home *** CD-ROM | disk | FTP | other *** search
/ Windoware / WINDOWARE_1_6.iso / winutil / om37a / meter.pas < prev    next >
Pascal/Delphi Source File  |  1992-06-14  |  4KB  |  155 lines
  1. {Meter - A Spin Control Window}
  2. unit Meter;
  3. {$R Meter.res}
  4. {$D Copyright (c) 1992 Doug Overmyer}
  5. {**********************  Interface  *************************}
  6. interface
  7. uses WinTypes, WinProcs, WinDos, Strings, WObjects,WFPlus;
  8. type
  9. PMeterWindow = ^TMeterWindow;
  10. TMeterWindow = object(TWindow)
  11.     BI:TBitmap;
  12.   ThePen:HPen;
  13.   PctDone :Integer;
  14.   BMP:HBitmap;
  15.   StartPT,EndPT:TPoint;
  16.   IsPainted:Boolean;
  17.   constructor Init(AParent:PWindowsObject;ATitle:PChar);
  18.   function GetClassName:PChar;virtual;
  19.   procedure SetupWindow;virtual;
  20.   destructor Done; virtual;
  21.   procedure Draw(NewPctDone:Integer);virtual;
  22.   procedure    Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  23.   procedure GetEndPt;virtual;
  24. end;
  25. {************************  Implementation        ********************}
  26. implementation
  27. function SetPoint(X,Y:Integer;PT:PPoint):PPoint;
  28. begin
  29.     PT^.x := X;
  30.   PT^.Y := Y;
  31.   SetPoint := PT;
  32. end;
  33.  
  34. {***************************  TMeterWindow  ***********************}
  35. constructor TMeterWindow.Init(Aparent:PWindowsObject;ATitle:PChar);
  36. var
  37.     DC:HDC;
  38.     CXBorder,CYBorder,CYCaption:Integer;
  39. begin
  40.     TWindow.Init(AParent,ATitle);
  41.   DisableAutoCreate;
  42.      ThePen := CreatePen(ps_Solid,2,RGB(255,0,0));
  43.   DC := CreateDC('Display', Nil, Nil, Nil);
  44.   CXBorder := GetSystemMetrics(SM_CXBORDER);
  45.   CYBorder := GetSystemMetrics(SM_CYBORDER);
  46.   CYCaption := GetSystemMetrics(SM_CYCAPTION);
  47.   DeleteDC(DC);
  48.   BMP := LoadBitmap(HInstance,'Meter');
  49.   GetObject(BMP,sizeof(TBitmap),@BI);
  50.   with Attr do
  51.        begin
  52.     X := 100;Y :=100 ;
  53.     W := BI.bmWidth+(2*CXBorder);
  54.     H := BI.bmHeight+CYBorder+CYCaption;
  55.     Style := ws_Popup or ws_Visible or ws_Border or ws_Caption;
  56.        end;
  57.   PctDone := -1;
  58.   SetPoint(75,90,@StartPt);
  59.   SetPoint(75,90,@EndPt);
  60.   IsPainted := False;
  61. end;
  62.  
  63. function TMeterWindow.GetClassName:PChar;
  64. begin
  65.     GetClassName := 'MeterWindow';
  66. end;
  67.  
  68. procedure TMeterWindow.SetupWindow;
  69. begin
  70.     TWindow.SetupWindow;
  71. end;
  72.  
  73. destructor TMeterWindow.Done;
  74. begin
  75.   DeleteObject(ThePen);
  76.   DeleteObject(BMP);
  77.   TWindow.Done;
  78. end;
  79.  
  80. procedure TMeterWindow.Draw(NewPctDone:Integer);
  81. var
  82. Rgn:TRect;
  83. DC:HDC;
  84. OldPen:HPen;
  85. begin
  86.     PctDone := NewPctDone;
  87.   if IsPainted then
  88.       begin
  89.       DC := GetDC(HWindow);
  90.       SetROP2(DC,R2_XORPen);
  91.       OldPen := SelectObject(DC,ThePen);
  92.       MoveTo(DC,StartPt.X,StartPt.Y);      {Erase the last line}
  93.       LineTo(DC,EndPT.X,EndPT.Y);
  94.       GetEndPt;
  95.       MoveTo(DC,StartPt.X,StartPt.Y);
  96.       LineTo(DC,EndPT.X,EndPT.Y);
  97.       SelectObject(DC,OldPen);
  98.       ReleaseDC(HWindow,DC);
  99.     end;
  100. end;
  101.  
  102. procedure TMeterWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  103. var
  104.   OldPen :HPen;
  105.   OldBMP:HBitmap;
  106.   MemDC:HDC;
  107. begin
  108.     IsPainted := True;
  109.     MemDC :=CreateCompatibleDC(PaintDC);
  110.   OldBMP := SelectObject(MemDC,BMP);
  111.   BitBlt(PaintDC, 0, 0,BI.bmWidth,BI.bmHeight, MemDC, 0, 0, SRCCopy);
  112.     SelectObject(MemDC,OldBmp);
  113.   DeleteDC(MemDC);
  114.   GetEndPt;
  115.   OldPen := SelectObject(PaintDC,ThePen);
  116.   SetROP2(PaintDC,R2_XORPen);
  117.   MoveTo(PaintDC,StartPt.X,StartPt.Y);
  118.   LineTo(PaintDC,EndPT.X,EndPT.Y);
  119.   SelectObject(PaintDC,OldPen);
  120. end;
  121.  
  122. procedure TMeterWindow.GetEndPt;
  123. begin
  124.   Case PctDone of
  125.       -1:SetPoint(38,85,@EndPt);
  126.       00:SetPoint(38,85,@EndPT);  {76}
  127.     05:SetPoint(39,72,@EndPt);
  128.     10:SetPoint(41,67,@EndPT);
  129.     15:SetPoint(42,63,@EndPt);
  130.     20:SetPoint(44,61,@EndPT);
  131.     25:SetPoint(45,59,@EndPt);
  132.     30:SetPoint(47,57,@EndPt);
  133.     35:SetPoint(51,53,@EndPt);
  134.     40:SetPoint(56,50,@EndPT);
  135.     45:SetPoint(66,47,@EndPt);
  136.     50:SetPoint(75,45,@EndPT);
  137.     55:SetPoint(85,48,@EndPt);
  138.     60:SetPoint(94,50,@EndPT);
  139.     65:SetPoint(99,54,@EndPt);
  140.     70:SetPoint(104,57,@EndPT);
  141.     75:SetPoint(105,59,@EndPt);
  142.     80:SetPoint(106,61,@EndPT);
  143.     85:SetPoint(108,64,@EndPT);
  144.     90:SetPoint(110,67,@EndPT);
  145.     95:SetPoint(112,72,@EndPt);
  146.     100:SetPoint(114,76,@EndPt);
  147.    else
  148.        begin
  149.        EndPt.X := EndPt.X ;
  150.        EndPt.Y := EndPt.Y ;
  151.        end;
  152.    end;
  153. end;
  154. end.
  155.