2. 程式人生 > >Delphi封裝Mdi窗體到Dll並使用外掛管理,tabControl製作多頁面

Delphi封裝Mdi窗體到Dll並使用外掛管理,tabControl製作多頁面

阿新 • • 發佈：2019-02-06

1.ShareMem的引用要放在各單元的第一位置,否則會報錯

2.dll中mdi子窗體關閉時要,

     Action:=caFree;
    TestForm2:=nil;

3.


主窗體程式碼

unit MainUnit;

interface

uses
  ShareMem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Menus, ToolWin, RzTabs,StrUtils;
 
type
  TTestdllMdiFrom=Function(App:TApplication;mfrmHdl:THandle;Scr:TScreen;Owner_s:Tform):Tform;stdcall;
  TGetCaption = function: Pchar; StdCall;
  TGetFormGuid= function: Pchar; StdCall;
  EdllLoadError=class(Exception);
  TTestPlugIn=class
        caption: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);
  private
    procedure MainCopyDataMsg(Var Msg : TMessage); Message WM_COPYDATA; //用於程序 或dll中傳遞 訊息
  public
    procedure 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;

var
  MainForm: 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);
var
  Found: TSearchRec;
  Sub: string;
  i: Integer;
  Dirs: TStrings;
  Finished: Integer;
begin
  StopSearch := False;
  Dirs := TStringList.Create;
  Finished := FindFirst(Dir + '*.*', 63, Found);
  while (Finished = 0) and not (StopSearch) do
  begin
    if (Found.Name[1] <> '.') then
    begin
      if (Found.Attr and faDirectory = faDirectory) then
        Dirs.Add(Dir + Found.Name) //Add to the directories list.
      else
        if Pos(UpperCase(Ext), UpperCase(Found.Name)) > 0 then
          Files.Add(Dir + Found.Name);
    end;
    Finished := FindNext(Found);
  end;
  FindClose(Found);
  if not StopSearch then
    for i := 0 to Dirs.Count - 1 do
      SearchFileExt(Dirs[i], Ext, Files);
  Dirs.Free;
end;
//-----------------------------------------------------------------
procedure TMainForm.tabControl_SelectedIndexChanged(sender: TObject);
var i:Integer;
begin
  if   MainForm.MDIChildCount   >0 then
     begin
        for i:=0 to MainForm.MDIChildCount-1 do
          begin
             if  MainTC.TabIndex=i then
               begin
                  MainForm.MDIChildren[i].ActiveMDIChild;
               end;
          end;  
     end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
     if MainTC.Tabs.Count=0 then
      MainTC.Height:=0
    else
      MainTC.Height:=28;
      LoadPlugIns;

end;

procedure TMainForm.MainTCChange(Sender: TObject);
var
    TabCap:String;
    I:   Integer;
    Child:   TForm;
begin
   if MainTC.Tabs.Count=0 then
     begin
        MainTC.Height:=0;
        exit;
     end
    else
      MainTC.Height:=28;

    TabCap:=MainTC.Tabs[MainTC.TabIndex].Caption;
    for   I   :=   MDIChildCount   -   1   downto   0   do
    begin
        Child   :=   MDIChildren[I];
        if   Child.Caption   =     TabCap   then
            Child.Show;
    end;


   MainSb.Panels[1].Text:=IntToStr(MainTC.TabIndex);
 end;

procedure TMainForm.TabControcl_ChangeTabPage(sender: TObject);
var i:Integer;
begin
     if (Self.MDIChildCount>0) and (MainTC.TabIndex>-1) then
       begin
            for i:=0 to Self.MDIChildCount-1 do
              begin
                 if MainTC.TabIndex=i then
                   begin
                      Self.MDIChildren[i].WindowState:=wsMaximized;
                      Self.MDIChildren[i].Visible:=True;
                      Self.MDIChildren[i].ActiveMDIChild;
                   end
                 else
                   begin
                      if Self.MDIChildren[i].Visible then
                         Self.MDIChildren[i].Visible:=False;
                   end;  
              end;  
       end;  
end;

procedure TMainForm.AdjustTabControl(Sender: TForm; Delete: Boolean);
var
    I:Integer;
    Found:Boolean;
    tmp_tab:TRzTabCollectionItem;
