Talk:Form in DLL

From Free Pascal wiki
Revision as of 05:18, 16 February 2020 by Trev (talk | contribs) (Fixed syntax highlighting)
(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=132146"