home *** CD-ROM | disk | FTP | other *** search
/ Windows Shareware GOLD / NuclearComputingVol3No1.cdr / utils / f1498 / woplus.pas < prev    next >
Pascal/Delphi Source File  |  1991-09-20  |  18KB  |  717 lines
  1. {WOPLUS - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit WOPlus;
  3.  
  4.  
  5. {******************************************************************}
  6. { I N T E R F A C E                                                        }
  7. {******************************************************************}
  8. interface
  9. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs,
  10.       Printer,pDevice,WFPlus;
  11. type
  12. PODButton = ^TODButton;
  13. TODButton = object(TButton)
  14.     HBmp :HBitmap;
  15.   State:Integer;
  16.   constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  17.       X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  18.   destructor    Done;virtual;
  19.   procedure    DrawItem(var Msg:TMessage);virtual;
  20. end;
  21.  
  22.  
  23. type
  24.     PTextObj = ^TTextObj;
  25.   TTextObj = object(TObject)
  26.   Text:PChar;
  27.       constructor Init(NewText:PChar);
  28.     destructor Done;virtual;
  29.     end;
  30.  
  31. type
  32.     PIntObj = ^TIntObj;
  33.   TIntObj = object(TObject)
  34.       Int:Integer;
  35.     constructor Init(NewInt:Integer);
  36.     destructor Done;virtual;
  37.     end;
  38.  
  39. type
  40.     PStack = ^TStack;
  41.     TStack = object(TCollection)
  42.        procedure Push(Item:Pointer);virtual;
  43.     function Pop:Pointer;virtual;
  44.    end;
  45.  
  46.  
  47. {TTextStream}
  48. type
  49. PTextStream = ^TTextStream ;
  50. TTextStream = object(TBufStream)
  51.    CharsToRead : LongInt;
  52.    CharsRead : LongInt;
  53.    ARecord :PChar;
  54.    constructor Init(FileName:PChar;Mode,Size:Word);
  55.    destructor Done;virtual;
  56.    function GetNext:PChar;virtual;
  57.    function WriteNext(szARecord:PChar):integer;virtual;
  58.    function WriteEOF:integer;virtual;
  59.    function IsEOF:Boolean;virtual;
  60.    function GetPctDone:Integer;
  61. end;
  62.  
  63.  
  64. {TMeter}
  65. type
  66. PMeterWindow = ^TMeterWindow;
  67. TMeterWindow = object(TWindow)
  68.   TheRedBrush:HBrush;
  69.   TheGrayBrush:Hbrush;
  70.   ThePen:HPen;
  71.   X,Y,dX,dY,mX :Integer;
  72.   PctDone :Integer;
  73.   Icon:HIcon;
  74.   constructor Init(AParent:PWindowsObject;ATitle:PChar);
  75.   procedure   SetupWindow;virtual;
  76.   destructor  Done; virtual;
  77.   procedure   Draw(NewPctDone:Integer);virtual;
  78.   procedure    Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  79. end;
  80.  
  81. type                               {Printer object support for margins,fonts}
  82. PWOPrinter = ^TWOPrinter;
  83. TWOPrinter = object(tPrinter)
  84.     Margin:TRect; {Rect struct for left,top,right,bottom values in pixels}
  85.   CurFont:hFont;
  86.   PageNumber:Integer;
  87.     Constructor Init(inst: tHandle; par: pWindowsObject);
  88.   function Start(dName:pChar;hw:HWnd):Boolean;virtual;
  89.   procedure SetMarginL(NewMargin:Integer);virtual;
  90.   procedure SetMarginT(NewMargin:Integer);virtual;
  91.   procedure SetMarginR(NewMargin:Integer);virtual;
  92.   procedure SetMarginB(NewMargin:Integer);virtual;
  93.   function SetMargin(NewMargin:TRect):Boolean;virtual;
  94.   function GetMargin(var CurMargin:TRect):Boolean;virtual;
  95.   function SetFont(NewFont:hFont):hFont;virtual;
  96.   function NewLine:Boolean; virtual;
  97.   function resetPos:Boolean;virtual;
  98.   function CheckNewPage:Boolean; virtual;
  99.   function NewPage:Boolean;virtual;
  100.   function DoHeader:Boolean;virtual;
  101.   function Print(aStr:pChar):Boolean;virtual;
  102.     function prnDeviceMode(Wnd:HWnd):Integer;virtual;
  103.   function DoNewFrame:Boolean;virtual;
  104.     Function lineWidth(aStr: pChar): Integer;virtual;
  105. end;
  106.  
  107. type
  108. PSRect = ^TSRect;
  109. TSRect = object(TWindow)
  110.   W,H:Integer;
  111.     State:Integer;
  112.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  113.       NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  114.   destructor Done;virtual;
  115.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  116.   procedure SetupWindow;virtual;
  117. end;
  118.  
  119. type
  120. PSText = ^TSText;
  121. TSText = object(TSRect)
  122.     Text:Array [0..80] of Char;
  123.   DTStyle:Integer;
  124.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  125.       NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  126.   destructor Done;virtual;
  127.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  128.   procedure SetText(NewText:PChar);virtual;
  129. end;
  130.  
  131.  
  132. {********************************************************************}
  133. {I M P L E M E N T A T I O N                                                     }
  134. {********************************************************************}
  135. implementation
  136. {$R WOPLUS.RES}
  137. {********************************************************************}
  138.  
  139. constructor    TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  140.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  141. begin
  142.     TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
  143.    Attr.Style := Attr.Style or bs_OwnerDraw;
  144.    HBmp := LoadBitmap(HInstance,BMP);
  145. end;
  146.  
  147. destructor    TODButton.Done;
  148. begin
  149.     TButton.Done;
  150.     DeleteObject(HBmp);
  151. end;
  152.  
  153.  
  154. procedure    TODButton.DrawItem(var Msg:TMessage);
  155. var
  156.     TheDC:HDc;
  157.     ThePen:HPen;
  158.   Pen1:HPen;
  159.   Pen2:HPen;
  160.   TheBrush :HBrush;
  161.   OldBrush :HBrush;
  162.   OldPen:HPen;
  163.   OldBitMap:HBitMap;
  164.   MemDC :HDC;
  165.   LPts:Array[0..2] of TPoint;
  166.   RPts:Array[0..2] of TPoint;
  167.   PDIS :^TDrawItemStruct;
  168.   X,Y,W,H:Integer;
  169. begin
  170.     PDIS := Pointer(Msg.lParam);
  171.   if PDIS^.itemAction = oda_Focus then Exit;
  172.     if ((PDIS^.itemAction and oda_Select ) > 0) and
  173.       ((PDIS^.itemState and ods_Selected) > 0) then
  174.       State := 1 else State := 0; ;
  175.  
  176.   X := PDIS^.rcItem.left;Y := PDIS^.rcItem.top;
  177.   W := PDIS^.rcItem.right-PDIS^.rcItem.left;
  178.   H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
  179.   LPts[0].x := W; LPts[0].y := 0;
  180.   LPts[1].x := 0; LPts[1].y := 0;
  181.   LPts[2].x := 0; LPts[2].y := H;
  182.   RPts[0].x := 0; RPts[0].y := H;
  183.   RPts[1].x := W; RPts[1].y := H;
  184.   RPts[2].x := W; RPts[2].y := 0;
  185.   MemDC := CreateCompatibleDC(PDIS^.HDC);
  186.   OldBitMap := SelectObject(MemDC,HBMP);
  187.   if State = 0 then
  188.         BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
  189.   else
  190.       BitBlt(PDIS^.HDC,X+2,Y+2,W,H, MemDC,0,0,SrcCopy);
  191.   SelectObject(MemDC,OldBitMap);
  192.   DeleteDC(MemDC);
  193.  
  194.     Pen1 := CreatePen(ps_Solid,2,$00000000);
  195.   OldPen := SelectObject(PDIS^.HDC,Pen1);
  196.   PolyLine(PDIS^.HDC,LPts,3);
  197.   PolyLine(PDIS^.HDC,RPts,3);
  198.   SelectObject(PDIS^.HDC,OldPen);
  199.   DeleteObject(Pen1);
  200.  
  201.   LPts[0].x := W-2; LPts[0].y := 2;
  202.   LPts[1].x := 2; LPts[1].y := 2;
  203.   LPts[2].x := 2;LPts[2].y := H-2;
  204.   RPts[0].x := 1; RPts[0].y := H-1;
  205.   RPts[1].x := W-1; RPts[1].y := H-1;
  206.   RPts[2].x := W-1; RPts[2].y := 1;
  207.   if State = 0 then
  208.       begin
  209.         Pen1 := CreatePen(ps_Solid,2,$00FFFFFF);
  210.     Pen2 := CreatePen(ps_Solid,2,$00808080);
  211.     end
  212.   else
  213.       begin
  214.         Pen2 := CreatePen(ps_Solid,1,$00808080);
  215.       Pen1 := CreatePen(ps_Solid,2,$00808080);
  216.     end;
  217.  
  218.   OldPen := SelectObject(PDIS^.HDC,Pen1);
  219.   PolyLine(PDIS^.HDC,LPts,3);
  220.  
  221.   SelectObject(PDIS^.HDC,Pen2);
  222.   DeleteObject(Pen1);
  223.  
  224.   PolyLine(PDIS^.HDC,RPts,3);
  225.   SelectObject(PDIS^.HDC,OldPen);
  226.   DeleteObject(Pen2);
  227. end;
  228.  
  229.  
  230. {***********************************************************************}
  231. constructor TTextObj.Init(NewText:PChar);
  232. begin
  233.     Text := StrNew(NewText);
  234. end;
  235.  
  236. destructor TTextObj.Done;
  237. begin
  238.     StrDispose(Text);
  239. end;
  240.  
  241. {***********************************************************************}
  242. constructor TIntObj.Init(NewInt:Integer);
  243. begin
  244.     Int := NewInt;
  245. end;
  246.  
  247. destructor TIntObj.Done;
  248. begin
  249.  
  250. end;
  251. {***********************************************************************}
  252. procedure TStack.Push(Item:Pointer);
  253. begin
  254.     AtInsert(0,Item);
  255. end;
  256.  
  257. function TStack.Pop:Pointer;
  258. begin
  259.     Pop := At(0);
  260.   AtDelete(0);
  261. end;
  262.  
  263.  
  264. {***********************************************************************}
  265. {TTextStream Methods}
  266. constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
  267. begin
  268.     TBufStream.Init(FileName,Mode,Size);
  269.   CharsRead := 0;
  270.   CharsToRead := TBufStream.GetSize;
  271.   ARecord := MemAlloc(32000);
  272. end;
  273.  
  274. {Done}
  275. destructor TTextStream.Done;
  276. begin
  277.     TBufStream.Done;
  278.   FreeMem(ARecord,32000);
  279. end;
  280.  
  281. {GetNext}
  282. function TTextStream.GetNext:PChar;
  283. var
  284.     Blksize:Integer;
  285.   AChar:Char;
  286.   Indx : Integer;
  287.   IsEOR : Boolean;
  288. begin
  289.     Indx := 0;
  290.   IsEOR := False;
  291.   ARecord[0] := #0;
  292.   while (CharsRead < CharsToRead) and (IsEOR = False) do
  293.       begin
  294.       TBufStream.Read(AChar,1);
  295.     Inc(CharsRead);
  296.     case AChar of
  297.       #13:
  298.           begin
  299.         ARecord[Indx] := #0;
  300.         IsEOR := True;
  301.         end;
  302.       #10,#26:
  303.           begin
  304.         end;
  305.       else
  306.           begin
  307.         ARecord[Indx] := AChar;
  308.         inc(Indx);
  309.         end;
  310.     end;
  311.   GetNext := ARecord;
  312.   end;
  313. end;
  314.  
  315. {WriteNext}
  316. {This method not actually used due to performance loss - instead
  317.    TStream.Write is called directly}
  318. function TTextStream.WriteNext(szARecord:PChar):Integer;
  319. const
  320.   CRLF : Array[0..2] of Char = #13#10#0;
  321.  
  322. begin
  323.       TBufStream.Write(szARecord,
  324.           StrLen(szARecord));
  325.       TBufStream.Write(CRLF,2);
  326.       WriteNext := StrLen(szARecord);
  327. end;
  328.  
  329. {WriteEOF}
  330. function TTextStream.WriteEOF:Integer;
  331. const
  332.       EOF : Array[0..1] of Char  = #26;
  333. begin
  334.     TBufStream.Write(EOF,1);
  335.    WriteEOF := 1;
  336. end;
  337.  
  338. {IsEOF}
  339. function TTextStream.IsEOF:Boolean;
  340. begin
  341.     IsEOF := False;
  342.    if CharsRead >= CharsToRead then
  343.        IsEOF := True;
  344. end;
  345.  
  346. {GetPctDone}
  347. function TTextStream.GetPctDone:Integer;
  348. begin
  349.     GetPctDone := CharsRead*100 div CharsToRead;
  350. end;
  351.  
  352.  
  353. {**********************************************************************}
  354. {TMeterWindow Methods}
  355. {Init}
  356. constructor TMeterWindow.Init(Aparent:PWindowsObject;ATitle:PChar);
  357. begin
  358.     TWindow.Init(AParent,ATitle);
  359.   DisableAutoCreate;
  360.      ThePen := CreatePen(ps_Solid,0,$00000000);
  361.   TheGrayBrush := CreateSolidBrush($00C0C0C0);
  362.   TheRedBrush  := CreateSolidBrush(RGB(255,0,0));
  363.   with Attr do
  364.        begin
  365.       X := 100;Y :=100 ;W := 350;H := 85;
  366.       Style := ws_Popup or ws_Visible or ws_Border or ws_Caption;
  367.        end;
  368.   X := 50;
  369.   Y := 10;
  370.   dX := 275;
  371.   dY := 30;
  372.   mX := 50;   {midpoint between X & X+dX}
  373.   PctDone := 0;
  374. end;
  375.  
  376. procedure TMeterWindow.SetupWindow;
  377. begin
  378.     TWindow.SetupWindow;
  379.     Icon :=LoadIcon(HInstance,'MW_Icon');
  380. end;
  381.  
  382. {Done}
  383. destructor TMeterWindow.Done;
  384. begin
  385.      DeleteObject(TheGrayBrush);
  386.   DeleteObject(TheRedBrush);
  387.   DeleteObject(ThePen);
  388.   Destroy;
  389.   TWindow.Done;
  390. end;
  391.  
  392. procedure TMeterWindow.Draw(NewPctDone:Integer);
  393. var
  394. Rgn:TRect;
  395. begin
  396.     PctDone := NewPctDone;
  397.     If PctDone > 0 then
  398.        mX :=  X + ((dX * PctDone) div 100)
  399.    else
  400.        mX := X;
  401.    Rgn.Left := X;
  402.    Rgn.Top := Y;
  403.    Rgn.Right := Max(210,mx);
  404.    Rgn.Bottom := Y+dY+20;
  405.    InvalidateRect(HWindow,@Rgn,false);
  406.    UpdateWindow(HWindow); 
  407. end;
  408.  
  409. procedure TMeterWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  410. var
  411.     OldBrush : HBrush;
  412.   OldPen :HPen;
  413.   OldColor : LongInt;
  414.   OldBkMode : Integer;
  415.   Buf  : Array[0..6] of Char;
  416. begin
  417.     DrawIcon(PaintDC,10,10,Icon);
  418.   OldPen := SelectObject(PaintDC,ThePen);
  419.   OldBrush := SelectObject(PaintDC,TheGrayBrush);
  420.   Rectangle(PaintDC,X,Y,mX,Y+dY);
  421.   Str(PctDone:2, Buf);
  422.   StrCat(Buf,'%');
  423.   SetTextAlign(PaintDC,ta_left);
  424.   OldColor := SetTextColor(PaintDC,RGB(255,0,0));  {Red}
  425.   {OldBkMode := SetBkMode(PaintDC,Transparent);}
  426.   TextOut(PaintDC,180,42,Buf,StrLen(Buf));
  427.   SelectObject(PaintDC,OldBrush);
  428.   SelectObject(PaintDC,OldPen);
  429.   SetTextColor(PaintDC,Oldcolor);
  430.   {SetBkMode(PaintDC,OldBkMode);}
  431. end;
  432.  
  433. {*********************************************************************}
  434. Constructor tWOPrinter.Init(inst: tHandle; par: pWindowsObject);
  435. begin
  436.     tPrinter.Init(inst,par);
  437.   PageNumber := 1;
  438. end;
  439.  
  440.  
  441. function TWOPrinter.SetFont(NewFont:hFont):hFont;
  442. var
  443.     MM:Integer;
  444.    LogFont:TLogFont;
  445. begin
  446.     SetFont := SelectObject(hPrintDC,NewFont);
  447.   CurFont := NewFont;
  448.    getTextMetrics(hPrintDC,Metrics);
  449.   { MM := GetMapMode(hPrintDC);
  450.    GetObject(NewFont,sizeof(LogFont),@LogFont);}
  451. end;
  452.  
  453. function TWOPrinter.Start(dName:pChar;hw:HWnd):Boolean;
  454. begin
  455.     Margin.Left := 0;
  456.   Margin.Top := 0;
  457.   Margin.Right := 0;
  458.   Margin.Bottom := 0;
  459.   Start := tPrinter.Start(dName,hw);   {ancestor call}
  460.   CurFont := GetStockObject(Device_Default_Font);
  461. end;
  462.  
  463. procedure TWOPrinter.SetMarginL(NewMargin:Integer);
  464. begin
  465.     Margin.Left := NewMargin;
  466. end;
  467.  
  468. procedure TWOPrinter.SetMarginT(NewMargin:Integer);
  469. begin
  470.     Margin.Top := NewMargin;
  471. end;
  472.  
  473. procedure TWOPrinter.SetMarginR(NewMargin:Integer);
  474. begin
  475.     Margin.Right := NewMargin;
  476. end;
  477.  
  478. procedure TWOPrinter.SetMarginB(NewMargin:Integer);
  479. begin
  480.     Margin.Bottom := NewMargin;
  481. end;
  482.  
  483. function TWOPrinter.SetMargin(NewMargin:TRect):Boolean;
  484. begin
  485.     Margin := NewMargin;
  486.   SetMargin := True;
  487. end;
  488.  
  489. function TWOPrinter.GetMargin(var CurMargin:TRect):Boolean;
  490. begin
  491.     CurMargin := Margin;
  492. end;
  493.  
  494. function TWOPrinter.NewLine:Boolean;
  495. Begin
  496.     posX := Margin.Left;
  497.    posY := posY + height;
  498.    checkNewPage;
  499. end;
  500.  
  501. function TWOPrinter.ResetPos:Boolean;
  502. Begin
  503.     posX := Margin.Left;
  504.    posY := Margin.Top;
  505. end;
  506.  
  507. function TWOPrinter.CheckNewPage:Boolean;
  508. begin
  509.     if (posY + Margin.Bottom + 2*height > maxY ) then newPage;
  510. end;
  511.  
  512. function TWOPrinter.NewPage:Boolean;
  513. begin
  514.     if OkToPrint then
  515.       begin
  516.     ResetPos;
  517.     DoNewFrame;
  518.     Inc(PageNumber);
  519.     DoHeader;
  520.     end;
  521. end;
  522.  
  523. function TWOPrinter.DoHeader:Boolean;
  524. begin
  525.     {formal method}
  526. end;
  527.  
  528. function TWOPrinter.Print(aStr:pchar):Boolean;
  529. var
  530.     Extent:Integer;
  531. begin
  532.     Extent := lineWidth(aStr);
  533.   {if ((PosX + Extent + Margin.Right) > maxX) then
  534.        newLine;}
  535.   if printString(aStr) then
  536.       begin
  537.       PosX := PosX + Extent;
  538.       Print := True;
  539.       end
  540.   else
  541.        Print := False;
  542. end;
  543.  
  544.  
  545. function     TWOPrinter.prnDeviceMode(Wnd:HWnd):Integer;
  546.  var
  547.   dHandle: tHandle;     {handle of the load library for the current printer}
  548.   drvName: pChar;       {name of the driver used to get dHandle}
  549.   pAddr:   tFarProc;    {address of the function in the DLL we want to EXEC}
  550.  
  551.  
  552. Begin
  553.   if getPrinterParms then begin            {retrieve printer info from windows}
  554.     drvName := driver;
  555.     strCat(drvName,'.drv');             {make a file name out of the driver}
  556.     dHandle := LoadLibrary(drvName);    {load the DLL for the printer}
  557.     pAddr := getProcAddress(dHandle,'ExtDeviceMode');
  558.     if (pAddr <> nil) then begin
  559.       tGetExtDevMode(pAddr)(wnd,dHandle,dMode,drvName,prnPort,dMode,nil,
  560.               dm_prompt  OR dm_Update);
  561.     end else begin
  562.       pAddr := GetProcAddress(dHandle,'DEVICEMODE');
  563.       if (pAddr <> nil) then begin
  564.         tGetDevMode(pAddr)(wnd,dHandle,drvName,prnPort);
  565.       End;
  566.     End;
  567.     FreeLibrary(dHandle);   {the library is freed when we are done with it}
  568.   End;
  569. end;
  570.  
  571. function tWOPrinter.DoNewFrame:Boolean;
  572. begin
  573.   tPrinter.DoNewFrame;
  574.   SelectObject(hPrintDC,CurFont);
  575. end;
  576.  
  577. Function tWOPrinter.lineWidth(aStr: pChar): Integer;
  578. var
  579.     Res:LongInt;
  580. Begin
  581.   if (aStr <> nil) then
  582.       begin
  583.     res := (GetTextExtent(hPrintDC,aStr,strLen(aStr)));
  584.     lineWidth := LongRec(res).lo;
  585.     end
  586.   else
  587.     LineWidth := 0;
  588. End;
  589.  
  590. {***********************************************************************}
  591. constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
  592.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  593. begin
  594.     TWindow.Init(AParent,ATitle);
  595.   Attr.Style := ws_Child or ws_visible ;
  596.   Attr.X := NewX;
  597.   Attr.Y := NewY;
  598.   Attr.W := NewW;
  599.   Attr.H := NewH;
  600.   Attr.ID := AnID;
  601.   W := NewW;
  602.   H := NewH;
  603.   if NewState = 1 then
  604.       State := 1
  605.     else
  606.         State := 0;
  607. end;
  608.  
  609. destructor TSRect.Done;
  610. begin
  611.     TWindow.Done;
  612. end;
  613.  
  614. procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  615. var
  616.   LPts:Array[0..2] of TPoint;
  617.   RPts:Array[0..2] of TPoint;
  618.     ThePen:HPen;
  619.   Pen1:HPen;
  620.   Pen2:HPen;
  621.   TheBrush :HBrush;
  622.   OldBrush :HBrush;
  623.   OldPen:HPen;
  624.   OldBkMode:Integer;
  625.   DRect:TRect;
  626.   Ofs:Integer;
  627. begin
  628.   TheBrush := GetStockObject(ltGray_Brush);    {Draw window background}
  629.   OldBrush := SelectObject(PaintDC,TheBrush);
  630.   Rectangle(PaintDC,0,0,W,H);
  631.   SelectObject(PaintDC,OldBrush);
  632.  
  633.   Ofs := 0;
  634.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  635.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  636.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  637.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  638.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  639.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  640.  
  641.     Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  642.   OldPen := SelectObject(PaintDC,Pen1);
  643.   PolyLine(PaintDC,LPts,3);
  644.   PolyLine(PaintDC,RPts,3);
  645.   SelectObject(PaintDC,OldPen);
  646.   DeleteObject(Pen1);
  647.  
  648.   Ofs := 1;
  649.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  650.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  651.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  652.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  653.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  654.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  655.   if State = 0 then
  656.       begin
  657.         Pen1 := CreatePen(ps_Solid,1,$00FFFFFF);
  658.     Pen2 := CreatePen(ps_Solid,1,$00808080);
  659.     end
  660.   else
  661.       begin
  662.       Pen1 := CreatePen(ps_Solid,1,$00808080);
  663.         Pen2 := CreatePen(ps_Solid,1,$00FFFFFF);
  664.     end;
  665.  
  666.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  667.   PolyLine(PaintDC,LPts,3);
  668.   SelectObject(PaintDC,Pen2);
  669.   DeleteObject(Pen1);
  670.  
  671.   PolyLine(PaintDC,RPts,3);
  672.   SelectObject(PaintDC,OldPen);
  673.   DeleteObject(Pen2);
  674. end;
  675.  
  676. procedure TSRect.SetupWindow;
  677. begin
  678.  
  679. end;
  680. {***********************************************************************}
  681. constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
  682.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  683. begin
  684.     TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
  685.   DTStyle := NewStyle;
  686.   StrCopy(Text,ATitle);
  687. end;
  688.  
  689. destructor TSText.Done;
  690. begin
  691.     TSRect.Done;
  692. end;
  693.  
  694. procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  695. var
  696.   OldBkMode:Integer;
  697.   DRect:TRect;
  698. begin
  699.   TSRect.Paint(PaintDC,PaintInfo);
  700.   OldBkMode := SetBkMode(PaintDC,Transparent);  {Draw the text}
  701.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  702.   DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
  703.   SetBkMode(PaintDC,OldBkMode);
  704. end;
  705.  
  706. procedure TSText.SetText(NewText:PChar);
  707. var
  708.     DRect:TRect;
  709. begin
  710.     StrCopy(Text,NewText);
  711.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  712.    InvalidateRect(HWindow,@DRect,false);
  713. end;
  714.  
  715.  
  716. end.
  717.