3177 lines
92 KiB
ObjectPascal
3177 lines
92 KiB
ObjectPascal
|
|
||
|
|
{********************************************************************}
|
||
|
|
{ }
|
||
|
|
{ Developer Express Visual Component Library }
|
||
|
|
{ Express Cross Platform Library graphics classes }
|
||
|
|
{ }
|
||
|
|
{ Copyright (c) 2000-2006 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 cxGraphics;
|
||
|
|
|
||
|
|
{$I cxVer.inc}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
{$IFDEF DELPHI6}
|
||
|
|
Types,
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Windows,
|
||
|
|
{$ELSE}
|
||
|
|
Qt,
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFDEF CLR}
|
||
|
|
System.Runtime.InteropServices,
|
||
|
|
{$ENDIF}
|
||
|
|
Classes, SysUtils, Controls, Graphics, ImgList, cxClasses;
|
||
|
|
|
||
|
|
const
|
||
|
|
cxAlignLeft = 1;
|
||
|
|
cxAlignRight = 2;
|
||
|
|
cxAlignHCenter = 4;
|
||
|
|
cxAlignTop = 8;
|
||
|
|
cxAlignBottom = 16;
|
||
|
|
cxAlignVCenter = 32;
|
||
|
|
cxAlignCenter = 36;
|
||
|
|
cxSingleLine = 64;
|
||
|
|
cxDontClip = 128;
|
||
|
|
cxExpandTabs = 256;
|
||
|
|
cxShowPrefix = 512;
|
||
|
|
cxWordBreak = 1024;
|
||
|
|
cxShowEndEllipsis = 2048;
|
||
|
|
cxDontPrint = 4096;
|
||
|
|
cxShowPathEllipsis = 8192;
|
||
|
|
cxDontBreakChars = 16384;
|
||
|
|
|
||
|
|
{$IFNDEF DELPHI6}
|
||
|
|
clMoneyGreen = TColor($C0DCC0);
|
||
|
|
clSkyBlue = TColor($F0CAA6);
|
||
|
|
clCream = TColor($F0FBFF);
|
||
|
|
clMedGray = TColor($A4A0A0);
|
||
|
|
{$ENDIF}
|
||
|
|
clcxLightGray = $CFCFCF;
|
||
|
|
|
||
|
|
cxEmptyRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
|
||
|
|
|
||
|
|
cxDesignSelectionWidth = 2;
|
||
|
|
|
||
|
|
cxDefaultAlphaValue = 200;
|
||
|
|
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
cxHalfToneBrush: TBrush = nil;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
type
|
||
|
|
IcxFontListener = interface
|
||
|
|
['{B144DD7E-0B27-439A-B908-FC3ACFE6A2D3}']
|
||
|
|
procedure Changed(Sender: TObject; AFont: TFont);
|
||
|
|
end;
|
||
|
|
|
||
|
|
TcxBorder = (bLeft, bTop, bRight, bBottom);
|
||
|
|
TcxBorders = set of TcxBorder;
|
||
|
|
|
||
|
|
const
|
||
|
|
cxBordersAll = [bLeft, bTop, bRight, bBottom];
|
||
|
|
|
||
|
|
type
|
||
|
|
TBrushHandle = {$IFDEF VCL}HBRUSH{$ELSE}QBrushH{$ENDIF};
|
||
|
|
|
||
|
|
TPointArray = array of TPoint;
|
||
|
|
TRectArray = array of TRect;
|
||
|
|
|
||
|
|
TcxColorPart = -100..100;
|
||
|
|
|
||
|
|
TcxGridLines = (glBoth, glNone, glVertical, glHorizontal);
|
||
|
|
|
||
|
|
PcxViewParams = ^TcxViewParams;
|
||
|
|
TcxViewParams = record
|
||
|
|
Bitmap: TBitmap;
|
||
|
|
Color: TColor;
|
||
|
|
Font: TFont;
|
||
|
|
TextColor: TColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TcxRegion }
|
||
|
|
|
||
|
|
TcxRegionHandle = {$IFDEF VCL}HRGN{$ELSE}QRegionH{$ENDIF};
|
||
|
|
TcxRegionOperation = (roSet, roAdd, roSubtract, roIntersect);
|
||
|
|
|
||
|
|
TcxRegion = class {6}
|
||
|
|
private
|
||
|
|
FHandle: TcxRegionHandle;
|
||
|
|
function GetIsEmpty: Boolean;
|
||
|
|
protected
|
||
|
|
procedure DestroyHandle;
|
||
|
|
public
|
||
|
|
constructor Create(AHandle: TcxRegionHandle); overload;
|
||
|
|
constructor Create(const ABounds: TRect); overload;
|
||
|
|
constructor Create; overload;
|
||
|
|
constructor Create(ALeft, ATop, ARight, ABottom: Integer); overload;
|
||
|
|
destructor Destroy; override;
|
||
|
|
|
||
|
|
procedure Combine(ARegion: TcxRegion; AOperation: TcxRegionOperation;
|
||
|
|
ADestroyRegion: Boolean = True);
|
||
|
|
function IsEqual(ARegion: TcxRegion): Boolean; overload;
|
||
|
|
function IsEqual(ARegionHandle: TcxRegionHandle): Boolean; overload;
|
||
|
|
procedure Offset(DX, DY: Integer);
|
||
|
|
function PtInRegion(const Pt: TPoint): Boolean; overload;
|
||
|
|
function PtInRegion(X, Y: Integer): Boolean; overload;
|
||
|
|
function RectInRegion(const R: TRect): Boolean; overload;
|
||
|
|
function RectInRegion(ALeft, ATop, ARight, ABottom: Integer): Boolean; overload;
|
||
|
|
|
||
|
|
property Handle: TcxRegionHandle read FHandle write FHandle;
|
||
|
|
property IsEmpty: Boolean read GetIsEmpty;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TcxCanvas }
|
||
|
|
|
||
|
|
TcxRotationAngle = (ra0, raPlus90, raMinus90{$IFDEF VCL}, ra180{$ENDIF});
|
||
|
|
|
||
|
|
TcxCanvas = class
|
||
|
|
private
|
||
|
|
FCanvas: TCanvas;
|
||
|
|
|
||
|
|
function GetBrush: TBrush;
|
||
|
|
function GetCopyMode: TCopyMode;
|
||
|
|
function GetDCOrigin: TPoint;
|
||
|
|
function GetFont: TFont;
|
||
|
|
function GetHandle: {$IFDEF VCL}HDC{$ELSE}QPainterH{$ENDIF};
|
||
|
|
function GetPen: TPen;
|
||
|
|
function GetViewportOrg: TPoint;
|
||
|
|
function GetWindowOrg: TPoint;
|
||
|
|
procedure SetBrush(Value: TBrush);
|
||
|
|
procedure SetCopyMode(Value: TCopyMode);
|
||
|
|
procedure SetFont(Value: TFont);
|
||
|
|
procedure SetPen(Value: TPen);
|
||
|
|
procedure SetPixel(X, Y: Integer; Value: TColor);
|
||
|
|
procedure SetViewportOrg(const P: TPoint);
|
||
|
|
procedure SetWindowOrg(const P: TPoint);
|
||
|
|
public
|
||
|
|
constructor Create(ACanvas: TCanvas); virtual;
|
||
|
|
|
||
|
|
procedure AlignMultiLineTextRectVertically(var R: TRect; const AText: string;
|
||
|
|
AAlignmentVert: TcxAlignmentVert; AWordBreak, AShowPrefix: Boolean;
|
||
|
|
AEnabled: Boolean = True; ADontBreakChars: Boolean = False);
|
||
|
|
procedure CopyRect(const Dest: TRect; ACanvas: TCanvas; const Source: TRect);
|
||
|
|
procedure Draw(X, Y: Integer; Graphic: TGraphic);
|
||
|
|
procedure DrawComplexFrame(const R: TRect; ALeftTopColor, ARightBottomColor: TColor;
|
||
|
|
ABorders: TcxBorders = [bLeft, bTop, bRight, bBottom]; ABorderWidth: Integer = 1);
|
||
|
|
procedure DrawEdge(const R: TRect; ASunken, AOuter: Boolean;
|
||
|
|
ABorders: TcxBorders = [bLeft, bTop, bRight, bBottom]);
|
||
|
|
procedure DrawFocusRect(const R: TRect);
|
||
|
|
procedure DrawGlyph(X, Y: Integer; AGlyph: TBitmap; AEnabled: Boolean = True;
|
||
|
|
ABackgroundColor: TColor = clNone{; ATempCanvas: TCanvas = nil});
|
||
|
|
procedure DrawImage(Images: TCustomImageList; X, Y, Index: Integer;
|
||
|
|
Enabled: Boolean = True);
|
||
|
|
procedure DrawTexT(const Text: string; R: TRect; Flags: Integer;
|
||
|
|
Enabled: Boolean = True);
|
||
|
|
procedure FillRect(const R: TRect; ABitmap: TBitmap = nil;
|
||
|
|
AExcludeRect: Boolean = False); overload;
|
||
|
|
procedure FillRect(R: TRect; const AParams: TcxViewParams;
|
||
|
|
ABorders: TcxBorders = []; ABorderColor: TColor = clDefault;
|
||
|
|
ALineWidth: Integer = 1; AExcludeRect: Boolean = False); overload;
|
||
|
|
{$IFDEF LINUX}
|
||
|
|
procedure FillRect(const R: TRect; ABrush: TBrush); overload;
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFNDEF LINUX}
|
||
|
|
procedure DrawDesignSelection(ARect: TRect; AWidth: Integer = cxDesignSelectionWidth);
|
||
|
|
procedure DrawRegion(ARegion: TcxRegion; AContentColor: TColor = clDefault;
|
||
|
|
ABorderColor: TColor = clDefault; ABorderWidth: Integer = 1; ABorderHeight: Integer = 1); overload;
|
||
|
|
procedure DrawRegion(ARegion: TcxRegionHandle; AContentColor: TColor = clDefault;
|
||
|
|
ABorderColor: TColor = clDefault; ABorderWidth: Integer = 1; ABorderHeight: Integer = 1); overload;
|
||
|
|
procedure FillRegion(ARegion: TcxRegion; AColor: TColor = clDefault); overload;
|
||
|
|
procedure FillRegion(ARegion: TcxRegionHandle; AColor: TColor = clDefault); overload;
|
||
|
|
procedure FlipHorizontally(ABitmap: TBitmap);
|
||
|
|
procedure FrameRegion(ARegion: TcxRegion; AColor: TColor = clDefault;
|
||
|
|
ABorderWidth: Integer = 1; ABorderHeight: Integer = 1); overload;
|
||
|
|
procedure FrameRegion(ARegion: TcxRegionHandle; AColor: TColor = clDefault;
|
||
|
|
ABorderWidth: Integer = 1; ABorderHeight: Integer = 1); overload;
|
||
|
|
procedure Pie(const R: TRect; const ARadial1, ARadial2: TPoint); overload;
|
||
|
|
procedure Pie(const R: TRect; AStartAngle, ASweepAngle: Integer); overload;
|
||
|
|
{$ENDIF}
|
||
|
|
function FontHeight(AFont: TFont): Integer;
|
||
|
|
procedure FrameRect(const R: TRect; Color: TColor = clDefault;
|
||
|
|
ALineWidth: Integer = 1; ABorders: TcxBorders = cxBordersAll;
|
||
|
|
AExcludeFrame: Boolean = False);
|
||
|
|
procedure InvertFrame(const R: TRect; ABorderSize: Integer);
|
||
|
|
procedure InvertRect({$IFNDEF LINUX}const {$ENDIF}R: TRect);
|
||
|
|
procedure LineTo(X, Y: Integer);
|
||
|
|
procedure MoveTo(X, Y: Integer);
|
||
|
|
procedure Polygon(const Points: array of TPoint);
|
||
|
|
procedure Polyline(const Points: array of TPoint);
|
||
|
|
procedure RotateBitmap(ABitmap: TBitmap; ARotationAngle: TcxRotationAngle;
|
||
|
|
AFlipVertically: Boolean = False);
|
||
|
|
function TextExtent(const Text: string): TSize; overload;
|
||
|
|
procedure TextExtent(const Text: string; var R: TRect; Flags: Integer); overload;
|
||
|
|
function TextHeight(const Text: string): Integer;
|
||
|
|
function TextWidth(const Text: string): Integer;
|
||
|
|
procedure TransparentDraw(X, Y: Integer; ABitmap: TBitmap; AAlpha: Byte;
|
||
|
|
ABackground: TBitmap = nil);
|
||
|
|
|
||
|
|
procedure GetParams(var AParams: TcxViewParams);
|
||
|
|
procedure SetParams(AParams: TcxViewParams);
|
||
|
|
procedure SetBrushColor(Value: TColor);
|
||
|
|
procedure SetFontAngle(Value: Integer);
|
||
|
|
|
||
|
|
{$IFDEF VCL}
|
||
|
|
procedure GetTextStringsBounds(Text: string; R: TRect; Flags: Integer;
|
||
|
|
Enabled: Boolean; var ABounds: TRectArray);
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
{$IFNDEF LINUX}
|
||
|
|
procedure BeginPath;
|
||
|
|
procedure EndPath;
|
||
|
|
function PathToRegion: TcxRegion;
|
||
|
|
procedure WidenPath;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
// clipping
|
||
|
|
procedure ExcludeClipRect(const R: TRect);
|
||
|
|
procedure IntersectClipRect(const R: TRect);
|
||
|
|
function GetClipRegion(AConsiderOrigin: Boolean = True): TcxRegion;
|
||
|
|
procedure SetClipRegion(ARegion: TcxRegion; AOperation: TcxRegionOperation;
|
||
|
|
ADestroyRegion: Boolean = True; AConsiderOrigin: Boolean = True);
|
||
|
|
function RectFullyVisible(const R: TRect): Boolean;
|
||
|
|
function RectVisible({$IFDEF VCL}const {$ENDIF}R: TRect): Boolean;
|
||
|
|
|
||
|
|
property Brush: TBrush read GetBrush write SetBrush;
|
||
|
|
property Canvas: TCanvas read FCanvas write FCanvas;
|
||
|
|
property CopyMode: TCopyMode read GetCopyMode write SetCopyMode;
|
||
|
|
property DCOrigin: TPoint read GetDCOrigin;
|
||
|
|
property Font: TFont read GetFont write SetFont;
|
||
|
|
property Handle: {$IFDEF VCL}HDC{$ELSE}QPainterH{$ENDIF} read GetHandle;
|
||
|
|
property Pen: TPen read GetPen write SetPen;
|
||
|
|
property Pixels[X, Y: Integer]: TColor write SetPixel;
|
||
|
|
property ViewportOrg: TPoint read GetViewportOrg write SetViewportOrg;
|
||
|
|
property WindowOrg: TPoint read GetWindowOrg write SetWindowOrg;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TcxScreenCanvas }
|
||
|
|
|
||
|
|
TcxScreenCanvas = class(TcxCanvas)
|
||
|
|
public
|
||
|
|
constructor Create; reintroduce; virtual;
|
||
|
|
destructor Destroy; override;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TcxBitmap }
|
||
|
|
|
||
|
|
TcxBitmap = class(TBitmap)
|
||
|
|
public
|
||
|
|
procedure Assign(Source: TPersistent); override;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TRGBColors = array of TRGBQuad;
|
||
|
|
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
|
||
|
|
{ TcxBrushCache }
|
||
|
|
|
||
|
|
TcxBrushData = record
|
||
|
|
Brush: TBrush;
|
||
|
|
Color: TColor;
|
||
|
|
RefCount: Integer;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TcxBrushesData = array of TcxBrushData;
|
||
|
|
|
||
|
|
EBrushCache = class(Exception);
|
||
|
|
|
||
|
|
TcxBrushCache = class
|
||
|
|
private
|
||
|
|
FCapacity: Integer;
|
||
|
|
FCount: Integer;
|
||
|
|
FData: TcxBrushesData;
|
||
|
|
FDeletedCount: Integer;
|
||
|
|
FLockRef: Integer;
|
||
|
|
protected
|
||
|
|
function Add(AColor: TColor): TBrush;
|
||
|
|
function AddItemAt(AIndex: Integer; AColor: TColor): TBrush;
|
||
|
|
procedure CacheCheck(Value: Boolean; const AMessage: string);
|
||
|
|
procedure Delete(AIndex: Integer);
|
||
|
|
function IndexOf(AColor: TColor; out AIndex: Integer): Boolean;
|
||
|
|
procedure InitItem(var AItem: TcxBrushData; AColor: TColor);
|
||
|
|
function IsSystemBrush(ABrush: TBrush): Boolean;
|
||
|
|
function FindNearestItem(AColor: TColor): Integer;
|
||
|
|
procedure Move(ASrc, ADst, ACount: Integer);
|
||
|
|
procedure Pack;
|
||
|
|
procedure Recreate;
|
||
|
|
procedure Release(AIndex: Integer);
|
||
|
|
public
|
||
|
|
destructor Destroy; override;
|
||
|
|
procedure BeginUpdate;
|
||
|
|
procedure EndUpdate;
|
||
|
|
procedure ReleaseBrush(var ABrush: TBrush);
|
||
|
|
procedure SetBrushColor(var ABrush: TBrush; AColor: TColor);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
function cxFlagsToDTFlags(Flags: Integer): Integer;
|
||
|
|
|
||
|
|
procedure ExtendRect(var Rect: TRect; const AExtension: TRect);
|
||
|
|
|
||
|
|
function GetRealColor(AColor: TColor): TColor;
|
||
|
|
|
||
|
|
// light colors
|
||
|
|
function GetLightColor(ABtnFaceColorPart, AHighlightColorPart, AWindowColorPart: TcxColorPart): TColor;
|
||
|
|
function GetLightBtnFaceColor: TColor;
|
||
|
|
function GetLightDownedColor: TColor;
|
||
|
|
function GetLightDownedSelColor: TColor;
|
||
|
|
function GetLightSelColor: TColor;
|
||
|
|
|
||
|
|
{!!! TODO: adapt to .net}
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
procedure cxSmoothResizeBitmap(ASource, ADestination: TBitmap; AForceUseLanczos3Filter: Boolean = False);
|
||
|
|
|
||
|
|
// mouse cursor size
|
||
|
|
function cxGetCursorSize: TSize;
|
||
|
|
|
||
|
|
// image helper routines
|
||
|
|
procedure cxAlphaBlend(ASource: TBitmap; ARect: TRect; const ASelColor: TColor; Alpha: Byte = 170); overload;
|
||
|
|
procedure cxAlphaBlend(ADest, ABkSource, ASource: TBitmap; Alpha: Byte = cxDefaultAlphaValue); overload;
|
||
|
|
procedure cxAlphaBlend(ADestBitmap, ASrcBitmap: TBitmap; const ADestRect, ASrcRect: TRect; AConstantAlpha: Byte = $FF); overload;
|
||
|
|
procedure cxAlphaBlend(ADestDC: HDC; ASrcBitmap: TBitmap; const ADestRect, ASrcRect: TRect; AConstantAlpha: Byte = $FF); overload;
|
||
|
|
procedure cxApplyViewParams(ACanvas: TcxCanvas; const AViewParams: TcxViewParams);
|
||
|
|
procedure cxBlendFunction(const ASource: TRGBQuad; var ADest: TRGBQuad; ASourceConstantAlpha: Byte);
|
||
|
|
function cxCreateBitmap(const ASize: TSize; AFormat: TPixelFormat = pf24bit): TBitmap; overload;
|
||
|
|
function cxCreateBitmap(AWidth, AHeight: Integer; AFormat: TPixelFormat = pf24bit): TBitmap; overload;
|
||
|
|
function cxCreateTrueColorBitmap(const ASize: TSize): TBitmap; overload;
|
||
|
|
function cxCreateTrueColorBitmap(AWidth, AHeight: Integer): TBitmap; overload;
|
||
|
|
function cxCreateTrueColorBitmapHandle(AWidth, AHeight: Integer; ABPP: Integer = 32): HBitmap;
|
||
|
|
procedure cxCopyImage(ASource, ADest: TBitmap; const ASrcOffset, ADstOffset: TPoint; const ARect: TRect); overload;
|
||
|
|
procedure cxCopyImage(ASource, ADest: TCanvas; const ASrcOffset, ADstOffset: TPoint; const ARect: TRect); overload;
|
||
|
|
procedure cxDrawArrows(ACanvas: TCanvas; const ARect: TRect;
|
||
|
|
ASide: TcxBorder; AColor: TColor; APenColor: TColor = clDefault);
|
||
|
|
procedure cxFillHalfToneRect(Canvas: TCanvas; const ARect: TRect; ABkColor, AColor: TColor);
|
||
|
|
procedure cxSetCanvasOrg(ACanvas: TCanvas; var AOrg: TRect);
|
||
|
|
function cxTextHeight(AFont: TFont; const S: string = 'Wg'; AFontSize: Integer = 0): Integer;
|
||
|
|
function cxTextExtent(AFont: TFont; const S: string; AFontSize: Integer = 0): TSize;
|
||
|
|
function cxTextWidth(AFont: TFont; const S: string; AFontSize: Integer = 0): Integer;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
function cxDrawText(ADC: HDC; const AText: string; var ARect: TRect; AFormat: UINT; ACharCount: Integer = - 1): Integer;
|
||
|
|
function cxTextSize(ADC: HDC; const AText: string): TSize;
|
||
|
|
function cxGetTextRect(ADC: HDC; const AText: string; ARowCount: Integer; AReturnMaxRectHeight: Boolean = False): TRect; overload;
|
||
|
|
function cxGetTextRect(AFont: TFont; const AText: string; ARowCount: Integer): TRect; overload;
|
||
|
|
|
||
|
|
function cxGetWritingDirection(AFontCharset: TFontCharset; const AText: string): TCanvasOrientation;
|
||
|
|
procedure cxDrawThemeParentBackground(AControl: TWinControl; ACanvas: TcxCanvas; const ARect: TRect); overload;
|
||
|
|
procedure cxDrawThemeParentBackground(AControl: TWinControl; ACanvas: TCanvas; const ARect: TRect); overload;
|
||
|
|
procedure cxDrawTransparentControlBackground(AControl: TWinControl;
|
||
|
|
ACanvas: TcxCanvas; ARect: TRect; APaintParentWithChildren: Boolean = True); overload;
|
||
|
|
procedure cxDrawTransparentControlBackground(AControl: TWinControl;
|
||
|
|
ACanvas: TCanvas; const ARect: TRect; APaintParentWithChildren: Boolean = True); overload;
|
||
|
|
function cxScreenCanvas: TcxScreenCanvas;
|
||
|
|
|
||
|
|
{$IFDEF CLR}
|
||
|
|
[DllImport(gdi32, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'GetDIBits')]
|
||
|
|
function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT;
|
||
|
|
[out] Bits: TRGBColors; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external;
|
||
|
|
|
||
|
|
[DllImport(gdi32, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'SetDIBits')]
|
||
|
|
function SetDIBits(DC: HDC; Bitmap: HBITMAP; StartScan, NumScans: UINT;
|
||
|
|
[in] Bits: TRGBColors; const BitsInfo: TBitmapInfo; Usage: UINT): Integer; external;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
Messages, Math, Menus, cxControls, cxGeometry, dxUxTheme;
|
||
|
|
|
||
|
|
type
|
||
|
|
TCanvasAccess = class(TCanvas);
|
||
|
|
|
||
|
|
{!!! TODO: adapt to .net}
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
PContributor = ^TContributor;
|
||
|
|
TContributor = record
|
||
|
|
Pixel: Integer;
|
||
|
|
Weight: Integer;
|
||
|
|
end;
|
||
|
|
TContributorArray = array of TContributor;
|
||
|
|
|
||
|
|
TContributors = record
|
||
|
|
Count: Integer;
|
||
|
|
Contributors: TContributorArray;
|
||
|
|
end;
|
||
|
|
TContributorList = array of TContributors;
|
||
|
|
|
||
|
|
const
|
||
|
|
BaseRgns: array[0..3, 0..6, 0..1] of Integer =
|
||
|
|
(((0, -1), (-5, -6),(-2, -6), (-2, -9), (2, -9), (2, -6), (5, -6)),
|
||
|
|
((0, 0), (5, 5), (2, 5), (2, 8), (-2, 8), (-2, 5), (-5, 5)),
|
||
|
|
((-1, 0), (-6, -5), (-6, -2), (-9, -2), (-9, 2), (-6, 2), (-6, 5)),
|
||
|
|
((0, 0), (5, 5), (5, 2), (8, 2), (8, -2), (5, -2), (5, -5)));
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
const
|
||
|
|
DefaultBlendFunction: TBlendFunction =
|
||
|
|
(BlendOp: AC_SRC_OVER;
|
||
|
|
BlendFlags: 0;
|
||
|
|
SourceConstantAlpha: cxDefaultAlphaValue;
|
||
|
|
AlphaFormat: $0);
|
||
|
|
var
|
||
|
|
VCLAlphaBlend: {$IFNDEF CLR}function(DC: LongWord; p2, p3, p4, p5: Integer; DC6: LongWord;
|
||
|
|
p7, p8, p9, p10: Integer; p11: TBlendFunction): BOOL; stdcall;{$ELSE}FARPROC;{$ENDIF}
|
||
|
|
ScreenCanvas: TcxScreenCanvas = nil;
|
||
|
|
|
||
|
|
function cxFlagsToDTFlags(Flags: Integer): Integer;
|
||
|
|
begin
|
||
|
|
Result := DT_NOPREFIX;
|
||
|
|
if cxAlignLeft and Flags <> 0 then
|
||
|
|
Result := Result or DT_LEFT;
|
||
|
|
if cxAlignRight and Flags <> 0 then
|
||
|
|
Result := Result or DT_RIGHT;
|
||
|
|
if cxAlignHCenter and Flags <> 0 then
|
||
|
|
Result := Result or DT_CENTER;
|
||
|
|
if cxAlignTop and Flags <> 0 then
|
||
|
|
Result := Result or DT_TOP;
|
||
|
|
if cxAlignBottom and Flags <> 0 then
|
||
|
|
Result := Result or DT_BOTTOM;
|
||
|
|
if cxAlignVCenter and Flags <> 0 then
|
||
|
|
Result := Result or DT_VCENTER;
|
||
|
|
if cxSingleLine and Flags <> 0 then
|
||
|
|
Result := Result or DT_SINGLELINE;
|
||
|
|
if cxDontClip and Flags <> 0 then
|
||
|
|
Result := Result or DT_NOCLIP;
|
||
|
|
if cxExpandTabs and Flags <> 0 then
|
||
|
|
Result := Result or DT_EXPANDTABS;
|
||
|
|
if cxShowPrefix and Flags <> 0 then
|
||
|
|
Result := Result and not DT_NOPREFIX;
|
||
|
|
if cxWordBreak and Flags <> 0 then
|
||
|
|
begin
|
||
|
|
Result := Result or DT_WORDBREAK;
|
||
|
|
if cxDontBreakChars and Flags = 0 then
|
||
|
|
Result := Result or DT_EDITCONTROL;
|
||
|
|
end;
|
||
|
|
if cxShowEndEllipsis and Flags <> 0 then
|
||
|
|
Result := Result or DT_END_ELLIPSIS;
|
||
|
|
if cxDontPrint and Flags <> 0 then
|
||
|
|
Result := Result or DT_CALCRECT;
|
||
|
|
if cxShowPathEllipsis and Flags <> 0 then
|
||
|
|
Result := Result or DT_PATH_ELLIPSIS;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ExtendRect(var Rect: TRect; const AExtension: TRect);
|
||
|
|
begin
|
||
|
|
with AExtension do
|
||
|
|
begin
|
||
|
|
Inc(Rect.Left, Left);
|
||
|
|
Inc(Rect.Top, Top);
|
||
|
|
Dec(Rect.Right, Right);
|
||
|
|
Dec(Rect.Bottom, Bottom);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetRealColor(AColor: TColor): TColor;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
var
|
||
|
|
DC: HDC;
|
||
|
|
begin
|
||
|
|
DC := GetDC(0);
|
||
|
|
Result := GetNearestColor(DC, AColor);
|
||
|
|
ReleaseDC(0, DC);
|
||
|
|
end;
|
||
|
|
{$ELSE}
|
||
|
|
begin
|
||
|
|
Result := AColor;
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
function GetLightColor(ABtnFaceColorPart, AHighlightColorPart, AWindowColorPart: TcxColorPart): TColor;
|
||
|
|
var
|
||
|
|
ABtnFaceColor, AHighlightColor, AWindowColor: TColor;
|
||
|
|
|
||
|
|
function GetLightIndex(ABtnFaceValue, AHighlightValue, AWindowValue: Byte): Integer;
|
||
|
|
begin
|
||
|
|
Result :=
|
||
|
|
MulDiv(ABtnFaceValue, ABtnFaceColorPart, 100) +
|
||
|
|
MulDiv(AHighlightValue, AHighlightColorPart, 100) +
|
||
|
|
MulDiv(AWindowValue, AWindowColorPart, 100);
|
||
|
|
if Result < 0 then Result := 0;
|
||
|
|
if Result > 255 then Result := 255;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
ABtnFaceColor := ColorToRGB(clBtnFace);
|
||
|
|
AHighlightColor := ColorToRGB(clHighlight);
|
||
|
|
AWindowColor := ColorToRGB(clWindow);
|
||
|
|
if (ABtnFaceColor = 0) or (ABtnFaceColor = $FFFFFF) then
|
||
|
|
Result := AHighlightColor
|
||
|
|
else
|
||
|
|
Result := RGB(
|
||
|
|
GetLightIndex(GetRValue(ABtnFaceColor), GetRValue(AHighlightColor), GetRValue(AWindowColor)),
|
||
|
|
GetLightIndex(GetGValue(ABtnFaceColor), GetGValue(AHighlightColor), GetGValue(AWindowColor)),
|
||
|
|
GetLightIndex(GetBValue(ABtnFaceColor), GetBValue(AHighlightColor), GetBValue(AWindowColor)));
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetLightBtnFaceColor: TColor;
|
||
|
|
|
||
|
|
function GetLightValue(Value: Byte): Byte;
|
||
|
|
begin
|
||
|
|
Result := Value + MulDiv(255 - Value, 16, 100);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
Result := ColorToRGB(clBtnFace);
|
||
|
|
Result := RGB(
|
||
|
|
GetLightValue(GetRValue(Result)),
|
||
|
|
GetLightValue(GetGValue(Result)),
|
||
|
|
GetLightValue(GetBValue(Result)));
|
||
|
|
Result := GetRealColor(Result);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetLightDownedColor: TColor;
|
||
|
|
begin
|
||
|
|
Result := GetRealColor(GetLightColor(11, 9, 73));
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetLightDownedSelColor: TColor;
|
||
|
|
begin
|
||
|
|
Result := GetRealColor(GetLightColor(14, 44, 40));
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetLightSelColor: TColor;
|
||
|
|
begin
|
||
|
|
Result := GetRealColor(GetLightColor(-2, 30, 72));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure FillBitmapInfoHeader(out AHeader: TBitmapInfoHeader; ABitmap: TBitmap;
|
||
|
|
ATopDownDIB: Boolean);
|
||
|
|
begin
|
||
|
|
AHeader.biSize := SizeOf(TBitmapInfoHeader);
|
||
|
|
AHeader.biWidth := ABitmap.Width;
|
||
|
|
if ATopDownDIB then
|
||
|
|
AHeader.biHeight := -ABitmap.Height
|
||
|
|
else
|
||
|
|
AHeader.biHeight := ABitmap.Height;
|
||
|
|
AHeader.biPlanes := 1;
|
||
|
|
AHeader.biBitCount := 32;
|
||
|
|
AHeader.biCompression := BI_RGB;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetBitmapBits(ABitmap: TBitmap; ATopDownDIB: Boolean): TRGBColors;
|
||
|
|
var
|
||
|
|
AInfo: TBitmapInfo;
|
||
|
|
begin
|
||
|
|
SetLength(Result, ABitmap.Width * ABitmap.Height);
|
||
|
|
FillBitmapInfoHeader(AInfo.bmiHeader, ABitmap, ATopDownDIB);
|
||
|
|
// GetDIBits(ABitmap.Canvas.Handle, ABitmap.Handle, 0, ABitmap.Height, nil, AInfo,
|
||
|
|
// DIB_RGB_COLORS);
|
||
|
|
GetDIBits(cxScreenCanvas.Handle, ABitmap.Handle, 0, ABitmap.Height, Result,
|
||
|
|
AInfo, DIB_RGB_COLORS);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure SetBitmapBits(ABitmap: TBitmap; var AColors: TRGBColors;
|
||
|
|
ATopDownDIB: Boolean);
|
||
|
|
var
|
||
|
|
AInfo: TBitmapInfo;
|
||
|
|
begin
|
||
|
|
FillBitmapInfoHeader(AInfo.bmiHeader, ABitmap, ATopDownDIB);
|
||
|
|
SetDIBits(cxScreenCanvas.Handle, ABitmap.Handle, 0, ABitmap.Height,
|
||
|
|
AColors, AInfo, DIB_RGB_COLORS);
|
||
|
|
AColors := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{!!! TODO: adapt to .net}
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
|
||
|
|
function Lanczos3Filter(Value: Single): Single;
|
||
|
|
|
||
|
|
function SinC(Value: Single): Single;
|
||
|
|
begin
|
||
|
|
if (Value <> 0.0) then
|
||
|
|
begin
|
||
|
|
Value := Value * PI;
|
||
|
|
Result := Sin(Value) / Value
|
||
|
|
end
|
||
|
|
else Result := 1.0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if (Value < 0.0) then Value := -Value;
|
||
|
|
if (Value < 3.0) then
|
||
|
|
Result := SinC(Value) * SinC(Value / 3.0)
|
||
|
|
else
|
||
|
|
Result := 0.0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure BuildFilter(out AContributorList: TContributorList; AScale: Single; ASrcSize, ADestSize: Integer);
|
||
|
|
var
|
||
|
|
I, J, APixel, AMaxContributors, AWeight: Integer;
|
||
|
|
ACenter, ARadius, AScaleFactor: Single;
|
||
|
|
begin
|
||
|
|
SetLength(AContributorList, ADestSize);
|
||
|
|
if AScale < 1.0 then AScaleFactor := 1.0 / AScale else AScaleFactor := 1.0;
|
||
|
|
ARadius := 3 * AScaleFactor;
|
||
|
|
AMaxContributors := Trunc(ARadius * 2.0 + 1);
|
||
|
|
for I := 0 to ADestSize - 1 do
|
||
|
|
with AContributorList[I] do
|
||
|
|
begin
|
||
|
|
SetLength(Contributors, AMaxContributors);
|
||
|
|
Count := 0;
|
||
|
|
ACenter := I / AScale;
|
||
|
|
for J := Floor(ACenter - ARadius) to Ceil(ACenter + ARadius) do
|
||
|
|
begin
|
||
|
|
AWeight := Round(Lanczos3Filter((ACenter - J) / AScaleFactor) / AScaleFactor * 256);
|
||
|
|
if AWeight = 0 then continue;
|
||
|
|
if J < 0 then
|
||
|
|
APixel := -J
|
||
|
|
else
|
||
|
|
if (J >= ASrcSize) then
|
||
|
|
APixel := ASrcSize - J + ASrcSize - 1
|
||
|
|
else
|
||
|
|
APixel := J;
|
||
|
|
Contributors[Count].Pixel := APixel;
|
||
|
|
Contributors[Count].Weight := AWeight;
|
||
|
|
Inc(Count);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ApplyFilter(var AContributorList: TContributorList;
|
||
|
|
var ASource: TRGBColors; ASrcSize, ASrcLineLength: Integer;
|
||
|
|
var ADest: TRGBColors; ADestSize, ADestLineLength: Integer;
|
||
|
|
AHorizontal: Boolean);
|
||
|
|
|
||
|
|
function GetColorPart(Value: Integer): Integer;
|
||
|
|
begin
|
||
|
|
if Value < 0 then
|
||
|
|
Result := 0
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Value := Value shr 8;
|
||
|
|
if Value > 255 then
|
||
|
|
Result := 255
|
||
|
|
else
|
||
|
|
Result := Value;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
AWeight: Integer;
|
||
|
|
AColor: TRGBQuad;
|
||
|
|
R, G, B: Integer;
|
||
|
|
K, I, J: Integer;
|
||
|
|
AContributor: PContributor;
|
||
|
|
begin
|
||
|
|
for I := 0 to ASrcSize - 1 do
|
||
|
|
for J := 0 to ADestSize - 1 do
|
||
|
|
with AContributorList[J] do
|
||
|
|
begin
|
||
|
|
R := 0; G := 0; B := 0;
|
||
|
|
AContributor := @Contributors[0];
|
||
|
|
for K := 0 to Count - 1 do
|
||
|
|
begin
|
||
|
|
with AContributor^ do
|
||
|
|
begin
|
||
|
|
if AHorizontal then
|
||
|
|
AColor := ASource[Pixel + (I * ASrcLineLength)]
|
||
|
|
else
|
||
|
|
AColor := ASource[I + (Pixel * ASrcLineLength)];
|
||
|
|
AWeight := Weight;
|
||
|
|
if AWeight = 0 then continue;
|
||
|
|
Inc(R, AColor.rgbRed * AWeight);
|
||
|
|
Inc(G, AColor.rgbGreen * AWeight);
|
||
|
|
Inc(B, AColor.rgbBlue * AWeight);
|
||
|
|
end;
|
||
|
|
Inc(AContributor);
|
||
|
|
end;
|
||
|
|
AColor.rgbRed := GetColorPart(R);
|
||
|
|
AColor.rgbGreen := GetColorPart(G);
|
||
|
|
AColor.rgbBlue := GetColorPart(B);
|
||
|
|
AColor.rgbReserved := 0;
|
||
|
|
if AHorizontal then
|
||
|
|
ADest[J + (I * ADestLineLength)] := AColor
|
||
|
|
else
|
||
|
|
ADest[I + (J * ADestLineLength)] := AColor;
|
||
|
|
end;
|
||
|
|
//dispose contributors and source buffer
|
||
|
|
for I := 0 to HIGH(AContributorList) do
|
||
|
|
AContributorList[I].Contributors := nil;
|
||
|
|
AContributorList := nil;
|
||
|
|
ASource := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxSmoothResizeBitmap(ASource, ADestination: TBitmap; AForceUseLanczos3Filter: Boolean = False);
|
||
|
|
var
|
||
|
|
AContributorList: TContributorList;
|
||
|
|
ASrcWidth, ASrcHeight, ADestWidth, ADestHeight: Integer;
|
||
|
|
ABuffer1, ABuffer2: TRGBColors;
|
||
|
|
AOldMode: Cardinal;
|
||
|
|
AScale: Single;
|
||
|
|
begin
|
||
|
|
ADestWidth := ADestination.Width;
|
||
|
|
ADestHeight := ADestination.Height;
|
||
|
|
ASrcWidth := ASource.Width;
|
||
|
|
ASrcHeight := ASource.Height;
|
||
|
|
if (ADestWidth = 0) or (ADestHeight = 0) or (ASrcWidth = 0) or (ASrcHeight = 0) then Exit;
|
||
|
|
ASource.Canvas.Lock;
|
||
|
|
ADestination.Canvas.Lock;
|
||
|
|
try
|
||
|
|
if IsWinNT and not AForceUseLanczos3Filter then
|
||
|
|
begin
|
||
|
|
AOldMode := SetStretchBltMode(ADestination.Canvas.Handle, HALFTONE);
|
||
|
|
StretchBlt(ADestination.Canvas.Handle, 0, 0, ADestWidth, ADestHeight,
|
||
|
|
ASource.Canvas.Handle, 0, 0, ASrcWidth, ASrcHeight, srcCopy);
|
||
|
|
SetStretchBltMode(ADestination.Canvas.Handle, AOldMode);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
ABuffer1 := GetBitmapBits(ASource, False);
|
||
|
|
SetLength(ABuffer2, ADestWidth * ASrcHeight);
|
||
|
|
if ASrcWidth = 1 then
|
||
|
|
AScale := ADestWidth / ASrcWidth
|
||
|
|
else
|
||
|
|
AScale := (ADestWidth - 1) / (ASrcWidth - 1);
|
||
|
|
BuildFilter(AContributorList, AScale, ASrcWidth, ADestWidth);
|
||
|
|
ApplyFilter(AContributorList, ABuffer1, ASrcHeight, ASrcWidth, ABuffer2, ADestWidth, ADestWidth, True);
|
||
|
|
ABuffer1 := GetBitmapBits(ADestination, False);
|
||
|
|
if (ASrcHeight = 1) or (ADestHeight = 1) then
|
||
|
|
AScale := ADestHeight / ASrcHeight
|
||
|
|
else
|
||
|
|
AScale := (ADestHeight - 1) / (ASrcHeight - 1);
|
||
|
|
BuildFilter(AContributorList, AScale, ASrcHeight, ADestHeight);
|
||
|
|
ApplyFilter(AContributorList, ABuffer2, ADestWidth, ADestWidth, ABuffer1, ADestHeight, ADestWidth, False);
|
||
|
|
SetBitmapBits(ADestination, ABuffer1, False);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
ASource.Canvas.Unlock;
|
||
|
|
ADestination.Canvas.Unlock;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxGetCursorSize: TSize;
|
||
|
|
var
|
||
|
|
IconInfo: TIconInfo;
|
||
|
|
BitmapInfoSize, BitmapBitsSize, ImageSize: DWORD;
|
||
|
|
Bitmap: PBitmapInfoHeader;
|
||
|
|
Bits: Pointer;
|
||
|
|
BytesPerScanline: Integer;
|
||
|
|
|
||
|
|
function FindScanline(Source: Pointer; MaxLen: Cardinal;
|
||
|
|
Value: Cardinal): Cardinal; assembler;
|
||
|
|
asm
|
||
|
|
PUSH ECX
|
||
|
|
MOV ECX,EDX
|
||
|
|
MOV EDX,EDI
|
||
|
|
MOV EDI,EAX
|
||
|
|
POP EAX
|
||
|
|
REPE SCASB
|
||
|
|
MOV EAX,ECX
|
||
|
|
MOV EDI,EDX
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
{ Default value is entire icon height }
|
||
|
|
Result.cy := GetSystemMetrics(SM_CYCURSOR);
|
||
|
|
Result.cx := GetSystemMetrics(SM_CXCURSOR);
|
||
|
|
|
||
|
|
if GetIconInfo(GetCursor, IconInfo) then
|
||
|
|
try
|
||
|
|
GetDIBSizes(IconInfo.hbmMask, BitmapInfoSize, BitmapBitsSize);
|
||
|
|
Bitmap := AllocMem(DWORD(BitmapInfoSize) + BitmapBitsSize);
|
||
|
|
try
|
||
|
|
Bits := Pointer(DWORD(Bitmap) + BitmapInfoSize);
|
||
|
|
if GetDIB(IconInfo.hbmMask, 0, Bitmap^, Bits^) and
|
||
|
|
(Bitmap^.biBitCount = 1) then
|
||
|
|
begin
|
||
|
|
{ Point Bits to the end of this bottom-up bitmap }
|
||
|
|
with Bitmap^ do
|
||
|
|
begin
|
||
|
|
Result.cx := biWidth;
|
||
|
|
BytesPerScanline := ((biWidth * biBitCount + 31) and not 31) div 8;
|
||
|
|
ImageSize := biWidth * BytesPerScanline;
|
||
|
|
Bits := Pointer(DWORD(Bits) + BitmapBitsSize - ImageSize);
|
||
|
|
{ Use the width to determine the height since another mask bitmap
|
||
|
|
may immediately follow }
|
||
|
|
Result.cy := FindScanline(Bits, ImageSize, $FF);
|
||
|
|
{ In case the and mask is blank, look for an empty scanline in the
|
||
|
|
xor mask. }
|
||
|
|
if (Result.cy = 0) and (biHeight >= 2 * biWidth) then
|
||
|
|
Result.cy := FindScanline(Pointer(DWORD(Bits) - ImageSize),
|
||
|
|
ImageSize, $00);
|
||
|
|
Result.cy := Result.cy div BytesPerScanline;
|
||
|
|
end;
|
||
|
|
Dec(Result.cy, IconInfo.yHotSpot);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
FreeMem(Bitmap, BitmapInfoSize + BitmapBitsSize);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
if IconInfo.hbmColor <> 0 then DeleteObject(IconInfo.hbmColor);
|
||
|
|
if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxAlphaBlend(ASource: TBitmap; ARect: TRect;
|
||
|
|
const ASelColor: TColor; Alpha: Byte = 170);
|
||
|
|
var
|
||
|
|
ARow, ACol: Integer;
|
||
|
|
SrcLine: Pointer;
|
||
|
|
C1, C2: Double;
|
||
|
|
AColorValues: array[0..3] of Byte;
|
||
|
|
P: TPoint;
|
||
|
|
begin
|
||
|
|
C1 := Alpha / 255;
|
||
|
|
C2 := 1.0 - C1;
|
||
|
|
AColorValues[0] := Round(GetBValue(ASelColor) * C1);
|
||
|
|
AColorValues[1] := Round(GetGValue(ASelColor) * C1);
|
||
|
|
AColorValues[2] := Round(GetRValue(ASelColor) * C1);
|
||
|
|
AColorValues[3] := 0;
|
||
|
|
GetWindowOrgEx(ASource.Canvas.Handle, P);
|
||
|
|
OffsetRect(ARect, -P.X, -P.Y);
|
||
|
|
for ARow := Max(ARect.Top, 0) to Min(ARect.Bottom, ASource.Height - 1) do
|
||
|
|
begin
|
||
|
|
SrcLine := ASource.ScanLine[ARow];
|
||
|
|
ACol := Max(0, ARect.Left * 4);
|
||
|
|
while ACol < Min(ARect.Right * 4, ASource.Width * 4 - 1) do
|
||
|
|
begin
|
||
|
|
WriteToMemory(SrcLine, ACol, AColorValues[ACol mod 4] + Round(ReadFromMemory(SrcLine, ACol) * C2));
|
||
|
|
Inc(ACol);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxAlphaBlend(
|
||
|
|
ADest, ABkSource, ASource: TBitmap; Alpha: Byte = cxDefaultAlphaValue);
|
||
|
|
|
||
|
|
function SystemAlphaPaint: Boolean;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
var
|
||
|
|
ABlendFunction: TBlendFunction;
|
||
|
|
{$ENDIF}
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if not Assigned(VCLAlphaBlend) then
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
ABlendFunction := DefaultBlendFunction;
|
||
|
|
ABlendFunction.SourceConstantAlpha := Alpha;
|
||
|
|
with ADest do
|
||
|
|
begin
|
||
|
|
Canvas.Draw(0, 0, ABkSource); // Assign(ABkSource); todo: graphics bug image not copying but _AddRef called
|
||
|
|
Result := {$IFDEF CLR}AlphaBlend{$ELSE}VCLAlphaBlend{$ENDIF}(Canvas.Handle,
|
||
|
|
0, 0, Width, Height, ASource.Canvas.Handle, 0, 0, Width, Height, ABlendFunction);
|
||
|
|
end;
|
||
|
|
{$ELSE}
|
||
|
|
Result := False;
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure AlphaPaint;
|
||
|
|
var
|
||
|
|
ACount, K: Integer;
|
||
|
|
DstLine, BkSrcLine, SrcLine: Pointer;
|
||
|
|
C1, C2: Double;
|
||
|
|
begin
|
||
|
|
C1 := Alpha / 255;
|
||
|
|
C2 := 1.0 - C1;
|
||
|
|
with ASource do
|
||
|
|
begin
|
||
|
|
K := Height;
|
||
|
|
ACount := ((Width * 24 + 31) and not 31) shr 3 * K;
|
||
|
|
end;
|
||
|
|
BkSrcLine := ABkSource.ScanLine[K - 1];
|
||
|
|
SrcLine := ASource.ScanLine[K - 1];
|
||
|
|
DstLine := ADest.ScanLine[K - 1];
|
||
|
|
for K := 0 to ACount - 1 do
|
||
|
|
WriteToMemory(DstLine, K,
|
||
|
|
Round(ReadFromMemory(SrcLine, K) * C1) + Round(ReadFromMemory(BkSrcLine, K) * C2));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure DoAlphaPaint;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if GetDeviceCaps(cxScreenCanvas.Handle, BITSPIXEL) in [16, 24, 32] then
|
||
|
|
{$ELSE}
|
||
|
|
//TODO
|
||
|
|
if False then
|
||
|
|
{$ENDIF}
|
||
|
|
AlphaPaint
|
||
|
|
else
|
||
|
|
ADest.Canvas.Draw(0, 0, ASource); // .Assign(ASource);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if not SystemAlphaPaint then DoAlphaPaint;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure CommonAlphaBlend(ADestBitmap, ASrcBitmap: TBitmap; ADestDC: HDC; const ADestRect, ASrcRect: TRect; AConstantAlpha: Byte = $FF);
|
||
|
|
|
||
|
|
procedure SystemAlphaBlend(ADestDC, ASrcDC: HDC;
|
||
|
|
ADestLeft, ADestTop, ADestWidth, ADestHeight, ASrcLeft, ASrcTop, ASrcWidth, ASrcHeight: Integer; AConstantAlpha: Byte);
|
||
|
|
{$IFNDEF DELPHI6}
|
||
|
|
const
|
||
|
|
AC_SRC_ALPHA = 1;
|
||
|
|
{$ENDIF}
|
||
|
|
var
|
||
|
|
ABlendFunction: TBlendFunction;
|
||
|
|
begin
|
||
|
|
ABlendFunction.BlendOp := AC_SRC_OVER;
|
||
|
|
ABlendFunction.BlendFlags := 0;
|
||
|
|
ABlendFunction.SourceConstantAlpha := AConstantAlpha;
|
||
|
|
ABlendFunction.AlphaFormat := AC_SRC_ALPHA;
|
||
|
|
{$IFDEF CLR}AlphaBlend{$ELSE}VCLAlphaBlend{$ENDIF}(ADestDC, ADestLeft, ADestTop, ADestWidth, ADestHeight,
|
||
|
|
ASrcDC, ASrcLeft, ASrcTop, ASrcWidth, ASrcHeight, ABlendFunction);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure SoftwareAlphaBlend(ADestBitmap, ASrcBitmap: TBitmap;
|
||
|
|
ADestLeft, ADestTop, ADestWidth, ADestHeight, ASrcLeft, ASrcTop, ASrcWidth, ASrcHeight: Integer; AConstantAlpha: Byte);
|
||
|
|
|
||
|
|
function GetStretchedBitmap(AWidth, AHeight: Integer): TBitmap;
|
||
|
|
begin
|
||
|
|
Result := cxCreateBitmap(AWidth, AHeight, pf32bit);
|
||
|
|
Result.Canvas.Brush.Color := 0;
|
||
|
|
Result.Canvas.FillRect(Rect(0, 0, AWidth, AHeight));
|
||
|
|
|
||
|
|
StretchBlt(Result.Canvas.Handle, ADestLeft, ADestTop, ADestWidth, ADestHeight, ASrcBitmap.Canvas.Handle, ASrcLeft, ASrcTop, ASrcWidth, ASrcHeight, SRCCOPY);
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
ASourceColors, ADestColors: TRGBColors;
|
||
|
|
I, J, K: Integer;
|
||
|
|
AWidth, AHeight: Integer;
|
||
|
|
AStretchedBitmap: TBitmap;
|
||
|
|
begin
|
||
|
|
AWidth := ADestBitmap.Width;
|
||
|
|
AHeight := ADestBitmap.Height;
|
||
|
|
AStretchedBitmap := GetStretchedBitmap(AWidth, AHeight);
|
||
|
|
|
||
|
|
try
|
||
|
|
ASourceColors := GetBitmapBits(AStretchedBitmap, False);
|
||
|
|
ADestColors := GetBitmapBits(ADestBitmap, False);
|
||
|
|
for I := 0 to AWidth - 1 do
|
||
|
|
for J := 0 to AHeight - 1 do
|
||
|
|
begin
|
||
|
|
K := J * AWidth + I;
|
||
|
|
cxBlendFunction(ASourceColors[K], ADestColors[K], AConstantAlpha);
|
||
|
|
end;
|
||
|
|
SetBitmapBits(ADestBitmap, ADestColors, False);
|
||
|
|
finally
|
||
|
|
AStretchedBitmap.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
DC: HDC;
|
||
|
|
ADestWidth, ADestHeight: Integer;
|
||
|
|
begin
|
||
|
|
ADestWidth := ADestRect.Right - ADestRect.Left;
|
||
|
|
ADestHeight := ADestRect.Bottom - ADestRect.Top;
|
||
|
|
if Assigned(VCLAlphaBlend) then
|
||
|
|
begin
|
||
|
|
if ADestBitmap <> nil then
|
||
|
|
DC := ADestBitmap.Canvas.Handle
|
||
|
|
else
|
||
|
|
DC := ADestDC;
|
||
|
|
SystemAlphaBlend(DC, ASrcBitmap.Canvas.Handle,
|
||
|
|
ADestRect.Left, ADestRect.Top, ADestWidth, ADestHeight,
|
||
|
|
ASrcRect.Left, ASrcRect.Top, ASrcRect.Right - ASrcRect.Left, ASrcRect.Bottom - ASrcRect.Top,
|
||
|
|
AConstantAlpha);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if ADestBitmap <> nil then
|
||
|
|
SoftwareAlphaBlend(ADestBitmap, ASrcBitmap,
|
||
|
|
ADestRect.Left, ADestRect.Top, ADestWidth, ADestHeight,
|
||
|
|
ASrcRect.Left, ASrcRect.Top, ASrcRect.Right - ASrcRect.Left, ASrcRect.Bottom - ASrcRect.Top,
|
||
|
|
AConstantAlpha)
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
ADestBitmap := cxCreateBitmap(ADestWidth, ADestHeight, pf32bit);
|
||
|
|
try
|
||
|
|
BitBlt(ADestBitmap.Canvas.Handle, 0, 0, ADestWidth, ADestHeight,
|
||
|
|
ADestDC, ADestRect.Left, ADestRect.Top, SRCCOPY);
|
||
|
|
SoftwareAlphaBlend(ADestBitmap, ASrcBitmap,
|
||
|
|
0, 0, ADestWidth, ADestHeight,
|
||
|
|
ASrcRect.Left, ASrcRect.Top, ASrcRect.Right - ASrcRect.Left, ASrcRect.Bottom - ASrcRect.Top,
|
||
|
|
AConstantAlpha);
|
||
|
|
|
||
|
|
BitBlt(ADestDC, ADestRect.Left, ADestRect.Top, ADestWidth, ADestHeight,
|
||
|
|
ADestBitmap.Canvas.Handle, 0, 0, SRCCOPY);
|
||
|
|
finally
|
||
|
|
ADestBitmap.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxAlphaBlend(ADestBitmap, ASrcBitmap: TBitmap; const ADestRect, ASrcRect: TRect; AConstantAlpha: Byte = $FF); overload;
|
||
|
|
begin
|
||
|
|
CommonAlphaBlend(ADestBitmap, ASrcBitmap, 0, ADestRect, ASrcRect, AConstantAlpha);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxAlphaBlend(ADestDC: HDC; ASrcBitmap: TBitmap; const ADestRect, ASrcRect: TRect; AConstantAlpha: Byte = $FF); overload;
|
||
|
|
begin
|
||
|
|
CommonAlphaBlend(nil, ASrcBitmap, ADestDC, ADestRect, ASrcRect, AConstantAlpha);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxApplyViewParams(ACanvas: TcxCanvas;
|
||
|
|
const AViewParams: TcxViewParams);
|
||
|
|
begin
|
||
|
|
with ACanvas do
|
||
|
|
begin
|
||
|
|
Font := AViewParams.Font;
|
||
|
|
Font.Color := AViewParams.TextColor;
|
||
|
|
Brush.Color := AViewParams.Color;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxBlendFunction(const ASource: TRGBQuad; var ADest: TRGBQuad; ASourceConstantAlpha: Byte);
|
||
|
|
|
||
|
|
function GetValue(AValue: Single): Byte;
|
||
|
|
begin
|
||
|
|
if AValue < 255 then
|
||
|
|
Result := Round(AValue)
|
||
|
|
else
|
||
|
|
Result := 255;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
ASCA, ASrcAlpha: Single;
|
||
|
|
begin
|
||
|
|
ASCA := ASourceConstantAlpha / 255;
|
||
|
|
ASrcAlpha := 1 - ASource.rgbReserved * ASCA / 255;
|
||
|
|
|
||
|
|
ADest.rgbRed := GetValue(ASource.rgbRed * ASCA + ASrcAlpha * ADest.rgbRed);
|
||
|
|
ADest.rgbGreen := GetValue(ASource.rgbGreen * ASCA + ASrcAlpha * ADest.rgbGreen);
|
||
|
|
ADest.rgbBlue := GetValue(ASource.rgbBlue * ASCA + ASrcAlpha * ADest.rgbBlue);
|
||
|
|
ADest.rgbReserved := GetValue(ASource.rgbReserved * ASCA + ASrcAlpha * ADest.rgbReserved);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxCreateBitmap(const ASize: TSize; AFormat: TPixelFormat = pf24bit): TBitmap;
|
||
|
|
begin
|
||
|
|
Result := cxCreateBitmap(ASize.cx, ASize.cy, AFormat);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxCreateBitmap(AWidth, AHeight: Integer; AFormat: TPixelFormat = pf24bit): TBitmap;
|
||
|
|
begin
|
||
|
|
Result := TBitmap.Create;
|
||
|
|
Result.PixelFormat := AFormat;
|
||
|
|
Result.Width := AWidth;
|
||
|
|
Result.Height := AHeight;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxCreateTrueColorBitmap(const ASize: TSize): TBitmap;
|
||
|
|
begin
|
||
|
|
Result := cxCreateTrueColorBitmap(ASize.cx, ASize.cy);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxCreateTrueColorBitmap(AWidth, AHeight: Integer): TBitmap;
|
||
|
|
begin
|
||
|
|
Result := TBitmap.Create;
|
||
|
|
Result.Handle := cxCreateTrueColorBitmapHandle(AWidth, AHeight);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxCreateTrueColorBitmapHandle(AWidth, AHeight: Integer; ABPP: Integer = 32): HBitmap;
|
||
|
|
begin
|
||
|
|
Result := CreateBitmap(AWidth, AHeight, 1, ABPP, nil);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxCopyImage(ASource, ADest: TBitmap;
|
||
|
|
const ASrcOffset, ADstOffset: TPoint; const ARect: TRect);
|
||
|
|
var
|
||
|
|
ADstRect, ASrcRect: TRect;
|
||
|
|
begin
|
||
|
|
ADstRect := ARect;
|
||
|
|
ASrcRect := ARect;
|
||
|
|
OffsetRect(ASrcRect, ASrcOffset.X, ASrcOffset.Y);
|
||
|
|
OffsetRect(ADstRect, ADstOffset.X, ADstOffset.Y);
|
||
|
|
ADest.Canvas.CopyRect(ASrcRect, ASource.Canvas, ADstRect);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxCopyImage(ASource, ADest: TCanvas;
|
||
|
|
const ASrcOffset, ADstOffset: TPoint; const ARect: TRect);
|
||
|
|
var
|
||
|
|
ADstRect, ASrcRect: TRect;
|
||
|
|
begin
|
||
|
|
ADstRect := ARect;
|
||
|
|
ASrcRect := ARect;
|
||
|
|
OffsetRect(ASrcRect, ASrcOffset.X, ASrcOffset.Y);
|
||
|
|
OffsetRect(ADstRect, ADstOffset.X, ADstOffset.Y);
|
||
|
|
ADest.CopyRect(ADstRect, ASource, ASrcRect);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxDrawArrows(ACanvas: TCanvas; const ARect: TRect;
|
||
|
|
ASide: TcxBorder; AColor: TColor; APenColor: TColor = clDefault);
|
||
|
|
type
|
||
|
|
TArrowPolygon = array[0..6] of TPoint;
|
||
|
|
var
|
||
|
|
ArrowRgns: array[0..1, 0..6, 0..1] of Integer;
|
||
|
|
BaseLine: array[0..1, 0..1] of Integer;
|
||
|
|
I, J, K: Integer;
|
||
|
|
begin
|
||
|
|
with ARect do
|
||
|
|
begin
|
||
|
|
BaseLine[0, 0] := Left;
|
||
|
|
BaseLine[0, 1] := Top;
|
||
|
|
BaseLine[1, 0] := Right;
|
||
|
|
BaseLine[1, 1] := Bottom;
|
||
|
|
end;
|
||
|
|
if ASide in [bLeft, bBottom] then
|
||
|
|
begin
|
||
|
|
BaseLine[Byte(ASide = bLeft), 0] := ARect.Left;
|
||
|
|
BaseLine[Byte(ASide = bLeft), 1] := ARect.Bottom;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
BaseLine[Byte(ASide = bTop), 0] := ARect.Right;
|
||
|
|
BaseLine[Byte(ASide = bTop), 1] := ARect.Top;
|
||
|
|
end;
|
||
|
|
Move(BaseRgns[Byte(ASide in [bTop, bBottom]) shl 1], ArrowRgns, SizeOf(ArrowRgns));
|
||
|
|
for I := 0 to 1 do
|
||
|
|
for J := 0 to 6 do
|
||
|
|
for K := 0 to 1 do
|
||
|
|
Inc(ArrowRgns[I, J, K], BaseLine[I, K]);
|
||
|
|
ACanvas.Brush.Color := AColor;
|
||
|
|
if APenColor = clDefault then
|
||
|
|
ACanvas.Pen.Color := $FFFFFF xor ColorToRgb(AColor)
|
||
|
|
else
|
||
|
|
ACanvas.Pen.Color := APenColor;
|
||
|
|
for I := 0 to 1 do
|
||
|
|
ACanvas.Polygon(TArrowPolygon(ArrowRgns[I]));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxFillHalfToneRect(
|
||
|
|
Canvas: TCanvas; const ARect: TRect; ABkColor, AColor: TColor);
|
||
|
|
begin
|
||
|
|
with Canvas do
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
ABkColor := SetBkColor(Handle, ColorToRgb(ABkColor));
|
||
|
|
AColor := SetTextColor(Handle, ColorToRgb(AColor));
|
||
|
|
Windows.FillRect(Handle, ARect, cxHalfToneBrush.Handle);
|
||
|
|
SetBkColor(Handle, ABkColor);
|
||
|
|
SetTextColor(Handle, AColor);
|
||
|
|
{$ELSE}
|
||
|
|
QBrush_SetColor(HalfToneBrush.Handle, QColor(AColor));
|
||
|
|
QPainter_SetBackgroundColor(Handle, QColor(ABkColor));
|
||
|
|
with ARect do
|
||
|
|
QPainter_FillRect(Handle, Left, Top, Right - Left + 1, Bottom - Top + 1, cxHalfToneBrush);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxSetCanvasOrg(ACanvas: TCanvas; var AOrg: TRect);
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
with AOrg do
|
||
|
|
SetWindowOrgEx(ACanvas.Handle, Left, Top, @TopLeft);
|
||
|
|
{$ELSE}
|
||
|
|
QPainter_SetWindow(ACanvas.Handle, AOrg);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxTextHeight(AFont: TFont; const S: string = 'Wg'; AFontSize: Integer = 0): Integer;
|
||
|
|
begin
|
||
|
|
Result := cxTextExtent(AFont, S, AFontSize).cy;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxTextExtent(AFont: TFont; const S: string; AFontSize: Integer = 0): TSize;
|
||
|
|
begin
|
||
|
|
with cxScreenCanvas do
|
||
|
|
begin
|
||
|
|
Font.Assign(AFont);
|
||
|
|
if AFontSize <> 0 then Font.Size := AFontSize;
|
||
|
|
Result := TextExtent(S);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxTextWidth(AFont: TFont; const S: string; AFontSize: Integer = 0): Integer;
|
||
|
|
begin
|
||
|
|
Result := cxTextExtent(AFont, S, AFontSize).cx;
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
function cxDrawText(ADC: HDC; const AText: string; var ARect: TRect; AFormat: UINT; ACharCount: Integer = - 1): Integer;
|
||
|
|
begin
|
||
|
|
Result := Windows.DrawText(ADC, {$IFNDEF CLR}PChar{$ENDIF}(AText), ACharCount, ARect, AFormat);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxTextSize(ADC: HDC; const AText: string): TSize; // differs from cxTextExtent
|
||
|
|
var
|
||
|
|
ARect: TRect;
|
||
|
|
begin
|
||
|
|
ARect := cxGetTextRect(ADC, AText, 1);
|
||
|
|
Result := Size(ARect.Right, ARect.Bottom);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxGetTextRect(ADC: HDC; const AText: string; ARowCount: Integer; AReturnMaxRectHeight: Boolean = False): TRect;
|
||
|
|
|
||
|
|
function GetFirstApproximation(out ARectWidth, ARectHeight: Integer): TRect;
|
||
|
|
begin
|
||
|
|
Result := Rect(0, 0, 1, 1);
|
||
|
|
cxDrawText(ADC, AText, Result, DT_WORDBREAK or DT_CALCRECT);
|
||
|
|
ARectHeight := cxTextSize(ADC, 'Wg').cy * ARowCount;
|
||
|
|
ARectWidth := cxRectWidth(Result);
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
ARectHeight, ARectWidth: Integer;
|
||
|
|
begin
|
||
|
|
Result := cxEmptyRect;
|
||
|
|
if ARowCount <= 0 then
|
||
|
|
Exit;
|
||
|
|
if ARowCount = 1 then
|
||
|
|
cxDrawText(ADC, AText, Result, DT_SINGLELINE or DT_CALCRECT)
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Result := GetFirstApproximation(ARectWidth, ARectHeight);
|
||
|
|
while cxRectHeight(Result) > ARectHeight do
|
||
|
|
begin
|
||
|
|
Inc(ARectWidth);
|
||
|
|
Result.Right := ARectWidth;
|
||
|
|
cxDrawText(ADC, AText, Result, DT_WORDBREAK or DT_CALCRECT);
|
||
|
|
end;
|
||
|
|
if AReturnMaxRectHeight and (cxRectHeight(Result) < ARectHeight) then
|
||
|
|
Result.Bottom := Result.Top + ARectHeight;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxGetTextRect(AFont: TFont; const AText: string; ARowCount: Integer): TRect;
|
||
|
|
begin
|
||
|
|
cxScreenCanvas.Font := AFont;
|
||
|
|
Result := cxGetTextRect(cxScreenCanvas.Handle, AText, ARowCount);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxGetWritingDirection(AFontCharset: TFontCharset; const AText: string): TCanvasOrientation;
|
||
|
|
|
||
|
|
function IsStandardASCIIChar: Boolean;
|
||
|
|
begin
|
||
|
|
{$IFDEF CLR}
|
||
|
|
Result := (Length(AText) > 0) and (Integer(AText[1]) < 128);
|
||
|
|
{$ELSE}
|
||
|
|
Result := (Length(AText) > 0) and (cxStrCharLength(AText) = 1) and (Integer(AText[1]) < 128);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if AFontCharset = DEFAULT_CHARSET then
|
||
|
|
AFontCharset := GetDefFontCharset;
|
||
|
|
if not IsStandardASCIIChar and (AFontCharset in [ARABIC_CHARSET, CHINESEBIG5_CHARSET, GB2312_CHARSET]) then
|
||
|
|
Result := coRightToLeft
|
||
|
|
else
|
||
|
|
Result := coLeftToRight;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxDrawThemeParentBackground(AControl: TWinControl; ACanvas: TcxCanvas; const ARect: TRect);
|
||
|
|
begin
|
||
|
|
if AControl.Parent.DoubleBuffered then
|
||
|
|
cxDrawTransparentControlBackground(AControl, ACanvas, ARect, False)
|
||
|
|
else
|
||
|
|
DrawThemeParentBackground(AControl.Handle, ACanvas.Handle, ARect);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxDrawThemeParentBackground(AControl: TWinControl; ACanvas: TCanvas; const ARect: TRect);
|
||
|
|
var
|
||
|
|
AcxCanvas: TcxCanvas;
|
||
|
|
begin
|
||
|
|
AcxCanvas := TcxCanvas.Create(ACanvas);
|
||
|
|
try
|
||
|
|
cxDrawThemeParentBackground(AControl, AcxCanvas, ARect);
|
||
|
|
finally
|
||
|
|
AcxCanvas.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxDrawTransparentControlBackground(AControl: TWinControl;
|
||
|
|
ACanvas: TcxCanvas; ARect: TRect; APaintParentWithChildren: Boolean = True);
|
||
|
|
|
||
|
|
procedure cxPaintControlTo(ADrawControl: TWinControl;
|
||
|
|
AOffsetX, AOffsetY: Integer; ADrawRect: TRect);
|
||
|
|
|
||
|
|
procedure DrawEdgesAndBorders;
|
||
|
|
var
|
||
|
|
AEdgeFlags, ABorderFlags: Integer;
|
||
|
|
ABorderRect: TRect;
|
||
|
|
begin
|
||
|
|
ABorderFlags := 0;
|
||
|
|
AEdgeFlags := 0;
|
||
|
|
if GetWindowLong(ADrawControl.Handle, GWL_EXSTYLE) and WS_EX_CLIENTEDGE <> 0 then
|
||
|
|
begin
|
||
|
|
AEdgeFlags := EDGE_SUNKEN;
|
||
|
|
ABorderFlags := BF_RECT or BF_ADJUST
|
||
|
|
end
|
||
|
|
else
|
||
|
|
if GetWindowLong(ADrawControl.Handle, GWL_STYLE) and WS_BORDER <> 0 then
|
||
|
|
begin
|
||
|
|
AEdgeFlags := BDR_OUTER;
|
||
|
|
ABorderFlags := BF_RECT or BF_ADJUST or BF_MONO;
|
||
|
|
end;
|
||
|
|
if ABorderFlags <> 0 then
|
||
|
|
begin
|
||
|
|
ABorderRect := Rect(0, 0, ADrawControl.Width, ADrawControl.Height);
|
||
|
|
DrawEdge(ACanvas.Handle, ABorderRect, AEdgeFlags, ABorderFlags);
|
||
|
|
ACanvas.SetClipRegion(TcxRegion.Create(ABorderRect), roIntersect);
|
||
|
|
MoveWindowOrg(ACanvas.Handle, ABorderRect.Left, ABorderRect.Top);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
ASavedDC, I: Integer;
|
||
|
|
AChildControl: TControl;
|
||
|
|
begin
|
||
|
|
ASavedDC := SaveDC(ACanvas.Handle);
|
||
|
|
try
|
||
|
|
MoveWindowOrg(ACanvas.Handle, AOffsetX, AOffsetY);
|
||
|
|
|
||
|
|
ACanvas.SetClipRegion(TcxRegion.Create(ADrawRect), roIntersect);
|
||
|
|
with ACanvas.GetClipRegion do
|
||
|
|
try
|
||
|
|
if IsEmpty then
|
||
|
|
Exit;
|
||
|
|
finally
|
||
|
|
Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
ADrawControl.ControlState := ADrawControl.ControlState + [csPaintCopy];
|
||
|
|
try
|
||
|
|
if ADrawControl <> AControl.Parent then
|
||
|
|
DrawEdgesAndBorders;
|
||
|
|
ACanvas.Canvas.Lock;
|
||
|
|
try
|
||
|
|
ADrawControl.Perform(WM_ERASEBKGND, ACanvas.Handle, ACanvas.Handle);
|
||
|
|
ADrawControl.Perform(WM_PAINT, ACanvas.Handle, 0);
|
||
|
|
finally
|
||
|
|
ACanvas.Canvas.Unlock;
|
||
|
|
end;
|
||
|
|
if APaintParentWithChildren then
|
||
|
|
for I := 0 to ADrawControl.ControlCount - 1 do
|
||
|
|
begin
|
||
|
|
AChildControl := ADrawControl.Controls[I];
|
||
|
|
if AChildControl = AControl then
|
||
|
|
Break;
|
||
|
|
if (AChildControl is TWinControl) and TWinControl(AChildControl).Visible then
|
||
|
|
cxPaintControlTo(TWinControl(AChildControl), AChildControl.Left, AChildControl.Top, Rect(0, 0, AChildControl.Width, AChildControl.Height));
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
ADrawControl.ControlState := ADrawControl.ControlState - [csPaintCopy];
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
RestoreDC(ACanvas.Handle, ASavedDC);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if AControl.Parent <> nil then
|
||
|
|
begin
|
||
|
|
OffsetRect(ARect, AControl.Left, AControl.Top);
|
||
|
|
cxPaintControlTo(AControl.Parent, -ARect.Left, -ARect.Top, ARect);
|
||
|
|
// wrong cxLabel painting cxPaintControlTo(AControl.Parent, -AControl.Left, -AControl.Top, ARect);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure cxDrawTransparentControlBackground(AControl: TWinControl;
|
||
|
|
ACanvas: TCanvas; const ARect: TRect; APaintParentWithChildren: Boolean = True);
|
||
|
|
var
|
||
|
|
AcxCanvas: TcxCanvas;
|
||
|
|
begin
|
||
|
|
AcxCanvas := TcxCanvas.Create(ACanvas);
|
||
|
|
try
|
||
|
|
cxDrawTransparentControlBackground(AControl, AcxCanvas, ARect, APaintParentWithChildren);
|
||
|
|
finally
|
||
|
|
AcxCanvas.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function cxScreenCanvas: TcxScreenCanvas;
|
||
|
|
begin
|
||
|
|
if ScreenCanvas = nil then
|
||
|
|
ScreenCanvas := TcxScreenCanvas.Create;
|
||
|
|
Result := ScreenCanvas;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TcxRegion }
|
||
|
|
|
||
|
|
constructor TcxRegion.Create(AHandle: TcxRegionHandle);
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
FHandle := AHandle;
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TcxRegion.Create(const ABounds: TRect);
|
||
|
|
var
|
||
|
|
AHandle: TcxRegionHandle;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
AHandle := CreateRectRgnIndirect(ABounds);
|
||
|
|
{$ELSE}
|
||
|
|
AHandle := QRegion_create(@ABounds, QRegionRegionType_Rectangle);
|
||
|
|
{$ENDIF}
|
||
|
|
Create(AHandle);
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TcxRegion.Create;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Create(0, 0, 0, 0);
|
||
|
|
{$ELSE}
|
||
|
|
Create(QRegion_create);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TcxRegion.Create(ALeft, ATop, ARight, ABottom: Integer);
|
||
|
|
begin
|
||
|
|
Create(Rect(ALeft, ATop, ARight, ABottom));
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TcxRegion.Destroy;
|
||
|
|
begin
|
||
|
|
DestroyHandle;
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxRegion.GetIsEmpty: Boolean;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
var
|
||
|
|
R: TRect;
|
||
|
|
{$ENDIF}
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Result := GetRgnBox(FHandle, R) = NULLREGION;
|
||
|
|
{$ELSE}
|
||
|
|
Result := QRegion_isEmpty(FHandle);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxRegion.DestroyHandle;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if FHandle <> 0 then
|
||
|
|
begin
|
||
|
|
DeleteObject(FHandle);
|
||
|
|
FHandle := 0;
|
||
|
|
end;
|
||
|
|
{$ELSE}
|
||
|
|
if FHandle <> nil then
|
||
|
|
begin
|
||
|
|
QRegion_destroy(FHandle);
|
||
|
|
FHandle := nil;
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxRegion.Combine(ARegion: TcxRegion; AOperation: TcxRegionOperation;
|
||
|
|
ADestroyRegion: Boolean = True);
|
||
|
|
{$IFDEF VCL}
|
||
|
|
const
|
||
|
|
Modes: array[TcxRegionOperation] of Integer = (RGN_COPY, RGN_OR, RGN_DIFF, RGN_AND);
|
||
|
|
{$ENDIF}
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if AOperation = roSet then
|
||
|
|
CombineRgn(FHandle, ARegion.Handle, 0, Modes[AOperation])
|
||
|
|
else
|
||
|
|
CombineRgn(FHandle, FHandle, ARegion.Handle, Modes[AOperation]);
|
||
|
|
{$ELSE}
|
||
|
|
case AOperation of
|
||
|
|
roSet:
|
||
|
|
{};
|
||
|
|
roAdd:
|
||
|
|
QRegion_unite(FHandle, FHandle, ARegion.Handle);
|
||
|
|
roSubtract:
|
||
|
|
QRegion_subtract(FHandle, FHandle, ARegion.Handle);
|
||
|
|
roIntersect:
|
||
|
|
QRegion_intersect(FHandle, FHandle, ARegion.Handle);
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
if ADestroyRegion then ARegion.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxRegion.IsEqual(ARegion: TcxRegion): Boolean;
|
||
|
|
begin
|
||
|
|
Result := (ARegion <> nil) and ((IsEmpty and ARegion.IsEmpty) or IsEqual(ARegion.Handle));
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxRegion.IsEqual(ARegionHandle: TcxRegionHandle): Boolean;
|
||
|
|
begin
|
||
|
|
Result := EqualRgn(Handle, ARegionHandle);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxRegion.Offset(DX, DY: Integer);
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
OffsetRgn(FHandle, DX, DY);
|
||
|
|
{$ELSE}
|
||
|
|
QRegion_translate(FHandle, DX, DY);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxRegion.PtInRegion(const Pt: TPoint): Boolean;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Result := Windows.PtInRegion(Handle, Pt.X, Pt.Y);
|
||
|
|
{$ELSE}
|
||
|
|
Result := QRegion_contains(Handle, @Pt);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxRegion.PtInRegion(X, Y: Integer): Boolean;
|
||
|
|
begin
|
||
|
|
Result := PtInRegion(Point(X, Y));
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxRegion.RectInRegion(const R: TRect): Boolean;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Result := Windows.RectInRegion(Handle, R);
|
||
|
|
{$ELSE}
|
||
|
|
Result := QRegion_contains(Handle, @R);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxRegion.RectInRegion(ALeft, ATop, ARight, ABottom: Integer): Boolean;
|
||
|
|
begin
|
||
|
|
Result := RectInRegion(Rect(ALeft, ATop, ARight, ABottom));
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TcxCanvas }
|
||
|
|
|
||
|
|
constructor TcxCanvas.Create(ACanvas: TCanvas);
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
FCanvas := ACanvas;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetBrush: TBrush;
|
||
|
|
begin
|
||
|
|
Result := Canvas.Brush;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetCopyMode: TCopyMode;
|
||
|
|
begin
|
||
|
|
Result := Canvas.CopyMode;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetDCOrigin: TPoint;
|
||
|
|
var
|
||
|
|
AWindowOrg, AViewportOrg: TPoint;
|
||
|
|
begin
|
||
|
|
AWindowOrg := WindowOrg;
|
||
|
|
AViewportOrg := ViewportOrg;
|
||
|
|
Result := Point(AViewportOrg.X - AWindowOrg.X, AViewportOrg.Y - AWindowOrg.Y);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetFont: TFont;
|
||
|
|
begin
|
||
|
|
Result := Canvas.Font;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetHandle: {$IFDEF VCL}HDC{$ELSE}QPainterH{$ENDIF};
|
||
|
|
begin
|
||
|
|
Result := Canvas.Handle;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetPen: TPen;
|
||
|
|
begin
|
||
|
|
Result := Canvas.Pen;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetViewportOrg: TPoint;
|
||
|
|
begin
|
||
|
|
GetViewportOrgEx(Handle, Result);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetWindowOrg: TPoint;
|
||
|
|
{$IFNDEF VCL}
|
||
|
|
var
|
||
|
|
R: TRect;
|
||
|
|
{$ENDIF}
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
GetWindowOrgEx(Handle, Result);
|
||
|
|
{$ELSE}
|
||
|
|
QPainter_window(Handle, @R);
|
||
|
|
Result := R.TopLeft;
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetBrush(Value: TBrush);
|
||
|
|
begin
|
||
|
|
Canvas.Brush := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetCopyMode(Value: TCopyMode);
|
||
|
|
begin
|
||
|
|
Canvas.CopyMode := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetFont(Value: TFont);
|
||
|
|
begin
|
||
|
|
Canvas.Font := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetPen(Value: TPen);
|
||
|
|
begin
|
||
|
|
Canvas.Pen := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetPixel(X, Y: Integer; Value: TColor);
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Canvas.Pixels[X, Y] := Value;
|
||
|
|
{$ELSE}
|
||
|
|
SetBrushColor(Value);
|
||
|
|
FillRect(Rect(X, Y, X + 1, Y + 1));
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetViewportOrg(const P: TPoint);
|
||
|
|
begin
|
||
|
|
SetViewportOrgEx(Handle, P.X, P.Y, nil);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetWindowOrg(const P: TPoint);
|
||
|
|
{$IFNDEF VCL}
|
||
|
|
var
|
||
|
|
ACanvasHandle: QPainterH;
|
||
|
|
R: TRect;
|
||
|
|
{$ENDIF}
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
SetWindowOrgEx(Handle, P.X, P.Y, nil);
|
||
|
|
{$ELSE}
|
||
|
|
ACanvasHandle := Handle;
|
||
|
|
QPainter_window(ACanvasHandle, @R);
|
||
|
|
OffsetRect(R, P.X - R.Left, P.Y - R.Top);
|
||
|
|
QPainter_setWindow(ACanvasHandle, @R);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.AlignMultiLineTextRectVertically(var R: TRect;
|
||
|
|
const AText: string; AAlignmentVert: TcxAlignmentVert;
|
||
|
|
AWordBreak, AShowPrefix: Boolean; AEnabled: Boolean = True;
|
||
|
|
ADontBreakChars: Boolean = False);
|
||
|
|
var
|
||
|
|
ASizeR: TRect;
|
||
|
|
AFlags: Integer;
|
||
|
|
begin
|
||
|
|
if AAlignmentVert = vaTop then Exit;
|
||
|
|
ASizeR := Rect(0, 0, R.Right - R.Left - Ord(not AEnabled), 0);
|
||
|
|
AFlags := cxAlignLeft or cxAlignTop;
|
||
|
|
if AWordBreak then
|
||
|
|
AFlags := AFlags or cxWordBreak;
|
||
|
|
if AShowPrefix then
|
||
|
|
AFlags := AFlags or cxShowPrefix;
|
||
|
|
if ADontBreakChars then
|
||
|
|
AFlags := AFlags or cxDontBreakChars;
|
||
|
|
TextExtent(AText, ASizeR, AFlags);
|
||
|
|
case AAlignmentVert of
|
||
|
|
vaCenter:
|
||
|
|
R.Top := (R.Top + R.Bottom - (ASizeR.Bottom - ASizeR.Top)) div 2;
|
||
|
|
vaBottom:
|
||
|
|
R.Top := R.Bottom - (ASizeR.Bottom - ASizeR.Top + Ord(not AEnabled));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.CopyRect(const Dest: TRect; ACanvas: TCanvas;
|
||
|
|
const Source: TRect);
|
||
|
|
begin
|
||
|
|
{$IFNDEF VCL}
|
||
|
|
if IsRectEmpty(Dest) or IsRectEmpty(Source) then Exit;
|
||
|
|
{$ENDIF}
|
||
|
|
Canvas.CopyRect(Dest, ACanvas, Source);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.Draw(X, Y: Integer; Graphic: TGraphic);
|
||
|
|
begin
|
||
|
|
Canvas.Draw(X, Y, Graphic);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawComplexFrame(const R: TRect;
|
||
|
|
ALeftTopColor, ARightBottomColor: TColor; ABorders: TcxBorders;
|
||
|
|
ABorderWidth: Integer);
|
||
|
|
var
|
||
|
|
ABorder: TcxBorder;
|
||
|
|
|
||
|
|
function GetBorderColor: TColor;
|
||
|
|
begin
|
||
|
|
if ABorder in [bLeft, bTop] then
|
||
|
|
Result := ALeftTopColor
|
||
|
|
else
|
||
|
|
Result := ARightBottomColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetBorderBounds: TRect;
|
||
|
|
begin
|
||
|
|
Result := R;
|
||
|
|
with Result do
|
||
|
|
case ABorder of
|
||
|
|
bLeft:
|
||
|
|
Right := Left + ABorderWidth;
|
||
|
|
bTop:
|
||
|
|
Bottom := Top + ABorderWidth;
|
||
|
|
bRight:
|
||
|
|
Left := Right - ABorderWidth;
|
||
|
|
bBottom:
|
||
|
|
Top := Bottom - ABorderWidth;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
for ABorder := Low(ABorder) to High(ABorder) do
|
||
|
|
if ABorder in ABorders then
|
||
|
|
begin
|
||
|
|
SetBrushColor(GetBorderColor);
|
||
|
|
FillRect(GetBorderBounds);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawEdge(const R: TRect; ASunken, AOuter: Boolean;
|
||
|
|
ABorders: TcxBorders);
|
||
|
|
begin
|
||
|
|
if ASunken then
|
||
|
|
if AOuter then
|
||
|
|
DrawComplexFrame(R, clBtnShadow, clBtnHighlight, ABorders)
|
||
|
|
else
|
||
|
|
DrawComplexFrame(R, cl3DDkShadow{clBtnText}, cl3DLight{clBtnFace}, ABorders)
|
||
|
|
else
|
||
|
|
if AOuter then
|
||
|
|
DrawComplexFrame(R, cl3DLight{clBtnFace}, cl3DDkShadow{clBtnText}, ABorders)
|
||
|
|
else
|
||
|
|
DrawComplexFrame(R, clBtnHighlight, clBtnShadow, ABorders);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawFocusRect(const R: TRect);
|
||
|
|
begin
|
||
|
|
SetBrushColor(clWhite);
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Canvas.Font.Color := clBlack;
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
TCanvasAccess(Canvas).RequiredState([csFontValid]);
|
||
|
|
{$ELSE}
|
||
|
|
Canvas.Handle;
|
||
|
|
{$ENDIF}
|
||
|
|
{$ELSE}
|
||
|
|
Canvas.Pen.Color := clBlack;
|
||
|
|
{$ENDIF}
|
||
|
|
Canvas.DrawFocusRect(R);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawGlyph(X, Y: Integer; AGlyph: TBitmap; AEnabled: Boolean = True;
|
||
|
|
ABackgroundColor: TColor = clNone{; ATempCanvas: TCanvas = nil});
|
||
|
|
var
|
||
|
|
{$IFDEF VCL}
|
||
|
|
APrevBrushStyle: TBrushStyle;
|
||
|
|
{$ENDIF}
|
||
|
|
AImageList: TImageList;
|
||
|
|
ABitmap: TBitmap;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if AEnabled {and (ATempCanvas = nil)} then
|
||
|
|
begin
|
||
|
|
APrevBrushStyle := Brush.Style;
|
||
|
|
if ABackgroundColor = clNone then
|
||
|
|
Brush.Style := bsClear
|
||
|
|
else
|
||
|
|
Brush.Color := ABackgroundColor;
|
||
|
|
Canvas.BrushCopy(Bounds(X, Y, AGlyph.Width, AGlyph.Height), AGlyph,
|
||
|
|
Rect(0, 0, AGlyph.Width, AGlyph.Height), AGlyph.TransparentColor);
|
||
|
|
Brush.Style := APrevBrushStyle;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
AImageList := nil;
|
||
|
|
ABitmap := nil;
|
||
|
|
try
|
||
|
|
AImageList := TImageList.Create(nil);
|
||
|
|
AImageList.Width := AGlyph.Width;
|
||
|
|
AImageList.Height := AGlyph.Height;
|
||
|
|
if ABackgroundColor <> clNone then
|
||
|
|
//if ATempCanvas = nil then
|
||
|
|
begin
|
||
|
|
ABitmap := TBitmap.Create;
|
||
|
|
ABitmap.Width := AImageList.Width;
|
||
|
|
ABitmap.Height := AImageList.Height;
|
||
|
|
with ABitmap.Canvas do
|
||
|
|
begin
|
||
|
|
Brush.Color := ABackgroundColor;
|
||
|
|
FillRect(Rect(0, 0, ABitmap.Width, ABitmap.Height));
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
{else
|
||
|
|
with ATempCanvas do
|
||
|
|
begin
|
||
|
|
Brush.Color := ABackgroundColor;
|
||
|
|
FillRect(Bounds(X, Y, AGlyph.Width, AGlyph.Height));
|
||
|
|
end};
|
||
|
|
|
||
|
|
if AGlyph.TransparentMode = tmFixed then
|
||
|
|
AImageList.AddMasked(AGlyph, AGlyph.TransparentColor)
|
||
|
|
else
|
||
|
|
AImageList.AddMasked(AGlyph, clDefault);
|
||
|
|
|
||
|
|
if ABitmap <> nil then
|
||
|
|
begin
|
||
|
|
AImageList.Draw(ABitmap.Canvas, 0, 0, 0{$IFNDEF VCL}, itImage{itMask}{$ENDIF}, AEnabled); // ??? itMask TODO
|
||
|
|
Draw(X, Y, ABitmap);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
(*if ATempCanvas <> nil then
|
||
|
|
AImageList.Draw(ATempCanvas, X, Y, 0{$IFNDEF VCL}, itMask{$ENDIF}, AEnabled) // ??? itMask TODO
|
||
|
|
else*)
|
||
|
|
AImageList.Draw(Canvas, X, Y, 0{$IFNDEF VCL}, itImage{itMask}{$ENDIF}, AEnabled); // ??? itMask TODO
|
||
|
|
finally
|
||
|
|
ABitmap.Free;
|
||
|
|
AImageList.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawImage(Images: TCustomImageList; X, Y, Index: Integer;
|
||
|
|
Enabled: Boolean = True);
|
||
|
|
var
|
||
|
|
ASavedDCInfo: Integer;
|
||
|
|
begin
|
||
|
|
if (0 <= Index) and (Index < Images.Count) then
|
||
|
|
begin
|
||
|
|
if not Enabled then
|
||
|
|
ASavedDCInfo := SaveDC(Handle) // to restore normal colors after TCustomImageList.DoDraw
|
||
|
|
else
|
||
|
|
ASavedDCInfo := 0;
|
||
|
|
Images.Draw(Canvas, X, Y, Index, {$IFNDEF VCL}itImage, {$ENDIF}Enabled);
|
||
|
|
if ASavedDCInfo <> 0 then
|
||
|
|
RestoreDC(Handle, ASavedDCInfo);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawText(const Text: string; R: TRect; Flags: Integer;
|
||
|
|
Enabled: Boolean);
|
||
|
|
var
|
||
|
|
{$IFDEF VCL}
|
||
|
|
AUseDrawText: Boolean;
|
||
|
|
{$ENDIF}
|
||
|
|
PrevBrushStyle: TBrushStyle;
|
||
|
|
PrevFontColor: TColor;
|
||
|
|
|
||
|
|
procedure ProcessFlags;
|
||
|
|
var
|
||
|
|
ASize: TSize;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
AAlignmentVert: TcxAlignmentVert;
|
||
|
|
{$ENDIF}
|
||
|
|
begin
|
||
|
|
ASize := TextExtent(Text);
|
||
|
|
if (ASize.cx <= R.Right - R.Left) and (ASize.cy <= R.Bottom - R.Top) then
|
||
|
|
Flags := Flags or cxDontClip;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if AUseDrawText then
|
||
|
|
begin
|
||
|
|
if (Flags and cxSingleLine = 0) and (Flags and (cxAlignBottom or cxAlignVCenter) <> 0) then
|
||
|
|
begin
|
||
|
|
if Flags and cxAlignBottom <> 0 then
|
||
|
|
AAlignmentVert := vaBottom
|
||
|
|
else
|
||
|
|
AAlignmentVert := vaCenter;
|
||
|
|
AlignMultiLineTextRectVertically(R, Text, AAlignmentVert,
|
||
|
|
cxWordBreak and Flags <> 0, cxShowPrefix and Flags <> 0, Enabled,
|
||
|
|
cxDontBreakChars and Flags <> 0);
|
||
|
|
end;
|
||
|
|
Flags := cxFlagsToDTFlags(Flags);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if ASize.cx < R.Right - R.Left then
|
||
|
|
case Flags and (cxAlignLeft or cxAlignRight or cxAlignHCenter) of
|
||
|
|
cxAlignRight:
|
||
|
|
R.Left := R.Right - ASize.cx - Ord(not Enabled);
|
||
|
|
cxAlignHCenter:
|
||
|
|
R.Left := (R.Left + R.Right - ASize.cx) div 2;
|
||
|
|
end;
|
||
|
|
if ASize.cy < R.Bottom - R.Top then
|
||
|
|
case Flags and (cxAlignTop or cxAlignBottom or cxAlignVCenter) of
|
||
|
|
cxAlignBottom:
|
||
|
|
R.Top := R.Bottom - ASize.cy - Ord(not Enabled);
|
||
|
|
cxAlignVCenter:
|
||
|
|
R.Top := (R.Top + R.Bottom - ASize.cy) div 2;
|
||
|
|
end;
|
||
|
|
if Flags and cxDontClip = 0 then
|
||
|
|
Flags := ETO_CLIPPED
|
||
|
|
else
|
||
|
|
Flags := 0;
|
||
|
|
end;
|
||
|
|
{$ELSE}
|
||
|
|
Flags := Flags and not (cxShowEndEllipsis or cxShowPathEllipsis);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure DoDrawText;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if AUseDrawText then
|
||
|
|
Windows.DrawText(Canvas.Handle, {$IFNDEF CLR}PChar{$ENDIF}(Text), Length(Text), R, Flags)
|
||
|
|
else
|
||
|
|
ExtTextOut(Canvas.Handle, R.Left, R.Top, Flags, {$IFNDEF CLR}@{$ENDIF}R, {$IFNDEF CLR}PChar{$ENDIF}(Text), Length(Text), nil);
|
||
|
|
{$ELSE}
|
||
|
|
Canvas.TextRect(R, R.Left, R.Top, Text, Flags);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if Length(Text) = 0 then Exit;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
AUseDrawText := (Flags and cxSingleLine = 0) or
|
||
|
|
(Flags and (cxShowPrefix or cxShowEndEllipsis or cxShowPathEllipsis) <> 0);
|
||
|
|
{$ENDIF}
|
||
|
|
ProcessFlags;
|
||
|
|
PrevBrushStyle := Brush.Style;
|
||
|
|
PrevFontColor := Font.Color;
|
||
|
|
if not Enabled then
|
||
|
|
begin
|
||
|
|
with R do
|
||
|
|
begin
|
||
|
|
Inc(Left);
|
||
|
|
Inc(Top);
|
||
|
|
end;
|
||
|
|
Brush.Style := bsClear;
|
||
|
|
Font.Color := clBtnHighlight;
|
||
|
|
DoDrawText;
|
||
|
|
OffsetRect(R, -1, -1);
|
||
|
|
Font.Color := clBtnShadow;
|
||
|
|
end;
|
||
|
|
DoDrawText;
|
||
|
|
if Brush.Style <> PrevBrushStyle then
|
||
|
|
Brush.Style := PrevBrushStyle;
|
||
|
|
Font.Color := PrevFontColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.FillRect(const R: TRect; ABitmap: TBitmap = nil;
|
||
|
|
AExcludeRect: Boolean = False);
|
||
|
|
var
|
||
|
|
ABitmapSize, AOffset: TPoint;
|
||
|
|
AFirstCol, AFirstRow, ALastCol, ALastRow, I, J: Integer;
|
||
|
|
ABitmapRect, ACellRect: TRect;
|
||
|
|
begin
|
||
|
|
if IsRectEmpty(R) then Exit;
|
||
|
|
if (ABitmap = nil) or ABitmap.Empty then
|
||
|
|
Canvas.FillRect(R)
|
||
|
|
else
|
||
|
|
with ABitmapSize do
|
||
|
|
begin
|
||
|
|
X := ABitmap.Width;
|
||
|
|
Y := ABitmap.Height;
|
||
|
|
AFirstCol := R.Left div X;
|
||
|
|
AFirstRow := R.Top div Y;
|
||
|
|
ALastCol := R.Right div X - Ord(R.Right mod X = 0);
|
||
|
|
ALastRow := R.Bottom div Y - Ord(R.Bottom mod Y = 0);
|
||
|
|
for J := AFirstRow to ALastRow do
|
||
|
|
for I := AFirstCol to ALastCol do
|
||
|
|
begin
|
||
|
|
AOffset.X := I * X;
|
||
|
|
AOffset.Y := J * Y;
|
||
|
|
ACellRect := Bounds(AOffset.X, AOffset.Y, X, Y);
|
||
|
|
IntersectRect(ACellRect, ACellRect, R);
|
||
|
|
ABitmapRect := ACellRect;
|
||
|
|
OffsetRect(ABitmapRect, -AOffset.X, -AOffset.Y);
|
||
|
|
CopyRect(ACellRect, ABitmap.Canvas, ABitmapRect);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if AExcludeRect then
|
||
|
|
SetClipRegion(TcxRegion.Create(R), roSubtract);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.FillRect(R: TRect; const AParams: TcxViewParams;
|
||
|
|
ABorders: TcxBorders = []; ABorderColor: TColor = clDefault;
|
||
|
|
ALineWidth: Integer = 1; AExcludeRect: Boolean = False);
|
||
|
|
begin
|
||
|
|
FrameRect(R, ABorderColor, ALineWidth, ABorders, AExcludeRect);
|
||
|
|
with R do
|
||
|
|
begin
|
||
|
|
if bLeft in ABorders then
|
||
|
|
Inc(Left, ALineWidth);
|
||
|
|
if bRight in ABorders then
|
||
|
|
Dec(Right, ALineWidth);
|
||
|
|
if bTop in ABorders then
|
||
|
|
Inc(Top, ALineWidth);
|
||
|
|
if bBottom in ABorders then
|
||
|
|
Dec(Bottom, ALineWidth);
|
||
|
|
end;
|
||
|
|
SetBrushColor(AParams.Color);
|
||
|
|
FillRect(R, AParams.Bitmap, AExcludeRect);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF LINUX}
|
||
|
|
|
||
|
|
procedure TcxCanvas.FillRect(const R: TRect; ABrush: TBrush);
|
||
|
|
begin
|
||
|
|
QPainter_fillRect(Handle, @R, ABrush.Handle);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
{$IFNDEF LINUX}
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawDesignSelection(ARect: TRect; AWidth: Integer = cxDesignSelectionWidth);
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
for I := 0 to AWidth - 1 do
|
||
|
|
begin
|
||
|
|
DrawFocusRect(ARect);
|
||
|
|
InflateRect(ARect, -1, -1);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawRegion(ARegion: TcxRegion; AContentColor: TColor = clDefault;
|
||
|
|
ABorderColor: TColor = clDefault; ABorderWidth: Integer = 1; ABorderHeight: Integer = 1);
|
||
|
|
begin
|
||
|
|
DrawRegion(ARegion.Handle, AContentColor, ABorderColor, ABorderWidth, ABorderHeight);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.DrawRegion(ARegion: TcxRegionHandle; AContentColor: TColor = clDefault;
|
||
|
|
ABorderColor: TColor = clDefault; ABorderWidth: Integer = 1; ABorderHeight: Integer = 1);
|
||
|
|
begin
|
||
|
|
FillRegion(ARegion, AContentColor);
|
||
|
|
FrameRegion(ARegion, ABorderColor, ABorderWidth, ABorderHeight);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.FillRegion(ARegion: TcxRegion; AColor: TColor = clDefault);
|
||
|
|
begin
|
||
|
|
FillRegion(ARegion.Handle, AColor);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.FillRegion(ARegion: TcxRegionHandle; AColor: TColor = clDefault);
|
||
|
|
begin
|
||
|
|
SetBrushColor(AColor);
|
||
|
|
FillRgn(Handle, ARegion, Brush.Handle);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.FlipHorizontally(ABitmap: TBitmap);
|
||
|
|
var
|
||
|
|
Bits: TRGBColors;
|
||
|
|
ARow, ACol, W, H, ARowStart: Integer;
|
||
|
|
AValue: TRGBQuad;
|
||
|
|
begin
|
||
|
|
W := ABitmap.Width;
|
||
|
|
H := ABitmap.Height;
|
||
|
|
|
||
|
|
Bits := GetBitmapBits(ABitmap, True);
|
||
|
|
ARowStart := 0;
|
||
|
|
for ARow := 0 to H - 1 do
|
||
|
|
begin
|
||
|
|
for ACol := 0 to (W - 1) div 2 do
|
||
|
|
begin
|
||
|
|
AValue := Bits[ARowStart + ACol];
|
||
|
|
Bits[ARowStart + ACol] := Bits[ARowStart + W - 1 - ACol];
|
||
|
|
Bits[ARowStart + W - 1 - ACol] := AValue;
|
||
|
|
end;
|
||
|
|
Inc(ARowStart, W);
|
||
|
|
end;
|
||
|
|
SetBitmapBits(ABitmap, Bits, True);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.FrameRegion(ARegion: TcxRegion; AColor: TColor = clDefault;
|
||
|
|
ABorderWidth: Integer = 1; ABorderHeight: Integer = 1);
|
||
|
|
begin
|
||
|
|
FrameRegion(ARegion.Handle, AColor, ABorderWidth, ABorderHeight);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.FrameRegion(ARegion: TcxRegionHandle; AColor: TColor = clDefault;
|
||
|
|
ABorderWidth: Integer = 1; ABorderHeight: Integer = 1);
|
||
|
|
begin
|
||
|
|
SetBrushColor(AColor);
|
||
|
|
FrameRgn(Handle, ARegion, Brush.Handle, ABorderWidth, ABorderHeight);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.Pie(const R: TRect; const ARadial1, ARadial2: TPoint);
|
||
|
|
begin
|
||
|
|
with R do
|
||
|
|
Canvas.Pie(Left, Top, Right, Bottom, ARadial1.X, ARadial1.Y, ARadial2.X, ARadial2.Y);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.Pie(const R: TRect; AStartAngle, ASweepAngle: Integer);
|
||
|
|
|
||
|
|
{
|
||
|
|
A * B
|
||
|
|
V = ---------------------------------------------
|
||
|
|
Sqrt(A^2 * Sin^2(Alpha) + B^2 * Cos^2(Alpha))
|
||
|
|
|
||
|
|
Radial.X = V * Cos(Alpha)
|
||
|
|
Radial.Y = V * Sin(Alpha)
|
||
|
|
|
||
|
|
where:
|
||
|
|
A - horizontal ellipse semiaxis
|
||
|
|
B - vertical ellipse semiaxis
|
||
|
|
Angle - an angle between Radius-Vector and A calculated in counterclockwise direction
|
||
|
|
}
|
||
|
|
|
||
|
|
function CalculateRadial(A, B: Integer; const ACenter: TPoint; AnAngle: Integer): TPoint;
|
||
|
|
var
|
||
|
|
Sin, Cos, V: Extended;
|
||
|
|
begin
|
||
|
|
SinCos(DegToRad(AnAngle), Sin, Cos);
|
||
|
|
if (A <> 0) and (B <> 0) then
|
||
|
|
V := A * B / Sqrt(A * A * Sin * Sin + B * B * Cos * Cos)
|
||
|
|
else
|
||
|
|
V := 0;
|
||
|
|
Result.X := ACenter.X + Round(V * Cos);
|
||
|
|
Result.Y := ACenter.Y - Round(V * Sin);
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
A, B: Integer;
|
||
|
|
Center, Radial1, Radial2: TPoint;
|
||
|
|
begin
|
||
|
|
if IsRectEmpty(R) or (ASweepAngle = 0) then Exit;
|
||
|
|
with R do
|
||
|
|
begin
|
||
|
|
A := (Right - Left) div 2;
|
||
|
|
B := (Bottom - Top) div 2;
|
||
|
|
Center.X := Left + A;
|
||
|
|
Center.Y := Top + B;
|
||
|
|
end;
|
||
|
|
Radial1 := CalculateRadial(A, B, Center, AStartAngle);
|
||
|
|
if ASweepAngle = 360 then
|
||
|
|
Radial2 := Radial1
|
||
|
|
else
|
||
|
|
Radial2 := CalculateRadial(A, B, Center, AStartAngle + ASweepAngle);
|
||
|
|
if (Radial1.X <> Radial2.X) or (Radial1.Y <> Radial2.Y) or (ASweepAngle > 180) then
|
||
|
|
Pie(R, Radial1, Radial2);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
function TcxCanvas.FontHeight(AFont: TFont): Integer;
|
||
|
|
begin
|
||
|
|
Font := AFont;
|
||
|
|
Result := TextHeight('Qq');
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.FrameRect(const R: TRect; Color: TColor = clDefault;
|
||
|
|
ALineWidth: Integer = 1; ABorders: TcxBorders = cxBordersAll;
|
||
|
|
AExcludeFrame: Boolean = False);
|
||
|
|
begin
|
||
|
|
if IsRectEmpty(R) then Exit;
|
||
|
|
if Color <> clDefault then
|
||
|
|
begin
|
||
|
|
SetBrushColor(Color);
|
||
|
|
{$IFNDEF VCL}
|
||
|
|
Brush.Style := bsSolid; // bug in Qt
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
with R do
|
||
|
|
begin
|
||
|
|
if bLeft in ABorders then
|
||
|
|
FillRect(Rect(Left, Top, Min(Left + ALineWidth, Right), Bottom), nil, AExcludeFrame);
|
||
|
|
if bRight in ABorders then
|
||
|
|
FillRect(Rect(Max(Right - ALineWidth, Left), Top, Right, Bottom), nil, AExcludeFrame);
|
||
|
|
if bTop in ABorders then
|
||
|
|
FillRect(Rect(Left, Top, Right, Min(Top + ALineWidth, Bottom)), nil, AExcludeFrame);
|
||
|
|
if bBottom in ABorders then
|
||
|
|
FillRect(Rect(Left, Max(Bottom - ALineWidth, Top), Right, Bottom), nil, AExcludeFrame);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.InvertFrame(const R: TRect; ABorderSize: Integer);
|
||
|
|
begin
|
||
|
|
with R do
|
||
|
|
begin
|
||
|
|
InvertRect(Rect(Left, Top, Left + ABorderSize, Bottom));
|
||
|
|
InvertRect(Rect(Right - ABorderSize, Top, Right, Bottom));
|
||
|
|
InvertRect(Rect(Left + ABorderSize, Top,
|
||
|
|
Right - ABorderSize, Top + ABorderSize));
|
||
|
|
InvertRect(Rect(Left + ABorderSize, Bottom - ABorderSize,
|
||
|
|
Right - ABorderSize, Bottom));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.InvertRect({$IFNDEF LINUX}const {$ENDIF}R: TRect);
|
||
|
|
begin
|
||
|
|
{$IFDEF LINUX}
|
||
|
|
IntersectRect(R, R, Canvas.ClipRect);
|
||
|
|
{$ENDIF}
|
||
|
|
with Canvas do
|
||
|
|
begin
|
||
|
|
CopyMode := cmDstInvert;
|
||
|
|
CopyRect(R, Canvas, R);
|
||
|
|
CopyMode := cmSrcCopy;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.LineTo(X, Y: Integer);
|
||
|
|
begin
|
||
|
|
Canvas.LineTo(X, Y);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.MoveTo(X, Y: Integer);
|
||
|
|
begin
|
||
|
|
Canvas.MoveTo(X, Y);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.Polygon(const Points: array of TPoint);
|
||
|
|
begin
|
||
|
|
Canvas.Polygon(Points{$IFNDEF VCL}, False, 0, -1{$ENDIF});
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.Polyline(const Points: array of TPoint);
|
||
|
|
begin
|
||
|
|
Canvas.Polyline(Points);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF VCL}
|
||
|
|
|
||
|
|
procedure TcxCanvas.RotateBitmap(ABitmap: TBitmap; ARotationAngle: TcxRotationAngle;
|
||
|
|
AFlipVertically: Boolean = False);
|
||
|
|
var
|
||
|
|
SourceRGBs, DestRGBs: TRGBColors;
|
||
|
|
ARow, ACol, H, W, ASourceI, ADestI: Integer;
|
||
|
|
begin
|
||
|
|
SourceRGBs := nil; // to remove compiler's warning
|
||
|
|
if (ARotationAngle = ra0) and not AFlipVertically then exit;
|
||
|
|
H := ABitmap.Height;
|
||
|
|
W := ABitmap.Width;
|
||
|
|
|
||
|
|
SourceRGBs := GetBitmapBits(ABitmap, True);
|
||
|
|
SetLength(DestRGBs, Length(SourceRGBs));
|
||
|
|
|
||
|
|
for ARow := 0 to H - 1 do
|
||
|
|
for ACol := 0 to W - 1 do
|
||
|
|
begin
|
||
|
|
ASourceI := ARow * W + ACol;
|
||
|
|
case ARotationAngle of
|
||
|
|
raPlus90:
|
||
|
|
if AFlipVertically then
|
||
|
|
ADestI := ACol * H + ARow
|
||
|
|
else
|
||
|
|
ADestI := (W - ACol - 1) * H + ARow;
|
||
|
|
ra0:
|
||
|
|
ADestI := (H - 1 - ARow) * W + ACol;
|
||
|
|
ra180:
|
||
|
|
if AFlipVertically then
|
||
|
|
ADestI := ARow * W + W - ACol - 1
|
||
|
|
else
|
||
|
|
ADestI := (H - ARow - 1) * W + W - ACol - 1;
|
||
|
|
else
|
||
|
|
if AFlipVertically then
|
||
|
|
ADestI := (W - ACol - 1) * H + H - ARow - 1
|
||
|
|
else
|
||
|
|
ADestI := H - 1 + ACol * H - ARow;
|
||
|
|
end;
|
||
|
|
DestRGBs[ADestI] := SourceRGBs[ASourceI];
|
||
|
|
end;
|
||
|
|
|
||
|
|
if ARotationAngle in [raPlus90, raMinus90] then
|
||
|
|
begin
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
ABitmap.Height := 0;
|
||
|
|
{$ENDIF}
|
||
|
|
ABitmap.Width := H;
|
||
|
|
ABitmap.Height := W;
|
||
|
|
end;
|
||
|
|
SetBitmapBits(ABitmap, DestRGBs, True);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ELSE}
|
||
|
|
|
||
|
|
procedure RotateBitmap(Bitmap: TBitmap; Angle: TcxRotationAngle);
|
||
|
|
var
|
||
|
|
PDest, PDestStart: ^DWord;
|
||
|
|
PSource: ^DWord;
|
||
|
|
PBuffer: Pointer;
|
||
|
|
XSource, YSource: Integer;
|
||
|
|
LineCopyingDirection: Integer;
|
||
|
|
TempVar: Integer;
|
||
|
|
begin
|
||
|
|
case Angle of
|
||
|
|
raPlus90, raMinus90:
|
||
|
|
with Bitmap do
|
||
|
|
begin
|
||
|
|
GetMem(PBuffer, Width * Height * 4);
|
||
|
|
|
||
|
|
LineCopyingDirection := 0;
|
||
|
|
PDestStart := PBuffer;
|
||
|
|
case Angle of
|
||
|
|
raPlus90:
|
||
|
|
begin
|
||
|
|
Inc(PDestStart, Height * (Width - 1));
|
||
|
|
LineCopyingDirection := 1;
|
||
|
|
end;
|
||
|
|
raMinus90:
|
||
|
|
begin
|
||
|
|
Inc(PDestStart, Height - 1);
|
||
|
|
LineCopyingDirection := -1;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for YSource := 0 to Height - 1 do
|
||
|
|
begin
|
||
|
|
PSource := ScanLine[YSource];
|
||
|
|
PDest := PDestStart;
|
||
|
|
for XSource := 0 to Width - 1 do
|
||
|
|
begin
|
||
|
|
PDest^ := PSource^;
|
||
|
|
Dec(PDest, Height * LineCopyingDirection);
|
||
|
|
Inc(PSource);
|
||
|
|
end;
|
||
|
|
Inc(PDestStart, LineCopyingDirection);
|
||
|
|
end;
|
||
|
|
|
||
|
|
TempVar := Width;
|
||
|
|
Width := Height;
|
||
|
|
Height := TempVar;
|
||
|
|
if Width = Height then
|
||
|
|
begin
|
||
|
|
Width := Width + 1;
|
||
|
|
Width := Width - 1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
PDest := PBuffer;
|
||
|
|
for YSource := 0 to Height - 1 do
|
||
|
|
begin
|
||
|
|
Move(PDest^, ScanLine[YSource]^, Width * 4);
|
||
|
|
Inc(PDest, Width);
|
||
|
|
end;
|
||
|
|
|
||
|
|
FreeMem(PBuffer);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
function TcxCanvas.TextExtent(const Text: string): TSize;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
TCanvasAccess(Canvas).RequiredState([csHandleValid, csFontValid]);
|
||
|
|
{$ELSE}
|
||
|
|
Canvas.Handle;
|
||
|
|
{$ENDIF}
|
||
|
|
Result.cX := 0;
|
||
|
|
Result.cY := 0;
|
||
|
|
GetTextExtentPoint(Handle, {$IFNDEF CLR}PChar{$ENDIF}(Text), Length(Text), Result);
|
||
|
|
{$ELSE}
|
||
|
|
Result := Canvas.TextExtent(Text, 0);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.TextExtent(const Text: string; var R: TRect; Flags: Integer);
|
||
|
|
{$IFDEF VCL}
|
||
|
|
var
|
||
|
|
RWidth, RHeight, TextWidth, TextHeight: Integer;
|
||
|
|
|
||
|
|
procedure CalcRSizes(var AWidth, AHeight: Integer);
|
||
|
|
begin
|
||
|
|
with R do
|
||
|
|
begin
|
||
|
|
AWidth := Right - Left;
|
||
|
|
AHeight := Bottom - Top;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure AlignR;
|
||
|
|
begin
|
||
|
|
if Flags and DT_CENTER <> 0 then
|
||
|
|
OffsetRect(R, (RWidth - TextWidth) div 2, 0)
|
||
|
|
else
|
||
|
|
if Flags and DT_RIGHT <> 0 then
|
||
|
|
OffsetRect(R, RWidth - TextWidth, 0);
|
||
|
|
if Flags and DT_VCENTER <> 0 then
|
||
|
|
OffsetRect(R, 0, (RHeight - TextHeight) div 2)
|
||
|
|
else
|
||
|
|
if Flags and DT_BOTTOM <> 0 then
|
||
|
|
OffsetRect(R, 0, RHeight - TextHeight);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
CalcRSizes(RWidth, RHeight);
|
||
|
|
Flags := cxFlagsToDTFlags(Flags);
|
||
|
|
if (RWidth <= 0) and (Text <> '') then // A2079
|
||
|
|
R.Right := R.Left + 1;
|
||
|
|
Windows.DrawText(Canvas.Handle, {$IFNDEF CLR}PChar{$ENDIF}(Text), Length(Text), R,
|
||
|
|
Flags and not DT_VCENTER or DT_CALCRECT);
|
||
|
|
CalcRSizes(TextWidth, TextHeight);
|
||
|
|
AlignR;
|
||
|
|
end;
|
||
|
|
{$ELSE}
|
||
|
|
begin
|
||
|
|
Canvas.TextExtent(Text, R, Flags);
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
function TcxCanvas.TextHeight(const Text: string): Integer;
|
||
|
|
begin
|
||
|
|
Result := TextExtent(Text).cy;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.TextWidth(const Text: string): Integer;
|
||
|
|
begin
|
||
|
|
Result := TextExtent(Text).cx;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.TransparentDraw(X, Y: Integer; ABitmap: TBitmap; AAlpha: Byte;
|
||
|
|
ABackground: TBitmap = nil);
|
||
|
|
|
||
|
|
function BlendValues(ASource, ADestination: DWORD): DWORD;
|
||
|
|
begin
|
||
|
|
Result := MulDiv(ASource, AAlpha, 255) + MulDiv(ADestination, 255 - AAlpha, 255);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure BlendValue(const ASource: TRGBQuad; var ADestination: TRGBQuad);
|
||
|
|
begin
|
||
|
|
ADestination.rgbBlue := BlendValues(ASource.rgbBlue, ADestination.rgbBlue);
|
||
|
|
ADestination.rgbGreen := BlendValues(ASource.rgbGreen, ADestination.rgbGreen);
|
||
|
|
ADestination.rgbRed := BlendValues(ASource.rgbRed, ADestination.rgbRed);
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
W, H, ARow, ACol: Integer;
|
||
|
|
ABackgroundBitmap: TBitmap;
|
||
|
|
ABlendFunction: TBlendFunction;
|
||
|
|
ABits, ABackgroundBits: TRGBColors;
|
||
|
|
begin
|
||
|
|
ABits := nil; // to remove compiler's warning
|
||
|
|
W := ABitmap.Width;
|
||
|
|
H := ABitmap.Height;
|
||
|
|
|
||
|
|
ABackgroundBitmap := TBitmap.Create;
|
||
|
|
ABackgroundBitmap.Width := W;
|
||
|
|
ABackgroundBitmap.Height := H;
|
||
|
|
|
||
|
|
if ABackground = nil then
|
||
|
|
ABackgroundBitmap.Canvas.CopyRect(Rect(0, 0, W, H), Canvas, Bounds(X, Y, W, H))
|
||
|
|
else
|
||
|
|
ABackgroundBitmap.Canvas.Draw(0, 0, ABackground);
|
||
|
|
|
||
|
|
if Assigned(VCLAlphaBlend) then
|
||
|
|
begin
|
||
|
|
ABlendFunction := DefaultBlendFunction;
|
||
|
|
ABlendFunction.SourceConstantAlpha := AAlpha;
|
||
|
|
{$IFDEF CLR}AlphaBlend{$ELSE}VCLAlphaBlend{$ENDIF}(ABackgroundBitmap.Canvas.Handle,
|
||
|
|
0, 0, W, H, ABitmap.Canvas.Handle, 0, 0, W, H, ABlendFunction);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
ABits := GetBitmapBits(ABitmap, True);
|
||
|
|
ABackgroundBits := GetBitmapBits(ABackgroundBitmap, True);
|
||
|
|
|
||
|
|
for ARow := 0 to H - 1 do
|
||
|
|
for ACol := 0 to W - 1 do
|
||
|
|
BlendValue(ABits[ACol * H + ARow], ABackgroundBits[ACol * H + ACol]);
|
||
|
|
|
||
|
|
SetBitmapBits(ABackgroundBitmap, ABackgroundBits, True);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Draw(X, Y, ABackgroundBitmap);
|
||
|
|
|
||
|
|
ABackgroundBitmap.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.GetParams(var AParams: TcxViewParams);
|
||
|
|
begin
|
||
|
|
AParams.Color := Brush.Color;
|
||
|
|
AParams.Font := Font;
|
||
|
|
AParams.TextColor := Font.Color;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetParams(AParams: TcxViewParams);
|
||
|
|
begin
|
||
|
|
SetBrushColor(AParams.Color);
|
||
|
|
Font := AParams.Font;
|
||
|
|
Font.Color := AParams.TextColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetBrushColor(Value: TColor);
|
||
|
|
begin
|
||
|
|
if Brush.Color <> Value then
|
||
|
|
Brush.Color := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetFontAngle(Value: Integer);
|
||
|
|
var
|
||
|
|
ALogFont: TLogFont;
|
||
|
|
begin
|
||
|
|
{$IFDEF CLR}
|
||
|
|
GetObject(Font.Handle, Marshal.SizeOf(TypeOf(TLogFont)), ALogFont);
|
||
|
|
ALogFont.lfOrientation := Value * 10;
|
||
|
|
{$ELSE}
|
||
|
|
GetObject(Font.Handle, SizeOf(ALogFont), @ALogFont);
|
||
|
|
{$ENDIF}
|
||
|
|
ALogFont.lfEscapement := Value * 10;
|
||
|
|
if Value <> 0 then
|
||
|
|
ALogFont.lfOutPrecision := OUT_TT_ONLY_PRECIS;
|
||
|
|
Font.Handle := CreateFontIndirect(ALogFont);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF VCL}
|
||
|
|
|
||
|
|
procedure TcxCanvas.GetTextStringsBounds(Text: string; R: TRect; Flags: Integer;
|
||
|
|
Enabled: Boolean; var ABounds: TRectArray);
|
||
|
|
var
|
||
|
|
AAlignHorz, AAlignVert, AMaxCharCount: Integer;
|
||
|
|
ATextR: TRect;
|
||
|
|
AStringSize: TSize;
|
||
|
|
|
||
|
|
procedure PrepareRects;
|
||
|
|
begin
|
||
|
|
if not Enabled then
|
||
|
|
with R do
|
||
|
|
begin
|
||
|
|
Dec(Right);
|
||
|
|
Dec(Bottom);
|
||
|
|
end;
|
||
|
|
ATextR := R;
|
||
|
|
TextExtent(Text, ATextR, Flags);
|
||
|
|
case AAlignVert of
|
||
|
|
cxAlignBottom:
|
||
|
|
OffsetRect(ATextR, 0, R.Bottom - ATextR.Bottom);
|
||
|
|
cxAlignVCenter:
|
||
|
|
OffsetRect(ATextR, 0, (R.Bottom - ATextR.Bottom) div 2);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure CheckMaxCharCount;
|
||
|
|
|
||
|
|
function ProcessSpecialChars: Boolean;
|
||
|
|
const
|
||
|
|
SpecialChars = [#10, #13];
|
||
|
|
var
|
||
|
|
I, ACharCount: Integer;
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
for I := 1 to AMaxCharCount do
|
||
|
|
if Text[I] in SpecialChars then
|
||
|
|
begin
|
||
|
|
AMaxCharCount := I - 1;
|
||
|
|
ACharCount := 1;
|
||
|
|
if (I < Length(Text)) and
|
||
|
|
(Text[I + 1] in SpecialChars) and (Text[I] <> Text[I + 1]) then
|
||
|
|
Inc(ACharCount);
|
||
|
|
Delete(Text, I, ACharCount);
|
||
|
|
Result := True;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ProcessSpaces;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
if AMaxCharCount < Length(Text) then
|
||
|
|
for I := AMaxCharCount + 1 downto 1 do
|
||
|
|
if Text[I] = ' ' then
|
||
|
|
begin
|
||
|
|
if I < AMaxCharCount then
|
||
|
|
begin
|
||
|
|
AMaxCharCount := I;
|
||
|
|
if AAlignHorz <> cxAlignLeft then
|
||
|
|
begin
|
||
|
|
Delete(Text, I, 1);
|
||
|
|
Dec(AMaxCharCount);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if not ProcessSpecialChars then
|
||
|
|
ProcessSpaces;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure GetStringSize;
|
||
|
|
begin
|
||
|
|
if AMaxCharCount = 0 then
|
||
|
|
AStringSize.cx := 0
|
||
|
|
else
|
||
|
|
GetTextExtentPoint(Handle, {$IFNDEF CLR}PChar{$ENDIF}(Copy(Text, 1, AMaxCharCount)),
|
||
|
|
AMaxCharCount, AStringSize);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function GetBounds: TRect;
|
||
|
|
begin
|
||
|
|
Result := ATextR;
|
||
|
|
with Result, AStringSize do
|
||
|
|
begin
|
||
|
|
case AAlignHorz of
|
||
|
|
cxAlignLeft:
|
||
|
|
Right := Left + cx;
|
||
|
|
cxAlignRight:
|
||
|
|
Left := Right - cx;
|
||
|
|
cxAlignHCenter:
|
||
|
|
begin
|
||
|
|
Left := (Left + Right - cx) div 2;
|
||
|
|
Right := Left + cx;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Bottom := Top + cy;
|
||
|
|
end;
|
||
|
|
ATextR.Top := Result.Bottom;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if Text = '' then Exit;
|
||
|
|
if Flags and cxShowPrefix <> 0 then
|
||
|
|
begin
|
||
|
|
Text := StripHotKey(Text);
|
||
|
|
Flags := Flags and not cxShowPrefix;
|
||
|
|
end;
|
||
|
|
AAlignHorz := Flags and (cxAlignLeft or cxAlignRight or cxAlignHCenter);
|
||
|
|
AAlignVert := Flags and (cxAlignTop or cxAlignBottom or cxAlignVCenter);
|
||
|
|
PrepareRects;
|
||
|
|
repeat
|
||
|
|
GetTextExtentExPoint(Handle, {$IFNDEF CLR}PChar{$ENDIF}(Text), Length(Text), R.Right - R.Left,
|
||
|
|
{$IFNDEF CLR}@{$ENDIF}AMaxCharCount, nil, AStringSize);
|
||
|
|
CheckMaxCharCount;
|
||
|
|
GetStringSize;
|
||
|
|
SetLength(ABounds, High(ABounds) + 2);
|
||
|
|
ABounds[High(ABounds)] := GetBounds;
|
||
|
|
Delete(Text, 1, AMaxCharCount);
|
||
|
|
until Text = '';
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
{$IFNDEF LINUX}
|
||
|
|
|
||
|
|
procedure TcxCanvas.BeginPath;
|
||
|
|
begin
|
||
|
|
Windows.BeginPath(Handle);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.EndPath;
|
||
|
|
begin
|
||
|
|
Windows.EndPath(Handle);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.PathToRegion: TcxRegion;
|
||
|
|
begin
|
||
|
|
Result := TcxRegion.Create(Windows.PathToRegion(Handle));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.WidenPath;
|
||
|
|
begin
|
||
|
|
Windows.WidenPath(Handle);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
procedure TcxCanvas.ExcludeClipRect(const R: TRect);
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
with R do
|
||
|
|
Windows.ExcludeClipRect(Handle, Left, Top, Right, Bottom);
|
||
|
|
{$ELSE}
|
||
|
|
if not IsRectEmpty(R) then
|
||
|
|
SetClipRegion(TcxRegion.Create(R), roSubtract);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.IntersectClipRect(const R: TRect);
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
with R do
|
||
|
|
Windows.IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
|
||
|
|
{$ELSE}
|
||
|
|
if IsRectEmpty(R) then Exit;
|
||
|
|
SetClipRegion(TcxRegion.Create(R), roIntersect);
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.GetClipRegion(AConsiderOrigin: Boolean = True): TcxRegion;
|
||
|
|
const
|
||
|
|
MaxRegionSize = 30000;
|
||
|
|
begin
|
||
|
|
Result := TcxRegion.Create;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if GetClipRgn(Handle, Result.Handle) = 0 then
|
||
|
|
SetRectRgn(Result.Handle, 0, 0, MaxRegionSize, MaxRegionSize);
|
||
|
|
{$ELSE}
|
||
|
|
if QPainter_hasClipping(Handle) then
|
||
|
|
QRegion_unite(Result.Handle, Result.Handle, Canvas.GetClipRegion)
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Result.DestroyHandle;
|
||
|
|
Result.Handle := QRegion_create(0, 0, MaxInt div 20, MaxInt div 20,
|
||
|
|
QRegionRegionType_Rectangle);
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
if AConsiderOrigin then
|
||
|
|
Result.Offset(-DCOrigin.X, -DCOrigin.Y);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxCanvas.SetClipRegion(ARegion: TcxRegion; AOperation: TcxRegionOperation;
|
||
|
|
ADestroyRegion: Boolean = True; AConsiderOrigin: Boolean = True);
|
||
|
|
var
|
||
|
|
AClipRegion: TcxRegion;
|
||
|
|
ARegionOrigin: TPoint;
|
||
|
|
begin
|
||
|
|
if AOperation = roSet then
|
||
|
|
begin
|
||
|
|
if AConsiderOrigin then
|
||
|
|
begin
|
||
|
|
ARegionOrigin := DCOrigin;
|
||
|
|
ARegion.Offset(ARegionOrigin.X, ARegionOrigin.Y);
|
||
|
|
end;
|
||
|
|
SelectClipRgn(Handle, ARegion.Handle);
|
||
|
|
if ADestroyRegion then
|
||
|
|
ARegion.Free
|
||
|
|
else
|
||
|
|
if AConsiderOrigin then
|
||
|
|
ARegion.Offset(-ARegionOrigin.X, -ARegionOrigin.Y);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
AClipRegion := GetClipRegion(AConsiderOrigin);
|
||
|
|
AClipRegion.Combine(ARegion, AOperation, ADestroyRegion);
|
||
|
|
SetClipRegion(AClipRegion, roSet, True, AConsiderOrigin);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.RectFullyVisible(const R: TRect): Boolean;
|
||
|
|
var
|
||
|
|
AClipRegion, ARegion: TcxRegion;
|
||
|
|
begin
|
||
|
|
AClipRegion := GetClipRegion;
|
||
|
|
ARegion := TcxRegion.Create(R);
|
||
|
|
try
|
||
|
|
CombineRgn(AClipRegion.Handle, AClipRegion.Handle, ARegion.Handle, RGN_AND);
|
||
|
|
Result := AClipRegion.IsEqual(ARegion);
|
||
|
|
finally
|
||
|
|
ARegion.Free;
|
||
|
|
AClipRegion.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxCanvas.RectVisible({$IFDEF VCL}const {$ENDIF}R: TRect): Boolean;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Result := Windows.RectVisible(Handle, R);
|
||
|
|
{$ELSE}
|
||
|
|
Result := not QPainter_hasClipping(Handle);
|
||
|
|
if Result then
|
||
|
|
Result := not IsRectEmpty(R)
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Inc(R.Right);
|
||
|
|
Inc(R.Bottom);
|
||
|
|
Result := QRegion_contains(QPainter_clipRegion(Handle), PRect(@R));
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TScreenCanvas }
|
||
|
|
|
||
|
|
type
|
||
|
|
TScreenCanvas = class({$IFDEF VCL}TCanvas{$ELSE}TQtCanvas{$ENDIF})
|
||
|
|
private
|
||
|
|
{$IFNDEF VCL}
|
||
|
|
FWidget: QOpenWidgetH;
|
||
|
|
FWidgetFlags: Integer;
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFDEF VCL}
|
||
|
|
procedure FreeHandle;
|
||
|
|
protected
|
||
|
|
procedure CreateHandle; override;
|
||
|
|
{$ENDIF}
|
||
|
|
public
|
||
|
|
constructor Create;
|
||
|
|
destructor Destroy; override;
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TScreenCanvas.Create;
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
{$IFNDEF VCL}
|
||
|
|
FWidget := QOpenWidgetH(QApplication_desktop);
|
||
|
|
FWidgetFlags := QOpenWidget_getWFlags(FWidget);
|
||
|
|
QOpenWidget_setWFlags(FWidget, FWidgetFlags or Integer(WidgetFlags_WPaintUnclipped));
|
||
|
|
QtHandle := FWidget;
|
||
|
|
Start;
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TScreenCanvas.Destroy;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
FreeHandle;
|
||
|
|
{$ELSE}
|
||
|
|
Stop;
|
||
|
|
QOpenWidget_setWFlags(FWidget, FWidgetFlags);
|
||
|
|
{$ENDIF}
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF VCL}
|
||
|
|
|
||
|
|
procedure TScreenCanvas.FreeHandle;
|
||
|
|
begin
|
||
|
|
ReleaseDC(0, Handle);
|
||
|
|
Handle := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TScreenCanvas.CreateHandle;
|
||
|
|
begin
|
||
|
|
Handle := GetDC(0);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
{ TcxScreenCanvas }
|
||
|
|
|
||
|
|
constructor TcxScreenCanvas.Create;
|
||
|
|
begin
|
||
|
|
inherited Create(TScreenCanvas.Create);
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TcxScreenCanvas.Destroy;
|
||
|
|
begin
|
||
|
|
FCanvas.Free;
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TcxBitmap }
|
||
|
|
|
||
|
|
procedure TcxBitmap.Assign(Source: TPersistent);
|
||
|
|
begin
|
||
|
|
if not (Source is TBitmap) or not (Empty and TBitmap(Source).Empty) then
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
|
||
|
|
{$IFDEF VCL}
|
||
|
|
const
|
||
|
|
SystemBrushes: TList = nil;
|
||
|
|
SysColorPrefix = {$IFDEF DELPHI7} clSystemColor {$ELSE} $80000000 {$ENDIF};
|
||
|
|
BrushDataSize = SizeOf(TcxBrushData);
|
||
|
|
scxBrushCacheReleaseUnusedBrush = 'Release unused brush';
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
destructor TcxBrushCache.Destroy;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
for I := 0 to FCount - 1 do
|
||
|
|
FData[I].Brush.Free;
|
||
|
|
finally
|
||
|
|
inherited Destroy;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.BeginUpdate;
|
||
|
|
begin
|
||
|
|
Inc(FLockRef);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.EndUpdate;
|
||
|
|
begin
|
||
|
|
Inc(FLockRef);
|
||
|
|
if (FLockRef = 0) and (FDeletedCount <> 0) then Pack;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.ReleaseBrush(var ABrush: TBrush);
|
||
|
|
var
|
||
|
|
AIndex: Integer;
|
||
|
|
begin
|
||
|
|
if ABrush <> nil then
|
||
|
|
begin
|
||
|
|
if not IsSystemBrush(ABrush) and IndexOf(ABrush.Color, AIndex) then
|
||
|
|
begin
|
||
|
|
with FData[AIndex] do
|
||
|
|
begin
|
||
|
|
Dec(RefCount);
|
||
|
|
CacheCheck(RefCount < 0, scxBrushCacheReleaseUnusedBrush);
|
||
|
|
if RefCount <= 0 then Delete(AIndex);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.SetBrushColor(var ABrush: TBrush; AColor: TColor);
|
||
|
|
begin
|
||
|
|
ReleaseBrush(ABrush);
|
||
|
|
ABrush := Add(AColor);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxBrushCache.Add(AColor: TColor): TBrush;
|
||
|
|
begin
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if AColor and SysColorPrefix <> 0 then
|
||
|
|
Result := TBrush(SystemBrushes[AColor and not SysColorPrefix])
|
||
|
|
else
|
||
|
|
{$ENDIF}
|
||
|
|
Result := AddItemAt(FindNearestItem(AColor), AColor);
|
||
|
|
Result.Color := AColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxBrushCache.AddItemAt(AIndex: Integer; AColor: TColor): TBrush;
|
||
|
|
var
|
||
|
|
Delta: Integer;
|
||
|
|
begin
|
||
|
|
if (AIndex >= FCount) or (FData[AIndex].Color <> AColor) then
|
||
|
|
begin
|
||
|
|
if FCapacity <= FCount then
|
||
|
|
begin
|
||
|
|
Delta := FCapacity shr 2;
|
||
|
|
if Delta < 8 then Delta := 8;
|
||
|
|
Inc(FCapacity, Delta);
|
||
|
|
SetLength(FData, FCapacity);
|
||
|
|
end;
|
||
|
|
if AIndex < FCount then Move(AIndex, AIndex + 1, FCount - AIndex);
|
||
|
|
InitItem(FData[AIndex], AColor);
|
||
|
|
Inc(FCount);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
if FData[AIndex].RefCount = 0 then Dec(FDeletedCount);
|
||
|
|
Inc(FData[AIndex].RefCount);
|
||
|
|
Result := FData[AIndex].Brush;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.CacheCheck(Value: Boolean; const AMessage: string);
|
||
|
|
begin
|
||
|
|
if Value then
|
||
|
|
raise EBrushCache.Create(AMessage);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.Delete(AIndex: Integer);
|
||
|
|
begin
|
||
|
|
if FLockRef = 0 then
|
||
|
|
begin
|
||
|
|
FData[AIndex].Brush.Free;
|
||
|
|
Dec(FCount);
|
||
|
|
if AIndex < FCount then
|
||
|
|
Move(AIndex + 1, AIndex, FCount - AIndex);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Inc(FDeletedCount);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxBrushCache.IndexOf(AColor: TColor; out AIndex: Integer): Boolean;
|
||
|
|
begin
|
||
|
|
AIndex := -1;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
if (AColor and SysColorPrefix = 0) then
|
||
|
|
{$ENDIF}
|
||
|
|
AIndex := FindNearestItem(AColor);
|
||
|
|
Result := (AIndex >= 0) and (AIndex < FCount) and (FData[AIndex].Color = AColor);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.InitItem(var AItem: TcxBrushData; AColor: TColor);
|
||
|
|
begin
|
||
|
|
FillChar(AItem, BrushDataSize, 0);
|
||
|
|
AItem.Brush := TBrush.Create;
|
||
|
|
AItem.Brush.Color := AColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxBrushCache.IsSystemBrush(ABrush: TBrush): Boolean;
|
||
|
|
begin
|
||
|
|
Result := ABrush = nil;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
Result := Result or ((ABrush.Color and SysColorPrefix) <> 0);
|
||
|
|
{$ENDIF};
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TcxBrushCache.FindNearestItem(AColor: TColor): Integer;
|
||
|
|
|
||
|
|
function Check(Min, Max: Integer): Integer;
|
||
|
|
begin
|
||
|
|
Result := Max;
|
||
|
|
if AColor <= FData[Min].Color then
|
||
|
|
Result := Min
|
||
|
|
else
|
||
|
|
if AColor > FData[Max].Color then
|
||
|
|
AColor := Max + 1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
A, B, C: Integer;
|
||
|
|
begin
|
||
|
|
if FCount > 0 then
|
||
|
|
begin
|
||
|
|
A := 0;
|
||
|
|
B := FCount - 1;
|
||
|
|
if (FData[0].Color >= AColor) or (FData[B].Color <= AColor) then
|
||
|
|
Result := Check(A, B)
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
while A < B do
|
||
|
|
begin
|
||
|
|
C := (A + B) shr 1;
|
||
|
|
with FData[C] do
|
||
|
|
begin
|
||
|
|
if Color < AColor then
|
||
|
|
A := C
|
||
|
|
else
|
||
|
|
if Color > AColor then
|
||
|
|
B := C
|
||
|
|
else
|
||
|
|
B := A;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Result := Check(A, B);
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.Move(ASrc, ADst, ACount: Integer);
|
||
|
|
begin
|
||
|
|
System.Move(FData[ASrc], FData[ADst], ACount * BrushDataSize);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.Pack;
|
||
|
|
var
|
||
|
|
I, ACount: Integer;
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
ACount := 0;
|
||
|
|
I := FCount - 1;
|
||
|
|
while (ACount < FDeletedCount) and (I >= 0) do
|
||
|
|
begin
|
||
|
|
if FData[I].RefCount < 0 then
|
||
|
|
begin
|
||
|
|
Delete(I);
|
||
|
|
Inc(ACount);
|
||
|
|
end;
|
||
|
|
Dec(I);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
FDeletedCount := 0;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.Recreate;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
for I := 0 to FCount - 1 do
|
||
|
|
with FData[I] do Brush.Color := Color;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TcxBrushCache.Release(AIndex: Integer);
|
||
|
|
begin
|
||
|
|
Dec(FData[AIndex].RefCount);
|
||
|
|
if FData[AIndex].RefCount = 0 then Delete(AIndex);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF VCL}
|
||
|
|
procedure InitSystemBrushes;
|
||
|
|
var
|
||
|
|
I: Word;
|
||
|
|
ABrush: TBrush;
|
||
|
|
begin
|
||
|
|
SystemBrushes := TList.Create;
|
||
|
|
for I := COLOR_SCROLLBAR to COLOR_ENDCOLORS do
|
||
|
|
begin
|
||
|
|
ABrush := TBrush.Create;
|
||
|
|
ABrush.Handle := GetSysColorBrush(I);
|
||
|
|
SystemBrushes.Add(ABrush);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure DestroySystemBrushes;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
for I := 0 to SystemBrushes.Count - 1 do
|
||
|
|
TBrush(SystemBrushes[I]).Free;
|
||
|
|
finally
|
||
|
|
SystemBrushes.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
procedure InitPredefinedBrushes;
|
||
|
|
var
|
||
|
|
ABitmap: {$IFDEF VCL} HBitmap {$ELSE} TBitmap{$ENDIF};
|
||
|
|
{$IFNDEF VCL}
|
||
|
|
I, J: Integer;
|
||
|
|
{$ENDIF}
|
||
|
|
const
|
||
|
|
APattern: array[0..7] of Word =
|
||
|
|
($00AA, $0055, $00AA, $0055, $00AA, $0055, $00AA, $0055);
|
||
|
|
begin
|
||
|
|
cxHalfToneBrush := TBrush.Create;
|
||
|
|
{$IFDEF VCL}
|
||
|
|
InitSystemBrushes;
|
||
|
|
ABitmap := CreateBitmap(8, 8, 1, 1, @APattern);
|
||
|
|
cxHalfToneBrush.Handle := CreatePatternBrush(ABitmap);
|
||
|
|
DeleteObject(ABitmap);
|
||
|
|
{$ELSE}
|
||
|
|
ABitmap := cxCreateBitmap(TSize(cxPointPoint(8, 8)), pf1Bit);
|
||
|
|
ABitmap.Monochrome := True;
|
||
|
|
for I := 0 to 7 do
|
||
|
|
for J := 0 to 7 do
|
||
|
|
begin
|
||
|
|
if ((APattern[I] and (1 shl J)) <> 0) then
|
||
|
|
ABitmap.Canvas.Pen.Color := ColorToRGB(clBlack)
|
||
|
|
else
|
||
|
|
ABitmap.Canvas.Pen.Color := ColorToRGB(clWhite);
|
||
|
|
ABitmap.Canvas.DrawPoint(J, K);
|
||
|
|
end;
|
||
|
|
cxHalfToneBrush.Bitmap := ABitmap;
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure DestroyPredefinedBrushes;
|
||
|
|
begin
|
||
|
|
DestroySystemBrushes;
|
||
|
|
{$IFDEF DELPHI9}
|
||
|
|
{$IFNDEF DELPHI10}
|
||
|
|
cxHalfToneBrush.Bitmap.Free;
|
||
|
|
{$ENDIF}
|
||
|
|
{$ENDIF}
|
||
|
|
cxHalfToneBrush.Free;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
var
|
||
|
|
ALib: Integer;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
InitPredefinedBrushes;
|
||
|
|
{$ENDIF}
|
||
|
|
ALib := LoadLibrary('msimg32.dll');
|
||
|
|
if ALib <> 0 then
|
||
|
|
VCLAlphaBlend := GetProcAddress(ALib, 'AlphaBlend')
|
||
|
|
else
|
||
|
|
VCLAlphaBlend := nil;
|
||
|
|
|
||
|
|
finalization
|
||
|
|
if ALib <> 0 then FreeLibrary(ALib);
|
||
|
|
{$IFNDEF CLR}
|
||
|
|
DestroyPredefinedBrushes;
|
||
|
|
FreeAndNil(ScreenCanvas);
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
end.
|