spin2.pas

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

{*

  29 Nov 1991 Sketched out
   2 Dec 1991 Major debugging session to get working!
   6 Oct 1992 Now has 3D push down button effect

  A custom spin button based on C code in J. M. Richter's
  book Windows 3:A developer's guide.

  Somewhat modified.

  To use in an application

  1. use the Resource workshop to
     create the dialog. The spin button
     is a custom tool. Pace and editor next to the button.

  2. In the application
     (a) The range and current value for the spin button are specified
         by the values passed to the associated edit window
         by that window's InitResource method. The edit
         window must be a TSpinEdit window.

     (b) To set up the spin button, send the um_SetSpin message
         (defined in CPWCONTL) to the edit window from the
         dialog boxes SetUpWindow method.

     (c) because of a bug in the Transfer method of TNumEdit,
         the transfer method only works using strings as in
         TEdit.

     (d) Load the DLL as for METER.PAS

  Hence, the code looks something like this

  In the dialog
  -------------

  procedure MyDialog.SetUpWindow;
  begin
    .
    .
   SendMessage (GetDlgItem(HWindow, 101),   [ to the edit window ]
                um_SetSpin,                 [ um_SetSpin message ]
                GetDlgItem (HWindow, 102),  [ handle to spin button ]
                0);                         [ lParam not used ]
    .
    .
  end;

  In the main window
  ------------------

  procedure Something;
  var
     TheDialog;
     P: PSpinEdit;
  begin
     TheDialog := new(PTestDialog, Init (@Self, 'DIALOG_1'));
     E := new(PSpinEdit, InitResource (TheDialog,
                                       101,       [ edit id ]
                                       3,         [ textlen ]
                                       1,         [ min ]
                                       20,        [ max ]
                                       3,         [ current value ]
                                       102));     [ spin id ]
     Application^.ExecDialog (TheDialog);

     [ Any transfer requires PChar variables as for TEdit ]

  end;

  In the application
  ------------------

  constructor App.Init;

   Lib := LoadLibrary(DLLName);
   if Lib < 32 then Status := em_DLLNotFound;
   TApplication.Init(AName);


  Messages (defined in SpinCo)
  --------

  Msg
                                     Returns    wParam   lParam
   SPNM_SETRANGE      Set range         -         -      (Min,Max)
   SPNM_GETRANGE      Get range      (Min,Max)*   -         -
   SPNM_SETCRNTVALUE                    -        value      -
   SPNM_GETCRNTVALUE                   value      -         -
  ^SPNM_NOTIFYPARENT                    -        value      -
   SPNM_GETWRAP                       0=no wrap   -         -
   SPNM_SETEDITID     Assoc. edit ID    -        Edit ID    -

   * Signifies the lo and hi words of a longint variable.
   ^ Internal use only.
*}


library Spin2;

uses
   WinTypes,
   WinProcs,
   Strings,
   CustCntl,  { custom controls }
   SpinCo;    { meter constants }

{$R SPIN.RES} { spin style dialog resource }

const
   ofSize           = 10{8}{6};  { Amount of window extra bytes to use }
   GWW_RANGE        = 0;
   GWW_CRNTVALUE    = 4{2};
   GWW_TRIANGLEDOWN = 6{4};

   GWW_EDITID       = 8;

   SPNM_SCROLLVALUE = wm_User + 500;

   TIME_DELAY = 150;

   TD_NONE:word = 0;
   TD_UP:word   = 1;
   TD_DOWN:word = 2;

function SpinWinFn2(HWindow: HWnd; Message: Word; wParam: Word;
  lParam: Longint): Longint; export;
var
  DC             : HDC;
  Result         : word;
  PS             : TPaintStruct;
  pt             : TPoint;
  rc             : TRect;
  nCrntVal,
  nNewVal,
  x,y : integer;
  TriangleDown,
  OldTriangleDown : word;
  dwTime, dwRange :longint;
  fWrap : Bool;

  EditID : integer;
  EditWnd : THandle;
  buf : array[0..9] of char;
  newpen, oldpen : HPen;

      MemDC     : HDC;
      Bits,
      Oldbitmap : HBitmap;


