home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PCTV2N6.ZIP / PIE.ZIP / PIECTRL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-12-09  |  4.2 KB  |  146 lines
  1. { piectrl.pas -- Sample Pie-Shaped custom control by Tom Swan }
  2.  
  3. {$N+}  { Use math coprocessor and WIN87EM.DLL }
  4.  
  5. library PieCtrl;
  6.  
  7. uses WinTypes, WinProcs, Strings;
  8.  
  9. const
  10.   className = 'PieCtrl';
  11.   extraBytes = 4;     { Extra bytes in window instance }
  12.   pie_Limit = 0;      { Offset to instance Limit value }
  13.   pie_Index = 2;      { Offset to instance Index value }
  14.   startAngle = 270.0; { Pie function's "straight up" angle }
  15.  
  16. {$I piectrl.inc }  { Include message identifiers }
  17.  
  18. function Radians(W: Double): Double;
  19. begin
  20.   Radians := Abs(Round(W) mod 360) * Pi / 180.0;
  21. end;
  22.  
  23. function PieWndFn(HWindow: HWnd; Message: Word; WParam: Word;
  24.   LParam: Longint): LongInt; export;
  25. var
  26.   PS: TPaintStruct;
  27.  
  28.   procedure Paint(DC: HDC);
  29.   var
  30.     R: TRect;
  31.     Brush: HBrush;
  32.     THeight, Center: Word;
  33.     DLimit, DIndex: Double;
  34.     XEnd, YEnd, XStart, YStart: Integer;
  35.     Percent, EndAngle, DRadius: Double;
  36.     S: array[0 .. 5] of char;
  37.   begin
  38.     SaveDC(DC);
  39.     GetClientRect(HWindow, R);
  40.     if (R.right > R.bottom) then
  41.       R.right := R.bottom
  42.     else if (R.bottom > R.right) then
  43.       R.bottom := R.right;
  44.     DRadius := R.right;
  45.     Center := R.right div 2;
  46.     DLimit := SendMessage(HWindow, pie_GetLimit, 0, 0);
  47.     DIndex := SendMessage(HWindow, pie_GetIndex, 0, 0);
  48.     Percent := DIndex / DLimit;
  49.     Str(100.0 * Percent:0:0, S);
  50.     StrCat(S, '%');
  51.     EndAngle := startAngle + (Percent * 360.0);
  52.     XEnd := Center + Round(DRadius * Cos(Radians(EndAngle)));
  53.     YEnd := Center + Round(DRadius * Sin(Radians(EndAngle)));
  54.     XStart := Center + Round(DRadius * Cos(Radians(startAngle)));
  55.     YStart := Center + Round(DRadius * Sin(Radians(startAngle)));
  56.     Brush := SendMessage(GetParent(HWindow),
  57.       wm_CtlColor, DC, MAKELONG(HWindow, pie_BackColor));
  58.     SelectObject(DC, Brush);
  59.     Pie(DC, R.left, R.top, R.right, R.bottom,
  60.       XEnd, YEnd, XStart, YStart);
  61.     if (DLimit <> DIndex) then
  62.     begin
  63.       Brush := SendMessage(GetParent(HWindow),
  64.         wm_CtlColor, DC, MAKELONG(HWindow, pie_ForeColor));
  65.       SelectObject(DC, Brush);
  66.       Pie(DC, R.left, R.top, R.right, R.bottom,
  67.         XStart, YStart, XEnd, YEnd);
  68.     end;
  69.     THeight := HIWORD(GetTextExtent(DC, S, 1));
  70.     SetTextAlign(DC, ta_Center);
  71.     TextOut(DC, Center, Center - THeight div 2, S, StrLen(S));
  72.     RestoreDC(DC, -1);
  73.   end;
  74.  
  75. begin
  76.   PieWndFn := 0;   { Preset function result }
  77.   case Message of
  78.     wm_Create:
  79.       begin
  80.         SendMessage(HWindow, pie_SetLimit, 100, 0);
  81.         SendMessage(HWindow, pie_SetIndex, 0, 0);
  82.       end;
  83.     wm_GetDlgCode:
  84.       PieWndFn := dlgc_Static;
  85.     wm_Paint:
  86.       begin
  87.         BeginPaint(HWindow, PS);
  88.         Paint(PS.hDC);
  89.         EndPaint(HWindow, PS);
  90.       end;
  91.     pie_SetLimit:
  92.       begin
  93.         SetWindowWord(HWindow, pie_Limit, WParam);
  94.         InvalidateRect(HWindow, nil, false);
  95.         UpdateWindow(HWindow);
  96.       end;
  97.     pie_GetLimit:
  98.       begin
  99.         PieWndFn := GetWindowWord(HWindow, pie_Limit);
  100.       end;
  101.     pie_SetIndex:
  102.       begin
  103.         SetWindowWord(HWindow, pie_Index, WParam);
  104.         InvalidateRect(HWindow, nil, false);
  105.         UpdateWindow(HWindow);
  106.       end;
  107.     pie_GetIndex:
  108.       PieWndFn := GetWindowWord(HWindow, pie_Index);
  109.   else
  110.     PieWndFn := DefWindowProc(HWindow, Message, WParam, LParam);
  111.   end;
  112. end;
  113.  
  114. exports
  115.   PieWndFn;
  116.  
  117. var
  118.   Class: TWndClass;   { Control's window class }
  119.   Chain: Pointer;     { For hooking into exit chain }
  120.  
  121. {$S-}  { Turn off stack checking for DLL exit procedures }
  122. procedure PieExitProc; far;
  123. begin
  124.   UnregisterClass(className, System.hInstance);
  125.   ExitProc := Chain;  { Continue exit procedure chain }
  126. end;
  127.  
  128. begin
  129.   Chain := ExitProc;         { Preserve current exit path }
  130.   ExitProc := @PieExitProc;  { Link new procedure into chain }
  131.   with Class do
  132.   begin
  133.     cbClsExtra    := 0;
  134.     cbWndExtra    := extraBytes;
  135.     hbrBackground := 0;
  136.     hIcon         := 0;
  137.     hInstance     := System.hInstance;
  138.     hCursor       := LoadCursor(0, idc_Arrow);
  139.     lpfnWndProc   := TFarProc(@PieWndFn);
  140.     lpszClassName := className;
  141.     lpszMenuName  := nil;
  142.     style         := cs_HRedraw or cs_VRedraw or cs_GlobalClass;
  143.   end;
  144.   RegisterClass(Class);
  145. end.
  146.