git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@8 05c56307-c608-d34a-929d-697000501d7a
1167 lines
37 KiB
ObjectPascal
1167 lines
37 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressPrinting System(tm) COMPONENT SUITE }
|
|
{ }
|
|
{ Copyright (C) 1998-2007 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSPRINTINGSYSTEM AND }
|
|
{ ALL ACCOMPANYING VCL CONTROLS AS PART OF AN }
|
|
{ EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
|
|
unit dxPSTextOut;
|
|
|
|
interface
|
|
|
|
{$I cxVer.inc}
|
|
|
|
uses
|
|
Windows, Classes, Graphics, {$IFDEF DELPHI5} Contnrs, {$ENDIF} dxPSGlbl;
|
|
|
|
{type
|
|
TdxTextAlignX = (taLeft, taCenterX, taRight, taJustifyX, taDistributeX);
|
|
TdxTextAlignY = (taTop, taCenterY, taBottom, taDistributeY);}
|
|
|
|
const
|
|
DXTO_LEFT = $00000000;
|
|
DXTO_CENTER_HORIZONTALLY = $00000001;
|
|
DXTO_RIGHT = $00000002;
|
|
DXTO_JUSTIFY_HORIZONTALLY = $00000003;
|
|
DXTO_DISTRIBUTE_HORIZONTALLY = $00000004;
|
|
|
|
DXTO_TOP = $00000000;
|
|
DXTO_CENTER_VERTICALLY = $00000010;
|
|
DXTO_BOTTOM = $00000020;
|
|
DXTO_DISTRIBUTE_VERTICALLY = $00000030;
|
|
|
|
DXTO_WORDBREAK = $00000100;
|
|
DXTO_SINGLELINE = $00000200;
|
|
DXTO_EXPANDTABS = $00000400;
|
|
DXTO_END_ELLIPSIS = $00000800;
|
|
|
|
DXTO_PATTERNEDTEXT = $00001000;
|
|
DXTO_EXTERNALLEADING = $00002000;
|
|
DXTO_EDITCONTROL = $00004000;
|
|
DXTO_NOCLIP = $00008000;
|
|
|
|
DXTO_AUTOINDENTS = $00010000;
|
|
DXTO_CHARBREAK = $00020000;
|
|
DXTO_PREVENT_LEFT_EXCEED = $00040000;
|
|
DXTO_PREVENT_TOP_EXCEED = $00080000;
|
|
|
|
DXTO_CALCRECT = $00100000;
|
|
DXTO_CALCROWCOUNT = $00200000;
|
|
|
|
DXTO_NOPREFIX = $00000000;
|
|
DXTO_HIDEPREFIX = $01000000;
|
|
|
|
DXTO_DEFAULT_FORMAT = DXTO_AUTOINDENTS or DXTO_PATTERNEDTEXT;
|
|
|
|
type
|
|
TdxVerticalTextOutDirection = (vtdTopToBottom, vtdBottomToTop);
|
|
|
|
TdxTextParams = record
|
|
RowHeight: Integer;
|
|
tmExternalLeading: Integer;
|
|
FullRowHeight: Integer;
|
|
OnePixel: Integer;
|
|
EndEllipsisWidth: Integer;
|
|
BreakChar: Char;
|
|
Bold: Boolean;
|
|
TextAlignX: TdxTextAlignX;
|
|
TextAlignY: TdxTextAlignY;
|
|
WordBreak: Boolean;
|
|
SingleLine: Boolean;
|
|
ExpandTabs: Boolean;
|
|
EndEllipsis: Boolean;
|
|
PatternedText: Boolean;
|
|
ExternalLeading: Boolean;
|
|
EditControl: Boolean;
|
|
NoClip: Boolean;
|
|
AutoIndents: Boolean;
|
|
PreventLeftExceed: Boolean;
|
|
PreventTopExceed: Boolean;
|
|
CharBreak: Boolean;
|
|
CalcRowCount: Boolean;
|
|
CalcRect: Boolean;
|
|
HidePrefix: Boolean;
|
|
end;
|
|
|
|
TdxTextRow = class
|
|
public
|
|
Text: PChar;
|
|
CharCount: Integer;
|
|
TextExtents: TSize;
|
|
BreakCount: Integer;
|
|
TextOriginX: Integer;
|
|
TextOriginY: Integer;
|
|
procedure CalculateExtents(DC: HDC; const ATextParams: TdxTextParams); virtual;
|
|
end;
|
|
|
|
TdxTextRows = class({$IFDEF DELPHI5}TObjectList{$ELSE}TList{$ENDIF})
|
|
private
|
|
function GetItem(Index: Integer): TdxTextRow;
|
|
procedure SetItem(Index: Integer; Value: TdxTextRow);
|
|
public
|
|
function CalculateMaxWidth: Integer;
|
|
{$IFNDEF DELPHI5}
|
|
procedure Clear; override;
|
|
{$ENDIF}
|
|
property Items[Index: Integer]: TdxTextRow read GetItem write SetItem; default;
|
|
end;
|
|
|
|
|
|
function dxCalcTextParams(DC: HDC; AFormat: DWORD; const ALineSpacingFactor: Double = 1.0): TdxTextParams;
|
|
function dxCalcTextExtents(DC: HDC; AText: PChar; ATextLength: Integer; AExpandTabs: Boolean): TSize;
|
|
function dxMakeFormat(ATextAlignX: TdxTextAlignX; ATextAlignY: TdxTextAlignY): DWORD;
|
|
function dxMakeTextRows(DC: HDC; const Source: string; const R: TRect;
|
|
const ATextParams: TdxTextParams): TdxTextRows;
|
|
procedure dxPlaceTextRows(DC: HDC; const R: TRect; var ATextParams: TdxTextParams;
|
|
ATextRows: TdxTextRows; ARowCount: Integer);
|
|
function dxPrepareRect(const R: TRect; const ATextParams: TdxTextParams;
|
|
ALeftIndent: Integer = 0; ARightIndent: Integer = 0): TRect;
|
|
procedure dxTextRowsOut(DC: HDC; const R: TRect; const ATextParams: TdxTextParams;
|
|
ATextRows: TdxTextRows; ARowCount: Integer);
|
|
|
|
function dxTextOut(DC: HDC; S: string; var R: TRect; AFormat: DWORD;
|
|
AFont: TFont = nil; AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0;
|
|
ARightIndent: Integer = 0; ATextColor: TColor = clDefault; // -> current TextColor is used
|
|
const ALineSpacingFactor: Double = 1.0): Integer;
|
|
|
|
procedure dxRotatedTextOut(DC: HDC; const ABounds: TRect; const AText: string; AFont: TFont;
|
|
AAlignHorz: TdxTextAlignX = taCenterX; AAlignVert: TdxTextAlignY = taCenterY; AWordBreak: Boolean = True;
|
|
ALeftExceed: Boolean = True; ARightExceed: Boolean = True; ADirection: TdxVerticalTextOutDirection = vtdBottomToTop;
|
|
AFontSize: Integer = 0);
|
|
|
|
const
|
|
dxEndEllipsisChars = '...';
|
|
dxMinVisuallyVisibleTextHeight = 6;
|
|
dxTextSpace = 2;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, cxClasses, cxGraphics, dxPSUtl;
|
|
|
|
function GetTabbedTextExtent(hDC: HDC; lpString: PChar; nCount, nTabPositions: Integer;
|
|
lpnTabStopPositions: Pointer): DWORD; stdcall; external user32 name 'GetTabbedTextExtentA';
|
|
function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar; nCount, nTabPositions: Integer;
|
|
lpnTabStopPositions: Pointer; nTabOrigin: Integer): Longint; stdcall; external user32 name 'TabbedTextOutA';
|
|
|
|
const
|
|
Tab: Char = #9;
|
|
CR: Char = #13;
|
|
LF: Char = #10;
|
|
|
|
DXTO_HORZ_ALIGN_MASK = DXTO_CENTER_HORIZONTALLY or DXTO_RIGHT or DXTO_JUSTIFY_HORIZONTALLY or DXTO_DISTRIBUTE_HORIZONTALLY;
|
|
DXTO_VERT_ALIGN_MASK = DXTO_CENTER_VERTICALLY or DXTO_BOTTOM or DXTO_DISTRIBUTE_VERTICALLY;
|
|
DXTO_VERT_ALIGN_OFFSET = 4;
|
|
|
|
var
|
|
FillPatterns: array[Boolean] of HBRUSH;
|
|
|
|
{ TdxTextRow }
|
|
|
|
procedure TdxTextRow.CalculateExtents(DC: HDC; const ATextParams: TdxTextParams);
|
|
begin
|
|
TextExtents := dxCalcTextExtents(DC, Text, CharCount, ATextParams.ExpandTabs);
|
|
end;
|
|
|
|
{ TdxTextRows }
|
|
|
|
function TdxTextRows.CalculateMaxWidth: Integer;
|
|
var
|
|
I, V: Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
V := Items[I].TextExtents.cX;
|
|
if V > Result then Result := V;
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF DELPHI5}
|
|
procedure TdxTextRows.Clear;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
Items[I].Free;
|
|
inherited;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TdxTextRows.GetItem(Index: Integer): TdxTextRow;
|
|
begin
|
|
Result := TdxTextRow(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TdxTextRows.SetItem(Index: Integer; Value: TdxTextRow);
|
|
begin
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
{ utility routines }
|
|
|
|
function CreateTextRow(DC: HDC; var Source: PChar; var ALength: Integer;
|
|
AWidth: Integer; AIsLastRow: Boolean; const ATextParams: TdxTextParams): TdxTextRow;
|
|
|
|
function GetCharAt(P: PChar; ACharIndex: Integer; ACharSize: Integer): Char;
|
|
begin
|
|
Result := P[ACharIndex];
|
|
end;
|
|
|
|
function CharIsBreak(Ch: Char): Boolean; overload;
|
|
begin
|
|
Result := (Ch = ATextParams.BreakChar) or (Ch = Tab);
|
|
end;
|
|
|
|
function CharIsBreak(P: PChar; ACharIndex: Integer; ACharSize: Integer): Boolean; overload;
|
|
begin
|
|
Result := CharIsBreak(GetCharAt(P, ACharIndex, ACharSize));
|
|
end;
|
|
|
|
procedure IncPChar(var P: PChar; AnOffset: Integer);
|
|
begin
|
|
Inc(P, AnOffset);
|
|
end;
|
|
|
|
var
|
|
R: TRect;
|
|
TotalTextWidth, BreakPos, CharSize, I: Integer;
|
|
PDBCSSource: PChar;
|
|
BreakByWords, BreakByChars, IsSpecialProcessedRow, HasCRSequence: Boolean;
|
|
Ch: Char;
|
|
Size: TSize;
|
|
begin
|
|
Result := TdxTextRow.Create;
|
|
if Source = nil then Exit;
|
|
|
|
TotalTextWidth := 0;
|
|
BreakPos := -1;
|
|
CharSize := 1;
|
|
PDBCSSource := Source;
|
|
|
|
with ATextParams do
|
|
begin
|
|
BreakByWords := not SingleLine and (WordBreak or (TextAlignX in [taJustifyX, taDistributeX]));
|
|
BreakByChars := BreakByWords and CharBreak;
|
|
IsSpecialProcessedRow := not NoClip and not (TextAlignX in [taJustifyX, taDistributeX]) and AIsLastRow and EndEllipsis;
|
|
end;
|
|
|
|
with Result do
|
|
begin
|
|
for I := 0 to ALength - 1 do
|
|
begin
|
|
if SysLocale.FarEast then
|
|
begin
|
|
CharSize := cxStrCharLength(PDBCSSource);
|
|
if StrByteType(Source, I) = mbTrailByte then
|
|
Continue;
|
|
Inc(PDBCSSource, CharSize);
|
|
end;
|
|
CharCount := I + 1 + CharSize - 1 ;
|
|
|
|
Ch := GetCharAt(Source, I, CharSize);
|
|
|
|
if CharIsBreak(Ch) then
|
|
begin
|
|
Inc(BreakCount);
|
|
BreakPos := I;
|
|
end;
|
|
|
|
//todo: DB53862
|
|
if ((Ch = CR) or (Ch = LF)) {and not IsSpecialProcessedRow and not ATextParams.SingleLine} then
|
|
begin
|
|
Dec(CharCount);
|
|
if ATextParams.TextAlignX = taJustifyX then BreakCount := 0;
|
|
Break;
|
|
end;
|
|
|
|
if BreakByWords or IsSpecialProcessedRow or ATextParams.SingleLine then
|
|
begin
|
|
if not ATextParams.ExpandTabs then
|
|
begin
|
|
Windows.GetTextExtentPoint32(DC, @Ch, CharSize, Size);
|
|
Inc(TotalTextWidth, Size.cX);
|
|
end
|
|
else
|
|
begin
|
|
if AWidth > High(Word) then
|
|
begin
|
|
R := NullRect;
|
|
DrawText(DC, Source, CharCount, R,
|
|
DT_SINGLELINE or DT_NOPREFIX or DT_CALCRECT or DT_EXPANDTABS);
|
|
TotalTextWidth := R.Right - R.Left;
|
|
end
|
|
else
|
|
TotalTextWidth := LoWord(GetTabbedTextExtent(DC, Source, CharCount, 0, nil));
|
|
end;
|
|
|
|
if TotalTextWidth >= AWidth then
|
|
begin
|
|
if ATextParams.SingleLine or IsSpecialProcessedRow or
|
|
((TotalTextWidth = AWidth) and ((I = ALength - 1) or CharIsBreak(Source, I + 1, CharSize))) then
|
|
Break
|
|
else
|
|
if (BreakPos <> -1) then//and ((TotalTextWidth > AWidth) or ATextParams.CalcRect) then
|
|
begin
|
|
if not ATextParams.CalcRect then
|
|
CharCount := BreakPos + 1;
|
|
Break;
|
|
end
|
|
else
|
|
if BreakByChars then
|
|
begin
|
|
if (TotalTextWidth > AWidth) and (CharCount > CharSize) then
|
|
Dec(CharCount, CharSize);
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
Text := Source;
|
|
|
|
// truncate trailing spaces
|
|
if ATextParams.TextAlignX in [taJustifyX, taDistributeX] then
|
|
while (CharCount > 0) and CharIsBreak(Source, CharCount - 1, CharSize) do
|
|
begin
|
|
if BreakCount > 0 then Dec(BreakCount);
|
|
Dec(CharCount, CharSize );
|
|
end;
|
|
end;
|
|
|
|
Result.CalculateExtents(DC, ATextParams);
|
|
|
|
HasCRSequence := False;
|
|
IncPChar(Source, Result.CharCount);
|
|
Dec(ALength, Result.CharCount);
|
|
I := 0;
|
|
while (I < ALength) and (GetCharAt(Source, I, CharSize) = ATextParams.BreakChar) do
|
|
Inc(I);
|
|
if I < ALength then
|
|
begin
|
|
if GetCharAt(Source, I, CharSize) = Tab then Inc(I);
|
|
HasCRSequence := GetCharAt(Source, I, CharSize) = CR;
|
|
if GetCharAt(Source, I, CharSize) = CR then Inc(I);
|
|
if GetCharAt(Source, I, CharSize) = LF then Inc(I);
|
|
end;
|
|
IncPChar(Source, I);
|
|
Dec(ALength, I);
|
|
|
|
// doesn't justify last row like Excel does?
|
|
if ((ALength = 0) or HasCRSequence) and (ATextParams.TextAlignX = taJustifyX) then
|
|
Result.BreakCount := 0;
|
|
end;
|
|
|
|
function dxCalcTextParams(DC: HDC; AFormat: DWORD; const ALineSpacingFactor: Double = 1.0): TdxTextParams;
|
|
var
|
|
TextMetric: TTextMetric;
|
|
R: TRect;
|
|
begin
|
|
FillChar(Result, SizeOf(Result), 0);
|
|
GetTextMetrics(DC, TextMetric);
|
|
with Result do
|
|
begin
|
|
BreakChar := TextMetric.tmBreakChar;
|
|
RowHeight := dxCalcTextExtents(DC, 'Wg', 2, False).cY;
|
|
Bold := TextMetric.tmWeight >= FW_BOLD;
|
|
|
|
TextAlignX := TdxTextAlignX(AFormat and DXTO_HORZ_ALIGN_MASK);
|
|
TextAlignY := TdxTextAlignY(AFormat and DXTO_VERT_ALIGN_MASK shr DXTO_VERT_ALIGN_OFFSET);
|
|
|
|
AutoIndents := AFormat and DXTO_AUTOINDENTS <> 0;
|
|
CalcRect := AFormat and DXTO_CALCRECT <> 0;
|
|
CalcRowCount := AFormat and DXTO_CALCROWCOUNT <> 0;
|
|
CharBreak := (AFormat and DXTO_CHARBREAK <> 0) or SysLocale.FarEast;
|
|
EditControl := AFormat and DXTO_EDITCONTROL <> 0;
|
|
EndEllipsis := AFormat and DXTO_END_ELLIPSIS <> 0;
|
|
ExternalLeading := AFormat and DXTO_EXTERNALLEADING <> 0;
|
|
ExpandTabs := AFormat and DXTO_EXPANDTABS <> 0;
|
|
NoClip := AFormat and DXTO_NOCLIP <> 0;
|
|
PatternedText := AFormat and DXTO_PATTERNEDTEXT <> 0;
|
|
PreventLeftExceed := AFormat and DXTO_PREVENT_LEFT_EXCEED <> 0;
|
|
PreventTopExceed := AFormat and DXTO_PREVENT_TOP_EXCEED <> 0;
|
|
SingleLine := AFormat and DXTO_SINGLELINE <> 0;
|
|
WordBreak := AFormat and DXTO_WORDBREAK <> 0;
|
|
HidePrefix := AFormat and DXTO_HIDEPREFIX <> 0;
|
|
|
|
R := Rect(0, 0, 1, 1);
|
|
DPtoLP(DC, R, 2);
|
|
OnePixel := R.Right - R.Left;
|
|
|
|
if ExternalLeading then
|
|
tmExternalLeading := TextMetric.tmExternalLeading;
|
|
FullRowHeight := Round((RowHeight + tmExternalLeading) * ALineSpacingFactor);
|
|
|
|
if PatternedText then
|
|
begin
|
|
R := Rect(0, 0, dxMinVisuallyVisibleTextHeight, dxMinVisuallyVisibleTextHeight);
|
|
DPtoLP(DC, R, 2);
|
|
PatternedText := RowHeight < R.Bottom - R.Top;
|
|
end;
|
|
|
|
EndEllipsisWidth := dxCalcTextExtents(DC, dxEndEllipsisChars, Length(dxEndEllipsisChars), False).cX;
|
|
end;
|
|
end;
|
|
|
|
|
|
function dxCalcTextExtents(DC: HDC; AText: PChar; ATextLength: Integer;
|
|
AExpandTabs: Boolean): TSize;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if AExpandTabs then
|
|
begin
|
|
{ //todo: CB41669 textextent.cx can greate then max of LoWord
|
|
V := GetTabbedTextExtent(DC, AText, ATextLength, 0, nil);
|
|
Result.cX := LoWord(V);
|
|
Result.cY := HiWord(V);}
|
|
R := Rect(0, 0, 0, 0);
|
|
DrawText(DC, AText, ATextLength, R, DT_SINGLELINE or DT_NOPREFIX or DT_CALCRECT or DT_EXPANDTABS);
|
|
Result.cx := R.Right - R.Left;
|
|
Result.cy := R.Bottom - R.Right;
|
|
end
|
|
else
|
|
GetTextExtentPoint32(DC, AText, ATextLength, Result);
|
|
end;
|
|
|
|
|
|
function dxMakeFormat(ATextAlignX: TdxTextAlignX; ATextAlignY: TdxTextAlignY): DWORD;
|
|
begin
|
|
Result := Byte(ATextAlignX) or (Byte(ATextAlignY) shl DXTO_VERT_ALIGN_OFFSET);
|
|
end;
|
|
|
|
function dxMakeTextRows(DC: HDC; const Source: string; const R: TRect; const ATextParams: TdxTextParams): TdxTextRows;
|
|
|
|
function CheckIsLastRow(ATotalHeight, H: Integer): Boolean;
|
|
begin
|
|
with ATextParams do
|
|
if SingleLine then
|
|
Result := True
|
|
else
|
|
if (R.Bottom <> MaxInt) and (TextAlignY = taTop) and not CalcRect then
|
|
begin
|
|
if (EditControl{ or EndEllipsis}) and not NoClip then
|
|
Result := ATotalHeight + FullRowHeight > H
|
|
else
|
|
Result := ATotalHeight > H
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
var
|
|
P: PChar;
|
|
TextRow: TdxTextRow;
|
|
IsLastRow: Boolean;
|
|
TotalHeight, L, H, W: Integer;
|
|
begin
|
|
if (Source <> '') and (Source[1] <> #0) then
|
|
begin
|
|
P := Pointer(Source);
|
|
Result := TdxTextRows.Create;
|
|
if ATextParams.CalcRect and ATextParams.SingleLine then
|
|
begin
|
|
TextRow := TdxTextRow.Create;
|
|
TextRow.Text := P;
|
|
TextRow.CharCount := Length(Source);
|
|
TextRow.CalculateExtents(DC, ATextParams);
|
|
Result.Add(TextRow);
|
|
end
|
|
else
|
|
begin
|
|
IsLastRow := False;
|
|
TotalHeight := 0;
|
|
L := Length(Source);
|
|
W := R.Right - R.Left;
|
|
H := R.Bottom - R.Top;
|
|
|
|
while (P^ <> #0) and not IsLastRow do
|
|
begin
|
|
Inc(TotalHeight, ATextParams.FullRowHeight);
|
|
IsLastRow := CheckIsLastRow(TotalHeight, H);
|
|
TextRow := CreateTextRow(DC, P, L, W, IsLastRow, ATextParams);
|
|
Result.Add(TextRow);
|
|
if not IsLastRow then IsLastRow := L = 0;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure dxPlaceTextRows(DC: HDC; const R: TRect; var ATextParams: TdxTextParams;
|
|
ATextRows: TdxTextRows; ARowCount: Integer);
|
|
|
|
procedure CalcExtraAndTopRowOffset(out AExtra, ATopRowOffset: Integer);
|
|
var
|
|
H: Integer;
|
|
begin
|
|
AExtra := 0;
|
|
with ATextParams do
|
|
begin
|
|
if (ARowCount > 1) and (TextAlignY = taDistributeY) then
|
|
begin
|
|
H := R.Bottom - R.Top;
|
|
Dec(H, RowHeight);
|
|
if H / (ARowCount - 1) > RowHeight then
|
|
begin
|
|
FullRowHeight := H div (ARowCount - 1);
|
|
AExtra := H mod (ARowCount - 1);
|
|
end;
|
|
end;
|
|
|
|
case TextAlignY of
|
|
taCenterY:
|
|
ATopRowOffset := R.Top + (R.Bottom - R.Top - ARowCount * FullRowHeight) div 2;
|
|
taBottom:
|
|
ATopRowOffset := R.Bottom - ARowCount * FullRowHeight + tmExternalLeading;
|
|
else
|
|
ATopRowOffset := R.Top;
|
|
end;
|
|
|
|
if PreventTopExceed and (ATopRowOffset < R.Top) then
|
|
ATopRowOffset := R.Top;
|
|
end;
|
|
end;
|
|
|
|
procedure PlaceRows(AExtra, ATopRowOffset: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to ARowCount - 1 do
|
|
with ATextRows[I] do
|
|
begin
|
|
// Horizontally
|
|
case ATextParams.TextAlignX of
|
|
taCenterX:
|
|
TextOriginX := R.Left + (R.Right - R.Left - TextExtents.cX) div 2;
|
|
taRight:
|
|
TextOriginX := R.Right - TextExtents.cX;
|
|
else
|
|
TextOriginX := R.Left;
|
|
end;
|
|
if ATextParams.PreventLeftExceed and (TextOriginX < R.Left) then
|
|
TextOriginX := R.Left;
|
|
|
|
// Vertically
|
|
TextOriginY := ATopRowOffset;
|
|
Inc(ATopRowOffset, ATextParams.FullRowHeight);
|
|
if AExtra > 0 then
|
|
begin
|
|
Inc(ATopRowOffset);
|
|
Dec(AExtra);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Extra, TopRowOffset: Integer;
|
|
begin
|
|
CalcExtraAndTopRowOffset(Extra, TopRowOffset);
|
|
PlaceRows(Extra, TopRowOffset);
|
|
end;
|
|
|
|
function dxPrepareRect(const R: TRect; const ATextParams: TdxTextParams;
|
|
ALeftIndent, ARightIndent: Integer): TRect;
|
|
begin
|
|
Result := R;
|
|
with Result, ATextParams do
|
|
begin
|
|
if AutoIndents then
|
|
InflateRect(Result, -dxTextSpace * OnePixel, -dxTextSpace * OnePixel);
|
|
Inc(Left, ALeftIndent * OnePixel);
|
|
Dec(Right, ARightIndent * OnePixel);
|
|
end;
|
|
end;
|
|
|
|
function dxUnprepareRect(const R: TRect; const ATextParams: TdxTextParams;
|
|
ALeftIndent: Integer = 0; ARightIndent: Integer = 0): TRect;
|
|
begin
|
|
Result := R;
|
|
with Result, ATextParams do
|
|
begin
|
|
Dec(Left, ALeftIndent * OnePixel);
|
|
Inc(Right, ARightIndent * OnePixel);
|
|
if AutoIndents then
|
|
InflateRect(Result, dxTextSpace * OnePixel, dxTextSpace * OnePixel);
|
|
end;
|
|
end;
|
|
|
|
procedure dxTextRowsOut(DC: HDC; const R: TRect; const ATextParams: TdxTextParams;
|
|
ATextRows: TdxTextRows; ARowCount: Integer);
|
|
|
|
procedure OutTextRowAsPattern(const ATextRow: TdxTextRow; R: TRect);
|
|
var
|
|
BkColor: COLORREF;
|
|
begin
|
|
InflateRect(R, 0, -ATextParams.OnePixel);
|
|
with R do
|
|
begin
|
|
if Bottom <= Top then
|
|
Bottom := Top + ATextParams.OnePixel;
|
|
Left := ATextRow.TextOriginX;
|
|
if Right > Left + ATextRow.TextExtents.cX then
|
|
Right := Left + ATextRow.TextExtents.cX;
|
|
end;
|
|
|
|
BkColor := SetBkColor(DC, ColorToRGB(clWindow));
|
|
FillRect(DC, R, FillPatterns[ATextParams.Bold]);
|
|
SetBkColor(DC, BkColor);
|
|
end;
|
|
|
|
procedure OutTextRow(const ATextRow: TdxTextRow);
|
|
begin
|
|
with ATextRow do
|
|
if ATextParams.ExpandTabs then
|
|
TabbedTextOut(DC, TextOriginX, TextOriginY, Text, CharCount, 0, nil, 0)
|
|
else
|
|
ExtTextOut(DC, TextOriginX, TextOriginY, 0, nil, Text, CharCount, nil);
|
|
end;
|
|
|
|
procedure PrepareEndEllipsis(var ATextRow: TdxTextRow; var AWidth: Integer);
|
|
var
|
|
CharNumber: Integer;
|
|
Size: TSize;
|
|
begin
|
|
Dec(AWidth, ATextParams.EndEllipsisWidth);
|
|
if AWidth < 0 then AWidth := 0;
|
|
with ATextRow do
|
|
begin
|
|
GetTextExtentExPoint(DC, Text, CharCount, AWidth, @CharNumber, nil, Size);
|
|
if CharNumber = 0 then Inc(CharNumber);
|
|
CharCount := CharNumber;
|
|
end;
|
|
ATextRow.CalculateExtents(DC, ATextParams);
|
|
end;
|
|
|
|
procedure OutEndEllipsis(const ATextRow: TdxTextRow; var ARowRect: TRect);
|
|
var
|
|
fuOptions: UINT;
|
|
begin
|
|
Inc(ARowRect.Left, ATextRow.TextExtents.cX);
|
|
if ARowRect.Left < ARowRect.Right then
|
|
begin
|
|
fuOptions := 0;
|
|
if not ATextParams.NoClip and (ARowRect.Left + ATextParams.EndEllipsisWidth > ARowRect.Right) then
|
|
fuOptions := ETO_CLIPPED;
|
|
ExtTextOut(DC, ARowRect.Left, ATextRow.TextOriginY, fuOptions, @ARowRect,
|
|
dxEndEllipsisChars, Length(dxEndEllipsisChars), nil);
|
|
end;
|
|
end;
|
|
|
|
function IntersectClipRect(const R: TRect): HRGN;
|
|
begin
|
|
Result := CreateRectRgn(0, 0, 0, 0);
|
|
if GetClipRgn(DC, Result) = -1 then
|
|
begin
|
|
DeleteObject(Result);
|
|
Result := 0;
|
|
end;
|
|
with R do
|
|
Windows.IntersectClipRect(DC, Left, Top, Right, Bottom);
|
|
end;
|
|
|
|
procedure RestoreClipRgn(var ARgn: HRGN);
|
|
begin
|
|
SelectClipRgn(DC, ARgn);
|
|
if ARgn <> 0 then
|
|
begin
|
|
DeleteObject(ARgn);
|
|
ARgn := 0
|
|
end;
|
|
end;
|
|
|
|
var
|
|
RowRect: TRect;
|
|
W, I, BreakExtra, PrevBkMode: Integer;
|
|
NeedClipping, NeedEndEllipsis: Boolean;
|
|
TextRow: TdxTextRow;
|
|
AClipRgn: HRGN;
|
|
AIsMetaFile: Boolean;
|
|
begin
|
|
W := R.Right - R.Left;
|
|
RowRect := R;
|
|
AIsMetaFile := IsMetaFileDC(DC);
|
|
AClipRgn := 0;
|
|
PrevBkMode := SetBkMode(DC, Windows.TRANSPARENT);
|
|
for I := 0 to ARowCount - 1 do
|
|
begin
|
|
TextRow := ATextRows[I];
|
|
with TextRow, ATextParams do
|
|
begin
|
|
if CharCount <> 0 then
|
|
begin
|
|
RowRect.Top := TextOriginY;
|
|
RowRect.Bottom := RowRect.Top + FullRowHeight;
|
|
if RectVisible(DC, RowRect) then
|
|
begin
|
|
if PatternedText then
|
|
OutTextRowAsPattern(TextRow, RowRect)
|
|
else
|
|
begin
|
|
NeedEndEllipsis := EndEllipsis and (TextExtents.cX > W) and (I = ARowCount - 1);
|
|
|
|
BreakExtra := 0;
|
|
if (TextAlignX in [taJustifyX, taDistributeX]) and not NeedEndEllipsis then
|
|
begin
|
|
BreakExtra := W - TextExtents.cX;
|
|
if (BreakCount <> 0) and (BreakExtra > 0) then
|
|
SetTextJustification(DC, BreakExtra, BreakCount);
|
|
end;
|
|
|
|
NeedClipping := not NoClip and ((TextExtents.cX > W) or (RowRect.Top < R.Top) or (RowRect.Bottom > R.Bottom));
|
|
|
|
if NeedClipping then
|
|
begin
|
|
if RowRect.Top < R.Top then RowRect.Top := R.Top;
|
|
if RowRect.Bottom > R.Bottom then RowRect.Bottom := R.Bottom;
|
|
if not AIsMetaFile then
|
|
AClipRgn := IntersectClipRect(RowRect);
|
|
end;
|
|
|
|
if NeedEndEllipsis then PrepareEndEllipsis(TextRow, W);
|
|
OutTextRow(TextRow);
|
|
if NeedEndEllipsis then OutEndEllipsis(TextRow, RowRect);
|
|
|
|
if NeedClipping and not AIsMetaFile then
|
|
RestoreClipRgn(AClipRgn);
|
|
|
|
if BreakExtra > 0 then SetTextJustification(DC, 0, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
SetBkMode(DC, PrevBkMode);
|
|
end;
|
|
|
|
function dxTextOut(DC: HDC; S: string; var R: TRect; AFormat: DWORD;
|
|
AFont: TFont = nil; AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0;
|
|
ARightIndent: Integer = 0; ATextColor: TColor = clDefault;
|
|
const ALineSpacingFactor: Double = 1.0): Integer;
|
|
|
|
function ProcessText(const ATextParams: TdxTextParams; const ATextRect: TRect): Boolean;
|
|
begin
|
|
if ATextParams.CalcRect then
|
|
Result := (ATextRect.Right - ATextRect.Left) > 0
|
|
else
|
|
Result := not IsRectEmpty(ATextRect);
|
|
end;
|
|
|
|
procedure DoHidePrefix(var S: string);
|
|
const
|
|
Ampersand: Char = '&';
|
|
var
|
|
ItWasAmpersand: Boolean;
|
|
I: Integer;
|
|
begin
|
|
ItWasAmpersand := False;
|
|
I := 1;
|
|
while I <= Length(S) do
|
|
if S[I] = Ampersand then
|
|
begin
|
|
if not ItWasAmpersand then
|
|
Delete(S, I, 1)
|
|
else
|
|
Inc(I);
|
|
ItWasAmpersand := not ItWasAmpersand;
|
|
end
|
|
else
|
|
begin
|
|
ItWasAmpersand := False;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
PrevFont: HFONT;
|
|
PrevFontColor: COLORREF;
|
|
TextHeight: Integer;
|
|
TextParams: TdxTextParams;
|
|
TextRect: TRect;
|
|
TextRows: TdxTextRows;
|
|
RowCount: Integer;
|
|
begin
|
|
PrevFont := GetCurrentObject(DC, OBJ_FONT);
|
|
PrevFontColor := GetTextColor(DC);
|
|
if AFont <> nil then
|
|
begin
|
|
PrevFont := SelectObject(DC, AFont.Handle);
|
|
SetTextColor(DC, ColorToRGB(AFont.Color));
|
|
end;
|
|
if ATextColor <> clDefault then
|
|
SetTextColor(DC, ColorToRGB(ATextColor));
|
|
|
|
TextParams := dxCalcTextParams(DC, AFormat, ALineSpacingFactor);
|
|
TextRect := dxPrepareRect(R, TextParams, ALeftIndent, ARightIndent);
|
|
|
|
TextHeight := 0;
|
|
RowCount := 0;
|
|
if ProcessText(TextParams, TextRect) then
|
|
begin
|
|
if TextParams.HidePrefix then DoHidePrefix(S);
|
|
|
|
TextRows := dxMakeTextRows(DC, S, TextRect, TextParams);
|
|
if TextRows <> nil then
|
|
try
|
|
RowCount := TextRows.Count;
|
|
if TextParams.CalcRect then
|
|
begin
|
|
TextRect.Right := TextRect.Left + TextRows.CalculateMaxWidth;
|
|
if not TextParams.SingleLine then
|
|
begin
|
|
TextRows.Free;
|
|
TextRows := dxMakeTextRows(DC, S, TextRect, TextParams);
|
|
RowCount := TextRows.Count;
|
|
end;
|
|
dxPlaceTextRows(DC, TextRect, TextParams, TextRows, RowCount);
|
|
TextRect.Bottom := TextRect.Top + TextRows[RowCount - 1].TextOriginY + TextParams.RowHeight;
|
|
R := dxUnprepareRect(TextRect, TextParams, ALeftIndent, ARightIndent);
|
|
end
|
|
else
|
|
begin
|
|
if (AMaxLineCount > 0) and (RowCount > AMaxLineCount) then
|
|
RowCount := AMaxLineCount;
|
|
dxPlaceTextRows(DC, TextRect, TextParams, TextRows, RowCount);
|
|
dxTextRowsOut(DC, TextRect, TextParams, TextRows, RowCount);
|
|
end;
|
|
TextHeight := TextRows[RowCount - 1].TextOriginY + TextParams.RowHeight - TextRect.Top;
|
|
finally
|
|
TextRows.Free;
|
|
end;
|
|
end;
|
|
|
|
if TextParams.CalcRowCount or (TextHeight = 0) then
|
|
Result := RowCount
|
|
else
|
|
Result := TextHeight;
|
|
|
|
SelectObject(DC, PrevFont);
|
|
SetTextColor(DC, PrevFontColor);
|
|
end;
|
|
|
|
procedure CreateFillPatterns;
|
|
const
|
|
BoldPatternBits: array[0..7] of Word = ($0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000);
|
|
StandardPatternBits: array[0..7] of Word = ($5555, $AAAA, $5555, $AAAA, $5555, $AAAA, $5555, $AAAA);
|
|
|
|
function AllocPBits(AnIsBold: Boolean): Pointer ;
|
|
begin
|
|
if AnIsBold then
|
|
Result := @BoldPatternBits
|
|
else
|
|
Result := @StandardPatternBits;
|
|
end;
|
|
|
|
procedure FreePBits(var APBits: Pointer );
|
|
begin
|
|
end;
|
|
|
|
function CreateFillPattern(AnIsBold: Boolean): HBRUSH;
|
|
var
|
|
PBits: Pointer ;
|
|
Bitmap: HBITMAP;
|
|
begin
|
|
PBits := AllocPBits(AnIsBold);
|
|
try
|
|
Bitmap := CreateBitmap(8, 8, 1, 1, PBits);
|
|
try
|
|
Result := CreatePatternBrush(Bitmap);
|
|
finally
|
|
DeleteObject(Bitmap);
|
|
end;
|
|
finally
|
|
FreePBits(PBits);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FillPatterns[False] := CreateFillPattern(False);
|
|
FillPatterns[True] := CreateFillPattern(True);
|
|
end;
|
|
|
|
procedure DestroyFillPatterns;
|
|
begin
|
|
if FillPatterns[False] <> 0 then DeleteObject(FillPatterns[False]);
|
|
if FillPatterns[True] <> 0 then DeleteObject(FillPatterns[True]);
|
|
end;
|
|
|
|
|
|
procedure dxRotatedTextOut(DC: HDC; const ABounds: TRect; const AText: string; AFont: TFont;
|
|
AAlignHorz: TdxTextAlignX = taCenterX; AAlignVert: TdxTextAlignY = taCenterY; AWordBreak: Boolean = True;
|
|
ALeftExceed: Boolean = True; ARightExceed: Boolean = True; ADirection: TdxVerticalTextOutDirection = vtdBottomToTop;
|
|
AFontSize: Integer = 0);
|
|
|
|
const
|
|
Angles: array[TdxVerticalTextOutDirection] of Integer = (-900, 900);
|
|
Flags: array[TdxVerticalTextOutDirection] of Integer =
|
|
(TA_LEFT or TA_BOTTOM or TA_NOUPDATECP, TA_LEFT or TA_TOP or TA_NOUPDATECP);
|
|
|
|
procedure AddRow(AList: TList; AFirstChar: PChar; ACount, AWidth: Integer);
|
|
begin
|
|
AList.Add(AFirstChar);
|
|
AList.Add(Pointer(ACount));
|
|
AList.Add(Pointer(AWidth));
|
|
end;
|
|
|
|
function CreateRotatedFont: HFONT;
|
|
var
|
|
ALogFont: TLogFont;
|
|
begin
|
|
FillChar(ALogFont, SizeOf(ALogFont), 0);
|
|
cxGetFontData(AFont.Handle, ALogFont);
|
|
if AFontSize <> 0 then
|
|
ALogFont.lfHeight := -MulDiv(AFontSize, GetDeviceCaps(DC, LOGPIXELSY), 72);
|
|
ALogFont.lfEscapement := Angles[ADirection];
|
|
ALogFont.lfOutPrecision := OUT_TT_ONLY_PRECIS;
|
|
Result := CreateFontIndirect(ALogFont);
|
|
end;
|
|
|
|
function TextSize(ACurrentChar: PChar; ACharCount: Integer): TSize;
|
|
begin
|
|
GetTextExtentPoint32(DC, ACurrentChar, ACharCount, Result);
|
|
end;
|
|
|
|
function GetNextChar(AFirstChar: PChar; ALen: Integer = 1): PChar;
|
|
begin
|
|
Result := AFirstChar;
|
|
while ALen > 0 do
|
|
begin
|
|
if Result^ in LeadBytes then
|
|
Inc(Integer(Result));
|
|
Inc(Integer(Result));
|
|
Dec(ALen);
|
|
end;
|
|
end;
|
|
|
|
function TextWidth(const AFirstChar: PChar; ACharCount: Integer): Integer;
|
|
var
|
|
ASize: TSize;
|
|
begin
|
|
GetTextExtentPoint32(DC, AFirstChar, ACharCount, ASize);
|
|
Result := ASize.cx;
|
|
end;
|
|
|
|
function MakeRow(var AFirstChar: PChar; ALastChar: PChar;
|
|
ACharCount, ARowCharCount: Integer; ATextRows: TList): Integer;
|
|
begin
|
|
// make break and move first point to current point
|
|
AddRow(ATextRows, AFirstChar, ARowCharCount, TextWidth(AFirstChar, ARowCharCount));
|
|
if ALastChar^ = ' ' then
|
|
begin
|
|
Dec(ACharCount);
|
|
ALastChar := GetNextChar(ALastChar);
|
|
end;
|
|
AFirstChar := ALastChar;
|
|
Result := ACharCount - ARowCharCount;
|
|
end;
|
|
|
|
|
|
procedure CalculateWordWrappedTextRows(AFirstChar: PChar;
|
|
ACharCount, ATextWidth: Integer; ATextRows: TList);
|
|
var
|
|
ACurrentChar, APrevBreakChar: PChar;
|
|
AIsBreakChar, AHasPrevBreak: Boolean;
|
|
APos, APrevBreakPos, AWidth: Integer;
|
|
begin
|
|
while ACharCount > 0 do
|
|
begin
|
|
ACurrentChar := AFirstChar;
|
|
APos := 0;
|
|
AHasPrevBreak := False;
|
|
AWidth := 0;
|
|
APrevBreakPos := 0;
|
|
APrevBreakChar := ' ';
|
|
while APos < ACharCount do
|
|
begin
|
|
ACurrentChar := GetNextChar(ACurrentChar);
|
|
Inc(APos);
|
|
AIsBreakChar := (ACurrentChar^ = ' ') or (ACurrentChar^ = #13) or (ACurrentChar^ = #10);
|
|
if AIsBreakChar or (APos = ACharCount) then
|
|
begin
|
|
AWidth := TextWidth(AFirstChar, APos);
|
|
if AWidth < ATextWidth then
|
|
begin
|
|
AHasPrevBreak := AIsBreakChar;
|
|
APrevBreakPos := APos;
|
|
APrevBreakChar := ACurrentChar;
|
|
end;
|
|
end;
|
|
if (AIsBreakChar and ((AWidth > ATextWidth) or (ACurrentChar^ in [#13, #10]))) or (APos = ACharCount) then
|
|
begin
|
|
if AHasPrevBreak and (AWidth > ATextWidth) then
|
|
begin
|
|
APos := APrevBreakPos;
|
|
ACurrentChar := APrevBreakChar;
|
|
end;
|
|
ACharCount := MakeRow(AFirstChar, ACurrentChar, ACharCount, APos, ATextRows);
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ProcessHorizontalAlignemnt(const ATextBounds: TRect;
|
|
AWidth: Integer): Integer;
|
|
var
|
|
ARightPos, ALeftPos: Integer;
|
|
begin
|
|
if ADirection = vtdBottomToTop then
|
|
begin
|
|
ARightPos := ATextBounds.Top + AWidth;
|
|
ALeftPos := ATextBounds.Bottom;
|
|
end
|
|
else
|
|
begin
|
|
ALeftPos := ATextBounds.Top;
|
|
ARightPos := ATextBounds.Bottom - AWidth;
|
|
end;
|
|
if AAlignHorz = taLeft then
|
|
Result := ALeftPos
|
|
else
|
|
if AAlignHorz = taRight then
|
|
Result := ARightPos
|
|
else
|
|
begin
|
|
if ADirection = vtdBottomToTop then
|
|
Result := (ATextBounds.Top + ATextBounds.Bottom + AWidth) div 2
|
|
else
|
|
Result := (ATextBounds.Top + ATextBounds.Bottom - AWidth) div 2
|
|
end;
|
|
if AWidth > (ATextBounds.Bottom - ATextBounds.Top) then
|
|
begin
|
|
if ARightExceed then
|
|
Result := ARightPos
|
|
else
|
|
if ALeftExceed then
|
|
Result := ALeftPos;
|
|
end;
|
|
end;
|
|
|
|
function ProcessVerticalAlignemnt(const ATextBounds: TRect;
|
|
ARowHeight, ARowCount: Integer): Integer;
|
|
begin
|
|
if ADirection = vtdBottomToTop then
|
|
begin
|
|
// align by horizontally
|
|
if AAlignVert = taBottom then
|
|
begin
|
|
Result := ATextBounds.Right - ARowHeight * ARowCount;
|
|
if Result < ATextBounds.Left then
|
|
Result := ATextBounds.Left;
|
|
end
|
|
else
|
|
if AAlignVert = taCenterY then
|
|
Result := (ATextBounds.Left + ATextBounds.Right - ARowHeight * ARowCount) div 2
|
|
else
|
|
Result := ATextBounds.Left;
|
|
if Result < ATextBounds.Left then
|
|
Result := ATextBounds.Left;
|
|
end
|
|
else
|
|
begin
|
|
if AAlignVert = taTop then
|
|
Result := ATextBounds.Right - ARowHeight
|
|
else
|
|
if AAlignVert = taCenterY then
|
|
Result := (ATextBounds.Left - ARowHeight + ATextBounds.Right + ARowHeight * (ARowCount - 1)) div 2
|
|
else
|
|
Result := ATextBounds.Left + ARowHeight * (ARowCount - 1);
|
|
if Result > (ATextBounds.Right - ARowHeight) then
|
|
Result := ATextBounds.Right - ARowHeight;
|
|
end;
|
|
end;
|
|
|
|
procedure PlaceTextRows(ATextRows: TList; ATextBounds: TRect);
|
|
var
|
|
ASize: TSize;
|
|
I, ALeft, ATop, ARowCount, AWidth: Integer;
|
|
begin
|
|
GetTextExtentPoint32(DC, 'Wg', 2, ASize);
|
|
ARowCount := ATextRows.Count div 3;
|
|
ALeft := ProcessVerticalAlignemnt(ATextBounds, ASize.cy, ARowCount);
|
|
for I := 0 to ARowCount - 1 do
|
|
begin
|
|
// align by vertically
|
|
AWidth := Integer(ATextRows.List^[I * 3 + 2]);
|
|
ATop := ProcessHorizontalAlignemnt(ATextBounds, AWidth);
|
|
// out text row
|
|
ExtTextOut(DC, ALeft, ATop, 0{ETO_CLIPPED}, @ATextBounds,
|
|
PChar(ATextRows.List^[I * 3]), Integer(ATextRows.List^[I * 3 + 1]), nil);
|
|
// offset place and check visibility
|
|
if ADirection = vtdBottomToTop then
|
|
Inc(ALeft, ASize.cy)
|
|
else
|
|
Dec(ALeft, ASize.cy);
|
|
if (ALeft < ATextBounds.Left) or (ALeft > ATextBounds.Right) then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
// ASize: TSize;
|
|
ATextRows: TList;
|
|
AFontHandle: HFONT;
|
|
ATextBounds: TRect;
|
|
ACharCount, AMode, AWidth: Integer;
|
|
begin
|
|
ACharCount := Length(AText);
|
|
if ACharCount = 0 then Exit;
|
|
ATextBounds := ABounds;
|
|
InflateRect(ATextBounds, -2, -2);
|
|
AWidth := ATextBounds.Bottom - ATextBounds.Top;
|
|
AFontHandle := SelectObject(DC, CreateRotatedFont);
|
|
AMode := SetBkMode(DC, Windows.TRANSPARENT);
|
|
ATextRows := TList.Create;
|
|
try
|
|
ATextRows.Capacity := Length(AText) * 3;
|
|
SetTextAlign(DC, Flags[ADirection]);
|
|
if not AWordBreak then
|
|
AddRow(ATextRows, @AText[1], ACharCount, TextWidth(@AText[1], ACharCount))
|
|
else
|
|
CalculateWordWrappedTextRows(@AText[1], ACharCount, AWidth, ATextRows);
|
|
PlaceTextRows(ATextRows, ATextBounds);
|
|
finally
|
|
SetBkMode(DC, AMode);
|
|
AFontHandle := SelectObject(DC, AFontHandle);
|
|
DeleteObject(AFontHandle);
|
|
ATextRows.Free;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
CreateFillPatterns;
|
|
|
|
finalization
|
|
DestroyFillPatterns;
|
|
|
|
end.
|
|
|