cpwcontl.pas

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

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

{ Intercept wm_Char message and accept only
  numbers, otherwise beep.  Check that user is
  trying to enter a valid number.}
procedure TExcludeNumEdit.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]) then { ASCII '0'..'9' }
      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 lie are in the range from %ld to %ld', Arg);
      BWCCMessageBox(HWindow, UMsg, 'Error', mb_Ok or mb_IconExclamation);
      SetFocus (HWindow);
      SetText (OldBuf);
      end
   else begin
      if (i = Excluded) then begin
         MessageBeep (0);
         SetText (OldBuf);
         end;
      end;
end;

{**********************}
{                      }
{  TSpinEdit           }
{                      }
{**********************}

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

constructor TSpinEdit.Init(AParent: PWindowsObject; AnId: Integer;
  ATitle: PChar; X, Y, W, H: Integer; Digits: Word;
  AMinValue, AMaxValue, ACurValue: Longint; ASpinID:integer);
begin
  TNumEdit.Init(AParent, AnId, ATitle, X, Y, W, H, Digits + 1,AMinValue, AMaxValue);
  SpinID   := ASpinID;
  CurValue := ACurValue;
end;

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

constructor TSpinEdit.InitResource(AParent: PWindowsObject;
  ResourceID: Word; Digits: Word; AMinValue, AMaxValue, ACurValue: Longint;
  ASpinID:integer);
begin
  TNumEdit.InitResource(AParent, ResourceID, Digits + 1, AMinValue, AMaxValue);
  SpinID := ASpinID;
  CurValue := ACurValue;
end;

{-----------------------------WMKeyDown------------------------------------}

{ Intercept keyboard messages to implement an up-down
  arrow key interface for the editor button. }
procedure TSpinEdit.WMKeyDown(var Msg:TMessage);
var
   buf: array[0..10] of char;
   Code: integer;
   i:longint;
   UpDateText : Boolean;
begin
   UpDateText := False;
   CurValue := SendMessage (GetDlgItem (Parent^.HWindow, SpinID), SPNM_GETCRNTVALUE, 0, 0);
   case Msg.wParam of
      vk_Up:
         begin
            UpDateText := True;
            if (CurValue < MaxValue) then
               Inc(CurValue)
            else
               if SendMessage (GetDlgItem (Parent^.HWindow, SpinID),
                  SPNM_GETWRAP, 0, 0) <> 0 then
                  CurValue := MinValue
               else UpDateText := False;
         end;
      vk_Down:
         begin
            UpDateText := True;
            if (CurValue > MinValue) then
               Dec(CurValue)
            else
               if SendMessage (GetDlgItem (Parent^.HWindow, SpinID),
                  SPNM_GETWRAP, 0, 0) <> 0 then
                  CurValue := MaxValue
               else UpDateText := False;
         end;
      vk_Return:
         begin
            UpDateText := False;
            { User has pressed enter }
            GetText (Buf, 10);
            Val (Buf, i, Code);
            if (i <> CurValue) and (i >= MinValue)
               and (i <= MaxValue) then begin
               CurValue := i;
               SendMessage (GetDlgItem (Parent^.HWindow, SpinID),
                  SPNM_SETCRNTVALUE, CurValue, 0);
               SendMessage (Parent^.HWindow, um_NewValue, 0, 0);
               end;
         end;
      else DefWndProc (Msg);
      end;

   if UpDateText then begin
      { fix editor display }
      wvsprintf (buf, '%d',CurValue);
      SetText (buf);
      SetSelection (0,StrLen(buf));
      { update spin button }
      SendMessage (GetDlgItem (Parent^.HWindow, SpinID),
         SPNM_SETCRNTVALUE, CurValue, 0);
      SendMessage (Parent^.HWindow, um_NewValue, 0, 0);
      end;
end;


procedure TSpinEdit.EMReplaceSel (var Msg:TMessage);
begin
   TEdit.DefWndProc (Msg);
   SendMessage (Parent^.HWindow, um_NewValue, 0, 0);
end;

{ Inform spin button of edit control's range, current value,
  and ID. }
procedure TSpinEdit.SetSpinButton (var Msg:TMessage);
var
   SpinWnd: HWnd;
begin
   SpinWnd := GetDlgItem (Parent^.HWindow, SpinID);
   SendMessage (SpinWnd, SPNM_SETRANGE, 0, MakeLong(MinValue, MaxValue));
   SendMessage (SpinWnd, SPNM_SETCRNTVALUE, CurValue,0);
   SendMessage (SpinWnd, SPNM_SETEDITID, GetDlgCtrlID (HWindow),0);
end;

{ Adjust range of valid values, update Spin button as well }
procedure TSpinEdit.UMAdjustRange (var Msg: TMessage);
var
   SpinWnd: HWnd;
