Category : Windows 3.X Files
Archive   : PLX17.ZIP
Filename : SCLPTEXT.PAS

{SclpText - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
unit SclpText;
{*********************** Interface **************************}
interface
uses WinTypes, WinProcs, WinDos, Strings, WObjects;
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.