cpwodial.pas

生物信息学中的遗传数据分析的delphi源码。

{*********************************************}
{                                             }
{    COMPONENT for MS DOS and MS WINDOWS      }
{                                             }
{    Source code for Turbo Pascal 6.0 and     }
{    Turbo Pasacal for Windows 1.0 compilers. }
{                                             }
{    (c) 1991, Roderic D. M. Page             }
{                                             }
{*********************************************}

{*
   TOptionsDialog is a descendant of TDialog that supports "hiding"
   some of its functionality. Dialog box expands to display the remaining
   options if user clicks on the "Options >>" button.

   Code is a Pascal translation of Jeffrey M. Richter's C code from
   "Windows 3: A developer's guide" (M&T books, pp: 145-153).

   To use this code, the dialog box must include in its resource file:

   1. A push button control with the id "id_Options."

   2. A static control with the id "id_DefaultBox" and the style
      ss_BlackRect to mark the limit of the default area of the
      dialog box.

   History
   -------

   14 Oct 1991 Written.

   15 Oct 1991 Bug found if dialog box moved by user before
               "Options>>" button pressed. Dialog box doesn't resize
               properly because its old information on its greatest
               extent is now invalid. Fixed this by handling wm_Move
               messages.

*}

{$I CPDIR.INC}

unit cpwodial;

interface

uses
   WinTypes,
	WinProcs,
	{$IFDEF BWCC}    { use Borland-style dialogs }
   BWCC,
   {$IFDEF VER10}   { TPW 1.0 }
   WObjectB,
   StdDlgsB,
   {$ELSE}
	WObjects,
   StdDlgs,
   {$ENDIF} {VER10}
	{$ELSE}         { use standard dialogs }
   WObjects,
   {$ENDIF}
   cpwdlg;         { TDialog desc with a help button }

const
   id_Options    = 157;
   id_DefaultBox = 164;

type
  POptionsDialog = ^TOptionsDialog;
  TOptionsDialog = object(CPWDialog)
     procedure SetUpWindow;virtual;
     procedure ShowArea (fShowDefAreaOnly: Bool; hDlg, hWndDefArea: HWnd);
     procedure Options (var Msg:TMessage);virtual id_First + id_Options;
     procedure WMMove (var Msg:TMessage);virtual wm_First + wm_Move;
     private
     left,
     top,
     right,
     bottom : integer;
     end;

implementation

const
   { Bit mask flags }
   EnableChildren  :longint = $80000000;
   DisableChildren :longint = $00000000;

{-----------------------------EnableChildrenInOptionArea-------------------}

{ Call back function to disable/enable dialog box controls
  outside the default area. }
function EnableChildrenInOptionArea (H:HWnd; lParam:longint):integer;
   export;
var
   rc      : TRect;
   fEnable : Bool;
begin
   { Get fEnable flag from lParam }
   fEnable := ((lParam and ENABLECHILDREN) <> 0);
   lParam := lParam and not ENABLECHILDREN;

   { Calculate rectangle occupied by child window
     in screen coordinates. }
   GetWindowRect (H, rc);

   { Enable/disable child if its:
     right edge is >= the right edge of hWndDefArea
     bottom edge is >= the bottom edge of hDefWndArea.
   }
   if ((rc.right >= LoWord(lParam)) or (rc.bottom >= HiWord(lParam))) then
      EnableWindow (H, fEnable);

   { Allow enumeration to continue until all windows
     are checked. }
   EnableChildrenInOptionArea := 1;
end;

{-----------------------------WMMove---------------------------------------}

procedure TOPtionsDialog.WMMove (var Msg: TMessage);
var
   dhoriz, dvert: integer;
begin
   dhoriz := Msg.lParamLo - left;
   dvert  := Msg.lParamHi - top;
   TDialog.DefWndProc (Msg);
   right  := right + dhoriz;
   bottom := bottom + dvert;
end;

{-----------------------------SetUpWindow----------------------------------}

{ Set up window with just the default area showing }
procedure TOptionsDialog.SetUpWindow;
var
   rcDlg: TRect;
begin
   TDialog.SetUpWindow;
   { Save original size of dialog box }
   GetWindowRect (HWindow, rcDlg);
   left   := rcDlg.left;
   top    := rcDlg.top;
   right  := rcDlg.right;
   bottom := rcDlg.bottom;
   ShowArea (True, HWindow, GetDlgItem (HWindow, id_DefaultBox));
end;

{-----------------------------Options--------------------------------------}

{ Handle user clicking on "Options" button by displaying optional
  part of dialog box and disabling the "Options" button. }
procedure TOptionsDialog.Options (var Msg:TMessage);
begin
   if (HiWord (Msg.lParam) = bn_Clicked) then begin
      ShowArea (False, HWindow, GetDlgItem (HWindow, id_DefaultBox));

      { The ShowArea (False,...) function enables all
        windows outside the "default" area. Any windows
        that should be disabled must be explicitly
        disabled here. Note that the status of the
        windows within the default area is NOT changed.
      }
      SetFocus (GetNextDlgTabItem (HWindow, LoWord (Msg.lParam), False));
      EnableWindow (LoWord (Msg.lParam), False);
      end;
end;

{-----------------------------ShowArea-------------------------------------}

{ Show or hide the optional area of the dialog box. }
procedure TOptionsDialog.ShowArea (fShowDefAreaOnly: Bool;
                                hDlg, hWndDefArea: HWnd);
var
   rcDlg,
   rcDefArea,
   rcOptionsArea : TRect;
   fpProc        : TFarProc;
   Parameter     : longint;

begin
   { Save original width and height of dialog box }
   GetWindowRect (hDlg, rcDlg);

   { Retrieve coordinates for default area window }
   GetWindowRect (hWndDefArea, rcDefArea);

   { Enable/disable controls outside of default area. Any window
     whose left edge > rcDefArea.right or right > rcDefArea.bottom.
     Set bit in lParam as a flag for enable/disable. }
   if fShowDefAreaOnly then
      Parameter := DISABLECHILDREN
   else Parameter := ENABLECHILDREN;
   Parameter := Parameter or MakeLong (rcDefArea.right, rcDefArea.bottom);
   fpProc := MakeProcInstance (@EnableChildrenInOptionArea, HInstance);
   EnumChildWindows (HWindow, fpProc, Parameter);
   FreeProcInstance (fpProc);

   if fShowDefAreaOnly then begin
      { Resize dialog box to fit only default area }
      SetWindowPos (hDlg, 0, 0, 0, rcDefArea.right - rcDlg.left,
                   rcDefArea.bottom - rcDlg.top,
                   swp_NoZOrder or swp_NoMove);
      { Make sure the default area box is hidden }
      ShowWindow (hWndDefArea, sw_Hide);
      end
   else
      { Resize dialog box to maximum size }
      SetWindowPos (hDlg, 0, 0, 0, right - rcDlg.left,
                    bottom - rcDlg.top,
                   swp_NoZOrder or swp_NoMove);

end;


begin
end.