Talk:Form in DLL

From Lazarus wiki
Revision as of 17:09, 11 December 2017 by PeterX (talk | contribs) (splitted in three files)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigationJump to search

Hi there,

I've put Your code into a project, but with usual three files .. Still works under Lazarus 1.8 release on 2017-12-11.

What is a "fake button" ?

program MainApp;

{$mode objfpc}{$H+}

uses 

 {$IFDEF UNIX}{$IFDEF UseCThreads}
 cthreads,
 {$ENDIF}{$ENDIF}
 Interfaces, // this includes the LCL widgetset
 Forms, mainunit
 { you can add units after this };

{$R *.res}

begin 

 Application.Scaled:=True;
 RequireDerivedFormResource:=True;
 Application.Initialize;
 Application.CreateForm(TMainForm, MainForm);
 DLLDialog_Init( @DisableFormsCallBack, @EnableFormsCallback);
 try
   Application.Run;
 finally
   DLLDialog_Final;
 end;

end.

unit mainunit;

{$mode objfpc}{$H+}

interface

uses 

 //Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;
 Interfaces, Classes, LCLType, Controls, StdCtrls, Forms, ExtCtrls;

type 

 TEnableDisableFormsCallBack = procedure(var FormList: Pointer);
 TCreateButtonCallBack = procedure(Caption: PChar; OnClick: TProcedure);

const {$IFDEF WINDOWS} 

 DLLDialogLib = 'DLLDialog.dll';

{$ELSE} 

 DLLDialogLib = 'DLLDialog.so';

{$ENDIF}

procedure DLLDialog_Init(DisableFormsCallBack, EnableFormsCallback: TEnableDisableFormsCallBack); external DLLDialogLib; procedure DLLDialog_Final; external DLLDialogLib; procedure DLLDialog_ShowModal(ParentWindow: HWND); external DLLDialogLib; procedure DLLDialog_Show(ParentWindow: HWND); external DLLDialogLib; procedure DLLDialog_CreateDLLButton(ParentWindow: HWND); external DLLDialogLib; procedure DLLDialog_CreateButton(CreateButtonCallBack: TCreateButtonCallBack); external DLLDialogLib;


procedure EnableFormsCallback( var FormList: Pointer); procedure DisableFormsCallBack( var FormList: Pointer);


type 

 TMainForm = class(TForm)
 private
   PnlParent: TPanel;

   procedure BtnAddDLLButtonClick(Sender: TObject);
   procedure BtnAddButtonClick(Sender: TObject);
   procedure ShowModalDLLDialog(Sender: TObject);
   procedure ShowDLLDialog(Sender: TObject);
 public
   constructor Create(aOwner: TComponent); override;
 end;

var 

 MainForm: TMainForm;


implementation

{$R *.lfm}

procedure EnableFormsCallback( var FormList: Pointer); begin 

 Screen.EnableForms( TList( FormList));

end;

procedure DisableFormsCallBack( var FormList: Pointer); begin 

 FormList := Screen.DisableForms( nil, TList( FormList));

end;


// ----- TMainForm ------------------------------------------------------------- constructor TMainForm.Create(aOwner: TComponent); var 

 BtnShow,
 BtnShowModal,
 BtnAddDLLButton,
 BtnAddButton: TButton;

