runder Button

[Hansa]

Hi,

brauche einen runden Button. Nicht wegen überflüssiger Spielereien, sondern um einen Knopf zu simulieren (Touchscreen). Verschiedenes ist zu finden. Das reicht von 1500 Zeilen-Unit abgeleitet von TGraphicControl, bis zu dem hier :

Delphi-Quellcode:

procedure DrawRounded(Control: TWinControl);
var
  R: TRect;
  Rgn: HRGN;
begin
  with Control do
  begin
    R := ClientRect;
    rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 14, 14);
    Perform(EM_GETRECT, 0, lParam(@r));
    InflateRect(r,1,1);
    Perform(EM_SETRECTNP, 0, lParam(@r));
    SetWindowRgn(Handle, rgn, True);
    Invalidate;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DrawRounded(Button1);
end;

Am besten gefällt mir noch das hier (SwissDelphiCenter) :

Delphi-Quellcode:

procedure TColorRundButton.DrawButton(Rect: TRect; State: UINT);
var
  Flags, OldMode: Longint;
  IsDown, IsDefault, IsDisabled: Boolean;
  OldColor: TColor;
  OrgRect: TRect;
  rgn: HRGN;
begin
  OrgRect := Rect;
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  IsDown := State and ODS_SELECTED <> 0;
  IsDefault := State and ODS_FOCUS <> 0;
  IsDisabled := State and ODS_DISABLED <> 0;
  if IsDown then Flags := Flags or DFCS_PUSHED;
  if IsDisabled then Flags := Flags or DFCS_INACTIVE;

  if IsFocused or IsDefault then begin
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Style := bsClear;

    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
    InflateRect(Rect, - 1, - 1);
  end;

  if IsDown then begin
    FCanvas.Pen.Color := clBtnShadow;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Color := clBtnFace;
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
    InflateRect(Rect, - 1, - 1);
  end
  else begin
    DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
  end;

  if IsDown then OffsetRect(Rect, 1, 1);

  OldColor := FCanvas.Brush.Color;
  FCanvas.Brush.Color := BackColor;
  FCanvas.FillRect(Rect);
  FCanvas.Brush.Color := OldColor;
  OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT);
  FCanvas.Font.Color := ForeColor;
  if IsDisabled then
    DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
    ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
    ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
      0, 0, DST_TEXT or DSS_DISABLED)
  else
    DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect,
      DT_SINGLELINE or DT_CENTER or DT_VCENTER);

  SetBkMode(FCanvas.Handle, OldMode);

  if IsFocused and IsDefault then begin
    Font.Style := Font.Style + [fsBold];
  end
  else begin
    Font.Style := Font.Style - [fsBold];
  end;
(* laut WinSDK :
    int nLeftRect,   // x-coordinate of region's upper-left corner
    int nTopRect,   // y-coordinate of region's upper-left corner
    int nRightRect,   // x-coordinate of region's lower-right corner
    int nBottomRect    // y-coordinate of region's lower-right corner
*)
  rgn := CreateRoundRectRgn(3,3,Width - 2,Height - 2,10,10);
  SetWindowRgn(Handle, rgn, True);
end; (*DrawButton*)

Da wurde eine protected procedure neu eingeführt. Auch etwas mehr als gewünscht (aber Unit nur ca. 230 Zeilen), zumindest aber siehts brauchbar aus. Der damit erzeugte Button hat abgerundete Ecken. Wie kriege ich den nun komplett rund ? Das CreateRoundRectRgn hat anscheinend 6 Parameter. Laut WinSDK aber nur 4. Was nun ? Alternativ wäre auch andere Komponente denkbar (TPanel ??), die sich relativ leicht "rund" machen lässt.

[DerFree]

Hi,

bei den JEDI's ist ein "JvShapedButton" dabei, den du a.u. auch auf "Rund" einstellen kannst.

[Hawkeye219]

Hallo Hansa,

bezüglich der API-Funktion solltest du direkt beim Hersteller nachsehen.

Gruß Hawkeye

[Hansa]

Der schweizer Code ist nicht schlecht (bitte selber suchen -> 1. Tip zu TButton). So geht es :

Delphi-Quellcode:

  begin
    Font.Style := Font.Style - [fsBold];
  end;
(*
Width := 100;
Height := 100;
*)
Height := Width;
//  rgn := CreateRoundRectRgn(3,3,Width - 2,Height - 2,20,20);
//showmessage (IntToStr (Width)+'  '+IntToStr (Height));
  rgn := CreateRoundRectRgn(3,3,Width - 2,Height - 2,Width,Height);
  SetWindowRgn(Handle, rgn, True);
end; (*DrawButton*)

Beweis : siehe Anhang. Weiß noch jemand, was gemacht werden muss, damit um die jetzt gefüllte Fläche (also genau auf der Umrandung) eine Linie um die Fläche gezogen wird, in anderer Farbe, ohne die Fläche selbst zu beeinflussen ?

[Namenloser]

Wieso CreateRoundRectRgn und nicht CreateEllipticRgn?

[Hansa]

Was weiß denn ich ? Wollte ja Kreis. Da gilt Width = Height. Und das ist auch eine Ellipse.

Delphi-Quellcode:

  rgn := CreateRoundRectRgn(3,3,Width - 2,Height - 2,Width,Height);
  SetWindowRgn(Handle, rgn, True);
  FCanvas.Pen.Color := clBlack;
  FCanvas.Pen.Width := 5;
  FCanvas.Brush.Color := clBlue;
  FCanvas.RoundRect(3,3,Width - 2 - 1,Height - 2 - 1,Width,Height);
end; (*DrawButton*)

Der Rand wird jetzt auch gezeichnet, überdeckt aber die Caption dieses runden Buttons. Was ist zu tun ? DP-Ampeln kann man damit aber zumindest mal bauen.

[Opa]

Wenn das ein Ampel werden soll warum nimmst du nicht ein Image und gibst dem noch ein paar Ereignisse.

MFG

[Hansa]

Besser um diese Uhrzeit nicht mehr so viel denken, Opa. Es geht um keine Ampel, sondern um das, was in Beitrag #1 gefragt wurde. Die Ampel ist bereits als Neujahrs-Witz zu verstehen.

[alzaimar]

Wenn Du einen Touchscreen-Buitoni möchtest, dann mal Dir einen. Dann noch einen, so wie er gedrückt aussieht. Und noch einen, so wie er aussehen soll, wenn man mit der Maus drüber fährt. Und noch einen, wenn er nicht drückbar sein soll (also Enabled := False).

Dann schnapp Dir ein TImage und fettich. Wieso willst du dir einen mit Regions abbrechen? Vasteh ick nich.

[DeddyH]

Regions könnte man noch benutzen, um den klickbaren Bereich einzugrenzen. Ansonsten finde ich auch, dass das mit vorgefertigten Grafiken einfach besser aussieht