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.