教程 – 第2页 – QDAC官方网站

[FMX]在程序中使用已有的样式做自己需要的渲染

2017-09-272017-09-27 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 967 次

今天我们来做一件坏事，我们都是坏孩子…… 我们知道，FMX 是有 StyleBook，每个控件有自己的样式,但有时候，我们要绘制自绘一些状态，难道非要用户重新定义一堆样式吗？为啥不能利用现成的样式呢，比如，我就只是要自绘一个CheckBox，但我还不想放置一个TCheckBox组件，那么怎么来做呢？第一：我们需要知道

【教程】在你的程序中使用自定义字体

2017-09-222017-09-25 • Android、Delphi、QDAC、教程 • 暂无评论 • swish •浏览 1,452 次

【Android】方法一：参考 [译]在 Andriod/IOS 程序中使用自己的字体自己修改系统源码，缺点是每升级一个版本需要修改一次；方法二：使用 QDAC 为此新增 qdac_fmx_fontex_android ，不过区分免费版和赞助版（赞助版为qdac_appfonts，同时支持所有平台），但使用步骤一

[教程]在你的程序中使用 FontAwesome 字体

2017-09-212017-09-23 • Android、C++ Builder、Delphi、iOS、教程 • 暂无评论 • swish •浏览 1,139 次

首先是无论什么平台，要使用 FontAwesome 字体需要两步：第一步：添加字体，考虑到字体如果是专用的话，应该是当前程序能够加载字体的目录（下面都假设这一点，你如果装到操作系统字体目录里的话，就直接使用就可以了）；第二步：设置控件的字体为 FontAwesome，然后调整字体大小和样式为合适的大小；【Wind

[QMacros] 使用迭代器来重复内容

2017-09-18 • C++ Builder、Delphi、QDAC、QMacros、教程 • 暂无评论 • swish •浏览 718 次

QMacros 2017年9月18日提交的版本支持了迭代器，以重复替换某一部分内容。迭代器的声明：

IQMacroIterator = interface
    ['{3DB5D84F-0539-4C10-9476-E6B71D3099DE}']
    // 开始替换
    procedure BeginReplace(AMacro: TQMacroItem);
    // 判断是否还有要处理的数据
    function HasNext: Boolean;
    // 执行一次替换
    function Replace: QStringW;
    // 结束替换
    procedure EndReplace;
    // 获取当前活动的迭代器序号
    function GetItemIndex: Integer;
  end;

IQMacroIterator = interface

['{3DB5D84F-0539-4C10-9476-E6B71D3099DE}']

// 开始替换

procedure BeginReplace(AMacro: TQMacroItem);

// 判断是否还有要处理的数据

function HasNext: Boolean;

// 执行一次替换

function Replace: QStringW;

// 结束替换

procedure EndReplace;

// 获取当前活动的迭代器序号

function GetItemIndex: Integer;

end;

好吧，这是一个接口，这就意味着，我们绑定某个宏到这个迭代器之前，需要先实现一个迭代器。我们可以继承自 TQMacroIterator 实现一个自带的迭代

[教程]通过 PnP 获取显示器信息示例

2017-09-02 • Delphi、教程 • 暂无评论 • swish •浏览 864 次

在一些场合，我们需要获取显示器的硬件信息，来便做一些便宜的处理（那当然具体的处理就不需要我说道了），下面的代码提供了一种实现，供有需要的朋友参考：下载：MonitorEDID 效果：当然了，如果你没有想到用它来干啥，说明你根本就用不到它，当然也就不用管它了，全当看了一个笑话。

[教程]导出函数不是动态链接库或共享对象的专利，可执行文件也可以导出，所以两者是可以相互调用的

2017-08-27 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 802 次

这个教程没有更多内容，只是一句提示，懂得自然懂，不懂的慢慢想。

[教程]调用 TBrowseForFolder 的正确姿势

2017-08-22 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 880 次

TBrowseForFolder 是 Delphi / C++ Builder 中自带的一个浏览目录的对话框，位于 StdActns 单元（后期为 Vcl.StdActns 单元），不幸的是，这个动作代码天生残疾（从诞生到现在一直没改过这个问题），要让其好用，有两种解决办法：第一种：刮骨疗毒=>修改 StdAc

[教程]Delphi下的移动教程之二：读懂第三方 Java/Objective-C 接口

2017-08-21 • Android、Delphi、iOS、教程 • 暂无评论 • swish •浏览 1,079 次

教程以 Delphi 录制，但由于 Delphi 和 C++ Builder 使用同一 IDE，所以绝大部分内容同样适用于 C++ Builder。【价格】以人民币计价：个人用户：50元企业用户：300元【视频长度】待定【视频语言】中文，普通话【视频编码】格式：H.264 MP4 分辨率:1920×

[FMX]不是所有的高质量绘图都是我们想要的：在 FMX 下使用 Canvas 进行“低质量”绘图

