Delphi

delphi教程,涵盖了delphi 7到delphi xe各版本,其中作者经常使用delphi xe4和delphi xe7

Delphi MessageBox

MessageBox对话框是比较常用的一个信息对话框,其不仅能够定义显示的信息内容、信息提示图标,而且可以定义按钮组合及对话框的标题,是一个功能齐全的信息对话框信息提示图标,而且可以定义按钮组合及对话框的标题,是一个功能齐全的信息对框。
 1、函数原型及参数
 function MessageBox(hWnd: HWND; Text, Caption: PChar; Type: Word): Integer;
 hWnd:对话框父窗口句柄,对话框显示在Delphi窗体内,可使用窗体的Handle属性,否则可用0,使其直接作为桌面窗口的子窗口。
 Text:欲显示的信息字符串。
 Caption:对话框标题字符串。
 Type:对话框类型常量。
 该函数的返回值为整数,用于对话框按钮的识别。
 2、类型常量
 对话框的类型常量可由按钮组合、缺省按钮、显示图标、运行模式四种常量组合而成。
 (1)按钮组合常量
 MB_OK = $00000000;         //一个确定按钮
 MB_OKCANCEL = $00000001;      //一个确定按钮,一个取消按钮
 MB_ABORTRETRYIGNORE = $00000002;  //一个异常终止按钮,一个重试按钮,一个忽略按钮
 MB_YESNOCANCEL = $00000003;     //一个是按钮,一个否按钮,一个取消按钮
 MB_YESNO = $00000004;        //一个是按钮,一个否按钮
 MB_RETRYCANCEL = $00000005;     //一个重试按钮,一个取消按钮
 (2)缺省按钮常量
 MB_DEFBUTTON1 = $00000000;     //第一个按钮为缺省按钮
 MB_DEFBUTTON2 = $00000100;     //第二个按钮为缺省按钮
 MB_DEFBUTTON3 = $00000200;     //第三个按钮为缺省按钮
 MB_DEFBUTTON4 = $00000300;     //第四个按钮为缺省按钮
 (3)图标常量
 MB_ICONHAND = $00000010;        //“×”号图标
 MB_ICONQUESTION = $00000020;      //“?”号图标
 MB_ICONEXCLAMATION = $00000030;    //“!”号图标
 MB_ICONASTERISK = $00000040;      //“i”图标
 MB_USERICON = $00000080;        //用户图标
 MB_ICONWARNING = MB_ICONEXCLAMATION;  //“!”号图标
 MB_IConERROR = MB_ICONHAND;      //“×”号图标
 MB_ICONINFORMATION = MB_ICONASTERISK; //“i”图标
 MB_ICONSTOP = MB_ICONHAND;       //“×”号图标
 (4)运行模式常量
 MB_APPLMODAL = $00000000;    //应用程序模式,在未结束对话框前也能切换到另一应用程序
 MB_SYSTEMMODAL = $00001000;   //系统模式,必须结束对话框后,才能做其他操作
 MB_TASKMODAL = $00002000;    //任务模式,在未结束对话框前也能切换到另一应用程序
 MB_HELP = $00004000;       //Help Button
 3、函数返回值
 0            //对话框建立失败
 idOk = 1        //按确定按钮
 idCancel = 2      //按取消按钮
 idAbout = 3       //按异常终止按钮
 idRetry = 4       //按重试按钮
 idIgnore = 5      //按忽略按钮
 idYes = 6        //按是按钮
 idNo = 7        //按否按钮

例子:messagebox(0,'没有选择播放类型','错误',MB_ICONEXCLAMATION );

