runden Button

[sentinal]

Hallo,

ist es möglich einen runden Button zu erstellen?
Evtl. ein abgeleitetes Panel o.ä.

sentinal

[arbu man]

ja :-D

Delphi-Quellcode:

begin
  x := (Width - Canvas.TextWidth(Caption)) div 2;
  y := (Height- Canvas.TextHeight(Caption)) div 2;
  if Pressed then
    for i := 1 to 3 do
    begin
      // Canvas.Pen.Color := OColor[4-i];
      Canvas.Pen.Color := OColor[(i+1) div 2];
      Canvas.Arc (i, i, Width-i, Height-i, i, i, i, i);
      Canvas.Ellipse (3, 3, Width-3, Height-3);
      Canvas.TextOut (x+1,y+1, Caption+' ');
    end
  else
    for i := 1 to 3 do
    begin
      Canvas.Pen.Color := OColor[i];
      Canvas.Arc (i, i, Width-i, Height-i, i, i, i, i);
      Canvas.Ellipse (3, 3, Width-3, Height-3);
      Canvas.TextOut (x,y, Caption+' ');
    end;
end;

Benutze die Klasse TCustomControl für die komponente

[sentinal]

Hallo,

was ist den z.B. OColor?

sentinal

[Vader]

hallo arbu man

du schreibst : "Benutze die Klasse TCustomControl für die komponente"

wie geht das wo schreibe ich das hinein "TCustomControl"
und die komponente ist mir auch nicht klar wo ich die finde ???

mfg vader

[jfheins]

du musst dir für den runden Button eine eigene Komponente schreiben.
Diese musst du von der Klasse TCustomControl ableiten ...

[Vader]

hallo,

ok danke
mfg vader

[sentinal]

Hallo!

Ich war nen Moment nicht da, kann mir hier nochmal jmd. etwas mehr Quellcode zu posten???

sentinal

[fkerber]

Hi!

Was willst du denn wissen?

Ciao Frederic

[sentinal]

Hallo,

naja, irgendwo muss der Code von oben ja eingebaut werden.
Also wäre es ganz nett mal zu wissen wo.

Normal fängt ein neuer type ja immer mit ner Definition an und muss es eine eigene create geben oder eine onclick etc pp.

[fkerber]

Hi!

Es sieht sehr nach der OnPaint aus.


Ciao Frederic

[SirThornberry]

die bisher gepostete Variante malt nur etwas rundes. Einen Button wirklich rund machen kannst du so

Delphi-Quellcode:

var LRgn: HRGN;
begin
  LRgn := CreateEllipticRgn(0, 0, Button1.Width, Button1.Height);
  SetWindowRgn(Button1.Handle, LRgn, True);
  DeleteObject(LRgn);

Anstelle von Button1 kannst du auch jedes anderen WinControl nehmen

[sentinal]

Also da ist der Button wunderschön rund, aber leider fehlt dann da ja der Rahmen...


Bei dem anderen habe ich mal was versucht, aber ist missglückt.

[fkerber]

Hi!

Versuch es mal mit dem Code von SirT.


Ciao Frederic

[Nils_13]

Hol dir das Buch "Delphi für Kids", da stehts drinnen :wink:

[sentinal]

Zitat:

Zitat von Nils_13

Hol dir das Buch "Delphi für Kids", da stehts drinnen :wink:

Oh, wie nett...

ich brauch das für die Schule... normal mach ich nichts mit Delphi... und bin eigentlich auch der Meinung, dass man keine runde Buttons braucht.

[Nils_13]

Such halt mal im Internet :!:

[fkerber]

Hi!

SirT hat doch bereits eine Lösung gepostet.


Ciao Frederic

[SirThornberry]

Hier mal Source für einen ganze einfachen Runden Button der nur ein OnClick hat.

Delphi-Quellcode:

type
  TRundBtn = class(TCustomControl)
  private
    fIsDown: Boolean;
    fNeedsFormSet: Boolean;
    procedure fDownProc(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure fUpProc(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    OnClick;
  end;

constructor TRundBtn.Create(AOwner: TComponent);
var LRgn: HRGN;
begin
  inherited;
  fIsDown := False;
  color := clRed;
  OnMouseDown := fDownProc;
  OnMouseUp := fUpProc;
  SetBounds(Left, Top, 75, 25);
end;

procedure TRundBtn.Paint;
var LRgn: HRGN;
begin
  if fNeedsFormSet then
  begin
    fNeedsFormSet := False;
    LRgn := CreateEllipticRgn(0, 0, Width, Height);
    SetWindowRgn(Handle, LRgn, True);
    DeleteObject(LRgn);
  end;
  inherited;
  if fIsDown then
    Canvas.Brush.Color := clBlue
  else
    Canvas.Brush.Color := Color;
  Canvas.FillRect(Canvas.ClipRect);
end;

procedure TRundBtn.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var LRgn: HRGN;
    LNeedsResize: Boolean;
begin
  if (AWidth <> Width) or (AHeight <> Height) then
    LNeedsResize := True;
  inherited;
  if LNeedsResize then
  begin
    if Parent <> nil then
    begin
      LRgn := CreateEllipticRgn(0, 0, Width, Height);
      SetWindowRgn(Handle, LRgn, True);
      DeleteObject(LRgn);
    end else fNeedsFormSet := True;
  end;
end;

procedure TRundBtn.fDownProc(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  fIsDown := True;
  Repaint;
end;

procedure TRundBtn.fUpProc(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  fIsDown := False;
  Repaint;
end;

[sentinal]

Hallo,

ich sagte schon zu dem von SirT, dass dort ja kein Rahmen mehr da ist.

Und im Internet habe ich auch schon erfolglos gesucht. Erst danach bin ich ja hierhin gekommen und habe gefragt, ... das macht man doch normalerweise so.


sentinal



PS:

Danke für den Code hier.

[sentinal]

Habe nun alles in einer extra Unit eingebaut, uses und implementation und so ergänzt und dann wollte ich einen erzeugen.

Code:

procedure TForm1.Button1Click(Sender: TObject);
  var btn: TRundBtn;
begin
  btn := TRundBtn.Create(Form1);
  btn.Width := 80;
  btn.Height := 89;
  btn.top := 80;
  btn.left := 89; 
  btn.show;
end;

Leider passiert nichts. Sonst ging es immer so. Ich muss zugeben, dass dies meine aktuellen Kenntnisse von Delphi überschreitet, da ich mich normal wenn ich was programmiere/scripte mit anderen Sprachen rumschlagen, die auch nicht in der (Turbo?)Pascal-Art sind.

sentinal

[alcaeus]

Hi sentinal,

bau mal nach dem Create die folgende Zeile ein:

Delphi-Quellcode:

btn.Parent := Form1

Du musst den Parent eines Controls setzen, damit er irgendwo gezeichnet wird.

Greetz
alcaeus

[sentinal]

Autsch, stimmt.

Das war doch noch was...
Danke, klappt... supi....