2017-08-21 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 1,378 次

鱼，我所欲也，熊掌，虽我也欲，但我买不起也！FMX 默认的组图模式是 SystemDefault，在 Windows 下，默认是高质量绘图。当然，高质量这个词意味着啥，大家都清楚，使用 TCanvas 的 DrawLine 绘制一条 1 像素的水平直虚线，效果如下：怎么样，感觉是不是有点辣

[教程]Delphi 中三种回调函数形式解析

2017-08-152017-08-15 • Delphi、教程 • 暂无评论 • swish •浏览 1,565 次

Delphi 支持三种形式的回调函数：全局函数这种方式几乎是所有的语言都支持的，类的静态函数也可以归为此类，它保存的只是一个函数的代码起始地址指针（ Pointer ）。在 Delphi 中声明一般为：

TXXX=procedure/function (参数列表);

1	TXXX=procedure/function (参数列表);

类的成员函数类的成员函数作为回调函数，与全局

[FMX]在你的跨平台应用中使用剪贴板进行复制粘贴

2017-08-10 • Android、C++ Builder、Delphi、iOS、教程 • 暂无评论 • swish •浏览 1,193 次

VCL 中如何使用剪贴板咱就不说了，FMX 做为一个新的框架，提供了跨平台的剪贴板支持。FMX 对剪贴板的支持来自两个接口： IFMXClipboardService：位于 FMX.Platform.pas 中

  IFMXClipboardService = interface(IInterface)
    ['{CC9F70B3-E5AE-4E01-A6FB-E3FC54F5C54E}']
    /// <summary>
    ///   Gets current clipboard value
    /// </summary>
    function GetClipboard: TValue;
    /// <summary>
    ///   Sets new clipboard value
    /// </summary>
    procedure SetClipboard(Value: TValue);
  end;

IFMXClipboardService = interface(IInterface)

['{CC9F70B3-E5AE-4E01-A6FB-E3FC54F5C54E}']

/// <summary>

/// Gets current clipboard value

/// </summary>

function GetClipboard: TValue;

/// <summary>

/// Sets new clipboard value

/// </summary>

procedure SetClipboard(Value: TValue);

end;

IFMXExtendedClipboard

[FMX] 在 FMX 中手动控制打印机打印内容

2017-04-13 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 1,344 次

好吧，先说下版本：10.1.2，然后说遇到的两个 Bug：一、字体大小的问题打印机的字体大小错误，比如设置为10.5（五号字的大小，3.7mm），你会发现打印出的字特别小，根本与实际设置不搭别。所以在 10.1.2 时，输出文本时的字体大小需要按以下公式计算下：字体磅数 × DPI/72 然后就没有问题了，比如现

[FMX]增强画布的 DrawBitmap 函数

2017-04-12 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 949 次

不多说话，直接上源码：

type
  TFMXCanvasHelper = class helper for TCanvas
  public
    procedure StretchDraw(R: TRectF; ABitmap: TBitmap;
      ADoFit, AHighSpeed: Boolean);
  end;
{ TFMXCanvasHelper }

procedure TFMXCanvasHelper.StretchDraw(R: TRectF; ABitmap: TBitmap;
  ADoFit, AHighSpeed: Boolean);
var
  SR: TRectF;
begin
  SR := RectF(0, 0, ABitmap.Width, ABitmap.Height);
  if ADoFit then
    R := SR.FitInto(R);
  DrawBitmap(ABitmap, SR, R, 1, AHighSpeed);
end;

type

TFMXCanvasHelper = class helper for TCanvas

public

procedure StretchDraw(R: TRectF; ABitmap: TBitmap;

ADoFit, AHighSpeed: Boolean);

end;

{ TFMXCanvasHelper }

procedure TFMXCanvasHelper.StretchDraw(R: TRectF; ABitmap: TBitmap;

ADoFit, AHighSpeed: Boolean);

var

SR: TRectF;

begin

SR := RectF(0, 0, ABitmap.Width, ABitmap.Height);

if ADoFit then

R := SR.FitInto(R);

DrawBitmap(ABitmap, SR, R, 1, AHighSpeed);

end;

参数说明： R ：绘制目标区域 ABitmap：要绘制的位图内容 ADoFit：是否按比例自适应目标区域大小 AHighSpeed：是否高速绘图，如果你是要绘制边缘清晰的位图，如二维码，那就要设置为 true，否则设置为 fals

[FMX]获取控件样式中的指定项目以便进行调节

2017-03-26 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 1,160 次

FMX 的样式丰富了我们的设计，但我们在运行时想改变特定的Style的属性却没有直接的办法，下面的函数提供了一种途径，让你找到特定的样式，然后进行处理。

