教程 – 第 2 页 – QDAC数据访问组件网站

[教程]使用泛型为 Delphi 提供一个位运算的模板支持

2018-11-212018-11-21 • Delphi、教程 • 暂无评论 • swish •浏览 2,398 次

说起来，Delphi 自 2009 引和泛型已经很长时间了，而 Delphi 缺少位域也已经更久远了，早在远古之前……，扯远了:) 新版的 Delphi 提供了一个类，名字叫 TBits，好吧，顾名思意，可是为什么是类呀？这意味着我们没法像C++一样将它嵌入到结构体里，如果你能，你就上天了@ 好吧，为了实现这一目的，本

[教程]Delphi 10.3 新特性：内联变量

2018-10-29 • Delphi、教程 • 暂无评论 • swish •浏览 5,545 次

简译自 Macro 技术博客简单一句话：Delphi 终于不用非将变量定义在函数的开头位置了。拓展开来： 1、您可以在代码中使用变量时，通过下面的格式来定义变量： var 变量名[:变量类型][:=变量值] 示例一：

procedure Test;
begin
  var I, J: Integer;
  I := 22;
  j := I + 20;
  ShowMessage (J.ToString);
end;

procedure Test;

begin

var I, J: Integer;

I := 22;

j := I + 20;

ShowMessage (J.ToString);

end;

