cpwcontl.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             }
{                                             }
{*********************************************}


{$I CPDIR.INC}

unit cpwcontl;

{*
   17 Jun 1992 Changes made to how controls handle out of range values.
*}

{*

   Control types:

   TEdit                        [ ObjectWindows ]
   |
   |
   +-----TNumEdit               Editor for positive integer numbers only
   |     |
   |     |
   |     +-----TExludeNumEdit   Exclude one number from allowed range
   |     |
   |     |
   |     +-----TSpinEdit        Editor with associated custom spin button
   |
   +-----TRangeEdit             Editor that processes a range (1 4-5 6.-)

   New control types:
   =================

   TNumEdit (a descendant of TEdit) that allows integers to be input.

   User messages defined here:
   ==========================

   um_AdjustRange
   ------------------------------------------------------------------

   Informs control of new range of valid values.

   Parameters  wParam: lower value
               lParam: upper value

   Comments    Allows a dialog window to update a control (such
               as a TNumEdit control) to a new range.

   um_GetValue
   ------------------------------------------------------------------

   Gets value in control.

   Parameters  wParam: not used
               lParam: not used


   um_SetSpin
   ------------------------------------------------------------------

   Sets range and current value for spin button

   Parameters  wParam: spin button's handle
               lParam: not used

   um_SetValue
   ------------------------------------------------------------------

   Sets current value shown by editor

   Parameters  wParam: new value
               lParam: not used

*}


interface

uses
   WinTypes,
	WinProcs,
	{$IFDEF BWCC}    { use Borland-style dialogs }
   BWCC,
   {$IFDEF VER10}   { TPW 1.0 }
   WObjectB,
   StdDlgsB,
   {$ELSE}
   WObjects,
   StdDlgs,
   {$ENDIF} {VER10}
   {$ELSE}
	WObjects,
   {$ENDIF}
   Strings,
   SpinCo;    { constants for spin button custom control }

const
   um_AdjustRange     = wm_User + 8;
   um_GetValue        = wm_User + 9;
   um_SetSpin         = wm_User + 10;
   um_SetValue        = wm_User + 11;
   um_NewValue       = wm_User + 14;

type

  { TNumEdit is taken from \tpw\owldemos\vdlgapp.pas, and
    modified to intercept wm_Char messages and
    accept only '0'..'9' characters.  Will not accept
    numbers outside a certain range, and displays a
    dialog box if user tries to enter an invalid number.}

  PNumEdit = ^TNumEdit;
  TNumEdit = object(TEdit)
    MinValue, MaxValue: Longint;
    constructor Init(AParent: PWindowsObject; AnId: Integer;
      ATitle: PChar; X, Y, W, H: Integer; Digits: Word;
      AMinValue, AMaxValue: Longint);
    constructor InitResource(AParent: PWindowsObject; ResourceID: Word;
      Digits: Word; AMinValue, AMaxValue: Longint);
    function Transfer(DataPtr: Pointer; TransferFlag: Word): Word; virtual;
    procedure WMChar (var Msg: TMessage);
       virtual wm_First + wm_Char;
    procedure UMAdjustRange (var Msg: TMessage);
       virtual wm_First + um_AdjustRange;
    procedure UMGetValue (var Msg:TMessage);
       virtual wm_First + um_GetValue;
    procedure UMSetValue (var Msg:TMessage);
       virtual wm_First + um_SetValue;
  end;

  PExcludeNumEdit = ^TExcludeNumEdit;
  TExcludeNumEdit = object(TNumEdit)
     Excluded : longint;
     constructor Init(AParent: PWindowsObject; AnId: Integer;
       ATitle: PChar; X, Y, W, H: Integer; Digits: Word;
       AMinValue, AMaxValue, ExcludedValue: Longint);
     constructor InitResource(AParent: PWindowsObject; ResourceID: Word;
       Digits: Word; AMinValue, AMaxValue, ExcludedValue: Longint);
     procedure WMChar (var Msg: TMessage);
        virtual wm_First + wm_Char;
     end;


  { TSpinEdit is accepts only numbers, and updates
   (and is updated by) its associated spin button. }

  PSpinEdit = ^TSpinEdit;
  TSpinEdit = object(TNumEdit)
    SpinID: integer;
    CurValue : longint;
    constructor Init(AParent: PWindowsObject; AnId: Integer;
      ATitle: PChar; X, Y, W, H: Integer; Digits: Word;
      AMinValue, AMaxValue, ACurValue: Longint; ASpinID:integer);
    constructor InitResource(AParent: PWindowsObject; ResourceID: Word;
      Digits: Word; AMinValue, AMaxValue, ACurValue: Longint;ASpinID:integer);
    procedure WMKeyDown (var Msg:TMessage);
       virtual wm_First + wm_KeyDown;
    procedure SetSpinButton (var Msg:TMessage);
       virtual wm_First + um_SetSpin;
    procedure UMAdjustRange (var Msg: TMessage);
       virtual wm_First + um_AdjustRange;
    procedure UMSetValue (var Msg:TMessage);
       virtual wm_First + um_SetValue;
    procedure EMReplaceSel (var Msg:TMessage);
       virtual wm_First + em_ReplaceSel;
  end;


  { Accepts only a string specifying a range of
    positive integers between MinValue and MaxValue. }
  PRangeEdit = ^TRangeEdit;
  TRangeEdit = object(TEdit)
    MinValue, MaxValue: Longint;
    constructor Init(AParent: PWindowsObject; AnId: Integer;
      ATitle: PChar; X, Y, W, H: Integer; Digits: Word;
      AMinValue, AMaxValue: Longint);
    constructor InitResource(AParent: PWindowsObject; ResourceID: Word;
      Digits: Word; AMinValue, AMaxValue: Longint);
    function CanClose:Boolean;virtual;
    end;