function FindStyleByName(AParent:TFMXObject;AName:String):TFMXObject;
  var
    I: Integer;
    AObj:TFMXObject;
  begin
  Result:=nil;
  for I := 0 to AParent.ChildrenCount-1 do
    begin
    AObj:=AParent.Children[I];
    if AObj.StyleName=AName then
      Result:=AObj
    else
      Result:=FindStyleByName(AObj,AName);
    if Assigned(Result) then
      break;
    end;
  end;

function FindStyleByName(AParent:TFMXObject;AName:String):TFMXObject;

var

I: Integer;

AObj:TFMXObject;

begin

Result:=nil;

for I := 0 to AParent.ChildrenCount-1 do

begin

AObj:=AParent.Children[I];

if AObj.StyleName=AName then

Result:=AObj

else

Result:=FindStyleByName(AObj,AName);

if Assigned(Result) then

break;

end;

用法示例：

procedure TForm1.btnLeftApplyStyleLookup(Sender: TObject);
var
  AText:TButtonStyleTextObject;
begin
AText:=FindStyleByName(Sender as TFMXObject,'text') as TButtonStyleTextObject;
AText.NormalColor:=TAlphaColors.White;
end;

procedure TForm1.btnLeftApplyStyleLookup(Sender: TObject);

var

AText:TButtonStyleTextObject;

begin

AText:=FindStyleByName(Sender as TFMXObject,'text') as TButtonStyleTextObject;

AText.NormalColor:=TAlphaColors.White;

end;

在 btnLeft 的

[教程] Delphi 10.2 Linux 程序开发环境部署的基本步骤

2017-03-232018-11-24 • 教程 • 暂无评论 • swish •浏览 5,542 次

官方声明支持 Ubuntu 和 RedHat 的 Linux，但实际上，现在市面上有许多 Linux 都是基于它们进一步改进的版本，比如下面我用的深度 Linux，就是原来做盗版 XP 出名的深度，从良后做 Linux 的发行版，整合的还是相当不错。废话永远嫌多，所以现在少说开整。第一步：下载 Linux 的 IS

纯真IP数据库解析Delphi D10.1下正常使用

2017-02-232017-02-23 • Delphi、教程、杂谈 • 暂无评论 • sinmax •浏览 1,220 次

直接一个单元，代码分享出来。

unit   Net.IPLocation;

interface

uses System.Classes, System.SysUtils, Winapi.WinSock, Vcl.Forms,
  System.Math, System.SyncObjs;

type
  TIPLocation = class(TObject)
  private
    QQWryFileName: string;
    QQWryFileStream: TBufferedFileStream;
    QQWryFileSize: Cardinal;
    IPRecordNum: Cardinal;
    FirstIPIndexOffset, LastIPIndexOffset: Cardinal;
    FLock: TCriticalSection;

    function GetQQWryFileName: string;
    function GetQQWryFileSize: Cardinal;
    function GetIPRecordNum: Cardinal;
    function GetQQWryDate: TDate;
    function GetQQWryDataFrom: string;
    function GetIPLocation(IPLocationOffset: Cardinal): TStringlist;
    function GetIPMsg(IPRecordID: Cardinal): TStringlist;
    function GetIPRecordID(IP: string): Cardinal;
    function GetIPValue(IP: string): Cardinal;
  public
    constructor Create(cQQWryFileName: string);
    destructor Destroy; override;
    function GetLocation(IP: string): String;
  end;

function IPLocation: TIPLocation;

implementation

var
  __IPLocation: TIPLocation;

function IPLocation: TIPLocation;
begin
  if __IPLocation = nil then
    __IPLocation := TIPLocation.Create(ExtractFilePath(ParamStr(0)) +
      'qqwry.dat');

  Result := __IPLocation;
end;

{ TIPLocation }

constructor TIPLocation.Create(cQQWryFileName: string);
begin
  inherited Create;
  FLock := TCriticalSection.Create;
  QQWryFileName := cQQWryFileName;
  QQWryFileStream := TBufferedFileStream.Create(QQWryFileName,
    fmOpenRead or fmShareDenyWrite, 0);
  QQWryFileSize := QQWryFileStream.Size;
  QQWryFileStream.Read(FirstIPIndexOffset, 4);
  QQWryFileStream.Read(LastIPIndexOffset, 4);
  IPRecordNum := (LastIPIndexOffset - FirstIPIndexOffset) div 7 + 1;
end;

destructor TIPLocation.Destroy;
begin

  QQWryFileStream.Free;
  FLock.Free;
  inherited Destroy;
end;

function TIPLocation.GetIPLocation(IPLocationOffset: Cardinal): TStringlist;
const
  // 实际信息字串存放位置的重定向模式
  REDIRECT_MODE_1 = 1;
  REDIRECT_MODE_2 = 2;
var
  RedirectMode: byte;
  CountryFirstOffset, CountrySecondOffset: Cardinal;
  CountryMsg, AreaMsg: string;
  //
  function ReadString(StringOffset: Cardinal): ansistring;
  var
    ReadByte: ansichar;
  begin
    Result := '';
    QQWryFileStream.Seek(StringOffset, soFromBeginning);
    QQWryFileStream.Read(ReadByte, 1);
    while ord(ReadByte) <> 0 do
    begin
      Result := Result + ReadByte;
      QQWryFileStream.Read(ReadByte, 1);
    end;
  end;
