[Ocs-comps-commits] OCS2/Samples/VCL/AddinManager/Debug DebugAddin.bpg,NONE,1.1 DebugAddinManager.dpr,NONE,1.1 DebugAddinManager.res,NONE,1.1 DebugShared.pas,NONE,1.1 MainForm.dfm,NONE,1.1 MainForm.pas,NONE,1.1

[Si C. <tec...@us...>]

Update of /cvsroot/ocs-comps/OCS2/Samples/VCL/AddinManager/Debug
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10593/Samples/VCL/AddinManager/Debug

Added Files:
	DebugAddin.bpg DebugAddinManager.dpr DebugAddinManager.res 
	DebugShared.pas MainForm.dfm MainForm.pas 
Log Message:
Initially added to source control

--- NEW FILE: MainForm.pas ---
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, ComCtrls, ImgList, Menus, ExtCtrls, OrckaAddinManager,
  OrckaAddinManagerShared, DebugShared, StdCtrls, Buttons, OrckaButton,
  OrckaFontControls, OrckaSubClass, OrckaInterceptor;

type
  TForm1 = class;
  
  TServerMain = class(TServer)
  private
    FClientList: TList;
    Form: TForm1;
    function GetClient(Index: Integer): TClient;
  public
    constructor Create(Form: TForm1);
    destructor Destroy; override;
    function AddClient(AClient: TClient): Boolean; override;
    function RemoveClient(AClient: TClient): Boolean; override;
    procedure AddString(Value: TLongString); 
    procedure AddInteger(Value: Integer); 
    procedure OnMessage(Msg: TMsg);
    function Count: Integer;
    property Client[Index: Integer]: TClient read GetClient;
  end;
  
  TForm1 = class(TForm)
    OrckaAddinManager1: TOrckaAddinManager;
    ControlBar1: TControlBar;
    MainMenu1: TMainMenu;
    mnuFile: TMenuItem;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    Database1: TDatabase;
    mnuPlugins: TMenuItem;
    mnuPluginsLoad: TMenuItem;
    mnuPluginsUnload: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHelpAbout: TMenuItem;
    mnuFileClose: TMenuItem;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    OrckaFontButton1: TOrckaFontButton;
    OrckaFontButton2: TOrckaFontButton;
    OrckaFontButton3: TOrckaFontButton;
    OrckaButton1: TOrckaButton;
    OrckaFontButton4: TOrckaFontButton;
    OrckaFontButton5: TOrckaFontButton;
    OrckaFontButton6: TOrckaFontButton;
    OrckaButton2: TOrckaButton;
    OrckaFontButton7: TOrckaFontButton;
    OrckaFontButton8: TOrckaFontButton;
    OrckaFontButton9: TOrckaFontButton;
    OrckaButton3: TOrckaButton;
    OrckaFontButton10: TOrckaFontButton;
    RichEdit1: TRichEdit;
    Panel2: TPanel;
    OrckaFontSize1: TOrckaFontSize;
    OrckaFontList1: TOrckaFontList;
    OrckaIntercept1: TOrckaIntercept;
    procedure OrckaAddinManager1GetHandle(Sender: TObject;
      var Hwnd: Integer);
    procedure OrckaAddinManager1GetAddinParams(Sender: TObject;
      AddinManagerParams: TOrckaAddinManagerParams);
    procedure mnuHelpAboutClick(Sender: TObject);
    procedure mnuFileCloseClick(Sender: TObject);
    procedure mnuPluginsLoadClick(Sender: TObject);
    procedure mnuPluginsUnloadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure OrckaFontButton1Click(Sender: TObject;
      ButtonType: TFontButtonTypes);
    procedure OrckaFontButton2Click(Sender: TObject;
      ButtonType: TFontButtonTypes);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RichEdit1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OrckaFontSize1Change(Sender: TObject; FontSize: Word);
  private
    FServerMain: TServerMain;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure OnHint(Sender: TObject);
    procedure OnMsg(var Msg: TMsg; var Handled: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

resourcestring
  sAbout = 'Orcka AddinManager Debug Demo'#13#13'Copyright © 2000. Orcka.';

{ TServerMain }

function TServerMain.AddClient(AClient: TClient): Boolean;
var
  I: Integer;
  ClientName: TShortString;
begin
  Result := True;
  ClientName := AClient.GetName;
  for I := 0 to Count -1 do 
  begin
    try
      if CompareText(ClientName, Client[I].GetName) = 0 then
      begin
        Result := False;
        Break;
      end;
    except
      { Ignore exceptions within the Client }
    end;
  end;
  if Result then
    FClientList.Add(AClient);
end;

procedure TServerMain.AddInteger(Value: Integer);
var
  I: Integer;
begin
  for I := 0 to Count -1 do 
  begin
    try
      Client[I].AddInteger(Value);
    except
      { Ignore exceptions within the Client }
    end;
  end;
end;

procedure TServerMain.AddString(Value: TLongString);
var
  I: Integer;
begin
  for I := 0 to Count -1 do 
  begin
    try
      Client[I].AddString(Value);
    except
      { Ignore exceptions within the Client }
    end;
  end;
end;

function TServerMain.Count: Integer;
begin
  Result := FClientList.Count;
end;

constructor TServerMain.Create;
begin
  FClientList := TList.Create;
end;

destructor TServerMain.Destroy;
begin
  FClientList.Free;
  inherited;
end;

function TServerMain.GetClient(Index: Integer): TClient;
begin
  Result := TClient(FClientList.Items[Index]);
end;

procedure TServerMain.OnMessage(Msg: TMsg);
var
  I: Longint;
begin
  for I := 0 to Count -1 do 
  begin
    try
      if GetParent(Msg.hwnd) = Form1.Handle then
        Client[I].OnMessage(Msg);
    except
      { Ignore exceptions within the Client }
    end;
  end;
end;

function TServerMain.RemoveClient(AClient: TClient): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to Count -1 do 
  begin
    try
      if Client[I] = AClient then
      begin
        FClientList.Items[I] := nil;
        Result := True;
        Break;
      end;
    except
      { Ignore exceptions within the Client }
    end;
  end;
  FClientList.Pack;
end;


{ TForm1 }
procedure TForm1.OrckaAddinManager1GetHandle(Sender: TObject;
  var Hwnd: Integer);
begin
  Hwnd := Handle;
end;

procedure TForm1.OrckaAddinManager1GetAddinParams(Sender: TObject;
  AddinManagerParams: TOrckaAddinManagerParams);
begin
  AddinManagerParams.User := FServerMain;
end;


constructor TForm1.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FServerMain := TServerMain.Create(Self);
  Application.OnHint := OnHint;
  Application.OnMessage := OnMsg;
end;

destructor TForm1.Destroy;
var
  I: Integer;
begin
  Application.OnHint := nil;
  Application.OnMessage := nil;


  for I := 0 to OrckaAddinManager1.Count -1 do
    OrckaAddinManager1.UnloadAddin(OrckaAddinManager1.Addin[I]);

  FServerMain.Free;
  inherited Destroy;
end;

procedure TForm1.mnuHelpAboutClick(Sender: TObject);
begin
  MessageBox(0, Pchar(sAbout), PChar(Caption), MB_OK or MB_ICONINFORMATION);
end;

procedure TForm1.mnuFileCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.mnuPluginsLoadClick(Sender: TObject);
begin
  with OpenDialog1 do
    if Execute then
    begin
      OrckaAddinManager1.LoadAddin(FileName);
      mnuPluginsUnload.Enabled := True;
      mnuPluginsLoad.Enabled := False;
    end;
end;

procedure TForm1.mnuPluginsUnloadClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to OrckaAddinManager1.Count -1 do
    OrckaAddinManager1.UnloadAddin(OrckaAddinManager1.Addin[I]);
  mnuPluginsUnload.Enabled := False;
  mnuPluginsLoad.Enabled := True;
end;

procedure TForm1.OnHint(Sender: TObject);
begin
  StatusBar1.SimpleText := GetLongHint(Application.Hint);
  StatusBar1.SimplePanel := CompareText(StatusBar1.SimpleText, '') <> 0;
end;

procedure TForm1.OnMsg(var Msg: TMsg; var Handled: Boolean);
begin
  FServerMain.OnMessage(Msg);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Align := alClient;
end;

procedure TForm1.OrckaFontButton1Click(Sender: TObject;
  ButtonType: TFontButtonTypes);
begin
  if OrckaFontButton1.Down then
    FServerMain.AddString('Set Bold On')
  else
    FServerMain.AddString('Set Bold Off');
end;

procedure TForm1.OrckaFontButton2Click(Sender: TObject;
  ButtonType: TFontButtonTypes);
begin
  if OrckaFontButton2.Down then
    FServerMain.AddString('Set Italic On')
  else
    FServerMain.AddString('Set Italic Off');
end;

procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FServerMain.AddString('Mouse Down');
  FServerMain.AddInteger(X);
  FServerMain.AddInteger(Y);
end;

procedure TForm1.RichEdit1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FServerMain.AddString('Mouse Up');
  FServerMain.AddInteger(X);
  FServerMain.AddInteger(Y);

end;

procedure TForm1.OrckaFontSize1Change(Sender: TObject; FontSize: Word);
begin
  FServerMain.AddString('New Font Size');
  FServerMain.AddInteger(FontSize);
end;

end.

--- NEW FILE: MainForm.dfm ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: DebugAddinManager.dpr ---
program DebugAddinManager;

uses
  Forms,
  MainForm in 'MainForm.pas' {Form1},
  DebugShared in 'DebugShared.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

--- NEW FILE: DebugAddinManager.res ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: DebugAddin.bpg ---
#------------------------------------------------------------------------------
VERSION = BWS.01
#------------------------------------------------------------------------------
!ifndef ROOT
ROOT = $(MAKEDIR)\..
!endif
#------------------------------------------------------------------------------
MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**
DCC = $(ROOT)\bin\dcc32.exe $**
BRCC = $(ROOT)\bin\brcc32.exe $**
#------------------------------------------------------------------------------
PROJECTS = Debug.dll DebugAddinManager.exe
#------------------------------------------------------------------------------
default: $(PROJECTS)
#------------------------------------------------------------------------------

Debug.dll: DebugPlugin\Debug.dpr
  $(DCC)

DebugAddinManager.exe: DebugAddinManager.dpr
  $(DCC)



--- NEW FILE: DebugShared.pas ---
unit DebugShared;

interface

uses
  Windows;
  
type
  TShortString = array[0..60] of char;
  TLongString = array[0..255] of char;
  
  TClient = class
  public
    function GetName: TShortString; virtual; abstract;
    procedure AddString(Value: TLongString); virtual; abstract;
    procedure AddInteger(Value: Integer); virtual; abstract;
    procedure OnMessage(Msg: TMsg); virtual; abstract;
  end;
  
  TServer = class
  public
    function AddClient(AClient: TClient): Boolean; virtual; abstract;
    function RemoveClient(AClient: TClient): Boolean; virtual; abstract;
  end;
  
implementation

end.