(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTDBSpinEdit;

interface
{$I AHM.INC}
uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls,DBCtrls,DB,AHMTSpinEdit,AHMStdClass;

type
  TAHMDBCustomSpinEdit = class(TDBEdit)
  private
    FAboutStr : TAHMAboutSControlStr;
    FMinValue,FMaxValue,FLineSize,FMultipleLineSize:LongInt;
    FCutandPaste:Boolean;
    FButton:Pointer;
    FButtonWin: TWinControl;
    procedure SetEditRect;
    procedure SetInteger(Index:Integer; aValue:LongInt);
    procedure SetValue(aValue:LongInt);
    function GetMinHeight: Integer;
    function GetValue: LongInt;
    function CheckValue(aValue:LongInt):LongInt;
    procedure SetBColor(value : TColor);
    Function GetBColor : TColor;
    procedure SetAColor(value : TColor);
    Function GetAColor : TColor;
    procedure CMEnabledChanged(var Msg:TMessage); message CM_EnabledChanged;
    procedure CMEnter(var Message: TCMGOTFOCUS);message CM_ENTER;
    procedure CMExit(var Message: TCMExit);message CM_EXIT;
    procedure WMCut(var Message: TWMCut);message WM_CUT;
    procedure WMPaste(var Message: TWMPaste);message WM_PASTE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure AdjustSize;{$IFDEF AHMINPRISE4} override; {$ENDIF}
    procedure DownClick (Sender: TObject); virtual;
    function IsValidChar(Key: Char): Boolean; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure UpClick (Sender: TObject); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Button: Pointer read FButton;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property AutoSelect;
    property AutoSize;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property ArrowColor : TColor read GetAColor write SetAColor default clBlack;
    property ButtonColor : TColor read GetBColor write SetBColor default clBtnFace;
    property CutandPaste: Boolean read FCutandPaste write FCutandPaste default True;
    property Enabled;
    property Font;
    {$IFDEF AHMINPRISE3}
    property ImeMode;
    property ImeName;
    {$ENDIF}
    property LineSize:LongInt index 2 read FLineSize write SetInteger default 1;
    property MaxLength;
    property MaxValue:LongInt index 0 read FMaxValue write SetInteger default 100;
    property MinValue:LongInt index 1 read FMinValue write SetInteger default 0;
    property MultipleLineSize:LongInt index 3 read FMultipleLineSize write SetInteger default 10;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Value:LongInt read GetValue write SetValue default 0;
    property Visible;
    property DataField;
    Property DataSource;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;
  TAHMDBSpinEdit = class(TAHMDBCustomSpinEdit)
  private
  protected
  public
  published
  end;

implementation

uses Forms;

procedure TAHMDBCustomSpinEdit.SetEditRect;
var r: TRect;
begin
  r:=Rect(0,0, ClientWidth-TAHMCustomSpinButton(FButton).Width-2, ClientHeight+1);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@r));
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@r));
end;

procedure TAHMDBCustomSpinEdit.SetInteger(Index:Integer; aValue:LongInt);
begin
  case Index of
    0: if (aValue<>FMaxValue) and (aValue>FMinValue) then
       begin
         FMaxValue:=aValue;
         if Value>FMaxValue then Value:=FMaxValue;
       end;
    1: if (aValue<>FMinValue) and (aValue<FMaxValue) then
       begin
         FMinValue:=aValue;
         if Value<FMinValue then Value:=FMinValue;
       end;
    2: FLineSize:=aValue;
    3: FMultipleLineSize:=aValue;
  end;
end;

procedure TAHMDBCustomSpinEdit.SetValue(aValue:LongInt);
begin
  Text:=IntToStr(CheckValue(aValue));
end;

function TAHMDBCustomSpinEdit.GetMinHeight: Integer;
var DC: HDC;
    SaveFont: HFont;
    h: Integer;
    SysMetrics, Metrics: TTextMetric;
begin
  DC:=GetDC(0);
  try
    GetTextMetrics(DC, SysMetrics);
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
  finally
    ReleaseDC(0, DC);
  end;
  h:=SysMetrics.tmHeight;
  if h>Metrics.tmHeight then h:=Metrics.tmHeight;
  Result:=Metrics.tmHeight+ h div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
end;

function TAHMDBCustomSpinEdit.GetValue:LongInt;
begin
  if (Text='') then Text:=IntToStr(MinValue);
  try
    Result:=StrToInt(Text);
  except
    Result:=FMinValue;
  end;
end;

procedure TAHMDBCustomSpinEdit.AdjustSize;
var MinHeight: Integer;
begin
  MinHeight:=GetMinHeight;
  if Height<MinHeight then Height:=MinHeight else
  begin
    if NewStyleControls and CTL3D then FButtonWin.SetBounds(Width-Height,0,Height-4,Height-4)
                                  else FButtonWin.SetBounds(Width - Height, 0, Height, Height);
    TAHMCustomSpinButton(FButton).SetBounds(0, 0, FButtonWin.Height, FButtonWin.Height);
    SetEditRect;
  end;