//
  function ReadArea(AreaOffset: Cardinal): ansistring;
  var
    ModeByte: byte;
    ReadAreaOffset: Cardinal;
  begin
    ReadAreaOffset := 0;
    QQWryFileStream.Seek(AreaOffset, soFromBeginning);
    QQWryFileStream.Read(ModeByte, 1);
    if (ModeByte = REDIRECT_MODE_1) or (ModeByte = REDIRECT_MODE_2) then
    begin
      QQWryFileStream.Read(ReadAreaOffset, 3);
      if ReadAreaOffset = 0 then
        Result := '未知地区'
      else
        Result := ReadString(ReadAreaOffset);
    end
    else
    begin
      Result := ReadString(AreaOffset);
    end;
  end;

begin
  CountryFirstOffset := 0;
  CountrySecondOffset := 0;
  // 跳过4个字节，该4字节内容为该条IP信息里IP地址段中的终止IP值
  QQWryFileStream.Seek(IPLocationOffset + 4, soFromBeginning);
  // 读取国家信息的重定向模式值
  QQWryFileStream.Read(RedirectMode, 1);
  // 重定向模式1的处理
  if RedirectMode = REDIRECT_MODE_1 then
  begin
    // 模式值为1，则后3个字节的内容为国家信息的重定向偏移值
    QQWryFileStream.ReadData(CountryFirstOffset, 3);
    // 进行重定向
    QQWryFileStream.Seek(CountryFirstOffset, soFromBeginning);
    // 第二次读取国家信息的重定向模式
    QQWryFileStream.Read(RedirectMode, 1);
    // 第二次重定向模式为模式2的处理
    if RedirectMode = REDIRECT_MODE_2 then
    begin
      // 后3字节的内容即为第二次重定向偏移值
      QQWryFileStream.ReadData(CountrySecondOffset, 3);
      // 读取第二次重定向偏移值下的字符串值，即为国家信息
      CountryMsg := ReadString(CountrySecondOffset);
      // 若第一次重定向模式为1，进行重定向后读取的第二次重定向模式为2，
      // 则地区信息存放在第一次国家信息偏移值的后面
      QQWryFileStream.Seek(CountryFirstOffset + 4, soFromBeginning);
      // 第二次重定向模式不是模式2的处理
    end
    else
    begin
      CountryMsg := ReadString(CountryFirstOffset);
    end;
    // 在重定向模式1下读地区信息值
    AreaMsg := ReadArea(QQWryFileStream.Position);
    // 重定向模式2的处理
  end
  else if RedirectMode = REDIRECT_MODE_2 then
  begin
    QQWryFileStream.ReadData(CountrySecondOffset, 3);
    CountryMsg := ReadString(CountrySecondOffset);
    AreaMsg := ReadArea(IPLocationOffset + 8);
    // 不是重定向模式的处理，存放的即是IP地址信息
  end
  else
  begin
    CountryMsg := ReadString(QQWryFileStream.Position - 1);
    AreaMsg := ReadArea(QQWryFileStream.Position);
  end;
  Result := TStringlist.Create;
  Result.Add(CountryMsg);
  Result.Add(AreaMsg);
end;

function TIPLocation.GetIPMsg(IPRecordID: Cardinal): TStringlist;
var
  aryStartIP: array [1 .. 4] of byte;
  strStartIP: string;
  EndIPOffset: Cardinal;
  aryEndIP: array [1 .. 4] of byte;
  strEndIP: string;
  i: integer;
begin
  EndIPOffset := 0;

  // 根据记录ID号移到该记录号的索引处
  QQWryFileStream.Seek(FirstIPIndexOffset + (IPRecordID - 1) * 7,
    soFromBeginning);
  // 索引的前4个字节为起始IP地址
  QQWryFileStream.Read(aryStartIP, 4);
  // 后3个字节是内容区域的偏移值
  // QQWryFileStream.Read(EndIPOffset, 3);
  QQWryFileStream.ReadData(EndIPOffset, 3);
  // 移至内容区域
  QQWryFileStream.Seek(EndIPOffset, soFromBeginning);
  // 内容区域的前4个字节为终止IP地址
  QQWryFileStream.Read(aryEndIP, 4);

  // 将起止IP地址转换为点分的形式
  strStartIP := '';
  for i := 4 downto 1 do
  begin
    if i <> 1 then
      strStartIP := strStartIP + IntToStr(aryStartIP[i]) + '.'
    else
      strStartIP := strStartIP + IntToStr(aryStartIP[i]);
  end;
  strEndIP := '';
  for i := 4 downto 1 do
  begin
    if i <> 1 then
      strEndIP := strEndIP + IntToStr(aryEndIP[i]) + '.'
    else
      strEndIP := strEndIP + IntToStr(aryEndIP[i]);
  end;
  Result := TStringlist.Create;
  Result.Add(strStartIP);
  Result.Add(strEndIP);
  // 获取该条记录下的IP地址信息
  // 以下三者是统一的：①内容区域的偏移值 ②终止IP地址的存放位置 ③国家信息紧接在终止IP地址存放位置后
  Result.AddStrings(GetIPLocation(EndIPOffset));
