Mega Code Archive
How to use bitbtn which accepts controls and multiline captions
<![CDATA[
Below there is a code of a TBitBtn descendant with two additional
functionalities:
1. Its caption can be multiline (see the Lines property)
2. Another controls may be placed on it if the AcceptControls property
is set to True (sometimes it is useful to place a TCheckBox or a TEdit
on a button).
Remarks: only TWinControl descendants work well when placed on
the button. If you want another control (like TImage for instance),
first place a TPanel and then, on the panel you can place whatever
you want. Only cliks in the button area not covered by another
controls trigger the button's OnClick event.
unit ZLBitBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls;
type
TZLBitBtn = class(TBitBtn)
private
FAcceptControls: boolean;
FLines: TStringList;
procedure SetAcceptControls(const Value: boolean);
procedure SetLines(const Value: TStrings);
function GetLines: TStrings;
protected
procedure LinesChanged(Sender: TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure WMSetText(var m: TMessage); message WM_SETTEXT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property AcceptControls: boolean read FAcceptControls write SetAcceptControls;
property Lines: TStrings read GetLines write SetLines;
end;
procedure register;
implementation
procedure register;
begin
RegisterComponents('Samples', [TZLBitBtn]);
end;
{TZlBitBtn}
constructor TZlBitBtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FLines:=TStringList.Create;
FLines.OnChange:=LinesChanged;
if FAcceptControls then
ControlStyle:=ControlStyle + [csAcceptsControls];
end;
procedure TZLBitBtn.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:=Params.Style or BS_MULTILINE;
end;
destructor TZLBitBtn.Destroy;
begin
FLines.Free;
inherited Destroy;
end;
function TZLBitBtn.GetLines: TStrings;
begin
Result:=FLines;
end;
procedure TZLBitBtn.LinesChanged(Sender: TObject);
begin
Caption:=Lines.Text;
end;
procedure TZLBitBtn.SetAcceptControls(const Value: boolean);
begin
FAcceptControls := Value;
if FAcceptControls then
ControlStyle:=ControlStyle + [csAcceptsControls]
else
ControlStyle:=ControlStyle - [csAcceptsControls];
end;
procedure TZLBitBtn.SetLines(const Value: TStrings);
begin
FLines.Assign(Value);
end;
procedure TZLBitBtn.WMSetText(var m: TMessage);
var
OldCaption: string;
begin
OldCaption:=Caption;
inherited;
{If caption has been changed, reflect changes in Lines also}
if caption<>OldCaption then
Lines.Text:=caption;
end;
end.
]]>