Delphi封装Mdi窗体到Dll并使用插件管理,tabControl制作多页面

2024-01-25 13:58
文章标签 使用 dll 封装 页面 管理 制作 插件 delphi 窗体 tabcontrol mdi

本文主要是介绍Delphi封装Mdi窗体到Dll并使用插件管理,tabControl制作多页面，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！

源码下载地址


1.ShareMem的引用要放在各单元的第一位置,否则会报错

2.dll中mdi子窗体关闭时要,

     Action:=caFree;
    TestForm2:=nil;

3.




主窗体代码

unit MainUnit;interfaceusesShareMem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ComCtrls, Menus, ToolWin, RzTabs,StrUtils;typeTTestdllMdiFrom=Function(App:TApplication;mfrmHdl:THandle;Scr:TScreen;Owner_s:Tform):Tform;stdcall;TGetCaption = function: Pchar; StdCall;TGetFormGuid= function: Pchar; StdCall;EdllLoadError=class(Exception);TTestPlugIn=classcaption:string;//加载的getption返加地址Address:THandle;//存取加载的dll的地址call:Pointer;//存取ShowDllForm的句柄guid:string;//窗体的唯一标识end;TMainForm = class(TForm)MainSb: TStatusBar;MainMenu1: TMainMenu;N1: TMenuItem;N_Window: TMenuItem;testForm1: TMenuItem;N2: TMenuItem;N21: TMenuItem;CoolBar1: TCoolBar;ToolBar1: TToolBar;ToolButton3: TToolButton;ToolButton4: TToolButton;ToolButton5: TToolButton;MainTC: TRzTabControl;N_plugins: TMenuItem;procedure FormCreate(Sender: TObject);procedure MainTCChange(Sender: TObject);procedure MainTCClose(Sender: TObject; var AllowClose: Boolean);procedure FormDestroy(Sender: TObject);privateprocedure MainCopyDataMsg(Var Msg : TMessage); Message WM_COPYDATA; //用于进程 或dll中传递 消息publicprocedure tabControl_SelectedIndexChanged(sender:TObject);procedure TabControcl_ChangeTabPage(sender:TObject);procedure AdjustTabControl(Sender:TForm;   Delete:Boolean);procedure TabControl_DeleteTabFromCaption(sCaption:string);//窗体关闭时能过标题关闭窗体//---procedure LoadPlugIns;//加载插件到菜单procedure PlugInsClick(Sender: TObject); //插件菜单点击事件procedure FreePlugIns; //释放插件end;varMainForm: TMainForm;ShowDllFrom:TTestdllMdiFrom;  //声明接口函数数型Plugins:TList;//存放每个Dll加载后的相关信息StopSearch:Boolean;
//  function ShowDllForm( App:TApplication;Scr:TScreen;Owner_s:Tform): Boolean;stdcall; external 'TestDllFrm.dll';//为了简单，使用静态调用方法
implementation{$R *.dfm}
//
//查找文件，并存于Files中
procedure SearchFileExt(const Dir, Ext: string; Files: TStrings);
varFound: TSearchRec;Sub: string;i: Integer;Dirs: TStrings;Finished: Integer;
beginStopSearch := False;Dirs := TStringList.Create;Finished := FindFirst(Dir + '*.*', 63, Found);while (Finished = 0) and not (StopSearch) dobeginif (Found.Name[1] <> '.') thenbeginif (Found.Attr and faDirectory = faDirectory) thenDirs.Add(Dir + Found.Name) //Add to the directories list.elseif Pos(UpperCase(Ext), UpperCase(Found.Name)) > 0 thenFiles.Add(Dir + Found.Name);end;Finished := FindNext(Found);end;FindClose(Found);if not StopSearch thenfor i := 0 to Dirs.Count - 1 doSearchFileExt(Dirs[i], Ext, Files);Dirs.Free;
end;
//-----------------------------------------------------------------
procedure TMainForm.tabControl_SelectedIndexChanged(sender: TObject);
var i:Integer;
beginif   MainForm.MDIChildCount   >0 thenbeginfor i:=0 to MainForm.MDIChildCount-1 dobeginif  MainTC.TabIndex=i thenbeginMainForm.MDIChildren[i].ActiveMDIChild;end;end;  end;
end;procedure TMainForm.FormCreate(Sender: TObject);
beginif MainTC.Tabs.Count=0 thenMainTC.Height:=0elseMainTC.Height:=28;LoadPlugIns;end;procedure TMainForm.MainTCChange(Sender: TObject);
varTabCap:String;I:   Integer;Child:   TForm;
beginif MainTC.Tabs.Count=0 thenbeginMainTC.Height:=0;exit;endelseMainTC.Height:=28;TabCap:=MainTC.Tabs[MainTC.TabIndex].Caption;for   I   :=   MDIChildCount   -   1   downto   0   dobeginChild   :=   MDIChildren[I];if   Child.Caption   =     TabCap   thenChild.Show;end;MainSb.Panels[1].Text:=IntToStr(MainTC.TabIndex);end;procedure TMainForm.TabControcl_ChangeTabPage(sender: TObject);
var i:Integer;
beginif (Self.MDIChildCount>0) and (MainTC.TabIndex>-1) thenbeginfor i:=0 to Self.MDIChildCount-1 dobeginif MainTC.TabIndex=i thenbeginSelf.MDIChildren[i].WindowState:=wsMaximized;Self.MDIChildren[i].Visible:=True;Self.MDIChildren[i].ActiveMDIChild;endelsebeginif Self.MDIChildren[i].Visible thenSelf.MDIChildren[i].Visible:=False;end;  end;  end;  
end;procedure TMainForm.AdjustTabControl(Sender: TForm; Delete: Boolean);
varI:Integer;Found:Boolean;tmp_tab:TRzTabCollectionItem;
begin//查找Found   :=   False;for   I   :=   0   to   MainTC.Tabs.Count   -   1   dobeginif   Sender.Caption   =   MainTC.Tabs[i].Caption   thenbeginFound   :=   True;   //找到if   Delete   then   //删除MainTC.Tabs.Delete(I)else     //激活beginif   MainTC.TabIndex   <>   I   thenMainTC.TabIndex   :=   I;Sender.WindowState:=wsMaximized;  end;break;end;end;if   not   Found   then   //增加并激活begintmp_tab:=TRzTabCollectionItem.Create(MainTC.Tabs);tmp_tab.Caption:=Sender.Caption;tmp_tab.Hint:=IntToStr(Sender.Handle);MainTC.TabIndex   :=   MainTC.Tabs.Count   -   1;end;MainSb.Panels[3].Text :='handle:'+inttostr(MainForm.Handle);
end;procedure TMainForm.MainTCClose(Sender: TObject; var AllowClose: Boolean);
var i:Integer;tmpcaption:string;
begintmpcaption:=MainTC.Tabs.Items[MainTC.TabIndex].Caption   ;for i:=0 to MainForm.MDIChildCount-1 dobeginif MainForm.MDIChildren[i].Caption=  tmpcaption       thenMainForm.MDIChildren[i].Close;end;  
end;procedure TMainForm.MainCopyDataMsg(var Msg: TMessage);
var tmpstr:string;sHead:string;tmpCaption,TMP_frmGuid:string;cdds : TcopyDataStruct;
beginif msg.Msg = WM_COPYDATA thenbegincdds := PcopyDataStruct(Msg.LParam)^;tmpstr := (Pchar(cdds.lpData));sHead:=LeftStr(tmpstr,5);if sHead='XFRM:'  then  //X掉即关闭子窗体begintmpCaption:=RightStr(tmpstr,Length(tmpstr)-5);TabControl_DeleteTabFromCaption(tmpCaption)  ;end;if sHead='FUID:'  then  //根据guid freeFrombeginTMP_frmGuid:=RightStr(tmpstr,Length(tmpstr)-5);// FreePlugIns_fromCapiont(TMP_frmGuid);end;end;
end;procedure TMainForm.TabControl_DeleteTabFromCaption(sCaption:string);
varI:Integer;Found:Boolean;tmp_tab:TRzTabCollectionItem;
begin//查找Found   :=   False;for   I   :=   0   to   MainTC.Tabs.Count   -   1   dobeginif   sCaption   =   MainTC.Tabs[i].Caption   thenbeginFound   :=   True;   //找到MainTC.Tabs.Delete(i);break;end;end;end;procedure TMainForm.LoadPlugIns;
varFiles: TStrings;i: Integer;TestPlugIn: TTestPlugIn;NewMenu: TMenuItem;GetCaption: TGetCaption;fm:TTestdllMdiFrom;GetFormGuid:TGetFormGuid;
beginFiles := TStringList.Create;Plugins := TList.Create;//查找指定目录下的.dll文件，并存于Files对象中SearchFileExt(ExtractFilepath(Application.Exename), '.dll', Files);//加载查找到的DLLfor i := 0 to Files.Count - 1 dobeginTestPlugIn := TTestPlugIn.Create;TestPlugIn.Address := LoadLibrary(PChar(Files[i]));if TestPlugIn.Address = 0 thenraise EDLLLoadError.Create('装载' + PChar(Files[i]) + '失败');try@GetCaption := GetProcAddress(TestPlugIn.Address, 'GetCaption');TestPlugIn.Caption := GetCaption;@fm:=GetProcAddress(TestPlugIn.Address, 'ShowDllForm');TestPlugIn.call:=@fm   ;@GetFormGuid:=GetProcAddress(TestPlugIn.Address,'GetFormGuid') ;TestPlugIn.guid:=GetFormGuid;PlugIns.Add(TestPlugIn);//创建菜单，并将菜单标题，Onclick事件赋值NewMenu := TMenuItem.Create(Self);NewMenu.Caption := TestPlugIn.Caption;NewMenu.OnClick := PlugInsClick;NewMenu.Tag := i;N_plugins.Add(NewMenu); //每次在菜单下新增一个模块菜单exceptraise EDLLLoadError.Create('初始化失败');end;end;Files.Free;
end;procedure TMainForm.FreePlugIns;
vari: Integer;tmpHandl:THandle;
begin//将加载的插件全部释放for i := 0 to PlugIns.Count - 1 dobegintmpHandl:=TTestPlugIn(PlugIns[i]).Address;if tmpHandl<>0 thenFreeLibrary(tmpHandl);end;//释放plugIns对象PlugIns.Free;
end;procedure TMainForm.PlugInsClick(Sender: TObject);
var tmpform:TForm;
tmp_swFrom:TTestdllMdiFrom;
i:Integer;
unit TestUnit;interfaceusesShareMem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;typeTTestForm = class(TForm)Memo1: TMemo;Button1: TButton;procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure Button1Click(Sender: TObject);procedure FormCreate(Sender: TObject);privateprocedure SendKeys(sSend:string);procedure SendParmKeys(sSend:string);//发送运行参数publicend;varTestForm: TTestForm;implementationuses myUnit;{$R *.dfm}procedure TTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
beginSendParmKeys('XFRM:'+self.Caption);SendParmKeys('FUID:'+frm_guid);Action:=caFree;TestForm:=nil;
end;procedure TTestForm.Button1Click(Sender: TObject);
beginSendParmKeys(frm_guid);
end;
procedure TTestForm.SendKeys(sSend:string);
vari:integer;focushld,windowhld:hwnd;threadld:dword;ch: byte;
beginwindowhld:=GetForegroundWindow;//获得前台应用程序的活动窗口的句柄threadld:=GetWindowThreadProcessId(Windowhld,nil);//获取与指定窗口关联在一起的一个进程和线程标识符AttachThreadInput(GetCurrentThreadId,threadld,true);//通常，系统内的每个线程都有自己的输入队列。            ////AttachThreadInput允许线程和进程共享输入队列。         ////连接了线程后，输入焦点、窗口激活、鼠标捕获、键盘状态 ////以及输入队列状态都会进入共享状态                      //Focushld:=getfocus;//获得拥有输入焦点的窗口的句柄AttachThreadInput(GetCurrentThreadId,threadld,false);if focushld = 0 then Exit;//如果没有输入焦点则退出发送过程i := 1;while i <= Length(sSend) do//该过程发送指定字符串（中英文皆可以）beginch := byte(sSend[ i ]);if Windows.IsDBCSLeadByte(ch) thenbeginInc(i);SendMessage(focushld, WM_IME_CHAR, MakeWord(byte(sSend[ i ]), ch), 0);endelseSendMessage(focushld, WM_IME_CHAR, word(ch), 0);Inc(i);end;postmessage(focushld,WM_keydown,13,0);//发送一个虚拟Enter按键
end;
procedure TTestForm.SendParmKeys(sSend: string);
vartmpstr:string;cdds : TCopyDataStruct;
begin
tmpstr:=sSend;
cdds.dwData := 0;
cdds.cbData := length(tmpstr)+1;
cdds.lpData := pchar(tmpstr);
SendMessage(DllMfrmHdl,WM_COPYDATA,0,LongWord(@cdds));end;procedure TTestForm.FormCreate(Sender: TObject);
beginend;end.