end;

function TIPLocation.GetIPRecordID(IP: string): Cardinal;
  function SearchIPRecordID(IPRecordFrom, IPRecordTo, IPValue: Cardinal)
    : Cardinal;
  var
    CompareIPValue1, CompareIPValue2: Cardinal;
  begin
    Result := 0;
    CompareIPValue1 := 0;
    CompareIPValue2 := 0;
    QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div 2
      + IPRecordFrom - 1) * 7, soFromBeginning);
    QQWryFileStream.Read(CompareIPValue1, 4);
    QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div 2
      + IPRecordFrom) * 7, soFromBeginning);
    QQWryFileStream.Read(CompareIPValue2, 4);
    // 找到了
    if (IPValue >= CompareIPValue1) and (IPValue < CompareIPValue2) then
    begin
      Result := (IPRecordTo - IPRecordFrom) div 2 + IPRecordFrom;
    end
    else
      // 后半段找
      if IPValue > CompareIPValue1 then
      begin
        Result := SearchIPRecordID((IPRecordTo - IPRecordFrom) div 2 +
          IPRecordFrom + 1, IPRecordTo, IPValue);
      end
      else
        // 前半段找
        if IPValue < CompareIPValue1 then
        begin
          Result := SearchIPRecordID(IPRecordFrom, (IPRecordTo - IPRecordFrom)
            div 2 + IPRecordFrom - 1, IPValue);
        end;
  end;

begin
  Result := SearchIPRecordID(1, GetIPRecordNum, GetIPValue(IP));
end;

function TIPLocation.GetIPRecordNum: Cardinal;
begin
  Result := IPRecordNum;
end;

function TIPLocation.GetIPValue(IP: string): Cardinal;
var
  tsIP: TStringlist;
  i: integer;
  function SplitStringToStringlist(aString: string; aSplitChar: string)
    : TStringlist;
  begin
    Result := TStringlist.Create;
    while pos(aSplitChar, aString) > 0 do
    begin
      Result.Add(copy(aString, 1, pos(aSplitChar, aString) - 1));
      aString := copy(aString, pos(aSplitChar, aString) + 1,
        length(aString) - pos(aSplitChar, aString));
    end;
    Result.Add(aString);
  end;

begin
  tsIP := SplitStringToStringlist(IP, '.');
  Result := 0;
  for i := 3 downto 0 do
  begin
    Result := Result + StrToInt(tsIP[i]) * trunc(power(256, 3 - i));
  end;
end;

function TIPLocation.GetLocation(IP: string): String;
begin
  FLock.Enter;
  try
    Result := GetIPMsg(GetIPRecordID(IP))[2];
  finally
    FLock.Leave;
  end;
end;

function TIPLocation.GetQQWryDataFrom: string;
begin
  Result := GetIPMsg(GetIPRecordNum)[2];
end;

function TIPLocation.GetQQWryDate: TDate;
var
  DateString: string;
begin
  DateString := GetIPMsg(GetIPRecordNum)[3];
  DateString := copy(DateString, 1, pos('IP数据', DateString) - 1);
  DateString := StringReplace(DateString, '年', '-',
    [rfReplaceAll, rfIgnoreCase]);
  DateString := StringReplace(DateString, '月', '-',
    [rfReplaceAll, rfIgnoreCase]);
  DateString := StringReplace(DateString, '日', '-',
    [rfReplaceAll, rfIgnoreCase]);
  Result := StrToDate(DateString);
end;

function TIPLocation.GetQQWryFileName: string;
begin
  Result := QQWryFileName;
end;

function TIPLocation.GetQQWryFileSize: Cardinal;
begin
  Result := QQWryFileSize;
end;

initialization

finalization

if __IPLocation <> nil then
  __IPLocation.Free;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

unit Net.IPLocation;

interface

uses System.Classes, System.SysUtils, Winapi.WinSock, Vcl.Forms,

System.Math, System.SyncObjs;

type

TIPLocation = class(TObject)

private

QQWryFileName: string;

QQWryFileStream: TBufferedFileStream;

QQWryFileSize: Cardinal;

IPRecordNum: Cardinal;

FirstIPIndexOffset, LastIPIndexOffset: Cardinal;

FLock: TCriticalSection;

function GetQQWryFileName: string;

function GetQQWryFileSize: Cardinal;

function GetIPRecordNum: Cardinal;

