kcheckbox.pas

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

unit Kcheckbox;

interface

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

  -------------------------------------------------------------------
}

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

type
  TLabelColorType = (LCTFont, LCTColor);

  TKCheckBox = class(TCheckBox)
  private
    { Private declarations }
    FAllowArrow  : Boolean;
    FAllowEnter  : Boolean;
    FFocusColor  : TColor;
    FUnFocusColor : TColor;
    FFocusCtl   : Boolean;           //碍力肺 瘤沥等 器目胶肺 捞悼且巴牢瘤 酒囱瘤 瘤沥
    FFocusprior : TWincontrol;       //捞傈狼 器目胶
    FFocusNext  : TWincontrol;       //捞饶狼 器目胶
    FLabelCtl : TLabel;              //瘤沥等 扼骇狼 祸惑阑 官槽促
    FLabelCtlType : TLabelColorType; //瘤沥等 扼骇狼 祸惑 肚绰 迄飘甫 瘤沥茄促.
    FLabelEColor : TColor;           //扼骇器目胶甫 罐阑锭 祸惑
    FLabelFColor: TColor;            //扼骇器目胶甫 酪阑锭 祸惑

  protected
    { Protected declarations }
    procedure SetUnFocusColor(Value: TColor);
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    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
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

  published
    { Published declarations }
    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 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;

procedure Register;

implementation

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

constructor TKCheckbox.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FAllowArrow  := True;
  FAllowEnter  := True;
  FUnFocusColor := clBtnFace;
  FFocusColor  := clBtnFace;

  ImeMode := imSHanguel;
  Font.Size := 10;
  Font.Name := '奔覆';
  ShowHint := True;
  Height := 18;
end;

destructor TKCheckbox.Destroy;
begin
  inherited Destroy;
end;

procedure TKCheckbox.DoEnter;
begin
  Color := FFocusColor;
  if FLabelCtl <> Nil then
    if FLabelCtlType = LCTFont then FLabelCtl.Font.Color := FLabelFcolor
    else FLabelCtl.Color := FLabelFcolor;
  inherited;
end;

procedure TKCheckbox.DoExit;
begin
  Color := FUnFocusColor;
  if FLabelCtl <> Nil then
    if FLabelCtlType = LCTFont then FLabelCtl.Font.Color := FLabelEcolor
    else FLabelCtl.Color := FLabelEcolor;
  inherited DoExit;
end;
procedure TKCheckbox.KeyDown(var Key: Word; Shift: TShiftState);
var
  MyForm: TCustomForm;
begin
  if FAllowArrow and (Key = VK_DOWN) then begin
    MyForm := GetParentForm(Self);
    if (FFocusCtl) and (fFocusNext <> Nil) then FFocusNext.SetFocus
    else SendMessage(MyForm.Handle, WM_NEXTDLGCTL, 0, 0);
    Key := 0;
  end else if FAllowArrow and (Key = VK_UP) then begin
    MyForm := GetParentForm(Self);
    if (FFocusCtl) and (FFocusPrior <> Nil) then FFocusPrior.SetFocus
    else SendMessage(MyForm.Handle, WM_NEXTDLGCTL, 1, 0);
    Key := 0;
  end else if FAllowEnter and (Key = VK_RETURN)and(Shift=[]) then begin
    MyForm := GetParentForm(Self);
    if (FFocusCtl) and (fFocusNext <> Nil) then FFocusNext.SetFocus
    else SendMessage(MyForm.Handle, WM_NEXTDLGCTL, 0, 0);
    inherited KeyDown(Key,Shift);
  end else inherited;
end;

procedure TKCheckbox.KeyPress(var Key: Char);
begin
  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 begin
      inherited KeyPress(Key);
      Key := #0;
      Exit;
    end;
  end;
  inherited KeyPress(Key);
end;

procedure TKCheckbox.SetUnFocusColor(Value: TColor);
begin
  if Value = FUnFocusColor then Exit;
  FUnFocusColor := Value;
  if not Focused or (csDesigning in ComponentState) then Color := FUnFoCusColor;
end;

procedure TKCheckbox.SetLabelCtl(Value : TLabel);
begin
  FLabelCtl := Value;
end;

procedure TKCheckbox.SetLabelCtltype(Value : TLabelColorType);
begin
  FLabelCtlType := Value;
end;

procedure TKCheckbox.SetLabelFColor(Value : TColor);
begin
  FLabelFColor := Value;
end;

procedure TKCheckbox.SetLabelEColor(Value : TColor);
begin
  FLabelEColor := Value;
end;

procedure TKCheckbox.SetFocusCtl(Value : Boolean);
Begin
  FFocusCtl := Value;
End;

procedure TKCheckbox.SetFocusprior(Value : TWincontrol);
Begin
  FFocusprior := Value;
  inherited;
End;

procedure TKCheckbox.SetFocusNext(Value : TWincontrol);
Begin
  FFocusNext := Value;
  inherited;
End;

end.