implementation

{**********************}
{                      }
{  TNumEdit            }
{                      }
{**********************}

{-----------------------------Init-----------------------------------------}

constructor TNumEdit.Init(AParent: PWindowsObject; AnId: Integer;
  ATitle: PChar; X, Y, W, H: Integer; Digits: Word;
  AMinValue, AMaxValue: Longint);
begin
  TEdit.Init(AParent, AnId, ATitle, X, Y, W, H, Digits + 1, False);
  MinValue := AMinValue;
  MaxValue := AMaxValue;
end;

{-----------------------------InitResource---------------------------------}

constructor TNumEdit.InitResource(AParent: PWindowsObject;
  ResourceID: Word; Digits: Word; AMinValue, AMaxValue: Longint);
begin
  TEdit.InitResource(AParent, ResourceID, Digits + 1);
  MinValue     := AMinValue;
  MaxValue     := AMaxValue;
end;

{-----------------------------Transfer-------------------------------------}

function TNumEdit.Transfer(DataPtr: Pointer; TransferFlag: Word): Word;
var
  ValCode: Integer;
  Text: array[0..15] of Char;
begin
  case TransferFlag of
    tf_GetData:
      begin
        GetText(Text, SizeOf(Text));
        Val(Text, longint(DataPtr^), ValCode);
      end;
    tf_SetData:
      begin
        Str(longint(DataPtr^),Text);
        SetText(Text);
      end;
  end;
  Transfer := SizeOf(Longint);
end;

{-----------------------------WMChar---------------------------------------}

{ Intercept wm_Char message and accept only
  numbers, otherwise beep.  Check that user is
  trying to enter a valid number.}
procedure TNumEdit.WMChar (var Msg: TMessage);
var
   OldBuf, NewBuf : array[0..20] of char;
   Code:integer;
   i:longint;
   Arg: array[0..1] of longint;
   UMsg: array[0..80] of char;
begin
   GetText (OldBuf, 19);
   if (Msg.wParam in [48..57])  { ASCII '0'..'9' }
      or (Msg.wParam = vk_Back) { ASCII backspace }
      or (Msg.wParam = vk_Return) { Enter key } then
      DefWndProc (Msg)
   else MessageBeep (0);

   GetText (NewBuf, 19);
   Val (NewBuf, i, Code);
   if (i > MaxValue) then begin
      MessageBeep (0);
      Arg[0] := MinValue;
      Arg[1] := MaxValue;
      WVSPrintF(UMsg, 'Valid numbers are from %ld to %ld', Arg);
      BWCCMessageBox(HWindow, UMsg, 'Error', mb_Ok or mb_IconExclamation);
      SetFocus (HWindow);
      SetText (OldBuf);
      end;
end;

{-----------------------------UMAdjustRange--------------------------------}

{ Adjust range of valid values and adjust current
  value if necessary. }
procedure TNumEdit.UMAdjustRange (var Msg: TMessage);
var
   oldx, x:longint;
begin
   MinValue := Msg.wParam;
   MaxValue := Msg.lParam;
   x := SendMessage (HWindow, um_GetValue, 0, 0);
   oldx := x;
   if (x < MinValue) then
      x := MinValue;
   if (x > MaxValue) then
      x := MaxValue;
   if (Oldx <> x) then
      SendMessage (HWindow, um_SetValue, x, 0);
end;

{-----------------------------UMGetValue-----------------------------------}

{ Returns in Msg.Result the current value in the editor.
  If editor doesn't contain a valid number then
  returns -1. }
procedure TNumEdit.UMGetValue (var Msg:TMessage);
var
  ValCode: Integer;
  x : longint;
  Text: array[0..15] of Char;
begin
  GetText (Text, SizeOf(Text));
  Val(Text, x, ValCode);
  if (ValCode = 0) then
     Msg.Result := x
  else Msg.Result := -1;
end;

{-----------------------------UMSetValue-----------------------------------}

{ Change the current value in the editor. }
procedure TNumEdit.UMSetValue (var Msg:TMessage);
var
  Text: array[0..15] of Char;
begin
  Str (Msg.wParam, text);
  SetText (Text);
end;

{**********************}
{                      }
{  TExcludeNumEdit     }
{                      }
{**********************}

{-----------------------------Init-----------------------------------------}

constructor TExcludeNumEdit.Init(AParent: PWindowsObject; AnId: Integer;
  ATitle: PChar; X, Y, W, H: Integer; Digits: Word;
  AMinValue, AMaxValue, ExcludedValue: Longint);
begin
  TNumEdit.Init(AParent, AnId, ATitle, X, Y, W, H, Digits + 1,
                AMinValue, AMaxValue);
  Excluded := ExcludedValue;
end;

{-----------------------------InitResource---------------------------------}

constructor TExcludeNumEdit.InitResource(AParent: PWindowsObject;
  ResourceID: Word; Digits: Word; AMinValue, AMaxValue,
  ExcludedValue: Longint);
begin
  TNumEdit.InitResource(AParent, ResourceID, Digits + 1,
                        AMinValue, AMaxValue);
  Excluded := ExcludedValue;
end;