Delphi 的一些笔记

来自东子哥的Blog

1、Include

  集合函数  
      Include(FControlState,   csCustomPaint);  
  等同于  
      FControlState   :=   FControlState+[csCustomPaint];

2、Assign

  Delphi中的原型模式

在Delphi的VCL有一个非常重要的类TPersistent，从它的名字（可持续类）上可以知道该类提供了可持续性的功能，Vcl的基类TObject本身不支持Rtti(运行时类型信息)，而TPersistent类通过{$M+}编译指令提供了RTTI的功能，打开了M开关后，Delphi在编译该对象时，会把对象的类型信息也编译进可执行文件，这样在运行时就可以动态的获得对象的属性，方法等信息，所有的VCL可视化组件都是从TPersistent派生出来的，因此可以将组件信息保存成DFM文件，可以在运行时加载。

  除了RTTI外，TPersistent类定义了一个非常重要的虚方法Assign，方法的定义如下：

    procedure Assign(Source: TPersistent); virtual;

这个方法其实和Java中的Clone方法和C++中的Copy Constructor构造函数一样，就是用来把一个源对象的属性复制到目标对象中。略微有些不同的是Java中的Clone和C++中的拷贝构造函数直接返回源对象的副本，而调用Assign方法前，我们需要先Create一个目标对象，然后再复制源对象的属性。默认的TPersistent对象的Assign方法只是简单的调用源对象的AssignTo方法来复制属性，而TPersistent的AssignTo虚方法只是简单的抛出一个异常。也就是说TPersistent方法并没有实现任何有意义的功能，那么对于派生自TPersistent类的对象要想提供克隆的功能都需要重载TPersistent的Assign或者AssignTo方法来实现自定义的复制功能，在Vcl中很多的类都实现了定制的Assign方法，比如最常见的TStrings类就重载了Assign方法提供了字符串列表的复制功能，在程序开发中经常会有需要将一个列表框的选项全部移动到另外一个列表中表示选择了全部的内容，这个过程其实就是一个克隆的过程，

 

3、动态创建的控件的查找（代码）

procedure TForm1.FormCreate(Sender: TObject);
var
  pnl1: TPanel;
begin
  pnl1 := TPanel.Create(form1); 
  with pnl1 do
  begin
    Left := 10;
    Top := 10;
    Visible := true;
    Parent := Form1; //必须设定parent与name属性
    Name := 'pnl1';
  end;

end;

procedure TForm1.btn1Click(Sender: TObject);
var
  cp: TComponent;
begin
  cp := form1.FindComponent('pnl1'); 
  if cp <> nil then
  begin
    showmessage(TPanel(cp).Name);
    TPanel(cp).Destroy;
  end;
end;

4、如何在Panel中嵌入Dll中的Form

Dll代码：

library FormDLL;

uses
  SysUtils, Classes, Controls,
  FormInDll in 'FormInDll.pas' {frmFormInDll};

{$R *.RES}
exports
  Create_FormInDllAsChild,
  Free_FormInDllAsChild;
begin

end.

unit FormInDll;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TfrmFormInDll = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    {Private declarations }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Loaded; override;
  public
    {Public declarations }
  end;

var
  frmFormInDll: TfrmFormInDll = nil;

procedure Create_FormInDllAsChild(AParent: TWinControl);
procedure Free_FormInDllAsChild;

implementation

{$R *.DFM}

procedure Create_FormInDllAsChild(AParent: TWinControl);
begin
  if not Assigned(frmFormInDll) then
  begin
    frmFormInDll := TfrmFormInDll.CreateParented(AParent.Handle);
    frmFormInDll.Show;
  end;
end;

procedure Free_FormInDllAsChild;
begin
  if Assigned(frmFormInDll) then
  begin
    frmFormInDll.Release;
    frmFormInDll := nil;
  end;
end;

procedure TfrmFormInDll.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_CHILD;
end;
  (*----------------------------------------------------------------------------------*)

procedure TfrmFormInDll.Loaded;
begin
  inherited;
  Align := alClient;
  BorderStyle := bsNone;
  BorderIcons := [];
  Position := poDefault;
end;
  (*----------------------------------------------------------------------------------*)

procedure TfrmFormInDll.Button1Click(Sender: TObject);
begin
  ShowMessage('是我啊');
end;

end.

 

调用DLL程序代码：
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
     { Private  declarations}
  public
     {Public declarations}
  end;

var
  Form1: TForm1;

implementation

{$R   *.DFM}