function GetQQWryDate: TDate;

function GetQQWryDataFrom: string;

function GetIPLocation(IPLocationOffset: Cardinal): TStringlist;

function GetIPMsg(IPRecordID: Cardinal): TStringlist;

function GetIPRecordID(IP: string): Cardinal;

function GetIPValue(IP: string): Cardinal;

public

constructor Create(cQQWryFileName: string);

destructor Destroy; override;

function GetLocation(IP: string): String;

end;

function IPLocation: TIPLocation;

implementation

var

__IPLocation: TIPLocation;

function IPLocation: TIPLocation;

begin

if __IPLocation = nil then

__IPLocation := TIPLocation.Create(ExtractFilePath(ParamStr(0)) +

'qqwry.dat');

Result := __IPLocation;

end;

{ TIPLocation }

constructor TIPLocation.Create(cQQWryFileName: string);

begin

inherited Create;

FLock := TCriticalSection.Create;

QQWryFileName := cQQWryFileName;

QQWryFileStream := TBufferedFileStream.Create(QQWryFileName,

fmOpenRead or fmShareDenyWrite, 0);

QQWryFileSize := QQWryFileStream.Size;

QQWryFileStream.Read(FirstIPIndexOffset, 4);

QQWryFileStream.Read(LastIPIndexOffset, 4);

IPRecordNum := (LastIPIndexOffset - FirstIPIndexOffset) div 7 + 1;

end;

destructor TIPLocation.Destroy;

begin

QQWryFileStream.Free;

FLock.Free;

inherited Destroy;

end;

function TIPLocation.GetIPLocation(IPLocationOffset: Cardinal): TStringlist;

const

// 实际信息字串存放位置的重定向模式

REDIRECT_MODE_1 = 1;

REDIRECT_MODE_2 = 2;

var

RedirectMode: byte;

CountryFirstOffset, CountrySecondOffset: Cardinal;

CountryMsg, AreaMsg: string;

function ReadString(StringOffset: Cardinal): ansistring;

var

ReadByte: ansichar;

begin

Result := '';

QQWryFileStream.Seek(StringOffset, soFromBeginning);

QQWryFileStream.Read(ReadByte, 1);

while ord(ReadByte) <> 0 do

begin

Result := Result + ReadByte;

QQWryFileStream.Read(ReadByte, 1);

end;

function ReadArea(AreaOffset: Cardinal): ansistring;

var

ModeByte: byte;

ReadAreaOffset: Cardinal;

begin

ReadAreaOffset := 0;

QQWryFileStream.Seek(AreaOffset, soFromBeginning);

QQWryFileStream.Read(ModeByte, 1);

if (ModeByte = REDIRECT_MODE_1) or (ModeByte = REDIRECT_MODE_2) then

begin

QQWryFileStream.Read(ReadAreaOffset, 3);

if ReadAreaOffset = 0 then

Result := '未知地区'

else

Result := ReadString(ReadAreaOffset);

end

else

begin

Result := ReadString(AreaOffset);

end;

begin

CountryFirstOffset := 0;

CountrySecondOffset := 0;

// 跳过4个字节，该4字节内容为该条IP信息里IP地址段中的终止IP值

QQWryFileStream.Seek(IPLocationOffset + 4, soFromBeginning);

// 读取国家信息的重定向模式值

QQWryFileStream.Read(RedirectMode, 1);

// 重定向模式1的处理

if RedirectMode = REDIRECT_MODE_1 then

begin

// 模式值为1，则后3个字节的内容为国家信息的重定向偏移值

QQWryFileStream.ReadData(CountryFirstOffset, 3);

// 进行重定向

QQWryFileStream.Seek(CountryFirstOffset, soFromBeginning);

// 第二次读取国家信息的重定向模式

QQWryFileStream.Read(RedirectMode, 1);

// 第二次重定向模式为模式2的处理

if RedirectMode = REDIRECT_MODE_2 then

begin

// 后3字节的内容即为第二次重定向偏移值

QQWryFileStream.ReadData(CountrySecondOffset, 3);

// 读取第二次重定向偏移值下的字符串值，即为国家信息

CountryMsg := ReadString(CountrySecondOffset);

// 若第一次重定向模式为1，进行重定向后读取的第二次重定向模式为2，

// 则地区信息存放在第一次国家信息偏移值的后面

QQWryFileStream.Seek(CountryFirstOffset + 4, soFromBeginning);

// 第二次重定向模式不是模式2的处理

end

else

begin

CountryMsg := ReadString(CountryFirstOffset);

end;

// 在重定向模式1下读地区信息值

AreaMsg := ReadArea(QQWryFileStream.Position);

// 重定向模式2的处理

end

else if RedirectMode = REDIRECT_MODE_2 then

begin

QQWryFileStream.ReadData(CountrySecondOffset, 3);

CountryMsg := ReadString(CountrySecondOffset);

