home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / rcnt / ctrldlgs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-11-12  |  13.4 KB  |  414 lines
  1. {***************************************************************************
  2.  
  3.     NoMan Custom Control Library            $Version$
  4.     Style Dialog Box Function Unit
  5.     $Author$        $Date$
  6.  
  7.         Copyright 1991 Anthony M. Vitabile
  8.  
  9.     Unit Description
  10.  
  11.     This Turbo Pascal for Windows unit contains the code for
  12.     controlling the style dialog boxes for each of the custom
  13.     controls defined in this library.  Procedures common to all
  14.     dialog boxes are defined first, which control the operation of
  15.     various controls in the dialog boxes.  Then two procedures
  16.     specific to each control are defined.  The first of these is a
  17.     procedure that causes a dialog box to be displayed, and the
  18.     second is an actual Windows Dialog Box procedure.
  19.  
  20.     The library uses straight Windows calls and does NOT use Object-
  21.     Windows calls.    This is to allow the control to be used by ANY
  22.     Windows program.
  23.  
  24.     This code is adapted from the code that appeared in the July,
  25.     1990 issue of Microsoft Systems Journal article, "Extending the
  26.     Windows 3.0 Interface with Installable Custom Controls" by Kevin
  27.     P.  Welch.  It has been extended to support the multi-control
  28.     DLL format defined by Borland for use with its Resource Workshop
  29.     resource editor.
  30.  
  31. ***************************************************************************}
  32.  
  33. {$C DemandLoad Discardable}
  34. Unit CtrlDlgs;
  35. Interface
  36.   Uses WinTypes, CustCntl;
  37.  
  38.   procedure CenterPopup(HWindow, HParent:  HWnd); export;
  39.  
  40.   function PercentCtrlStyle(HWindow  :    HWnd;
  41.                 CtrlStyle:    THandle;
  42.                 StrToID  :    TStrToId;
  43.                 IDToStr  :    TIdToStr
  44.                ):  LongBool; export;
  45.   function PercentCtrlDlgFn(HDlg   :  HWnd;
  46.                 Message,
  47.                 wParam :  word;
  48.                 lParam :  longint
  49.                ):  Bool; export;
  50.  
  51. Implementation
  52.   Uses CtrlCommonDefs, Strings, WinProcs;
  53.  
  54.   const
  55.     hCtrlStyle :  PChar = MakeIntResource(1);
  56.     LpStrToIDLo:  PChar = MakeIntResource(2);
  57.     LpStrToIDHi:  PChar = MakeIntResource(3);
  58.     TheStyleArr:  PChar = MakeIntResource(4);
  59.     StyleDialog:  PChar = 'PercentStyle';
  60.  
  61.     ID_Identifier  = 100;        { Control:  ID      edit control ID }
  62.     ID_IDValue     = 101;        { Control:  Static text w/ID as a number }
  63.     ID_Title       = 102;        { Control:  Title   edit control ID }
  64.     ID_Tabstop       = 103;        { Control:  tabstop radio button }
  65.     ID_Group       = 104;        { Control:  group   radio button }
  66.  
  67.   type
  68.     StyleArray = array [ID_Tabstop .. ID_Tabstop + 16] of longint;
  69.  
  70.   var
  71.     CtrlStyleTemp:  THandle;        { Holds the TRWCtlStyle handle passed to PercentCtrlStyle }
  72.     UseStrToID     :  TStrToID;        { Address of function to convert from a string to an ID }
  73.     UseIDToStr     :  TIDToStr;        { Address of function to convert from an ID to a string }
  74.  
  75.   procedure Buttons(HWindow :  HWnd;
  76.                     CtlStyle:  PRWCtlStyle;
  77.             TheBtn  ,
  78.             FstBtn  ,
  79.             LstBtn  :  integer;
  80.             TheMask :  longint;
  81.         var TheStyle:  StyleArray);
  82.     begin    { Buttons }
  83.       CheckRadioButton(hWindow, FstBtn, LstBtn, TheBtn);
  84.       if CtlStyle <> nil
  85.        then
  86.          with CtlStyle^ do
  87.        dwStyle := dwStyle and TheMask or TheStyle[TheBtn]
  88.        else
  89.          for TheBtn := FstBtn to LstBtn do
  90.        EnableWindow(GetDlgItem(HWindow, TheBtn), FALSE)
  91.     end     { Buttons };
  92.  
  93.   procedure CenterPopup(HWindow, HParent:  HWnd);
  94.     var
  95.       xPopup  ,
  96.       yPopup  ,
  97.       cxPopup ,
  98.       cyPopup ,
  99.       cxScreen,
  100.       cyScreen,
  101.       cxParent,
  102.       cyParent:  integer;
  103.       rcWindow:  TRect;
  104.  
  105.     begin    { CenterPopup }
  106.         { Retrieve main display dimensions }
  107.       cxScreen := GetSystemMetrics(sm_CXScreen);
  108.       cyScreen := GetSystemMetrics(sm_CYScreen);
  109.  
  110.         { Retrieve popup rectangle }
  111.       GetWindowRect(HWindow, rcWindow);
  112.  
  113.         { Calculate popup size }
  114.       cxPopup := rcWindow.right  - rcWindow.left;
  115.       cyPopup := rcWindow.bottom - rcWindow.top;
  116.  
  117.         { Calculate bounding rectangle }
  118.       if HParent = 0
  119.        then
  120.     begin
  121.      xPopup := (cxScreen - cxPopup) div 2;
  122.      yPopup := (cyScreen - cyPopup) div 2
  123.     end
  124.        else
  125.     begin
  126.      GetWindowRect(HParent, rcWindow);
  127.      cxParent := rcWindow.right  - rcWindow.left;
  128.      cyParent := rcWindow.bottom - rcwindow.top;
  129.  
  130.         { Center within parent window }
  131.      xPopup := rcWindow.left + ((cxParent - cxPopup) div 2);
  132.      yPopup := rcWindow.top  + ((cyParent - cyPopup) div 2);
  133.  
  134.         { Adjust popup x-location for screen size }
  135.  
  136.      if (xPopup + cxPopup) > cxScreen
  137.       then xPopup := cxScreen - cxPopup;
  138.      if (yPopup + cyPopup) > cyScreen
  139.       then yPopup := cyScreen - cyPopup
  140.     end;
  141.       if xPopup < 0
  142.        then xPopup := 0;
  143.       if yPopup < 0
  144.        then yPopup := 0;
  145.  
  146.       MoveWindow(hWindow, xPopup, yPopup, cxPopup, cyPopup, TRUE)
  147.     end     { CenterPopup };
  148.  
  149.   procedure CheckBit(HWindow :    HWnd;
  150.                      CtlStyle:  PRWCtlStyle;
  151.              ID      :    word;
  152.          var TheStyle:    StyleArray);
  153.     begin    { CheckBit }
  154.       if CtlStyle = nil
  155.        then EnableWindow(GetDlgItem(HWindow, ID), FALSE)
  156.        else
  157.     with CtlStyle^ do
  158.       begin
  159.         dwStyle := dwStyle xor TheStyle[ID];
  160.         CheckDlgButton(HWindow, ID, ord((dwStyle and TheStyle[ID]) <> 0))
  161.       end
  162.     end     { CheckBit };
  163.  
  164.   procedure ProcessOK(HDlg    :  HWnd;
  165.                       CtlStyle:  PRWCtlStyle;
  166.                       StrToID :  TStrToID);
  167.     var
  168.       bClose:  boolean;
  169.       wSize :  word;
  170.       Result:  longint;
  171.       TheID :  packed array [0 .. ctlTitle] of char;
  172.       temp  :  string[10];
  173.  
  174.     begin    { ProcessOK }
  175.       bClose   := FALSE;
  176.       if CtlStyle <> nil
  177.        then
  178.         begin
  179.          GetDlgItemText(HDlg, id_Title, CtlStyle^.szTitle, ctlTitle);
  180.          @StrToId := Pointer(MakeLong(
  181.                              GetProp(HDlg, LpStrToIDLo),
  182.                              GetProp(HDlg, LpStrToIDHi)));
  183.          wSize := GetDlgItemText(HDlg, id_Identifier, TheID, sizeof(TheID));
  184.          TheID[wSize] := #0;
  185.          if @StrToID = nil
  186.           then
  187.            begin
  188.         temp := StrPas(TheID);
  189.             Val(temp, Result, wSize);
  190.             if wSize = 0
  191.              then
  192.               begin
  193.                bClose        := TRUE;
  194.                CtlStyle^.wID := Result
  195.               end
  196.            end
  197.           else
  198.            begin
  199.             Result := StrToID(TheID);
  200.             if LoWord(Result) <> 0
  201.             then
  202.              begin
  203.               bClose        := TRUE;
  204.               CtlStyle^.wID := HiWord(Result)
  205.              end
  206.            end
  207.         end;
  208.       if bClose
  209.        then EndDialog(HDlg, ord(TRUE))
  210.     end     { ProcessOK };
  211.  
  212.   procedure SetButtons(hDlg      :  HWnd;
  213.                CtrlStyle  :  PRWCtlSTyle;
  214.                FirstButton,
  215.                LastButton :  integer;
  216.                TheMask      :  longint;
  217.            var TheStyle   :  StyleArray);
  218.     var
  219.       i:  integer;
  220.  
  221.     begin    { SetButtons }
  222.       if CtrlStyle = nil
  223.        then Buttons(hDlg, CtrlStyle, FirstButton, FirstButton, LastButton, TheMask, TheStyle)
  224.        else
  225.          with CtrlStyle^ do
  226.            begin
  227.              i := FirstButton;
  228.              while (i <= LastButton) and ((dwStyle and TheStyle[i]) = 0) do
  229.                inc(i);
  230.              if i > LastButton
  231.                then i := FirstButton;
  232.              Buttons(hDlg, CtrlStyle, i, FirstButton, LastButton, TheMask, TheStyle)
  233.            end
  234.     end     { SetButtons };
  235.  
  236.   procedure SetCheckBox(hDlg     :  HWnd;
  237.             CtrlStyle:  PRWCtlStyle;
  238.             Button     :  integer;
  239.             TheMask  :  longint);
  240.     var
  241.       State:  word;
  242.  
  243.     begin    { SetCheckBox }
  244.       if CtrlStyle = nil
  245.         then State := 0
  246.         else State := word((CtrlStyle^.dwStyle and TheMask) <> 0);
  247.       CheckDlgButton(hDlg, Button, State)
  248.     end     { SetCheckBox };
  249.  
  250.   procedure SetID(hDlg       :  HWnd;
  251.           CtrlStyle:  PRWCtlStyle;
  252.           IDToStr  :  TIDToStr);
  253.     var
  254.       PCtrlStyle:  PRWCtlStyle;
  255.       TheID     :  packed array [0 .. 32] of char;
  256.       temp      :  string[10];
  257.  
  258.     begin    { SetID }
  259.       Str(CtrlStyle^.wID:1, temp);
  260.       StrPCopy(TheID, temp);
  261.       SetDlgItemText(HDlg, id_IDValue, TheID);
  262.       if @IDToStr <> nil
  263.         then IDToStr(PCtrlStyle^.wID, TheID, sizeof(TheID));
  264.       SetDlgItemText(HDlg, id_Identifier, TheID)
  265.     end     { SetID };
  266.  
  267.   procedure TestAxis(HWindow :  HWnd;
  268.                      CtlStyle:  PRWCtlStyle;
  269.                      Button  :  integer;
  270.                      Mask    :  longint;
  271.                  var TheStyle:  StyleArray);
  272.     begin    { TestAxis }
  273.       if CtlStyle <> nil
  274.        then
  275.          with CtlStyle^ do
  276.            EnableWindow(GetDlgItem(HWindow, Button), (dwStyle and Mask <> 0))
  277.     end        { TestAxis };
  278.  
  279.   function PercentCtrlStyle(HWindow  :    HWnd;
  280.                 CtrlStyle:    THandle;
  281.                 StrToID  :    TStrToID;
  282.                 IDToStr  :    TIDToStr
  283.                ):  LongBool;
  284.     var
  285.       Result:  LongBool;
  286.       lpProc:  TFarProc;
  287.  
  288.     begin    { PercentCtrlStyle }
  289.       if CtrlStyle = 0
  290.        then Result := FALSE
  291.        else
  292.     begin
  293.      CtrlStyleTemp := CtrlStyle;
  294.      UseStrToID    := StrToID;
  295.      UseIDToStr    := IDToStr;
  296.      lpProc        := MakeProcInstance(@PercentCtrlDlgFn, HInstance);
  297.      Result        := LongBool(DialogBox(HInstance, StyleDialog, HWindow, lpProc));
  298.      FreeProcInstance(lpProc)
  299.     end;
  300.       PercentCtrlStyle := Result
  301.     end     { PercentCtrlStyle };
  302.  
  303.   function PercentCtrlDlgFn(HDlg   :  HWnd;
  304.                 Message,
  305.                 wParam :  word;
  306.                 lParam :  longint
  307.                ):  Bool;
  308.     label 1;
  309.  
  310.     const
  311.       ID_NoGrads  = 105;        { Control:  No  Grads radio button }
  312.       ID_10Grads  = 106;        { Control:  10% Grads radio button }
  313.       ID_25Grads  = 107;        { Control:  25% Grads radio button }
  314.       ID_50Grads  = 108;        { Control:  50% Grads radio button }
  315.       ID_DrawAxis = 109;        { Control:  Draw Axis radio button }
  316.       ID_DrawPct  = 110;        { Control:  Draw %    radio button }
  317.  
  318.     var
  319.       Result  :  Bool;
  320.       CtlStyle,
  321.       Style   :  THandle;
  322.       PStyle  :  PRWCtlStyle;
  323.       TheStyle:  ^StyleArray;
  324.       StrToID :  TStrToID;
  325.  
  326.     begin    { PercentCtrlDlgFn }
  327.       Result := TRUE;
  328.       if Message <> wm_InitDialog
  329.         then
  330.           begin
  331.         CtlStyle := GetProp(HDlg, hCtrlStyle);
  332.             if CtlStyle = 0
  333.               then PStyle := nil
  334.               else PStyle := GlobalLock(CtlStyle);
  335.             @StrToID := Pointer(MakeLong(GetProp(HDlg, LpStrToIDLo),
  336.                                          GetProp(HDlg, LpStrToIDHi)));
  337.             Style    := GetProp(HDlg, TheStyleArr);
  338.             TheStyle := GlobalLock(Style)
  339.           end;
  340.       case Message of
  341.     wm_InitDialog:
  342.       begin
  343.             Style := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, sizeof(StyleArray));
  344.             if Style = 0
  345.               then
  346.                 begin
  347.                   MessageBox(HDlg, 'Cannot Create Style Array!', nil, mb_IconExclamation or mb_OK);
  348.                   EndDialog (HDlg, ord(FALSE));
  349.                   goto 1
  350.                 end;
  351.             TheStyle := GlobalLock(Style);
  352.             if TheStyle = nil
  353.               then
  354.                 begin
  355.                   MessageBox(HDlg, 'Cannot Lock Style Array!', nil, mb_IconExclamation or mb_OK);
  356.                   GlobalFree(Style);
  357.                   EndDialog (HDlg, ord(FALSE));
  358.                   goto 1
  359.                 end;
  360.         TheStyle^[ID_TabStop ] := ws_TabStop;    { Set up the style array }
  361.             TheStyle^[ID_Group   ] := ws_Group;        { With Percent Control data }
  362.             TheStyle^[ID_NoGrads ] := 0;
  363.             TheStyle^[ID_10Grads ] := Pct_Decades;
  364.             TheStyle^[ID_25Grads ] := Pct_Quarters;
  365.             TheStyle^[ID_50Grads ] := Pct_Halves;
  366.             TheStyle^[ID_DrawAxis] := Pct_Axis;
  367.             TheStyle^[ID_DrawPct ] := Pct_Digits;
  368.  
  369.         { Initialize the property list }
  370.         SetProp(HDlg, hCtrlStyle , CtrlStyleTemp);
  371.         SetProp(HDlg, LpStrToIDLo, LoWord(longint(@UseStrToID)));
  372.         SetProp(HDlg, LpStrToIDHi, HiWord(longint(@UseStrToID)));
  373.             SetProp(HDlg, TheStyleArr, Style);
  374.             PStyle := GlobalLock(CtrlStyleTemp);
  375.  
  376.         CenterPopup   (HDlg, GetParent(HDlg));     { Center the popup in the parent window }
  377.             SetDlgItemText(HDlg, id_Title, PStyle^.szTitle);
  378.         SetID         (HDlg, Pstyle, UseIDToStr);
  379.         SetButtons    (HDlg, PStyle, ID_NoGrads , ID_50Grads, PctMask, TheStyle^);
  380.         SetCheckBox   (HDlg, PStyle, ID_DrawAxis, Pct_Axis  );
  381.         SetCheckBox   (HDlg, PStyle, ID_DrawPct , Pct_Digits);
  382.         SetCheckBox   (HDlg, PStyle, ID_TabStop , ws_TabStop);
  383.         SetCheckBox   (HDlg, PStyle, ID_Group   , ws_Group  );
  384.             TestAxis      (HDlg, PStyle, ID_DrawAxis, not PctMask, TheStyle^)
  385.       end;
  386.     wm_Command   :
  387.       case wParam of
  388.         IDOK       :  ProcessOK(HDlg, PStyle, StrToID);    { Process the OK     button }
  389.         IDCancel   :  EndDialog(HDlg, ord(FALSE));        { Process the Cancel button }
  390.         ID_NoGrads ..
  391.         ID_50Grads :  begin
  392.                             Buttons (hDlg, PStyle, wParam     , ID_NoGrads, ID_50Grads, PctMask, TheStyle^);
  393.                             TestAxis(HDlg, PStyle, ID_DrawAxis, not PctMask, TheStyle^)
  394.                           end;
  395.         ID_DrawAxis,
  396.         ID_DrawPct ,
  397.         ID_TabStop ,
  398.         ID_Group   :  CheckBit(hDlg, PStyle, wParam, TheStyle^);
  399.       end;
  400.     wm_Destroy   :
  401.       begin
  402.         RemoveProp(HDlg, hCtrlStyle);    { Clean up the property list }
  403.         RemoveProp(HDlg, LpStrToIDLo);
  404.         RemoveProp(HDlg, LpStrToIDHi);
  405.             RemoveProp(HDlg, TheStyleArr)
  406.       end
  407.        else Result := FALSE
  408.       end;
  409.       GlobalUnlock(Style);
  410. 1:    PercentCtrlDlgFn := Result
  411.     end     { PercentCtrlDlgFn };
  412.  
  413.   end.
  414.