delphi - 在 Delphi 中更改 GroupBox 的边框颜色

Question

如何在 Delphi 中更改 GroupBox 的边框颜色？

Answer 1

示例源代码来自这里：

(*
TEXSColoredGroupBox - Eddie Shipman

 TGroupBox that allows colored and flat colored bevels.

 Added three properties:
*******************************************************************************
 property: - BevelShadowColor-

    This is the color of the Bevel's Shadow, Default clBtnShadow.
    Change this color to change the color of the Bevel's Shadow.

*******************************************************************************
 property: BevelHighlightColor-

    This is the color of the Bevel's Highlight, Default clBtnHighlight.
    Change this color to change the color of the Bevel's Highlight.

*******************************************************************************
 property: BevelWidth-

    This is the width of the Bevel.

*******************************************************************************
  This component will also draw the frame in "flat mode" if Ctl3D is False
  using the BevelShadowColor.

  It still has some problems with redrawing controls in design-time but it is
  usable...

*******************************************************************************
*)
unit ColoredBorderGroupBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TEXSColoredGroupBox = class(TGroupBox)
  private
    { private declarations }
    FBevelLowColor: TColor;
    FBevelHiColor : TColor;
    FBevelWidth : Integer;
    procedure SetBvlLowColor(Value: TColor);
    procedure SetBvlHiColor(Value: TColor);
    procedure SetBevelWidth(Value: Integer);
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure WMSize(var Message: TMessage); message WM_SIZE;
  protected
    { protected declarations }
    procedure CreateParams(Var Params:TCreateparams); override;
    procedure Paint; override;
    procedure SetParent(AParent:TWinControl); override;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure DrawFrame(Rect:TRect);
    procedure DrawFlatFrame(Rect:TRect);
    procedure InvalidateFrame;
  public
    { public declarations }
    Constructor Create(AOwner:TComponent); override;
  published
    { published declarations }
    property BevelShadowColor :TColor read FBevelLowColor
                                        write SetBvlLowColor;
    property BevelHighlightColor:TColor read FBevelHiColor
                                        write SetBvlHiColor;
    property BevelWidth :Integer read FBevelWidth
                                        write SetBevelWidth
                                      default 1;
    property Align;
    property Caption;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnendDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('SST', [TEXSColoredGroupBox]);
end;

constructor TEXSColoredGroupBox.Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
    ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csDoubleClicks, csReplicatable];
  FBevelLowColor := clBtnShadow;
  FBevelHiColor := clBtnHighlight;
  FBevelWidth := 1;
end;

procedure TEXSColoredGroupBox.CreateParams(Var Params:TCreateparams);
begin
  inherited CreateParams (Params);
  with Params.WindowClass do
    Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TEXSColoredGroupBox.Paint;
var
  H: Integer;
  R: TRect;
begin
  // No call to inherited needed.
  // inherited Paint;
  with Canvas do
  begin
    Font := Self.Font;
    H := TextHeight('0');
    R := Rect(0, H div 2 - 1, Width, Height);
    if Ctl3D then
    begin
      DrawFrame(R);
    end else
    begin
      Brush.Color := FBevelLowColor;
      DrawFlatFrame(R);
    end;
    if Text <> '' then
    begin
      R := Rect(8, 0, 0, H);
      Brush.Style := bsClear;
      DrawText(Handle, PChar(Text), Length(Text), R, DT_LEFT or DT_SINGLELINE
or
DT_CALCRECT);
      // **********************
  if not Enabled then
  begin
    OffsetRect(R, 1, 1);
    Canvas.Font.Color := clBtnHighlight;
    DrawText(Canvas.Handle, PChar(Text), Length(Text), R, DT_LEFT or
DT_SINGLELINE);
    OffsetRect(R, -1, -1);
    Canvas.Font.Color := clBtnShadow;
    DrawText(Canvas.Handle, PChar(Text), Length(Text), R, DT_LEFT or
DT_SINGLELINE);
  end
  else
    DrawText(Canvas.Handle, PChar(Text), Length(Text), R, DT_LEFT or
DT_SINGLELINE);
  // ****************************
      // DrawText(Handle, PChar(Text), Length(Text), R, );
    end;
  end;
end;

procedure TEXSColoredGroupBox.AlignControls(AControl: TControl; var Rect:
TRect);
begin
  Canvas.Font := Font;
  Inc(Rect.Top, Canvas.TextHeight('0'));
  InflateRect(Rect, -1, -1);
  if Ctl3d then InflateRect(Rect, -1, -1);
  inherited AlignControls(AControl, Rect);
