expertcad/POWERCAD30/UNITS/PcPluginDlg.pas

unit PcPluginDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DlgBase,BlockFrm,FileCtrl,plgDial,pcPlgInt,PCTypesUtils;

type
  TPCPluginDlg = class(TDlgBase)
  private
    { Private declarations }
    Dial : TfrmPlugin;
    fDirectory: String;
    FPlugins : TstringList;
    FPluginHandles: Array [0..255] of THandle;
    Procedure GetCommand( comId: integer; values: string; valueI: integer );
    procedure SetDirectory(const Value: String);
    function GetVisible: Boolean;
  protected
    { Protected declarations }

  public
    { Public declarations }
    constructor create(Aowner: TComponent);override;
    Destructor Destroy;override;
    procedure Show;override;
    Procedure SyncronizeContext;
    Procedure Syncronize;override;
    Procedure Locate(px,py:Integer);override;
    Procedure LoadPlugins;
    Procedure UnLoadPlugins;
    Procedure GetPlugins(List: TStringList);
    Function GetPluginNames:String;
    Function GetPluginCount:Integer;
    Function GetPluginName(PluginIdx:Integer):String;
    Function GetPluginVerbCount(PluginIdx:Integer):Integer;
    Function GetPluginVerbName(PluginIdx,VerbIdx:Integer):String;
    Function GetPluginVerbs(PluginIdx: integer):String;
    Procedure DoPluginVerb(PluginIdx,VerbIdx: integer);
    Function GetPluginInfoText(PluginIdx:Integer):String;
  published
    { Published declarations }
    Property CadControl;
    Property PluginsDirectory:String read fDirectory write SetDirectory;
    Property Visible:Boolean read GetVisible;
  end;

  TGetVerbsProc = Function:pchar;stdcall;
  TDoVerbProc = Procedure (VerbIndex: integer);stdcall;
  TInitProc = Procedure (OwnerApp:integer);stdcall;
  TInfoProc = Function:String;stdcall;

implementation
{$R *.DCR}

{ TPCPluginDlg }

constructor TPCPluginDlg.create(Aowner: TComponent);
var dir: String;
begin
  inherited create(Aowner);
  dial := TfrmPlugin.create(self);
  oncommand := GetCommand;
  DlgName := 'Plugins';
  Fplugins := TStringList.Create;
  RegRead('PlgDir',dir);
  PluginsDirectory := dir;
end;

destructor TPCPluginDlg.Destroy;
begin
  UnLoadPlugins;
  FPlugins.Free;
  Dial.Free;
  inherited;
end;

procedure TPCPluginDlg.DoPluginVerb(PluginIdx, VerbIdx: integer);
var DoVerbProc : TDoVerbProc;
Begin
  If (FPlugins = nil) or (FPlugins.count < PluginIdx+1) then
  begin
  end
  else
  begin
    SetControlForPlugins(CadControl);
    @DoVerbProc := GetProcAddress(FPluginHandles[PluginIdx],pchar('DoVerb'));
    if @DoVerbProc <> nil then
    begin
      DoVerbProc(VerbIdx);
      CadControl.Refresh;
      CadControl.Updated := True;
    end;
  end;

end;

procedure TPCPluginDlg.GetCommand(comId: integer; values: string;
  valueI: integer);
begin
  case ComId of
  0: begin
       PluginsDirectory := ValueS;
     end;
  1: begin
       LoadPlugins;
     end;
  end;
end;

function TPCPluginDlg.GetPluginCount: Integer;
begin
  result := 0;
  if assigned(FPlugins) then result := FPlugins.Count;
end;

function TPCPluginDlg.GetPluginInfoText(PluginIdx: Integer): String;
var InfoProc : TinfoProc;
begin
  Result := '';
  If (FPlugins = nil) or (FPlugins.count < PluginIdx+1) then
  begin
  end
  else
  begin
    SetControlForPlugins(CadControl);
    @InfoProc := nil;
    @InfoProc := GetProcAddress(FPluginHandles[PluginIdx],pchar('GetName'));
    if @InfoProc <> nil then
      Result := Result+'Name'+': '+InfoProc+#13
    else
      Result := Result+'Name'+': '+Copy(FPlugins[PluginIdx],1,Length(FPlugins[PluginIdx])-4)+#13;
    @InfoProc := nil;
    @InfoProc := GetProcAddress(FPluginHandles[PluginIdx],pchar('GetDesc'));
    if @InfoProc <> nil then
      Result := Result+'Description'+': '+InfoProc+#13
    else
      Result := Result+'Description'+': '+'N/A'+#13;
    @InfoProc := nil;
    @InfoProc := GetProcAddress(FPluginHandles[PluginIdx],pchar('GetCompany'));
    if @InfoProc <> nil then
      Result := Result+'Company'+': '+InfoProc+#13
    else
      Result := Result+'Company'+': '+'N/A'+#13;
    @InfoProc := nil;
    @InfoProc := GetProcAddress(FPluginHandles[PluginIdx],pchar('GetDate'));
    if @InfoProc <> nil then
      Result := Result+'Date'+': '+InfoProc+#13
    else
      Result := Result+'Date'+': '+'N/A'+#13;
    @InfoProc := nil;
    @InfoProc := GetProcAddress(FPluginHandles[PluginIdx],pchar('GetVersion'));
    if @InfoProc <> nil then
      Result := Result+'Version'+': '+InfoProc+#13
    else
      Result := Result+'Version'+': '+'N/A'+#13;
    @InfoProc := nil;
    @InfoProc := GetProcAddress(FPluginHandles[PluginIdx],pchar('GetLicence'));
    if @InfoProc <> nil then
      Result := Result+'Licence'+': '+InfoProc+#13
    else
      Result := Result+'Licence'+': '+'N/A'+#13+#13;

    Result := Result+'Verbs Provided'+#13+'-------------------'+#13+GetPluginVerbs(PluginIdx);
  end;