–Application.MessageBox('MessageBox','警告',MB_ICONWARNING+MB_YesNo);
–MessageBox(Form1.Handle,'MessageBox','提示',MB_ICONINFORMATION+MB_OkCancel);
–MessageBox(Form1.Handle,'MessageBox','提示‘,MB_ICONINFORMATION+MB_OkCancel+MB_DEFBUTTON2);
— if MessageBox(Form1.Handle,'MessageBox','提示',MB_ICONINFORMATION+MB_OkCancel)= idOk then
     begin
       ShowMessage('Ok');
     end;

 ————————————————————————–

MessageDlg用法

messageDlg, 是在对话框显示消息,并等待用户点击一个按钮,然后返回一个整数确定知道是那个按钮.
原型:MessageDlg(const Msg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer

Msg:想要提示的文字
DlgType:对话框的类型
Buttons:对话框中的按钮
HelpCtx:定义对话框的帮助屏幕,使用HelpCtx参数可以指定当用户单击Help按钮或按F1键所弹出的帮助主题的帮助上下文ID,一般也用不上,用0,表示帮助主题为空。

对话框类型:
mtwarning——含有感叹号的警告对话框
mterror——含有红色叉符号的错误对话框
mtinformation——含有蓝色i符号的信息对话框
mtconfirmation——含有绿色问号的确认对话框
mtcustom——不含图标的一般对话框,对话框的标题是程序的名称

按钮组中的按钮:
mbYes——mrYes或6
mbNo——mrNo或7
mbOk——mrOk或1
mbCancel——mrCancel或2
mbHelp——help按钮
mbAbort——mrAbort或3
mbRetry——mrRetry或4
mbIgnore——mrIgnore或5
mbAll——mrAll或8
mbNoToAll——9
mbYesToAll——10

举例:
procedure TForm1.Button1Click(Sender: TObject);
begin
  Messagedlg('你确定吗',mtWarning,[mbYES,mbNO],0);
   MessageDlg('错误(1001)',mtError,[mbCancel],0);
end;

MessageDlg()信息的汉化

Delphi中的常量都放在consts.pas中,修改它可以达到汉化的目的.如:
MessageDlg()显示的窗口标题及其中的
按钮标题都是英文,虽然不影响使用,但在一个中文软件中总显得有些不协调.
为此在consts.pas中查找以下内容:
"SMsgDlgWarning"

SMsgDlgWarning = 'Warning';
SMsgDlgError = 'Error';
SMsgDlgInformation = 'Information';
SMsgDlgConfirm = 'Confirm';
SMsgDlgYes = '&Yes';
SMsgDlgNo = '&No';
SMsgDlgOK = 'OK';
SMsgDlgCancel = 'Cancel';
SMsgDlgHelp = '&Help';
SMsgDlgHelpNone = 'No help available';
SMsgDlgHelpHelp = 'Help';
SMsgDlgAbort = '&Abort';
SMsgDlgRetry = '&Retry';
SMsgDlgIgnore = '&Ignore';
SMsgDlgAll = '&All';
SMsgDlgNoToAll = 'N&o to All';
SMsgDlgYesToAll = 'Yes to &All';
改成
SMsgDlgWarning = '警告';
SMsgDlgError = '错误';
SMsgDlgInformation = '提示';
SMsgDlgConfirm = '确认';
SMsgDlgYes = '是(&Y)';
SMsgDlgNo = '不(&N)';
SMsgDlgOK = '确定';
SMsgDlgCancel = '取消';
SMsgDlgHelp = '帮助(&H)';
SMsgDlgHelpNone = '没有该帮助信息';
SMsgDlgHelpHelp = '帮助';
SMsgDlgAbort = '放弃(&A)';
SMsgDlgRetry = '重试(&R)';
SMsgDlgIgnore = '忽略(&I)';
SMsgDlgAll = '全部(&A)';
SMsgDlgNoToAll = '全都不(&O)';
SMsgDlgYesToAll = '全都是(&A)';
然后重新编译Consts.pas,把Consts.dcu
拷到delphi的lib和slib子目录下,就OK啦!

Delphi 遍历控件 遍历组件

特别在动态创建控件时,有时经常需要遍历控件。

如果知道控件名称,则可以通过FindComponent – 查找(定位)组件,如果不知道的话,只能遍历控件了。

遍历一个Panel上的所有控件:

Var
	i: integer;
begin
	for i:=0 to Panel1.ControlCount do
		begin
			// 控件: Panel1.Controls[i]
			// 自己的业务逻辑代码
		end;
end;

以下是根据控件的某个属性来定位,并且批量修改属性

var
  I:integer;
begin
  for i:=0 to Self.Componentcount-1 do//Self.Componentcount就是TForm1的控件数量
    begin
      if Self.Components[i] is TRzEdit then   //判断控件是否为TRzEdit
        begin
          if (Self.Components[i] as TRzEdit).Text='' then CWMsg.M(Self.Components[i].Name);
        end;
    end;
end;

关于已知控件名称的话,则建议使用FindComponent

Delphi StringReplace – 替换字符函数

Delphi中的StringReplace函数是SysUtils单元中自带的函数,该函数可以替换字符串中的指定字符。

function StringReplace (const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;

// rfReplaceAll:全部替换
// rfIgnoreCase:忽略大小写

// For Example:

var
    aStr: String;
begin
    aStr := 'This is a book, not a pen!';
    ShowMessage(StringReplace (aStr, 'a', 'two', []));//This is two book, not a pen!只替换了第一个符合的字
    ShowMessage(StringReplace (aStr, 'a', 'two', [rfReplaceAll]));//This is two book, not two pen!替换了所有符合的字
    aStr := 'This is a book, not A pen!';
    ShowMessage(StringReplace (aStr, 'a', 'two', [rfReplaceAll]));//This is two book, not A pen!只替换了符合的字(小写a)
    ShowMessage(StringReplace (aStr, 'a', 'two', [rfReplaceAll, rfIgnoreCase]));//This is two book, not two pen!不管大小写替换了所有符合的字
end;
内存释放 内存泄漏

Delphi Create(nil), Create(self), Create(Application)的区别

最近的项目中经常在程序中动态创建控件,势必用到Create。

但是随之而来的问题就是动态创建的控件是否可以正确的释放内存?

以及 Create(nil), Create(self), Create(Application)的区别又是什么呢?

Create(nil);//需要自己释放
   
Create(Self);//当Self释放时自动触发释放

Create(Application);//当Application释放时自动释放

Create(nil);//这种方式创建的对象要自己手工进行FREE才会回收内存
//其他很多内存泄漏就是忘了手工释放内存

Create(Self);//由self对象负责释放创建的对象,只要self没有释放掉
//这个对象的内存就不会被释入掉,除程序员手工进行释放,他会触发很多事件。
//性能不是很好

Create(Application);
Create(Application.owner); //这两就是把self具体对象罢了

memory_overflow

Delphi 截屏控件

unit ALScreenSnap;
   interface
   uses
     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     ShellAPI;
   type
     TALScreenSnap = class(TComponent)
     private
       OldWndProc, NewWndProc: Pointer;
       fActive: Boolean;
       fThreshold: Integer;
       procedure NewWndMethod(var Msg: TMessage);
     public
       constructor Create(AOwner: TComponent); override;
       destructor Destroy; override;
     published
       property Active: Boolean    read fActive    write fActive    default True;
       property Threshold: Integer read fThreshold write fThreshold default 30;
     end;
   procedure Register;
   implementation
   begin
     RegisterComponents('ALComps', [TALScreenSnap]);
   end;
   { TALScreenSnap }
   constructor TALScreenSnap.Create(AOwner: TComponent);
   var
     i: Integer;
     // Only allow one instance per form
     for i := 0 to AOwner.ComponentCount-1 do
       if AOwner.Components[i] is TALScreenSnap then
         raise Exception.Create('TALScreenSnap component cannot be duplicated in ' + AOwner.Name);
     inherited;
     // Check if the owner is a form
     if (Owner = nil) or not(AOwner is TForm) then
       raise Exception.Create('Owner of TALScreenSnap component must be a form');
     // Form subclassing
     if not(csDesigning in ComponentState) then
     begin
       NewWndProc := MakeObjectInstance(NewWndMethod);
       OldWndProc := Pointer(SetWindowLong(TForm(Owner).Handle, gwl_WndProc, Longint(NewWndProc)));
     end
     else
       NewWndProc := nil;
       OldWndProc := nil;
     fActive := True;
     fThreshold := 30;
   destructor TALScreenSnap.Destroy;
     if Assigned(NewWndProc) then
       FreeObjectInstance(NewWndProc);
   procedure TALScreenSnap.NewWndMethod(var Msg: TMessage);
     Pabd: AppBarData;
     ScreenWidth, ScreenHeight: Integer;
     ScreenRect, TaskBarRect: TRect;
     if (Msg.Msg = WM_EXITSIZEMOVE) and Active then
       Pabd.cbSize := SizeOf(APPBARDATA);
       SHAppBarMessage(ABM_GETTASKBARPOS, Pabd);
       TaskBarRect := Pabd.rc;
       ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
       ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
       ScreenRect := Rect(0, 0, ScreenWidth, ScreenHeight);
       if (TaskBarRect.Left < 1) and (TaskBarRect.Bottom >= ScreenHeight) and (TaskBarRect.Right >= ScreenWidth) then
         // Bottom
         ScreenRect.Bottom := TaskBarRect.Top
       else if (TaskBarRect.Top < 1) and (TaskBarRect.Left < 1) and (TaskBarRect.Right >= ScreenWidth) then
         // Top
         ScreenRect.Top := TaskBarRect.Bottom
       else if (TaskBarRect.Left < 1) and (TaskBarRect.Top < 1) and (TaskBarRect.Bottom >= ScreenHeight) then
         // Left
         ScreenRect.Left := TaskBarRect.Right
       else if (TaskBarRect.Right >= ScreenWidth) and (TaskBarRect.Top < 1) and (TaskBarRect.Bottom >= ScreenHeight) then
         // Right
         ScreenRect.Right := TaskBarRect.Left;
       // Position form
       if TForm(Owner).Left < ScreenRect.Left + fThreshold then
         TForm(Owner).Left := ScreenRect.Left;
       if TForm(Owner).Top < ScreenRect.Top + fThreshold then
         TForm(Owner).Top := ScreenRect.Top;
       if TForm(Owner).Left+TForm(Owner).Width > ScreenRect.Right-fThreshold then
         TForm(Owner).Left := ScreenRect.Right-TForm(Owner).Width;
       if TForm(Owner).Top+TForm(Owner).Height > ScreenRect.Bottom-fThreshold then
         TForm(Owner).Top := ScreenRect.Bottom-TForm(Owner).Height;
     Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg, Msg.WParam, Msg.LParam);
   end.

 

delphi发送邮件

Delphi 发送邮件 通过Office Outlook

网上搜到的Delphi邮件发送系统,绝大多数是使用SMTP协议来发送。

但是事实上它们已经过时了,大多数邮件服务器已经屏蔽了Delphi Indy的邮件发送,从而导致Delphi发送不成功。

事实上,让Delphi通过Outlook.Application来发送邮件,也是非常方便的,而且没有那么多的限制。

以下是我目前使用的,我把它写成了个函数,使用的时候调用一下即可。

不过,使用的前提是,你得现在在本地Outlook上配置好一个账户。

procedure TForm1.SendOutlookMail(const Recipient,Title,Body,Attachment:string);
    const
       olMailItem = 0;
    var
       Outlook: OleVariant;
       vMailItem: variant;
    begin
       try
          Outlook := GetActiveOleObject("Outlook.Application");
       except
          Outlook := CreateOleObject("Outlook.Application");
       end;
       vMailItem := Outlook.CreateItem(olMailItem);
       vMailItem.Recipients.Add(Recipient);
       vMailItem.Subject := Title;
       vMailItem.Body := Body;
       if Attachment &lt;&gt;"" then vMailItem.Attachments.Add(Attachment);
       vMailItem.Send;
       VarClear(Outlook);

delphi发送邮件

Delphi TreeView – 自动给标题上加图片

当处理完TreeView控件树形结构的数据后,根据不同的树形节点Level,加上不同的图片。

图片的ImageList已经放置好,并且TreeView的Images已经连上带有图片的ImageList。

RTV-Images

除了手动添加图片外,还可以通过代码,根据判断不同Level来批量添加图片,实现代码增加在TreeView的 GetImageIndex 事件中。

recommand

procedure Tfrm_main.RzTreeView1GetImageIndex(Sender: TObject; Node: TTreeNode);
begin
  if Node.HasChildren then
  begin
    if Node.Level = 0 then Node.ImageIndex := 9 else Node.ImageIndex := 66;
  end
  else Node.ImageIndex := 24;
  Node.SelectedIndex := Node.ImageIndex;
end;

 

cxGrid 显示行号及行号列列名

cxGrid默认不显示行号,但是可以通过cxGrid1DBTableView1CustomDrawIndicatorCell事件来重绘行号

选中cxGrid1DBTableView1,在OnCustomDrawIndicatorCell事件中,输入以下代码:

procedure TForm1.cxGrid1DBTableView1CustomDrawIndicatorCell(
  Sender: TcxGridTableView; ACanvas: TcxCanvas;
  AViewInfo: TcxCustomGridIndicatorItemViewInfo; var ADone: Boolean);
begin
  SetRowNumber(Sender, AviewInfo, ACanvas, ADone);//调用SetRowNumber函数,函数声明及实现见后
end;

SetRowNumber函数声明(注意函数声明的摆放位置,此处不在Form内):

procedure SetRowNumber(var Sender: TcxGridTableView; var AViewInfo: TcxCustomGridIndicatorItemViewInfo;
  ACanvas: TcxCanvas; var ADone: boolean);

SetRowNumber函数实现代码:

procedure SetRowNumber(var Sender: TcxGridTableView; var AViewInfo: TcxCustomGridIndicatorItemViewInfo;
  ACanvas: TcxCanvas; var ADone: boolean);
var
  AIndicatorViewInfo: TcxGridIndicatorRowItemViewInfo;
  ATextRect: TRect;
  AFont: TFont;
  AFontTextColor, AColor: TColor;
  procedure DrawIndicatorImage(ACanvas: TcxCanvas;
    const R: TRect; AKind: TcxIndicatorKind);
  var
    X, Y: Integer;
  begin
    if AKind = ikNone then Exit;
    X := (R.Left + R.Right - cxLookAndFeelPainters.cxIndicatorImages.Width);
    Y := (R.Top + R.Bottom - cxLookAndFeelPainters.cxIndicatorImages.Height) div 2;
    cxLookAndFeelPainters.cxIndicatorImages.Draw(ACanvas.Canvas, X, Y, Ord(AKind) - 1);
  end;
begin
  try
    AFont := ACanvas.Font;
    AColor := clBtnFace;
    AFontTextColor := clWindowText;
    if (AViewInfo is TcxGridIndicatorHeaderItemViewInfo) then begin
      ATextRect := AViewInfo.Bounds;
      InflateRect(ATextRect, -1, -1);
      Sender.LookAndFeelPainter.DrawHeader(ACanvas, AViewInfo.Bounds,
        ATextRect, [], cxBordersAll, cxbsNormal, taCenter, TcxAlignmentVert.vaCenter,
        False, False, '序号', AFont, AFontTextColor, AColor);
      ADone := True;
    end;
    if not (AViewInfo is TcxGridIndicatorRowItemViewInfo) then
      Exit;
    ATextRect := AViewInfo.ContentBounds;
    AIndicatorViewInfo := AViewInfo as TcxGridIndicatorRowItemViewInfo;
    InflateRect(ATextRect, -1, -1);
    if Sender.DataController.RecordCount > 0 then begin
      if AIndicatorViewInfo.GridRecord.Selected then
        AFontTextColor := clRed
      else
        AFontTextColor := clWindowText;
    end;
    Sender.LookAndFeelPainter.DrawHeader(ACanvas, AViewInfo.ContentBounds,
      ATextRect, [], [bBottom, bLeft, bRight], cxbsNormal, taCenter, TcxAlignmentVert.vaCenter,
      False, False, IntToStr(AIndicatorViewInfo.GridRecord.Index + 1),
      AFont, AFontTextColor, AColor);
    ADone := True;
  except
  end;
  DrawIndicatorImage(ACanvas, ATextRect, AIndicatorViewInfo.IndicatorKind);
end;

最后将cxGrid1DBTableView1中的OptionView中的Indicator设为True, IndicatorWidth设为适合值即可。

recommand

cxgrid_indicator_preview

FindComponent

Delphi FindComponent – 查找(定位)组件

根据组件名称,来定位到组件,并且更改组件属性

主要用到Delphi FindComponent 函数

//循环将RzBackground1 - #12的图片改为Sample中的图片
  for I := 1 to 12 do
    begin
        TRzBackground(FindComponent('RzBackground'+IntToStr(I))).Texture := RzBackground_Sample.Texture;
    end;

//将组件名为ComponentName的标签名改为DM.Cdstmp数据集中的CNAME字符
TLabel(FindComponent(ComponentName)).Caption := DM.Cdstmp.FieldByName('CNAME').AsString;

//将组件名为ComponentName的标签颜色改为红色
TLabel(FindComponent(ComponentName)).Font.Color := clRed;

recommand

 

FindComponent

FindComponent