begin 

 inherited CreateNew( aOwner);

 Position := poWorkAreaCenter;
 Width    := 600;
 Height   := 200;

 BtnShow := TButton.Create(Self);
 BtnShow.Parent   := Self;
 BtnShow.Caption  := 'Show form';
 BtnShow.AutoSize := True;
 BtnShow.OnClick  := @ShowDLLDialog;

 BtnShowModal := TButton.Create(Self);
 BtnShowModal.Parent := Self;
 BtnShowModal.Caption := 'Show modal form';
 BtnShowModal.AutoSize := True;
 BtnShowModal.OnClick := @ShowModalDLLDialog;
 BtnShowModal.AnchorSide[akLeft].Control := BtnShow;
 BtnShowModal.AnchorSide[akLeft].Side := asrRight;
 BtnShowModal.BorderSpacing.Left := 10;

 BtnAddDLLButton := TButton.Create(Self);
 BtnAddDLLButton.Parent := Self;
 BtnAddDLLButton.Caption := 'Create real DLL button';
 BtnAddDLLButton.AutoSize := True;
 BtnAddDLLButton.OnClick := @BtnAddDLLButtonClick;
 BtnAddDLLButton.AnchorSide[akLeft].Control := BtnShowModal;
 BtnAddDLLButton.AnchorSide[akLeft].Side := asrRight;
 BtnAddDLLButton.BorderSpacing.Left := 10;

 BtnAddButton := TButton.Create(Self);
 BtnAddButton.Parent := Self;
 BtnAddButton.Caption := 'Create fake DLL button';
 BtnAddButton.AutoSize := True;
 BtnAddButton.OnClick := @BtnAddButtonClick;
 BtnAddButton.AnchorSide[akLeft].Control := BtnAddDLLButton;
 BtnAddButton.AnchorSide[akLeft].Side := asrRight;
 BtnAddButton.BorderSpacing.Left := 10;

 PnlParent := TPanel.Create(Self);
 PnlParent.Parent := Self;
 PnlParent.AnchorSide[akTop].Control := BtnShow;
 PnlParent.AnchorSide[akTop].Side := asrBottom;
 PnlParent.BorderSpacing.Top := 10;
 PnlParent.Width := 220;

end;

procedure CreateButtonCallBack( ACaption: PChar; AOnClick: TProcedure); var 

 MyMethod : TMethod;
 Btn      : TButton;

begin 

 Btn := TButton.Create( MainForm);
 Btn.Caption   := ACaption;
 Btn.Left      := 100;
 Btn.Width     := 100;
 Btn.Height    := 20;
 MyMethod.Code := AOnClick;
 MyMethod.Data := nil;
 Btn.OnClick   := TNotifyEvent( MyMethod);
 Btn.Parent    := MainForm.PnlParent;

end;

procedure TMainForm.BtnAddButtonClick(Sender: TObject); begin 

 DLLDialog_CreateButton( @CreateButtonCallBack);

end;

procedure TMainForm.BtnAddDLLButtonClick(Sender: TObject); begin 

 DLLDialog_CreateDLLButton( PnlParent.Handle);

end;

procedure TMainForm.ShowDLLDialog(Sender: TObject); begin 

 DLLDialog_Show(0);

end;

procedure TMainForm.ShowModalDLLDialog(Sender: TObject); begin 

 DLLDialog_ShowModal( Self.Handle);

end;

end.

library DllDialog;

{$mode objfpc}{$H+}

uses 

 Interfaces, Classes, LCLType, StdCtrls, Controls, Forms, Dialogs;

type 

 TDLLDialog = class(TForm)
 protected
   procedure CreateParams(var Params: TCreateParams); override;
 public
   procedure BtnShowMessageClick(Sender: TObject);
   constructor Create(aOwner: TComponent); override;
 public
   ParentFormHandle: HWND;
 end;

 TEnableDisableFormsCallBack = procedure(var FormList: Pointer);
 TCreateButtonCallBack = procedure(Caption: PChar; OnClick: TProcedure);

 TApplicationCallback = class(TComponent)
 private
   DisableFormsCallBack: TEnableDisableFormsCallBack;
   EnableFormsCallback: TEnableDisableFormsCallBack;
   FormList: Pointer;
 public
   procedure DisableForms(Sender: TObject);
   procedure EnableForms(Sender: TObject);
   procedure BtnClick(Sender: TObject);

   constructor Create(aOwner: TComponent); override;
   destructor Destroy; override;
 end;

var 

 ApplicationCallback: TApplicationCallback;

procedure DLLDialog_Init(DisableFormsCallBack, EnableFormsCallback: TEnableDisableFormsCallBack); begin 

 ApplicationCallback := TApplicationCallback.Create(nil);
 ApplicationCallback.DisableFormsCallBack := DisableFormsCallBack;
 ApplicationCallback.EnableFormsCallback := EnableFormsCallback;