end;

function TPCPluginDlg.GetPluginName(PluginIdx: Integer): String;
begin
  If (FPlugins = nil) or (FPlugins.count < PluginIdx+1) then
  begin
    result := '';
  end else begin
    result := Copy(ExtractFileName(FPlugins[PluginIdx]),1,
                   length(ExtractFileName(FPlugins[PluginIdx]))-4);
  end;
end;

function TPCPluginDlg.GetPluginNames: String;
var a: integer;
begin
  result := '';
  if not ((FPlugins = nil) or (FPlugins.count = 0)) then
  begin
    for a := 0 to FPlugins.count -1 do
    begin
      result := result+#13+
                Copy(ExtractFileName(FPlugins[a]),1,
                     length(ExtractFileName(FPlugins[a]))-4);
    end;
  end;
end;

procedure TPCPluginDlg.GetPlugins(List: TStringList);
var a: integer;
begin
  if not ((FPlugins = nil) or (FPlugins.count = 0)) then
  begin
    for a := 0 to FPlugins.count -1 do
    begin
      List.Add(Copy(ExtractFileName(FPlugins[a]),1,
                     length(ExtractFileName(FPlugins[a]))-4));
    end;
  end;
end;

function TPCPluginDlg.GetPluginVerbCount(PluginIdx: Integer): Integer;
var verbs: String;
    List: TstringList;
begin
  verbs := GetPluginVerbs(PluginIdx);
  List := TstringList.Create;
  List.text := Verbs;
  result := List.Count;
  list.Free;
end;

function TPCPluginDlg.GetPluginVerbName(PluginIdx,
  VerbIdx: Integer): String;
var verbs: String;
    List: TstringList;
begin
  result := '';
  verbs := GetPluginVerbs(PluginIdx);
  List := TstringList.Create;
  List.text := Verbs;
  if (VerbIdx > -1) and (VerbIdx < List.Count) then result := List[VerbIdx];
  List.Free;

end;

function TPCPluginDlg.GetPluginVerbs(PluginIdx: integer): String;
var GetVerbsProc : TGetVerbsProc;
Begin
  If (FPlugins = nil) or (FPlugins.count < PluginIdx+1) then
  begin
    result := '';
  end
  else
  begin
    @GetVerbsProc := GetProcAddress(FPluginHandles[PluginIdx],pchar('GetVerbs'));
    if @GetVerbsProc <> nil then
      result := GetVerbsProc;
  end;
end;

function TPCPluginDlg.GetVisible: Boolean;
begin
  Result := Dial.Visible;
end;

procedure TPCPluginDlg.LoadPlugins;
var FileRec:TWIN32FindData;
    FHandle: THandle;
    a,b: integer;
    InitProc : TInitProc;
Begin
  If FDirectory = '' then exit;
  UnLoadPlugins;
  FHandle := FindFirstFile(pchar(FDirectory+'*.pce'),FileRec);
  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    FPlugins.Add(FileRec.cFileName);
    while FindNextFile(Fhandle,FileRec) do
    begin
      FPlugins.Add(FileRec.cFileName);
    end;
  end;
  For a := 0 to FPlugins.count -1 do
  begin
    FPluginHandles[a] := LoadLibrary(pchar(FDirectory+FPlugins[a]));
    @InitProc := GetProcAddress(FPluginHandles[a],pchar('Init'));
    if @InitProc <> nil then
      InitProc(HInstance);
  end;
  b := FPlugins.count;
  FHandle := FindFirstFile(pchar(FDirectory+'*.dll'),FileRec);
  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    FPlugins.Add(FileRec.cFileName);
    while FindNextFile(Fhandle,FileRec) do
    begin
      FPlugins.Add(FileRec.cFileName);
    end;
  end;
  For a := b to FPlugins.count -1 do
  begin
    FPluginHandles[a] := LoadLibrary(pchar(FDirectory+FPlugins[a]));
    @InitProc := GetProcAddress(FPluginHandles[a],pchar('Init'));
    if @InitProc <> nil then
      InitProc(HInstance);
  end;
  SyncronizeContext;
end;

procedure TPCPluginDlg.Locate(px, py: Integer);
begin
  Dial.Left := px;
  Dial.Top := py;
end;


procedure TPCPluginDlg.SetDirectory(const Value: String);
begin
  fDirectory := Value;
  if fDirectory <>  '' then begin
    if fDirectory[Length(fDirectory)] <> '\' then fDirectory := fDirectory + '\';
  end;
  if (fDirectory <>  '') then  RegWrite('PlgDir',Value);
  if not (csDesigning in self.ComponentState) then LoadPlugins;
end;

procedure TPCPluginDlg.Show;
begin
  SyncronizeContext;
  dial.showModal;
end;

procedure TPCPluginDlg.Syncronize;
begin
  If Dial.Visible then SyncronizeContext;
end;

procedure TPCPluginDlg.SyncronizeContext;
var i: Integer;
begin
  Dial.ListBox1.Clear;
  Dial.InfoList.Clear;
  for i := 0 to FPlugins.Count-1 do
  begin
    Dial.Listbox1.Items.Add(Copy(FPlugins[i],1,Length(FPlugins[i])-4));
    Dial.InfoList.Add(GetPluginInfoText(i));
  end;
  Dial.Edit1.text := FDirectory;
end;

procedure TPCPluginDlg.UnLoadPlugins;
var a: integer;
Begin
  For a := 0 to FPlugins.count -1 do
  begin
    FreeLibrary(FPluginHandles[a]);
  end;
  FPlugins.Clear;
end;

end.