kxedit.pas

Korea, a data table control 韩国数据表控件 必备

unit KXEdit;

interface
{*********************************************************************
  荐沥老 : 2000斥 2岿 绢蠢朝
  恐 荐沥沁唱? : 粱歹 犬厘等 VCL阑 啊瘤绊 祈府窍霸 橇肺弊伐阑 父甸绊
                 酵绢辑 肚 RealGrid甫 荤侩窍绊 付澜俊甸菌栏唱 促弗 霓
                 器惩飘啊 酒浆款 扁瓷捞 乐绢辑 眠啊沁促.
  穿啊 : 辫蜡吝
  歹窍绊酵篮富 : 捞霓器惩飘甫 歹宽 荐沥窍咯 荤侩窍扁甫......
  眠啊郴侩 :
    ENTER虐甫 荤侩 促澜 牧飘费肺 捞悼 且 锭 KeyDown捞亥飘俊 VK_RETURN蔼阑 佬阑 荐 乐档废 荐沥
    FKeyPos: integer;           //家荐痢 磊府荐
    FKeyOption: integer;        //例荤, 例惑, 馆棵覆
    FFocusCtl   : Boolean;      //碍力肺 瘤沥等 器目胶肺 捞悼且巴牢瘤 酒囱瘤 瘤沥
    FFocusprior : TWincontrol;  //捞傈狼 器目胶
    FFocusNext  : TWincontrol;  //捞饶狼 器目胶
    FLabelColorCtl: TLabel;     //瘤沥等 霓器惩飘狼 祸惑阑 官槽促
    FLabelCtlType : TLabelColorType; //瘤沥等 扼骇狼 祸惑 肚绰 迄飘甫 瘤沥茄促.
    FLabelEColor : TColor;    //器目胶甫 罐阑锭 祸惑
    FLabelFColor: TColor;      //器目胶甫 酪阑锭 祸惑
    FocusColor : 器目胶 登菌阑锭狼 祸彬阑 瘤沥茄促.
    FocusUnColor : 器目胶 救登菌阑锭狼 祸彬阑 瘤沥茄促. (UnFocus狼 捞抚父 官厕)

  -------------------------------------------------------------------

  力格    : 茄惫屈 犬厘 Editor VER 1.0
  累己磊  : 缴捍殴
  父电朝  : 1998斥 7岿
  父电捞蜡: 橇肺璃飘甫 窍妨绊 窍促啊 癌磊扁 父甸绢具摆促绰 积阿捞 甸绢辑..

  眠啊等 Property :
   Value      : 箭磊蔼 涝仿屈侥老 版快 箭磊甫 府畔茄促.
   MinValue   : 箭磊 涝仿矫 弥家 涝仿蔼阑 涝仿茄促.
   MaxValue   : 箭磊 涝仿矫 弥措 涝仿蔼阑 汲沥茄促.
               ** MinValue,MaxValue = 0 捞搁 蔼狼 力茄捞 绝促.**
   AllowEnter : ENTER虐甫 荤侩 促澜 牧飘费肺 捞悼 且 荐 乐档废窃
   AllowArrow : 规氢虐甫 荤侩 促澜 牧飘费肺 捞悼且 荐 乐档废 窃
   FocusColor : 器目胶 登菌阑锭狼 祸彬阑 瘤沥茄促.
   UnFocusColor : 器目胶 救登菌阑锭狼 祸彬阑 瘤沥茄促.
   EditType   : (ETString, ETInteger, ETFloat, ETCurrency, ETFloatCurrency)
               吝 窍唱肺 鉴辑措肺 巩磊凯,哪付绝绰 沥荐屈,哪付绝绰 角荐屈,
               哪付啊 甸绢啊绰 沥荐屈, 哪付啊 甸绢啊绰 角荐屈
   LinkStyle  : LSEllipsis费 汲沥登搁 快螟俊 滚瓢捞 积变促.
   ButtonShortCut : LSEllipsis甫 汲沥沁阑 版快 Button捞 喘妨瘤档废 窍绰
                 窜绵虐甫 沥狼茄促.
   眠啊等 Event :
   OnButtonClick: 滚瓢捞 喘妨脸阑锭 惯积登绰 捞亥飘

