Для изменения цвета границы GroupBox в Delphi, вы можете использовать компонент TEXSColoredGroupBox, который был разработан Eddie Shipman. Этот компонент является расширением стандартного компонента TGroupBox и добавляет три свойства: BevelShadowColor, BevelHighlightColor и BevelWidth.
Чтобы использовать этот компонент, вам нужно добавить его в свой проект. Вы можете сделать это, скопировав и вставив следующий код в раздел "implementation" своего единичного модуля:
unit ColoredBorderGroupBox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TEXSColoredGroupBox = class(TGroupBox)
private
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
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
Constructor Create(AOwner:TComponent); override;
published
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;
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.
После добавления этого кода в свой проект, вы можете использовать компонент TEXSColoredGroupBox вместо стандартного TGroupBox. Чтобы изменить цвет границы, просто установите значения свойств BevelShadowColor и BevelHighlightColor в нужный цвет. Например, чтобы установить цвет границы в синий, вы можете использовать следующую конструкцию кода:
Также можно изменить ширину границы, установив значение свойства BevelWidth. Например, чтобы установить ширину границы в 2 пикселя, можно использовать следующую конструкцию кода:
MyGroupBox.BevelWidth := 2;
Обратите внимание, что этот компонент также добавляет поддержку режима "flat mode", если свойство Ctl3D установлено в False. В этом режиме граница отображается одним цветом, заданным свойством BevelShadowColor.
Подтвержденный ответ: Чтобы изменить цвет границы GroupBox в Delphi, можно использовать компонент TEXSColoredGroupBox, который добавляет три свойства: BevelShadowColor, BevelHighlightColor и BevelWidth. Установив значения этих свойств, можно изменить цвет и ширину границы GroupBox. Альтернативный ответ: Также можно использовать стандартный компонент TGroupBox и переопределить процедуру Paint, чтобы нарисовать границу нужного цвета и ширины. Однако это требует больше кода и может быть сложнее в использовании.
В тексте приведено описание компонента TEXSColoredGroupBox для Delphi, который является расширением стандартного компонента TGroupBox и добавляет три свойства: BevelShadowColor, BevelHighlightColor и BevelWidth. С помощью этих свойств можно изменить цвет
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал