unit dpbNameCard;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, db, dbTables, ExtCtrls;

type
  TdpbNameCard = Class;

  { µ¥ÀÌÅÍ ¸µÅ© Ŭ·¡½º ¼±¾ð }
  TdpbNameCardDataLink = Class(TDataLink)
  private
    FCard: TdpbNameCard;
  protected
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance : Integer); override;
    procedure ActiveChanged; override;
  public
    constructor Create(ACard: TdpbNameCard);
    destructor Destroy; override;
  End;

  TdpbNameCard = class(TCustomControl)
  private
    { Private declarations }
    FBorderStyle : TBorderStyle;
    FDataLink : TdpbNameCardDataLink;
    FStartRecord : Integer;
    FViewConfiguration : TStrings;
    FColCount : Integer;
    FRowCount : Integer;
    FNameFont : TFont;
    FNameColor : TColor;
    FCardWidth : Integer;
    FCardHeight : Integer;
    FCardColor : TColor;
    FCardBorderColor : TColor;

    procedure SetBorderStyle(Value : TBorderStyle);
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    procedure SetViewConfiguration(Value : TStrings);
    procedure Changed(Sender : TObject);
    procedure SetCardWidth(Value : Integer);
    procedure SetCardHeight(Value : Integer);
    procedure SetNameFont(Value : TFont);
    procedure SetCardColor(Value : TColor);
    procedure SetCardBorderColor(Value : TColor);
    procedure SetNameColor(Value : TColor);
    procedure SetVertScrollRange(Const AMin, AMax : Integer);
    procedure SetVertScrollPos(Const APos : Integer);
    procedure AdjustColRow;
    procedure DoVScroll(ScrollCode : TScrollCode);

    procedure DataChanged;
    procedure ActiveChanged;
  protected
    { Protected declarations }
    procedure CreateWnd; override;
    procedure CreateParams(var Params: TCreateParams); Override;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
              X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    procedure UpdateVertScrollBar;
    function  GetCellRect(const ACol, ARow : Integer) : TRect;
    function  VisibleRows : Integer;
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    procedure Paint; override;
    procedure Loaded; override;
  published
    { Published declarations }
    Property Align;
    Property BorderStyle : TBorderStyle
             Read FBorderStyle
             Write SetBorderStyle
             Default bsSingle;

    property CardBorderColor : TColor
             read FCardBorderColor
             write SetCardBorderColor
             default clBtnFace;
    property CardColor : TColor
             read FCardColor
             write SetCardColor
             default clWindow;

    property CardHeight : Integer
             read FCardHeight
             write SetCardHeight
             default 90;

    property CardWidth : Integer
             read FCardWidth
             write SetCardWidth
             default 60;

    Property Color;
    property Constraints;
    Property Ctl3D;

    property DataSource: TDataSource
             read GetDataSource
             write SetDataSource;

    Property Font;
    property Hint;

    property NameColor : TColor
             read FNameColor
             write SetNameColor
             default clBtnFace;

    property NameFont : TFont
             read FNameFont
             write SetNameFont;

    Property ParentColor;
    property ParentCtl3D;
    Property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property ViewConfiguration : TStrings
             read FViewConfiguration
             write SetViewConfiguration;

    property OnClick;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DPB', [TdpbNameCard]);
end;

function GetWord(AValue : string; AIndex : Integer; ADelimiter : char) : string;
var
  nIndex, DelNum : integer;
begin
  Result := '';
  DelNum := 1;
  for nIndex := 1 to Length(AValue) do
  begin
    if AValue[nIndex] = ADelimiter then
      Inc(DelNum)
    else
    begin
      if DelNum = AIndex then
        Result := Result + AValue[nIndex];
    end;
  end;
  Result := Trim(Result);
end;

function Min( A, B : Integer ) : Integer;
begin
  if A < B then
    Result := A
  else
    Result := B;
end;

{ TdpbNameCardDataLink }

constructor TdpbNameCardDataLink.Create(ACard: TdpbNameCard);
begin
  inherited Create;
  FCard := ACard;
end;

destructor TdpbNameCardDataLink.Destroy;
begin
  FCard := nil;
  inherited Destroy;
end;

procedure TdpbNameCardDataLink.ActiveChanged;
begin
  if FCard <> nil then FCard.ActiveChanged;
end;

procedure TdpbNameCardDataLink.DataSetChanged;
begin
  if FCard <> nil then FCard.DataChanged;
end;

procedure TdpbNameCardDataLink.DataSetScrolled(Distance : Integer);
begin
  if FCard <> nil then FCard.DataChanged;
end;

{ TdpbNameCard }


procedure TdpbNameCard.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    { BorderStyleÀº WindowÀÇ Style·Î ¼³Á¤µÇ±â ¶§¹®¿¡ BorderStyleÀÌ º¯°æµÇ¸é
      À©µµ¸¦ ´Ù½Ã »ý¼ºÇϱâ À§ÇØ RecreateWnd ¸¦ È£ÃâÇÑ´Ù. }
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

function TdpbNameCard.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TdpbNameCard.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
  if not (csLoading in ComponentState) then ActiveChanged;
end;

procedure TdpbNameCard.SetViewConfiguration(Value: TStrings);
begin
  FViewConfiguration.Assign(Value);
  Invalidate;
end;

procedure TdpbNameCard.SetCardWidth(Value: Integer);
begin
  if FCardWidth <> Value then
  begin
    FCardWidth := Value;
    AdjustColRow;
  end;
end;

procedure TdpbNameCard.SetCardHeight(Value: Integer);
begin
  if FCardHeight <> Value then
  begin
    FCardHeight := Value;
    AdjustColRow;
  end;
end;

procedure TdpbNameCard.SetNameFont(Value: TFont);
begin
  FNameFont.Assign(Value);
  Invalidate;
end;

procedure TdpbNameCard.SetCardBorderColor(Value: TColor);
begin
  if FCardBorderColor <> Value then
  begin
    FCardBorderColor := Value;
    Invalidate;
  end;
end;

procedure TdpbNameCard.SetCardColor(Value: TColor);
begin
  if FCardColor <> Value then
  begin
    FCardColor := Value;
    Invalidate;
  end;
end;

procedure TdpbNameCard.SetNameColor(Value: TColor);
begin
  if FNameColor <> Value then
  begin
    FNameColor := Value;
    Invalidate;
  end;
end;

procedure TdpbNameCard.ActiveChanged;
begin
  if HandleAllocated then
  begin
    UpdateVertScrollBar;
    Invalidate;
  end;
end;

procedure TdpbNameCard.DataChanged;
begin
  if HandleAllocated then
  begin
    UpdateVertScrollBar;
    Invalidate;
  end;
end;

procedure TdpbNameCard.CMCtl3DChanged(var Message: TMessage);
begin
  If FBorderStyle = bsSingle Then
    RecreateWnd;
  Inherited;
end;

constructor TdpbNameCard.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { ĸ¼ÇÀ» ÀÚµ¿À¸·Î ¼³Á¤ÇÒ ÇÊ¿ä°¡ ¾øÀ¸´Ï±î csSetCaption Ç÷¡±×¸¦ Áö¿î´Ù. }
  ControlStyle := ControlStyle - [csSetCaption];
  Width := 200;
  Height := 150;
  ParentColor := False;
  Color := clWindow;

  FBorderStyle := bsSingle;
  FCardWidth := 90;
  FCardHeight := 60;
  FCardColor := clWindow;
  FCardBorderColor := clBtnFace;
  FNameColor := clBtnFace;
  FStartRecord := 0;


  { µ¥ÀÌÅÍ ¸µÅ©¸¦ »ý¼ºÇÑ´Ù. }
  FDataLink := TdpbNameCardDataLink.Create(Self);

  FViewConfiguration := TStringList.Create;
  TStringList(FViewConfiguration).OnChange := Changed;

  FNameFont := TFont.Create;
  FNameFont.OnChange := Changed;
end;

procedure TdpbNameCard.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    { ¼öÁ÷ ½ºÅ©·Ñ ¹Ù¸¦ Ãß°¡ÇÑ´Ù. }
    Style := Style or WS_VSCROLL;
    if FBorderStyle = bsSingle then
    begin
      { ÄÞÆ÷³ÍÆ®ÀÇ ¿Ü°û¼±À» °áÁ¤ÇÑ´Ù. }
      if Ctl3D then
        ExStyle := ExStyle or WS_EX_CLIENTEDGE
      else
        Style := Style or WS_BORDER;
    end;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  End;
end;

destructor TdpbNameCard.Destroy;
begin
  FNameFont.Free;
  FViewConfiguration.Free;
  FDataLink.Free;
  inherited Destroy;
end;

procedure TdpbNameCard.Paint;
Const
  FieldAlignment : Array[0..2] Of Integer = (DT_LEFT, DT_CENTER, DT_RIGHT);
var
  nIndex : Integer;
  OldActive : Integer;
  StartRow, StopRow : Integer;
  nCol, nRow : Integer;
  szField, szFormat : String;
  CellRect, TmpRect, FieldRect : TRect;
begin
  Canvas.Brush.Color := Self.Color;
  Canvas.FillRect(ClientRect);

  if FDataLink.Active then
  begin
    { ½ÃÀÛ ·¹ÄÚµå¿Í ¸¶Áö¸· ·¹Äڵ带 ±¸ÇÑ´Ù. }
    StartRow := FDataLink.ActiveRecord;
    for nIndex := 1 to VisibleRows do
      if StartRow > 0 then
        Dec( StartRow );
    StopRow := Min(FDataLink.RecordCount, StartRow + VisibleRows);
    OldActive := FDataLink.ActiveRecord;
  end
  else
  begin
    OldActive := 0;
    StopRow := 0;
  end;

  StartRow := 0;
  for nRow := 1 To FRowCount do
  begin
    for nCol := 1 To FColCount do
    begin
      { Ä«µå°¡ ±×·ÁÁú ¿µ¿ªÀ» ±¸ÇÑ´Ù .}
      CellRect := GetCellRect(nCol, nRow);

      if FDataLink.Active then
      begin
        if StartRow < StopRow then
        begin
          Canvas.Pen.Color := FCardBorderColor;
          Canvas.Brush.Color := FCardColor;
          Canvas.Rectangle(CellRect.Left, CellRect.Top,
                           CellRect.Right, CellRect.Bottom);

          FDataLink.ActiveRecord := StartRow;
          Inc(StartRow);

          { À̸§ ¿µ¿ªÀÇ ¹è°æÀ» ±×¸°´Ù. }
          Canvas.Font.Assign(FNameFont);
          TmpRect := CellRect;
          TmpRect.Bottom := TmpRect.Top + Canvas.TextHeight('A') + 8;
          if FDataLink.ActiveRecord = OldActive then
          begin
            Canvas.Brush.Color := clHighlight;
            Canvas.Font.Color := clHighlightText;
          end
          else
          begin
            Canvas.Brush.Color := FNameColor;
          end;
          Canvas.FillRect(TmpRect);
          InflateRect(TmpRect, -2, -2);

          { À̸§À» Ãâ·ÂÇÑ´Ù. }
          DrawText(Canvas.Handle,
                   PChar(FDataLink.DataSet.FieldByName('Name').DisplayText + ' ' +
                         FDataLink.DataSet.FieldByName('Position').DisplayText ),
                   -1, TmpRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER);

          {
            ±×¸®´Â ·¹Äڵ尡 ÇöÀç ·¹ÄÚµåÀÌ°í ÀÔ·Â Æ÷Ä¿½º¸¦ °¡Áö°í ÀÖÀ¸¸é
            Æ÷Ä¿½º¸¦ ³ªÅ¸³»´Â »ç°¢ÇüÀ» ±×·ÁÁØ´Ù.
          }
          if Focused and (FDataLink.ActiveRecord = OldActive) then
            Canvas.DrawFocusRect(TmpRect);
          Canvas.Brush.Color := FCardColor;

          { ±âŸ Çʵ带 ViewConfiguration¿¡ Á¤ÀÇµÈ ¼ø¼­´ë·Î ±×·ÁÁØ´Ù. }
          Canvas.Font.Assign(Self.Font);
          For nIndex := 0 To Pred(FViewConfiguration.Count) Do
          Begin
            If Length(FViewConfiguration[nIndex]) > 0 then
            Begin
              { Çʵå À̸§ }
              szField := GetWord(FViewConfiguration[nIndex], 1, ',');

              { Çʵ尡 ±×·ÁÁú ¿µ¿ª }
              FieldRect.Left := TmpRect.Left +
                StrToIntDef(GetWord(FViewConfiguration[nIndex], 2, ','), 0);
              FieldRect.Top := TmpRect.Bottom +
                StrToIntDef(GetWord(FViewConfiguration[nIndex], 3, ','), 0) + 3;
              FieldRect.Right := FieldRect.Left +
                StrToIntDef(GetWord(FViewConfiguration[nIndex], 4, ','), 0);
              FieldRect.Bottom := FieldRect.Top +
                StrToIntDef(GetWord(FViewConfiguration[nIndex], 5, ','), 0);

              FieldRect.Right := Min(CellRect.Right - 3, FieldRect.Right);
              FieldRect.Bottom := Min(CellRect.Bottom - 3, FieldRect.Bottom);

              { Çʵ带 ±×¸± ¶§ »ç¿ëÇÒ ¹®ÀÚ¿­ Çü½Ä }
              szFormat := GetWord(FViewConfiguration[nIndex], 6, ',');
              DrawText(Canvas.Handle,
                       PChar(Format(szFormat,
                       [FDataLink.DataSet.FieldByName(szField).DisplayText])),
                       -1, FieldRect,
                       { Çʵå Á¤·Ä ¹æ¹ý }
                       FieldAlignment[StrToIntDef(GetWord(FViewConfiguration[nIndex], 7, ','), 0)]
                       or DT_SINGLELINE or DT_VCENTER);
            End;
          End;
        end;
      end;
    end;
  end;
  if FDataLink.Active Then
    FDataLink.ActiveRecord := OldActive;
end;

function TdpbNameCard.VisibleRows: Integer;
begin
  Result := FColCount * FRowCount;
end;

procedure TdpbNameCard.DoVScroll(ScrollCode : TScrollCode);
var
  Offset : Integer;
begin
  Case ScrollCode of
    scLineUp :
      begin
        if not FDataLink.DataSet.BOF then
        begin
          if (FDataLink.ActiveRecord < FColCount) and
             (FDataLink.ActiveRecord > 0) then
          begin
            Offset := FDataLink.ActiveRecord;
            FDataLink.DataSet.MoveBy(-(FColCount + Offset));
            FDataLink.ActiveRecord := FDataLink.ActiveRecord + Offset;
          end
          else
            FDataLink.DataSet.MoveBy(-FColCount);
        end;
      end;
    scLineDown :
      begin
        if not FDataLink.DataSet.EOF then
        begin
          if (FDataLink.ActiveRecord div FColCount) = Pred(FRowCount) then
          begin
            Offset := FColCount - (FDataLink.ActiveRecord mod FColCount) - 1;
            FDataLink.DataSet.MoveBy(FColCount + Offset);
            FDataLink.ActiveRecord := FDataLink.ActiveRecord - Offset;
          end
          else
            FDataLink.DataSet.MoveBy(FColCount);
        end;
      end;
    scPageUp : FDataLink.DataSet.MoveBy(-VisibleRows);
    scPageDown : FDataLink.DataSet.MoveBy(VisibleRows);
    scTop : FDataLink.DataSet.First;
    scBottom : FDataLink.DataSet.Last;
  end;
end;

procedure TdpbNameCard.WMVScroll(var Message: TWMVScroll);
Begin
  With Message Do
  begin
    Case ScrollCode of
      SB_LINEUP, SB_LINEDOWN, SB_TOP, SB_BOTTOM, SB_PAGEUP, SB_PAGEDOWN :
        begin
          DoVScroll(TScrollCode(Message.ScrollCode));
        End;
      SB_THUMBPOSITION :
        begin
          FDataLink.DataSet.RecNo := Pos;
        End;
    End;
  End;
end;

procedure TdpbNameCard.SetVertScrollPos(const APos: Integer);
var
  sc : TScrollInfo;
Begin
  sc.cbSize := SizeOf(TScrollInfo);
  sc.fMask := SIF_POS Or SIF_DISABLENOSCROLL;
  sc.nPos := APos;
  SetScrollInfo(Handle, SB_VERT, sc, True);
end;

procedure TdpbNameCard.SetVertScrollRange(const AMin, AMax: Integer);
var
  sc : TScrollInfo;
Begin
  sc.cbSize := SizeOf(TScrollInfo);
  sc.fMask := SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL;
  sc.nMin := AMin;
  sc.nPage := VisibleRows;
  sc.nMax := AMax;
  SetScrollInfo(Handle, SB_VERT, sc, True);
end;

procedure TdpbNameCard.UpdateVertScrollBar;
begin
  if HandleAllocated then
  begin
    if FDatalink.Active then
    begin
      with FDataLink.DataSet do
      begin
        SetVertScrollRange(1, RecordCount + VisibleRows - 1);
        SetVertScrollPos(RecNo);
      end;
    end
    else
    begin
      with FDataLink.DataSet do
      begin
        SetVertScrollRange(1, 1);
        SetVertScrollPos(1);
      end;
    end;
  end;
end;

procedure TdpbNameCard.CreateWnd;
begin
  inherited CreateWnd;
  FDataLink.BufferCount := VisibleRows;
  UpdateVertScrollBar;
end;

procedure TdpbNameCard.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  nCol, nRow : Integer;
begin
  inherited;
  SetFocus;
  if FDataLink.Active then
  begin
    { ¸¶¿ì½º Æ÷ÀÎÅÍÀÇ À§Ä¡¿¡ µû¶ó ÇöÀç ·¹Äڵ带 Á¶Á¤ÇÑ´Ù. }
    for nRow := 1 To FRowCount do
    begin
      for nCol := 1 To FColCount do
      begin
        if PtInRect(GetCellRect(nCol, nRow), POINT(X, Y)) then
        begin
          FDataLink.DataSet.MoveBy(((nRow-1) * FColCount) + (nCol-1) -
                                   FDataLink.ActiveRecord);
          Exit;
        end;
      end;
    end;
  end;
end;

procedure TdpbNameCard.Changed(Sender: TObject);
begin
  Invalidate;
end;

{ °¢ ¸íÇÔÀÌ ±×·ÁÁú »ç°¢ ¿µ¿ªÀ» ±¸ÇÑ´Ù. }
function TdpbNameCard.GetCellRect(const ACol, ARow: Integer): TRect;
const
  MARGIN = 10;
var
  CellW, CellH : Integer;
begin
  CellW := (ClientWidth - ((FColCount + 1) * MARGIN)) div FColCount;
  CellH := (ClientHeight - ((FRowCount + 1) * MARGIN)) div FRowCount;

  Result.Left := (MARGIN * ACol) + (CellW * (ACol-1));
  Result.Top := (MARGIN * ARow) + (CellH * (ARow-1));
  Result.Right := Result.Left + CellW;
  Result.Bottom := Result.Top + CellH;
end;

procedure TdpbNameCard.WMEraseBkgnd(var Message: TMessage);
begin
  { È­¸é ±ô¹ÚÀÓÀ» ÁÙ¿© ÁØ´Ù. }
  Message.Result := 1;
end;

procedure TdpbNameCard.WMKillFocus(var Message: TWMKillFocus);
begin
  Invalidate;
end;

procedure TdpbNameCard.WMSetFocus(var Message: TWMSetFocus);
begin
  Invalidate;
end;

procedure TdpbNameCard.AdjustColRow;
begin
  FColCount := ClientWidth div FCardWidth;
  FRowCount := ClientHeight div FCardHeight;
  FDataLink.BufferCount := VisibleRows;
  UpdateVertScrollBar;
  Invalidate;
end;

procedure TdpbNameCard.Loaded;
begin
  inherited;
  AdjustColRow;
  ActiveChanged;
end;

procedure TdpbNameCard.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if FDataLink.Active then
  begin
    case Key of
      VK_LEFT: FDataLink.DataSet.MoveBy(-1);
      VK_RIGHT: FDataLink.DataSet.MoveBy(1);
      VK_UP: DoVScroll(scLineUp);
      VK_DOWN: DoVScroll(scLineDown);
      VK_PRIOR: DoVScroll(scPageUp);
      VK_NEXT: DoVScroll(scPageDown);
      VK_HOME: DoVScroll(scTop);
      VK_END: DoVScroll(scBottom);
      VK_RETURN : DblClick;
    end;
  end;
end;

procedure TdpbNameCard.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  { È­»ìÇ¥ Å°¸¦ ÀÔ·Â ¹ÞÀ» ¼ö ÀÖµµ·Ï ÇÑ´Ù. }
  Message.Result := DLGC_WANTARROWS;
end;

procedure TdpbNameCard.WMSize(var Message: TWMSize);
begin
  inherited;
  AdjustColRow;
end;

end.

unit dpbDBNumberEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, db, dbctrls;

type
  TdpbDBNumberEdit = class(TCustomEdit)
  private
    FMinValue: LongInt;
    FMaxValue: LongInt;
    FDataLink : TFieldDataLink;

    function GetValue: LongInt;
    function CheckValue (NewValue: LongInt): LongInt;
    procedure SetValue (NewValue: LongInt);
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
    procedure WMUndo(var Message: TMessage); message WM_UNDO;
    procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
    procedure WMCut(var Message: TWMCut);   message WM_CUT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(const Value: TDataSource);

    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    procedure UpdateData(Sender: TObject);
    function GetReadOnly: Boolean;
    procedure SetReadOnly(const Value: Boolean);

  protected
    procedure Change; override;
    procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
    function IsValidChar(Key: Char): Boolean; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property Color;
    property Constraints;
    property Ctl3D;
    property DataSource : TDataSource read GetDataSource write SetDataSource;
    property DataField : string read GetDataField write SetDataField;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property MaxLength;
    property MaxValue: LongInt read FMaxValue write FMaxValue default 0;
    property MinValue: LongInt read FMinValue write FMinValue default 0;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Value: LongInt read GetValue write SetValue;
    property Visible;

    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;
    property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('dpb', [TdpbDBNumberEdit]);
end;

{ TdpbDBNumberEdit }

constructor TdpbDBNumberEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  { TDBCtrlGrid¿¡¼­ »ç¿ëÇÏ·Á¸é csReplicatable Ç÷¡±×°¡ ¼³Á¤µÇ¾î ÀÖ¾î¾ß ÇÑ´Ù. }
  ControlStyle := ControlStyle - [csSetCaption] + [csReplicatable];

  FMinValue := 0;
  FMaxValue := 0;

  { µ¥ÀÌÅÍ ¸µÅ©¸¦ »ý¼ºÇÑ´Ù. }
  FDataLink := TFieldDataLink.Create;
  { TField °´Ã¼ÀÇ FocusControl ÇÁ·ÎÆÛƼ¿Í µ¥ÀÌÅÍ ¿¬µ¿ ÄÞÆ÷³ÍÆ®¸¦ ¿¬°áÇϱâ À§ÇØ
    µ¥ÀÌÅÍ ¸µÅ©ÀÇ Control ÇÁ·ÎÆÛƼ¸¦ ÀÚ½ÅÀ¸·Î ¼³Á¤ÇÑ´Ù. } 
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;

end;

destructor TdpbDBNumberEdit.Destroy;
begin
  FDataLink.Free;
  inherited Destroy;
end;

procedure TdpbDBNumberEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);

  { ±ÛÀÚ »èÁ¦³ª »ðÀԽà µ¥ÀÌÅÍ ¸µÅ©¸¦ ¼öÁ¤ ¸ðµå·Î }
  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    FDataLink.Edit;