   眠啊等 窃荐 棺 函荐
     function AsInteger : 箭磊蔼栏妨 函版 馆券
     function AsString  : 巩磊凯肺 函版 馆券
     function AsFloat   : 角荐屈栏肺 函版 馆券
     function AsCurrency: 陛咀屈栏肺 函版 馆券


  荐沥等 荤亲.
    捞繁幅狼 Editor啊 惑寸洒 腹栏府扼绊 夯促. 窍瘤父 咯瘤帛 结夯巴甸 吝
    肯寒洒 妇俊 靛绰巴 绝菌带淀 窍促. 困狼 眠啊等 扁瓷 寇俊档 付胶农俊
    叼磐肺 汲沥沁阑版快 茄臂阑 涝仿且 荐 绝档废(捞蜡绰 滚弊啊 乐栏骨肺)
    窍看绊, Alignment甫 汲沥矫 焊咯龙锭 挥 酒聪扼 涝仿矫俊档 谅螟 吝居
    沥纺等 惑怕俊辑 涝仿捞 啊瓷窍档废 窍看促.  Enter贸府档 富阐窍霸
    贸府 登绢乐促.

    PS: 救崇窍绞聪鳖? 缴捍殴涝聪促. 捞吧 父电 饶 流立 荤侩窍搁辑
     橇肺弊伐阑 父甸菌绊 弊矾搁辑 滚弊档 窍唱,窍唱 棱疽嚼聪促. 2俺岿
     沥档 荤侩窍搁辑 力啊 荤侩窍扁 祈且 父怒 犬厘篮 窍看瘤父 肚 歹
     绢痘霸 犬厘 秦具且瘤 葛福摆匙夸. 荤侩窍矫促 眠啊 登菌栏搁 窍绰
     扁瓷捞唱 滚弊啊 乐栏矫搁 皋老阑 焊郴 林绞矫夸. 泅犁 雀荤酒捞叼唱,
     [e-mail] 栏肺夸.
     付瘤阜栏肺 促弗镑俊 捞 哪器惩飘甫 傍俺窍矫绰扒 亮篮单夸. 葛滴 瘤快柳
     付矫绊 力捞抚 籍磊沥档绰 巢败林矫辨 瑚聪促. 弊成 傍俺 登搁  宝洒 距埃
     辑款窍歹扼备夸. 弊烦 捞父. 殴捞啊.

 *********************************************************************}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, DB, DBTables, DBCtrls, Mask, Buttons, IMM;

type
  TLinkStyle = (LSNormal, LSEllipsis);
  TEditTypes = (ETString, ETInteger, ETFloat, ETCurrency, ETFloatCurrency, ETZnumber);
  TLabelColorType = (LCTFont, LCTColor);

  TKXCustomEdit = class(TCustomMaskEdit)
  private
    FAllowArrow  : Boolean;
    FAllowEnter  : Boolean;
    FButtonWidth : integer;
    FLinkStyle   : TLinkStyle;
    FPressed     : Boolean;
    FAlignment   : TAlignment;
    FButtonShortCut : TShortCut;
    FTracking    : boolean;
    FEditType    : TEditTypes;
    FFocusColor  : TColor;
    FUnFocusColor : TColor;
    FValue        : Extended;
    FMinValue,FMaxValue : Extended;
    IsMinus   : Boolean;
    FChangeCvt   : Byte;
    FOnButtonClick : TNotifyEvent;

    FKeyPos: integer;                //家荐痢 磊府荐
    FKeyOption: integer;             //例荤, 例惑, 馆棵覆
    FFocusCtl   : Boolean;           //碍力肺 瘤沥等 器目胶肺 捞悼且巴牢瘤 酒囱瘤 瘤沥
    FFocusprior : TWincontrol;       //捞傈狼 器目胶
    FFocusNext  : TWincontrol;       //捞饶狼 器目胶
    FLabelCtl : TLabel;              //瘤沥等 扼骇狼 祸惑阑 官槽促
    FLabelCtlType : TLabelColorType; //瘤沥等 扼骇狼 祸惑 肚绰 迄飘甫 瘤沥茄促.
    FLabelEColor : TColor;           //扼骇器目胶甫 罐阑锭 祸惑
    FLabelFColor: TColor;            //扼骇器目胶甫 酪阑锭 祸惑

    procedure StopTracking;
    procedure SetMinValue(Value : Extended);
    procedure SetMaxValue(Value : Extended);
    procedure SetUnFocusColor(Value: TColor);
    procedure TrackButton(X,Y: Integer);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  protected
    procedure ConvertValue( Str : string );
    procedure SetEditType(Value: TEditTypes); virtual;
    procedure SetLinkStyle(Value: TLinkStyle); virtual;
    procedure SetAlignment(Value: TAlignment); virtual;
    procedure SetInputchar(var Key: Char);
    procedure SetDeleteKey(var Key : Word; Shift : TShiftState);
    procedure Change; override;
    procedure BoundsChanged;
    procedure EditButtonClick;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure PaintWindow(DC: HDC); override;
    procedure WndProc(var Message: TMessage); override;
    property Alignment : TAlignment read FAlignment write SetAlignment default TALeftJustify;

    procedure SetKeyPos(var Value : integer);
    procedure SetKeyOption(var Value: integer);
    procedure SetFocusCtl(Value : Boolean);
    procedure SetFocusprior(Value : TWincontrol);
    procedure SetFocusNext(Value : TWincontrol);
    procedure SetLabelCtl(Value : TLabel);
    procedure SetLabelCtlType(Value : TLabelColorType);
    procedure SetLabelEColor(Value : TColor);
    procedure SetLabelFColor(Value : TColor);

  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function AsInteger : Longint;
    function AsString  : string;
    function AsFloat   : Extended;
    function AsCurrency: Currency;

  published
    property Value : Extended read FValue;
    property MinValue : Extended read FMinValue write SetMinValue;
    property MaxValue : Extended read FMaxValue write SetMaxValue;
    property AllowArrow: Boolean read FAllowArrow write fAllowArrow default True;
    property AllowEnter: Boolean read FAllowEnter write FAllowEnter default False;
    property FocusColor : TColor read FFocusColor write FFocusColor;
    property FocusUnColor : TColor read FUnFocusColor write SetUnFocusColor default clWindow;
    property EditType  : TEditTypes read FEditType write SetEditType default ETString;
    property LinkStyle: TLinkStyle read FLinkStyle write SetLinkStyle default LSNormal;
    property ButtonShortCut : TShortCut read FButtonShortCut write FButtonShortCut;
    property OnButtonClick: TNotifyEvent read fOnButtonClick write fOnButtonClick;

    property KeyPos: integer read FKeyPos write SetKeyPos default 0;
    property KeyOption: integer read FKeyOption write SetKeyOption default 0;
    property LabelCtl: TLabel read FLabelCtl write SetLabelCtl;
    property LabelCtlType: TLabelColorType read FLabelCtltype write SetLabelCtltype;
    property LabelFColor: TColor read FLabelFColor write SetLabelFColor default clWindow;
    property LabelEColor: TColor read FLabelEColor write SetLabelEColor default clWindow;
    property FocusCtl   : Boolean     Read FFocusCtl   Write SetFocusCtl Default False;
    property FocusPrior : TWincontrol Read FFocusPrior Write SetFocusPrior;
    property FocusNext  : TWincontrol Read FFocusNext  Write SetFocusNext;
  end;

  TKXFieldDataLink = class(TDataLink)
  private
    FField: TField;
    FFieldName: string;
    FControl: TComponent;
    FEditing: Boolean;
    FModified: Boolean;
    FOnDataChange: TNotifyEvent;
    FOnEditingChange: TNotifyEvent;
    FOnUpdateData: TNotifyEvent;
    FOnActiveChange: TNotifyEvent;
    function GetCanModify: Boolean;
    procedure SetEditing(Value: Boolean);
    procedure SetField(Value: TField);
    procedure SetFieldName(const Value: string);
    procedure UpdateField;
  protected
    procedure ActiveChanged; override;
    procedure EditingChanged; override;
    procedure FocusControl(Field: TFieldRef); override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure UpdateData; override;
  public
    function Edit: Boolean;
    procedure Modified;
    procedure Reset;
    property CanModify: Boolean read GetCanModify;
    property Control: TComponent read FControl write FControl;
    property Editing: Boolean read FEditing;
    property Field: TField read FField;
    property FieldName: string read FFieldName write SetFieldName;
    property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
    property OnEditingChange: TNotifyEvent read FOnEditingChange write FOnEditingChange;
    property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
    property OnActiveChange: TNotifyEvent read FOnActiveChange write FOnActiveChange;
  end;

  TKXEdit = class(TKXCustomEdit)
  published
    property Alignment;
    property AutoSelect;
    property BorderStyle;
    property CharCase;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property EditMask;
    property Font;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    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;

    property KeyPos;
    property KeyOption;
    property LabelCtl;
    property LabelCtlType;
    property LabelFColor;
    property LabelEColor;
    property FocusCtl;
    property FocusPrior;
    property FocusNext;

  end;

  TKXDBEdit = class(TKXCustomEdit)
  private
    FDataLink: TKXFieldDataLink;
    FFocused: Boolean;
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    function  GetDataField: string;
    function  GetDataSource: TDataSource;
    function  GetField: TField;
    function  GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetFocused(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure SetEditText(const Value: string);
    function  GetEditText: string;
    procedure SetText(const Value: string);
    function  GetText: string;
    procedure UpdateData(Sender: TObject);
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  protected
    procedure Change; override;
    procedure SetEditType(Value: TEditTypes); override;
    function  EditCanModify: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Reset; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
    property EditText: string read GetEditText write SetEditText;
    property Text: string read GetText write SetText;
  published
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Ctl3D;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property TabOrder;
    property TabStop;
    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;
function StrToCurrency(const Str: string; const op: integer) : string;
function FloatToCurrency(const Value : Extended): string;

implementation

procedure Register;
begin
  RegisterComponents('Etc', [TKXEdit,TKXDBEdit]);
end;

function StrToStrL(const Str: string; const S: string) : string;
var Temp : string;
begin
  Temp := Str;
  if Pos(S, Temp) > 0 then SetLength(Temp, Pos(S, Temp)-1 );
  Result:=Temp;
end;

function StrToStrR(const Str: string; const S: string) : string;
var Temp : string;
    i : integer;
begin
  Temp:=Str;
  i:=Pos(S,Temp);
  if i > 0 then Temp:=Copy(Temp,i,Length(Temp)+1-i)
  else Temp:='';
  Result:=Temp;
end;

function StrToCurrency(const Str: string; const op: integer) : string;
var
  Temp : string;
  Minus : Boolean;
  i,j,Len : Integer;
begin
  Temp:=TrimLeft(StrToStrL(Str,'.'));
  Minus:=False;
  if Length(Temp) > 0 then begin
    if Temp[1] = '-' then begin
      Minus:=True;
      Delete(Temp,1,1);
    end;
    Len:=Length(Temp);
    i:=1; j:=Len;
    while i < Len do begin
      inc(i); dec(j);
      if (i mod 3 = 0) and (j>1) then insert(',', Temp, j);
    end;
    Temp:=Temp+TrimRight(StrToStrR(Str,'.'));
    if Minus then  Temp:='-' + Temp;
  end;
  if (op=0) and (Length(Temp)=0) then Temp:='0';
  Result:=Temp;
end;

function FloatToCurrency(const Value : Extended): string;
begin
  try
    Result := StrToCurrency(FloatToStr(Value),0);
  except
    Result := '0';
  end;
end;

constructor TKXCustomEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  FAllowArrow  := True;
  FAllowEnter  := True;
  FAlignment    := taLeftJustify;
  FUnFocusColor := clWindow;
  FFocusColor  := clWindow;
  FButtonShortCut := ShortCut(0,[]);
  AutoSize     := True;
  IsMinus      := False;
  FChangeCvt   := 0;
  FMinValue    := 0;
  FMaxValue    := 0;