2005. szeptember 4., vasárnap

How to create a flat TCheckBox


Problem/Question/Abstract:

I want to inherit the TCheckbox class in order to create a new TCheckBox class that is the flat version for TCheckbox. What style to override in order to make it a flat checkbox instead of a 3D checkbox?

Answer:

{ ... }
TExCheckBox = class(TCheckBox)
private
  { Private declarations }
  FFlat: Boolean;
  FMultiLine: Boolean;
  FPushLike: Boolean;
  procedure SetFlat(const Value: Boolean);
  procedure SetMultiLine(const Value: Boolean);
  procedure SetPushLike(const Value: Boolean);
protected
  { Protected declarations }
  procedure CreateParams(var Params: TCreateParams); override;
public
  { Public declarations }
  constructor Create(AOwner: TComponent); override;
published
  { Published declarations }
  property Flat: Boolean read FFlat write SetFlat default true;
  property MultiLine: Boolean read FMultiLine write SetMultiLine default false;
  property PushLike: Boolean read FPushLike write SetPushLike default false;
end;

{ TExCheckBox }

constructor TExCheckBox.Create(AOwner: TComponent);
begin
  FFlat := true;
  FMultiLine := false;
  FPushLike := false;
  inherited Create(AOwner);
end;

procedure TExCheckBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if FFlat then
    Params.Style := Params.Style or BS_FLAT
  else
    Params.Style := Params.Style and not BS_FLAT;
  if FMultiLine then
    Params.Style := Params.Style or BS_MULTILINE
  else
    Params.Style := Params.Style and not BS_MULTILINE;
  if FPushLike then
    Params.Style := Params.Style or BS_PUSHLIKE
  else
    Params.Style := Params.Style and not BS_PUSHLIKE;
end;

procedure TExCheckBox.SetFlat(const Value: Boolean);
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    RecreateWnd;
  end;
end;

procedure TExCheckBox.SetMultiLine(const Value: Boolean);
begin
  if Value <> FMultiLine then
  begin
    FMultiLine := Value;
    RecreateWnd;
  end;
end;

procedure TExCheckBox.SetPushLike(const Value: Boolean);
begin
  if Value <> FPushLike then
  begin
    FPushLike := Value;
    RecreateWnd;
  end;
end;

Nincsenek megjegyzések:

Megjegyzés küldése