I have done this successfully - with many forms.
I'm a little busy right now to explain how all this works, but if you
ask questions I'll try to answer them.
Doug
P.S. I don't think that this particular DLL uses the form, but others do.
Here is a typical DLL: (below is how to load)
----------s74244.dpr-------------------------------------------------------------
library s74244;
uses
ShareMem,
SysUtils,
Classes,
Windows,
Messages,
Graphics,
Controls,
Forms,
Dialogs,
U74244 in 'U74244.pas' {Generic},
Model in 'Model.pas';
{$E .mdl}
function GetSimClass : CSimModel; export; stdcall;
begin
result := TMC74245;
end;
exports
GetSimClass;
begin
end.
---------------U74244.pas------------------------------------------------------------
unit U74244;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Model;
const
PartName = '74244';
AttribList = 'Name';
PinCount = 20;
BoxWidth = 60;
PinList =
'#1OE,1D0,2O0,1D1,2O1,1D2,2O2,1D3,2O3,GND,2D3,1O3,2D2,1O2,2D1,1O1,2D0,1O0,#2OE,VCC';
PinNums : Array[0..PinCount-1] of Integer =
(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20);
PinPos : Array[0..PinCount-1] of Record Pos : Integer; OnLeft :
Boolean; end =
((Pos:0;OnLeft:True)
,(Pos:1;OnLeft:True)
,(Pos:2;OnLeft:True)
,(Pos:3;OnLeft:True)
,(Pos:4;OnLeft:True)
,(Pos:5;OnLeft:True)
,(Pos:6;OnLeft:True)
,(Pos:7;OnLeft:True)
,(Pos:8;OnLeft:True)
,(Pos:9;OnLeft:True)
,(Pos:9;OnLeft:False)
,(Pos:8;OnLeft:False)
,(Pos:7;OnLeft:False)
,(Pos:6;OnLeft:False)
,(Pos:5;OnLeft:False)
,(Pos:4;OnLeft:False)
,(Pos:3;OnLeft:False)
,(Pos:2;OnLeft:False)
,(Pos:1;OnLeft:False)
,(Pos:0;OnLeft:False)
);
const
AV : Array[False..True] of Array[False..True] of Byte = ((0,6), (3,3));
type
TMC74245 = class(TsimModel)
procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
private
_InstanceName : String;
I1, I2, O1, O2 : Array[0..3] of Boolean;
NE1, NE2 : Boolean;
PinNames : TStringList;
public
function Run(TimeStep : Word; AccumulatedTime : LongWord) : Boolean;
override;
function GetInstance : String; override;
function GetPin(Ndx : Integer) : Byte ; override;
function GetPinCount : Integer; override;
function GetPinName(Ndx : Integer) : String;override;
function GetPinNumber(Name : String) : Integer; override;
procedure PutInstance(Name : String); override;
procedure PutPin(Ndx : Integer; Value : Byte); override;
Property InstanceName : String read GetInstance write PutInstance;
class function GetStatus : String; Override;
class function GetAttributeNames : String; Override;
class function GetLibraryName : String; Override;
Property PinCount : Integer read GetPinCount;
Property PinName[Ndx : Integer] : String read GetPinName;
Property PinNumber[Name : STring] : Integer read GetPinNumber;
Property Pin[Ndx : Integer] : Byte read GetPin write PutPin;
function GetPinLoc(Ndx : Integer) : TPoint; Override;
function GetShapeSize : TPoint; Override;
Property PinLoc[Ndx : Integer] : TPoint read GetPinLoc;
Property ShapeSize : TPoint read GetShapeSize;
function GetDevicePinNumber(Ndx : Integer) : Integer; override;
Property DevicePinNumber[Ndx : Integer] : Integer read
GetDevicePinNumber;
end;
implementation
{$R *.DFM}
var
PinNames : TStringList;
function TMC74245.GetDevicePinNumber(Ndx : Integer) : Integer;
begin
if (Ndx < 0) or (Ndx > PinCount-1) then
result := -1
else
result := PinNums[Ndx];
end;
function TMC74245.GetPinLoc(Ndx : Integer) : TPoint;
begin
if (Ndx < 0) or (Ndx > PinCount-1) then
result := MakePoint(0, 0)
else
result := CalcPin(PinPos[Ndx].Pos, BoxWidth, PinPos[Ndx].OnLeft);
end;
function TMC74245.GetShapeSize : TPoint;
var
i, L, R : Integer;
begin
L := 0;
R := 0;
for i := 0 to PinCount-1 do
begin
if PinPos[i].OnLeft then
begin
if PinPos[i].Pos+1 > L then L := PinPos[i].Pos+1;
end
else
begin
if PinPos[i].Pos+1 > R then R := PinPos[i].Pos+1;
end;
end;
result := CalcBox(L, R, BoxWidth);
end;
function TMC74245.GetInstance : String;
begin
result := _InstanceName;
end;
function TMC74245.GetPinCount : Integer;
begin
result := PinNames.Count;
end;
function TMC74245.GetPinName(Ndx : Integer) : String;
begin
if Ndx < 0 then result := ''
else if Ndx < PinNames.Count then result := PinNames[Ndx]
else result := '';
end;
function TMC74245.GetPinNumber(Name : String) : Integer;
begin
result := PinNames.IndexOf(Name);
end;
class function TMC74245.GetStatus : String;
begin
result := 'Functional';
end;
class function TMC74245.GetAttributeNames : String;
begin
result := AttribList;
end;
class function TMC74245.GetLibraryName : String;
begin
result := PartName;
end;
// 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
17 18 19
//#1OE,1D0,2O0,1D1,2O1,1D2,2O2,1D3,2O3,GND,2D3,1O3,2D2,1O2,2D1,1O1,2D0,1O0,#2OE,VCC
function TMC74245.Run(TimeStep : Word; AccumulatedTime : LongWord) :
Boolean;
var
i : Integer;
begin
for i := 0 to 3 do
begin
O1[i] := I1[i];
O2[i] := I2[i];
end;
result := False;
end;
function TMC74245.GetPin(Ndx : Integer) : Byte ;
begin
case Ndx of
2: result := AV[NE2, O2[0]];
4: result := AV[NE2, O2[1]];
6: result := AV[NE2, O2[2]];
8: result := AV[NE2, O2[3]];
17: result := AV[NE1, O1[0]];
15: result := AV[NE1, O1[1]];
13: result := AV[NE1, O1[2]];
11: result := AV[NE1, O1[3]];
0, 1, 3, 5, 7, 9, 10, 12, 14, 16, 18, 19: result := 3;
else result := 7;
end;
end;
procedure TMC74245.PutPin(Ndx : Integer; Value : Byte);
begin
case Ndx of
0: NE1 := Value > 3;
1: I1[0] := Value > 3;
3: I1[1] := Value > 3;
5: I1[2] := Value > 3;
6: I1[3] := Value > 3;
10: I2[3] := Value > 3;
12: I2[2] := Value > 3;
14: I2[1] := Value > 3;
16: I2[0] := Value > 3;
18: NE2 := Value > 3;
else;
end;
end;
procedure TMC74245.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
case Msg.CharCode of
112: // F1
begin
end;
113: // F2
begin
Handled := True;
end;
114: // F3
begin
Handled := True;
end;
115: // F4
begin
Handled := True;
end;
116: // F5
begin
Handled := True;
end;
117: // F6
begin
Handled := True;
end;
118: // F7 handled by MainForm
begin
Handled := False;
end;
119: // F8 handled by MainForm
begin
Handled := False;
end;
120: // F9 handled by MainForm
begin
Handled := False;
end;
121: // F10
begin
Handled := True;
end;
122: // F11
begin
Handled := True;
end;
123: // F12
begin
TForm(Owner).SHow;
Handled := True;
end;
27: // ESC
begin
Close;
Handled := True;
end;
else
begin
// MessageDlg(IntToStr(Msg.CharCode)+' '+IntToStr(Msg.KeyData),
mtInformation, [mbOK], 0);
Handled := False;
end;
end;
end;
procedure TMC74245.PutInstance(Name : String);
var
P : Integer;
i : Integer;
L : TStringList;
begin
if _InstanceName <> '' then Exit;
L := TStringList.Create;
_InstanceName := Name;
L.CommaText := Name;
P := Pos(' -', Caption);
if P <> 0 then Caption := Copy(Caption, 1, P-1);
L.CommaText := Name;
for i := 0 to L.Count-1 do
begin
case i of
0:
begin
Caption := Caption+' - '+L[i];
end;
else;
end;
end;
PinNames := TStringList.Create;
PinNames.CommaText := PinList;
Visible := False;
L.Free;
end;
var
PosPin : Integer;
procedure B(N : String; OnLeft : Boolean);
var
i : Integer;
begin
i := PinNames.IndexOf(N);
PinPos[i].Pos := PosPin;
PinPos[i].OnLeft := OnLeft;
end;
procedure A(L, R : String);
begin
if L <> '' then B(L, True);
if R <> '' then B(R, False);
Inc(PosPin);
end;
begin
PosPin := 0;
PinNames := TStringList.Create;
PinNames.CommaText := PinList;
A('', 'VCC');
A('', '');
A('1D3', '1O3');
A('1D2', '1O2');
A('1D1', '1O1');
A('1D0', '1O0');
A('#1OE', '');
A('', '');
A('2D3', '2O3');
A('2D2', '2O2');
A('2D1', '2O1');
A('2D0', '2O0');
A('#2OE', '');
A('', 'GND');
end.
---------------------model.pas------------------------------------------------------------------
unit Model;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TRunSimCmnd = (rscStart, rscStop, rscStep, rscSlowStart, rscSlowStop,
rscShow, rscHide);
TRunSim = Procedure(Cmnd : TRunSimCmnd) of object;
TSimModel = class(TForm)
private
public
RunSim : TRunSim;
class function GetStatus : String; virtual; abstract;
class function GetLibraryName : String; virtual; abstract;
class function GetAttributeNames : String; virtual; abstract;
function GetInstance : String; virtual; abstract;
function GetPin(Ndx : Integer) : Byte ; virtual; abstract;
function GetPinCount : Integer; virtual; abstract;
function GetPinName(Ndx : Integer) : String;virtual; abstract;
function GetPinNumber(Name : String) : Integer; virtual; abstract;
function Run(TimeStep : Word; AccumulatedTime : LongWord) : Boolean;
virtual; abstract;
procedure PutInstance(Name : String); virtual; abstract;
procedure PutPin(Ndx : Integer; Value : Byte); virtual; abstract;
Property InstanceName : String read GetInstance write PutInstance;
Property Pin[Ndx : Integer] : Byte read GetPin write PutPin;
Property PinCount : Integer read GetPinCount;
Property PinName[Ndx : Integer] : String read GetPinName;
Property PinNumber[Name : String] : Integer read GetPinNumber;
function GetPinLoc(Ndx : Integer) : TPoint; virtual; abstract;
function GetShapeSize : TPoint; virtual; abstract;
Property PinLoc[Ndx : Integer] : TPoint read GetPinLoc;
Property ShapeSize : TPoint read GetShapeSize;
function GetDevicePinNumber(Ndx : Integer) : Integer; virtual; abstract;
Property DevicePinNumber[Ndx : Integer] : Integer read
GetDevicePinNumber;
end;
CSimModel = Class of TSimModel;
function CalcPin(Pin, Width : Integer; IsLeft : Boolean) : TPoint;
function CalcBox(Left, Right, Width : Integer) : Tpoint;
function MakePoint(X, Y : Integer) : Tpoint;
implementation
uses Math;
function MakePoint(X, Y : Integer) : Tpoint;
var
P : TPoint;
begin
P.x := X;
P.y := Y;
result := P;
end;
function CalcPin(Pin, Width : Integer; IsLeft : Boolean) : Tpoint;
var
P : TPoint;
begin
if IsLeft then
P.x := 0
else
P.x := Width-1;
P.y := (Pin + 2) * 10;
result := P;
end;
function CalcBox(Left, Right, Width : Integer) : Tpoint;
var
P : TPoint;
begin
P.x := Width;
P.y := (Max(Left, Right) + 3) * 10;
result := P;
end;
end.
This is how I load the DLL
------- extracted method from main
.exe--------------------------------------------------------
function TBOX.AddLIB(Fn: TFileName): Integer;
var
Name, Status : String;
DllHandle: THandle;
Model : CSimModel;
GetSimClass : TGetSimClass;
begin
result := -1;
DllHandle := LoadLibrary(PChar(Fn));
GetSimClass := GetProcAddress(DllHandle, 'GetSimClass');
if GetSimClass <> nil then
begin
try
Model := GetSimClass();
Name := Model.GetLibraryName;
Status := Model.GetStatus;
result := LIB.Items.Add(Name);
LIBmodel[result] := Model;
LIB.Update;
DrawForm.AddModel(Name, Longint(Model));
except
end;
end;
end;
Paul Bennett wrote:
> Hi all,
>
> A little bit of background first...
>
> I have a small application which basically consists of a MDI form
> which acts as host to a series of plugin forms. The application is
> relatively immature and subject to change.
>
> The application is only used at one site and all users have access to
> a shared directory on the network where the most up to date versions
> of the plugins are kept, this means it is relatively easy to check
> that the application always has the latest versions of the plugins.
>
> Recently I have suffered from a bit of 'project creep', and I was
> looking at a way of applying the same system of updating the
> applications main form.
>
> The Problem...
>
> I decided to move all of the MDI Form (ie pretty much the whole
> application) into a dll, create a Loader program which checks the
> (local) dll version number against the (network) dll and downloads it
> as necessary and then loads the dll and opens the form.
>
> This all seems to work fine, except... when the MDI form is closed
> the application crashes with an unknown exception.
>
> I've checked the MDI Form and as far as I can tell every object that
> is created as the form loads is freed and it unloads.
>
> The following is the Code for the Library Project.
>
> library FEBAPI;
>
> uses
> ShareMem,
> madExcept,
> madLinkDisAsm,
> Forms,
> Dialogs,
> MainUI in 'Source\MainUI.pas' {FrameworkUI};
>
> {$R *.res}
>
> procedure RunFEB; stdcall;
> var
> FrameworkUI: TFrameworkUI;
> begin
> FrameworkUI := TFrameworkUI.Create(nil);
> FrameworkUI.ShowModal;
> FrameworkUI.Release;
> end;
>
> exports RunFEB;
>
> begin
> end.
>
> When stepping through the RunFEB method, after FrameworkUI.Release is
> called, there are repeated calls to stdWinProc (around 5 at last
> count) until the Application crashes with an unknown exception.
>
> Any pointers most gratefully received.
>
> Paul Bennett
>
>
>
> ------------------------------------
>
> -----------------------------------------------------
> Home page: http://groups.yahoo.com/group/delphi-en/
> To unsubscribe: [email protected]! Groups Links
>
>
>
>
> ------------------------------------------------------------------------
>
>
> No virus found in this incoming message.
> Checked by AVG - www.avg.com
> Version: 8.5.339 / Virus Database: 270.12.80/2187 - Release Date: 06/19/09
> 06:53:00
>
>
[Non-text portions of this message have been removed]
