(*************************************************)
(*   BP 7.0/TPW 1.5 OWL program to show tool	   *)
(*	 class in use.      												 *)
(*                                               *)
(*  (c) Copyright 1993. Castle Computer Services *)
(*  All rights reserved.                         *)
(*                                               *)
(*  Author : G.T. Swindell                       *)
(*************************************************)

Program TestTool;
{$R testtool.res}

Uses
	WinDos, WinCrt, WinTypes, WinProcs, Strings,
	{$IFDEF VER15}
	WObjects,
	{$ELSE}
	Objects, OWindows, ODialogs,
	{$ENDIF}
	Tools, BWCC;

const
	app_name : PChar = 'TestTool';

	id_ToolBar = 200;

	id_FirstButton = 100;

	cm_button1 = wm_User + 100;
	cm_button2 = wm_User + 101;
	cm_Button3 = Wm_User + 102;

Type
	PTestTool = ^TTestTool;
	TTestTool = object(TToolWindow) { Use TToolWindow as the parent class}
		Constructor Init(AParent : PWindowsObject; AName : PChar);
		Procedure GetWindowClass(var AWndClass : TWndClass); virtual;
		Procedure SetupWindow; virtual;
		Procedure Button1Pressed(var MSg : TMessage); virtual cm_first + cm_Button1;
		Procedure Button2Pressed(var MSg : TMessage); virtual cm_first + cm_Button2;
		Procedure Button3Pressed(var MSg : TMessage); virtual cm_first + cm_Button3;
	end;

Constructor TTestTool.Init(AParent : PWindowsObject; AName : PChar);
Var
	Buts : Array[0..3] of TBButton;
	ButtonInfo : TToolBarInfo;
	StatusInfo : TStatusInfo;

begin
	{ Set up the buttons for the toolbar }

	{ Each button and space on the toolbar is represented by a record within }
	{ an array of TBButton. See TOOLS.PAS for more info. }

	With Buts[0] do
	begin
		iBitMap := 0;                { postion 0 in bitmap }
		idCommand := cm_Button1;
		fsState := TBState_Enabled;
		fsStyle := TBStyle_Button;
		idsHelp := 0;
	end;

	With Buts[1] do  { This one is a Space }
	begin
		iBitMap := 0;
		idCommand := 0;
		fsState := TBState_Enabled;
		fsStyle := TBStyle_Sep;
    idsHelp := 0;
  end;

  With Buts[2] do
  begin
    iBitMap := 1;
    idCommand := cm_Button2;
    fsState := TBState_Enabled;
    fsStyle := TBStyle_Button;
    idsHelp := 1;
  end;

  With Buts[3] do
  begin
    iBitMap := 2;
    idCommand := cm_Button3;
    fsState := TBState_Enabled;
    fsStyle := TBStyle_Button;
    idsHelp := 2;
  end;

  With ButtonInfo do
  begin
    Style := WS_Border or WS_Child or WS_Visible;
    ToolBarID := id_toolbar;
    NoBitmaps := 3;
    BMInst := hInstance;
    BMID := 100;
    Buttons := @Buts[0];
    NoButtons := 4;
  end;

  { Set up the statusbar information }

  With StatusInfo do
  begin
    Style := WS_Border or WS_Child or WS_Visible;
    StatusID := 201;
    OrigText := NIL;
    NoOfParts := 2;
    Parts[0] := 90;  { First divide at 90 pixcels from left }
    Parts[1] := -1;  { -1 for final section = finish at right of window }
    HelpStatusPart := 1;  { Send help to 2nd section. Section ID's start at zero }
  end;

  TToolWindow.Init(AParent, AName, ButtonInfo, StatusInfo);

  Attr.Menu := LoadMenu(hInstance, App_Name);
end;

Procedure TTestTool.GetWindowClass(var AWndClass : TWndClass);
begin
  TToolWindow.GetWindowClass(AWndClass);
  With AWndClass do
    hIcon := LoadIcon(hInstance, App_Name);
end;

Procedure TTestTool.SetupWindow;
Const
  DatePattern : PChar = '%02d - %02d - %04d';
var
  Date : Array[0..14] of Char;
  D, M, Y, DOW : Word;
  ArgList : Array[0..2] of Word;

begin
  TToolWindow.SetupWindow;

  { setup the date for the first section of the statusbar}
  GetDate(Y, M, D, DOW);
  ArgList[0] := D;
  ArgList[1] := M;
  ArgList[2] := Y;
  wvsprintf(Date, DatePattern, ArgList);
  SetStatusText(0, 0, Date);
end;

Procedure TTestTool.Button1Pressed(var Msg : TMessage);
begin
  MessageBox(hWindow, 'Button 1 Pressed', app_Name, MB_IconInformation + MB_OK);
end;

Procedure TTestTool.Button2Pressed(var Msg : TMessage);
begin
  MessageBox(hWindow, 'Button 2 Pressed', app_Name, MB_IconInformation + MB_OK);
end;

Procedure TTestTool.Button3Pressed(var Msg : TMessage);
begin
  MessageBox(hWindow, 'Button 3 Pressed', app_Name, MB_IconInformation + MB_OK);
end;

Type { Main application class }
  TTestToolApp = object(TApplication)
    Procedure InitMainWindow; virtual;
  end;

Procedure TTestToolApp.InitMainWindow;
begin
  MainWindow := New(PTestTool, Init(Nil, 'Tool Unit Test Program'));
end;

var
  ATesting_App : TTestToolApp;

begin
  With ATesting_App do
  begin
    Init(App_Name);
    Run;
    Done;
  end;
end.