[Solved] Colored Button

[MikeRohsoft]

Hello Lazarus Community,

I'm currently working on a Windows CE application.
I got the task to enhance Colored Buttons instead of TBitBtn/TSpeedButton (I need Glyph).
I've tried "TCDButton" from the CustomDrawn component.
It works fine, but I can't change the alignment of the Glyph/Text which I need to align on the left side.
There is no property to change it.

I also tried the component TGridButton in which I can change the Background Color and the alignment with the propertry TextAlignment := taLeftJustify;

My only problem with this Component is that it is way too slow.
The programm must be able to draw many Buttons in seconds, not in minutes for just 100

It must be fast like a SpeedButton, looking like SpeedButton with a Glyph and .Margin := 1; with a White Background Color.

Does anyone have a solution for me, or do I have to draw my own button?
Thanks in advance.

[Avishai]

I doubt this is the solution you are looking for, but you can use Tpanel as a button and put a TImage and TLabel on it.  Use the OnClick event.  You can also use MouseEnter/MouseLeave if you want the TPanel to react to that.

[MikeRohsoft]

Thank you very much for the Idea.
My Solution isn't nice, but works.
Maybe some one need it too.

Code: [Select]

type
  TColoredButton = class(TPanel)
  private
    FCaption: TLabel;
    FImage: TImage;
    FCommand: string;
    function  GetFCaption: string;
    procedure SetFCaption(ACaption: string);
    procedure SetPicture(AImage: string);
    function  GetCommand: string;
    procedure SetCommand(ACommand: string);
    procedure DynamicLabelRef(Sender: TObject);
    procedure DynamicImageRef(Sender: TObject);
    procedure SetFontSize(ASize: integer);
    function  GetFontSize: integer;
    procedure SetFontColor(AColor: integer);
    function  GetFontColor: integer;
    procedure SetFontStyle(AStyle: TFontStyles);
    function  GetFontStyle: TFontStyles;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property FontStyle: TFontStyles read GetFontStyle write SetFontStyle;
    property FontSize: integer read GetFontSize write SetFontSize;
    property FontColor: integer read GetFontColor write SetFontColor;
    property Caption : string read GetFCaption write SetFCaption;
    property Glyph: string write SetPicture;
    property Command: string read GetCommand write SetCommand;
end;

implementation
{$R *.lfm}

constructor TColoredButton.Create(AOwner: TComponent);
begin
  inherited;
  FCaption := TLabel.Create(AOwner);
  FCaption.Parent := Self;
  FCaption.Left := 55;
  FCaption.Top := (Self.Height - (FCaption.Height div 2)) div 2;
  FCaption.OnClick := @DynamicLabelRef;
  FImage := TImage.Create(AOwner);
  FImage.Parent := Self;
  FImage.Left := 5;
  FImage.Top := 5;
  FImage.Height := 44;
  FImage.Width := 44;
  FImage.OnClick := @DynamicImageRef;
  Self.Height := 55;
  Self.Width := 200;
end;

procedure TColoredButton.SetFontStyle(AStyle: TFontStyles);
begin
   FCaption.Font.Style := AStyle;
end;

function TColoredButton.GetFontStyle : TFontStyles;
begin
   Result := FCaption.Font.Style;
end;

procedure TColoredButton.SetFontColor(AColor: integer);
begin
   FCaption.Font.Color := AColor;
end;

function TColoredButton.GetFontColor : integer;
begin
   Result := FCaption.Font.Color;
end;

procedure TColoredButton.SetFontSize(ASize: integer);
begin
   FCaption.Font.Size := ASize;
end;

function TColoredButton.GetFontSize : integer;
begin
   Result := FCaption.Font.Size;
end;

procedure TColoredButton.SetFCaption(ACaption: string);
begin
   FCaption.Caption := ACaption;
end;

function TColoredButton.GetFCaption: string;
begin
   Result := FCaption.Caption;
end;

procedure TColoredButton.SetPicture(AImage: string);
begin
   FImage.Picture.LoadFromFile(AImage);
end;

procedure TColoredButton.SetCommand(ACommand: string);
begin
   FCommand := ACommand;
end;

function TColoredButton.GetCommand: string;
begin
   Result := FCommand;
end;

procedure TColoredButton.DynamicLabelRef(Sender: TObject);
begin
   (TLabel(Sender)).Parent.onClick(TLabel(Sender).Parent);
end;

procedure TColoredButton.DynamicImageRef(Sender: TObject);
begin
   (TImage(Sender)).Parent.onClick(TImage(Sender).Parent);
end;

I don't know how to Reference to a property.
I'm very new to Pascal and it's my first Class ever ^^

Thank you again.

[bambamns]

Hi,

I use image.onclick to call procedure for visual motion and then do the stuff I need for that "button".

Visual motion goes like this :

Code: [Select]

procedure TDM.ImageMotion(a_image:TImage; a_form:TForm);

var a_time: cardinal;
      tmpW, tmpH , tmpT, tmpL : integer;
      a_move: byte;

begin

   a_move := 8;

   tmpL := a_image.Left;
   tmpT := a_image.Top;
   tmpH := a_image.Height;
   tmpW := a_image.Width;

   a_image.Left := tmpL + a_move;
   a_image.Top := tmpT + a_move;
   a_image.Height := tmpH - 2*a_move;
   a_image.Width := tmpW - 2*a_move;
   a_image.Update;

   a_time := GetTickCount;
   while GetTickCount < (a_time + 250) do
    begin
     Application.ProcessMessages;
    end;

   a_image.Left := tmpL;
   a_image.Top := tmpT;
   a_image.Height := tmpH;
   a_image.Width := tmpW;
   a_image.Update;

end;