buttonstyle ändern

[FastJack2]

.. hab noch was vergessen ... es gibt ja auch den status "enabled = false" ... ist jetzt noch mit implementiert ;)

greetz
-FastJack2

Code:

type
  TOwnButton = class(TButton)
  private
    isin: boolean;
    ismousein: boolean;
    isdown: boolean;
    procedure paintme;
  public
    procedure PMNorm(var message: TMessage); message WM_PAINT;
    procedure PMUpDown(var message: TMessage); message $f3;
    procedure PMEnter(var message: TMessage); message WM_SETFOCUS;
    procedure PMLeave(var message: TMessage); message WM_KILLFOCUS;
    procedure PMMouseEnter(var message: TMessage); message CM_MOUSEENTER;
    procedure PMMouseLeave(var message: TMessage); message CM_MOUSELEAVE;
  end;

implemetation

procedure TOwnButton.paintme;
var
  c: TControlCanvas;
  tmpcaption: string;
begin
  try
    c := TControlCanvas.create;
    c.Control := self;
    if not enabled then
    begin
      c.Brush.Color := $00004800;
      c.FillRect((rect(0,0,self.Width,self.Height)));
      c.font.Color := clgray;
      tmpcaption := 'diabled';
      c.TextOut((width div 2)-(c.TextWidth(tmpcaption) div 2),
                (height div 2)-(c.Textheight(tmpcaption) div 2),
                tmpcaption);
    end
    else if isdown then
    begin
      c.Brush.Color := clmaroon;
      c.FillRect((rect(0,0,self.Width,self.Height)));
      c.font.Color := clred;
      tmpcaption := 'down';
      c.TextOut((width div 2)-(c.TextWidth(tmpcaption) div 2),
                (height div 2)-(c.Textheight(tmpcaption) div 2),
                tmpcaption);
    end
    else if ismousein then
    begin
      c.Brush.Color := cllime;
      c.FillRect((rect(0,0,self.Width,self.Height)));
      c.font.Color := clblack;
      tmpcaption := 'hover';
      c.TextOut((width div 2)-(c.TextWidth(tmpcaption) div 2),
                (height div 2)-(c.Textheight(tmpcaption) div 2),
                tmpcaption);
    end
    else if isin then
    begin
      c.Brush.Color := clnavy;
      c.FillRect((rect(0,0,self.Width,self.Height)));
      c.font.Color := clwhite;
      tmpcaption := 'focused';
      c.TextOut((width div 2)-(c.TextWidth(tmpcaption) div 2),
                (height div 2)-(c.Textheight(tmpcaption) div 2),
                tmpcaption);
    end
    else
    begin
      c.Brush.Color := clgreen;
      c.FillRect((rect(0,0,self.Width,self.Height)));
      c.font.Color := cllime;
      tmpcaption := 'normal';
      c.TextOut((width div 2)-(c.TextWidth(tmpcaption) div 2),
                (height div 2)-(c.Textheight(tmpcaption) div 2),
                tmpcaption);
    end;
  finally
    FreeAndNil(c);
  end;
end;

procedure TOwnButton.PMNorm(var message: TMessage);
begin
  inherited;
  paintme;
end;


procedure TOwnButton.PMUpDown(var message: TMessage);
begin
  inherited;
  if message.WParam = 1 then
  begin
    isdown := true;
    paintme;
  end
  else
  begin
    isdown := false;
    paintme;
  end;
end;

procedure TOwnButton.PMMouseEnter(var message: TMessage);
begin
  ismousein := true;
  paintme;
end;

procedure TOwnButton.PMMouseLeave(var message: TMessage);
begin
  ismousein := false;
  paintme;
end;


procedure TOwnButton.PMEnter(var message: TMessage);
begin
  isin := true;
  inherited;
end;

procedure TOwnButton.PMLeave(var message: TMessage);
begin
  isin := false;
  inherited;
end;