procedure Create_FormInDllAsChild(AParent: TWinControl); external 'FormDLL.dll';
procedure Free_FormInDllAsChild; external 'FormDLL.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
  Create_FormInDllAsChild(Panel1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Free_FormInDllAsChild;
end;

end.

 

5、国际化问题

GetText是比较完善地国际化I18N解决方案

Gettext (0.13.1): 
ftp://ftp.gnu.org/gnu/gettext/

http://man.chinaunix.net/linux/lfs/htmlbook/appendixa/gettext.html

delphi实现： http://sourceforge.net/projects/dxgettext/

6、Never-build package 'AAAAA' requires always-build package 'BBBB'

提示我们需要直接编译包‘BBBB',

需要将BBBB这个bpl包重新编译， 选择project option;
然后选择Explicit rebuild; 重新编译一下。  

7、解决文件型数据库互锁问题

多个程序同时读取一个文件型数据库时，经常遇到库互锁问题，如mdb库、sqlite库等

解决这个问题除了用数据库本身提供的解决互锁的方法，

另外一个好的解决方法，采用进程间通信的方式，相互通知自己是否在操作库。

 

8、SQL Server  错误

1069：是由于SQL Server登录失败引起的。

http://www.webym.cn/blog/article.asp?id=289

17052: http://support.microsoft.com/kb/314947

http://www.sb123.org/736

9、判断字符串是不是全是数字或字符

function IsNumberic(Vaule: string): Boolean; //判断Vaule是不是数字
var
  i: integer;
begin
  result := true; //设置返回值为 是（真）
  Vaule := trim(Vaule); //去空格
  for i := 1 to length(Vaule) do //准备循环
  begin
    if not (Vaule[i] in ['0'..'9']) then //如果Vaule的第i个字不是0-9中的任一个
    begin
      result := false; //返回值 不是（假）
      exit; //退出函数
    end;
  end;
end;

function IsEnCase(Vaule: string): boolean; //判断Vaule 是不是字母
var
  i: integer;
begin
  result := true; //设置返回值为 是
  Vaule := trim(Vaule); //去空格
  for i := 1 to length(Vaule) do //准备循环
  begin
    if (not (Vaule[i] in ['A'..'Z'])) and (not (Vaule[i] in ['a'..'z'])) then //如果Vaule的第i个字不是A-Z或者a-z中的任一个
    begin
      result := false; //返回值 不是
      exit; //退出函数
    end;
  end;
end;

10、让输入框只能输入数字

procedure KeyPress(Sender: TObject; var Key: Char);

begin

  if not (key in ['0'..'9',#13,#8 ，#46]) then
  key := #0;
end;

11、注册一个新的文件类型

{-------------------------------------------------------------------------------
  过程名:    CreateNewExt
  参数:      FileExt, Filetype, FileDescription, MIMEType, ExecName: string
  返回值:    Boolean
  说明:      注册一个新的文件类型
-------------------------------------------------------------------------------}
function CreateNewExt(FileExt, Filetype, FileDescription, MIMEType, ExecName: string): Boolean;
var
  Reg: TRegistry;
begin
  Result := False;
  if (FileExt = '') or (ExecName = '') then Exit; {如果文件类型为空或者没有定义执行程序就退出，FileExt必须带″.″，如.BMP}
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    if not Reg.OpenKey(FileExt, True) then Exit; {当不能正确找到或创建FileExt键时退出，这种情况一般是注册表有错误，以下同}
    Reg.WriteString('', FileType);
    if MIMEType <> '' then Reg.WriteString('Content Type', MIMEType);
    Reg.CloseKey;
    if not Reg.OpenKey(FileType, True) then Exit;
    Reg.WriteString('', FileDescription);
    if not Reg.OpenKey('shell\open\command', True) then Exit;
    Reg.WriteString('', ExecName);{执行程序一般都有参数，例如WinZip的“winzip32.exe ″％1″”，″％1″参数指ZIP文件的文件名。因此ExecName应视情况加入参数}
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
end;
12、转换一个字符串为数字

StrToIntDef(const S: string; const Default: Integer): Integer;

这个函数相对会比StrToInt好用。

13、根据名字操作控件

TGroupBox(FindComponent('grp1'));

即可对一个叫grp1的TGroupBox控件进行控件

14、ListView的行改变颜色

首先ListView的设置OwnerDraw为False

然后在OnCustomDrawItem中，添加代码：

if Item.Index mod 2 =0 then //这个条件可以根据实际需要改变

  Sender.Canvas.Brush.Color :=clSkyBlue

else

  Sender.Canvas.Brush.Color :=clWhite;

 

15、TStringList类哈希表操作
var
  List: TStringList;
begin
  List := TStringList.Create;

  List.Add('aaa=111');
  List.Add('bbb=222');
  List.Add('ccc=333');
  List.Add('ddd=444');

  ShowMessage(List.Names[1]);  //bbb
  ShowMessage(List.ValueFromIndex[1]);  //222
  ShowMessage(List.Values['bbb']);  //222

  //ValueFromIndex 可以赋值:
  List.ValueFromIndex[1] := '2';
  ShowMessage(List[1]);  //bbb=2

  //可以通过 Values 赋值:
  List.Values['bbb'] := '22';
  ShowMessage(List[1]);  //bbb=22

  List.Free;
end;
16、为自己创建的上下文菜单的菜单项添加图标

var
  pic : HBITMAP;
begin 

。。。。。。。。 
  //加入图标，只能是14×14的bitmap图片，101为rc资源文件中标识资源id
  pic := LoadImage(HInstance,MakeIntResource(101),IMAGE_BITMAP,0,0,LR_LOADMAP3DCOLORS);
  SetMenuItemBitmaps(Menu, idCmdFirst + idBackup, MF_BYCOMMAND ,pic,pic);
  Result := 1;

 

。。。。。
end;

待续。。。

来自东子哥的Blog