示例2： [crayon-616

[教程]QAnimation 使用教程之一：为 TPageControl 切换加入动画效果

2018-09-022019-06-09 • Delphi、教程 • 暂无评论 • swish •浏览 2,527 次

首先，VCL 的 TPageControl 是没有切入切出动画的，所以，这里要做的是给 VCL 的 TPageControl 做动画支持。当然，虽然咱们说的是 QAnimation 教程，但关注的重点不是 QAnimation，而是如何给 TPageControl 添加动画效果，QAnimation 只是一个动画控制器

【教程】delphi 中如何访问另一个类中到私有成员方法 N 合 1

2018-09-022018-09-02 • Delphi、教程 • 暂无评论 • swish •浏览 2,296 次

此文是参考原文链接和群友及作者自己曾经用过的方法简单总结，感谢群内的朋友和原文作者。另外，此文中所谓的访问另一个类的私有成员，另一个类并不在同一单元，在同一单元内的私有成员 Delphi 也是可以直接访问的，不需要绕圈子。 1、最易用的方法：class helper + with self 创建一个对应类的 cl

[教程] Resource XXX not found 的解决办法

2018-08-31 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 7,535 次

一查路径：查看程序的搜索和库文件路径中是否有重名的文件，如果资源在这些重名的文件中，链接时如果错误链接到了老版本，就有可能造成此问题。二看定义：在 Delphi 中，如果 DFM 定义和 Pas 对应的文件不完全匹配（比如界面上有的控件，但 pas 中由于某些原因被删除了），编译时并不会提示什么问题，但实际链接到程序

[教程]判断两个不同的接口实例是否是同一个对象

2018-08-07 • Delphi、教程 • 暂无评论 • swish •浏览 1,495 次

如果一个对象支持多个接口，当我们获取其支持的不同接口的实例时，就会得到不同的地址，比如：

type
  IA=interface
  ['{CB36F22E-E44C-4842-8198-7487806A3617}']
  ...
  end;
  
  IB=interface
  ['{06949AE4-97F9-48C9-9E47-21E29F396DF7}']
  ...
  end;
  
  TABObject=class(TInterfacedObject,IA,IB)
  ...
  end;

type

IA=interface

['{CB36F22E-E44C-4842-8198-7487806A3617}']

...

end;

IB=interface

['{06949AE4-97F9-48C9-9E47-21E29F396DF7}']

...

end;

TABObject=class(TInterfacedObject,IA,IB)

...

end;

我们假设对象 TABObject 的实例 ab，当我们写下类似于下面的代码时：

var
  A:IA;
  B:IB;
begin
  A:=ab;
  B:=ab;
  if Pointer(A)=Pointer(B) then
    ....
end;

var

A:IA;

B:IB;

begin

A:=ab;

B:=ab;

if Pointer(A)=Pointer(B) then

....

end;

在实际运行中，A

[教程]为 Delphi 剪贴板加入 CF_HTML 数据支持

2018-06-212018-06-21 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 1,743 次

嗯，直接上代码，需要引用 QDAC 的 QString 单元，不支持太老版本的 Delphi，使用古董版的 Delphi 的请自己改写下：

uses clipbrd, qstring;
type
  THTMLClipboardFormatData = class helper for TClipboard
  private
    class procedure RegisterHtmlFormat;
    function GetAsHtml: String;
    procedure SetAsHtml(const Value: String);
  public
    property AsHtml: String read GetAsHtml write SetAsHtml;
  end;

var
  CF_HTML: WORD = 0;
//此处省略一万字
{ THTMLClipboardFormatData }

function THTMLClipboardFormatData.GetAsHtml: String;
var
  AHandle: THandle;
  pData: PQCharA absolute AHandle;
  AText: QStringW;
  p: PWideChar;
begin
  RegisterHtmlFormat;
  if Clipboard.HasFormat(CF_HTML) then
  begin
    AHandle := Clipboard.GetAsHandle(CF_HTML);
    try
      AText := Utf8Decode(pData, -1);
      p := PWideChar(AText);
      while (p^ <> '<') and (p^ <> #0) do
        SkipLineW(p);
      Result := p;
    finally
      GlobalUnlock(AHandle);
    end;
  end;
end;

class procedure THTMLClipboardFormatData.RegisterHtmlFormat;
begin
  if CF_HTML = 0 then
    CF_HTML := RegisterClipboardFormat('HTML Format');
end;

procedure THTMLClipboardFormatData.SetAsHtml(const Value: String);
var
  S: QStringA;
  AText: String;
  AHandle: THandle;
begin
  RegisterHtmlFormat;
  S := QString.Utf8Encode(Value);
  AText := Format('Version:0.9'#13#10 + //
    'StartHTML:%08u'#13#10 + //
    'EndHTML:%08u'#13#10 + //
    'StartFragment:%08u'#13#10 + //
    'EndFragment:%08u'#13#10 + //
    '<html><body>'#13#10 + //
    '<!--StartFragment -->'#13#10 + //
    '%s'#13#10 + //
    '<!--EndFragment-->'#13#10 + '</body></html>', [97, 172 + S.Length, 111,
    136 + S.Length, Value]);
  S := QString.Utf8Encode(AText);
  AHandle := GlobalAlloc(GMEM_DDESHARE, S.Length + 1);
  if AHandle <> 0 then
  begin
    try
      Move(PQCharA(S)^, GlobalLock(AHandle)^, S.Length + 1);
    finally
      GlobalUnlock(AHandle);
      Clipboard.SetAsHandle(CF_HTML, AHandle);
    end;
  end;
end;

uses clipbrd, qstring;

type

THTMLClipboardFormatData = class helper for TClipboard

private

class procedure RegisterHtmlFormat;

function GetAsHtml: String;

procedure SetAsHtml(const Value: String);

public

property AsHtml: String read GetAsHtml write SetAsHtml;

end;

var

CF_HTML: WORD = 0;

//此处省略一万字

{ THTMLClipboardFormatData }

function THTMLClipboardFormatData.GetAsHtml: String;

var

AHandle: THandle;

pData: PQCharA absolute AHandle;

AText: QStringW;

p: PWideChar;

begin

RegisterHtmlFormat;

if Clipboard.HasFormat(CF_HTML) then

begin

AHandle := Clipboard.GetAsHandle(CF_HTML);

try

AText := Utf8Decode(pData, -1);

p := PWideChar(AText);

while (p^ <> '<') and (p^ <> #0) do

SkipLineW(p);

Result := p;

finally

GlobalUnlock(AHandle);

end;

class procedure THTMLClipboardFormatData.RegisterHtmlFormat;

begin

if CF_HTML = 0 then

CF_HTML := RegisterClipboardFormat('HTML Format');

end;

procedure THTMLClipboardFormatData.SetAsHtml(const Value: String);

var

S: QStringA;

AText: String;

AHandle: THandle;

begin

RegisterHtmlFormat;

S := QString.Utf8Encode(Value);

AText := Format('Version:0.9'#13#10 + //

'StartHTML:%08u'#13#10 + //

'EndHTML:%08u'#13#10 + //

'StartFragment:%08u'#13#10 + //

'EndFragment:%08u'#13#10 + //

'<html><body>'#13#10 + //

''#13#10 + //

'%s'#13#10 + //

''#13#10 + '</body></html>', [97, 172 + S.Length, 111,

136 + S.Length, Value]);

S := QString.Utf8Encode(AText);

AHandle := GlobalAlloc(GMEM_DDESHARE, S.Length + 1);

if AHandle <> 0 then

begin

try

Move(PQCharA(S)^, GlobalLock(AHandle)^, S.Length + 1);

finally

GlobalUnlock(AHandle);

Clipboard.SetAsHandle(CF_HTML, AHandle);

end;

用法是直接操作 Clipboard.AsHtml 属性就可以了，例如： [crayon-6169d754b5bf

[日积月累]-20180622:前向声明关键字 forward

2018-06-212018-06-22 • 教程 • 暂无评论 • swish •浏览 1,224 次

【格式】函数声明;forward; 【用途】 forward 关键字用于前向声明一个局部函数，比如:

 function Calculate(X, Y: Integer): Real; forward;

1	function Calculate(X, Y: Integer): Real; forward;

声明了一个 Calculate 函数，那么后面必需重新声明并实现这个函数，类似于下面: [crayon-6169d754b5daa116940753/

[日积月累]-20180621：[Warning] W1000 Symbol ‘%1’ is deprecated: ‘Use %2’

2018-06-212018-06-21 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 1,607 次

【译】 [警告] W1000 符号 ‘%1′ 已经被废弃：’请使用 %2’ 【问题原因】当前版的 Delphi 已经不再使用名为 %1 的函数/变量/常量，目前的代码仍可以正常运行，但最好改成使用 %2 的替代函数/变量/常量。官方的意思是相应的符号将在后续的某个版本中

[教程]DateTimeFromString 函数的使用说明

2018-04-142018-04-15 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 2,424 次

DateTimeFromString 用于将一个日期时间格式的字符串表达式转换为日期时间类型，用于替代 Delphi 自己的 StrToDate 函数（弱弱的一个函数，我一直忽略它的存在）。在绝大部分场景下，DateTimeFromString 可以正确识别多咱格式的日期时间字符串，但并不代表它的自动识别智能到可以理

[QString]FindSwitchValue 函数使用说明

2018-03-25 • QDAC、教程 • 暂无评论 • swish •浏览 1,906 次

【用途】此函数用于将命令行开关分隔为一个名称-值对，并取出其中值。【声明】

function FindSwitchValue(ASwitch: QStringW; ANameValueSperator: QCharW;
  AIgnoreCase: Boolean; var ASwitchChar: QCharW): QStringW; overload;
function FindSwitchValue(ASwitch: QStringW; ANameValueSperator: QCharW = ':')
  : QStringW;overload;

function FindSwitchValue(ASwitch: QStringW; ANameValueSperator: QCharW;

AIgnoreCase: Boolean; var ASwitchChar: QCharW): QStringW; overload;

function FindSwitchValue(ASwitch: QStringW; ANameValueSperator: QCharW = ':')

: QStringW;overload;

【参数说明】 ASwitch : 要查找的开关 ANameValueSperator : 开关和名称的值的分隔符 AIgnoreCase : 是否忽略大小写 ASwitchC

[教程] Delphi 中的自动引用计数使用规则

2018-02-132018-02-13 • Delphi、教程 • 暂无评论 • swish •浏览 2,316 次

Delphi 用户应该早已经熟悉自动引用计数的概念（ARC），Delphi 很早就开始支持接口、动态数组和字符串的自动引用计数（DCC32、DCC64、DCCOSX），移动编译器则加入对类的自动引用计数支持，因此还加了入弱引用的概念，以管理循环引用。有个预编译条件指令 AUTOREFCOUNT 可以检测当前是否编译器

[FMX] FMX 动画类的一个辅助增强

2018-01-132018-01-13 • C++ Builder、Delphi、教程、杂谈 • 暂无评论 • swish •浏览 2,713 次

本增强的目的是解决动画对象只支持 published 的有效的几种属性的问题，确切的说，这是一个适配器，通过匿名函数建立与非 published 属性的适配。我在 [FMX] Delphi 中 TAnimation 设计的几点值得商榷的地方一文中讨论了 FMX 动画支持类的一些值得商榷的地方和改动，而这个增强从另一个

[教程]为 TDateTimePicker 增加日期时间类型支持（来自LakeView）

2018-01-11 • 教程 • 暂无评论 • swish •浏览 1,970 次

1、找到 VCL.ComCtrls.pas 单元 2、修改 TDateTimeKind 类型，增加 dtkDateTime，以便支持日期时间类型。 TDateTimeKind = (dtkDate, dtkTime, dtkDateTime); 3、找到 TDateTimePicker.CNNotify 函数，在 D

[教程]以管理员身份运行程序的一种方法

2018-01-01 • Delphi、教程 • 暂无评论 • swish •浏览 2,349 次

以管理员运行程序的方法有很多种，包含在 manifest 文件中请求权限，兼容性设置及下面说的 runas。 runas 算是一种比较另类的方法，它是通过重新启动程序以管理员方式运行的方式来让新的进程以管理员方式运行，然后退出当前进程，以达到以管理员身份运行的目的。要执行这个操作实际上很简单，用众所周知的 Shell

[非官方补丁]RSP-19552 10.2.2 的 Android 程序在退出时出错的问题非官方补丁

2017-12-172017-12-17 • 教程 • 暂无评论 • swish •浏览 2,094 次

访问官方QC地址问题原因：该问题是由于程序退出时，FSharedContext 被释放，而 DoFinalizeShader 调用 Valid 没有做相应的处理，结果在检查到 FSharedContext 为空时，又重新创建了 FSharedContext 造成的。解决办法：在 Valid ->Activat

[FMX] FMX 拖放支持的一处小问题修正

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

FMX 的拖放支持实际上要比 VCL 方便一些，控件的 OnDragOver 事件的 Operation 代替了 VCL 中只能简单的 Accept。但就 10.2 版本而言，其拖放操作在 Windows 下对 DragDrop 的调用存在问题，没有调用 TControl.DragDrop 函数，造成拖放后，目标的 I

[QSecurity]QSecurity 使用入门指南

2017-10-20 • C++ Builder、Delphi、QDAC、QPlugin、教程 • 暂无评论 • swish •浏览 2,394 次

QSecurity 是 QPlugins 的安全相关插件接口及其实现， qplugins_security.pas 定义了安全相关的接口，我们在插件中使用时，只需要引用这个接口文件就可以了。而服务的实现单元并不包含在免费开源的范围内，如果您不想自己实现，或者想参考实现，需要付费购买，价格为人民币 99.00 元。无论

[教程]解析 Web 颜色（VCL）

2017-10-202017-10-20 • C++ Builder、Delphi、教程 • 暂无评论 • swish •浏览 1,504 次

这段代码支持的Web颜色格式为 #RRGGBB/#RGB 以及以Web标准名称命名的颜色（需要引用单元：qstring,graphutil）：

function ParseWebColor(S: String;ADefColor:TColor=clBlack): TColor;
var
  p: PChar;
  c: array [0 .. 3] of Byte absolute Result;
  i: Integer;
begin
  Result := 0;
  p := PChar(S);
  i := 0;
  if p^ in ['a' .. 'z', 'A' .. 'Z'] then
  begin
    if IdentToColor('cl' + S, i) then
      Result := i
    else
    begin
      S := 'clWeb' + S;
      for I := 0 to High(WebNamedColors) do
      begin
        if CompareText(WebNamedColors[I].Name, S) = 0 then
        begin
          Result := WebNamedColors[I].Value;
          Exit;
        end;
      end;
      Result := ADefColor;
    end;
    Exit;
  end
  else if p^ = '#' then
  begin
    Inc(p);
    if Length(S) = 4 then // #RGB
    begin
      while p^ <> #0 do
      begin
        if IsHexChar(p^) then
        begin
          c[i] := (HexValue(p^) * 255) div 15;
          Inc(i);
          Inc(p);
        end
        else
          break;
      end;
    end
    else if Length(S) = 7 then
    begin
      while p^ <> #0 do
      begin
        if IsHexChar(p^) then
        begin
          c[i] := HexValue(p^);
          Inc(p);
          if p^ <> #0 then
          begin
            c[i] := (c[i] shl 4) + HexValue(p^);
            Inc(p);
          end;
          Inc(i);
        end
        else
          break;
      end;
    end;
  end;
  if i <> 3 then
    Result := ADefColor;
end;

function ParseWebColor(S: String;ADefColor:TColor=clBlack): TColor;

var

p: PChar;

c: array [0 .. 3] of Byte absolute Result;

i: Integer;

begin

Result := 0;

p := PChar(S);

i := 0;

if p^ in ['a' .. 'z', 'A' .. 'Z'] then

begin

if IdentToColor('cl' + S, i) then

Result := i

else

begin

S := 'clWeb' + S;

for I := 0 to High(WebNamedColors) do

begin

if CompareText(WebNamedColors[I].Name, S) = 0 then

begin

Result := WebNamedColors[I].Value;

Exit;

end;

Result := ADefColor;

end;

Exit;

end

else if p^ = '#' then

begin

Inc(p);

if Length(S) = 4 then // #RGB

begin

while p^ <> #0 do

begin

if IsHexChar(p^) then

begin

c[i] := (HexValue(p^) * 255) div 15;

Inc(i);

Inc(p);

end

else

break;

end;

end

else if Length(S) = 7 then

begin

while p^ <> #0 do

begin

if IsHexChar(p^) then

begin

c[i] := HexValue(p^);

Inc(p);

if p^ <> #0 then

begin

c[i] := (c[i] shl 4) + HexValue(p^);

Inc(p);

end;

Inc(i);

end

else

break;

end;

if i <> 3 then

Result := ADefColor;

end;

比如#FF0000 和 #F00 都被解释为红色。

[FMX]在 FMX 程序中绘制单像素宽度的直线

2017-10-09 • Android、Delphi、教程 • 暂无评论 • swish •浏览 2,382 次

在前面的一篇文章中，我介绍了一种绘制低品质直线的方法，但是这么做，效率上肯定要打折扣的。在和群里的朋友们一顿交流折腾后，对于绘制水平或垂直的直线，现在有两种更简单的办法来解决这一问题：办法一：使用 FillRect 来代替 DrawLine 绘制，矩形区域的大小注意要在相应的方向上加 0.5 个像素。 [crayon

登录