begin
    //查詢
    Found   :=   False;
    for   I   :=   0   to   MainTC.Tabs.Count   -   1   do
    begin
        if   Sender.Caption   =   MainTC.Tabs[i].Caption   then
        begin
            Found   :=   True;   //找到
            if   Delete   then   //刪除
                MainTC.Tabs.Delete(I)
            else     //啟用
              begin
                  if   MainTC.TabIndex   <>   I   then
                    MainTC.TabIndex   :=   I;
                  Sender.WindowState:=wsMaximized;  
              end;

            break;
        end;
    end;

    if   not   Found   then   //增加並激活
    begin
        tmp_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;
begin


   tmpcaption:=MainTC.Tabs.Items[MainTC.TabIndex].Caption   ;
   for i:=0 to MainForm.MDIChildCount-1 do
     begin

         if MainForm.MDIChildren[i].Caption=  tmpcaption       then
            MainForm.MDIChildren[i].Close;

     end;  
end;

 



procedure TMainForm.MainCopyDataMsg(var Msg: TMessage);
var tmpstr:string;
    sHead:string;
    tmpCaption,TMP_frmGuid:string;
    cdds : TcopyDataStruct;
begin
   if msg.Msg = WM_COPYDATA then
   begin
     cdds := PcopyDataStruct(Msg.LParam)^;
     tmpstr := (Pchar(cdds.lpData));
     sHead:=LeftStr(tmpstr,5);
     if sHead='XFRM:'  then  //X掉即關閉子窗體
       begin
           tmpCaption:=RightStr(tmpstr,Length(tmpstr)-5);
           TabControl_DeleteTabFromCaption(tmpCaption)  ;
       end;
     if sHead='FUID:'  then  //根據guid freeFrom
       begin
           TMP_frmGuid:=RightStr(tmpstr,Length(tmpstr)-5);
          // FreePlugIns_fromCapiont(TMP_frmGuid);
       end;
   end;
end;

procedure TMainForm.TabControl_DeleteTabFromCaption(sCaption:string);
var
    I:Integer;
    Found:Boolean;
    tmp_tab:TRzTabCollectionItem;
begin
    //查詢
    Found   :=   False;
    for   I   :=   0   to   MainTC.Tabs.Count   -   1   do
    begin
        if   sCaption   =   MainTC.Tabs[i].Caption   then
        begin
            Found   :=   True;   //找到

                MainTC.Tabs.Delete(i);


            break;
        end;
    end;

end;

procedure TMainForm.LoadPlugIns;
var
  Files: TStrings;
  i: Integer;
  TestPlugIn: TTestPlugIn;
  NewMenu: TMenuItem;
  GetCaption: TGetCaption;
  fm:TTestdllMdiFrom;
  GetFormGuid:TGetFormGuid;
begin
  Files := TStringList.Create;
  Plugins := TList.Create;
  //查詢指定目錄下的.dll檔案，並存於Files物件中
  SearchFileExt(ExtractFilepath(Application.Exename), '.dll', Files);
  //載入查詢到的DLL
  for i := 0 to Files.Count - 1 do
  begin
    TestPlugIn := TTestPlugIn.Create;
    TestPlugIn.Address := LoadLibrary(PChar(Files[i]));
    if TestPlugIn.Address = 0 then
      raise EDLLLoadError.Create('裝載' + PChar(Files[i]) + '失敗');
    try
      @GetCaption := GetProcAddress(TestPlugIn.Address, 'GetCaption');
      TestPlugIn.Caption := GetCaption;

      @fm:=GetProcAddress(TestPlugIn.Address, 'ShowDllForm');
      TestPlugIn.call:
 
[email protected]   ;

      @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); //每次在選單下新增一個模組選單
    except
      raise EDLLLoadError.Create('初始化失敗');
    end;
  end;
  Files.Free;
end;

procedure TMainForm.FreePlugIns;
var
  i: Integer;
  tmpHandl:THandle;
begin
  //將載入的外掛全部釋放

  for i := 0 to PlugIns.Count - 1 do
  begin
   tmpHandl:=TTestPlugIn(PlugIns[i]).Address;
     if tmpHandl<>0 then
      FreeLibrary(tmpHandl);
  end;
  //釋放plugIns物件
  PlugIns.Free;