AreaMsg := ReadArea(IPLocationOffset + 8);

// 不是重定向模式的处理，存放的即是IP地址信息

end

else

begin

CountryMsg := ReadString(QQWryFileStream.Position - 1);

AreaMsg := ReadArea(QQWryFileStream.Position);

end;

Result := TStringlist.Create;

Result.Add(CountryMsg);

Result.Add(AreaMsg);

end;

function TIPLocation.GetIPMsg(IPRecordID: Cardinal): TStringlist;

var

aryStartIP: array [1 .. 4] of byte;

strStartIP: string;

EndIPOffset: Cardinal;

aryEndIP: array [1 .. 4] of byte;

strEndIP: string;

i: integer;

begin

EndIPOffset := 0;

// 根据记录ID号移到该记录号的索引处

QQWryFileStream.Seek(FirstIPIndexOffset + (IPRecordID - 1) * 7,

soFromBeginning);

// 索引的前4个字节为起始IP地址

QQWryFileStream.Read(aryStartIP, 4);

// 后3个字节是内容区域的偏移值

// QQWryFileStream.Read(EndIPOffset, 3);

QQWryFileStream.ReadData(EndIPOffset, 3);

// 移至内容区域

QQWryFileStream.Seek(EndIPOffset, soFromBeginning);

// 内容区域的前4个字节为终止IP地址

QQWryFileStream.Read(aryEndIP, 4);

// 将起止IP地址转换为点分的形式

strStartIP := '';

for i := 4 downto 1 do

begin

if i <> 1 then

strStartIP := strStartIP + IntToStr(aryStartIP[i]) + '.'

else

strStartIP := strStartIP + IntToStr(aryStartIP[i]);

end;

strEndIP := '';

for i := 4 downto 1 do

begin

if i <> 1 then

strEndIP := strEndIP + IntToStr(aryEndIP[i]) + '.'

else

strEndIP := strEndIP + IntToStr(aryEndIP[i]);

end;

Result := TStringlist.Create;

Result.Add(strStartIP);

Result.Add(strEndIP);

// 获取该条记录下的IP地址信息

// 以下三者是统一的：①内容区域的偏移值 ②终止IP地址的存放位置 ③国家信息紧接在终止IP地址存放位置后

Result.AddStrings(GetIPLocation(EndIPOffset));

end;

function TIPLocation.GetIPRecordID(IP: string): Cardinal;

function SearchIPRecordID(IPRecordFrom, IPRecordTo, IPValue: Cardinal)

: Cardinal;

var

CompareIPValue1, CompareIPValue2: Cardinal;

begin

Result := 0;

CompareIPValue1 := 0;

CompareIPValue2 := 0;

QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div 2

+ IPRecordFrom - 1) * 7, soFromBeginning);

QQWryFileStream.Read(CompareIPValue1, 4);

QQWryFileStream.Seek(FirstIPIndexOffset + ((IPRecordTo - IPRecordFrom) div 2

+ IPRecordFrom) * 7, soFromBeginning);

QQWryFileStream.Read(CompareIPValue2, 4);

// 找到了

if (IPValue >= CompareIPValue1) and (IPValue < CompareIPValue2) then

begin

Result := (IPRecordTo - IPRecordFrom) div 2 + IPRecordFrom;

end

else

// 后半段找

if IPValue > CompareIPValue1 then

begin

Result := SearchIPRecordID((IPRecordTo - IPRecordFrom) div 2 +

IPRecordFrom + 1, IPRecordTo, IPValue);

end

else

// 前半段找

if IPValue < CompareIPValue1 then

begin

Result := SearchIPRecordID(IPRecordFrom, (IPRecordTo - IPRecordFrom)

div 2 + IPRecordFrom - 1, IPValue);

end;

begin

Result := SearchIPRecordID(1, GetIPRecordNum, GetIPValue(IP));

end;

function TIPLocation.GetIPRecordNum: Cardinal;

begin

Result := IPRecordNum;

end;

function TIPLocation.GetIPValue(IP: string): Cardinal;

var

tsIP: TStringlist;

i: integer;

function SplitStringToStringlist(aString: string; aSplitChar: string)

: TStringlist;

begin

Result := TStringlist.Create;

while pos(aSplitChar, aString) > 0 do

begin

Result.Add(copy(aString, 1, pos(aSplitChar, aString) - 1));

aString := copy(aString, pos(aSplitChar, aString) + 1,

length(aString) - pos(aSplitChar, aString));

end;

Result.Add(aString);

end;

begin

tsIP := SplitStringToStringlist(IP, '.');

Result := 0;

for i := 3 downto 0 do

begin

Result := Result + StrToInt(tsIP[i]) * trunc(power(256, 3 - i));

end;

function TIPLocation.GetLocation(IP: string): String;

begin

FLock.Enter;

try

Result := GetIPMsg(GetIPRecordID(IP))[2];

finally

FLock.Leave;

