Если кому интересно, привожу простенький SpinEdit (по мотивам KOL UpDown). Максимальные значения практически не ограничены. Возможна масса доработок. Жду замечаний...
unit NSpinEdit;
interface
uses Windows, KOL, Messages;
type
NM_UPDOWN = packed record
hdr: TNMHDR;
iPos: Integer;
iDelta: Integer;
end;
TNMUpDown = NM_UPDOWN;
PNMUpDown = ^TNMUpDown;
PSpinEdit = ^TNSpinEdit;
// TKOLUpDown = PSpinEdit;
TNSpinEdit = object(TObj)
private
FValue: Variant;
protected
procedure SetValue(const aValue: Variant);
public
UpHandle: THandle;
Maximum,
Minimum,
Increment: Variant;
UpDown,
Edit: PControl;
destructor Destroy; virtual;
property Value: Variant read FValue write SetValue;
end;
function NewUpDown(AOwner: PControl; aValue, aMin, aMax, aInc: Variant): PSpinEdit;
function NewUpDownDef(AOwner: PControl; aValue: Variant): PSpinEdit;
function UpDownWndProc(Sender: PControl; var Msg:TMsg; var Rslt:Integer):Boolean;
function SpinEditWndProc(Sender: PControl; var Msg:TMsg;var Rslt:Integer):Boolean;
implementation
const
UPDOWN_CLASS = 'msctls_updown32';
UDS_ALIGNRIGHT = $0004;
UDN_FIRST = 0-721;
UDN_DELTAPOS = UDN_FIRST - 1;
function NewUpDownDef(AOwner: PControl; aValue: Variant): PSpinEdit;
begin
Result:= NewUpDown(AOwner, aValue, 0, 1000000, 100);
end;
function NewUpDown(AOwner: PControl; aValue, aMin, aMax, aInc: Variant): PSpinEdit;
var Flags: Integer;
begin
New(Result, Create);
AOwner.Add2AutoFree(Result);
Result.Edit:= NewEditBox(AOwner,[]);
Result.Edit.Color:= clWindow;
Flags:= UDS_ALIGNRIGHT;
Result.UpDown:= _NewCommonControl(Result.Edit, UPDOWN_CLASS,
WS_VISIBLE or WS_CHILD or Flags, False,nil);
Result.UpDown.ExStyle := WS_EX_CLIENTEDGE;
Result.UpDown.TabStop:= False;
Result.UpDown.HasBorder:= False;
Result.UpHandle:= Result.UpDown.GetWindowHandle;
Result.UpDown.Tag:= LongInt(Result);
Result.Minimum:= aMin;
Result.Value:= aValue;
Result.Maximum:= aMax;
Result.Increment:= aInc;
Result.UpDown.AttachProc(UpDownWndProc);
Result.Edit.AttachProc(SpinEditWndProc);
end;
function UpDownWndProc(Sender: PControl; var Msg:TMsg; var Rslt:Integer):Boolean;
var NMUpDown: PNMUpDown; UpDownNow: PSpinEdit; Tmp: Variant;
begin
Result:= False;
if Msg.message = WM_NOTIFY then begin
NMUpDown:= PNMUpDown(Msg.lParam);
if NMUpDown.hdr.code = UDN_DELTAPOS then begin
UpDownNow:= PSpinEdit(Sender.Tag);
if not Assigned(UpDownNow) then Exit;
with UpDownNow^ do begin
if (NMUpDown.iDelta = -1) then Tmp:= FValue - Increment
else if (NMUpDown.iDelta = 1) then Tmp:= FValue + Increment;
if Tmp >= Maximum then Tmp:= Maximum;
if Tmp <= Minimum then Tmp:= Minimum;
Value:= Tmp;
end;
end;
end;
end;
function SpinEditWndProc(Sender: PControl; var Msg:TMsg;var Rslt:Integer):Boolean;
var UPD: PControl; H, W: Integer;
begin
Result:= False;
with Sender^ do
if Msg.message = WM_PAINT then begin
UPD:= Children
[0];
H:= ClientHeight;
W:= H;
UPD.SetSize(W, H).SetPosition(Width - W - 4, 1);
end else if (Msg.message = WM_KEYUP) and (Length(Text) > 0) then
PSpinEdit(Children
[0].Tag).Value:= Variant(Text);
end;
destructor TNSpinEdit.Destroy;
begin
FValue:= Unassigned;
Free_And_Nil(UpDown);//.Free;
Free_And_Nil(Edit);
inherited Destroy;
end;
procedure TNSpinEdit.SetValue(const aValue: Variant);
begin
FValue:= aValue;
Edit.Text:= VarTostr(FValue);
end;
initialization
DoInitCommonControls(ICC_UPDOWN_CLASS);
finalization