{SclpText - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
unit SclpText;
{***********************  Interface     **************************}
interface
uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;
const
	sr_Recessed     =   1;
  sr_Raised       =   0;
type
PSRect = ^TSRect;
TSRect = object(TWindow)
  W,H:Integer;
	State:Integer;
  constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  	NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  destructor Done;virtual;
  procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
end;

type
PSText = ^TSText;
TSText = object(TSRect)
	Text:Array [0..80] of Char;
  DTStyle:Integer;
  DTFont:hfont;
  constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  	NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  destructor Done;virtual;
  procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  procedure SetText(NewText:PChar);virtual;
  procedure SetFont(NewFont:HFont);virtual;
end;

{***********************  Implementation          *******************}
implementation

{***********************         TSRect         *********************}
constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
	ATitle:PChar;	NewX,NewY,NewW,NewH:Integer; NewState:Integer);
begin
	TWindow.Init(AParent,ATitle);
  Attr.Style := ws_Child or ws_visible ;
  Attr.X := NewX;
  Attr.Y := NewY;
  Attr.W := NewW;
  Attr.H := NewH;
  Attr.ID := AnID;
  W := NewW;
  H := NewH;
  if NewState = sr_Recessed then
  	State := sr_Recessed
	else
		State := sr_Raised;

end;

destructor TSRect.Done;
begin
	TWindow.Done;
end;

procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
  LPts:Array[0..2] of TPoint;
  RPts:Array[0..2] of TPoint;
	ThePen:HPen;
  Pen1:HPen;
  Pen2:HPen;
  TheBrush :HBrush;
  OldBrush :HBrush;
  OldPen:HPen;
  OldBkMode:Integer;
  DRect:TRect;
  Ofs:Integer;
begin
  TheBrush := GetStockObject(ltGray_Brush);    {Draw window background}
  OldBrush := SelectObject(PaintDC,TheBrush);
  Rectangle(PaintDC,0,0,W,H);
  SelectObject(PaintDC,OldBrush);

  Ofs := 0;
	LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
	LPts[1].x := Ofs;   LPts[1].y := Ofs;
  LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
	RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
	RPts[2].x := W-Ofs; RPts[2].y := Ofs;

	Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  OldPen := SelectObject(PaintDC,Pen1);
  PolyLine(PaintDC,LPts,3);
  PolyLine(PaintDC,RPts,3);
  SelectObject(PaintDC,OldPen);
  DeleteObject(Pen1);

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

  OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  PolyLine(PaintDC,LPts,3);
  SelectObject(PaintDC,Pen2);
  DeleteObject(Pen1);

  PolyLine(PaintDC,RPts,3);
  SelectObject(PaintDC,OldPen);
  DeleteObject(Pen2);
end;
{************************   TSText   ********************************}
constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
	ATitle:PChar;	NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
begin
	TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
  DTStyle := NewStyle;
  StrCopy(Text,ATitle);
  DTFont := 0;
end;

destructor TSText.Done;
begin
	TSRect.Done;
end;

procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
  OldBkMode:Integer;
  DRect:TRect;
  OldFont:hFont;
begin
  TSRect.Paint(PaintDC,PaintInfo);
  OldFont := 0;
  if DTFont <> 0 then
  	OldFont := SelectObject(PaintDC,DTFont);
  OldBkMode := SetBkMode(PaintDC,Transparent);  {Draw the text}
  DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
  SetBkMode(PaintDC,OldBkMode);
  If OldFont > 0 then
  	SelectObject(PaintDC,OldFont);
end;

procedure TSText.SetText(NewText:PChar);
var
	DRect:TRect;
begin
	StrCopy(Text,NewText);
  DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  InvalidateRect(HWindow,@DRect,false);
end;

procedure TSText.SetFont(NewFont:HFont);
begin
	DTFont := NewFont;
end;
end.