Componentes.Terceros.jvcl/official/3.32/run/JvPlugin.pas

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: uilPlugin.PAS, released on 1999-09-06.

The Initial Developer of the Original Code is Tim Sullivan [tim att uil dott net]
Portions created by Tim Sullivan are Copyright (C) 1999 Tim Sullivan.
All Rights Reserved.

Contributor(s):
Ralf Steinhaeusser [ralfiii att gmx dott net].
Gustavo Bianconi
Steefan Lesage - converted to use new OTA

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:

Todo : Why the "stdcall" definitions ? (routines Configure, Initialize...)
       Why the TriggerConfigureEvent (and similar) procedures ? necessary ?
       What for the GlobalNameSpace.BeginWrite ?
-----------------------------------------------------------------------------}
// $Id: JvPlugin.pas 10612 2006-05-19 19:04:09Z jfudickar $

unit JvPlugin;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils,
  {$IFDEF VCL}
  Forms, Graphics,
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  QForms, QGraphics,
  {$ENDIF VisualCLX}
  Classes;

type
  TPluginMessageEvent = procedure(Sender: TObject; APluginMessage: Longint; AMessageText: string) of object;
  TPluginInitializeEvent = procedure(Sender: TObject; var AllowLoad: Boolean) of object;
  TJvPluginCommand = class;
  TJvPluginCommands = class;

  TJvPlugIn = class(TDataModule)
  private
    FPluginID: string;
    FAuthor: string;
    FCopyright: string;
    FDescription: string;
    FFileName: TFileName;
    FCommands: TJvPluginCommands;
    FHostApplication: TApplication;
    FManager: TComponent;
    FInstanceCount: Integer;
    FOnPluginMessage: TPluginMessageEvent;
    FOnInitialize: TPluginInitializeEvent;
    FOnConfigure: TNotifyEvent;
    FPluginVersion: string;
//    function GetVersion: string;
//    procedure SetVersion(newValue: string);
  protected
    procedure SetCommands(NewValue: TJvPluginCommands); virtual;
    procedure TriggerPluginMessageEvent(APluginMessage: Longint; AMessageText: string); virtual;
    procedure TriggerInitializeEvent(var AllowLoad: Boolean); virtual;
    procedure TriggerConfigureEvent; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Configure; virtual; stdcall;
    function Initialize(Manager: TComponent; HostApplication: TApplication;
      FileName: string): Boolean; virtual; stdcall;
    procedure SendPluginMessage(APluginMessage: Longint; AMessageText: string);
    property HostApplication: TApplication read FHostApplication;
    property Manager: TComponent read FManager;
    property FileName: TFileName read FFileName;
  published
    property Author: string read FAuthor write FAuthor;
    property Commands: TJvPluginCommands read FCommands write SetCommands;
    property Description: string read FDescription write FDescription;
    property Copyright: string read FCopyright write FCopyright;
    property InstanceCount: Integer read FInstanceCount write FInstanceCount default 1;
    property PluginID: string read FPluginID write FPluginID;
//    property Version: string read GetVersion write SetVersion;
    property PluginVersion: string read FPluginVersion write FPluginVersion;
    property OnPluginMessage: TPluginMessageEvent read FOnPluginMessage write FOnPluginMessage;
    property OnInitialize: TPluginInitializeEvent read FOnInitialize write FOnInitialize;
    property OnConfigure: TNotifyEvent read FOnConfigure write FOnConfigure;
  end;

  TJvPluginCommand = class(TCollectionItem)
  private
    FName: string;
    FCaption: string;
    FHint: string;
    FData: string;
    FShortCut: TShortCut;
    FBitmap: TBitmap;
    FOnExecute: TNotifyEvent;
    procedure SetBitmap(Value: TBitmap);
  protected
    function GetDisplayName: string; override;
  published
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property Caption: string read FCaption write FCaption;
    property Hint: string read FHint write FHint;
    property Data: string read FData write FData;
    property Name: string read FName write FName;
    property ShortCut: TShortCut read FShortCut write FShortCut;
    property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
  end;

  TJvPluginCommands = class(TCollection)
  private
    FPlugin: TJvPlugIn;
  protected
    function GetOwner: TPersistent; override;
    procedure SetItemName(AItem: TCollectionItem); override;
  public
    constructor Create(APlugIn: TJvPlugIn);
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvPlugin.pas $';
    Revision: '$Revision: 10612 $';
    Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JvResources;