end;

function TAHMDBCustomSpinEdit.CheckValue(aValue:LongInt): LongInt;
begin
  Result:=aValue;
  if (FMaxValue<>FMinValue) then
  begin
    if aValue<FMinValue then Result:=FMinValue;
    if aValue>FMaxValue then Result:=FMaxValue;
  end;
end;

procedure TAHMDBCustomSpinEdit.CMEnabledChanged(var Msg:TMessage);
begin
  inherited;
  TAHMCustomSpinButton(FButton).Enabled:=Enabled;
end;

procedure TAHMDBCustomSpinEdit.CMEnter(var Message: TCMGotFocus);
begin
  if AutoSelect and not(csLButtonDown in ControlState) then SelectAll;
  inherited;
end;

procedure TAHMDBCustomSpinEdit.CMExit(var Message: TCMExit);
begin
  inherited;
  if CheckValue(Value)<>Value then SetValue(Value);
end;

procedure TAHMDBCustomSpinEdit.WMCut(var Message: TWMPaste);
begin
  if not FCutandPaste or Readonly then Exit;
  inherited;
end;

procedure TAHMDBCustomSpinEdit.WMPaste(var Message: TWMPaste);
begin
  if not FCutandPaste or Readonly then Exit;
  inherited;
end;

procedure TAHMDBCustomSpinEdit.WMSize(var Message: TWMSize);
begin
  inherited;
  AdjustSize;
end;


procedure TAHMDBCustomSpinEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

procedure TAHMDBCustomSpinEdit.CreateWnd;
begin
  inherited CreateWnd;
  AdjustSize;
  SetEditRect;
end;

procedure TAHMDBCustomSpinEdit.DownClick(Sender: TObject);
begin
  if (assigned(Datasource)) and ((Datasource.state=dsEdit) or (Datasource.state=dsInsert)) and not(Readonly)
                            then Value:=Value-FLineSize else MessageBeep(0);
end;

function TAHMDBCustomSpinEdit.IsValidChar(Key: Char): Boolean;
var ValidChar: set of Char;
begin
  ValidChar:=['+','-','0'..'9'];
  result:=(Key in ValidChar) or (Key < #32);
  if not FCutandPaste and Result and ((Key>=#32) or (Key=Char(VK_BACK)) or (Key=Char(VK_DELETE))) then
  result:=false;
end;

procedure TAHMDBCustomSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case key of
    VK_UP:   UpClick (Self);
    VK_DOWN: DownClick (Self);
    VK_PRIOR:if not Readonly then value:=Value+FMultipleLineSize;
    VK_NEXT: if not Readonly then Value:=Value-FMultipleLineSize;
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TAHMDBCustomSpinEdit.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then
  begin
    Key:=#0;
    MessageBeep(0)
  end;
  if Key<>#0 then
  begin
    inherited KeyPress(Key);
    if (Key=Char(VK_RETURN)) or (Key=Char(VK_ESCAPE)) then
    begin
      GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
      if Key=Char(VK_RETURN) then Key := #0;
    end;
  end;
end;

procedure TAHMDBCustomSpinEdit.UpClick(Sender: TObject);
begin
  if (assigned(Datasource)) and ((Datasource.state=dsEdit) or (Datasource.state=dsInsert))
                            and not(Readonly) then Value:=Value+FLineSize else Messagebeep(0);
end;

constructor TAHMDBCustomSpinEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption];
  FButtonWin:=TWinControl.Create(Self);
  FButtonWin.Visible := True;
  FButtonWin.Parent := Self;
  FButtonWin.SetBounds(0, 0, Height, Height);
  FButton:=TAHMCustomSpinButton.Create(Self);
  with TAHMCustomSpinButton(FButton) do
  begin
    Parent:=FButtonWin;
    OnTopClick:=UpClick;
    OnBottomClick:=DownClick;
    SetBounds(0, 0, FButtonWin.Width, FButtonWin.Height);
  end;
  Text := '0';
  FLineSize := 1;
  FMultipleLineSize:=10;
  FMinValue:=0;
  FMaxValue:=100;
  FCutandPaste := True;
end;

destructor TAHMDBCustomSpinEdit.Destroy;
begin
  TAHMCustomSpinButton(FButton).Parent:=nil;
  TAHMCustomSpinButton(FButton).Free;
//  FButtonWin.Free;
  inherited Destroy;
end;

Function TAHMDBCustomSpinEdit.GetBColor : TColor;
begin
  result:=TAHMCustomSpinButton(FButton).Color;
end;

procedure TAHMDBCustomSpinEdit.SetBColor(value : TColor);
begin
  TAHMCustomSpinButton(FButton).Color:=value;
end;

Function TAHMDBCustomSpinEdit.GetAColor : TColor;
begin
  result:=TAHMCustomSpinButton(FButton).ArrowColor;
end;

procedure TAHMDBCustomSpinEdit.SetAColor(value : TColor);
begin
  TAHMCustomSpinButton(FButton).ArrowColor:=value;
end;

end.
