home *** CD-ROM | disk | FTP | other *** search
/ Wacky Windows Stuff... / WACKY.iso / toolbook / sclptext.pas < prev    next >
Pascal/Delphi Source File  |  1992-04-26  |  5KB  |  170 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.   DTFont:hfont;
  26.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  27.       NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  28.   destructor Done;virtual;
  29.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  30.   procedure SetText(NewText:PChar);virtual;
  31.   procedure SetFont(NewFont:HFont);virtual;
  32. end;
  33.  
  34. {***********************  Implementation          *******************}
  35. implementation
  36.  
  37. {***********************         TSRect         *********************}
  38. constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
  39.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  40. begin
  41.     TWindow.Init(AParent,ATitle);
  42.   Attr.Style := ws_Child or ws_visible ;
  43.   Attr.X := NewX;
  44.   Attr.Y := NewY;
  45.   Attr.W := NewW;
  46.   Attr.H := NewH;
  47.   Attr.ID := AnID;
  48.   W := NewW;
  49.   H := NewH;
  50.   if NewState = sr_Recessed then
  51.       State := sr_Recessed
  52.     else
  53.         State := sr_Raised;
  54.  
  55. end;
  56.  
  57. destructor TSRect.Done;
  58. begin
  59.     TWindow.Done;
  60. end;
  61.  
  62. procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  63. var
  64.   LPts:Array[0..2] of TPoint;
  65.   RPts:Array[0..2] of TPoint;
  66.     ThePen:HPen;
  67.   Pen1:HPen;
  68.   Pen2:HPen;
  69.   TheBrush :HBrush;
  70.   OldBrush :HBrush;
  71.   OldPen:HPen;
  72.   OldBkMode:Integer;
  73.   DRect:TRect;
  74.   Ofs:Integer;
  75. begin
  76.   TheBrush := GetStockObject(ltGray_Brush);    {Draw window background}
  77.   OldBrush := SelectObject(PaintDC,TheBrush);
  78.   Rectangle(PaintDC,0,0,W,H);
  79.   SelectObject(PaintDC,OldBrush);
  80.  
  81.   Ofs := 0;
  82.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  83.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  84.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  85.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  86.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  87.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  88.  
  89.     Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  90.   OldPen := SelectObject(PaintDC,Pen1);
  91.   PolyLine(PaintDC,LPts,3);
  92.   PolyLine(PaintDC,RPts,3);
  93.   SelectObject(PaintDC,OldPen);
  94.   DeleteObject(Pen1);
  95.  
  96.   Ofs := 1;
  97.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  98.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  99.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  100.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  101.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  102.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  103.   if State = sr_Raised then
  104.       begin
  105.         Pen1 := CreatePen(ps_Solid,1,$00FFFFFF);
  106.     Pen2 := CreatePen(ps_Solid,1,$00808080);
  107.     end
  108.   else
  109.       begin
  110.       Pen1 := CreatePen(ps_Solid,1,$00808080);
  111.         Pen2 := CreatePen(ps_Solid,1,$00FFFFFF);
  112.     end;
  113.  
  114.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  115.   PolyLine(PaintDC,LPts,3);
  116.   SelectObject(PaintDC,Pen2);
  117.   DeleteObject(Pen1);
  118.  
  119.   PolyLine(PaintDC,RPts,3);
  120.   SelectObject(PaintDC,OldPen);
  121.   DeleteObject(Pen2);
  122. end;
  123. {************************   TSText   ********************************}
  124. constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
  125.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  126. begin
  127.     TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
  128.   DTStyle := NewStyle;
  129.   StrCopy(Text,ATitle);
  130.   DTFont := 0;
  131. end;
  132.  
  133. destructor TSText.Done;
  134. begin
  135.     TSRect.Done;
  136. end;
  137.  
  138. procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  139. var
  140.   OldBkMode:Integer;
  141.   DRect:TRect;
  142.   OldFont:hFont;
  143. begin
  144.   TSRect.Paint(PaintDC,PaintInfo);
  145.   OldFont := 0;
  146.   if DTFont <> 0 then
  147.       OldFont := SelectObject(PaintDC,DTFont);
  148.   OldBkMode := SetBkMode(PaintDC,Transparent);  {Draw the text}
  149.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  150.   DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
  151.   SetBkMode(PaintDC,OldBkMode);
  152.   If OldFont > 0 then
  153.       SelectObject(PaintDC,OldFont);
  154. end;
  155.  
  156. procedure TSText.SetText(NewText:PChar);
  157. var
  158.     DRect:TRect;
  159. begin
  160.     StrCopy(Text,NewText);
  161.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  162.   InvalidateRect(HWindow,@DRect,false);
  163. end;
  164.  
  165. procedure TSText.SetFont(NewFont:HFont);
  166. begin
  167.     DTFont := NewFont;
  168. end;
  169. end.
  170.