end;

function TIPLocation.GetQQWryDataFrom: string;

begin

Result := GetIPMsg(GetIPRecordNum)[2];

end;

function TIPLocation.GetQQWryDate: TDate;

var

DateString: string;

begin

DateString := GetIPMsg(GetIPRecordNum)[3];

DateString := copy(DateString, 1, pos('IP数据', DateString) - 1);

DateString := StringReplace(DateString, '年', '-',

[rfReplaceAll, rfIgnoreCase]);

DateString := StringReplace(DateString, '月', '-',

[rfReplaceAll, rfIgnoreCase]);

DateString := StringReplace(DateString, '日', '-',

[rfReplaceAll, rfIgnoreCase]);

Result := StrToDate(DateString);

end;

function TIPLocation.GetQQWryFileName: string;

begin

Result := QQWryFileName;

end;

function TIPLocation.GetQQWryFileSize: Cardinal;

begin

Result := QQWryFileSize;

end;

initialization

finalization

if __IPLocation <> nil then

__IPLocation.Free;

end.

[FMX]开年第二弹：修改 FMX.Forms.pas 避免在控件中滑动被识别为点击

2017-02-04 • Android、C++ Builder、Delphi、iOS、教程 • 暂无评论 • swish •浏览 1,397 次

通过修改 FMX.Controls 单元，我们在编辑控制上滑动时，输入法自动弹出的问题算是比较完美的解决了（参考：[FMX]开年第一弹：修改 FMX.Controls 避免按住编辑框移动时弹出输入法的问题），但 FMX 依然存在着滑动时触发OnClick事件的问题。现在我们要做的就是解决这一问题： 1、找到 FMX.

[FMX]开年第一弹：修改 FMX.Controls 避免按住编辑框移动时弹出输入法的问题

2017-02-032017-02-03 • Android、C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 1,629 次

在 FMX 中，当用户在编辑框上按下时，许多场景下，是要拖动位置，但是，FMX.Controls 在 MouseDown 事件中，就调用了控件的 SetFocus ，结果就造成按下时，弹出输入法，影响拖动操作。我们可以将相应的代码那到 MouseUp 中来解决这一问题。同时，我们加一个判断，以避免将拖动识别为点击。所

[FMX]画个圈圈好过年：在 FMX 中绘制环形

2017-01-132017-01-14 • Android、C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 1,348 次

FMX 的 Shape 现在不是很全，至少我想找一个圆环时没找到，所以自己用代码实现了一个，供大家参考：

procedure AddRing(AData: TPathData; const ACenter: TPointF;
  R1, R2, AStartAngle, ASweepAngle: Single);
var
  A, CA, SA, AEndAngle: Single;
begin
  A := AStartAngle * PI / 180;
  SA := sin(A);
  CA := cos(A);
  AData.MoveTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));
  AData.AddArc(ACenter, PointF(R1, R1), AStartAngle, ASweepAngle);
  AData.MoveTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));
  AData.LineTo(PointF(ACenter.X + R2 * CA, ACenter.Y + R2 * SA));
  AData.AddArc(ACenter, PointF(R2, R2), AStartAngle, ASweepAngle);
  A := (AStartAngle + ASweepAngle) * PI / 180;
  SA := sin(A);
  CA := cos(A);
  AData.LineTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));
end;

procedure AddRing(AData: TPathData; const ACenter: TPointF;

R1, R2, AStartAngle, ASweepAngle: Single);

var

A, CA, SA, AEndAngle: Single;

begin

A := AStartAngle * PI / 180;

SA := sin(A);

CA := cos(A);

AData.MoveTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));

AData.AddArc(ACenter, PointF(R1, R1), AStartAngle, ASweepAngle);

AData.MoveTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));

AData.LineTo(PointF(ACenter.X + R2 * CA, ACenter.Y + R2 * SA));

AData.AddArc(ACenter, PointF(R2, R2), AStartAngle, ASweepAngle);

A := (AStartAngle + ASweepAngle) * PI / 180;

SA := sin(A);

CA := cos(A);

AData.LineTo(PointF(ACenter.X + R1 * CA, ACenter.Y + R1 * SA));

end;

函数的参数说明： AData : 用来保存圆环路径信息 ACenter：中心点坐标 R1：内环半径 R2：外环半径 AStartAngle：环的起始

[QSocket]QSocket 总体设计框架说明

2017-01-072017-01-07 • Android、C++ Builder、Delphi、iOS、QSocket、教程 • 暂无评论 • swish •浏览 2,166 次

QSocket 是 QDAC 开源组件的一个重要的组成部分，终于要开始开工了，为了方便大家了解 QSocket，对 QSocket 的总体设计的一些想法，我在这里给大家简要的描述一下。首先，QSocket 同 QDAC 的其它组成部分一样，是跨平台的，这意味着你可以在不同的操作系统中，体验 QSocket 为你带来的

登录