home *** CD-ROM | disk | FTP | other *** search
/ The Education Master 1994 (4th Edition) / EDUCATIONS_MASTER_4TH_EDITION.bin / files / windties / paprexps / sclptext.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-11-26  |  4.3 KB  |  155 lines
  1. {SclpText - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit SclpText;
  3. {***********************  Interface     **************************}
  4. interface
  5. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;
  6. const
  7.     sr_Recessed     =   1;
  8.   sr_Raised       =   0;
  9. type
  10. PSRect = ^TSRect;
  11. TSRect = object(TWindow)
  12.   W,H:Integer;
  13.     State:Integer;
  14.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  15.       NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  16.   destructor Done;virtual;
  17.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  18. end;
  19.  
  20. type
  21. PSText = ^TSText;
  22. TSText = object(TSRect)
  23.     Text:Array [0..80] of Char;
  24.   DTStyle:Integer;
  25.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  26.       NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  27.   destructor Done;virtual;
  28.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  29.   procedure SetText(NewText:PChar);virtual;
  30. end;
  31.  
  32. {***********************  Implementation          *******************}
  33. implementation
  34.  
  35. {***********************         TSRect         *********************}
  36. constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
  37.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  38. begin
  39.     TWindow.Init(AParent,ATitle);
  40.   Attr.Style := ws_Child or ws_visible ;
  41.   Attr.X := NewX;
  42.   Attr.Y := NewY;
  43.   Attr.W := NewW;
  44.   Attr.H := NewH;
  45.   Attr.ID := AnID;
  46.   W := NewW;
  47.   H := NewH;
  48.   if NewState = sr_Recessed then
  49.       State := sr_Recessed
  50.     else
  51.         State := sr_Raised;
  52. end;
  53.  
  54. destructor TSRect.Done;
  55. begin
  56.     TWindow.Done;
  57. end;
  58.  
  59. procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  60. var
  61.   LPts:Array[0..2] of TPoint;
  62.   RPts:Array[0..2] of TPoint;
  63.     ThePen:HPen;
  64.   Pen1:HPen;
  65.   Pen2:HPen;
  66.   TheBrush :HBrush;
  67.   OldBrush :HBrush;
  68.   OldPen:HPen;
  69.   OldBkMode:Integer;
  70.   DRect:TRect;
  71.   Ofs:Integer;
  72. begin
  73.   TheBrush := GetStockObject(ltGray_Brush);    {Draw window background}
  74.   OldBrush := SelectObject(PaintDC,TheBrush);
  75.   Rectangle(PaintDC,0,0,W,H);
  76.   SelectObject(PaintDC,OldBrush);
  77.  
  78.   Ofs := 0;
  79.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  80.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  81.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  82.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  83.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  84.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  85.  
  86.     Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  87.   OldPen := SelectObject(PaintDC,Pen1);
  88.   PolyLine(PaintDC,LPts,3);
  89.   PolyLine(PaintDC,RPts,3);
  90.   SelectObject(PaintDC,OldPen);
  91.   DeleteObject(Pen1);
  92.  
  93.   Ofs := 1;
  94.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  95.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  96.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  97.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  98.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  99.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  100.   if State = sr_Raised then
  101.       begin
  102.         Pen1 := CreatePen(ps_Solid,1,$00FFFFFF);
  103.     Pen2 := CreatePen(ps_Solid,1,$00808080);
  104.     end
  105.   else
  106.       begin
  107.       Pen1 := CreatePen(ps_Solid,1,$00808080);
  108.         Pen2 := CreatePen(ps_Solid,1,$00FFFFFF);
  109.     end;
  110.  
  111.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  112.   PolyLine(PaintDC,LPts,3);
  113.   SelectObject(PaintDC,Pen2);
  114.   DeleteObject(Pen1);
  115.  
  116.   PolyLine(PaintDC,RPts,3);
  117.   SelectObject(PaintDC,OldPen);
  118.   DeleteObject(Pen2);
  119. end;
  120. {************************   TSText   ********************************}
  121. constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
  122.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  123. begin
  124.     TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
  125.   DTStyle := NewStyle;
  126.   StrCopy(Text,ATitle);
  127. end;
  128.  
  129. destructor TSText.Done;
  130. begin
  131.     TSRect.Done;
  132. end;
  133.  
  134. procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  135. var
  136.   OldBkMode:Integer;
  137.   DRect:TRect;
  138. begin
  139.   TSRect.Paint(PaintDC,PaintInfo);
  140.   OldBkMode := SetBkMode(PaintDC,Transparent);  {Draw the text}
  141.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  142.   DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
  143.   SetBkMode(PaintDC,OldBkMode);
  144. end;
  145.  
  146. procedure TSText.SetText(NewText:PChar);
  147. var
  148.     DRect:TRect;
  149. begin
  150.     StrCopy(Text,NewText);
  151.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  152.   InvalidateRect(HWindow,@DRect,false);
  153. end;
  154. end.
  155.