unit fButton; {$mode objfpc}{$H+}
interface
uses Classes, Controls, Dialogs, Forms, Graphics, lcltype{ wegen*Multiline }, LResources, Messages,
StdCtrls, SysUtils, Windows;
type EBtnVisibility = ( btvNoChange, btvVisible, btvInvisible ); { Enumeration für die Prozedur Setze (Sichtbarkeit) }
type TfButton = class( TButton )
private FMultiline : Boolean; { wegen*Multiline }
function GetCaption: String; { wegen*Multiline }
procedure SetCaption(const Value: String); { wegen*Multiline }
procedure SetMultiline(const Value: Boolean); { wegen*Multiline }
protected
public
{ Prüft ob ein bestimmtes Bit im Tag-Integer gesetzt ist und gibt True oder False zurück }
function BitExists( BitNr : Byte ) : Boolean;
function CaptionToInt : Integer;
{ Löscht alle gesetzten Bits im Tag-Integer }
procedure ClearBits;
procedure CreateParams( var params: TCreateParams); override; { wegen*Multiline }
constructor Create(aOwner: TComponent); override; { wegen*Multiline }
{ Setzt ein bestimmtes Bit im Tag-Integer }
procedure SetzeBit( BitNr : Byte; bvVisibility : EBtnVisibility = btvNoChange );
procedure ToInvisible;
procedure ToVisible;
published
{ Wenn Multiline = True, dann wird das Zeichen ~ als Zeilenumbruch interpretiert }
property Multiline: Boolean read FMultiline write SetMultiline default True;
property Caption: String read GetCaption write SetCaption;
end;
procedure Register;
implementation
procedure Register; begin {$I fbutton_icon.lrs} RegisterComponents('fCtrls',[TfButton]); end;
constructor TfButton.Create(aOwner: TComponent); begin inherited; FMultiline := True; end; { wegen*Multiline }
function TfButton.BitExists( BitNr : Byte ) : Boolean; begin Result := ( ( Tag shr BitNr) and 1 ) = 1; end;
function TfButton.CaptionToInt : Integer;
begin
Result := StrToIntDef( Caption, 0 );
end;
procedure TfButton.ClearBits; begin Tag := 0; end;
procedure TfButton.SetMultiline(const Value: Boolean); { wegen*Multiline }
begin if FMultiline <> Value then begin
FMultiline := Value;
RecreateWnd(Self);
end;
end;
procedure TfButton.CreateParams(var params: TCreateParams); { wegen*Multiline }
begin
inherited;
if FMultiline then
params.Style := params.Style or BS_MULTILINE;
end;
function TfButton.GetCaption: String; { wegen*Multiline }
begin
Result := Stringreplace( inherited Caption, #13, '~', [rfReplaceAll] );
end;
procedure TfButton.SetCaption(const Value: String); { wegen*Multiline }
begin
if value <> Caption then begin
self.Multiline := True;
inherited Caption := Stringreplace( value, '~', #13, [rfReplaceAll] );
Invalidate;
end;
self.Multiline := True;
end;
procedure TfButton.SetzeBit( BitNr : Byte; bvVisibility : EBtnVisibility = btvNoChange );
begin
Tag := Tag or ( 1 shl BitNr );
case bvVisibility of
btvVisible : begin Visible := True; end;
btvInvisible : begin Visible := False; end;
end;
end;
procedure TfButton.ToInvisible; begin Visible := False; end;
procedure TfButton.ToVisible; begin Visible := True; end;
end.