You've already forked lazarus-ccr
ExCtrls: New component TShapeEx (text in shape)
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8484 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -12,7 +12,7 @@ procedure Register;
|
||||
implementation
|
||||
|
||||
uses
|
||||
ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo;
|
||||
ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo, ExShape;
|
||||
|
||||
{$R exctrlsreg.res}
|
||||
|
||||
@@ -21,7 +21,8 @@ begin
|
||||
RegisterComponents('ExCtrls', [
|
||||
TButtonEx, TCheckboxEx, TRadioButtonEx, TCheckGroupEx, TRadioGroupEx,
|
||||
TFloatSISpinEditEx, TCurrSpinEditEx,
|
||||
TColumnComboBoxEx, TCheckComboBoxEx
|
||||
TColumnComboBoxEx, TCheckComboBoxEx,
|
||||
TShapeEx
|
||||
]);
|
||||
end;
|
||||
|
||||
|
||||
Binary file not shown.
357
components/exctrls/source/exshape.pas
Normal file
357
components/exctrls/source/exshape.pas
Normal file
@@ -0,0 +1,357 @@
|
||||
unit ExShape;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Types, Graphics, Classes, SysUtils, ExtCtrls;
|
||||
|
||||
type
|
||||
TShapeText = class(TPersistent)
|
||||
private
|
||||
const
|
||||
cDefMargin = 8;
|
||||
private
|
||||
FShape: TShape;
|
||||
FHorAlignment: TAlignment;
|
||||
FHorMargin: Integer;
|
||||
FLines: TStrings;
|
||||
FVertAlignment: TVerticalAlignment;
|
||||
FVertMargin: Integer;
|
||||
function IsHorMarginStored: Boolean;
|
||||
function IsVertMarginStored: Boolean;
|
||||
procedure SetHorAlignment(const AValue: TAlignment);
|
||||
procedure SetHorMargin(const AValue: Integer);
|
||||
procedure SetLines(const AValue: TStrings);
|
||||
procedure SetVertAlignment(const AValue: TVerticalAlignment);
|
||||
procedure SetVertMargin(const AValue: Integer);
|
||||
protected
|
||||
procedure Changed(Sender: TObject); virtual;
|
||||
public
|
||||
constructor Create(AShape: TShape);
|
||||
destructor Destroy; override;
|
||||
procedure Assign(ASource: TPersistent); override;
|
||||
published
|
||||
property HorAlignment: TAlignment read FHorAlignment write SetHorAlignment default taCenter;
|
||||
property HorMargin: Integer read FHorMargin write SetHorMargin stored IsHorMarginStored;
|
||||
property Lines: TStrings read FLines write SetLines;
|
||||
property VertAlignment: TVerticalAlignment read FVertAlignment write SetVertAlignment default taVerticalCenter;
|
||||
property VertMargin: Integer read FVertMargin write SetVertMargin stored IsVertMarginStored;
|
||||
end;
|
||||
|
||||
{ TShapeEx}
|
||||
|
||||
TShapeEx = class(TShape)
|
||||
private
|
||||
FHeader: TShapeText;
|
||||
FHeaderFont: TFont;
|
||||
FText: TShapeText;
|
||||
procedure SetHeader(const AValue: TShapeText);
|
||||
procedure SetHeaderFont(const AValue: TFont);
|
||||
procedure SetText(const AValue: TShapeText); reintroduce;
|
||||
protected
|
||||
function DefaultPlaceText(AText: TShapeText): TPoint;
|
||||
procedure HeaderFontChanged(Sender: TObject);
|
||||
function MeasureText(AText: TShapeText): TSize;
|
||||
function TextFlags(AText: TShapeText): Integer;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure Paint; override;
|
||||
published
|
||||
property Header: TShapeText read FHeader write SetHeader;
|
||||
property HeaderFont: TFont read FHeaderFont write SetHeaderFont;
|
||||
property Text: TShapeText read FText write SetText;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLIntf, LCLType;
|
||||
|
||||
{ TShapeText }
|
||||
|
||||
constructor TShapeText.Create(AShape: TShape);
|
||||
begin
|
||||
inherited Create;
|
||||
FShape := AShape;
|
||||
FLines := TStringList.Create;
|
||||
FLines.SkipLastLineBreak := true;
|
||||
TStringList(FLines).OnChange := @Changed;
|
||||
FHorMargin := cDefMargin;
|
||||
FVertMargin := cDefMargin;
|
||||
FHorAlignment := taCenter;
|
||||
FVertAlignment := taVerticalCenter;
|
||||
end;
|
||||
|
||||
destructor TShapeText.Destroy;
|
||||
begin
|
||||
FLines.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TShapeText.Assign(ASource: TPersistent);
|
||||
begin
|
||||
if ASource is TShapeText then
|
||||
begin
|
||||
FLines.Assign(TShapeText(ASource).Lines);
|
||||
FHorAlignment := TShapeText(ASource).HorAlignment;
|
||||
FHorMargin := TShapeText(ASource).HorMargin;
|
||||
FVertAlignment := TShapeText(ASource).VertAlignment;
|
||||
FVertMargin := TShapeText(ASource).VertMargin;
|
||||
end else
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TShapeText.Changed(Sender: TObject);
|
||||
begin
|
||||
if FShape <> nil then
|
||||
FShape.Invalidate;
|
||||
end;
|
||||
|
||||
function TShapeText.IsHorMarginStored: Boolean;
|
||||
begin
|
||||
Result := FHorMargin <> cDefMargin;
|
||||
end;
|
||||
|
||||
function TShapeText.IsVertMarginStored: Boolean;
|
||||
begin
|
||||
Result := FVertMargin <> cDefMargin;
|
||||
end;
|
||||
|
||||
procedure TShapeText.SetHorAlignment(const AValue: TAlignment);
|
||||
begin
|
||||
if FHorAlignment <> AValue then
|
||||
begin
|
||||
FHorAlignment := AValue;
|
||||
Changed(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShapeText.SetHorMargin(const AValue: Integer);
|
||||
begin
|
||||
if FHorMargin <> AValue then
|
||||
begin
|
||||
FHorMargin := AValue;
|
||||
Changed(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShapeText.SetLines(const AValue: TStrings);
|
||||
begin
|
||||
if FLines.Text <> AValue.Text then
|
||||
begin
|
||||
FLines.Assign(AValue);
|
||||
FLines.SkipLastLineBreak := true;
|
||||
Changed(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShapeText.SetVertAlignment(const AValue: TVerticalAlignment);
|
||||
begin
|
||||
if FVertAlignment <> AValue then
|
||||
begin
|
||||
FVertAlignment := AValue;
|
||||
Changed(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShapeText.SetVertMargin(const AValue: Integer);
|
||||
begin
|
||||
if FVertMargin <> AValue then
|
||||
begin
|
||||
FVertMargin := AValue;
|
||||
Changed(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TShapeEx }
|
||||
|
||||
constructor TShapeEx.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
FHeader := TShapeText.Create(Self);
|
||||
FHeader.VertAlignment := taAlignTop;
|
||||
|
||||
FHeaderFont := TFont.Create;
|
||||
FHeaderFont.Style := [fsBold];
|
||||
FHeaderFont.OnChange := @HeaderFontChanged;
|
||||
|
||||
FText := TShapeText.Create(self);
|
||||
end;
|
||||
|
||||
destructor TShapeEx.Destroy;
|
||||
begin
|
||||
FText.Free;
|
||||
FHeader.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TShapeEx.DefaultPlaceText(AText: TShapeText): TPoint;
|
||||
var
|
||||
lSize: TSize;
|
||||
begin
|
||||
if AText.Lines.Text = '' then
|
||||
begin
|
||||
Result := Point(MaxInt, MaxInt);
|
||||
exit;
|
||||
end;
|
||||
|
||||
lSize := MeasureText(AText);
|
||||
case AText.HorAlignment of
|
||||
taLeftJustify: Result.X := AText.HorMargin;
|
||||
taCenter: Result.X := (ClientWidth - lSize.CX) div 2;
|
||||
taRightJustify: Result.X := ClientWidth - lSize.CX - AText.HorMargin;
|
||||
end;
|
||||
case AText.VertAlignment of
|
||||
taAlignTop: Result.Y := AText.VertMargin;
|
||||
taVerticalCenter: Result.Y := (ClientHeight - lSize.CY) div 2;
|
||||
taAlignBottom: Result.Y := ClientHeight - lSize.CY - AText.VertMargin;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShapeEx.HeaderFontChanged(Sender: TObject);
|
||||
begin
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
function TShapeEx.MeasureText(AText: TShapeText): TSize;
|
||||
var
|
||||
R: TRect;
|
||||
flags: Integer;
|
||||
s: String;
|
||||
begin
|
||||
s := AText.Lines.Text;
|
||||
if s = '' then
|
||||
begin
|
||||
Result := Size(0, 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
flags := DT_NOPREFIX or DT_CALCRECT or DT_WORDBREAK;
|
||||
if AText = FHeader then
|
||||
Canvas.Font.Assign(FHeaderFont)
|
||||
else
|
||||
Canvas.Font.Assign(Font);
|
||||
|
||||
R := Rect(0, 0, ClientWidth, 0);
|
||||
R.Right := R.Right - 2 * AText.HorMargin;
|
||||
DrawText(Canvas.Handle, PChar(s), Length(s), R, flags);
|
||||
Result := Size(R.Width, R.Height);
|
||||
end;
|
||||
|
||||
procedure TShapeEx.Paint;
|
||||
type
|
||||
TTextItem = (tiHeader, tiText);
|
||||
var
|
||||
P: array[TTextItem] of TPoint;
|
||||
s: array[TTextItem] of String;
|
||||
lSize: array[TTextItem] of TSize;
|
||||
flags: Integer;
|
||||
R: TRect;
|
||||
h, m: Integer;
|
||||
begin
|
||||
// Draw the shape itself
|
||||
inherited Paint;
|
||||
|
||||
s[tiHeader] := FHeader.Lines.Text;
|
||||
s[tiText] := FText.Lines.Text;
|
||||
|
||||
// Get text size
|
||||
lSize[tiHeader] := MeasureText(FHeader);
|
||||
lSize[tiText] := MeasureText(FText);
|
||||
|
||||
// Get default text positions
|
||||
P[tiHeader] := DefaultPlaceText(FHeader);
|
||||
P[tiText] := DefaultPlaceText(FText);
|
||||
|
||||
// Fix special cases of positioning
|
||||
if (s[tiHeader] <> '') and (s[tiText] <> '') then
|
||||
begin
|
||||
// Texts colliding at top
|
||||
if (FHeader.VertAlignment = taAlignTop) and (FText.VertAlignment = taAlignTop) then
|
||||
P[tiText].Y := P[tiHeader].Y + lSize[tiHeader].CY + P[tiText].Y
|
||||
else
|
||||
// Texts colliding at center
|
||||
if (FHeader.VertAlignment = taVerticalCenter) and (FText.VertAlignment = taVerticalCenter) then
|
||||
begin
|
||||
// Average margin value
|
||||
m := (FHeader.VertMargin + FText.VertMargin) div 2;
|
||||
// Combined height of header and text, with average margin
|
||||
h := lSize[tiHeader].CY + lSize[tiText].CY + m;
|
||||
P[tiHeader].Y := (ClientHeight - h) div 2;
|
||||
P[tiText].Y := P[tiHeader].Y + lSize[tiHeader].CY + m;
|
||||
end else
|
||||
// Texts colliding at bottom
|
||||
if (FHeader.VertAlignment = taAlignBottom) and (FText.VertAlignment = taAlignBottom) then
|
||||
P[tiText].Y := P[tiHeader].Y - lSize[tiText].CY - FText.VertMargin
|
||||
else
|
||||
// Adjust centered Text when header is at top or bottom
|
||||
if (FText.VertAlignment = taVerticalCenter) then
|
||||
begin
|
||||
// Vertically available space without header
|
||||
h := ClientHeight - FHeader.VertMargin - lSize[tiHeader].CY;
|
||||
if (FHeader.VertAlignment = taAlignTop) then
|
||||
P[tiText].Y := P[tiHeader].Y + lSize[tiHeader].CY + (h - lSize[tiText].CY) div 2
|
||||
else
|
||||
if (FHeader.VertAlignment = taAlignBottom) then // Keep header at bottom to become a footer
|
||||
P[tiText].Y := (h - lSize[tiText].CY) div 2;
|
||||
end;
|
||||
end;
|
||||
|
||||
Canvas.Brush.Style := bsClear;
|
||||
flags := DT_NOPREFIX or DT_WORDBREAK;
|
||||
|
||||
// Draw the header
|
||||
Canvas.Font.Assign(FHeaderFont);
|
||||
R.TopLeft := Point(0, 0);
|
||||
R.BottomRight := TPoint(lSize[tiHeader]);
|
||||
OffsetRect(R, P[tiHeader].X, P[tiHeader].Y);
|
||||
DrawText(Canvas.Handle, PChar(s[tiHeader]), Length(s[tiHeader]), R, flags or TextFlags(FHeader));
|
||||
|
||||
// Draw the text
|
||||
Canvas.Font.Assign(Font);
|
||||
R.TopLeft := Point(0, 0);
|
||||
R.BottomRight := TPoint(lSize[tiText]);
|
||||
OffsetRect(R, P[tiText].X, P[tiText].Y);
|
||||
DrawText(Canvas.Handle, PChar(s[tiText]), Length(s[tiText]), R, flags or TextFlags(FText));
|
||||
end;
|
||||
|
||||
procedure TShapeEx.SetHeader(const AValue: TShapeText);
|
||||
begin
|
||||
FHeader.Assign(AValue);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TShapeEx.SetHeaderFont(const AValue: TFont);
|
||||
begin
|
||||
FHeaderFont.Assign(AValue);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TShapeEx.SetText(const AValue: TShapeText);
|
||||
begin
|
||||
FText.Assign(AValue);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
function TShapeEx.TextFlags(AText: TShapeText): Integer;
|
||||
begin
|
||||
case AText.HorAlignment of
|
||||
taLeftJustify: Result := DT_LEFT;
|
||||
taCenter: Result := DT_CENTER;
|
||||
taRightJustify: Result := DT_RIGHT;
|
||||
end;
|
||||
case AText.VertAlignment of
|
||||
taAlignTop: Result := Result or DT_TOP;
|
||||
taVerticalCenter: Result := Result or DT_VCENTER;
|
||||
taAlignBottom: Result := Result or DT_BOTTOM;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user