fmPointer:Pointer;begin i:= TMenuItem(Sender).Tag; tmp_swFrom:=TTestPlugIn(PlugIns[i]).call;//TTestPlugIn(PlugIns[TMenuItem(Sender).Tag]).Child_Form:= TTestPlugIn(PlugIns[TMenuItem(Sender).Tag]).Call; //执行showDllForm函数 tmpform:=tmp_swFrom(application,Self.Handle,Screen,Self);
if Assigned(tmpform) then begin with tmpform do begin WindowState:=wsMaximized; Show;//--改为fORM.ShowModal end; AdjustTabControl( tmpform,False); end;end;procedure TMainForm.FormDestroy(Sender: TObject);begin FreePlugins;end;end.












dll窗体1代码









                                    

                                        这篇关于Delphi封装Mdi窗体到Dll并使用插件管理,tabControl制作多页面的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！
                                    

                                    

                                

                            

                            

                        

                    

                    

                        

                            

                            http://www.chinasem.cn/article/643485。
                            
                        

                    

                    
                    

                        
                            
                        
                    

                

                

                    相关文章
                

                    

                        

                            

                                

                                    
                                        中文分词jieba库的使用与实景应用（一）
                                    
                                

                            

                            

                                

                                    中文分词jieba库的使用与实景应用（一）
                                

                                

                                    知识星球：https://articles.zsxq.com/id_fxvgc803qmr2.html 目录 一.定义： 精确模式（默认模式）： 全模式： 搜索引擎模式： paddle 模式（基于深度学习的分词模式）： 二 自定义词典 三.文本解析   调整词出现的频率 四. 关键词提取 A. 基于TF-IDF算法的关键词提取 B. 基于TextRank算法的关键词提取
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        使用SecondaryNameNode恢复NameNode的数据
                                    
                                

                            

                            

                                

                                    使用SecondaryNameNode恢复NameNode的数据
                                

                                

                                    1）需求： NameNode进程挂了并且存储的数据也丢失了，如何恢复NameNode 此种方式恢复的数据可能存在小部分数据的丢失。  2）故障模拟 （1）kill -9 NameNode进程 [lytfly@hadoop102 current]$ kill -9 19886 （2）删除NameNode存储的数据（/opt/module/hadoop-3.1.4/data/tmp/dfs/na
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        Hadoop数据压缩使用介绍
                                    
                                

                            

                            

                                

                                    Hadoop数据压缩使用介绍
                                

                                

                                    一、压缩原则 （1）运算密集型的Job，少用压缩 （2）IO密集型的Job，多用压缩  二、压缩算法比较  三、压缩位置选择  四、压缩参数配置 1）为了支持多种压缩/解压缩算法，Hadoop引入了编码/解码器  2）要在Hadoop中启用压缩，可以配置如下参数
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        Makefile简明使用教程
                                    
                                

                            

                            

                                

                                    Makefile简明使用教程
                                

                                

                                    文章目录 规则makefile文件的基本语法：加在命令前的特殊符号：.PHONY伪目标: Makefilev1 直观写法v2 加上中间过程v3 伪目标v4 变量 make 选项-f-n-C     Make 是一种流行的构建工具，常用于将源代码转换成可执行文件或者其他形式的输出文件(如库文件、文档等)。Make 可以自动化地执行编译、链接等一系列操作。  规则 makefile文件
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        使用opencv优化图片（画面变清晰）
                                    
                                

                            

                            

                                

                                    使用opencv优化图片（画面变清晰）
                                

                                

                                    文章目录 需求影响照片清晰度的因素 实现降噪测试代码 锐化空间锐化Unsharp Masking频率域锐化对比测试 对比度增强常用算法对比测试     需求  对图像进行优化，使其看起来更清晰，同时保持尺寸不变，通常涉及到图像处理技术如锐化、降噪、对比度增强等  影响照片清晰度的因素 影响照片清晰度的因素有很多，主要可以从以下几个方面来分析 1. 拍摄设备 相机传感器：相机传
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        综合安防管理平台LntonAIServer视频监控汇聚抖动检测算法优势
                                    
                                

                            

                            

                                

                                    综合安防管理平台LntonAIServer视频监控汇聚抖动检测算法优势
                                

                                

                                    LntonAIServer视频质量诊断功能中的抖动检测是一个专门针对视频稳定性进行分析的功能。抖动通常是指视频帧之间的不必要运动，这种运动可能是由于摄像机的移动、传输中的错误或编解码问题导致的。抖动检测对于确保视频内容的平滑性和观看体验至关重要。  优势 1. 提高图像质量 - 清晰度提升：减少抖动，提高图像的清晰度和细节表现力，使得监控画面更加真实可信。 - 细节增强：在低光条件下，抖
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        如何在页面调用utility bar并传递参数至lwc组件
                                    
                                

                            

                            

                                

                                    如何在页面调用utility bar并传递参数至lwc组件
                                

                                

                                    1.在app的utility item中添加lwc组件： 2.调用utility bar api的方式有两种： 方法一，通过lwc调用： import {LightningElement,api ,wire   } from 'lwc';import { publish, MessageContext } from 'lightning/messageService';import Ca
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        pdfmake生成pdf的使用
                                    
                                

                            

                            

                                

                                    pdfmake生成pdf的使用
                                

                                

                                    实际项目中有时会有根据填写的表单数据或者其他格式的数据，将数据自动填充到pdf文件中根据固定模板生成pdf文件的需求   文章目录 利用pdfmake生成pdf文件1.下载安装pdfmake第三方包2.封装生成pdf文件的共用配置3.生成pdf文件的文件模板内容4.调用方法生成pdf    利用pdfmake生成pdf文件 1.下载安装pdfmake第三方包  npm i pdfma
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        零基础学习Redis(10) -- zset类型命令使用
                                    
                                

                            

                            

                                

                                    零基础学习Redis(10) -- zset类型命令使用
                                

                                

                                    zset是有序集合，内部除了存储元素外，还会存储一个score，存储在zset中的元素会按照score的大小升序排列，不同元素的score可以重复，score相同的元素会按照元素的字典序排列。 1. zset常用命令 1.1 zadd   zadd key [NX | XX] [GT | LT]   [CH] [INCR] score member [score member ...]
                                

                                

                                    阅读更多...
                                

                            

                        

                    

                    

                        

                            

                                

                                    
                                        软考系统规划与管理师考试证书含金量高吗？
                                    
                                

                            

                            

                                

                                    软考系统规划与管理师考试证书含金量高吗？
                                

                                

                                    2024年软考系统规划与管理师考试报名时间节点： 报名时间：2024年上半年软考将于3月中旬陆续开始报名 考试时间：上半年5月25日到28日，下半年11月9日到12日 分数线：所有科目成绩均须达到45分以上（包括45分）方可通过考试 成绩查询：可在“中国计算机技术职业资格网”上查询软考成绩 出成绩时间：预计在11月左右 证书领取时间：一般在考试成绩公布后3~4个月，各地领取时间有所不同
                                

                                

                                    阅读更多...
                                

                            

                        

                    

            

        

    


    


    

        

            Copyright China编程   23002807@qq.com
        

        

            沪ICP备2023033072号-2