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

	NoMan Custom Control Library			$Version$
	Style Dialog Box Function Unit
	$Author$		$Date$

        Copyright 1991 Anthony M. Vitabile

	Unit Description

	This Turbo Pascal for Windows unit contains the code for
	controlling the style dialog boxes for each of the custom
	controls defined in this library.  Procedures common to all
	dialog boxes are defined first, which control the operation of
	various controls in the dialog boxes.  Then two procedures
	specific to each control are defined.  The first of these is a
	procedure that causes a dialog box to be displayed, and the
	second is an actual Windows Dialog Box procedure.

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

	This code is adapted from the code that appeared in the July,
	1990 issue of Microsoft Systems Journal article, "Extending the
	Windows 3.0 Interface with Installable Custom Controls" by Kevin
	P.  Welch.  It has been extended to support the multi-control
	DLL format defined by Borland for use with its Resource Workshop
	resource editor.

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

{$C DemandLoad Discardable}
Unit CtrlDlgs;
Interface
  Uses WinTypes, CustCntl;

  procedure CenterPopup(HWindow, HParent:  HWnd); export;

  function PercentCtrlStyle(HWindow  :	HWnd;
			    CtrlStyle:	THandle;
			    StrToID  :	TStrToId;
			    IDToStr  :	TIdToStr
			   ):  LongBool; export;
  function PercentCtrlDlgFn(HDlg   :  HWnd;
			    Message,
			    wParam :  word;
			    lParam :  longint
			   ):  Bool; export;

