{WOPLUS - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
unit WOPlus;


{******************************************************************}
{ I N T E R F A C E                                                        }
{******************************************************************}
interface
uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;
type
PODButton = ^TODButton;
TODButton = object(TButton)
	HBmp :HBitmap;
   State:Integer;
   constructor	Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
   	X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
   destructor	Done;virtual;
   procedure	DrawItem(var Msg:TMessage);virtual;
end;


type
	PStackStr = ^TStackStr;
   TStackStr = object(TObject)
   	StackStr:PChar;
      constructor Init(NewStr:PChar);
      destructor Done;virtual;
	end;

type
	PStackInt = ^TStackInt;
   TStackInt = object(TObject)
   	StackInt:Integer;
      constructor Init(NewInt:Integer);
      destructor Done;virtual;
	end;

type
	PStack = ^TStack;
	TStack = object(TCollection)
   	procedure Push(Item:Pointer);virtual;
      function Pop:Pointer;virtual;
   end;


{TTextStream}
type
PTextStream = ^TTextStream ;
TTextStream = object(TBufStream)
   CharsToRead : LongInt;
   CharsRead : LongInt;
   ARecord :PChar;
   constructor Init(FileName:PChar;Mode,Size:Word);
   destructor Done;virtual;
   function GetNext:PChar;virtual;
   function WriteNext(szARecord:PChar):integer;virtual;
   function WriteEOF:integer;virtual;
   function IsEOF:Boolean;virtual;
   function GetPctDone:Integer;
end;


{TMeter}
type
	PMeterWindow = ^TMeterWindow;
   TMeterWindow = object(TWindow)
   	TheRedBrush:HBrush;
      TheBlueBrush:Hbrush;
      ThePen:HPen;
      X,Y,dX,dY,mX :Integer;
      PctDone :Integer;
   constructor Init(AParent:PWindowsObject;ATitle:PChar);
   procedure   SetupWindow;virtual;
   destructor  Done; virtual;
   procedure   Draw(NewPctDone:Integer);virtual;
   procedure	Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
end;

{********************************************************************}
{I M P L E M E N T A T I O N                                                     }
{********************************************************************}
implementation

{***********************************************************************}

constructor	TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
   	X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
begin
	TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
   Attr.Style := Attr.Style or bs_OwnerDraw;
   HBmp := LoadBitmap(HInstance,BMP);
end;

destructor	TODButton.Done;
begin
	TButton.Done;
	DeleteObject(HBmp);
end;


procedure	TODButton.DrawItem(var Msg:TMessage);
var
	TheDC:HDc;
	ThePen:HPen;
   Pen1:HPen;
   Pen2:HPen;
   TheBrush :HBrush;
   OldBrush :HBrush;
   OldPen:HPen;
   OldBitMap:HBitMap;
   MemDC :HDC;
   LPts:Array[0..2] of TPoint;
   RPts:Array[0..2] of TPoint;
   PDIS :^TDrawItemStruct;
   X,Y,W,H:Integer;
begin
	PDIS := Pointer(Msg.lParam);
   if PDIS^.itemAction = oda_Focus then Exit;
	if ((PDIS^.itemAction and oda_Select ) > 0) and
   	((PDIS^.itemState and ods_Selected) > 0) then
   	State := 1 else State := 0; ;

   X := PDIS^.rcItem.left;Y := PDIS^.rcItem.top;
   W := PDIS^.rcItem.right-PDIS^.rcItem.left;
   H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
   LPts[0].x := W; LPts[0].y := 0;
   LPts[1].x := 0; LPts[1].y := 0;
   LPts[2].x := 0; LPts[2].y := H;
   RPts[0].x := 0; RPts[0].y := H;
   RPts[1].x := W; RPts[1].y := H;
   RPts[2].x := W; RPts[2].y := 0;
   MemDC := CreateCompatibleDC(PDIS^.HDC);
   OldBitMap := SelectObject(MemDC,HBMP);
   if State = 0 then
   	BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
   else
      BitBlt(PDIS^.HDC,X+2,Y+2,W,H, MemDC,0,0,SrcCopy);
   SelectObject(MemDC,OldBitMap);
   DeleteDC(MemDC);

	Pen1 := CreatePen(ps_Solid,2,$00000000);
   OldPen := SelectObject(PDIS^.HDC,Pen1);
   PolyLine(PDIS^.HDC,LPts,3);
   PolyLine(PDIS^.HDC,RPts,3);
   SelectObject(PDIS^.HDC,OldPen);
   DeleteObject(Pen1);

   LPts[0].x := W-2; LPts[0].y := 2;
   LPts[1].x := 2; LPts[1].y := 2;
   LPts[2].x := 2;LPts[2].y := H-2;
   RPts[0].x := 1; RPts[0].y := H-1;
   RPts[1].x := W-1; RPts[1].y := H-1;
   RPts[2].x := W-1; RPts[2].y := 1;
   if State = 0 then
   	begin
		Pen1 := CreatePen(ps_Solid,2,$00FFFFFF);
      Pen2 := CreatePen(ps_Solid,2,$00808080);
      end
   else
   	begin
		Pen2 := CreatePen(ps_Solid,1,$00808080);
      Pen1 := CreatePen(ps_Solid,2,$00808080);
      end;

   OldPen := SelectObject(PDIS^.HDC,Pen1);
   PolyLine(PDIS^.HDC,LPts,3);

   SelectObject(PDIS^.HDC,Pen2);
   DeleteObject(Pen1);

   PolyLine(PDIS^.HDC,RPts,3);
   SelectObject(PDIS^.HDC,OldPen);
   DeleteObject(Pen2);

end;


{***********************************************************************}
constructor TStackStr.Init(NewStr:PChar);
begin
	StackStr := StrNew(NewStr);
end;

destructor TStackStr.Done;
begin
	StrDispose(StackStr);
end;

{***********************************************************************}
constructor TStackInt.Init(NewInt:Integer);
begin
	StackInt := NewInt;
end;

destructor TStackInt.Done;
begin

end;
{***********************************************************************}
procedure TStack.Push(Item:Pointer);
begin
	AtInsert(0,Item);
end;

function TStack.Pop:Pointer;
begin
	Pop := At(0);
   AtDelete(0);
end;


{***********************************************************************}
{TTextStream Methods}
constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
begin
	TBufStream.Init(FileName,Mode,Size);
   CharsRead := 0;
   CharsToRead := TBufStream.GetSize;
   ARecord := MemAlloc(32000);
end;

{Done}
destructor TTextStream.Done;
begin
	TBufStream.Done;
   FreeMem(ARecord,32000);
end;

{GetNext}
function TTextStream.GetNext:PChar;
var
	Blksize:Integer;
   AChar:Char;
   Indx : Integer;
   IsEOR : Boolean;
begin
   Indx := 0;
   IsEOR := False;
   ARecord[0] := #0;
   while (CharsRead < CharsToRead) and (IsEOR = False) do
   begin
   	TBufStream.Read(AChar,1);
      Inc(CharsRead);
      if (AChar = #13) then
      	begin
         ARecord[Indx] := #0;
         IsEOR := True;
         end
      else if (AChar = #10) then
      	begin
         end
      else if (AChar = #26) then
      	begin
         end
      else 
      	begin
         ARecord[Indx] := AChar;
         inc(Indx);
         end
   end;
   GetNext := ARecord;
end;

{WriteNext}
{This method not actually used due to performance loss - instead
   TStream.Write is called directly}
function TTextStream.WriteNext(szARecord:PChar):Integer;
const
  CRLF : Array[0..2] of Char = #13#10#0;

begin
      TBufStream.Write(szARecord,
      	StrLen(szARecord));
      TBufStream.Write(CRLF,2);
      WriteNext := StrLen(szARecord);
end;

{WriteEOF}
function TTextStream.WriteEOF:Integer;
const
	  EOF : Array[0..1] of Char  = #26;
begin
	TBufStream.Write(EOF,1);
   WriteEOF := 1;
end;

{IsEOF}
function TTextStream.IsEOF:Boolean;
begin
	IsEOF := False;
   if CharsRead >= CharsToRead then
   	IsEOF := True;
end;

{GetPctDone}
function TTextStream.GetPctDone:Integer;
begin
	GetPctDone := CharsRead*100 div CharsToRead;
end;


{**********************************************************************}
{TMeterWindow Methods}
{Init}
constructor TMeterWindow.Init(Aparent:PWindowsObject;ATitle:PChar);
begin
	TWindow.Init(AParent,ATitle);
   DisableAutoCreate;
 	ThePen := CreatePen(ps_Solid,3,$00000000);
   TheBlueBrush := CreateSolidBrush(RGB(0,0,255));
   TheRedBrush  := CreateSolidBrush(RGB(255,0,0));
   with Attr do
   	begin
      X := 100;Y :=100 ;W := 350;H := 75;
      Style := ws_Popup or ws_Visible or ws_Border or ws_Caption;
   end;
   X := 50;
   Y := 10;
   dX := 275;
   dY := 30;
   mX := 50;   {midpoint between X & X+dX}
   PctDone := 0;
end;

procedure TMeterWindow.SetupWindow;
begin
	TWindow.SetupWindow;
	SetClassWord(HWindow,GCW_HICON,LoadIcon(HInstance,'WS_Icon'));
end;

{Done}
destructor TMeterWindow.Done;
begin
 	DeleteObject(TheBlueBrush);
   DeleteObject(TheRedBrush);
   DeleteObject(ThePen);
   Destroy;
   TWindow.Done;
end;

procedure TMeterWindow.Draw(NewPctDone:Integer);
begin
	PctDone := NewPctDone;
	If PctDone > 0 then
   	mX :=  X + ((dX * PctDone) div 100)
   else
   	mX := X;
   InvalidateRect(HWindow,nil,True);
   UpdateWindow(HWindow);
end;

procedure TMeterWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
	OldBrush : HBrush;
   OldPen :HPen;
   OldColor : LongInt;
   OldBkMode : Integer;
   Buf  : Array[0..5] of Char;
begin
	DrawIcon(PaintDC,10,10,GetClassWord(HWindow,GCW_HICON));
   OldPen := SelectObject(PaintDC,ThePen);
   OldBrush := SelectObject(PaintDC,TheRedBrush);
   Rectangle(PaintDC,X,Y,mX,Y+dY);
   SelectObject(PaintDC,TheBlueBrush);
   Rectangle(PaintDC,mX,Y,X+dX,Y+dY);
   Str(PctDone:4, Buf);
   StrCat(Buf,'%');
   OldColor := SetTextColor(PaintDC,$00FFFFFF);  {White}
   OldBkMode := SetBkMode(PaintDC,Transparent);
   TextOut(PaintDC,165,17,Buf,StrLen(Buf));
   SelectObject(PaintDC,OldBrush);
   SelectObject(PaintDC,OldPen);
   SetTextColor(PaintDC,Oldcolor);
   SetBkMode(PaintDC,OldBkMode);
end;


{***********************************************************************}
end.