spin2.pas

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

      SetWindowLong (HWindow, GWW_RANGE , lParam);
   SPNM_GETRANGE:
      SpinWinFn2 := GetWindowLong (HWindow, GWW_RANGE);
   SPNM_SETCRNTVALUE:
      { Set the current value }
      SetWindowWord(HWindow, GWW_CRNTVALUE, wParam);
   SPNM_NOTIFYPARENT:
      { Update the associated edit window }
        begin
           { Get the edit window's id }
           EditID := GetWindowWord(HWindow, GWW_EDITID);

           { get its handle }
           EditWnd := GetDlgItem (GetParent(HWindow), EditID);
           if (EditWnd <> 0) then begin
              { Get the editor line }
              SendMessage (EditWnd, em_GetLine, 0, longint(@buf));
              { Select the editor text }
              SendMessage (EditWnd, em_SetSel, 0, MakeLong(0,7));
              { Replace it with the new value }
              wvsprintf(buf,'%d',wParam);
              SendMessage (EditWnd, em_ReplaceSel,0,longint(@buf));
              { Select the editor text }
              SendMessage (EditWnd, em_SetSel, 0, MakeLong(0,9));
              { Set the focus to the edit window }
              SetFocus (EditWnd);
              end;
        end;
   SPNM_SETEDITID:
      { save the associated edit window's ID }
      SetWindowWord (HWindow, GWW_EDITID, wParam);
   SPNM_GETCRNTVALUE:
      SpinWinFn2 := GetWindowWord(HWindow, GWW_CRNTVALUE);
   SPNM_GETWRAP:
      SpinWinFn2 := (GetWindowLong(HWindow,GWL_STYLE) and SPNS_WRAP);
  else
    SpinWinFn2 := DefWindowProc(HWindow, Message, wParam, lParam);
  end;
end;


{ ==============================================================
  Custom contol interface routines.
  ============================================================== }

{ SpinInfo ---------------------------------------------------
   Return the information about the capabilities of the
   meter class.
  -------------------------------------------------------------- }
function SpinInfo: THandle; export;
var
  hInfo: THandle;
  Info: PRWCtlInfo;
begin
  hInfo := GlobalAlloc(gmem_Share or gmem_ZeroInit,
    SizeOf(TRWCtlInfo));
  if hInfo <> 0 then
  begin
    Info := GlobalLock(hInfo);
    with Info^ do
    begin
      wVersion := $100;         { Version 1.00 }
      wCtlTypes := 1;           { 1 type }
      StrCopy(szClass, 'Spin2');
      StrCopy(szTitle, 'Spin2');

      with ctType[0] do
      begin
	wWidth  := 17 and not  $8000;
	wHeight := 25 and not $8000;
	StrCopy(szDescr, 'Spin2');
	dwStyle := ws_Border or ws_Child;
	hToolBit := LoadBitmap(HInstance, MakeIntResource(btSpinBits));
	hDropCurs := LoadCursor(HInstance, MakeIntResource(crSpinCurs));
      end;

    end;
    GlobalUnlock(hInfo);
  end;
  SpinInfo := hInfo;
end;

type
  PParamRec = ^TParamRec;
  TParamRec = record
    CtlStyle: THandle;
    IdToStr: TIdToStr;
    StrToId: TStrToId;
  end;

{ SpinStyleDlg -----------------------------------------------
    Style dialog's dialog hook.  Used by the dialog and called
    when the control is double-clicked inside the dialog
    editor.
  -------------------------------------------------------------- }
function SpinStyleDlg(HWindow: HWnd; Message: Word; wParam: Word;
  lParam: Longint): Longint; export;
const
  Prop = 'Prop';
var
  hRec: THandle;
  Rec: PParamRec;
  Style: PCtlStyle;
  S: array[0..256] of Char;
  Radio: Integer;
begin
  case Message of
    wm_InitDialog:
      begin
	hRec := LoWord(lParam);
	Rec := GlobalLock(hRec);
	Style := GlobalLock(Rec^.CtlStyle);
	SetProp(HWindow, Prop, hRec);
	with Rec^, Style^ do
	begin
	  { Set control id }
	  IdToStr(wId, S, SizeOf(S));
	  SetDlgItemText(HWindow, idControlId, S);

	  { Initialize wrap Stop check box }
	  CheckDlgButton(HWindow, idWrapID,
	    Integer(dwStyle and SPNS_WRAP <> 0));
        end;
	GlobalUnlock(Rec^.CtlStyle);
	GlobalUnlock(hRec);
      end;
    wm_Command:
      case wParam of
	idCancel:
	  EndDialog(HWindow, 0);
	idOk:
	  begin
	    hRec := GetProp(HWindow, Prop);
	    Rec := GlobalLock(hRec);
	    Style := GlobalLock(Rec^.CtlStyle);
	    with Rec^, Style^ do
	    begin
	      { Get control id }
	      GetDlgItemText(HWindow, idControlId, S, SizeOf(S));
	      wId := StrToId(S);

              dwStyle := dwStyle and $FFFF0000;

	      { Do we wrap? }
	      if IsDlgButtonChecked(HWindow, idWrapID) <> 0 then
		dwStyle := dwStyle or SPNS_WRAP;

	    end;
	    GlobalUnlock(Rec^.CtlStyle);
	    GlobalUnlock(hRec);
	    EndDialog(HWindow, 1);
	  end;
      else
	SpinStyleDlg := 0;
      end;
    wm_Destroy:
      RemoveProp(HWindow, Prop);
  else
    SpinStyleDlg := 0;
  end;
end;

{ SpinStyle --------------------------------------------------
    The function will bring up a dialog box to modify the style
    of the button.  Called when the button is double-clicked in
    the dialog editor.
  -------------------------------------------------------------- }
function SpinStyle(hWindow: HWnd; CtlStyle: THandle;
  StrToId: TStrToId; IdToStr: TIdToStr): Bool; export;
var
  hRec: THandle;
  Rec: PParamRec;
  hFocus: HWnd;
begin
  SpinStyle := False;
  hRec := GlobalAlloc(gmem_Share, SizeOf(TParamRec));
  if hRec <> 0 then
  begin
    Rec := GlobalLock(hRec);
    Rec^.IdToStr := IdToStr;
    Rec^.StrToId := StrToId;
    Rec^.CtlStyle := CtlStyle;
    GlobalUnlock(hRec);

    hFocus := GetFocus;
    SpinStyle := Bool(DialogBoxParam(HInstance,
      MakeIntResource(idSpinDlg), HWindow, @SpinStyleDlg,
      hRec));
    if hFocus <> 0 then SetFocus(hFocus);
    GlobalFree(hRec);
  end;
end;

{ SpinFlags --------------------------------------------------
    Called to decompose the style double word into the .RC
    script expression that it represents.  This only needs to
    decompose the style bits added to the style double word,
    it need not decompose the, for example, the ws_XXX bits.
    The expression returned must be a valid .RC expression
    (i.e. C syntax, case sensitive).
  -------------------------------------------------------------- }
function SpinFlags(Style: LongInt; Buff: PChar;
  BuffLength: Word): Word; export;
var
   x:word;
begin
   Buff[0] := #0;
   if (Style and SPNS_WRAP) = SPNS_WRAP then
      StrCat (Buff, 'SPNS_WRAP | ');
   x := StrLen (Buff);
   if (x > 0) then begin
      x := x - StrLen(' | ');
      Buff[x] := #0;
      end;
   SpinFlags := x;
end;

{ ListClasses --------------------------------------------------
    Called by Resource Workshop retrieve the information
    necessary to edit the custom controls contain in this DLL.
    This is an alternative to the Microsoft xxxStyle convention.
  -------------------------------------------------------------- }
function ListClasses(szAppName: PChar; wVersion: Word;
  fnLoad: TLoad; fnEdit: TEdit): THandle; export;
var
  hClasses: THandle;
  Classes: PCtlClassList;
begin
  hClasses := GlobalAlloc(gmem_Share or gmem_ZeroInit,
    SizeOf(Integer) + SizeOf(TRWCtlClass));
  if hClasses <> 0 then
  begin
    Classes := GlobalLock(hClasses);
    with Classes^ do
    begin
      nClasses := 1;
      with Classes[0] do
      begin
	fnInfo  := SpinInfo;
	fnStyle := SpinStyle;
	fnFlags := SpinFlags;
      end;
    end;
    GlobalUnlock(hClasses);
  end;
  ListClasses := hClasses;
end;

exports
  ListClasses,
  SpinWinFn2;

var
  Class: TWndClass;

begin
  with Class do
  begin
    lpszClassName := 'Spin2';
    hCursor       := LoadCursor(0, idc_Arrow);
    lpszMenuName  := nil;
    style         := cs_HRedraw or cs_VRedraw or cs_GlobalClass;
    lpfnWndProc   := TFarProc(@SpinWinFn2);
    hInstance     := System.hInstance;
    hIcon         := 0;
    cbWndExtra    := ofSize;
    cbClsExtra    := 0;
    hbrBackground := Color_BtnFace + 1;
  end;
  RegisterClass(Class);
end.