Componentes.Terceros.DevExp.../internal/x.46/1/ExpressLibrary/Sources/cxDrawTextUtils.pas
2009-10-27 17:09:30 +00:00

1948 lines
70 KiB
ObjectPascal

{********************************************************************}
{ }
{ Developer Express Visual Component Library }
{ Express Cross Platform Library classes }
{ }
{ Copyright (c) 2000-2009 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 EXPRESSCROSSPLATFORMLIBRARY 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 cxDrawTextUtils;
{$I cxVer.inc}
interface
uses
Windows, Controls,
{$IFDEF DELPHI6}
Types,
{$ELSE}
Classes,
{$ENDIF}
SysUtils, Graphics;
const
CXTO_LEFT = $00000000;
CXTO_CENTER_HORIZONTALLY = $00000001;
CXTO_RIGHT = $00000002;
CXTO_JUSTIFY_HORIZONTALLY = $00000003;
CXTO_DISTRIBUTE_HORIZONTALLY = $00000004;
CXTO_TOP = $00000000;
CXTO_CENTER_VERTICALLY = $00000010;
CXTO_BOTTOM = $00000020;
CXTO_DISTRIBUTE_VERTICALLY = $00000030;
CXTO_WORDBREAK = $00000100;
CXTO_SINGLELINE = $00000200;
CXTO_EXPANDTABS = $00000400;
CXTO_END_ELLIPSIS = $00000800;
CXTO_PATTERNEDTEXT = $00001000;
CXTO_EXTERNALLEADING = $00002000;
CXTO_EDITCONTROL = $00004000;
CXTO_NOCLIP = $00008000;
CXTO_AUTOINDENTS = $00010000;
CXTO_CHARBREAK = $00020000;
CXTO_PREVENT_LEFT_EXCEED = $00040000;
CXTO_PREVENT_TOP_EXCEED = $00080000;
CXTO_CALCRECT = $00100000;
CXTO_CALCROWCOUNT = $00200000;
CXTO_NOPREFIX = $00000000;
CXTO_HIDEPREFIX = $01000000;
CXTO_EXCELSTYLE = $02000000;
CXTO_DEFAULT_FORMAT = CXTO_LEFT or CXTO_TOP or CXTO_SINGLELINE;
cxTextSpace = 2;
TcxCacheStaticRowsCount = 32;
cxMinVisuallyVisibleTextHeight = 6;
type
TCaptionChar = Char;
TcxCaptionChar = TCaptionChar;
PcxCaptionChar = PChar;
TcxTextOutFormat = DWORD;
TcxTextAlignX = (taLeft, taCenterX, taRight, taJustifyX, taDistributeX);
TcxTextAlignY = (taTop, taCenterY, taBottom, taDistributeY);
TcxVerticalTextOutDirection = (vtdTopToBottom, vtdBottomToTop);
PcxTextParams = ^TcxTextParams;
TcxTextParams = packed record
RowHeight: Integer;
tmExternalLeading: Integer;
FullRowHeight: Integer;
EndEllipsisWidth: Integer;
Bold: Boolean;
BreakChar: WideChar;
TextAlignX: TcxTextAlignX;
TextAlignY: TcxTextAlignY;
WordBreak: Boolean;
SingleLine: Boolean;
ExpandTabs: Boolean;
EndEllipsis: Boolean;
ExternalLeading: Boolean;
EditControl: Boolean;
ExcelStyle: Boolean;
NoClip: Boolean;
AutoIndents: Boolean;
PatternedText: Boolean;
PreventLeftExceed: Boolean;
PreventTopExceed: Boolean;
CharBreak: Boolean;
CalcRowCount: Boolean;
CalcRect: Boolean;
MaxCharWidth: Integer;
CharSet: Byte;
OnePixel: Integer;
HidePrefix: Boolean;
end;
TcxTextRow = record
Text: PWideChar;
TextLength: Integer;
TextExtents: TSize;
BreakCount: Integer;
TextOriginX: Integer;
TextOriginY: Integer;
StartOffset: Integer;
end;
PcxTextRow = ^TcxTextRow;
TCanvasHandle = HDC;
TcxDynamicTextRows = array of TcxTextRow;
TcxCalcTextExtentsProc = function (AHandle: TCanvasHandle; AText: PWideChar;
ATextLength: Integer; AExpandTabs: Boolean; AData: Pointer): TSize;
TcxTextRows = record
Count: Integer;
Text: WideString;
StaticRows: array[0..TcxCacheStaticRowsCount - 1] of TcxTextRow;
DynamicRows: TcxDynamicTextRows;
end;
function cxCalcTextParams(AHandle: TCanvasHandle; AFormat: DWORD;
const ALineSpacingFactor: Double = 1.0): TcxTextParams; overload;
function cxCalcTextParams(ACanvas: TCanvas; AFormat: DWORD;
const ALineSpacingFactor: Double = 1.0): TcxTextParams; overload;
function cxCalcTextExtents(AHandle: TCanvasHandle; AText: PWideChar;
ATextLength: Integer; AExpandTabs: Boolean): TSize; overload;
function cxCalcTextExtents(AHandle: TCanvasHandle; AText: PAnsiChar;
ATextLength: Integer; AExpandTabs: Boolean): TSize; overload;
function cxCalcTextExtentsEx(AHandle: TCanvasHandle; AText: PWideChar;
ATextLength: Integer; AExpandTabs: Boolean; AData: Pointer): TSize; overload;
procedure cxCalcTextRowExtents(AHandle: TCanvasHandle; ATextRow: PcxTextRow;
const ATextParams: TcxTextParams); overload; {$IFDEF DELPHI9} inline; {$ENDIF}
procedure cxCalcTextRowExtents(AHandle: TCanvasHandle; ATextRow: PcxTextRow;
const ATextParams: TcxTextParams; AUserData: Pointer;
ACalcTextExtentsProc: TcxCalcTextExtentsProc); overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxGetLongestTextRowWidth(const ATextRows: TcxTextRows; ARowCount: Integer): Integer;
procedure cxPlaceTextRows(AHandle: TCanvasHandle; const R: TRect;
var ATextParams: TcxTextParams; const ATextRows: TcxTextRows; ARowCount: Integer);
procedure cxResetTextRows(var ATextRows: TcxTextRows); {$IFDEF DELPHI9} inline; {$ENDIF}
function cxGetTextRow(const ATextRows: TcxTextRows; AIndex: Integer): PcxTextRow; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxGetTextRowCount(const ATextRows: TcxTextRows): Integer; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxMakeFormat(ATextAlignX: TcxTextAlignX; ATextAlignY: TcxTextAlignY): DWORD;
function cxPrepareRect(const R: TRect; const ATextParams: TcxTextParams;
ALeftIndent, ARightIndent: Integer): TRect;
function cxGetIsWordDelimeter(ACodePage: DWORD; AChar: WideChar): Boolean;
function cxGetNextWordBreak(ACodePage: DWORD; AStart, AEnd: PWideChar): PWideChar;
procedure cxTextRowsOutHighlight(AHandle: TCanvasHandle; const R: TRect;
const ATextParams: TcxTextParams; const ATextRows: TcxTextRows; ARowCount,
ASelStart, ASelLength: Integer; ASelBkgColor, ASelTextColor: TColor; AForceEndEllipsis: Boolean);
//***************************** ANSI VERSION ***********************************
function cxMakeTextRows(AHandle: TCanvasHandle;
AText: PAnsiChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer; AUserData: Pointer;
ACalcTextExtentsProc: TcxCalcTextExtentsProc): Boolean; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxMakeTextRows(AHandle: TCanvasHandle;
AText: PAnsiChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer = 0): Boolean; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxMakeTextRows(ACanvas: TCanvas;
AText: PAnsiChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer = 0): Boolean; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxTextOut(AHandle: TCanvasHandle; const AText: AnsiString; var R: TRect;
AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer; AFont: TFont;
ASelBkgColor, ASelTextColor: TColor; AMaxLineCount: Integer = 0;
ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxTextOut(AHandle: TCanvasHandle; const AText: AnsiString; var R: TRect;
AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AFont: TFont = nil;
AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxTextOut(ACanvas: TCanvas; const AText: AnsiString; var R: TRect;
AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer; AFont: TFont;
ASelBkgColor, ASelTextColor: TColor; AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0;
ARightIndent: Integer = 0; ATextColor: TColor = clDefault;
const ALineSpacingFactor: Double = 1.0): Integer; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxTextOut(ACanvas: TCanvas; const AText: AnsiString; var R: TRect;
AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AFont: TFont = nil;
AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
procedure cxRotatedTextOut(AHandle: TCanvasHandle; const ABounds: TRect; const AText: AnsiString; AFont: TFont;
AAlignHorz: TcxTextAlignX = taCenterX; AAlignVert: TcxTextAlignY = taCenterY; AWordBreak: Boolean = True;
ALeftExceed: Boolean = True; ARightExceed: Boolean = True; ADirection: TcxVerticalTextOutDirection = vtdBottomToTop;
AFontSize: Integer = 0); overload; {$IFDEF DELPHI9} inline; {$ENDIF}
//**************************** UNICODE VERSION *********************************
function cxMakeTextRows(AHandle: TCanvasHandle;
AText: PWideChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer; AUserData: Pointer;
ACalcTextExtentsProc: TcxCalcTextExtentsProc): Boolean; overload;
function cxMakeTextRows(AHandle: TCanvasHandle;
AText: PWideChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer = 0): Boolean; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxMakeTextRows(ACanvas: TCanvas;
AText: PWideChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer = 0): Boolean; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxTextOut(AHandle: TCanvasHandle; const AText: WideString; var R: TRect;
AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer; AFont: TFont;
ASelBkgColor, ASelTextColor: TColor; AMaxLineCount: Integer = 0;
ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer; overload;
function cxTextOut(AHandle: TCanvasHandle; const AText: WideString; var R: TRect;
AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AFont: TFont = nil;
AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxTextOut(ACanvas: TCanvas; const AText: WideString; var R: TRect;
AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer; AFont: TFont;
ASelBkgColor, ASelTextColor: TColor; AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0;
ARightIndent: Integer = 0; ATextColor: TColor = clDefault;
const ALineSpacingFactor: Double = 1.0): Integer; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
function cxTextOut(ACanvas: TCanvas; const AText: WideString; var R: TRect;
AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AFont: TFont = nil;
AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
procedure cxRotatedTextOut(AHandle: TCanvasHandle; const ABounds: TRect; const AText: WideString; AFont: TFont;
AAlignHorz: TcxTextAlignX = taCenterX; AAlignVert: TcxTextAlignY = taCenterY; AWordBreak: Boolean = True;
ALeftExceed: Boolean = True; ARightExceed: Boolean = True; ADirection: TcxVerticalTextOutDirection = vtdBottomToTop;
AFontSize: Integer = 0); overload;
implementation
uses
Math, Classes, cxGeometry, dxCore, cxClasses, cxGraphics, cxControls;
type
TCanvasAccess = class(TControlCanvas);
TFullWidthUnicode = record
Start, Finish: WideChar;
end;
const
CXTO_VERT_ALIGN_OFFSET = 4;
CXTO_HORZ_ALIGN_MASK = CXTO_CENTER_HORIZONTALLY or CXTO_RIGHT or CXTO_JUSTIFY_HORIZONTALLY or CXTO_DISTRIBUTE_HORIZONTALLY;
CXTO_VERT_ALIGN_MASK = CXTO_CENTER_VERTICALLY or CXTO_BOTTOM or CXTO_DISTRIBUTE_VERTICALLY;
Tab = #9;
LF = #10;
CR = #13;
Space = #32;
cxEndEllipsisChars: PWideChar = '...';
cxEndEllipsisCharsLength = 3;
type
TcxTextRowFormat = record
Align: TcxTextAlignX;
BreakByWords: Boolean;
BreakByChars: Boolean;
CalcRect: Boolean;
EditControl: Boolean;
EndEllipsis: Boolean;
ExpandTabs: Boolean;
ExcelStyle: Boolean;
SingleLine: Boolean;
Special: Boolean;
end;
var
FillPatterns: array[Boolean] of HBRUSH;
//work with cache
procedure cxResetTextRows(var ATextRows: TcxTextRows);
begin
ATextRows.Count := 0;
SetLength(ATextRows.DynamicRows, 0);
ATextRows.DynamicRows := nil;
//don't clear ATextRows.Text here
end;
procedure ValidateTextRows(var ATextRows: TcxTextRows; ACount: Integer);
var
AIndex: Integer;
begin
AIndex := ACount - 1;
ATextRows.Count := ACount;
Dec(ACount, TcxCacheStaticRowsCount);
if ACount > Length(ATextRows.DynamicRows) then
SetLength(ATextRows.DynamicRows, ACount + 4);
if AIndex >= 0 then
FillChar(cxGetTextRow(ATextRows, AIndex)^, SizeOf(TcxTextRow), 0);
end;
function cxGetTextRow(const ATextRows: TcxTextRows; AIndex: Integer): PcxTextRow;
begin
if AIndex < TcxCacheStaticRowsCount then
Result := @ATextRows.StaticRows[AIndex]
else
begin
Dec(AIndex, TcxCacheStaticRowsCount);
Result := @ATextRows.DynamicRows[AIndex];
end;
end;
function cxGetTextRowCount(const ATextRows: TcxTextRows): Integer;
begin
Result := ATextRows.Count;
end;
function cxMakeFormat(ATextAlignX: TcxTextAlignX; ATextAlignY: TcxTextAlignY): DWORD;
begin
Result := Byte(ATextAlignX) or (Byte(ATextAlignY) shl CXTO_VERT_ALIGN_OFFSET);
end;
//support Win9x & WinMe
function cxWideCharLenToAnsiString(AText: PWideChar; ATextLength: Integer): AnsiString;
var
AAnsiTextLength: Integer;
begin
AAnsiTextLength := WideCharToMultiByte(CP_ACP, 0, AText, ATextLength, nil, 0, nil, nil);
SetLength(Result, AAnsiTextLength);
WideCharToMultiByte(CP_ACP, 0, AText, ATextLength, PAnsiChar(Result), AAnsiTextLength, nil, nil);
end;
function cxGetTabbedTextExtentW(hDC: HDC; lpString: PWideChar;
nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD;
var
S: AnsiString;
begin
if IsWinNT then
Result := GetTabbedTextExtentW(hDC, lpString, nCount, nTabPositions, lpnTabStopPositions)
else
begin
S := cxWideCharLenToAnsiString(lpString, nCount);
Result := GetTabbedTextExtentA(hDC, PAnsiChar(S), Length(S), nTabPositions, lpnTabStopPositions);
end;
end;
function cxGetTextExtentPoint32W(DC: HDC; Str: PWideChar; Count: Integer; var Size: TSize): BOOL;
var
S: AnsiString;
begin
if IsWinNT then
Result := GetTextExtentPoint32W(DC, Str, Count, Size)
else
begin
S := cxWideCharLenToAnsiString(Str, Count);
Result := GetTextExtentPoint32A(DC, PAnsiChar(S), Length(S), Size);
end;
end;
function cxGetTextExtentExPoint(AHandle: TCanvasHandle; AText: PWideChar;
ATextLength, AWidth: Integer; ACharNumber, ADX: PInteger): Boolean;
var
S: AnsiString;
ASize: TSize;
begin
if IsWinNT then
Result := GetTextExtentExPointW(AHandle, AText, ATextLength, AWidth, ACharNumber, ADX, ASize)
else
begin
S := cxWideCharLenToAnsiString(AText, ATextLength);
Result := GetTextExtentExPointA(AHandle, PAnsiChar(S), Length(S), AWidth, ACharNumber, ADX, ASize);
end;
end;
function cxDrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
var lpRect: TRect; uFormat: UINT): Integer;
var
S: AnsiString;
begin
if IsWinNT then
Result := DrawTextW(hDC, lpString, nCount, lpRect, uFormat)
else
begin
S := cxWideCharLenToAnsiString(lpString, nCount);
Result := DrawTextA(hDC, PAnsiChar(S), Length(S), lpRect, uFormat);
end;
end;
function cxTabbedTextOutW(hDC: HDC; X, Y: Integer; lpString: PWideChar;
nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint;
var
S: AnsiString;
begin
if IsWinNT then
Result := TabbedTextOutW(hDC, X, Y, lpString, nCount, nTabPositions, lpnTabStopPositions, nTabOrigin)
else
begin
S := cxWideCharLenToAnsiString(lpString, nCount);
Result := TabbedTextOutA(hDC, X, Y, PAnsiChar(S), Length(S), nTabPositions, lpnTabStopPositions, nTabOrigin);
end;
end;
function cxTextOutW(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL;
var
S: AnsiString;
begin
if IsWinNT then
Result := TextOutW(DC, X, Y, Str, Count)
else
begin
S := cxWideCharLenToAnsiString(Str, Count);
Result := TextOutA(DC, X, Y, PAnsiChar(S), Length(S));
end;
end;
function cxExtTextOutW(DC: HDC; X, Y: Integer; Options: Longint;
Rect: PRect; Str: PWideChar; Count: Longint; Dx: PInteger): BOOL;
var
S: AnsiString;
begin
if IsWinNT then
Result := ExtTextOutW(DC, X, Y, Options, Rect, Str, Count, Dx)
else
begin
S := cxWideCharLenToAnsiString(Str, Count);
Result := ExtTextOutA(DC, X, Y, Options, Rect, PAnsiChar(S), Length(S), Dx);
end;
end;
function cxCalcTextExtents(AHandle: TCanvasHandle; AText: PWideChar;
ATextLength: Integer; AExpandTabs: Boolean): TSize;
var
ATextExtent: DWORD;
R: TRect;
begin
if AExpandTabs then
begin
if ATextLength < 4096 then
begin
ATextExtent := cxGetTabbedTextExtentW(AHandle, AText, ATextLength, 0, Result);
Result.cx := LoWord(ATextExtent);
Result.cy := HiWord(ATextExtent);
end
else
begin
R := cxEmptyRect;
Result.cy := cxDrawTextW(AHandle, AText, ATextLength, R,
DT_SINGLELINE or DT_NOPREFIX or DT_CALCRECT or DT_EXPANDTABS);
Result.cx := R.Right - R.Left;
end;
end
else
cxGetTextExtentPoint32W(AHandle, AText, ATextLength, Result);
end;
function cxCalcTextExtents(AHandle: TCanvasHandle; AText: PAnsiChar;
ATextLength: Integer; AExpandTabs: Boolean): TSize;
var
ATextExtent: DWORD;
R: TRect;
begin
if AExpandTabs then
begin
if ATextLength <= 4096 then
begin
ATextExtent := GetTabbedTextExtentA(AHandle, AText, ATextLength, 0, Result);
Result.cx := LoWord(ATextExtent);
Result.cy := HiWord(ATextExtent);
end
else
begin
R := cxEmptyRect;
Result.cy := DrawTextA(AHandle, AText, ATextLength, R,
DT_SINGLELINE or DT_NOPREFIX or DT_CALCRECT or DT_EXPANDTABS);
Result.cx := R.Right - R.Left;
end;
end
else
GetTextExtentPoint32A(AHandle, AText, ATextLength, Result);
end;
function IntersectClipRect(AHandle: TCanvasHandle; const R: TRect): HRGN;
begin
Result := CreateRectRgn(0, 0, 0, 0);
if GetClipRgn(AHandle, Result) <> 1 then
begin
DeleteObject(Result);
Result := 0;
end;
with R do
Windows.IntersectClipRect(AHandle, Left, Top, Right, Bottom);
end;
procedure RestoreClipRgn(AHandle: TCanvasHandle; var ARgn: HRGN);
begin
SelectClipRgn(AHandle, ARgn);
if ARgn <> 0 then
begin
DeleteObject(ARgn);
ARgn := 0
end;
end;
function cxCalcTextExtentsEx(AHandle: TCanvasHandle; AText: PWideChar;
ATextLength: Integer; AExpandTabs: Boolean; AData: Pointer): TSize;
begin
Result := cxCalcTextExtents(AHandle, AText, ATextLength, AExpandTabs);
end;
procedure cxCalcTextRowExtents(AHandle: TCanvasHandle; ATextRow: PcxTextRow;
const ATextParams: TcxTextParams);
begin
cxCalcTextRowExtents(AHandle, ATextRow, ATextParams, nil, @cxCalcTextExtentsEx);
end;
procedure cxCalcTextRowExtents(AHandle: TCanvasHandle; ATextRow: PcxTextRow;
const ATextParams: TcxTextParams; AUserData: Pointer;
ACalcTextExtentsProc: TcxCalcTextExtentsProc); overload; {$IFDEF DELPHI9} inline; {$ENDIF}
begin
with ATextRow^ do
TextExtents := ACalcTextExtentsProc(AHandle, Text, TextLength,
ATextParams.ExpandTabs, AUserData);
end;
function cxCalcTextParams(AHandle: TCanvasHandle; AFormat: TcxTextOutFormat;
const ALineSpacingFactor: Double = 1.0): TcxTextParams;
var
ATextMetricW: TTextMetricW;
ATextMetricA: TTextMetricA;
R: TRect;
begin
FillChar(Result, SizeOf(Result), 0);
with Result do
begin
if GetTextMetricsW(AHandle, ATextMetricW) then
begin
Bold := ATextMetricW.tmWeight >= FW_BOLD;
BreakChar := ATextMetricW.tmBreakChar;
MaxCharWidth := ATextMetricW.tmMaxCharWidth;
RowHeight := ATextMetricW.tmHeight;
CharSet := ATextMetricW.tmCharSet;
if ExternalLeading then
tmExternalLeading := ATextMetricW.tmExternalLeading;
end
else
begin
GetTextMetricsA(AHandle, ATextMetricA);
Bold := ATextMetricA.tmWeight >= FW_BOLD;
BreakChar := WideChar(ATextMetricA.tmBreakChar);
MaxCharWidth := ATextMetricA.tmMaxCharWidth;
RowHeight := ATextMetricA.tmHeight;
CharSet := ATextMetricA.tmCharSet;
if ExternalLeading then
tmExternalLeading := ATextMetricA.tmExternalLeading;
end;
TextAlignX := TcxTextAlignX(AFormat and CXTO_HORZ_ALIGN_MASK);
TextAlignY := TcxTextAlignY(AFormat and CXTO_VERT_ALIGN_MASK shr CXTO_VERT_ALIGN_OFFSET);
AutoIndents := AFormat and CXTO_AUTOINDENTS <> 0;
CalcRect := AFormat and CXTO_CALCRECT <> 0;
CalcRowCount := AFormat and CXTO_CALCROWCOUNT <> 0;
CharBreak := (AFormat and CXTO_CHARBREAK <> 0) or SysLocale.FarEast; //SysLocale.FarEast ??
EditControl := AFormat and CXTO_EDITCONTROL <> 0;
EndEllipsis := AFormat and CXTO_END_ELLIPSIS <> 0;
ExcelStyle := AFormat and CXTO_EXCELSTYLE <> 0;
ExpandTabs := AFormat and CXTO_EXPANDTABS <> 0;
ExternalLeading := AFormat and CXTO_EXTERNALLEADING <> 0;
NoClip := AFormat and CXTO_NOCLIP <> 0;
PatternedText := AFormat and CXTO_PATTERNEDTEXT <> 0;
PreventLeftExceed := AFormat and CXTO_PREVENT_LEFT_EXCEED <> 0;
PreventTopExceed := AFormat and CXTO_PREVENT_TOP_EXCEED <> 0;
SingleLine := AFormat and CXTO_SINGLELINE <> 0;
WordBreak := AFormat and CXTO_WORDBREAK <> 0;
HidePrefix := AFormat and CXTO_HIDEPREFIX <> 0;
R := Rect(0, 0, 1, 1);
DPtoLP(AHandle, R, 2);
OnePixel := R.Right - R.Left;
FullRowHeight := Round((RowHeight + tmExternalLeading) * ALineSpacingFactor);
if PatternedText then
begin
R := Rect(0, 0, cxMinVisuallyVisibleTextHeight, cxMinVisuallyVisibleTextHeight);
DPtoLP(AHandle, R, 2);
PatternedText := RowHeight < R.Bottom - R.Top;
end;
if EndEllipsis then
EndEllipsisWidth := cxCalcTextExtents(AHandle, cxEndEllipsisChars, cxEndEllipsisCharsLength, False).cX
else
EndEllipsisWidth := 0;
end;
end;
function cxCalcTextParams(ACanvas: TCanvas; AFormat: DWORD;
const ALineSpacingFactor: Double = 1.0): TcxTextParams;
begin
TCanvasAccess(ACanvas).RequiredState([csHandleValid, csFontValid]);
Result := cxCalcTextParams(ACanvas.Handle, AFormat, ALineSpacingFactor);
end;
function IsFarEastLineBreak(C: WideChar): Boolean;
const
ASCIILatin1EndBreak: array[0..150] of Byte = (
1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0,
1, 0, 0, 0, 0, 0, 0, 1);
GeneralPunctuationEndBreak: array[0..32] of Byte = (
1, 1, 1, 1, 0, 1, 1, 0, 0, 0, 1, 0, 0,
0, 0, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 1);
CJKSymbolEndBreak: array[0..29] of Byte = (
1, 1, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1,
0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1);
CNS11643SmallVariantsEndBreak: array[0..46] of Byte = (
1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1);
FullWidthHalfWidthVariantsEndBreak: array[0..158] of Byte = (
1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 1, 1, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0,
0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1);
begin
case Ord(C) shr 8 of
$0000:
Result := (C >= #$0021) and (C <= #$00B7) and Boolean(ASCIILatin1EndBreak[Ord(C) - $0021]);
$0002:
Result := (C = #$02C7) or (C = #$02C9);
$0020:
Result := (C >= #$2013) and (C <= #$2033) and Boolean(GeneralPunctuationEndBreak[Ord(C) - $2013]);
$0021:
Result := C = #$2103;
$0022:
Result := C = #$2236;
$0025:
Result := C = #$2574;
$0030:
begin
if (C >= #$3001) and (C <= #$301E) then
Result := Boolean(CJKSymbolEndBreak[Ord(C) - $3001])
else
Result := (C = #$309B) or (C = #$309C);
end;
$00FE:
Result := (C >= #$FE30) and (C <= #$FE5E) and Boolean(CNS11643SmallVariantsEndBreak[Ord(C) - $FE30]);
$00FF:
begin
if (C >= #$FF01) and (C <= #$FF9F) then
Result := Boolean(FullWidthHalfWidthVariantsEndBreak[Ord(C) - $FF01])
else
Result := C >= #$FFE0;
end
else
Result := False;
end;
end;
function IsFarEastFullWidthCharacter(ACodePage: DWORD; AChar: WideChar): Boolean;
const
NUM_FULLWIDTH_UNICODES = 4;
FullWidthUnicodes: array[0..NUM_FULLWIDTH_UNICODES - 1] of TFullWidthUnicode = (
(Start: #$4E00; Finish: #$9FFF), // CJK_UNIFIED_IDOGRAPHS
(Start: #$3040; Finish: #$309F), // HIRAGANA
(Start: #$30A0; Finish: #$30FF), // KATAKANA
(Start: #$AC00; Finish: #$D7A3) // HANGUL
);
var
I: Integer;
begin
if AChar < #$0080 then
begin
Result := False;
Exit;
end;
for I := 0 to NUM_FULLWIDTH_UNICODES - 1 do
if (AChar >= FullWidthUnicodes[I].Start) and (AChar <= FullWidthUnicodes[I].Finish) then
begin
Result := True;
Exit;
end;
Result := WideCharToMultiByte(ACodePage, 0, @AChar, 1, nil, 0, nil, nil) > 1;
end;
function cxGetIsWordDelimeter(ACodePage: DWORD; AChar: WideChar): Boolean;
begin
Result := (AChar = CR) or (AChar = LF) or (AChar = Tab) or (AChar = Space) or
IsFarEastFullWidthCharacter(ACodePage, AChar) or IsFarEastLineBreak(AChar);
end;
function cxGetNextWordBreak(ACodePage: DWORD; AStart, AEnd: PWideChar): PWideChar;
var
ANonWhite: Integer;
begin
ANonWhite := 1;
while AStart < AEnd do
case AStart^ of
CR, LF:
Break;
Tab, Space:
begin
Result := AStart + ANonWhite;
Exit;
end;
else
begin
if IsFarEastFullWidthCharacter(ACodePage, AStart^) then
begin
if ANonWhite = 0 then
Result := AStart
else
if (AStart + 1 <> AEnd) and IsFarEastLineBreak((AStart + 1)^) then
Result := AStart + 1 + 1
else
Result := AStart + 1;
Exit;
end;
Inc(AStart);
ANonWhite := 0;
end;
end;
Result := AStart;
end;
function BreakAWord(AHandle: TCanvasHandle; AText: PWideChar;
ATextLength, AWidth: Integer; AExpandTabs: Boolean): PWideChar;
var
ALow, AHigh, ANew: Integer;
begin
ALow := 0;
AHigh := ATextLength;
while (AHigh - ALow) > 1 do
begin
ANew := ALow + (AHigh - ALow) div 2;
if cxCalcTextExtents(AHandle, AText, ANew, AExpandTabs).cx > AWidth then
AHigh := ANew
else
ALow := ANew;
end;
if (ALow = 0) and (ATextLength > 0) then
ALow := 1;
Result := AText + ALow;
end;
function AdjustWhiteSpaces(ANextLine: PWideChar; var ACount: Integer; AAlign: TcxTextAlignX): PWideChar;
begin
case AAlign of
taLeft:
if (ANextLine^ = Space) or (ANextLine^ = Tab) then
Inc(ANextLine);
taRight:
if ((ANextLine - 1)^ = Space) or ((ANextLine - 1)^ = Tab) then
Dec(ACount);
taCenterX:
begin
if ((ANextLine - 1)^ = Space) or ((ANextLine - 1)^ = Tab) then
Dec(ACount);
if (ANextLine^ = Space) or (ANextLine^ = Tab) then
Inc(ANextLine);
end;
end;
Result := ANextLine;
end;
function FastFindLineEnd(AText, AEnd: PWideChar): PWideChar;
begin
while AText < AEnd do
if (AText^ = CR) or (AText^ = LF) then
Break
else
Inc(AText);
Result := AText;
end;
function GetLineBreak(AHandle: TCanvasHandle; ALineStart: PWideChar;
ACount, AMaxWidth: Integer; const ATextRowFormat: TcxTextRowFormat;
var ATextRow: PcxTextRow; ACalcTextExtentsProc: TcxCalcTextExtentsProc;
AUserData: Pointer): PWideChar;
var
AExtent, ANewExtent: Integer;
AText, AEnd, P, ALineEnd: PWideChar;
AAdjustWhiteSpaces: Boolean;
begin
AExtent := 0;
AAdjustWhiteSpaces := False;
AText := ALineStart;
AEnd := ALineStart + ACount;
P := AText;
ATextRow.Text := AText;
ALineEnd := AEnd;
while AText < AEnd do
begin
if not ATextRowFormat.CalcRect and ATextRowFormat.BreakByWords then
P := cxGetNextWordBreak(CP_ACP, AText, AEnd)
else
P := FastFindLineEnd(AText, AEnd);
ALineEnd := P;
ANewExtent := ACalcTextExtentsProc(AHandle, ALineStart, P - ALineStart,
ATextRowFormat.ExpandTabs, AUserData).cx;
if ATextRowFormat.BreakByWords and (ANewExtent > AMaxWidth) then
begin
// Are there more than one word in this line and not a special case?
if (AText <> ALineStart) and not ATextRowFormat.Special then
begin
ALineEnd := AText;
P := AText;
AAdjustWhiteSpaces := True;
end
else
begin
//One word is longer than the maximum width permissible.
//See if we are allowed to break that single word.
if ATextRowFormat.BreakByChars then
begin
P := BreakAWord(AHandle, AText, P - AText, AMaxWidth - AExtent, ATextRowFormat.ExpandTabs);
ALineEnd := P;
//Note: Since we broke in the middle of a word, no need to adjust for white spaces.
end
else
begin
AAdjustWhiteSpaces := True;
// Check if we need to end this line with ellipsis
if ATextRowFormat.EndEllipsis then
// If there are CR/LF at the end, skip them.
if P < AEnd then
begin
if P^ = CR then
begin
Inc(P);
if (P < AEnd) and (P^ = LF) then
Inc(P);
AAdjustWhiteSpaces := False;
end;
if P^ = LF then
begin
Inc(P);
if (P < AEnd) and (P^ = CR) then
Inc(P);
AAdjustWhiteSpaces := False;
end;
end;
end;
end;
Break;
end
else
// Don't do this if already at the end of the string.
if P < AEnd then
begin
if P^ = CR then
begin
Inc(P);
if (P < AEnd) and (P^ = LF) then
Inc(P);
AAdjustWhiteSpaces := False;
Break;
end;
if P^ = LF then
begin
Inc(P);
if (P < AEnd) and (P^ = CR) then
Inc(P);
AAdjustWhiteSpaces := False;
Break;
end;
end;
// Point at the beginning of the next word.
AText := P;
AExtent := ANewExtent;
end;
// Calculate the length of current line.
ATextRow.TextLength := ALineEnd - ALineStart;
// Adjust the line length and P to take care of spaces.
if AAdjustWhiteSpaces and (P < AEnd) then
begin
P := AdjustWhiteSpaces(P, ATextRow.TextLength, ATextRowFormat.Align);
if ATextRowFormat.ExcelStyle then
while (P < AEnd) and (P^ = Space) do
Inc(P);
end;
if (ATextRowFormat.Align = taDistributeX) or
(AAdjustWhiteSpaces and (ATextRowFormat.Align = taJustifyX)) then
begin
AEnd := P - 1;
while (ATextRow.TextLength > 0) and ((AEnd^ = Space) or (AEnd^ = Tab)) do
begin
Dec(AEnd);
Dec(ATextRow.TextLength);
end;
AText := ATextRow.Text;
while AText < AEnd do
begin
if (AText^ = Space) or (AText^ = Tab) then
Inc(ATextRow.BreakCount);
Inc(AText);
end;
end;
// return the begining of next line;
Result := P;
end;
procedure MakeTextRowFormat(const ATextParams: TcxTextParams; out ATextRowFormat: TcxTextRowFormat);
begin
with ATextRowFormat do
begin
BreakByWords := not ATextParams.SingleLine and
(ATextParams.WordBreak or (ATextParams.TextAlignX in [taJustifyX, taDistributeX]));
CalcRect := ATextParams.CalcRect;
EditControl := ATextParams.EditControl;
EndEllipsis := ATextParams.EndEllipsis;
ExcelStyle := ATextParams.ExcelStyle;
ExpandTabs := ATextParams.ExpandTabs;
Align := ATextParams.TextAlignX;
SingleLine := ATextParams.SingleLine;
BreakByChars := BreakByWords and (ATextParams.CharBreak or EditControl);
end;
end;
function cxMakeTextRows(AHandle: TCanvasHandle; AText: PWideChar;
ATextLength: Integer; const R: TRect; const ATextParams: TcxTextParams;
var ATextRows: TcxTextRows; out ACount: Integer; AMaxLineCount: Integer = 0): Boolean; overload;
begin
Result := cxMakeTextRows(AHandle, AText, ATextLength, R, ATextParams,
ATextRows, ACount, AMaxLineCount, nil, @cxCalcTextExtentsEx);
end;
function cxMakeTextRows(AHandle: TCanvasHandle; AText: PWideChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer; AUserData: Pointer;
ACalcTextExtentsProc: TcxCalcTextExtentsProc): Boolean; overload;
function CheckIsLastRow(ATotalHeight, H: Integer): Boolean;
begin
with ATextParams do
if SingleLine then
Result := True
else
if (TextAlignY = taTop) and not (CalcRect or CalcRowCount) then
begin
if EditControl and not NoClip then
Result := ATotalHeight + FullRowHeight > H
else
Result := ATotalHeight > H
end
else
Result := (AMaxLineCount > 0) and (ACount = AMaxLineCount);
end;
var
P, ATextEnd, ANextLine: PWideChar;
ATextRow: PcxTextRow;
AIsLastRow, ARectIsSmall, APreSpecial, ACalculate: Boolean;
ATotalHeight, H, W, AOffset: Integer;
ATextRowFormat: TcxTextRowFormat;
begin
cxResetTextRows(ATextRows);
ARectIsSmall := False;
ACount := 0;
if ATextLength > 0 then
begin
if ATextParams.CalcRect and ATextParams.SingleLine then
begin
ACount := 1;
ValidateTextRows(ATextRows, ACount);
ATextRow := cxGetTextRow(ATextRows, 0);
ATextRow.Text := AText;
ATextRow.TextLength := ATextLength;
cxCalcTextRowExtents(AHandle, ATextRow, ATextParams, AUserData, ACalcTextExtentsProc);
end
else
begin
P := AText;
AOffset := 0;
ATotalHeight := 0;
W := R.Right - R.Left;
ACalculate := ATextParams.CalcRect or ATextParams.CalcRowCount;
H := R.Bottom - R.Top;
ATextEnd := AText + ATextLength;
AIsLastRow := False;
MakeTextRowFormat(ATextParams, ATextRowFormat);
APreSpecial := not ATextParams.NoClip and ATextParams.EndEllipsis and
not ACalculate and not (ATextParams.TextAlignX in [taJustifyX, taDistributeX]);
while (P < ATextEnd) and not AIsLastRow do
begin
Inc(ACount);
ValidateTextRows(ATextRows, ACount);
Inc(ATotalHeight, ATextParams.FullRowHeight);
AIsLastRow := CheckIsLastRow(ATotalHeight, H);
ATextRow := cxGetTextRow(ATextRows, ACount - 1);
ATextRowFormat.Special := AIsLastRow and APreSpecial;
ANextLine := GetLineBreak(AHandle, P, ATextLength, W, ATextRowFormat,
ATextRow, ACalcTextExtentsProc, AUserData);
Dec(ATextLength, ANextLine - P);
P := ANextLine;
ATextRow.StartOffset := AOffset;
cxCalcTextRowExtents(AHandle, ATextRow, ATextParams, AUserData, ACalcTextExtentsProc);
AOffset := P - AText;
if not AIsLastRow then
AIsLastRow := ATextLength = 0;
if (AMaxLineCount > 0) and (ACount = AMaxLineCount) then
Break;
end;
if not ACalculate and (ACount > 0) then
begin
if ATextRowFormat.SingleLine then
ARectIsSmall := ATextRow.TextExtents.cx > W
else
ARectIsSmall := ATextLength > 0;
end;
end;
end;
Result := not ARectIsSmall;
end;
function cxMakeTextRows(ACanvas: TCanvas;
AText: PWideChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer = 0): Boolean; overload;
begin
Result := cxMakeTextRows(ACanvas.Handle, AText, ATextLength, R, ATextParams,
ATextRows, ACount, AMaxLineCount);
end;
// ANSI to WideString convertors
function AnsiStringToWideString(const S: AnsiString;
ACharSet: Byte): WideString; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
begin
Result := dxAnsiStringToWideString(S, dxGetCodePageFromCharset(ACharSet));
end;
function AnsiStringToWideString(const S: AnsiString; DC: TCanvasHandle;
AFont: TFont): WideString; overload; {$IFDEF DELPHI9} inline; {$ENDIF}
var
ACharSet: Byte;
begin
if AFont <> nil then
ACharSet := AFont.Charset
else
ACharSet := GetTextCharset(DC);
Result := AnsiStringToWideString(S, ACharSet);
end;
function cxMakeTextRows(AHandle: TCanvasHandle; AText: PAnsiChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer; AUserData: Pointer;
ACalcTextExtentsProc: TcxCalcTextExtentsProc): Boolean; overload;
begin
ATextRows.Text := AnsiStringToWideString(AText, ATextParams.CharSet);
Result := cxMakeTextRows(AHandle, PWideChar(ATextRows.Text),
Length(ATextRows.Text), R, ATextParams, ATextRows, ACount,
AMaxLineCount, AUserData, ACalcTextExtentsProc);
end;
function cxMakeTextRows(ACanvas: TCanvas; AText: PAnsiChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer = 0): Boolean; overload;
begin
ATextRows.Text := AnsiStringToWideString(AText, ATextParams.CharSet);
Result := cxMakeTextRows(ACanvas.Handle, PWideChar(ATextRows.Text),
Length(ATextRows.Text), R, ATextParams, ATextRows, ACount, AMaxLineCount);
end;
function cxMakeTextRows(AHandle: TCanvasHandle; AText: PAnsiChar; ATextLength: Integer;
const R: TRect; const ATextParams: TcxTextParams; var ATextRows: TcxTextRows;
out ACount: Integer; AMaxLineCount: Integer = 0): Boolean; overload;
begin
ATextRows.Text := AnsiStringToWideString(AText, ATextParams.CharSet);
Result := cxMakeTextRows(AHandle, PWideChar(ATextRows.Text),
Length(ATextRows.Text), R, ATextParams, ATextRows, ACount, AMaxLineCount);
end;
procedure cxPlaceTextRows(AHandle: TCanvasHandle; const R: TRect; var ATextParams: TcxTextParams;
const ATextRows: TcxTextRows; 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 cxGetTextRow(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 cxPrepareRect(const R: TRect; const ATextParams: TcxTextParams;
ALeftIndent, ARightIndent: Integer): TRect;
begin
Result := R;
with Result, ATextParams do
begin
if AutoIndents then
InflateRect(Result, -cxTextSpace * OnePixel, -cxTextSpace * OnePixel);
Inc(Left, ALeftIndent * OnePixel);
Dec(Right, ARightIndent * OnePixel);
end;
end;
function cxUnprepareRect(const R: TRect; const ATextParams: TcxTextParams;
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, cxTextSpace * OnePixel, cxTextSpace * OnePixel);
end;
end;
function IsMetaFile(AHandle: TCanvasHandle): Boolean;
begin
Result := GetObjectType(AHandle) in [OBJ_METAFILE, OBJ_METADC, OBJ_ENHMETAFILE, OBJ_ENHMETADC];
end;
{$WARNINGS OFF}
procedure cxTextRowsOutHighlight(AHandle: TCanvasHandle; const R: TRect;
const ATextParams: TcxTextParams; const ATextRows: TcxTextRows; ARowCount,
ASelStart, ASelLength: Integer; ASelBkgColor, ASelTextColor: TColor; AForceEndEllipsis: Boolean);
procedure OutTextRowAsPattern(ATextRow: PcxTextRow; R: TRect);
var
ABkColor: 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;
ABkColor := SetBkColor(AHandle, ColorToRGB(clWindow));
FillRect(AHandle, R, FillPatterns[ATextParams.Bold]);
SetBkColor(AHandle, ABkColor);
end;
procedure OutTextRow(ATextRow: PcxTextRow);
var
Stub: Integer;
begin
with ATextRow^ do
if ATextParams.ExpandTabs then
begin
Stub := 0;
cxTabbedTextOutW(AHandle, TextOriginX, TextOriginY, Text, TextLength, 0, Stub, TextOriginX);
end
else
cxTextOutW(AHandle, TextOriginX, TextOriginY, Text, TextLength);
end;
procedure PrepareEndEllipsis(ATextRow: PcxTextRow; var AWidth: Integer);
var
ACharNumber: Integer;
begin
Dec(AWidth, ATextParams.EndEllipsisWidth);
if AWidth < 0 then AWidth := 0;
with ATextRow^ do
begin
if not cxGetTextExtentExPoint(AHandle, Text, TextLength, AWidth, @ACharNumber, nil) then
ACharNumber := 0;
if (ACharNumber = 0) and (ATextParams.TextAlignX = taLeft) then
ACharNumber := 1;
TextLength := ACharNumber;
end;
cxCalcTextRowExtents(AHandle, ATextRow, ATextParams);
end;
procedure OutEndEllipsis( ATextRow: PcxTextRow; var ARowRect: TRect);
const
ClipTexts: array[Boolean] of UINT = (0, ETO_CLIPPED);
var
fuOptions: UINT;
begin
Inc(ARowRect.Left, ATextRow.TextExtents.cx);
if ARowRect.Left < ARowRect.Right then
begin
fuOptions := ClipTexts[not ATextParams.NoClip and (ARowRect.Left + ATextParams.EndEllipsisWidth > ARowRect.Right)];
cxExtTextOutW(AHandle, ARowRect.Left, ATextRow.TextOriginY, fuOptions,
@ARowRect, cxEndEllipsisChars, cxEndEllipsisCharsLength, nil);
end;
end;
function GetSubstringWidth(AText: PWideChar; ATextLength, ASubstringLength: Integer): Integer;
var
ACharExtents: array of Integer;
begin
if ASubstringLength = 0 then
Result := 0
else
begin
SetLength(ACharExtents, ATextLength);
cxGetTextExtentExPoint(AHandle, AText, ATextLength, 0, nil, @ACharExtents[0]);
Result := ACharExtents[ASubstringLength - 1];
end;
end;
var
ARowRect, AHighlightRect: TRect;
W, I, F, L: Integer;
ABreakExtra: Integer;
APrevBkMode: Integer;
ASaveTextColor: TColor;
ANeedClip, ANeedEndEllipsis, AIsMetafile, AHasSelTextColor: Boolean;
ATextRow: PcxTextRow;
AHighlightStart, AHighlightEnd: Integer;
ARgn, ASaveClipRgn: HRGN;
ABrush: HBRUSH;
begin
ASelBkgColor := ColorToRGB(ASelBkgColor);
AHasSelTextColor := (ASelTextColor <> clNone) and (ASelTextColor <> clDefault);
if AHasSelTextColor then
ASelTextColor := ColorToRGB(ASelTextColor);
W := R.Right - R.Left;
APrevBkMode := SetBkMode(AHandle, Windows.TRANSPARENT);
if (ASelLength > 0) and (ASelBkgColor <> clNone) and (ASelBkgColor <> clDefault) then
ABrush := CreateSolidBrush(ASelBkgColor)
else
ABrush := 0;
AIsMetafile := IsMetaFile(AHandle);
ARowRect := R;
for I := 0 to ARowCount - 1 do
begin
ATextRow := cxGetTextRow(ATextRows, I);
with ATextRow^ do
begin
if TextLength <> 0 then
begin
ARowRect.Top := TextOriginY;
ARowRect.Bottom := ARowRect.Top + ATextParams.FullRowHeight;
if AIsMetafile or RectVisible(AHandle, ARowRect) then
begin
if ATextParams.PatternedText then
OutTextRowAsPattern(ATextRow, ARowRect)
else
begin
ANeedEndEllipsis := ATextParams.EndEllipsis and (I = ARowCount - 1) and
((TextExtents.cx > W) or AForceEndEllipsis);
ABreakExtra := 0;
if (ATextParams.TextAlignX in [taJustifyX, taDistributeX]) and not ANeedEndEllipsis then
begin
ABreakExtra := W - TextExtents.cX;
if (BreakCount <> 0) and (ABreakExtra > 0) then
SetTextJustification(AHandle, ABreakExtra, BreakCount);
end;
ANeedClip := not ATextParams.NoClip and ((TextExtents.cX > W) or
(ARowRect.Top < R.Top) or (ARowRect.Bottom > R.Bottom));
if ANeedClip then
begin
if ARowRect.Top < R.Top then ARowRect.Top := R.Top;
if ARowRect.Bottom > R.Bottom then ARowRect.Bottom := R.Bottom;
ARgn := IntersectClipRect(AHandle, ARowRect);
end;
if ANeedEndEllipsis then
PrepareEndEllipsis(ATextRow, W);
if (ASelLength > 0) and not AIsMetafile then
begin
if not ((ASelStart >= StartOffset + TextLength) or
(ASelStart + ASelLength <= StartOffset)) then
begin
F := Max(ASelStart, StartOffset);
L := Min(ASelStart + ASelLength, StartOffset + TextLength);
Dec(F, StartOffset);
Dec(L, StartOffset);
if L > F then
begin
AHighlightStart := GetSubstringWidth(Text, TextLength, F);
AHighlightEnd := GetSubstringWidth(Text, TextLength, L);
if cxGetWritingDirection(ATextParams.CharSet, Text) = coRightToLeft then
begin
AHighlightRect.Left := TextOriginX + TextExtents.cx - AHighlightEnd;
AHighlightRect.Right := TextOriginX + TextExtents.cx - AHighlightStart;
end
else
begin
AHighlightRect.Left := TextOriginX + AHighlightStart;
AHighlightRect.Right := TextOriginX + AHighlightEnd;
end;
AHighlightRect.Top := ARowRect.Top;
AHighlightRect.Bottom := ARowRect.Bottom;
if not IsRectEmpty(AHighlightRect) then
begin
ASaveClipRgn := IntersectClipRect(AHandle, AHighlightRect);
if ABrush <> 0 then
FillRect(AHandle, AHighlightRect, ABrush);
if AHasSelTextColor then
ASaveTextColor := SetTextColor(AHandle, ASelTextColor);
OutTextRow(ATextRow);
if AHasSelTextColor then
SetTextColor(AHandle, ASaveTextColor);
RestoreClipRgn(AHandle, ASaveClipRgn);
with AHighlightRect do
ExcludeClipRect(AHandle, Left, Top, Right, Bottom);
if ANeedEndEllipsis and (ASelStart + ASelLength >= StartOffset + TextLength) then
begin
ANeedEndEllipsis := False;
ASaveTextColor := SetTextColor(AHandle, ASelTextColor);
OutEndEllipsis(ATextRow, ARowRect);
SetTextColor(AHandle, ASaveTextColor);
end;
end;
end;
end
end;
OutTextRow(ATextRow);
if ANeedEndEllipsis then
OutEndEllipsis(ATextRow, ARowRect);
if ANeedClip then
RestoreClipRgn(AHandle, ARgn);
if ABreakExtra > 0 then
SetTextJustification(AHandle, 0, 0);
end;
end;
end
else
if AForceEndEllipsis and ATextParams.EndEllipsis and (I = ARowCount - 1) then
begin
ARowRect.Top := TextOriginY;
ARowRect.Bottom := ARowRect.Top + ATextParams.FullRowHeight;
PrepareEndEllipsis(ATextRow, W);
OutEndEllipsis(ATextRow, ARowRect);
end;
end;
end;
if ABrush <> 0 then
DeleteObject(ABrush);
SetBkMode(AHandle, APrevBkMode);
end;
{$WARNINGS ON}
function cxGetLongestTextRowWidth(const ATextRows: TcxTextRows; ARowCount: Integer): Integer;
var
I, W: Integer;
begin
if ARowCount > cxGetTextRowCount(ATextRows) then
ARowCount := cxGetTextRowCount(ATextRows);
Result := 0;
for I := 0 to ARowCount - 1 do
begin
W := cxGetTextRow(ATextRows, I).TextExtents.cx;
if W > Result then Result := W;
end;
end;
function CanProcessText(const ATextParams: TcxTextParams; const ATextRect: TRect): Boolean;
begin
if ATextParams.CalcRect then
Result := (ATextRect.Right - ATextRect.Left) > 0
else
Result := ((ATextRect.Right - ATextRect.Left) > 0) and ((ATextRect.Bottom - ATextRect.Top) > 0);
end;
function cxTextOut(AHandle: TCanvasHandle; const AText: WideString; var R: TRect;
AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer; AFont: TFont;
ASelBkgColor, ASelTextColor: TColor; AMaxLineCount: Integer = 0;
ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer;
var
APrevFont: HFONT;
APrevFontColor: COLORREF;
ATextHeight, ARowCount, ATextLength: Integer;
ATextParams: TcxTextParams;
ATextRect: TRect;
ATextRows: TcxTextRows;
AForceEndEllipsis: Boolean;
ATextPtr: PWideChar;
AHidePrefixStr: WideString;
begin
Result := 0;
ATextLength := Length(AText);
if ATextLength = 0 then Exit;
APrevFont := GetCurrentObject(AHandle, OBJ_FONT);
APrevFontColor := GetTextColor(AHandle);
if AFont <> nil then
begin
APrevFont := SelectObject(AHandle, AFont.Handle);
SetTextColor(AHandle, ColorToRGB(AFont.Color));
end;
if ATextColor <> clDefault then
SetTextColor(AHandle, ColorToRGB(ATextColor));
ATextParams := cxCalcTextParams(AHandle, AFormat, ALineSpacingFactor);
ATextRect := cxPrepareRect(R, ATextParams, ALeftIndent, ARightIndent);
ATextHeight := 0;
if CanProcessText(ATextParams, ATextRect) then
begin
if ATextParams.HidePrefix then
begin
AHidePrefixStr := RemoveAccelChars(AText, False);
ATextLength := Length(AHidePrefixStr);
if ATextLength = 0 then Exit;
ATextPtr := PWideChar(AHidePrefixStr);
end
else
ATextPtr := PWideChar(AText);
AForceEndEllipsis := not cxMakeTextRows(AHandle, ATextPtr, ATextLength,
ATextRect, ATextParams, ATextRows, ARowCount, AMaxLineCount);
if ARowCount <> 0 then
try
if ATextParams.CalcRect then
begin
if (AMaxLineCount > 0) and (AMaxLineCount < ARowCount) then
ARowCount := AMaxLineCount;
ATextRect.Right := ATextRect.Left + cxGetLongestTextRowWidth(ATextRows, ARowCount);
if not ATextParams.SingleLine then
begin
cxResetTextRows(ATextRows);
cxMakeTextRows(AHandle, ATextPtr, ATextLength, ATextRect, ATextParams,
ATextRows, ARowCount, AMaxLineCount);
end;
cxPlaceTextRows(AHandle, ATextRect, ATextParams, ATextRows, ARowCount);
ATextRect.Bottom := cxGetTextRow(ATextRows, ARowCount - 1).TextOriginY + ATextParams.RowHeight;
R := cxUnprepareRect(ATextRect, ATextParams, ALeftIndent, ARightIndent);
end
else
begin
cxPlaceTextRows(AHandle, ATextRect, ATextParams, ATextRows, ARowCount);
if (ASelStart < 0) or (ASelStart >= ATextLength) then
ASelLength := 0
else
if (ASelLength + ASelStart) > ATextLength then
ASelLength := ATextLength - ASelStart;
cxTextRowsOutHighlight(AHandle, ATextRect, ATextParams, ATextRows,
ARowCount, ASelStart, ASelLength, ASelBkgColor, ASelTextColor, AForceEndEllipsis);
end;
ATextHeight := cxGetTextRow(ATextRows, ARowCount - 1).TextOriginY + ATextParams.RowHeight - ATextRect.Top;
finally
cxResetTextRows(ATextRows);
end;
end;
if ATextParams.CalcRowCount or (ATextHeight = 0) then
Result := ARowCount
else
Result := ATextHeight;
SelectObject(AHandle, APrevFont);
SetTextColor(AHandle, APrevFontColor);
end;
function cxTextOut(AHandle: TCanvasHandle; const AText: WideString; var R: TRect;
AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AFont: TFont = nil;
AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer;
begin
Result := cxTextOut(AHandle, AText, R, AFormat, 0, 0, AFont, clDefault, clDefault,
AMaxLineCount, ALeftIndent, ARightIndent, ATextColor, ALineSpacingFactor);
end;
function cxTextOut(ACanvas: TCanvas; const AText: WideString; var R: TRect;
AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer; AFont: TFont;
ASelBkgColor, ASelTextColor: TColor; AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0;
ARightIndent: Integer = 0; ATextColor: TColor = clDefault;
const ALineSpacingFactor: Double = 1.0): Integer;
begin
Result := cxTextOut(ACanvas.Handle, AText, R, AFormat, ASelStart, ASelLength,
AFont, ASelBkgColor, ASelTextColor, AMaxLineCount, ALeftIndent, ARightIndent,
ATextColor, ALineSpacingFactor);
end;
function cxTextOut(ACanvas: TCanvas; const AText: WideString; var R: TRect;
AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AFont: TFont = nil;
AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer;
begin
Result := cxTextOut(ACanvas, AText, R, AFormat, 0, 0, AFont, clDefault,
clDefault, AMaxLineCount, ALeftIndent, ARightIndent, ATextColor, ALineSpacingFactor);
end;
//Support for AnsiStrings
function cxTextOut(AHandle: TCanvasHandle; const AText: AnsiString; var R: TRect;
AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer; AFont: TFont;
ASelBkgColor, ASelTextColor: TColor; AMaxLineCount: Integer = 0;
ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer;
begin
Result := cxTextOut(AHandle,
AnsiStringToWideString(AText, AHandle, AFont),
R, AFormat, ASelStart, ASelLength, AFont, ASelBkgColor, ASelTextColor,
AMaxLineCount, ALeftIndent, ARightIndent, ATextColor, ALineSpacingFactor);
end;
function cxTextOut(AHandle: TCanvasHandle; const AText: AnsiString; var R: TRect;
AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AFont: TFont = nil;
AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer; overload;
begin
Result := cxTextOut(AHandle,
AnsiStringToWideString(AText, AHandle, AFont),
R, AFormat, 0, 0, AFont, clDefault, clDefault, AMaxLineCount, ALeftIndent,
ARightIndent, ATextColor, ALineSpacingFactor);
end;
function cxTextOut(ACanvas: TCanvas; const AText: AnsiString; var R: TRect;
AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer; AFont: TFont;
ASelBkgColor, ASelTextColor: TColor; AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0;
ARightIndent: Integer = 0; ATextColor: TColor = clDefault;
const ALineSpacingFactor: Double = 1.0): Integer; overload;
begin
Result := cxTextOut(ACanvas.Handle,
AnsiStringToWideString(AText, ACanvas.Handle, AFont),
R, AFormat, ASelStart, ASelLength, AFont, ASelBkgColor, ASelTextColor,
AMaxLineCount, ALeftIndent, ARightIndent, ATextColor, ALineSpacingFactor);
end;
function cxTextOut(ACanvas: TCanvas; const AText: AnsiString; var R: TRect;
AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AFont: TFont = nil;
AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0;
ATextColor: TColor = clDefault; const ALineSpacingFactor: Double = 1.0): Integer; overload;
begin
Result := cxTextOut(ACanvas.Handle,
AnsiStringToWideString(AText, ACanvas.Handle, AFont),
R, AFormat, 0, 0, AFont, clDefault, clDefault, AMaxLineCount, ALeftIndent,
ARightIndent, ATextColor, ALineSpacingFactor);
end;
procedure cxRotatedTextOut(AHandle: TCanvasHandle; const ABounds: TRect; const AText: WideString; AFont: TFont;
AAlignHorz: TcxTextAlignX = taCenterX; AAlignVert: TcxTextAlignY = taCenterY; AWordBreak: Boolean = True;
ALeftExceed: Boolean = True; ARightExceed: Boolean = True; ADirection: TcxVerticalTextOutDirection = vtdBottomToTop;
AFontSize: Integer = 0);
const
Angles: array[TcxVerticalTextOutDirection] of Integer = (-900, 900);
Flags: array[TcxVerticalTextOutDirection] of Integer =
(TA_LEFT or TA_BOTTOM or TA_NOUPDATECP, TA_LEFT or TA_TOP or TA_NOUPDATECP);
procedure AddRow(AList: TList; AFirstChar: PWideChar; ACount, AWidth: Integer);
begin
AList.Add(AFirstChar);
AList.Add(Pointer(ACount));
AList.Add(Pointer(AWidth));
end;
function CreateRotatedFont: HFONT;
var
ALogFontW: TLogFontW;
ALogFontA: TLogFontA;
begin
if IsWinNT then
begin
FillChar(ALogFontW, SizeOf(ALogFontW), 0);
GetObject(AFont.Handle, SizeOf(TLogFontW), @ALogFontW);
if AFontSize <> 0 then
ALogFontW.lfHeight := -MulDiv(AFontSize, GetDeviceCaps(AHandle, LOGPIXELSY), 72);
ALogFontW.lfEscapement := Angles[ADirection];
ALogFontW.lfOutPrecision := OUT_TT_ONLY_PRECIS;
Result := CreateFontIndirectW(ALogFontW);
end
else
begin
FillChar(ALogFontA, SizeOf(ALogFontA), 0);
GetObject(AFont.Handle, SizeOf(TLogFontA), @ALogFontA);
if AFontSize <> 0 then
ALogFontA.lfHeight := -MulDiv(AFontSize, GetDeviceCaps(AHandle, LOGPIXELSY), 72);
ALogFontA.lfEscapement := Angles[ADirection];
ALogFontA.lfOutPrecision := OUT_TT_ONLY_PRECIS;
Result := CreateFontIndirectA(ALogFontA);
end;
end;
function TextSize(ACurrentChar: PWideChar; ACharCount: Integer): TSize;
begin
cxGetTextExtentPoint32W(AHandle, ACurrentChar, ACharCount, Result);
end;
function TextWidth(const AFirstChar: PWideChar; ACharCount: Integer): Integer;
var
ASize: TSize;
begin
cxGetTextExtentPoint32W(AHandle, AFirstChar, ACharCount, ASize);
Result := ASize.cx;
end;
function MakeRow(var AFirstChar: PWideChar; ALastChar: PWideChar;
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);
Inc(ALastChar);
end;
AFirstChar := ALastChar;
Result := ACharCount - ARowCharCount;
end;
procedure CalculateWordWrappedTextRows(AFirstChar: PWideChar;
ACharCount, ATextWidth: Integer; ATextRows: TList);
var
ACurrentChar, APrevBreakChar: PWideChar;
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
Inc(ACurrentChar);
Inc(APos);
AIsBreakChar := (ACurrentChar^ = Space) or (ACurrentChar^ = CR) or (ACurrentChar^ = LF);
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^ = CR) or (ACurrentChar^ = LF))) 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
cxGetTextExtentPoint32W(AHandle, '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
cxExtTextOutW(AHandle, ALeft, ATop, 0{ETO_CLIPPED}, @ATextBounds,
PWideChar(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
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(AHandle, CreateRotatedFont);
AMode := SetBkMode(AHandle, Windows.TRANSPARENT);
ATextRows := TList.Create;
try
ATextRows.Capacity := Length(AText) * 3;
SetTextAlign(AHandle, 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(AHandle, AMode);
AFontHandle := SelectObject(AHandle, AFontHandle);
DeleteObject(AFontHandle);
ATextRows.Free;
end;
end;
procedure cxRotatedTextOut(AHandle: TCanvasHandle; const ABounds: TRect; const AText: AnsiString; AFont: TFont;
AAlignHorz: TcxTextAlignX = taCenterX; AAlignVert: TcxTextAlignY = taCenterY; AWordBreak: Boolean = True;
ALeftExceed: Boolean = True; ARightExceed: Boolean = True; ADirection: TcxVerticalTextOutDirection = vtdBottomToTop;
AFontSize: Integer = 0);
begin
cxRotatedTextOut(AHandle, ABounds,
AnsiStringToWideString(AText, AHandle, AFont),
AFont, AAlignHorz, AAlignVert, AWordBreak, ALeftExceed, ARightExceed,
ADirection, AFontSize);
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 CreateFillPattern(AIsBold: Boolean): HBRUSH;
var
ABits: Pointer ;
ABitmap: HBITMAP;
begin
if AIsBold then
ABits := @BoldPatternBits
else
ABits := @StandardPatternBits;
ABitmap := CreateBitmap(8, 8, 1, 1, ABits);
try
Result := CreatePatternBrush(ABitmap);
finally
DeleteObject(ABitmap);
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;
initialization
CreateFillPatterns;
finalization
DestroyFillPatterns;
end.