end;

procedure TdpbDBNumberEdit.KeyPress(var Key: Char);
begin
  { À¯È¿ÇÑ Å°ÀÎÁö Á¶»çÇÑ´Ù. }
  if not IsValidChar(Key) then
  begin
    Key := #0;
    MessageBeep(0);
  end;

  case Key of
    { À¯È¿ÇÑ Å°ÀÎ °æ¿ì µ¥ÀÌÅÍ ¸µÅ©¸¦ ¼öÁ¤ ¸ðµå·Î º¯°æÇÑ´Ù. }
    ^H, ^V, ^X, '0'..'9', '+', '-':
      FDataLink.Edit;
    #27:
      begin
        { ESC Å°ÀÎ °æ¿ì Reset }
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;
  if Key <> #0 then inherited KeyPress(Key);
end;

function TdpbDBNumberEdit.IsValidChar(Key: Char): Boolean;
begin
  Result := (Key in ['+', '-', '0'..'9']) or
            ((Key < #32) and (Key <> Chr(VK_RETURN)));
end;

procedure TdpbDBNumberEdit.WMUndo(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TdpbDBNumberEdit.WMPaste(var Message: TWMPaste);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TdpbDBNumberEdit.WMCut(var Message: TWMPaste);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TdpbDBNumberEdit.CMExit(var Message: TCMExit);
begin
  inherited;

  if CheckValue (Value) <> Value then
    SetValue (Value);

  { ÀÔ·Â Æ÷Ä¿½º¸¦ ÀÒÀ» ¶§ º¯°æµÈ °ªÀ» ¾÷µ¥ÀÌÆ® ÇÑ´Ù. }
  try
    FDataLink.UpdateRecord;
  except
    { ¾÷µ¥ÀÌÆ®¿¡ ½ÇÆÐÇϸé Æ÷Ä¿½º¸¦ ´Ù½Ã °¡Á® ¿Â´Ù. }
    SelectAll;
    SetFocus;
    raise;
  end;
end;

procedure TdpbDBNumberEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

function TdpbDBNumberEdit.GetValue: LongInt;
begin
  Result := StrToIntDef(Text, FMinValue);
end;

procedure TdpbDBNumberEdit.SetValue (NewValue: LongInt);
begin
  Text := IntToStr (CheckValue (NewValue));
end;

function TdpbDBNumberEdit.CheckValue (NewValue: LongInt): LongInt;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue) then
  begin
    if NewValue < FMinValue then
      Result := FMinValue
    else if NewValue > FMaxValue then
      Result := FMaxValue;
  end;
end;

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

function TdpbDBNumberEdit.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

function TdpbDBNumberEdit.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TdpbDBNumberEdit.SetDataField(const Value: string);
begin
    FDataLink.FieldName := Value;
end;

procedure TdpbDBNumberEdit.SetDataSource(const Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TdpbDBNumberEdit.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

function TdpbDBNumberEdit.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TdpbDBNumberEdit.SetReadOnly(const Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

procedure TdpbDBNumberEdit.DataChange(Sender: TObject);
begin
  { ÇöÀç ÇʵåÀÇ °ªÀ» ÄÞÆ÷³ÍÆ®¿¡ ¹Ý¿µÇÑ´Ù. }
  if FDatalink.Field <> nil then
    Value := FDataLink.Field.AsInteger
  else
  begin
    if csDesigning in ComponentState then
      Text := Name
    else
      Text := '';
  end;
end;

procedure TdpbDBNumberEdit.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;
end;

procedure TdpbDBNumberEdit.UpdateData(Sender: TObject);
begin
  { ½ÇÁ¦·Î ÇʵåÀÇ °ªÀ» ¾÷µ¥ÀÌÆ® ÇÑ´Ù. }
  FDataLink.Field.AsInteger := Value;
end;

procedure TdpbDBNumberEdit.Change;
begin
  if FDataLink <> nil then
    FDataLink.Modified;
  inherited Change;
end;

end.