klistbox.pas

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

unit Klistbox;

interface

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

type

  TLabelColorType = (LCTFont, LCTColor);

  TKListbox = class(TListbox)
  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', [TKListbox]);
end;

constructor TKListbox.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FAllowArrow  := False;
  FAllowEnter  := True;
  FUnFocusColor := Color;
  FFocusColor  := Color;

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

destructor TKListbox.Destroy;
begin
  inherited Destroy;
end;

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

procedure TKListbox.DoExit;
begin
  Color := FUnFocusColor;
  if FLabelCtl <> Nil then
    if FLabelCtlType = LCTFont then FLabelCtl.Font.Color := FLabelEcolor
    else FLabelCtl.Color := FLabelEcolor;
  inherited DoExit;
end;
procedure TKListbox.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 TKListbox.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 TKListbox.SetUnFocusColor(Value: TColor);
begin
  if Value = FUnFocusColor then Exit;
  FUnFocusColor := Value;
  if not Focused or (csDesigning in ComponentState) then Color := FUnFoCusColor;
end;

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

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

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

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

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

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

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

end.