buttonstyle ändern

[glkgereon]

hi
ich weiss, wir hattens schon mal, aber irgendwie sind meines wissens die disskussionen nie zu ende gekommen...

ich will einen button haben der (zb) runde ecken hat, der 3-d effeckt (schreibt man das so?) größer ist oder in regenbogen farben, oder das ein gedrückter button anders aussieht etc

wie geht das?
kann ich mir da einfach ne klasse Townbutton vom TButton ableiten und da die entsprechenden sachen einfügen? (wie?)

[FastJack2]

Hy ;)
... du stellst ganz schön komplizierte Fragen ;) ... ich arbeite grad an nem Beispiel für dich ... poste es dann hier wenn ich fertig bin ;)

greetz
-FastJack2

[glkgereon]

danke
in freudiger erwartung
gereon

[FastJack2]

Soa ... nach reichlicher herumjongliererei mit windows messages und einer kleinen Mittagspause ist nun folgendes herausgekommen:

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;

implementation

procedure TOwnButton.paintme;
var
  c: TControlCanvas;
begin
  try
    c := TControlCanvas.create;
    c.Control := self;
    if isdown then
    begin
      c.TextOut(5,5,'down');  //hier statt textout einfach auf dem canvas malen ...
    end
    else if ismousein then
    begin
      c.TextOut(5,5,'hover');  //hier statt textout einfach auf dem canvas malen ...
    end
    else if isin then
    begin
      c.TextOut(5,5,'focus');  //hier statt textout einfach auf dem canvas malen ...
    end
    else
    begin
      c.TextOut(5,5,'norm');  //hier statt textout einfach auf dem canvas malen ...
    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;

hoffe das war das, was du haben wolltest ;)

falls du noch runde buttons implementieren willst, musst du halt deren region setzen, aber das ist ein anderes thema ;)

greetz
-FastJack2

[glkgereon]

sorry, da ich davon nicht wirklich viel ahnung hab, was tuen die einzelnen procedures?
die geben doch im prinzip nur auf canvas einen text aus, oder?

[FastJack2]

jupp ...
aber auf einem canvas kannste halt malen oder bitmaps reinkopieren ... ganz wie du lustig bist ...

diese proceduren

Code:

    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;

schalten nur die button-states um und rufen die Prozedur paintme auf, die dann den button-canvas bemalt ...

wenn du jetzt die paintme prozedur wie folgt abänderst ändert sich die farbe und die caption des buttons

Code:

procedure TOwnButton.paintme;
var
  c: TControlCanvas;
  tmpcaption: string;
begin
  try
    c := TControlCanvas.create;
    c.Control := self;
    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;

greetz
-FastJack2

[edit]probleme mit zeilemumbruch behoben ;)[/edit]

[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;

[glkgereon]

ok, jetzt hab ichs...

und was heisst das inherited?

[FastJack2]

inherited (engl. = geerbt) heisst, dass er die gleichnamige funktion (oder die funktion die auf die gleiche message reagiert) des Objektes ausführt, von demm das Objekt abgeleitet ist ;)

greetz
-FastJack2

[glkgereon]

ahaaa....
hauptsache es funzt