unitfrmmain.pas

《Delphi百例》源码?禗elphi百例》源码

unit unitFrmMain;
interface

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

const CPL_INIT = 1;
const CPL_GETCOUNT = 2;
const CPL_INQUIRE = 3;
const CPL_SELECT = 4;
const CPL_DBLCLK = 5;
const CPL_STOP = 6;
const CPL_EXIT = 7;
const CPL_NEWINQUIRE = 8;

type
  TfrmMain = class(TForm)
    btnOk: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  NEWCPLINFO = record // ncpli
    dwSize: Longword;
    dwFlags: Longword;
    dwHelpContext: Longword;
    lData: integer;
    hIcon: HICON;
    szName: array[0..31] of char;
    szInfo: array[0..63] of char;
    szHelpFile: array[0..127] of char;
  end;

type
  PNEWCPLINFO = ^NEWCPLINFO;

var
  frmMain: TfrmMain;
  MyIcon: TIcon;
  //处理各类消息
  function CPlApplet(hwndCPl: HWND; uMsg: word; lParam1: Longint; lParam2: Longint): Longint; stdcall;
  //填充NEWCPLINFO结构。
  function OnInquire(uAppNum: word; pInfo: PNEWCPLINFO): integer; stdcall;
  //显示对话框
  function OnDblclk(hwndCPl: HWND; uAppNum: word; lData: integer): integer; stdcall;

implementation

{$R *.DFM}
{$R icon.res} //其中 icon.res中包含了程序的图标

//处理各类消息

function CPlApplet(hwndCPl: HWND; uMsg: word; lParam1: Longint; lParam2: Longint): Longint; stdcall;
begin
  case uMsg of
    CPL_DBLCLK:
      OnDblclk(hwndCPl, lParam1, lParam2);
    CPL_EXIT:
      result := 0;
    CPL_GETCOUNT:
      result := 1;
    CPL_INIT:
      result := 1;
    CPL_NEWINQUIRE:
      OnInquire(lParam1, PNEWCPLINFO(lParam2));
    CPL_INQUIRE:
      result := 0; // not handled
    CPL_SELECT:
      result := 1;
    CPL_STOP:
      result := 1;
  else
    result := 0;
  end;
  result := 1;
end;

//填充NEWCPLINFO结构。

function OnInquire(uAppNum: word; pInfo: PNEWCPLINFO): integer; stdcall;
begin
  with pInfo^ do
  begin
    dwSize := sizeof(NEWCPLINFO);
    dwFlags := 0;
    dwHelpContext := 0;
    lData := 0;
    hIcon := loadicon(hinstance, 'icon');
    szName := 'DELPHI的控制面板程序';
    szInfo := '控制面板程序演示';
    szHelpFile := '';
  end;
  result := 0;
end;

//显示对话框

function OnDblclk(hwndCPl: HWND; uAppNum: word; lData: integer): integer; stdcall;
var
  frmMain: TfrmMain;
begin
  frmMain := TfrmMain.Create(Application);
  frmMain.ShowModal;
  result := 0;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  port: integer;
begin
  MyIcon := ticon.Create;
  MyIcon.Handle := loadicon(hinstance, 'icon');
  if (MyIcon.Handle = 0) then showmessage('error icon');
  icon := MyIcon;
end;

procedure TfrmMain.btnOkClick(Sender: TObject);
begin
  ShowMessage('这是一个用DELPHI编写的控制面板程序');
end;

end.