home *** CD-ROM | disk | FTP | other *** search
/ Windows Shareware GOLD / NuclearComputingVol3No1.cdr / _bbs2 / f1499.zip / WOPLUS.PAS < prev   
Pascal/Delphi Source File  |  1991-07-24  |  10KB  |  380 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. type
  11. PODButton = ^TODButton;
  12. TODButton = object(TButton)
  13.     HBmp :HBitmap;
  14.    State:Integer;
  15.    constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  16.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  17.    destructor    Done;virtual;
  18.    procedure    DrawItem(var Msg:TMessage);virtual;
  19. end;
  20.  
  21.  
  22. type
  23.     PStackStr = ^TStackStr;
  24.    TStackStr = object(TObject)
  25.        StackStr:PChar;
  26.       constructor Init(NewStr:PChar);
  27.       destructor Done;virtual;
  28.     end;
  29.  
  30. type
  31.     PStackInt = ^TStackInt;
  32.    TStackInt = object(TObject)
  33.        StackInt:Integer;
  34.       constructor Init(NewInt:Integer);
  35.       destructor Done;virtual;
  36.     end;
  37.  
  38. type
  39.     PStack = ^TStack;
  40.     TStack = object(TCollection)
  41.        procedure Push(Item:Pointer);virtual;
  42.       function Pop:Pointer;virtual;
  43.    end;
  44.  
  45.  
  46. {TTextStream}
  47. type
  48. PTextStream = ^TTextStream ;
  49. TTextStream = object(TBufStream)
  50.    CharsToRead : LongInt;
  51.    CharsRead : LongInt;
  52.    ARecord :PChar;
  53.    constructor Init(FileName:PChar;Mode,Size:Word);
  54.    destructor Done;virtual;
  55.    function GetNext:PChar;virtual;
  56.    function WriteNext(szARecord:PChar):integer;virtual;
  57.    function WriteEOF:integer;virtual;
  58.    function IsEOF:Boolean;virtual;
  59.    function GetPctDone:Integer;
  60. end;
  61.  
  62.  
  63. {TMeter}
  64. type
  65.     PMeterWindow = ^TMeterWindow;
  66.    TMeterWindow = object(TWindow)
  67.        TheRedBrush:HBrush;
  68.       TheBlueBrush:Hbrush;
  69.       ThePen:HPen;
  70.       X,Y,dX,dY,mX :Integer;
  71.       PctDone :Integer;
  72.    constructor Init(AParent:PWindowsObject;ATitle:PChar);
  73.    procedure   SetupWindow;virtual;
  74.    destructor  Done; virtual;
  75.    procedure   Draw(NewPctDone:Integer);virtual;
  76.    procedure    Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  77. end;
  78.  
  79. {********************************************************************}
  80. {I M P L E M E N T A T I O N                                                     }
  81. {********************************************************************}
  82. implementation
  83.  
  84. {***********************************************************************}
  85.  
  86. constructor    TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  87.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  88. begin
  89.     TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
  90.    Attr.Style := Attr.Style or bs_OwnerDraw;
  91.    HBmp := LoadBitmap(HInstance,BMP);
  92. end;
  93.  
  94. destructor    TODButton.Done;
  95. begin
  96.     TButton.Done;
  97.     DeleteObject(HBmp);
  98. end;
  99.  
  100.  
  101. procedure    TODButton.DrawItem(var Msg:TMessage);
  102. var
  103.     TheDC:HDc;
  104.     ThePen:HPen;
  105.    Pen1:HPen;
  106.    Pen2:HPen;
  107.    TheBrush :HBrush;
  108.    OldBrush :HBrush;
  109.    OldPen:HPen;
  110.    OldBitMap:HBitMap;
  111.    MemDC :HDC;
  112.    LPts:Array[0..2] of TPoint;
  113.    RPts:Array[0..2] of TPoint;
  114.    PDIS :^TDrawItemStruct;
  115.    X,Y,W,H:Integer;
  116. begin
  117.     PDIS := Pointer(Msg.lParam);
  118.    if PDIS^.itemAction = oda_Focus then Exit;
  119.     if ((PDIS^.itemAction and oda_Select ) > 0) and
  120.        ((PDIS^.itemState and ods_Selected) > 0) then
  121.        State := 1 else State := 0; ;
  122.  
  123.    X := PDIS^.rcItem.left;Y := PDIS^.rcItem.top;
  124.    W := PDIS^.rcItem.right-PDIS^.rcItem.left;
  125.    H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
  126.    LPts[0].x := W; LPts[0].y := 0;
  127.    LPts[1].x := 0; LPts[1].y := 0;
  128.    LPts[2].x := 0; LPts[2].y := H;
  129.    RPts[0].x := 0; RPts[0].y := H;
  130.    RPts[1].x := W; RPts[1].y := H;
  131.    RPts[2].x := W; RPts[2].y := 0;
  132.    MemDC := CreateCompatibleDC(PDIS^.HDC);
  133.    OldBitMap := SelectObject(MemDC,HBMP);
  134.    if State = 0 then
  135.        BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
  136.    else
  137.       BitBlt(PDIS^.HDC,X+2,Y+2,W,H, MemDC,0,0,SrcCopy);
  138.    SelectObject(MemDC,OldBitMap);
  139.    DeleteDC(MemDC);
  140.  
  141.     Pen1 := CreatePen(ps_Solid,2,$00000000);
  142.    OldPen := SelectObject(PDIS^.HDC,Pen1);
  143.    PolyLine(PDIS^.HDC,LPts,3);
  144.    PolyLine(PDIS^.HDC,RPts,3);
  145.    SelectObject(PDIS^.HDC,OldPen);
  146.    DeleteObject(Pen1);
  147.  
  148.    LPts[0].x := W-2; LPts[0].y := 2;
  149.    LPts[1].x := 2; LPts[1].y := 2;
  150.    LPts[2].x := 2;LPts[2].y := H-2;
  151.    RPts[0].x := 1; RPts[0].y := H-1;
  152.    RPts[1].x := W-1; RPts[1].y := H-1;
  153.    RPts[2].x := W-1; RPts[2].y := 1;
  154.    if State = 0 then
  155.        begin
  156.         Pen1 := CreatePen(ps_Solid,2,$00FFFFFF);
  157.       Pen2 := CreatePen(ps_Solid,2,$00808080);
  158.       end
  159.    else
  160.        begin
  161.         Pen2 := CreatePen(ps_Solid,1,$00808080);
  162.       Pen1 := CreatePen(ps_Solid,2,$00808080);
  163.       end;
  164.  
  165.    OldPen := SelectObject(PDIS^.HDC,Pen1);
  166.    PolyLine(PDIS^.HDC,LPts,3);
  167.  
  168.    SelectObject(PDIS^.HDC,Pen2);
  169.    DeleteObject(Pen1);
  170.  
  171.    PolyLine(PDIS^.HDC,RPts,3);
  172.    SelectObject(PDIS^.HDC,OldPen);
  173.    DeleteObject(Pen2);
  174.  
  175. end;
  176.  
  177.  
  178. {***********************************************************************}
  179. constructor TStackStr.Init(NewStr:PChar);
  180. begin
  181.     StackStr := StrNew(NewStr);
  182. end;
  183.  
  184. destructor TStackStr.Done;
  185. begin
  186.     StrDispose(StackStr);
  187. end;
  188.  
  189. {***********************************************************************}
  190. constructor TStackInt.Init(NewInt:Integer);
  191. begin
  192.     StackInt := NewInt;
  193. end;
  194.  
  195. destructor TStackInt.Done;
  196. begin
  197.  
  198. end;
  199. {***********************************************************************}
  200. procedure TStack.Push(Item:Pointer);
  201. begin
  202.     AtInsert(0,Item);
  203. end;
  204.  
  205. function TStack.Pop:Pointer;
  206. begin
  207.     Pop := At(0);
  208.    AtDelete(0);
  209. end;
  210.  
  211.  
  212. {***********************************************************************}
  213. {TTextStream Methods}
  214. constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
  215. begin
  216.     TBufStream.Init(FileName,Mode,Size);
  217.    CharsRead := 0;
  218.    CharsToRead := TBufStream.GetSize;
  219.    ARecord := MemAlloc(32000);
  220. end;
  221.  
  222. {Done}
  223. destructor TTextStream.Done;
  224. begin
  225.     TBufStream.Done;
  226.    FreeMem(ARecord,32000);
  227. end;
  228.  
  229. {GetNext}
  230. function TTextStream.GetNext:PChar;
  231. var
  232.     Blksize:Integer;
  233.    AChar:Char;
  234.    Indx : Integer;
  235.    IsEOR : Boolean;
  236. begin
  237.    Indx := 0;
  238.    IsEOR := False;
  239.    ARecord[0] := #0;
  240.    while (CharsRead < CharsToRead) and (IsEOR = False) do
  241.    begin
  242.        TBufStream.Read(AChar,1);
  243.       Inc(CharsRead);
  244.       if (AChar = #13) then
  245.           begin
  246.          ARecord[Indx] := #0;
  247.          IsEOR := True;
  248.          end
  249.       else if (AChar = #10) then
  250.           begin
  251.          end
  252.       else if (AChar = #26) then
  253.           begin
  254.          end
  255.       else 
  256.           begin
  257.          ARecord[Indx] := AChar;
  258.          inc(Indx);
  259.          end
  260.    end;
  261.    GetNext := ARecord;
  262. end;
  263.  
  264. {WriteNext}
  265. {This method not actually used due to performance loss - instead
  266.    TStream.Write is called directly}
  267. function TTextStream.WriteNext(szARecord:PChar):Integer;
  268. const
  269.   CRLF : Array[0..2] of Char = #13#10#0;
  270.  
  271. begin
  272.       TBufStream.Write(szARecord,
  273.           StrLen(szARecord));
  274.       TBufStream.Write(CRLF,2);
  275.       WriteNext := StrLen(szARecord);
  276. end;
  277.  
  278. {WriteEOF}
  279. function TTextStream.WriteEOF:Integer;
  280. const
  281.       EOF : Array[0..1] of Char  = #26;
  282. begin
  283.     TBufStream.Write(EOF,1);
  284.    WriteEOF := 1;
  285. end;
  286.  
  287. {IsEOF}
  288. function TTextStream.IsEOF:Boolean;
  289. begin
  290.     IsEOF := False;
  291.    if CharsRead >= CharsToRead then
  292.        IsEOF := True;
  293. end;
  294.  
  295. {GetPctDone}
  296. function TTextStream.GetPctDone:Integer;
  297. begin
  298.     GetPctDone := CharsRead*100 div CharsToRead;
  299. end;
  300.  
  301.  
  302. {**********************************************************************}
  303. {TMeterWindow Methods}
  304. {Init}
  305. constructor TMeterWindow.Init(Aparent:PWindowsObject;ATitle:PChar);
  306. begin
  307.     TWindow.Init(AParent,ATitle);
  308.    DisableAutoCreate;
  309.      ThePen := CreatePen(ps_Solid,3,$00000000);
  310.    TheBlueBrush := CreateSolidBrush(RGB(0,0,255));
  311.    TheRedBrush  := CreateSolidBrush(RGB(255,0,0));
  312.    with Attr do
  313.        begin
  314.       X := 100;Y :=100 ;W := 350;H := 75;
  315.       Style := ws_Popup or ws_Visible or ws_Border or ws_Caption;
  316.    end;
  317.    X := 50;
  318.    Y := 10;
  319.    dX := 275;
  320.    dY := 30;
  321.    mX := 50;   {midpoint between X & X+dX}
  322.    PctDone := 0;
  323. end;
  324.  
  325. procedure TMeterWindow.SetupWindow;
  326. begin
  327.     TWindow.SetupWindow;
  328.     SetClassWord(HWindow,GCW_HICON,LoadIcon(HInstance,'WS_Icon'));
  329. end;
  330.  
  331. {Done}
  332. destructor TMeterWindow.Done;
  333. begin
  334.      DeleteObject(TheBlueBrush);
  335.    DeleteObject(TheRedBrush);
  336.    DeleteObject(ThePen);
  337.    Destroy;
  338.    TWindow.Done;
  339. end;
  340.  
  341. procedure TMeterWindow.Draw(NewPctDone:Integer);
  342. begin
  343.     PctDone := NewPctDone;
  344.     If PctDone > 0 then
  345.        mX :=  X + ((dX * PctDone) div 100)
  346.    else
  347.        mX := X;
  348.    InvalidateRect(HWindow,nil,True);
  349.    UpdateWindow(HWindow);
  350. end;
  351.  
  352. procedure TMeterWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  353. var
  354.     OldBrush : HBrush;
  355.    OldPen :HPen;
  356.    OldColor : LongInt;
  357.    OldBkMode : Integer;
  358.    Buf  : Array[0..5] of Char;
  359. begin
  360.     DrawIcon(PaintDC,10,10,GetClassWord(HWindow,GCW_HICON));
  361.    OldPen := SelectObject(PaintDC,ThePen);
  362.    OldBrush := SelectObject(PaintDC,TheRedBrush);
  363.    Rectangle(PaintDC,X,Y,mX,Y+dY);
  364.    SelectObject(PaintDC,TheBlueBrush);
  365.    Rectangle(PaintDC,mX,Y,X+dX,Y+dY);
  366.    Str(PctDone:4, Buf);
  367.    StrCat(Buf,'%');
  368.    OldColor := SetTextColor(PaintDC,$00FFFFFF);  {White}
  369.    OldBkMode := SetBkMode(PaintDC,Transparent);
  370.    TextOut(PaintDC,165,17,Buf,StrLen(Buf));
  371.    SelectObject(PaintDC,OldBrush);
  372.    SelectObject(PaintDC,OldPen);
  373.    SetTextColor(PaintDC,Oldcolor);
  374.    SetBkMode(PaintDC,OldBkMode);
  375. end;
  376.  
  377.  
  378. {***********************************************************************}
  379. end.
  380.