> (D7) Is there a standard simple method of drawing a dividing line on a
> form, similar to a groupbox border but just a single horizontal line.
> It would be used to divide several sets of controls without grouping
> them in group boxes.
>
If you want one with a Caption, try this one.
unit EXSSplitterLine;
{ Copyright 2001 - by Eddie Shipman
}
{ ****************************************************************************
}
{
}
{ TEXSSplitterLine is a separator that emulates a TBevel with the bsBottomLine
}
{ or bsTopLine Shape. Only it has a Caption and can be set to disabled.
}
{ It can also have different colors for the Bevel Shadow and Bevel Highlight
}
{ as well as the caption font color and background color, be Sunken or Raised.
}
{ And it has Left or Right alignment for the text in the component.
}
{
}
{ ****************************************************************************
}
{
}
{ property Alignment: Aligns the Caption
}
{ baRight = Caption is to Right of Bevel
}
{ baLeft = Caption is to Left of Bevel
}
{ baCenter = Caption is Centered on Bevel
}
{ default: baLeft
}
{
}
{ property BevelOffset: Set the number of pixels from text, bevel line
}
{ begins/ends.
}
{ default: 4 pixels.
}
{
}
{ property BevelHilightColor: Set the Highlight Color of the Bevel
}
{ default: clBtnHighlight
}
{
}
{ property BevelShadowColor: Set the Shadow Color of the Bevel
}
{ default: clBtnShadow
}
{
}
{ property Color: Set the color of the background of the component
}
{ default: clBtnFace
}
{
}
{ property Enabled: If True, the Caption is drawn in disbled format like
}
{ TLabel
}
{ default: True
}
{
}
{ property LineStyle: Sunken or Raised look on the Bevel
}
{ default: bsLowered
}
{
}
{ property LineType:
}
{ ltCenterLine = Bevel Line is in the Middle of the Component
}
{ ltTopLine = Bevel Line is at the Top of the Component
}
{ ltBottomLine = Bevel Line is at the Bottom of the Component
}
{ default: ltCenterLine
}
{
}
{ ****************************************************************************
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TLineType = (ltTopLine, ltCenterLine, ltBottomLine);
TLine = class(TObject)
LineStart: Integer;
LineEnd: Integer;
end;
TEXSSplitterLine = class(TGraphicControl)
private
{ Private declarations }
FAlignment: TAlignment;
FBevelLineColor: TColor;
FBevelOffset: Integer;
FBevelShadowColor: TColor;
FDisabledFontColor: TColor;
FDisabledFontShadowColor: TColor;
FEnabled: Boolean;
FEnabledFontColor: TColor;
FFocusControl: TWinControl;
FLineStyle: TBevelStyle;
FLineType: TLineType;
FShowAccelChar: Boolean;
procedure AdjustBounds;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure WMSize(var Message: TMessage); message WM_SIZE;
procedure SetAlignment(Value: TAlignment);
procedure SetBevelLineColor(Value: TColor);
procedure SetBevelOffset(Value: Integer);
procedure SetBevelShadowColor(Value: TColor);
procedure SetDisabledFontColor(Value: TColor);
procedure SetDisabledFontShadowColor(Value: TColor);
procedure SetFocusControl(Value: TWinControl);
procedure SetLineStyle(Value: TBevelStyle);
procedure SetLineType(Value: TLineType);
procedure SetShowAccelChar(Value: Boolean);
procedure PaintTheSucker;
protected
{ Protected declarations }
procedure Paint; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure SetEnabled(Value: Boolean); override;
published
{ Published declarations }
property Alignment: TAlignment read FAlignment
write SetAlignment
default taLeftJustify;
property BevelHilightColor: TColor read FBevelLineColor
write SetBevelLineColor
default clBtnHighlight;
property BevelOffset: Integer read FBevelOffset
write SetBevelOffset
default 4;
property BevelShadowColor: TColor read FBevelShadowColor
write SetBevelShadowColor
default clBtnShadow;
property Caption;
property Color;
property DisabledFontColor: TColor read FDisabledFontColor
write SetDisabledFontColor
default clBtnHighlight;
property DisabledFontShadowColor: TColor
read FDisabledFontShadowColor
write SetDisabledFontShadowColor
default clBtnShadow;
property Enabled: Boolean read FEnabled
write SetEnabled
default True;
property FocusControl: TWinControl read FFocusControl
write SetFocusControl;
property Font;
property LineStyle: TBevelStyle read FLineStyle
write SetLineStyle
default bsLowered;
property LineType: TLineType read FLineType
write SetLineType
default ltCenterLine;
property ShowAccelChar: Boolean read FShowAccelChar
write SetShowAccelChar
default True;
property Visible;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('EXS', [TEXSSplitterLine]);
end;
constructor TEXSSplitterLine.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csDoubleClicks, csReplicatable, csSetCaption];
Width := 185;
Height := 16;
FAlignment := taLeftJustify;
FEnabled := True;
FLineStyle := bsLowered;
FLineType := ltCenterLine;
FBevelLineColor := clBtnHighlight;
FBevelShadowColor := clBtnShadow;
FDisabledFontColor := clBtnHighlight;
FDisabledFontShadowColor := clBtnShadow;
FBevelOffset := 4;
FShowAccelChar := True;
end;
procedure TEXSSplitterLine.SetFocusControl(Value: TWinControl);
begin
FFocusControl := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
procedure TEXSSplitterLine.SetShowAccelChar(Value: Boolean);
begin
if FShowAccelChar <> Value then
begin
FShowAccelChar := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FFocusControl) then
FFocusControl := nil;
end;
procedure TEXSSplitterLine.Paint;
begin
PaintTheSucker;
end;
procedure TEXSSplitterLine.CMDialogChar(var Message: TCMDialogChar);
begin
if (FFocusControl <> nil) and
Enabled and
ShowAccelChar and
IsAccel(Message.CharCode, Caption) then
begin
with FFocusControl do
if CanFocus then
begin
SetFocus;
Message.Result := 1;
end;
end;
end;
procedure TEXSSplitterLine.CMFontChanged(var Message: TMessage);
begin
inherited;
AdjustBounds;
Paint;
end;
procedure TEXSSplitterLine.AdjustBounds;
var
DC: HDC;
SaveFont: HFont;
TextSize: TSize;
W, H : Integer;
begin
if not (csReading in ComponentState) then
begin
DC := GetDC(0);
SaveFont := SelectObject(DC, Font.Handle);
GetTextExtentPoint32(DC, PChar(Caption), Length(Caption), TextSize);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
W := TextSize.cx + (GetSystemMetrics(SM_CXBORDER) * 4);
H := TextSize.cy + (GetSystemMetrics(SM_CYBORDER) * 4);
W := W + (Width - W + FBevelOffset);
SetBounds(Left, Top, W, H);
end;
end;
procedure TEXSSplitterLine.CMTextChanged(var Message: TMessage);
begin
Invalidate;
end;
procedure TEXSSplitterLine.WMSize(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TEXSSplitterLine.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.SetLineStyle(Value: TBevelStyle);
begin
if FLineStyle <> Value then
begin
FLineStyle := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.SetLineType(Value: TLineType);
begin
if FLineType <> Value then
begin
FLineType := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.SetBevelLineColor(Value: TColor);
begin
if FBevelLineColor <> Value then
begin
FBevelLineColor := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.SetBevelShadowColor(Value: TColor);
begin
if FBevelShadowColor <> Value then
begin
FBevelShadowColor := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.SetDisabledFontColor(Value: TColor);
begin
if FDisabledFontColor <> Value then
begin
FDisabledFontColor := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.SetDisabledFontShadowColor(Value: TColor);
begin
if FDisabledFontShadowColor <> Value then
begin
FDisabledFontShadowColor := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.SetBevelOffset(Value: Integer);
begin
if FBevelOffset <> Value then
begin
FBevelOffset := Value;
Invalidate;
end;
end;
procedure TEXSSplitterLine.SetEnabled(Value: Boolean);
begin
inherited;
if FEnabled <> Value then
begin
FEnabled := Value;
if FEnabled then Font.Color := FEnabledFontColor;
Invalidate;
end;
end;
procedure TEXSSplitterLine.PaintTheSucker;
procedure BevelLine(C: TColor;X1, Y, X2: Integer);
begin
with Canvas do
begin
Pen.Color := C;
MoveTo(X1, Y);
LineTo(X2, Y);
end;
end;
var
W, W1, H, FS: Integer;
R: TRect;
Color1, Color2: TColor;
Flags: Integer;
Line1: TLine;
begin
FEnabledFontColor := Font.Color;
Line1 := TLine.Create;
Line1.LineStart := 0;
Line1.LineEnd := 0;
Flags := DT_SINGLELINE;
if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and
(Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
Color1 := clBtnShadow;
Color2 := clBtnHighlight;
with Canvas do
begin
FS := TextHeight(Text);
if Copy(Text,1,1) <> '&' then
W := TextWidth(Text)
else
W := TextWidth(Copy(Text,2,Length(Text)));
H := (Height - FS) div 2;
Pen.Width := 1;
case FLineStyle of
bsLowered:
begin
Color1 := FBevelShadowColor;
Color2 := FBevelLineColor;
end;
bsRaised:
begin
Color1 := FBevelLineColor;
Color2 := FBevelShadowColor;
end;
end;
case FAlignment of
taLeftJustify:
begin
{
1. Draw the Text First
2. Draw the Bevel on the Right
}
case FLineType of
ltTopLine:
begin
R := Rect(0, 3, W, H + FS + 3);
end;
ltCenterLine:
begin
R := Rect(0, H, W, H + FS);
end;
ltBottomLine:
begin
R := Rect(0, Height - FS - (FS-Font.Size), W, Height - 3);
end;
end;
if Text <> '' then
begin
if not FEnabled then
begin
Brush.Style := bsClear;
OffsetRect(R, 1, 1);
Font.Color := FDisabledFontColor;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
OffsetRect(R, -1, -1);
Font.Color := FDisabledFontShadowColor;
Brush.Style := bsClear;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end
else
begin
Brush.Style := bsClear;
Font.Color := FEnabledFontColor;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end;
end;
case FLineType of
ltTopLine:
begin
Line1.LineStart := 0;
Line1.LineEnd := Width;
BevelLine(Color1, Line1.LineStart, 0, Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, 1, Line1.LineEnd);
end; {case: ltTopLine}
ltCenterLine:
begin
Line1.LineStart := W + FBevelOffset;
Line1.LineEnd := Width;
BevelLine(Color1, Line1.LineStart, (Height div 2) - 1,
Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, (Height div 2), Line1.LineEnd);
end; {case: ltCenterLine}
ltBottomLine:
begin
Line1.LineStart := 0;
Line1.LineEnd := Width;
BevelLine(Color1, Line1.LineStart, Height - 2, Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, Height - 1, Line1.LineEnd);
end; {case: ltBottomLine}
end; {case - FLineType}
end; {case: taLeftJustify}
taCenter:
begin
{
1. Draw the Bevel on the Left
2. Draw the Text
3. Draw the Bevel on the Right
}
W1 := (Width - W - (FBevelOffset * 2) ) div 2;
case FLineType of
ltTopLine:
begin
R := Rect(W1 + FBevelOffset,
3,
W1 + W + FBevelOffset,
H + FS + 3);
Line1.LineStart := 0;
Line1.LineEnd := Width;
BevelLine(Color1, 0, 1, Width);
BevelLine(Color2, 0, 2, Width);
end;
ltCenterLine:
begin
R := Rect(W1 + FBevelOffset,
H,
W1 + W + FBevelOffset,
H + Fs);
Line1.LineStart := 0;
Line1.LineEnd := W1;
BevelLine(Color1, Line1.LineStart, (Height div 2) - 1,
Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, (Height div 2), Line1.LineEnd);
end;
ltBottomLine:
begin
R := Rect(W1 + FBevelOffset,
Height - FS - (FS-Font.Size),
W1 + W + FBevelOffset,
Height - 3);
Line1.LineStart := 0;
Line1.LineEnd := Width;
BevelLine(Color1, Line1.LineStart, Height - 2, Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, Height - 1, Line1.LineEnd);
end;
end;
if Text <> '' then
begin
if not FEnabled then
begin
Brush.Style := bsClear;
OffsetRect(R, 1, 1);
Font.Color := FDisabledFontColor;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
OffsetRect(R, -1, -1);
Font.Color := FDisabledFontShadowColor;
Brush.Style := bsClear;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end
else
begin
Brush.Style := bsClear;
Font.Color := FEnabledFontColor;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end;
end;
case FLineType of
ltTopLine:
begin
Line1.LineStart := 0;
Line1.LineEnd := Width;
BevelLine(Color1, 0, 1, Line1.LineEnd);
BevelLine(Color2, 0, 2, Line1.LineEnd);
end;
ltCenterLine:
begin
Line1.LineStart := W1 + W + (FBevelOffset * 2);
Line1.LineEnd := Width;
BevelLine(Color1, Line1.LineStart, (Height div 2) - 1,
Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, (Height div 2), Line1.LineEnd);
end;
ltBottomLine:
begin
Line1.LineStart := 0;
Line1.LineEnd := Width;
BevelLine(Color1, Line1.LineStart, Height - 2, Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, Height - 1, Line1.LineEnd);
end;
end;
end;
taRightJustify:
begin
{
1. Draw the Bevel on the Left
2. Draw the Text
}
R := Rect(0, 0, Width, Height);
W1 := (Width - W - FBevelOffset);
case FLineType of
ltTopLine:
begin
R := Rect(W1 + FBevelOffset,
3,
Width,
H + FS + 3);
Line1.LineStart := 0;
Line1.LineEnd := Width;
BevelLine(Color1, 0, 1, Width);
BevelLine(Color2, 0, 2, Width);
end;
ltCenterLine:
begin
R := Rect(W1 + FBevelOffset,
H,
Width,
H + FS);
Line1.LineStart := 0;
Line1.LineEnd := W1;
BevelLine(Color1, Line1.LineStart, (Height div 2) - 1,
Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, (Height div 2), Line1.LineEnd);
end;
ltBottomLine:
begin
R := Rect(W1 + FBevelOffset,
Height - FS - (FS-Font.Size),
Width,
Height - 3);
Line1.LineStart := 0;
Line1.LineEnd := Width;
BevelLine(Color1, Line1.LineStart, Height - 2, Line1.LineEnd);
BevelLine(Color2, Line1.LineStart, Height - 1, Line1.LineEnd);
end;
end;
if Text <> '' then
begin
if not FEnabled then
begin
Brush.Style := bsClear;
OffsetRect(R, 1, 1);
Font.Color := FDisabledFontColor;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
OffsetRect(R, -1, -1);
Font.Color := FDisabledFontShadowColor;
Brush.Style := bsClear;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end
else
begin
Brush.Style := bsClear;
Font.Color := FEnabledFontColor;
DrawText(Handle, PChar(Text), Length(Text), R, Flags or
DT_CALCRECT);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end;
end;
end;
end;
end;
Line1.Free;
end;
end.
__________________________________________________
Do You Yahoo!?
Tired of spam? Yahoo! Mail has the best spam protection around
http://mail.yahoo.com
_______________________________________________
Delphi mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi
