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


    下面以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(0, nil , EnableTouchscreenCallback);
    end;
    
    procedure TForm1.btnDisEnableTouchClick(Sender: TObject);
    var
      dwNumsOfDevices: Word;
    begin
      dwNumsOfDevices := EnumerateTouchInstance(0, 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 = 0 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(0, nil , EnableTouchscreenCallback);
    end;
    
    procedure TForm1.btnDisEnableTouchClick(Sender: TObject);
    var
      dwNumsOfDevices: Word;
    begin
      //使所有触摸设备不可触摸
      dwNumsOfDevices := EnumerateTouchInstance(0, 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(0)) + 'xtkutility.dll';
      loadDll(PChar(DllName));
    end;
    
    end.
     
  • 相关阅读:
    centos linux系统日常管理3 服务管理ntsysv,chkconfig,系统日志rsyslog,last ,lastb ,exec,xargs,dmesg,screen,nohup,curl,ping ,telnet,traceroute ,dig ,nc,nmap,host,nethogs,base64,jq 第十六节课
    centos Linux系统日常管理2 tcpdump,tshark,selinux,strings命令, iptables ,crontab,TCP,UDP,ICMP,FTP网络知识 第十五节课
    一个兼职DBA的数据库运维经验 小米科技 xx@xiaomi.com 2011
    centos Linux系统日常管理1 cpuinfo cpu核数 命令 w, vmstat, uptime ,top ,kill ,ps ,free,netstat ,sar, ulimit ,lsof ,pidof 第十四节课
    HTML5矢量实现文件上传进度条
    基于HTML5的WebGL呈现A星算法3D可视化
    基于HTML5的WebGL呈现A星算法的3D可视化
    基于HTML5的WebGL设计汉诺塔3D游戏
    基于HTML5树组件延迟加载技术实现
    基于HTML5的WebGL电信网管3D机房监控应用
  • 原文地址:https://www.cnblogs.com/tc310/p/4680693.html
Copyright © 2020-2023  润新知