end;

procedure DLLDialog_Final; begin 

 ApplicationCallback.Free;

end;

procedure DLLDialog_ShowModal(ParentWindow: HWND); var 

 DLLDialog: TDLLDialog;

begin 

 DLLDialog := TDLLDialog.Create(ApplicationCallback);
 try
   DLLDialog.ParentFormHandle := ParentWindow;
   DLLDialog.ShowModal;
 finally
   DLLDialog.Free;
 end;

end;

procedure DLLDialog_Show(ParentWindow: HWND); var 

 DLLDialog: TDLLDialog;

begin 

 DLLDialog := TDLLDialog.Create(ApplicationCallback);
 DLLDialog.ParentFormHandle := ParentWindow;
 DLLDialog.Show;

end;

procedure DLLDialog_CreateDLLButton(ParentWindow: HWND); var 

 Btn: TButton;
 BtnParentForm: TForm;

begin 

 BtnParentForm := TForm.CreateNew(ApplicationCallback);
 BtnParentForm.ParentWindow := ParentWindow;
 BtnParentForm.Width := 100;
 BtnParentForm.Height := 20;
 BtnParentForm.BorderStyle := bsNone;
 BtnParentForm.Visible := True;

 Btn := TButton.Create(ApplicationCallback);
 Btn.Caption := 'Real DLL Button';
 Btn.Width := BtnParentForm.Width;
 Btn.Height := BtnParentForm.Height;
 Btn.OnClick := @ApplicationCallback.BtnClick;
 Btn.Parent := BtnParentForm;

end;

procedure FakeBtnClick; begin 

 ShowMessage('You clicked a fake button from a DLL!');

end;

procedure DLLDialog_CreateButton(CreateButtonCallBack: TCreateButtonCallBack); begin 

 CreateButtonCallBack('Fake DLL Button', @FakeBtnClick);

end;

exports 

 DLLDialog_Init, DLLDialog_Final, DLLDialog_ShowModal, DLLDialog_Show,
 DLLDialog_CreateButton, DLLDialog_CreateDLLButton;

{ TApplicationCallback }

constructor TApplicationCallback.Create(aOwner: TComponent); begin 

 inherited Create(aOwner);

 Application.AddOnModalBeginHandler(@DisableForms);
 Application.AddOnModalEndHandler(@EnableForms);

end;

procedure TApplicationCallback.BtnClick(Sender: TObject); begin 

 ShowMessage('You clicked a real button from a DLL!');

end;

destructor TApplicationCallback.Destroy; begin 

 Application.RemoveOnModalBeginHandler(@DisableForms);
 Application.RemoveOnModalEndHandler(@EnableForms);

 inherited Destroy;

end;

procedure TApplicationCallback.DisableForms(Sender: TObject); begin 

 DisableFormsCallBack(FormList);

end;

procedure TApplicationCallback.EnableForms(Sender: TObject); begin 

 EnableFormsCallback(FormList);

end;

{ TDLLDialog }

constructor TDLLDialog.Create(aOwner: TComponent); var 

 BtnShowMessage: TButton;

begin 

 inherited CreateNew(aOwner);

 Caption := 'This form is in a DLL !!!';
 Position := poWorkAreaCenter;
 Width := 200;
 Height := 100;

 BtnShowMessage := TButton.Create(Self);
 BtnShowMessage.Parent := Self;
 BtnShowMessage.Caption := 'Show message';
 BtnShowMessage.AutoSize := True;
 BtnShowMessage.OnClick := @BtnShowMessageClick;

end;

procedure TDLLDialog.BtnShowMessageClick(Sender: TObject); begin 

 ShowMessage('Hello from DLL!');

end;

procedure TDLLDialog.CreateParams(var Params: TCreateParams); begin 

 inherited CreateParams(Params);

 {$IFDEF LCLWin32}
 Params.WndParent := ParentFormHandle;
 {$ENDIF}

end;

begin 

 Application.Initialize;

end.

Retrieved from "http://wiki.freepascal.org/index.php?title=Talk:Form_in_DLL&oldid=114224"