Delphi静态加载DLL和动态加载DLL示例

2023-12-22 18:00:57

下面以Delphi调用触摸屏动态库xtkutility.dll为例子，说明如何静态加载DLL和动态加载DLL.

直接上代码。

1、静态加载示例

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    btnEnableTouch: TButton;

    btnDisEnableTouch: TButton;

    Label1: TLabel;

    Memo1: TMemo;

    procedure btnEnableTouchClick(Sender: TObject);

    procedure btnDisEnableTouchClick(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

{ 声明一个回调函数类型 }

type

  XTOUCH_ENUM_CALLBACK_PROC = function(pContext:Pointer;szSymbloicName:PChar;nType:Word):Boolean;stdcall;

function EnumerateTouchInstance(hWnd:THandle;pContext:Pointer;pCallback:XTOUCH_ENUM_CALLBACK_PROC):DWORD;stdcall;external 'xtkutility.dll';

//功能：枚举系统中的所有触摸设备

function CreateDevice(szSymbolicName: PChar): THandle;stdcall;external 'xtkutility.dll';

//打开触摸设备

function CloseDevice(hFile: THandle): Boolean;stdcall;external 'xtkutility.dll';

//关闭触摸设备

procedure EnableTouch(hFile: THandle;bEnable: Boolean);stdcall;external 'xtkutility.dll';

//触摸控制 bEnable为true时允许触摸  bEnable为false时禁止触摸

function DisEnableTouchscreenCallback(pContext:Pointer;szSymbloicName:PChar;nType:Word): Boolean;stdcall;

//声明一个回调函数，禁止触摸所有触摸设备

function EnableTouchscreenCallback(pContext:Pointer;szSymbloicName:PChar;nType:Word): Boolean;stdcall;

//声明一个回调函数，允许触摸所有触摸设备

var

  Form1: TForm1;

implementation

{$R *.dfm}

function DisEnableTouchscreenCallback(pContext:Pointer;szSymbloicName:PChar;nType:Word): Boolean;stdcall;

var

  hDevice: THandle;

begin

  hDevice := CreateDevice(szSymbloicName);

  EnableTouch(hDevice,False);

  CloseDevice(hDevice);

  Result := True;

  //显示触摸设备标识符

  form1.Memo1.Clear;

  Form1.Memo1.Lines.Add(szSymbloicName);

end;

function EnableTouchscreenCallback(pContext:Pointer;szSymbloicName:PChar;nType:Word): Boolean;stdcall;

var

  hDevice: THandle;

begin

  hDevice := CreateDevice(szSymbloicName);

  EnableTouch(hDevice,True);

  CloseDevice(hDevice);

  Result := True;

  //显示触摸设备标识符

  form1.Memo1.Clear;

  Form1.Memo1.Lines.Add(szSymbloicName);

end;

procedure TForm1.btnEnableTouchClick(Sender: TObject);

var

  dwNumsOfDevices: Word;

begin

  dwNumsOfDevices := EnumerateTouchInstance(, nil , EnableTouchscreenCallback);

end;

procedure TForm1.btnDisEnableTouchClick(Sender: TObject);

var

  dwNumsOfDevices: Word;

begin

  dwNumsOfDevices := EnumerateTouchInstance(, nil , DisEnableTouchscreenCallback);

end;

end.

2、动态加载示例

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    btnEnableTouch: TButton;

    btnDisEnableTouch: TButton;

    Label1: TLabel;

    Memo1: TMemo;

    procedure btnEnableTouchClick(Sender: TObject);

    procedure btnDisEnableTouchClick(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure FormCreate(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

{ 声明一个回调函数类型 }

type

  XTOUCH_ENUM_CALLBACK_PROC = function(pContext:Pointer;szSymbloicName:PChar;nType:Word):Boolean;stdcall;   

  procedure loadDll(dllName: PChar);

  function DisEnableTouchscreenCallback(pContext:Pointer;szSymbloicName:PChar;nType:Word): Boolean;stdcall;

  //声明一个回调函数，禁止触摸所有触摸设备

  function EnableTouchscreenCallback(pContext:Pointer;szSymbloicName:PChar;nType:Word): Boolean;stdcall;

  //声明一个回调函数，允许触摸所有触摸设备

//动态调用dll

type

  TEnumerateTouchInstance = function(hWnd:THandle;pContext:Pointer;pCallback:XTOUCH_ENUM_CALLBACK_PROC):DWORD;stdcall;

  TCreateDevice = function(szSymbolicName: PChar): THandle;stdcall;

  TCloseDevice = function(hFile: THandle): Boolean;stdcall;

  TEnableTouch = procedure(hFile: THandle;bEnable: Boolean);stdcall;

var

  Form1: TForm1;

  DllHandle: THandle;

  EnumerateTouchInstance: TEnumerateTouchInstance;

  CreateDevice: TCreateDevice;

  CloseDevice: TCloseDevice;

  EnableTouch: TEnableTouch;

implementation

{$R *.dfm}

procedure loadDll(DllName: PChar);

begin

  try

    if FileExists(DllName) then

    begin

      DllHandle := LoadLibrary(DllName);

      if DllHandle =  then

      begin

        raise Exception.Create('加载dll文件：' + DllName + '失败！');

      end

      else

      begin

        EnumerateTouchInstance := GetProcAddress(DllHandle,PChar('EnumerateTouchInstance'));

        if @EnumerateTouchInstance = nil then

          raise Exception.Create('定义函数EnumerateTouchInstance失败！');

        CreateDevice := GetProcAddress(DllHandle,PChar('CreateDevice'));

        if @CreateDevice = nil then

          raise Exception.Create('定义函数CreateDevice失败！');

        CloseDevice := GetProcAddress(DllHandle,PChar('CloseDevice'));

        if @CloseDevice = nil then

          raise Exception.Create('定义函数CloseDevice失败！');

        EnableTouch := GetProcAddress(DllHandle,PChar('EnableTouch'));

        if @EnableTouch = nil then

          raise Exception.Create('定义函数EnableTouch失败！');

      end;

    end

    else

    begin

      ShowMessage(DllName + '不存在！');

    end;

  except

    on e: Exception do

    begin

      ShowMessage(e.Message);

    end;

  end;

end;

function DisEnableTouchscreenCallback(pContext:Pointer;szSymbloicName:PChar;nType:Word): Boolean;stdcall;

var

  hDevice: THandle;

begin

  hDevice := CreateDevice(szSymbloicName);

  EnableTouch(hDevice,False);

  CloseDevice(hDevice);

  Result := True;

  //显示触摸设备标识符

  form1.Memo1.Clear;

  Form1.Memo1.Lines.Add(szSymbloicName);

end;

function EnableTouchscreenCallback(pContext:Pointer;szSymbloicName:PChar;nType:Word): Boolean;stdcall;

var

  hDevice: THandle;

begin

  hDevice := CreateDevice(szSymbloicName);

  EnableTouch(hDevice,True);

  CloseDevice(hDevice);

  Result := True;

  //显示触摸设备标识符

  form1.Memo1.Clear;

  Form1.Memo1.Lines.Add(szSymbloicName);

end;

procedure TForm1.btnEnableTouchClick(Sender: TObject);

var

  dwNumsOfDevices: Word;

begin

  //使所有触摸设备可以触摸

  dwNumsOfDevices := EnumerateTouchInstance(, nil , EnableTouchscreenCallback);

end;

procedure TForm1.btnDisEnableTouchClick(Sender: TObject);

var

  dwNumsOfDevices: Word;

begin

  //使所有触摸设备不可触摸

  dwNumsOfDevices := EnumerateTouchInstance(, nil , DisEnableTouchscreenCallback);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  FreeLibrary(DllHandle);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

  DllName: string;

begin

  DllName := ExtractFilePath(ParamStr()) + 'xtkutility.dll';

  loadDll(PChar(DllName));

end;

end.

码农公寓

相关文章