begin
   TNumEdit.UMAdjustRange (Msg);
   if (CurValue < MinValue) then
      CurValue := MinValue;
   if (CurValue > MaxValue) then
      CurValue := MaxValue;

   { update spin button and edit window }
   SpinWnd := GetDlgItem (Parent^.HWindow, SpinID);
   SendMessage (SpinWnd, SPNM_SETRANGE, 0, MakeLong(MinValue, MaxValue));
   SendMessage (SpinWnd, SPNM_SETCRNTVALUE, CurValue,0);
   SendMessage (SpinWnd, SPNM_NOTIFYPARENT, CurValue,0);
end;

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

{ Change the current value in the editor and update its
  spin control. }
procedure TSpinEdit.UMSetValue (var Msg:TMessage);
begin
   TNumEdit.UMSetValue(Msg);
   SendMessage (GetDlgItem (Parent^.HWindow, SpinID),
      SPNM_SETCRNTVALUE, Msg.wParam,0);
end;

{----------}


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

constructor TRangeEdit.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 TRangeEdit.InitResource(AParent: PWindowsObject;
  ResourceID: Word; Digits: Word; AMinValue, AMaxValue: Longint);
begin
  TEdit.InitResource(AParent, ResourceID, Digits + 1);
  MinValue     := AMinValue;
  MaxValue     := AMaxValue;
end;


{ Return true if s validly represents a range of numbers. }
function RangeOK (s:PChar; nMin, nMax:integer):Boolean;
type
   States = (stSTART, stNUMBER, stALL, stLETTER, stRANGE, stQUIT, stDONE);
var
   count:integer;
   i , Low, High, Code:integer;
   Token: array[0..10] of char;
   st:STATES;
   ch:char;

   function NextChar:char;
   begin
     NextChar := s[count];
     Inc (Count);
   end;

   function NonSpaceChar:char;
   begin
     while (s[count] = ' ') do Inc(Count);
     NonSpaceChar := s[count];
     Inc (Count);
   end;


begin
   count := 0;
   st    := stSTART;
   ch    := NextChar;
   while (st <> stQUIT) and (st <> stDONE) do begin
      case st of
         stSTART:
            case ch of
               ' ':    ch := NonSpaceChar;
               #0      : if (Count > 0) then
                            st := stDONE
                         else st :=stQUIT;
               '0'..'9': st := stNUMBER;
               'a'..'z',
               'A'..'Z': st := stALL;
               end;
         stALL:
             begin
                Token[0] := ch;
                Token[1] := #0;
                i := 1;
                ch := NextChar;
                while (ch in ['a'..'z','A'..'Z']) do begin
                   Token[i] := ch;
                   Inc (i);
                   Token[i] := #0;
                   ch := NextChar;
                   end;
                if (StrIComp (Token, 'all') = 0) then begin
                   st := stDONE;
                   end
                else st := stQUIT;
             end;
         stNUMBER:
            begin
               i := 1;
               Token[0] := ch;
               Token[1] := #0;
               ch := NextChar;
               while (ch in ['0'..'9']) do begin
                  Token[i] := ch;
                  Inc (i);
                  Token[i] := #0;
                  ch := NextChar;
                  end;
               Val (Token, Low, Code);
               if (Code <> 0) or (Low < nMin) then
                  st := stQUIT
               else
                  case ch of
                     '-' : begin ch := NonSpaceChar; st := stRANGE; end;
                     #0  : begin
                              st := stDONE;
                           end;
                     ' ' : begin
                              st := stSTART;
                           end;
                     else st := stQUIT;
                     end;
            end;
         stRANGE:
            begin
            case ch of
               '.' :
                  begin
                      High := nMax;
                      ch   := NextChar;
                   end;
                '0'..'9':
                   begin
                      Token[0] := ch;
                      Token[1] := #0;
                      i := 1;
                      ch := NextChar;
                      while (ch in ['0'..'9']) do begin
                         Token[i] := ch;
                         Inc (i);
                         Token[i] := #0;
                         ch := NextChar;
                         end;
                      Val (Token, High, Code);
                      if (Code <> 0) or (High < Low) or (High > nMax) then
                         st := stQUIT;
                   end;
                else st := stQUIT;
                end;

             if (st <> stQUIT) then
                st := stSTART;
            end;


         end; { case }
   end;
   RangeOK := (st = stDone);
end;


{ Check that range string is valid. }
function TRangeEdit.CanClose: Boolean;
var
  Text: array[0..255] of Char;
  Valid: Boolean;
begin
  GetText(Text, SizeOf(Text));
  Valid := RangeOK (Text, MinValue, MaxValue);
  if not Valid then begin
    BWCCMessageBox(HWindow, 'Invalid range', 'Data error',
      mb_Ok or mb_IconExclamation);
    SetSelection(0, MaxInt);
    SetFocus(HWindow);
    end;
  CanClose := Valid;
end;



begin
end.