Project USEDYNA
Project Structure
USEDYNA.DPR
program UseDyna;
uses
Forms,
UseDynaF in 'UseDynaF.pas' {Form1};
{$R *.RES}
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
USEDYNAF.PAS
unit UseDynaF;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
BtnChange: TButton;
BtnSelect: TButton;
BtnApp: TButton;
procedure BtnChangeClick(Sender: TObject);
procedure BtnSelectClick(Sender: TObject);
procedure BtnAppClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
hInstDLL: THandle;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
TGetColorProc = function (Col: LongInt): LongInt; stdcall;
TShowColorProc = procedure (Col: LongInt); stdcall;
procedure TForm1.BtnChangeClick(Sender: TObject);
var
Col: LongInt;
GetColorProc: TGetColorProc;
FPointer: TFarProc;
begin
FPointer := GetProcAddress (hInstDll, 'GetColor');
if FPointer = nil then
raise Exception.Create ('GetColor DLL function not found');
GetColorProc := TGetColorProc (FPointer);
// original code
Col := ColorToRGB (Color);
Color := GetColorProc (Col);
end;
procedure TForm1.BtnSelectClick(Sender: TObject);
var
Col: LongInt;
ShowColorProc: TShowColorProc;
FPointer: TFarProc;
begin
FPointer := GetProcAddress (hInstDll, 'ShowColor');
if FPointer = nil then
raise Exception.Create ('GetColor DLL function not found');
ShowColorProc := TShowColorProc (FPointer);
// original code
Col := ColorToRGB (Color);
ShowColorProc (Col);
end;
procedure TForm1.BtnAppClick(Sender: TObject);
begin
ShowMessage ('Application Handle: ' +
IntToStr (Application.Handle));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
hInstDll := LoadLibrary ('FormDllD.dll');
if hInstDll <= 0 then
raise Exception.Create ('FormDllD library not found');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if hInstDLL > 0 then
FreeLibrary (hInstDLL);
end;
end.
USEDYNAF.DFM
object Form1: TForm1
Left = 226
Top = 129
Width = 193
Height = 221
Caption = 'Test Form DLL'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object BtnChange: TButton
Left = 40
Top = 34
Width = 105
Height = 33
Caption = 'Change Color'
TabOrder = 0
OnClick = BtnChangeClick
end
object BtnSelect: TButton
Left = 40
Top = 88
Width = 105
Height = 33
Caption = 'Select Color'
TabOrder = 1
OnClick = BtnSelectClick
end
object BtnApp: TButton
Left = 40
Top = 136
Width = 105
Height = 33
Caption = 'Application'
TabOrder = 2
OnClick = BtnAppClick
end
end
|