end;

procedure TMainForm.PlugInsClick(Sender: TObject);
var tmpform:TForm;
tmp_swFrom:TTestdllMdiFrom;
i:Integer;
unit TestUnit;

interface

uses
  ShareMem,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TTestForm = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure SendKeys(sSend:string);
    procedure SendParmKeys(sSend:string);//傳送執行引數

  public
   
  end;

var
  TestForm: TTestForm;

implementation

uses myUnit;

{$R *.dfm}

procedure TTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    SendParmKeys('XFRM:'+self.Caption);
    SendParmKeys('FUID:'+frm_guid);
    Action:=caFree;
    TestForm:=nil;
end;

procedure TTestForm.Button1Click(Sender: TObject);
begin
 SendParmKeys(frm_guid);
end;
procedure TTestForm.SendKeys(sSend:string);
var
     i:integer;
     focushld,windowhld:hwnd;
     threadld:dword;
     ch: byte;
begin
   windowhld:=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
     //該過程傳送指定字串（中英文皆可以）
   begin
     ch := byte(sSend[ i ]);
     if Windows.IsDBCSLeadByte(ch) then
     begin
       Inc(i);
       SendMessage(focushld, WM_IME_CHAR, MakeWord(byte(sSend[ i ]), ch), 0);
     end
     else
       SendMessage(focushld, WM_IME_CHAR, word(ch), 0);
     Inc(i);
   end;
   postmessage(focushld,WM_keydown,13,0);
     //傳送一個虛擬Enter按鍵
end;
procedure TTestForm.SendParmKeys(sSend: string);
var
    tmpstr: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);
begin

end;

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製作多頁面

1.ShareMem的引用要放在各單元的第一位置,否則會報錯 2.dll中mdi子窗體關閉時要,      Action:=caFree;     TestForm2:=nil; 3. 主窗體程式碼 unit MainUnit; interface uses

封裝C#程式碼為DLL並在C#程式碼中引用

1.封裝C#程式碼為DLl 在VS2012中建立專案選擇類庫，命名testMyDll,新建類msg，注意修飾符必須為public using System; using System.Collections.Generic; using System.Linq; using System.T

VB封裝DLL並呼叫

首先明確DLL函式是什麼 DLL:動態連結庫（Dynamic Link Library）,一個DLL檔案裡面可以包含多個函式，其實就是實現共享函式的一種方式,一個應用程式可能需要多個DLL聯合起來才可以正常使用 一,新建ActiveX Dll 工程，然後在裡面的類模組裡面書

DevExpress 使用 XtraTabbedMdiManager 控制元件以 Tab樣式載入 Mdi窗體併合並父和子窗體的 RibbonControl 解決方案

最近剛接觸到 DevExpress 13.1 這個面板元件, 覺得相當好用 於是開始準備搭建 個小應用的主體框架. 找了好久的就是沒找到對應的文章來講解這一塊.. 翻了他們主網站上人家問的,以及API 才摸索... 不懂英文好吃力呀~~~ 首先選到的就是,依舊用 Md

學習使用C++封裝DLL並呼叫

一、生成DLL VS2013——建立win32專案——DLL——完成 //maopao.cpp #include "stdafx.h" //關鍵在於加入這一句,意為將C語言下的程式匯出為DLL extern"C"_declspec(dllexport) void

MDI窗體容器

hide lba contain rm2 open cli tro container logs MDI窗體容器： 一般來說，窗體是頂級容器，不允許放在其他任何容器內，但是如果將某個窗體的IsMdiContainer屬性設置為True，那此窗體就會成為窗體容器，可以在其中放

重啟並發管理器

linux 步驟 輸入 查詢 gic com log r12.2 占用 並發管理器經常在重啟應用的時候起不來，原因：系統在停應用的時候有請求再跑。 因此，一般在停應用之前，會把計劃請求取消掉，或者在停應用之後，將並發管理器占用的進程殺死。 EBS服務器大多是基於Linux搭

搭建Tomcat環境並配置管理

.tar.gz script started lib 是否 臨時文件 acc gin span 搭建Tomcat環境並配置管理 Tomcat是Apache 軟件基金會(Apache Software Foundation)的Jakarta 項目中的一個核心項目，由A

