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.