runden Button

[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