//=== { TJvPlugin } ==========================================================

constructor TJvPlugIn.Create(AOwner: TComponent);
begin
  try
    // Create datamodule
    CreateNew(AOwner);
    DesignSize := Point(100, 100);

    // Create commands-collection
    FCommands := TJvPluginCommands.Create(Self);

    FInstanceCount := 1;
    if (ClassType <> TJvPlugIn) and not (csDesigning in ComponentState) then
    begin
      if not InitInheritedComponent(Self, TJvPlugIn) then
        raise EResNotFound.CreateResFmt(@RsEFmtResNotFound, [ClassName]);

      // (rom) why this ?
      if Assigned(OnCreate) then
        OnCreate(Self);
    end;
  finally
  end;
end;

destructor TJvPlugIn.Destroy;
begin
  Commands.Free;
  inherited Destroy;
end;

procedure TJvPlugIn.SetCommands(NewValue: TJvPluginCommands);
begin
  FCommands.Assign(NewValue);
end;

// Show Versionsstring defined in JvPlugCommon

{function TJvPlugin.GetVersion: string;
begin
  Result := C_VersionString;
end;

procedure TJvPlugin.SetVersion(newValue: string);
begin
end;}

// Here the plugin should verify if it CAN be loaded (e.g. Main application implements correct interface,
//      Dongle is there....)

function TJvPlugIn.Initialize(Manager: TComponent; HostApplication: TApplication; FileName: string): Boolean;
begin
  Result := True;
  FHostApplication := HostApplication;
  FFileName := FileName;
  FManager := Manager;
  TriggerInitializeEvent(Result);
end;

procedure TJvPlugIn.Configure;
begin
  TriggerConfigureEvent;
end;

procedure TJvPlugIn.TriggerPluginMessageEvent(APluginMessage: Longint; AMessageText: string);
begin
  if Assigned(FOnPluginMessage) then
    FOnPluginMessage(Self, APluginMessage, AMessageText);
end;

procedure TJvPlugIn.TriggerInitializeEvent(var AllowLoad: Boolean);
begin
  if Assigned(FOnInitialize) then
    FOnInitialize(Self, AllowLoad);
end;

procedure TJvPlugIn.TriggerConfigureEvent;
begin
  if Assigned(FOnConfigure) then
    FOnConfigure(Self);
end;

procedure TJvPlugIn.SendPluginMessage(APluginMessage: Integer; AMessageText: string);
begin
  TriggerPluginMessageEvent(APluginMessage, AMessageText);
end;

//=== { TJvPluginCommand } ===================================================

constructor TJvPluginCommand.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FBitmap := TBitmap.Create;
  FShortCut := 0;
end;

destructor TJvPluginCommand.Destroy;
begin
  FBitmap.Free;
  inherited Destroy;
end;

function TJvPluginCommand.GetDisplayName: string;
begin
  Result := Name;
  if Result = '' then
    Result := inherited GetDisplayName;
end;

procedure TJvPluginCommand.SetBitmap(Value: TBitmap);
begin
  FBitmap.Assign(Value)
end;

//=== { TJvPluginCommands } ==================================================

constructor TJvPluginCommands.Create(APlugIn: TJvPlugIn);
begin
  inherited Create(TJvPluginCommand);
  FPlugin := APlugIn;
end;

function TJvPluginCommands.GetOwner: TPersistent;
begin
  Result := FPlugin;
end;

procedure TJvPluginCommands.SetItemName(AItem: TCollectionItem);
var
  I: Integer;
  J: Integer;

  function NameUsed: Boolean;
  var
    AName: string;
  begin
    AName := Format('Command%d', [I]);
    J := AItem.Collection.Count - 1;
    while (J > -1) and not AnsiSameText(TJvPluginCommand(AItem.Collection.Items[J]).Name, AName) do
      Dec(J);
    Result := J > -1;
  end;

  procedure FindCmdIdx;
  begin
    I := 1;
    while (I < MaxInt) and NameUsed do
      Inc(I);
  end;

begin
  with TJvPluginCommand(AItem) do
    if Name = '' then
    begin
      FindCmdIdx;
      Name := Format('Command%d', [I]);
    end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.