[Ocs-comps-commits] OCS2/Samples/VCL/AddinManager/Debug/DebugPlugin Debug.dpr,NONE,1.1 Debug.res,NONE,1.1 DebugSample.pas,NONE,1.1 DebugWindows.dfm,NONE,1.1 DebugWindows.pas,NONE,1.1

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

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

Added Files:
	Debug.dpr Debug.res DebugSample.pas DebugWindows.dfm 
	DebugWindows.pas 
Log Message:
Initially added to source control

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

interface

uses Windows, DebugShared, OrckaAddinManagerShared;

type
  TDebugClient = class(TClient)
  private
    FService: TOToolServices;
    FServer: TServer;
  public
    constructor Create(Service: TOToolServices; Server: TServer);
    destructor Destroy; override;
    function GetName: TShortString; override;
    procedure AddString(Value: TLongString); override;
    procedure AddInteger(Value: Integer); override;
    procedure OnMessage(Msg: TMsg); override;
  end;
  
function Plugin (InParams: TOrckaAddinManagerParams; 
  var ExitProc: Pointer): Boolean; stdcall;

exports
Plugin name OrckaAddinManagerExportProc;

var
  DebugClient: TDebugClient;


implementation

uses DebugWindows, Forms, Messages;

procedure PluginExit; stdcall;
begin
  DebugClient.Free;
end;

function Plugin (InParams: TOrckaAddinManagerParams; 
  var ExitProc: Pointer): Boolean; stdcall;
begin
  DebugClient := TDebugClient.Create(InParams.Service, TServer(InParams.User));
  ExitProc := @PluginExit;
  Result := True;
end;

exports
Plugin name OrckaAddinManagerExportProc;

{ TDebugClient }

procedure TDebugClient.AddInteger(Value: Integer);
begin
  Form2.AddInteger(Value);
end;

procedure TDebugClient.AddString(Value: TLongString);
begin
  Form2.AddString(Value);
end;

constructor TDebugClient.Create(Service: TOToolServices; Server: TServer);
begin
  FServer := Server;
  FService := Service;
  FServer.AddClient(Self);
  Form2 := TForm2.Create(nil);
  Form2.Show;
end;

destructor TDebugClient.Destroy;
begin
  FServer.RemoveClient(Self);
  Form2.Free;
  inherited;
end;

function TDebugClient.GetName: TShortString;
begin
  Result := 'DebugSample'
end;

procedure TDebugClient.OnMessage(Msg: TMsg);
begin
  if Msg.message <> WM_MOUSEMOVE then
    Form2.AddMessage(Msg);
end;

end.

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

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TForm2 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ListView1: TListView;
  private
    { Private declarations }
  public
    procedure AddString(Value: string);
    procedure AddInteger(Value: Integer);
    procedure AddMessage(Value: TMsg);
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

uses WinMsg;

{ TForm2 }

procedure TForm2.AddInteger(Value: Integer);
begin
  ListBox2.Items.Add(IntToStr(Value));
  ListBox2.ItemIndex := ListBox2.Items.Count -1;
end;

procedure TForm2.AddMessage(Value: TMsg);

  function GetControlName: string;
  var
    CtlName: PChar;
    Len: Integer;
  begin
    Len := 100;
    CtlName := StrAlloc(Len + 1);
    try
      Len := GetClassName(Value.hwnd, CtlName, Len);
      Result := Copy(CtlName, 1, Len);
    finally
      StrDispose(CtlName);
    end;
  end;
  
var
  ListItem: TListItem;
  s: string;
begin
  GetMessageText(Value.message, 0, s);
  ListItem := ListView1.Items.Add;
  ListItem.Caption := GetControlName;
  ListItem.SubItems.Add(s);
  ListItem.SubItems.Add(IntToStr(Value.wParam));
  ListItem.SubItems.Add(IntToStr(Value.lParam));
  ListView1.Selected := ListItem;
end;

procedure TForm2.AddString(Value: string);
begin
  ListBox1.Items.Add(Value);
  ListBox1.ItemIndex := ListBox1.Items.Count -1;
end;

end.

--- NEW FILE: Debug.dpr ---
library Debug;


uses
  DebugShared in '..\DebugShared.pas',
  DebugSample in 'DebugSample.pas',
  DebugWindows in 'DebugWindows.pas' {Form2};

{$R *.RES}

begin
end.
 
--- NEW FILE: DebugWindows.dfm ---
object Form2: TForm2
  Left = 404
  Top = 134
  Width = 581
  Height = 397
  Caption = 'Debug Windows'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 0
    Top = 214
    Width = 573
    Height = 3
    Cursor = crVSplit
    Align = alBottom
  end
  object Splitter2: TSplitter
    Left = 305
    Top = 0
    Width = 3
    Height = 214
    Cursor = crHSplit
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 305
    Height = 214
    Align = alLeft
    TabOrder = 0
    object Label1: TLabel
      Left = 1
      Top = 1
      Width = 303
      Height = 28
      Align = alTop
      Caption = 'Strings'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -20
      Font.Name = 'Comic Sans MS'
      Font.Style = []
      ParentFont = False
    end
    object ListBox1: TListBox
      Left = 1
      Top = 29
      Width = 303
      Height = 184
      Align = alClient
      ItemHeight = 13
      TabOrder = 0
    end
  end
  object Panel2: TPanel
    Left = 308
    Top = 0
    Width = 265
    Height = 214
    Align = alClient
    TabOrder = 1
    object Label2: TLabel
      Left = 1
      Top = 1
      Width = 263
      Height = 28
      Align = alTop
      Caption = 'Integers'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -20
      Font.Name = 'Comic Sans MS'
      Font.Style = []
      ParentFont = False
    end
    object ListBox2: TListBox
      Left = 1
      Top = 29
      Width = 263
      Height = 184
      Align = alClient
      ItemHeight = 13
      TabOrder = 0
    end
  end
  object Panel3: TPanel
    Left = 0
    Top = 217
    Width = 573
    Height = 153
    Align = alBottom
    TabOrder = 2
    object Label3: TLabel
      Left = 1
      Top = 1
      Width = 571
      Height = 28
      Align = alTop
      Caption = 'Messages'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -20
      Font.Name = 'Comic Sans MS'
      Font.Style = []
      ParentFont = False
    end
    object ListView1: TListView
      Left = 1
      Top = 29
      Width = 571
      Height = 123
      Align = alClient
      Columns = <
        item
          Caption = 'Control'
          Width = 150
        end
        item
          Caption = 'Message'
          Width = 100
        end
        item
          Caption = 'wParam'
          Width = 100
        end
        item
          Caption = 'lParam'
          Width = 100
        end>
      TabOrder = 0
      ViewStyle = vsReport
    end
  end
end