begin
  SpinWinFn2 := 0;
  case Message of
    wm_GetDlgCode:
       SpinWinFn2 := dlgc_Static;
    wm_Create:
      begin
         SendMessage (HWindow, SPNM_SETRANGE, 0, MakeLong(0,0));
         SendMessage (HWindow, SPNM_SETCRNTVALUE, 0,0);
      end;
    wm_Paint:
      begin
         BeginPaint (HWindow, PS);
         Bits := LoadBitmap (HInstance, 'SPIN_BUTTON');

         { Draw bitmap }
         MemDC := CreateCompatibleDC(PS.hDC);
         OldBitmap := SelectObject(MemDC, Bits);

         BitBlt(PS.hDC, 0, 0, 17, 25,
            MemDC, 0, 0, srcCopy);
         Bits := SelectObject(MemDC, OldBitmap);
         DeleteObject (Bits);
         DeleteDC(MemDC);
         EndPaint (HWindow, PS);
      end;
   wm_LButtonDown:
      begin
         GetClientRect (HWindow, rc);
         if (HiWord(lParam) < rc.bottom div 2) then begin
            TriangleDown := TD_UP;
            rc.bottom := rc.bottom div 2;
            end
         else begin
            TriangleDown := TD_DOWN;
            rc.top := rc.bottom div 2;
            end;
         Inc(rc.left);
         Dec(rc.right);
         Inc (rc.top);
         Dec(rc.bottom);


         { Save the triangle mouse was clicked over }
         SetWindowWord (HWindow, GWW_TRIANGLEDOWN, TriangleDown);

         { invert the top or bottom half of the window
           where the mouse was clicked }
         DC := GetDC (HWindow);
         InvertRect (DC, rc);
         ReleaseDC (HWindow, DC);

         SetCapture (HWIndow);

         { Subtract time delay so that action is performed at
           least once }
         dwTime := GetTickCount - TIME_DELAY;

         repeat
            { time delay hasn't passed yet, test
              loop condition }
            if (dwTime + TIME_DELAY <= GetTickCount) then begin
               { time delay has passed; scroll value in spin button }
               SendMessage (HWindow, SPNM_SCROLLVALUE,0,0);
               { get time last scroll occurred }
               dwTime := GetTickCount;
               end;
         { test if left mouse button is still down }
         until ((GetAsyncKeyState (vk_LButton) and $8000) <> $8000);

         ReleaseCapture;

         { invalidate window }
         InvalidateRect (HWindow, NIL, True);
      end;
   SPNM_SCROLLVALUE:
      begin
         { get mouse location }
         GetCursorPos (pt);
         { convert point from screen to client coordiantes }
         ScreenToClient(HWIndow,pt);
         { if the point is not in spin's client area, nothing to do }
         GetClientRect(HWindow, rc);
         if PtInRect (rc,pt) then begin
            nNewVal  := SendMessage (HWindow, SPNM_GETCRNTVALUE,0,0);
            nCrntVal := nNewVal;
            dwRange  := SendMessage (HWindow, SPNM_GETRANGE,0,0);
            fWrap    := Bool(GetWindowLong(HWindow,GWL_STYLE) and SPNS_WRAP);
            OldTriangleDown := GetWindowWord (HWindow, GWW_TRIANGLEDOWN);
            if (pt.y < rc.bottom div 2) then
               TriangleDown := TD_UP
            else TriangleDown := TD_DOWN;
            if OldTriangleDown <> TriangleDown then begin
               DC := GetDC (HWindow);
               InvertRect (DC, rc);
               ReleaseDC (HWindow, DC);
               end;
            if TriangleDown=TD_UP then begin
               { if value isn't at top of range, increment it }
               if HiWord(dwRange) > nCrntVal then
                 Inc (nNewVal)
               else
                  { if wrap then set to bottom of range }
                  if fWrap then
                     nNewVal := LoWord (dwRange);
               end
            else begin
               { if value isn't at bottom then decrement it }
               if LoWord(dwRange) < nCrntVal then
                 Dec (nNewVal)
               else
                  { if wrap then set to topof range }
                  if fWrap then
                     nNewVal := HiWord (dwRange);
               end;
            if nNewVal <> nCrntVal then begin
               SendMessage (HWindow, SPNM_SETCRNTVALUE,nNewVal,0);
               SendMessage (HWindow, SPNM_NOTIFYPARENT,nNewVal,0);
               end;

            SetWindowWord(HWindow, GWW_TRIANGLEDOWN, TriangleDown);
            end;
      end;

   SPNM_SETRANGE: