CD Actual Thematic 25: Programming/pc_actual_25.iso/Delphi/eXpertDevelopmentKit/SOURCE/XDKEXPT.PAS

Pascal/Delphi Source File | 1998-01-26 | 6.4 KB | 251 lines

{*******************************************************}
{                                                       }
{       eXpert Development Kit                          }
{                                                       }
{       Copyright (c) 1996,97 Sergey Orlik              }
{       - product manager of Borland Russia             }
{                                                       }
{*******************************************************}
Unit XDKExpt;

interface

uses
  Windows, SysUtils, Classes, Graphics, Forms, Dialogs, Menus,
  DsgnIntf, ExptIntf, EditIntf, FileIntf, ToolIntf, LibIntf;

type
  TRepositoryExpertStyle = (esrForm,esrProject);

type
  ExdkExpertError = class(Exception);
  TxdkExpert = class;

  TxdkIExpert = class(TIExpert)
  private
    FOwner  : TxdkExpert;
  public
    function GetName: string; override;
    function GetAuthor: string; override;
    function GetComment: string; override;
    function GetPage: string; override;
    function GetGlyph: HICON; override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;
    procedure Execute; override;
  end;

  TxdkExpert = class(TComponent)
  private
    FIExpert   : TxdkIExpert;
    FExpertName: string;
    FAuthor    : string;
    FComment   : string;
    FPage      : string;
    FGlyph     : TIcon;
    FStyle     : TExpertStyle;
    FState     : TExpertState;
    FMenuText  : string;
    FOnExecute : TNotifyEvent;
  protected
    property ExpertName:string read FExpertName write FExpertName;
    property Author:string read FAuthor write FAuthor;
    property Comment:string read FComment write FComment;
    property Page:string read FPage write FPage;
    property State:TExpertState read FState write FState default [esEnabled];
    property MenuText:string read FMenuText write FMenuText;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
  end;

  TxdkStandardExpert = class(TxdkExpert)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ExpertName;
    property State;
    property MenuText;
  end;

  TxdkRepositoryExpert = class(TxdkExpert)
  private
    FRStyle : TRepositoryExpertStyle;
    procedure SetGlyph(Icon:TIcon); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property ExpertName;
    property Author;
    property Comment;
    property Page;
    property Glyph:TIcon read FGlyph write SetGlyph;
    property RStyle:TRepositoryExpertStyle read FRStyle write FRStyle default esrForm;
  end;


//====================================================================
implementation
//====================================================================

const
  sInvalidExpertName = 'Expert name for %s can''t be empty!';
  sInvalidMenuText = 'Menu text for %s can''t be empty!';

procedure Error(const S: string;ExpertComponent:TxdkExpert);
begin
  raise ExdkExpertError.Create(Format(S,[ExpertComponent.Name]));
end;

//====================================================================
// TxdkIExpert
function TxdkIExpert.GetName: string;
begin
  Result:=FOwner.FExpertName
end;

function TxdkIExpert.GetAuthor: string;
begin
  if FOwner.FAuthor<>'' then
    Result:=FOwner.FAuthor
  else
    Result:='AuthorOf_'+FOwner.Name;
end;

function TxdkIExpert.GetComment: string;
begin
  Result:=FOwner.FComment;
end;

function TxdkIExpert.GetPage: string;
begin
  Result:=FOwner.FPage;
  if Result=EmptyStr then
  begin
    if FOwner.FStyle=esForm then
      Result:='Forms'
    else
      Result:='Projects';
  end;
end;

function TxdkIExpert.GetGlyph: HICON;
begin
  if Assigned(FOwner) then
    if (FOwner is TxdkRepositoryExpert) and Assigned(FOwner.FGlyph) then
    begin
      Result:=(FOwner as TxdkRepositoryExpert).FGlyph.Handle;
      (FOwner as TxdkRepositoryExpert).FGlyph.ReleaseHandle;
    end;
end;

function TxdkIExpert.GetStyle:TExpertStyle;
begin
  Result:=FOwner.FStyle;
end;

function TxdkIExpert.GetState:TExpertState;
begin
  Result:=FOwner.FState;
end;

function TxdkIExpert.GetIDString: string;
begin
  Result:=FOwner.ExpertName;
end;

function TxdkIExpert.GetMenuText: string;
begin
  Result:=FOwner.FMenuText;
end;

procedure TxdkIExpert.Execute;
begin
  if Assigned(FOwner) and Assigned(FOwner.FOnExecute) then
    FOwner.OnExecute(FOwner);
end;

//====================================================================
// TxdkExpert
constructor TxdkExpert.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIExpert:=TxdkIExpert.Create;
  FIExpert.FOwner:=Self;
  FState:=[esEnabled];
end;

procedure TxdkExpert.Loaded;
begin
  inherited Loaded;
  if not (csDesigning in ComponentState) then
  begin
    if FExpertName=EmptyStr then
      Error(sInvalidExpertName,Self);
    if FStyle=esStandard then
      if FMenuText=EmptyStr then
        Error(sInvalidMenuText,Self);

  //Add expert to IDE
    DelphiIDE.AddExpert(FIExpert);
  end;
end;

destructor TxdkExpert.Destroy;
begin
  //Remove expert from IDE
  if not (csDesigning in ComponentState) then
    DelphiIDE.RemoveExpert(FIExpert);
  FIExpert.Free;
  inherited Destroy;
end;

//=====================================================================
// TxdkStandardExpert
constructor TxdkStandardExpert.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStyle:=esStandard;
end;

//=====================================================================
// TxdkRepositoryExpert
constructor TxdkRepositoryExpert.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGlyph:=TIcon.Create;
  FRStyle:=esrForm;
  FStyle:=esForm;
end;

destructor TxdkRepositoryExpert.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;

procedure TxdkRepositoryExpert.Loaded;
begin
  inherited Loaded;
  if FRStyle=esrForm then
    FStyle:=esForm
  else
    FStyle:=esProject;
end;

procedure TxdkRepositoryExpert.SetGlyph(Icon:TIcon);
begin
  FGlyph.Assign(Icon);
end;

//=====================================================================

end.