Winform下去除MDI窗體邊框

use flag info pan 得到 this flags 中間 main 做項目中間遇到了MDI窗體內邊框的問題，經過苦苦尋找，最終得到了解決方案 在Main窗體中調用API // Win32 Constants private cons

如何實現MDI窗體不重復打開同一個子窗體？

rms 不重復 png bool 通過 family nor .sh for 使用MDI窗體時，默認是可以多次打開同一個子窗體的，那麽如何控制不重復打開同一個子窗體呢？MDI窗體有個重要屬性——MdiChildren，該屬性表示MDI窗體打開的子窗體

Winform MDI窗體切換不閃爍的解決辦法（測試通過）

view ref ipa edr 定義 true post pen 情況 MDI窗體不閃爍方法測試通過： //.net 4.0用OptimizedDoubleBufferthis.SetStyle(ControlStyles.OptimizedDoubleBuffer |

將SPCOMM封裝到了DLL裏

-c body xtra gcd clas blog bsp 鏈接 SM 演示程序： 鏈接: https://pan.baidu.com/s/10--C9SkdCNgcD7XxsqQtoA 密碼: hsy7 Delphi源碼，付款後自動網盤鏈接 ； QQ群：6218163

基於opencv下對視頻的灰度變換，高斯濾波，canny邊緣檢測處理，同窗體顯示並保存

rmi 其他 AS info ali 利用 測試結果 14. 中間 如題：使用opencv打開攝像頭或視頻文件，實時顯示原始視頻，將視頻每一幀依次做灰度轉換、高斯濾波、canny邊緣檢測處理（原始視頻和這3個中間步驟處理結果分別在一個窗口顯示），最後將邊緣檢測結果保存為一個

Delphi 封裝(4)-物理上的封裝-物理封裝和動態鏈接

ole nts ref pre fine provide imp mach ive unit DemoSvr_TLB; // ***********************************************************************

機房收費系統之細化篇（跨日期下機，MDI窗體的運用，MDI主窗體與子窗體的互動）

      最近在細化機房收費系統時，發現在下機窗體出現了很多消費時間為負值的情況，有時還會彈出Bug，仔細一看原來是跨日期的消費時間問題，那麼如何設定跨日期的下機呢？在機房收費系統中的MDI 窗體如何運用呢？下面就這兩個問題進行梳理分享。 一、跨日期的下機 核

360瀏覽器外掛管理

分享一下我老師大神的人工智慧教程！零基礎，通俗易懂！http://blog.csdn.net/jiangjunshow 也歡迎大家轉載本篇文章。分享知識，造福人民，實現我們中華民族偉大復興！        

Vim-plug 外掛管理器簡介

Vim-plug https://github.com/junegunn/vim-plug Vim-plug 是一款 Vim 外掛管理器。 核心特點 Plug 開頭指定外掛。 已知 https://github.com/sukima/vim-tiddlywiki

vim的外掛管理Vundle

Vim是Linux上一款用途廣泛的輕量級文字編輯工具。雖然對普通的Linux使用者來說開始學用起來難度相當大，但鑑於它具有的種種好處，完全值得一學。至於功能方面，Vim可以通過外掛實現全面定製。不過由於其高階配置，你可能需要在其外掛系統上花一番時間，才能夠高效地對Vim進行個性化定製。幸好，我們有幾

C#學習筆記——MDI窗體（多文件介面）

1、設定父窗體： 如果要將某個窗體設定為父窗體，只需將該窗體的IsMdiContainer屬性設定為True即可。 2、設定子窗體： 通過設為某個窗體的MdiParent屬性來確定該窗體是那個窗體的子窗體。 語法如下： 1: public Form MdiParent

Winform中MDI窗體設計

MDI窗體即多文件介面。用於同時顯示多個文件，每個文件顯示在各自的視窗中。 1、設定MDI窗體 在MDI窗體中，起到容器作用的視窗被稱為“父窗體”，放到父窗體中的其他窗體被稱為“子窗體”，也成為“MDI子窗體”。當MDI應用程式啟動時，首先會顯示父窗體。每個應用程式只能有一個父窗體，其他子窗