end;

procedure TEXSColoredGroupBox.SetParent(AParent:TWinControl);
begin
  inherited SetParent(AParent);
  if Parent <> nil then
    SetWindowLong(Parent.Handle, GWL_STYLE,
       GetWindowLong(Parent.Handle, GWL_STYLE)
          and not WS_ClipChildren);
end;


procedure TEXSColoredGroupBox.SetBvlLowColor(Value: TColor);
begin
  if FBevelLowColor <> Value then
    FBevelLowColor := Value;
  InvalidateFrame;
  Realign;
end;

procedure TEXSColoredGroupBox.SetBvlHiColor(Value: TColor);
begin
  if FBevelHiColor <> Value then
    FBevelHiColor := Value;
  InvalidateFrame;
  Realign;
end;

procedure TEXSColoredGroupBox.DrawFrame(Rect: TRect);
var
  CaptionLength: Integer;
begin
  with Canvas do
  begin
    Inc(Rect.Left, FBevelWidth); // 0,5 199,5
    Inc(Rect.Top, FBevelWidth); //
    Dec(Rect.Right, FBevelWidth); //
    Dec(Rect.Bottom, FBevelWidth); // 0,198 198,198
    CaptionLength := TextWidth(Text); //
    Pen.Color := FBevelHiColor; //
    Pen.Width := FBevelWidth; // 1,7 200,7
    MoveTo(Rect.Left, Rect.Top); //
    LineTo(6,Rect.Top); //
    MoveTo(8+CaptionLength+2, Rect.Top); // 1,200 200,200
    LineTo(Rect.Right,Rect.Top); //
    LineTo(Rect.Right,Rect.Bottom);
    LineTo(Rect.Left,Rect.Bottom);
    LineTo(Rect.Left, Rect.Top);
    Pen.Color := FBevelLowColor;
    Pen.Width := FBevelWidth;
    OffsetRect(Rect, -FBevelWidth, -FBevelWidth);
    MoveTo(Rect.Left, Rect.Top);
    LineTo(6,Rect.Top);
    MoveTo(8+CaptionLength+2, Rect.Top);
    LineTo(Rect.Right,Rect.Top);
    LineTo(Rect.Right,Rect.Bottom);
    LineTo(Rect.Left,Rect.Bottom);
    LineTo(Rect.Left, Rect.Top);
  end;
end;

procedure TEXSColoredGroupBox.DrawFlatFrame(Rect: TRect);
var
  CaptionLength: Integer;
begin
  with Canvas do
  begin
    Dec(Rect.Right);
    Dec(Rect.Bottom);
    CaptionLength := TextWidth(Text);
    Pen.Color := FBevelLowColor;
    Pen.Width := FBevelWidth;
    MoveTo(Rect.Left, Rect.Top);
    LineTo(6,Rect.Top);
    MoveTo(8+CaptionLength+2, Rect.Top);
    LineTo(Rect.Right,Rect.Top);
    LineTo(Rect.Right,Rect.Bottom);
    LineTo(Rect.Left,Rect.Bottom);
    LineTo(Rect.Left, Rect.Top);
  end;
end;

procedure TEXSColoredGroupBox.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and CanFocus then
    begin
      SelectFirst;
      Result := 1;
    end else
      inherited;
end;

procedure TEXSColoredGroupBox.CMTextChanged(var Message: TMessage);
begin
  inherited;
  InvalidateFrame;
  Realign;
end;

procedure TEXSColoredGroupBox.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  InvalidateFrame;
  Realign;
end;

procedure TEXSColoredGroupBox.WMSize(var Message: TMessage);
begin
  if (csDesigning in ComponentState) then
    InvalidateFrame;
  inherited;
end;

procedure TEXSColoredGroupBox.InvalidateFrame;
var
  R: TRect;
begin
  R := BoundsRect;
  InflateRect(R, 1, 1);
  If (Parent <> Nil) and Parent.HandleAllocated then
    InvalidateRect(Parent.Handle, @R, True)
  Else
    inherited Invalidate;
end;

procedure TEXSColoredGroupBox.SetBevelWidth(Value:Integer);
begin
  if Value <> FBevelWidth then
    FBevelWidth := Value;
  Repaint;
end;

end.