Implementation
  Uses CtrlCommonDefs, Strings, WinProcs;

  const
    hCtrlStyle :  PChar = MakeIntResource(1);
    LpStrToIDLo:  PChar = MakeIntResource(2);
    LpStrToIDHi:  PChar = MakeIntResource(3);
    TheStyleArr:  PChar = MakeIntResource(4);
    StyleDialog:  PChar = 'PercentStyle';

    ID_Identifier  = 100;		{ Control:  ID      edit control ID }
    ID_IDValue     = 101;		{ Control:  Static text w/ID as a number }
    ID_Title	   = 102;		{ Control:  Title   edit control ID }
    ID_Tabstop	   = 103;		{ Control:  tabstop radio button }
    ID_Group	   = 104;		{ Control:  group   radio button }

  type
    StyleArray = array [ID_Tabstop .. ID_Tabstop + 16] of longint;

  var
    CtrlStyleTemp:  THandle;		{ Holds the TRWCtlStyle handle passed to PercentCtrlStyle }
    UseStrToID	 :  TStrToID;		{ Address of function to convert from a string to an ID }
    UseIDToStr	 :  TIDToStr;		{ Address of function to convert from an ID to a string }

  procedure Buttons(HWindow :  HWnd;
                    CtlStyle:  PRWCtlStyle;
		    TheBtn  ,
		    FstBtn  ,
		    LstBtn  :  integer;
		    TheMask :  longint;
		var TheStyle:  StyleArray);
    begin	{ Buttons }
      CheckRadioButton(hWindow, FstBtn, LstBtn, TheBtn);
      if CtlStyle <> nil
       then
         with CtlStyle^ do
	   dwStyle := dwStyle and TheMask or TheStyle[TheBtn]
       else
         for TheBtn := FstBtn to LstBtn do
	   EnableWindow(GetDlgItem(HWindow, TheBtn), FALSE)
    end 	{ Buttons };

  procedure CenterPopup(HWindow, HParent:  HWnd);
    var
      xPopup  ,
      yPopup  ,
      cxPopup ,
      cyPopup ,
      cxScreen,
      cyScreen,
      cxParent,
      cyParent:  integer;
      rcWindow:  TRect;

    begin	{ CenterPopup }
		{ Retrieve main display dimensions }
      cxScreen := GetSystemMetrics(sm_CXScreen);
      cyScreen := GetSystemMetrics(sm_CYScreen);

		{ Retrieve popup rectangle }
      GetWindowRect(HWindow, rcWindow);

		{ Calculate popup size }
      cxPopup := rcWindow.right  - rcWindow.left;
      cyPopup := rcWindow.bottom - rcWindow.top;

		{ Calculate bounding rectangle }
      if HParent = 0
       then
	begin
	 xPopup := (cxScreen - cxPopup) div 2;
	 yPopup := (cyScreen - cyPopup) div 2
	end
       else
	begin
	 GetWindowRect(HParent, rcWindow);
	 cxParent := rcWindow.right  - rcWindow.left;
	 cyParent := rcWindow.bottom - rcwindow.top;

		{ Center within parent window }
	 xPopup := rcWindow.left + ((cxParent - cxPopup) div 2);
	 yPopup := rcWindow.top  + ((cyParent - cyPopup) div 2);

		{ Adjust popup x-location for screen size }

	 if (xPopup + cxPopup) > cxScreen
	  then xPopup := cxScreen - cxPopup;
	 if (yPopup + cyPopup) > cyScreen
	  then yPopup := cyScreen - cyPopup
	end;
      if xPopup < 0
       then xPopup := 0;
      if yPopup < 0
       then yPopup := 0;

      MoveWindow(hWindow, xPopup, yPopup, cxPopup, cyPopup, TRUE)
    end 	{ CenterPopup };

  procedure CheckBit(HWindow :	HWnd;
                     CtlStyle:  PRWCtlStyle;
		     ID      :	word;
		 var TheStyle:	StyleArray);
    begin	{ CheckBit }
      if CtlStyle = nil
       then EnableWindow(GetDlgItem(HWindow, ID), FALSE)
       else
	with CtlStyle^ do
	  begin
	    dwStyle := dwStyle xor TheStyle[ID];
	    CheckDlgButton(HWindow, ID, ord((dwStyle and TheStyle[ID]) <> 0))
	  end
    end 	{ CheckBit };

  procedure ProcessOK(HDlg    :  HWnd;
                      CtlStyle:  PRWCtlStyle;
                      StrToID :  TStrToID);
    var
      bClose:  boolean;
      wSize :  word;
      Result:  longint;
      TheID :  packed array [0 .. ctlTitle] of char;
      temp  :  string[10];

    begin	{ ProcessOK }
      bClose   := FALSE;
      if CtlStyle <> nil
       then
        begin
         GetDlgItemText(HDlg, id_Title, CtlStyle^.szTitle, ctlTitle);
         @StrToId := Pointer(MakeLong(
                             GetProp(HDlg, LpStrToIDLo),
                             GetProp(HDlg, LpStrToIDHi)));
         wSize := GetDlgItemText(HDlg, id_Identifier, TheID, sizeof(TheID));
         TheID[wSize] := #0;
         if @StrToID = nil
          then
           begin
	    temp := StrPas(TheID);
            Val(temp, Result, wSize);
            if wSize = 0
             then
              begin
               bClose        := TRUE;
               CtlStyle^.wID := Result
              end
           end
          else
           begin
            Result := StrToID(TheID);
            if LoWord(Result) <> 0
            then
             begin
              bClose        := TRUE;
              CtlStyle^.wID := HiWord(Result)
             end
           end
        end;
      if bClose
       then EndDialog(HDlg, ord(TRUE))
    end 	{ ProcessOK };

  procedure SetButtons(hDlg	  :  HWnd;
		       CtrlStyle  :  PRWCtlSTyle;
		       FirstButton,
		       LastButton :  integer;
		       TheMask	  :  longint;
		   var TheStyle   :  StyleArray);
    var
      i:  integer;

    begin	{ SetButtons }
      if CtrlStyle = nil
       then Buttons(hDlg, CtrlStyle, FirstButton, FirstButton, LastButton, TheMask, TheStyle)
       else
         with CtrlStyle^ do
           begin
             i := FirstButton;
             while (i <= LastButton) and ((dwStyle and TheStyle[i]) = 0) do
               inc(i);
             if i > LastButton
               then i := FirstButton;
             Buttons(hDlg, CtrlStyle, i, FirstButton, LastButton, TheMask, TheStyle)
           end
    end 	{ SetButtons };

  procedure SetCheckBox(hDlg	 :  HWnd;
			CtrlStyle:  PRWCtlStyle;
			Button	 :  integer;
			TheMask  :  longint);
    var
      State:  word;

    begin	{ SetCheckBox }
      if CtrlStyle = nil
        then State := 0
        else State := word((CtrlStyle^.dwStyle and TheMask) <> 0);
      CheckDlgButton(hDlg, Button, State)
    end 	{ SetCheckBox };

  procedure SetID(hDlg	   :  HWnd;
		  CtrlStyle:  PRWCtlStyle;
		  IDToStr  :  TIDToStr);
    var
      PCtrlStyle:  PRWCtlStyle;
      TheID     :  packed array [0 .. 32] of char;
      temp      :  string[10];

    begin	{ SetID }
      Str(CtrlStyle^.wID:1, temp);
      StrPCopy(TheID, temp);
      SetDlgItemText(HDlg, id_IDValue, TheID);
      if @IDToStr <> nil
        then IDToStr(PCtrlStyle^.wID, TheID, sizeof(TheID));
      SetDlgItemText(HDlg, id_Identifier, TheID)
    end 	{ SetID };

  procedure TestAxis(HWindow :  HWnd;
                     CtlStyle:  PRWCtlStyle;
                     Button  :  integer;
                     Mask    :  longint;
                 var TheStyle:  StyleArray);
    begin	{ TestAxis }
      if CtlStyle <> nil
       then
         with CtlStyle^ do
           EnableWindow(GetDlgItem(HWindow, Button), (dwStyle and Mask <> 0))
    end		{ TestAxis };

  function PercentCtrlStyle(HWindow  :	HWnd;
			    CtrlStyle:	THandle;
			    StrToID  :	TStrToID;
			    IDToStr  :	TIDToStr
			   ):  LongBool;
    var
      Result:  LongBool;
      lpProc:  TFarProc;

    begin	{ PercentCtrlStyle }
      if CtrlStyle = 0
       then Result := FALSE
       else
	begin
	 CtrlStyleTemp := CtrlStyle;
	 UseStrToID    := StrToID;
	 UseIDToStr    := IDToStr;
	 lpProc        := MakeProcInstance(@PercentCtrlDlgFn, HInstance);
	 Result        := LongBool(DialogBox(HInstance, StyleDialog, HWindow, lpProc));
	 FreeProcInstance(lpProc)
	end;
      PercentCtrlStyle := Result
    end 	{ PercentCtrlStyle };

  function PercentCtrlDlgFn(HDlg   :  HWnd;
			    Message,
			    wParam :  word;
			    lParam :  longint
			   ):  Bool;
    label 1;

    const
      ID_NoGrads  = 105;		{ Control:  No  Grads radio button }
      ID_10Grads  = 106;		{ Control:  10% Grads radio button }
      ID_25Grads  = 107;		{ Control:  25% Grads radio button }
      ID_50Grads  = 108;		{ Control:  50% Grads radio button }
      ID_DrawAxis = 109;		{ Control:  Draw Axis radio button }
      ID_DrawPct  = 110;		{ Control:  Draw %    radio button }

    var
      Result  :  Bool;
      CtlStyle,
      Style   :  THandle;
      PStyle  :  PRWCtlStyle;
      TheStyle:  ^StyleArray;
      StrToID :  TStrToID;

    begin	{ PercentCtrlDlgFn }
      Result := TRUE;
      if Message <> wm_InitDialog
        then
          begin
	    CtlStyle := GetProp(HDlg, hCtrlStyle);
            if CtlStyle = 0
              then PStyle := nil
              else PStyle := GlobalLock(CtlStyle);
            @StrToID := Pointer(MakeLong(GetProp(HDlg, LpStrToIDLo),
                                         GetProp(HDlg, LpStrToIDHi)));
            Style    := GetProp(HDlg, TheStyleArr);
            TheStyle := GlobalLock(Style)
          end;
      case Message of
	wm_InitDialog:
	  begin
            Style := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, sizeof(StyleArray));
            if Style = 0
              then
                begin
                  MessageBox(HDlg, 'Cannot Create Style Array!', nil, mb_IconExclamation or mb_OK);
                  EndDialog (HDlg, ord(FALSE));
                  goto 1
                end;
            TheStyle := GlobalLock(Style);
            if TheStyle = nil
              then
                begin
                  MessageBox(HDlg, 'Cannot Lock Style Array!', nil, mb_IconExclamation or mb_OK);
                  GlobalFree(Style);
                  EndDialog (HDlg, ord(FALSE));
                  goto 1
                end;
	    TheStyle^[ID_TabStop ] := ws_TabStop;	{ Set up the style array }
            TheStyle^[ID_Group   ] := ws_Group;		{ With Percent Control data }
            TheStyle^[ID_NoGrads ] := 0;
            TheStyle^[ID_10Grads ] := Pct_Decades;
            TheStyle^[ID_25Grads ] := Pct_Quarters;
            TheStyle^[ID_50Grads ] := Pct_Halves;
            TheStyle^[ID_DrawAxis] := Pct_Axis;
            TheStyle^[ID_DrawPct ] := Pct_Digits;

		{ Initialize the property list }
	    SetProp(HDlg, hCtrlStyle , CtrlStyleTemp);
	    SetProp(HDlg, LpStrToIDLo, LoWord(longint(@UseStrToID)));
	    SetProp(HDlg, LpStrToIDHi, HiWord(longint(@UseStrToID)));
            SetProp(HDlg, TheStyleArr, Style);
            PStyle := GlobalLock(CtrlStyleTemp);

	    CenterPopup   (HDlg, GetParent(HDlg)); 	{ Center the popup in the parent window }
            SetDlgItemText(HDlg, id_Title, PStyle^.szTitle);
	    SetID         (HDlg, Pstyle, UseIDToStr);
	    SetButtons    (HDlg, PStyle, ID_NoGrads , ID_50Grads, PctMask, TheStyle^);
	    SetCheckBox   (HDlg, PStyle, ID_DrawAxis, Pct_Axis  );
	    SetCheckBox   (HDlg, PStyle, ID_DrawPct , Pct_Digits);
	    SetCheckBox   (HDlg, PStyle, ID_TabStop , ws_TabStop);
	    SetCheckBox   (HDlg, PStyle, ID_Group   , ws_Group  );
            TestAxis      (HDlg, PStyle, ID_DrawAxis, not PctMask, TheStyle^)
	  end;
	wm_Command   :
	  case wParam of
	    IDOK       :  ProcessOK(HDlg, PStyle, StrToID);	{ Process the OK     button }
	    IDCancel   :  EndDialog(HDlg, ord(FALSE));		{ Process the Cancel button }
	    ID_NoGrads ..
	    ID_50Grads :  begin
                            Buttons (hDlg, PStyle, wParam     , ID_NoGrads, ID_50Grads, PctMask, TheStyle^);
                            TestAxis(HDlg, PStyle, ID_DrawAxis, not PctMask, TheStyle^)
                          end;
	    ID_DrawAxis,
	    ID_DrawPct ,
	    ID_TabStop ,
	    ID_Group   :  CheckBit(hDlg, PStyle, wParam, TheStyle^);
	  end;
	wm_Destroy   :
	  begin
	    RemoveProp(HDlg, hCtrlStyle);	{ Clean up the property list }
	    RemoveProp(HDlg, LpStrToIDLo);
	    RemoveProp(HDlg, LpStrToIDHi);
            RemoveProp(HDlg, TheStyleArr)
	  end
       else Result := FALSE
      end;
      GlobalUnlock(Style);
1:    PercentCtrlDlgFn := Result
    end 	{ PercentCtrlDlgFn };

  end.