UseDynaF.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:2k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit UseDynaF;
  2. interface
  3. uses
  4.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  5.   Forms, Dialogs, StdCtrls;
  6. type
  7.   TForm1 = class(TForm)
  8.     BtnChange: TButton;
  9.     BtnSelect: TButton;
  10.     BtnApp: TButton;
  11.     procedure BtnChangeClick(Sender: TObject);
  12.     procedure BtnSelectClick(Sender: TObject);
  13.     procedure BtnAppClick(Sender: TObject);
  14.     procedure FormCreate(Sender: TObject);
  15.     procedure FormDestroy(Sender: TObject);
  16.   private
  17.     hInstDLL: THandle;
  18.   end;
  19. var
  20.   Form1: TForm1;
  21. implementation
  22. {$R *.DFM}
  23. type
  24.   TGetColorProc = function (Col: LongInt): LongInt; stdcall;
  25.   TShowColorProc = procedure (Col: LongInt); stdcall;
  26. procedure TForm1.BtnChangeClick(Sender: TObject);
  27. var
  28.   Col: LongInt;
  29.   GetColorProc: TGetColorProc;
  30.   FPointer: TFarProc;
  31. begin
  32.   FPointer := GetProcAddress (hInstDll, 'GetColor');
  33.   if FPointer = nil then
  34.     raise Exception.Create ('GetColor DLL function not found');
  35.   GetColorProc := TGetColorProc (FPointer);
  36.   // original code
  37.   Col := ColorToRGB (Color);
  38.   Color := GetColorProc (Col);
  39. end;
  40. procedure TForm1.BtnSelectClick(Sender: TObject);
  41. var
  42.   Col: LongInt;
  43.   ShowColorProc: TShowColorProc;
  44.   FPointer: TFarProc;
  45. begin
  46.   FPointer := GetProcAddress (hInstDll, 'ShowColor');
  47.   if FPointer = nil then
  48.     raise Exception.Create ('GetColor DLL function not found');
  49.   ShowColorProc := TShowColorProc (FPointer);
  50.   // original code
  51.   Col := ColorToRGB (Color);
  52.   ShowColorProc (Col);
  53. end;
  54. procedure TForm1.BtnAppClick(Sender: TObject);
  55. begin
  56.   ShowMessage ('Application Handle: ' +
  57.     IntToStr (Application.Handle));
  58. end;
  59. procedure TForm1.FormCreate(Sender: TObject);
  60. begin
  61.   hInstDll := SafeLoadLibrary ('FormDllD.dll');
  62.   if hInstDll <= 0 then
  63.     raise Exception.Create ('FormDllD library not found');
  64. end;
  65. procedure TForm1.FormDestroy(Sender: TObject);
  66. begin
  67.   if hInstDLL > 0 then
  68.     FreeLibrary (hInstDLL);
  69. end;
  70. end.