{***************************************************************************

	Percent Control Window Procedure Unit		$Version$
        Window Function Unit
        $Author$		$Date$

        Copyright 1991 Anthony M. Vitabile

        Unit Description

        This Turbo Pascal for Windows unit contains the code that
        implements the window function for a new kind of control window
        for use in dialog boxes.  The behavior of the control is
        determined by the code contained in this function.

        The library uses straight Windows calls and does NOT use Object-
        Windows.  This is to allow the control to be used by ANY Windows
        program.

***************************************************************************}

Unit WndFnPercentCtrl;
Interface
  Uses WinTypes;

  function PercentCtrlWndFn(HWindow:  HWnd;
                            Message,
                            wParam :  word;
                            lParam :  longint
                           ):  longint; export;

Implementation
  Uses CtrlCommonDefs, Strings, WinProcs;

  function GetPercentage(HWindow:  HWnd):  integer;
    begin	{ GetPercentage }
      GetPercentage := GetWindowWord(HWindow, Pct_Percentage);
    end		{ GetPercentage };

  procedure DrawAxis(HWindow:  HWnd;
                     DC     :  HDC;
                 var Rect   :  TRect;
                     BorderW:  integer;
                     Style  :  longint);
    var
      Extent ,
      i      ,
      Mult   ,
      NoTicks,
      Percent,
      X      :  word;
      Width  :  single;
      Txt    :  array [0 .. 3] of char;
      Temp   :  string[3];

    begin	{ DrawAxis }
      if Style and Pct_Decades <> 0	{ Determine how many points between ticks }
       then Mult := 10
       else
        if Style and Pct_Quarters <> 0
         then Mult := 25
         else Mult := 50;
      NoTicks := 100 div Mult;		{ Determine the number of ticks on the bar }
      Width   := (Rect.right - Rect.left - 2 * BorderW) / NoTicks;
      X       := Rect.left + BorderW;
      for i := 0 to NoTicks do
        begin
          Percent := i * Mult;		{ Compute the current percentage to print }
          Str(Percent:1, Temp);
          StrPCopy(Txt, Temp);
          Extent     := LoWord(GetTextExtent(DC, Txt, StrLen(Txt)));
          Rect.left  := round(i * Width - Extent / 2) + X;
          Rect.right := Rect.left + Extent;
          DrawText(DC, Txt, 3, Rect, dt_Left)
        end
    end		{ DrawAxis };

  procedure DrawShadow(HWindow:  HWnd;
                       DC     :  HDC;
                   var Rect   :  TRect;
                       Up     :  boolean;
                       Offset :  integer);
    var
      NewPen,
      OldPen:  HPen;

    begin	{ DrawShadow }
      if Up				{ Set up Working rectangle for drawing shadows, etc }
       then NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_Window))
       else NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_BtnShadow));
      if NewPen = 0
       then OldPen := 0
       else OldPen := SelectObject(DC, NewPen);
      MoveTo(DC, Rect.left  + (Offset + 1), Rect.bottom - (Offset + 2));
      LineTo(DC, Rect.left  + (Offset + 1), Rect.top    + (Offset + 1));
      LineTo(DC, Rect.right - (Offset + 2), Rect.top    + (Offset + 1));
      MoveTo(DC, Rect.left  + (Offset + 2), Rect.bottom - (Offset + 3));
      LineTo(DC, Rect.left  + (Offset + 2), Rect.top    + (Offset + 2));
      LineTo(DC, Rect.right - (Offset + 3), Rect.top    + (Offset + 2));
      if OldPen <> 0
       then DeleteObject(SelectObject(DC, OldPen));
      if Up				{ Set up Working rectangle for drawing shadows, etc }
       then NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_BtnShadow))
       else NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_Window));
      if NewPen = 0
       then OldPen := 0
       else OldPen := SelectObject(DC, NewPen);
      MoveTo(DC, Rect.right - (Offset + 2), Rect.top    + (Offset + 1));
      LineTo(DC, Rect.right - (Offset + 2), Rect.bottom - (Offset + 2));
      LineTo(DC, Rect.left  + (Offset + 1), Rect.bottom - (Offset + 2));
      MoveTo(DC, Rect.right - (Offset + 3), Rect.top    + (Offset + 2));
      LineTo(DC, Rect.right - (Offset + 3), Rect.bottom - (Offset + 3));
      LineTo(DC, Rect.left  + (Offset + 2), Rect.bottom - (Offset + 3));
      if OldPen <> 0
       then DeleteObject(SelectObject(DC, OldPen))
    end		{ DrawShadow };

  procedure DrawButton(HWindow:  HWnd;
                       DC     :  HDC;
                   var Rect   :  TRect;
                       Up     :  boolean);
    var
      NewBrush,
      OldBrush:  HBrush;
      NewPen  ,
      OldPen  :  HPen;
      Offset  :  integer;

    begin	{ DrawButton }
      NewBrush := CreateSolidBrush(GetSysColor(color_BtnFace));
      if NewBrush = 0			{ Use the new brush if it was made }
       then OldBrush := 0
       else OldBrush := SelectObject(DC, NewBrush);
      NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_WindowFrame));
      if NewPen = 0
       then OldPen := 0
       else OldPen := SelectObject(DC, NewPen);
      Rectangle(DC, Rect.left, Rect.top, Rect.right, Rect.bottom);
      if OldBrush <> 0			{ Restore the original brush now! }
       then
         begin
           SelectObject(DC, OldBrush);
           DeleteObject(NewBrush)
         end;
      if OldPen <> 0
       then
         begin
           SelectObject(DC, OldPen);
           DeleteObject(NewPen)
         end;
      if Up
       then Offset := 0
       else Offset := 2;
      DrawShadow(HWindow, DC, Rect, Up, Offset)
    end		{ DrawButton };

  procedure DrawBar(HWindow:  HWnd; DC:  HDC; var Rect:  TRect);
    var
      Percent:  integer;
      PctRect:  TRect;

    begin	{ DrawBar }
		   { First draw the rectangle for the bar }
      DrawButton(HWindow, DC, Rect, FALSE);

			{ Draw the percentage rectangle }

      Percent := GetPercentage(HWindow);
      if Percent > 0			{ If there's something to be displayed }
       then				{ then draw the rectangle }
         begin
           PctRect := Rect;		{ Percent rectangle is inside bar rectangle }
           PctRect.right := PctRect.left   +	{ Compute how far to the right the bar is! }
                            round((Rect.right - Rect.left) *
                                  GetPercentage(HWindow) / 100) + 1;
           if PctRect.right > Rect.right
             then PctRect.right := Rect.right;
           DrawButton(HWindow, DC, PctRect, TRUE)
        end
    end		{ DrawBar };

  procedure DrawDigits(HWindow:  HWnd; DC:  HDC; var Rect:  TRect);
    var
      i   :  integer;
      Txt :  array [0 .. 4] of char;
      Temp:  string[4];

    begin	{ DrawDigits }
      i := GetPercentage(HWindow);
      Str(i:3, Temp);
      Temp := Temp + '%';
      StrPCopy(Txt, Temp);
      i := SetBkMode(DC, Transparent);
      DrawText(DC, Txt, length(Temp), Rect, dt_Center or dt_VCenter);
      if i <> 0
       then SetBkMode(DC, i)
    end		{ DrawDigits };

  procedure DrawTicks(HWindow:  HWnd;
                      DC     :  HDC;
                  var Rect   :  TRect;
                      Style  :  longint);
    var
      i      ,
      Mult   ,
      NoTicks,
      X      :  word;
      Width  :  single;

    begin	{ DrawTicks }
      if Style and Pct_Decades <> 0	{ Determine how many points between ticks }
       then Mult := 10
       else
        if Style and Pct_Quarters <> 0
         then Mult := 25
         else Mult := 50;
      NoTicks := 100 div Mult;		{ Determine the number of ticks on the bar }
      Width   := (Rect.right - Rect.left) / NoTicks;
      for i := 0 to NoTicks do
        begin
          X := round(i * Width + Rect.left);
          if (X >= Rect.right)
           then X := Rect.right - 1;
          MoveTo(DC, X, Rect.top);
          LineTo(DC, X, Rect.bottom)
        end
    end		{ DrawTicks };

  procedure DrawTitle(HWindow:  HWnd;
                      DC     :  HDC;
                  var Rect   :  TRect);
    var
      len :  integer;
      Temp:  array [0 .. ctlTitle] of char;

    begin	{ DrawTitle }
      len := GetWindowText(HWindow, Temp, sizeof(Temp));
      if len > 0
       then DrawText(DC, Temp, len, Rect, dt_Center or dt_VCenter)
    end		{ DrawTitle };

  procedure EraseBackground(HWindow:  HWnd; DC:  hDC);
    var
      Brush ,
      OBrush,
      NBrush,
      WBrush:  hBrush;
      Parent:  HWnd;
      LBrush:  TLogBrush;
      CRect :  TRect;

    begin	{ EraseBackground }
      WBrush := GetStockObject(White_Brush);	{ We may need this! }
      OBrush := SelectObject(DC, WBrush);	{ Get the currently selected brush }
      SelectObject(DC, OBrush);			{ Put the original brush back }
      Parent := GetParent(HWindow);		{ Get the window's parent }
      if Parent <> 0				{ If the control is indeed a child window }
        then					{ Have the parent tell us what brush to use }
          Brush := LoWord(SendMessage(Parent, wm_CtlColor, DC, MakeLong(HWindow, ctlcolor_Static)))
        else Brush := WBrush;			{ Otherwise use the white brush }
      GetObject(Brush, sizeof(LBrush), @LBrush);{ Get the brush's data }
      NBrush := CreateBrushIndirect(LBrush);	{ Create a brand new brush from data returned above }
      UnrealizeObject(NBrush);			{ Align the brush pattern }
      SelectObject   (DC, NBrush);		{ Select the brush }
      GetClientRect  (HWindow, CRect);		{ Get the area to be erased }
      FillRect       (DC, CRect, Brush);	{ Erase the background }
      if Brush <> WBrush			{ If the background isn't white, draw the shadow }
        then DrawShadow(HWindow, DC, CRect, FALSE, 0);
      DeleteObject(SelectObject(DC, OBrush))	{ Restore the original brush & delete our temp one }
    end		{ EraseBackground };

  procedure PaintPercentCtrl(HWindow:  HWnd);
    var
      HasAxis ,
      HasPct  ,
      HasTicks,
      HasTitle:  boolean;
      DC      :  HDC;
      AxisH   ,
      BarH    ,
      BarW    ,
      BorderW ,
      CharH   ,
      CharW   ,
      Height  ,
      TickH   ,
      TitleH  ,
      WhiteH  ,
      Width   :  integer;
      Style   :  longint;
      Paint   :  TPaintStruct;
      CRect   ,
      Rect    :  TRect;

    begin	{ PaintPercentCtrl }
      DC := BeginPaint(HWindow, Paint);		{ Begin the painting process }
      GetClientRect(HWindow, CRect);		{ Get the area covered by the window }
      Style := GetDialogBaseUnits;		{ Get the dialog base units }
      CharH := HiWord(Style);			{ Store the height of a character }
      CharW := LoWord(Style);			{ Store the width  of a character }

	  { Set up the variables for drawing the 3 parts of the control }

      Height   := CRect.bottom - CRect.top;	{ Compute the client rectangle's height }
      Width    := CRect.right  - CRect.left;	{ Compute the client rectangle's width }
      Style    := GetWindowLong(HWindow, gwl_Style);	{ Get the window's style bits }

      HasAxis  := Style and Pct_Axis   <> 0;
      HasPct   := Style and Pct_Digits <> 0;
      HasTicks := Style and (Pct_Decades or Pct_Quarters or Pct_Halves) <> 0;
      HasTitle := GetWindowTextLength(HWindow) > 0;

      if not HasAxis				{ Determine the width of the border }
       then BorderW := 0
       else BorderW := CharW * 5 div 2;
      if BorderW >= Width div 4
       then BorderW := 0;

      BarW := Width - BorderW * 2;		{ Determine the width of the percentage bar }
      if BarW < BorderW
       then BarW := Width;

      if not HasAxis				{ Determine the height of the axis }
       then AxisH := 0
       else AxisH := CharH;
      if not HasTicks				{ Determine the height of the ticks }
       then TickH := 0
       else TickH := CharH div 2;
      WhiteH := CharH div 4;			{ Compute white space height }
      if not HasTitle
       then TitleH := 0
       else TitleH := CharH;

      BarH := Height;				{ Compute bar height }
      if HasTitle and				{ If the control has a title }
         (BarH - TitleH - WhiteH * 2 > 0)	{ And it fits in the space we have }
       then BarH := BarH - TitleH - WhiteH * 2;{ Then adjust the bar height for the title }
      if HasTicks and				{ If the control has tick marks }
         (BarH - TickH - WhiteH div 2 > 0)	{ And they fit in the space we have }
       then BarH := BarH - TickH - WhiteH div 2;{ Then adjust the bar height for the tick marks }
      if HasAxis and				{ If the control has an axis }
         (BarH - AxisH - WhiteH > 0)		{ And it fits in the space we have }
       then BarH := BarH - AxisH - WhiteH;

                                { Draw the Title }

      Rect.top    := CRect.top;			{ Compute the top    coordinate of the rectangle }
      Rect.left   := CRect.left  + BorderW;	{ Compute the left   coordinate of the rectangle }
      Rect.right  := CRect.right - BorderW;	{ Compute the right  coordinate of the rectangle }
      if HasTitle
       then
        begin
         Rect.top    := Rect.top + WhiteH;	{ Compute the top    coordinate of the Title rectangle }
         Rect.bottom := Rect.top + TitleH;	{ Compute the bottom coordinate of the Title rectangle }
         DrawTitle(HWindow, DC, Rect);
         Rect.top := Rect.bottom + WhiteH	{ Prepare the top    coordinate of the bar rectangle }
        end;

      				{ Draw the % bar }

      Rect.bottom := Rect.top + BarH;		{ Compute the bottom coordinate of the bar rectangle }
      DrawBar(HWindow, DC, Rect);		{ Draw the bar on the display }
      if HasPct					{ Draw the percent digits if this style is on }
       then
        begin
         Rect.top    := Rect.top + 		{ Compute the bounding rect for the percent display }
                        (BarH - CharH) div 2;
         Rect.bottom := Rect.top + CharH;
         DrawDigits(HWindow, DC, Rect);
         Rect.top := Rect.top -			{ Restore the rectangle }
                     (BarH - CharH) div 2
        end;

      if HasTicks				{ Draw the axis tickmarks }
       then
        begin
         Rect.top    := Rect.top + BarH;	{ Compute the top    coordinate of the ticks rectangle }
         Rect.bottom := Rect.top + TickH;	{ Compute the bottom coordinate of the ticks rectangle }
         DrawTicks(HWindow, DC, Rect, Style)	{ Draw the tick marks }
        end;

      if HasAxis		{ Draw the axis labels }
       then
        begin
         Rect.top    := Rect.bottom +		{ Compute the top    coordinate of the ticks rectangle }
                        WhiteH div 2;
         Rect.bottom := Rect.top + AxisH;	{ Compute the bottom coordinate of the ticks rectangle }
         Rect.left   := CRect.left;
         Rect.right  := CRect.right;
         DrawAxis(HWindow, DC, Rect, BorderW, Style)	{ Draw the axis labels }
        end;

      EndPaint(HWindow, Paint)
    end		{ PaintPercentCtrl };

  procedure SetPercentage(HWindow:  HWnd; Pct:  integer);
    begin	{ SetPercentage }
      SetWindowWord (HWindow, Pct_Percentage, Pct)
    end		{ SetPercentage };

  function PercentCtrlWndFn(HWindow:  HWnd;
                            Message,
                            wParam :  word;
                            lParam :  longint
                           ):  longint;
    var
      x     :  integer;
      result:  longint;

    begin	{ PercentCtrlWndFn }
      result := ord(TRUE);
      case Message of
        wm_Create       :
          begin
            SetPercentage(HWindow, 0);
            result := word(FALSE)
          end;
        wm_Paint        :  PaintPercentCtrl(HWindow);
        wm_NCHitTest    :  result := htTransparent;
        wm_EraseBkgnd   :  EraseBackground(HWindow, wParam);
        pcm_ResetPercent:
          begin
            SetPercentage (HWindow, 0);
            InvalidateRect(HWindow, nil, TRUE)
          end;
        pcm_AddPercent  :
          begin
            x := integer(wParam);
            x := x + GetPercentage(HWindow);
            if x < 0
             then x := 0;
            if x > 100
             then x := 100;
            SetPercentage (HWindow, x);
            InvalidateRect(HWindow, nil, TRUE)
          end;
        pcm_GetPercent  : result := GetPercentage(HWindow);
        pcm_SetPercent  :
          begin
            x := integer(wParam);
            if x < 0
             then x := 0;
            if x > 100
             then x := 100;
            SetPercentage (HWindow, x);
            InvalidateRect(HWindow, nil, TRUE)
          end;
       else result := DefWindowProc(HWindow, Message, wParam, lParam)
      end;
      PercentCtrlWndFn := result
    end		{ PercentCtrlWndFn };

  end.