Модератор: Модераторы
vitaly_l » 04.02.2017 12:58:26
zub писал(а):Людям с техническим образованием должно быть стыдно за глобальные переменные.
. Лекс Айрин писал(а):Для особо упертых художников Вот прога:
zub » 04.02.2017 13:00:16
vitaly_l » 04.02.2017 13:01:17
zub писал(а):не использовать глобальные переменные
Поэтому и у Alex2013 код тормозит 
... zub » 04.02.2017 13:10:57
beria » 04.02.2017 13:21:02
vitaly_l писал(а):глобальных переменных
var
TSGMLArray : array [0..1903] of TSGMLRec =( ..... что-то там New(P);
if Assigned(P) then....
vitaly_l » 04.02.2017 13:29:34
zub писал(а):Просто у когото руки не оттуда растут
zub писал(а):при попытке доступа через неинициализированый указатель...
beria писал(а):И более использовать динамические переменные через New. GetMem типа
Лекс Айрин » 04.02.2017 13:32:28
beria писал(а):А ежели вот так инициализировать глобальные константы и переменные
vitaly_l » 04.02.2017 13:34:36
Лекс Айрин писал(а):Люди придумывают как упростить программисту жизнь
beria » 04.02.2017 13:40:58
Лекс Айрин писал(а):а он так и жаждет словить ошибку...
zub » 04.02.2017 13:43:04
Лекс Айрин » 04.02.2017 13:47:05
vitaly_l писал(а):А оказалось, всё банально. Ноли прописываются, по сути ЛЮБАЯ картинка ВСЕГДА инициализируется 2 раза подряд. И естественно программа тормозит.
vitaly_l писал(а):Теперь понятно почему С++шные программы работают быстрее, несмотря на то что - ассемблер везде одинаковый.
vitaly_l » 04.02.2017 13:51:50
beria писал(а):И что плохого в инициализации глобальных переменных.... Мне в коде ручками прописывать все тыщи элементов массива?
zub писал(а):нука специалист, покажи двойную работу в tbitmap)) я чесно не в курсе может она там гденить и есть))
{
/***************************************************************************
graphics.pp
-----------
Graphic Controls
Initial Revision : Mon Jul 26 0:02:58 1999
***************************************************************************/
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
unit Graphics;
{$mode objfpc}{$H+}
{$I lcl_defines.inc}
interface
{$ifdef Trace}
{$ASSERTIONS ON}
{$endif}
{$IF FPC_FULLVERSION>=20601}
{$DEFINE HasFPCanvas1}
{$ENDIF}
{$IF FPC_FULLVERSION>=20603}
{$DEFINE HasFPEndCap}
{$ENDIF}
{$IF FPC_FULLVERSION>=20603}
{$DEFINE HasFPJoinStyle}
{$ENDIF}
uses
SysUtils, Math, Types, Classes, Contnrs, FPCAdds, LCLVersion, LazUTF8Classes,
FileUtil,
FPImage, FPCanvas,
FPWriteBMP, // bmp support
FPWritePNG, PNGComn, // png support
FPReadPNM, FPWritePNM, // PNM (Portable aNyMap) support
FPReadJpeg, FPWriteJpeg, // jpg support
FPReadTiff, FPTiffCmn, // tiff support
FPReadGif,
AvgLvlTree,
IntfGraphics,
LCLStrConsts, LCLType, LCLProc, LMessages, LResources, LCLResCache,
GraphType, IcnsTypes, GraphMath, WSReferences;
type
PColor = ^TColor;
TColor = TGraphicsColor;
TFontPitch = (fpDefault, fpVariable, fpFixed);
TFontName = string;
TFontDataName = string[LF_FACESIZE -1];
TFontStyle = (fsBold, fsItalic, fsStrikeOut, fsUnderline);
TFontStyles = set of TFontStyle;
TFontStylesbase = set of TFontStyle;
TFontCharSet = 0..255;
TFontQuality = (fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased,
fqCleartype, fqCleartypeNatural);
TFontData = record
Handle: HFont;
Height: Integer;
Pitch: TFontPitch;
Style: TFontStylesBase;
CharSet: TFontCharSet;
Quality: TFontQuality;
Name: TFontDataName;
Orientation: Integer;
end;
const
// New TFont instances are initialized with the values in this structure.
// About font default values: The default font is chosen by the interfaces
// depending on the context. For example, there can be a different default
// font for a button and a groupbox.
DefFontData: TFontData = (
Handle: 0;
Height: 0;
Pitch: fpDefault;
Style: [];
Charset: DEFAULT_CHARSET;
Quality: fqDefault;
Name: 'default';
Orientation: 0;
);
type
{ Reflects text style when drawn in a rectangle }
TTextLayout = (tlTop, tlCenter, tlBottom);
TTextStyle = packed record
Alignment : TAlignment; // TextRect Only: horizontal alignment
Layout : TTextLayout; // TextRect Only: vertical alignment
SingleLine: boolean; // If WordBreak is false then process #13, #10 as
// standard chars and perform no Line breaking.
Clipping : boolean; // TextRect Only: Clip Text to passed Rectangle
ExpandTabs: boolean; // Replace #9 by apropriate amount of spaces (default is usually 8)
ShowPrefix: boolean; // TextRect Only: Process first single '&' per
// line as an underscore and draw '&&' as '&'
Wordbreak : boolean; // TextRect Only: If line of text is too long
// too fit between left and right boundaries
// try to break into multiple lines between
// words
// See also EndEllipsis.
Opaque : boolean; // TextRect: Fills background with current Brush
// TextOut : Fills background with current
// foreground color
SystemFont: Boolean; // Use the system font instead of Canvas Font
RightToLeft: Boolean; //For RightToLeft text reading (Text Direction)
EndEllipsis: Boolean; // TextRect Only: If line of text is too long
// to fit between left and right boundaries
// truncates the text and adds "..."
// If Wordbreak is set as well, Workbreak will
// dominate.
end;
const
psSolid = FPCanvas.psSolid;
psDash = FPCanvas.psDash;
psDot = FPCanvas.psDot;
psDashDot = FPCanvas.psDashDot;
psDashDotDot = FPCanvas.psDashDotDot;
psClear = FPCanvas.psClear;
psInsideframe = FPCanvas.psInsideframe;
psPattern = FPCanvas.psPattern;
pmBlack = FPCanvas.pmBlack;
pmWhite = FPCanvas.pmWhite;
pmNop = FPCanvas.pmNop;
pmNot = FPCanvas.pmNot;
pmCopy = FPCanvas.pmCopy;
pmNotCopy = FPCanvas.pmNotCopy;
pmMergePenNot = FPCanvas.pmMergePenNot;
pmMaskPenNot = FPCanvas.pmMaskPenNot;
pmMergeNotPen = FPCanvas.pmMergeNotPen;
pmMaskNotPen = FPCanvas.pmMaskNotPen;
pmMerge = FPCanvas.pmMerge;
pmNotMerge = FPCanvas.pmNotMerge;
pmMask = FPCanvas.pmMask;
pmNotMask = FPCanvas.pmNotMask;
pmXor = FPCanvas.pmXor;
pmNotXor = FPCanvas.pmNotXor;
bsSolid = FPCanvas.bsSolid;
bsClear = FPCanvas.bsClear;
bsHorizontal = FPCanvas.bsHorizontal;
bsVertical = FPCanvas.bsVertical;
bsFDiagonal = FPCanvas.bsFDiagonal;
bsBDiagonal = FPCanvas.bsBDiagonal;
bsCross = FPCanvas.bsCross;
bsDiagCross = FPCanvas.bsDiagCross;
{$IFDEF HasFPEndCap}
pecRound = FPCanvas.pecRound;
pecSquare = FPCanvas.pecSquare;
pecFlat = FPCanvas.pecFlat;
{$ENDIF}
{$IFDEF HasFPJoinStyle}
pjsRound = FPCanvas.pjsRound;
pjsBevel = FPCanvas.pjsBevel;
pjsMiter =FPCanvas.pjsMiter;
{$ENDIF}
type
TFillStyle = TGraphicsFillStyle;
TFillMode = (fmAlternate, fmWinding);
TCopymode = longint;
TCanvasStates = (csHandleValid,
csFontValid, // true if Font properties correspond to
// selected Font Handle in DC
csPenvalid, csBrushValid, csRegionValid);
TCanvasState = set of TCanvasStates;
TCanvasOrientation = (csLefttoRight, coRighttoLeft);
{ TProgressEvent is a generic progress notification event which may be
used by TGraphic classes with computationally intensive (slow)
operations, such as loading, storing, or transforming image data.
Event params:
Stage - Indicates whether this call to the OnProgress event is to
prepare for, process, or clean up after a graphic operation. If
OnProgress is called at all, the first call for a graphic operation
will be with Stage = psStarting, to allow the OnProgress event handler
to allocate whatever resources it needs to process subsequent progress
notifications. After Stage = psStarting, you are guaranteed that
OnProgress will be called again with Stage = psEnding to allow you
to free those resources, even if the graphic operation is aborted by
an exception. Zero or more calls to OnProgress with Stage = psRunning
may occur between the psStarting and psEnding calls.
PercentDone - The ratio of work done to work remaining, on a scale of
0 to 100. Values may repeat or even regress (get smaller) in
successive calls. PercentDone is usually only a guess, and the
guess may be dramatically altered as new information is discovered
in decoding the image.
RedrawNow - Indicates whether the graphic can be/should be redrawn
immediately. Useful for showing successive approximations of
an image as data is available instead of waiting for all the data
to arrive before drawing anything. Since there is no message loop
activity during graphic operations, you should call Update to force
a control to be redrawn immediately in the OnProgress event handler.
Redrawing a graphic when RedrawNow = False could corrupt the image
and/or cause exceptions.
Rect - Area of image that has changed and needs to be redrawn.
Msg - Optional text describing in one or two words what the graphic
class is currently working on. Ex: "Loading" "Storing"
"Reducing colors". The Msg string can also be empty.
Msg strings should be resourced for translation, should not
contain trailing periods, and should be used only for
display purposes. (do not: if Msg = 'Loading' then...)
}
TProgressStage = TFPImgProgressStage;
TProgressEvent = TFPImgProgressEvent;
{ For Delphi compatibility }
TPixelFormat = (
pfDevice,
pf1bit,
pf4bit,
pf8bit,
pf15bit,
pf16bit,
pf24bit,
pf32bit,
pfCustom
);
const
PIXELFORMAT_BPP: array[TPixelFormat] of Byte = (
0, 1, 4, 8, 15, 16, 24, 32, 0
);
type
TTransparentMode = (
tmAuto,
tmFixed
);
const
// The following colors match the predefined Delphi Colors
// standard colors
clBlack = TColor($000000);
clMaroon = TColor($000080);
clGreen = TColor($008000);
clOlive = TColor($008080);
clNavy = TColor($800000);
clPurple = TColor($800080);
clTeal = TColor($808000);
clGray = TColor($808080);
clSilver = TColor($C0C0C0);
clRed = TColor($0000FF);
clLime = TColor($00FF00);
clYellow = TColor($00FFFF);
clBlue = TColor($FF0000);
clFuchsia = TColor($FF00FF);
clAqua = TColor($FFFF00);
clLtGray = TColor($C0C0C0); // clSilver alias
clDkGray = TColor($808080); // clGray alias
clWhite = TColor($FFFFFF);
StandardColorsCount = 16;
// extended colors
clMoneyGreen = TColor($C0DCC0);
clSkyBlue = TColor($F0CAA6);
clCream = TColor($F0FBFF);
clMedGray = TColor($A4A0A0);
ExtendedColorCount = 4;
// special colors
clNone = TColor($1FFFFFFF);
clDefault = TColor($20000000);
// system colors
clScrollBar = TColor(SYS_COLOR_BASE or COLOR_SCROLLBAR);
clBackground = TColor(SYS_COLOR_BASE or COLOR_BACKGROUND);
clActiveCaption = TColor(SYS_COLOR_BASE or COLOR_ACTIVECAPTION);
clInactiveCaption = TColor(SYS_COLOR_BASE or COLOR_INACTIVECAPTION);
clMenu = TColor(SYS_COLOR_BASE or COLOR_MENU);
clWindow = TColor(SYS_COLOR_BASE or COLOR_WINDOW);
clWindowFrame = TColor(SYS_COLOR_BASE or COLOR_WINDOWFRAME);
clMenuText = TColor(SYS_COLOR_BASE or COLOR_MENUTEXT);
clWindowText = TColor(SYS_COLOR_BASE or COLOR_WINDOWTEXT);
clCaptionText = TColor(SYS_COLOR_BASE or COLOR_CAPTIONTEXT);
clActiveBorder = TColor(SYS_COLOR_BASE or COLOR_ACTIVEBORDER);
clInactiveBorder = TColor(SYS_COLOR_BASE or COLOR_INACTIVEBORDER);
clAppWorkspace = TColor(SYS_COLOR_BASE or COLOR_APPWORKSPACE);
clHighlight = TColor(SYS_COLOR_BASE or COLOR_HIGHLIGHT);
clHighlightText = TColor(SYS_COLOR_BASE or COLOR_HIGHLIGHTTEXT);
clBtnFace = TColor(SYS_COLOR_BASE or COLOR_BTNFACE);
clBtnShadow = TColor(SYS_COLOR_BASE or COLOR_BTNSHADOW);
clGrayText = TColor(SYS_COLOR_BASE or COLOR_GRAYTEXT);
clBtnText = TColor(SYS_COLOR_BASE or COLOR_BTNTEXT);
clInactiveCaptionText = TColor(SYS_COLOR_BASE or COLOR_INACTIVECAPTIONTEXT);
clBtnHighlight = TColor(SYS_COLOR_BASE or COLOR_BTNHIGHLIGHT);
cl3DDkShadow = TColor(SYS_COLOR_BASE or COLOR_3DDKSHADOW);
cl3DLight = TColor(SYS_COLOR_BASE or COLOR_3DLIGHT);
clInfoText = TColor(SYS_COLOR_BASE or COLOR_INFOTEXT);
clInfoBk = TColor(SYS_COLOR_BASE or COLOR_INFOBK);
clHotLight = TColor(SYS_COLOR_BASE or COLOR_HOTLIGHT);
clGradientActiveCaption = TColor(SYS_COLOR_BASE or COLOR_GRADIENTACTIVECAPTION);
clGradientInactiveCaption = TColor(SYS_COLOR_BASE or COLOR_GRADIENTINACTIVECAPTION);
clMenuHighlight = TColor(SYS_COLOR_BASE or COLOR_MENUHILIGHT);
clMenuBar = TColor(SYS_COLOR_BASE or COLOR_MENUBAR);
clForm = TColor(SYS_COLOR_BASE or COLOR_FORM);
// synonyms: do not show them in color lists
clColorDesktop = TColor(SYS_COLOR_BASE or COLOR_DESKTOP);
cl3DFace = TColor(SYS_COLOR_BASE or COLOR_3DFACE);
cl3DShadow = TColor(SYS_COLOR_BASE or COLOR_3DSHADOW);
cl3DHiLight = TColor(SYS_COLOR_BASE or COLOR_3DHIGHLIGHT);
clBtnHiLight = TColor(SYS_COLOR_BASE or COLOR_BTNHILIGHT);
clFirstSpecialColor = clBtnHiLight;
clMask = clWhite;
clDontMask = clBlack;
// !! deprecated colors !!
{$warnings off}
// CLX base, mapped, pseudo, rgb values
clForeground = TColor(-1) deprecated;
clButton = TColor(-2) deprecated;
clLight = TColor(-3) deprecated;
clMidlight = TColor(-4) deprecated;
clDark = TColor(-5) deprecated;
clMid = TColor(-6) deprecated;
clText = TColor(-7) deprecated;
clBrightText = TColor(-8) deprecated;
clButtonText = TColor(-9) deprecated;
clBase = TColor(-10) deprecated;
clxBackground = TColor(-11) deprecated;
clShadow = TColor(-12) deprecated;
clxHighlight = TColor(-13) deprecated;
clHighlightedText = TColor(-14) deprecated;
// CLX mapped role offsets
cloNormal = 32 deprecated;
cloDisabled = 64 deprecated;
cloActive = 96 deprecated;
// CLX normal, mapped, pseudo, rgb values
clNormalForeground = TColor(clForeground - cloNormal) deprecated;
clNormalButton = TColor(clButton - cloNormal) deprecated;
clNormalLight = TColor(clLight - cloNormal) deprecated;
clNormalMidlight = TColor(clMidlight - cloNormal) deprecated;
clNormalDark = TColor(clDark - cloNormal) deprecated;
clNormalMid = TColor(clMid - cloNormal) deprecated;
clNormalText = TColor(clText - cloNormal) deprecated;
clNormalBrightText = TColor(clBrightText - cloNormal) deprecated;
clNormalButtonText = TColor(clButtonText - cloNormal) deprecated;
clNormalBase = TColor(clBase - cloNormal) deprecated;
clNormalBackground = TColor(clxBackground - cloNormal) deprecated;
clNormalShadow = TColor(clShadow - cloNormal) deprecated;
clNormalHighlight = TColor(clxHighlight - cloNormal) deprecated;
clNormalHighlightedText = TColor(clHighlightedText - cloNormal) deprecated;
// CLX disabled, mapped, pseudo, rgb values
clDisabledForeground = TColor(clForeground - cloDisabled) deprecated;
clDisabledButton = TColor(clButton - cloDisabled) deprecated;
clDisabledLight = TColor(clLight - cloDisabled) deprecated;
clDisabledMidlight = TColor(clMidlight - cloDisabled) deprecated;
clDisabledDark = TColor(clDark - cloDisabled) deprecated;
clDisabledMid = TColor(clMid - cloDisabled) deprecated;
clDisabledText = TColor(clText - cloDisabled) deprecated;
clDisabledBrightText = TColor(clBrightText - cloDisabled) deprecated;
clDisabledButtonText = TColor(clButtonText - cloDisabled) deprecated;
clDisabledBase = TColor(clBase - cloDisabled) deprecated;
clDisabledBackground = TColor(clxBackground - cloDisabled) deprecated;
clDisabledShadow = TColor(clShadow - cloDisabled) deprecated;
clDisabledHighlight = TColor(clxHighlight - cloDisabled) deprecated;
clDisabledHighlightedText = TColor(clHighlightedText - cloDisabled) deprecated;
// CLX active, mapped, pseudo, rgb values
clActiveForeground = TColor(clForeground - cloActive) deprecated;
clActiveButton = TColor(clButton - cloActive) deprecated;
clActiveLight = TColor(clLight - cloActive) deprecated;
clActiveMidlight = TColor(clMidlight - cloActive) deprecated;
clActiveDark = TColor(clDark - cloActive) deprecated;
clActiveMid = TColor(clMid - cloActive) deprecated;
clActiveText = TColor(clText - cloActive) deprecated;
clActiveBrightText = TColor(clBrightText - cloActive) deprecated;
clActiveButtonText = TColor(clButtonText - cloActive) deprecated;
clActiveBase = TColor(clBase - cloActive) deprecated;
clActiveBackground = TColor(clxBackground - cloActive) deprecated;
clActiveShadow = TColor(clShadow - cloActive) deprecated;
clActiveHighlight = TColor(clxHighlight - cloActive) deprecated;
clActiveHighlightedText = TColor(clHighlightedText - cloActive) deprecated;
type
TMappedColor = clActiveHighlightedText..clNormalForeground;
TColorGroup = (cgInactive, cgDisabled, cgActive);
TColorRole = (crForeground, crButton, crLight, crMidlight, crDark, crMid,
crText, crBrightText, crButtonText, crBase, crBackground, crShadow,
crHighlight, crHighlightText, crNoRole);
{$warnings on}
const
cmBlackness = BLACKNESS;
cmDstInvert = DSTINVERT;
cmMergeCopy = MERGECOPY;
cmMergePaint = MERGEPAINT;
cmNotSrcCopy = NOTSRCCOPY;
cmNotSrcErase = NOTSRCERASE;
cmPatCopy = PATCOPY;
cmPatInvert = PATINVERT;
cmPatPaint = PATPAINT;
cmSrcAnd = SRCAND;
cmSrcCopy = SRCCOPY;
cmSrcErase = SRCERASE;
cmSrcInvert = SRCINVERT;
cmSrcPaint = SRCPAINT;
cmWhiteness = WHITENESS;
type
TCanvas = class;
// base class
TRasterImage = class;
TRasterImageClass = class of TRasterImage;
TCustomBitmap = class;
TCustomBitmapClass = class of TCustomBitmap;
// standard LCL graphic formats
TBitmap = class; // bmp
TPixmap = class; // xpm
TIcon = class; // ico
TPortableNetworkGraphic = class; // png
TPortableAnyMapGraphic = class; // pnm formats: pbm, pgm and ppm
TJpegImage = class; // jpg
TGIFImage = class; // gif (read only)
{ TGraphicsObject
In Delphi VCL this is the ancestor of TFont, TPen and TBrush.
Since FPC 2.0 the LCL uses TFPCanvasHelper as ancestor. }
TGraphicsObject = class(TPersistent)
private
FOnChanging: TNotifyEvent;
FOnChange: TNotifyEvent;
procedure DoChange(var Msg); message LM_CHANGED;
protected
procedure Changing; virtual;
procedure Changed; virtual;
procedure Lock;
procedure UnLock;
public
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
{ TFontHandleCacheDescriptor }
TFontHandleCacheDescriptor = class(TResourceCacheDescriptor)
public
LogFont: TLogFont;
LongFontName: string;
end;
{ TFontHandleCache }
TFontHandleCache = class(TResourceCache)
protected
procedure RemoveItem(Item: TResourceCacheItem); override;
public
constructor Create;
function CompareDescriptors(Tree: TAvgLvlTree; Desc1, Desc2: Pointer): integer; override;
function FindFont(TheFont: TLCLHandle): TResourceCacheItem;
function FindFontDesc(const LogFont: TLogFont;
const LongFontName: string): TFontHandleCacheDescriptor;
function Add(TheFont: TLCLHandle; const LogFont: TLogFont;
const LongFontName: string): TFontHandleCacheDescriptor;
end;
{ TFont }
TFont = class(TFPCustomFont)
private
FCanUTF8: boolean;
FCanUTF8Valid: boolean;
FIsMonoSpace: boolean;
FIsMonoSpaceValid: boolean;
FOrientation: Integer;
FPitch: TFontPitch;
FQuality: TFontQuality;
FStyle: TFontStylesBase;
FCharSet: TFontCharSet;
FPixelsPerInch: Integer;
FUpdateCount: integer;
FChanged: boolean;
FFontHandleCached: boolean;
FColor: TColor;
FHeight: integer; // FHeight = -(FSize * FPixelsPerInch) div 72
FReference: TWSFontReference;
procedure FreeReference;
function GetCanUTF8: boolean;
function GetHandle: HFONT;
function GetData: TFontData;
function GetIsMonoSpace: boolean;
function GetReference: TWSFontReference;
function IsHeightStored: boolean;
function IsNameStored: boolean;
procedure SetData(const FontData: TFontData);
procedure SetHandle(const Value: HFONT);
procedure ReferenceNeeded;
protected
function GetCharSet: TFontCharSet;
function GetHeight: Integer;
function GetName: string;
function GetOrientation: Integer;
function GetPitch: TFontPitch;
function GetSize: Integer;
function GetStyle: TFontStyles;
procedure Changed; override;
procedure DoAllocateResources; override;
procedure DoCopyProps(From: TFPCanvasHelper); override;
procedure DoDeAllocateResources; override;
procedure SetCharSet(const AValue: TFontCharSet);
procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
procedure SetColor(Value: TColor);
function GetColor: TColor;
procedure SetFlags(Index: integer; AValue: boolean); override;
procedure SetFPColor(const AValue: TFPColor); override;
procedure SetHeight(Avalue: Integer);
procedure SetName(AValue: string); override;
procedure SetOrientation(AValue: Integer); override; // This was introduced in 2.5 quite late, and the Android pre-compiled compiler was before this, so I prefer to let it only for 2.6
procedure SetPitch(Value: TFontPitch);
procedure SetSize(AValue: integer); override;
procedure SetStyle(Value: TFontStyles);
procedure SetQuality(const AValue: TFontQuality);
public
constructor Create; override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Assign(const ALogFont: TLogFont);
procedure BeginUpdate;
procedure EndUpdate;
property FontData: TFontData read GetData write SetData;
function HandleAllocated: boolean;
property Handle: HFONT read GetHandle write SetHandle; deprecated 'use Reference.Handle instead';
function IsDefault: boolean;
function IsEqual(AFont: TFont): boolean; virtual;
property IsMonoSpace: boolean read GetIsMonoSpace;
procedure SetDefault;
property CanUTF8: boolean read GetCanUTF8; deprecated;
property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
property Reference: TWSFontReference read GetReference;
published
property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;
property Color: TColor read FColor write SetColor default {$ifdef UseCLDefault}clDefault{$else}clWindowText{$endif};
property Height: Integer read GetHeight write SetHeight stored IsHeightStored;
property Name: string read GetName write SetName stored IsNameStored;
property Orientation: Integer read GetOrientation write SetOrientation default 0;
property Pitch: TFontPitch read GetPitch write SetPitch default fpDefault;
property Quality: TFontQuality read FQuality write SetQuality default fqDefault;
property Size: Integer read GetSize write SetSize stored false;
property Style: TFontStyles read GetStyle write SetStyle default [];
end;
{ TPen }
TPenStyle = TFPPenStyle;
TPenMode = TFPPenMode;
// pen end caps. valid only for geometric pens
{$IFDEF HasFPEndCap}
TPenEndCap = TFPPenEndCap;
{$ELSE}
TPenEndCap = (
pecRound,
pecSquare,
pecFlat
);
{$ENDIF}
// join style. valid only for geometric pens
{$IFDEF HasFPJoinStyle}
TPenJoinStyle = FPCanvas.TFPPenJoinStyle;
{$ELSE}
TPenJoinStyle = (
pjsRound,
pjsBevel,
pjsMiter
);
{$ENDIF}
TPenPattern = array of LongWord;
{ TPenHandleCacheDescriptor }
TPenHandleCacheDescriptor = class(TResourceCacheDescriptor)
public
ExtPen: TExtLogPen;
Pattern: TPenPattern;
end;
{ TPenHandleCache }
TPenHandleCache = class(TResourceCache)
protected
procedure RemoveItem(Item: TResourceCacheItem); override;
public
constructor Create;
function CompareDescriptors(Tree: TAvgLvlTree; Desc1, Desc2: Pointer): integer; override;
function FindPen(APen: TLCLHandle): TResourceCacheItem;
function FindPenDesc(const AExtPen: TExtLogPen;
const APattern: TPenPattern): TPenHandleCacheDescriptor;
function Add(APen: TLCLHandle; const AExtPen: TExtLogPen;
const APattern: TPenPattern): TPenHandleCacheDescriptor;
end;
TPen = class(TFPCustomPen)
private
FColor: TColor;
{$IFNDEF HasFPEndCap}
FEndCap: TPenEndCap;
{$ENDIF}
FCosmetic: Boolean;
{$IFNDEF HasFPJoinStyle}
FJoinStyle: TPenJoinStyle;
{$ENDIF}
FPattern: TPenPattern;
FPenHandleCached: boolean;
FReference: TWSPenReference;
procedure FreeReference;
function GetHandle: HPEN;
function GetReference: TWSPenReference;
procedure ReferenceNeeded;
procedure SetCosmetic(const AValue: Boolean);
procedure SetHandle(const Value: HPEN);
protected
procedure DoAllocateResources; override;
procedure DoDeAllocateResources; override;
procedure DoCopyProps(From: TFPCanvasHelper); override;
procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
procedure SetFPColor(const AValue: TFPColor); override;
procedure SetColor(Value: TColor);
procedure SetEndCap(AValue: TPenEndCap); {$IFDEF HasFPEndCap}override;{$ENDIF}
procedure SetJoinStyle(AValue: TPenJoinStyle); {$IFDEF HasFPJoinStyle}override;{$ENDIF}
procedure SetMode(Value: TPenMode); override;
procedure SetStyle(Value: TPenStyle); override;
procedure SetWidth(value: Integer); override;
public
constructor Create; override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property Handle: HPEN read GetHandle write SetHandle; deprecated;
property Reference: TWSPenReference read GetReference;
function GetPattern: TPenPattern;
procedure SetPattern(APattern: TPenPattern); reintroduce;
published
property Color: TColor read FColor write SetColor default clBlack;
property Cosmetic: Boolean read FCosmetic write SetCosmetic default True;
{$IFDEF HasFPEndCap}
property EndCap default pecRound;
{$ELSE}
property EndCap: TPenEndCap read FEndCap write SetEndCap default pecRound;
{$ENDIF}
{$IFDEF HasFPJoinStyle}
property JoinStyle default pjsRound;
{$ELSE}
property JoinStyle: TPenJoinStyle read FJoinStyle write SetJoinStyle default pjsRound;
{$ENDIF}
property Mode default pmCopy;
property Style default psSolid;
property Width default 1;
end;
{ TBrush }
TBrushStyle = TFPBrushStyle;
TBrushHandleCache = class(TBlockResourceCache)
protected
procedure RemoveItem(Item: TResourceCacheItem); override;
public
constructor Create;
end;
TBrush = class(TFPCustomBrush)
private
FBrushHandleCached: boolean;
FColor: TColor;
FBitmap: TCustomBitmap;
FReference: TWSBrushReference;
FInternalUpdateIndex: Integer;
procedure FreeReference;
function GetHandle: HBRUSH;
function GetReference: TWSBrushReference;
function GetColor: TColor;
procedure ReferenceNeeded;
procedure SetHandle(const Value: HBRUSH);
procedure DoChange(var Msg); message LM_CHANGED;
protected
procedure DoAllocateResources; override;
procedure DoDeAllocateResources; override;
procedure DoCopyProps(From: TFPCanvasHelper); override;
procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
procedure SetFPColor(const AValue: TFPColor); override;
procedure SetBitmap(Value: TCustomBitmap);
procedure SetColor(Value: TColor);
procedure SetStyle(Value: TBrushStyle); override;
public
procedure Assign(Source: TPersistent); override;
constructor Create; override;
destructor Destroy; override;
function EqualsBrush(ABrush: TBrush): boolean;
property Bitmap: TCustomBitmap read FBitmap write SetBitmap;
property Handle: HBRUSH read GetHandle write SetHandle; deprecated; // use instead Reference.Handle
property Reference: TWSBrushReference read GetReference;
published
property Color: TColor read FColor write SetColor default clWhite;
property Style default bsSolid;
end;
TRegionCombineMode = (rgnAnd, rgnCopy, rgnDiff, rgnOr, rgnXOR);
TRegionOperationType = (rgnNewRect, rgnCombine);
TRegionOperation = record
ROType: TRegionOperationType;
Source1, Source2, Dest: Integer; // Index to the list of sub-regions, -1 indicates the main region
CombineMode: TRegionCombineMode; // Used only if ROType=rgnCombine
Rect: TRect; // Used for ROType=rgnNewRect
end;
TRegionOperations = array of TRegionOperation;
{ TRegion }
TRegion = class(TGraphicsObject)
private
FReference: TWSRegionReference;
// Description of the region
//RegionOperations: TRegionOperations;
//SubRegions: array of HRGN;
procedure AddOperation(AOp: TRegionOperation);
procedure ClearSubRegions();
procedure AddSubRegion(AHandle: HRGN);
//
procedure FreeReference;
function GetReference: TWSRegionReference;
function GetHandle: HRGN;
procedure ReferenceNeeded;
procedure SetHandle(const Value: HRGN);
protected
procedure SetClipRect(value: TRect);
function GetClipRect: TRect;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
// Convenience routines to add elements to the region
procedure AddRectangle(X1, Y1, X2, Y2: Integer);
property ClipRect: TRect read GetClipRect write SetClipRect;
property Handle: HRGN read GetHandle write SetHandle; deprecated;
property Reference: TWSRegionReference read GetReference;
end;
{ TGraphic }
{ The TGraphic class is an abstract base class for dealing with graphic images
such as bitmaps, pixmaps, icons, and other image formats.
LoadFromFile - Read the graphic from the file system. The old contents of
the graphic are lost. If the file is not of the right format, an
exception will be generated.
SaveToFile - Writes the graphic to disk in the file provided.
LoadFromStream - Like LoadFromFile except source is a stream (e.g.
TBlobStream).
SaveToStream - stream analogue of SaveToFile.
LoadFromClipboardFormat - Replaces the current image with the data
provided. If the TGraphic does not support that format it will generate
an exception.
SaveToClipboardFormats - Converts the image to a clipboard format. If the
image does not support being translated into a clipboard format it
will generate an exception.
Height - The native, unstretched, height of the graphic.
Palette - Color palette of image. Zero if graphic doesn't need/use palettes.
Transparent - Some parts of the image are not opaque. aka the background
can be seen through.
Width - The native, unstretched, width of the graphic.
OnChange - Called whenever the graphic changes
PaletteModified - Indicates in OnChange whether color palette has changed.
Stays true until whoever's responsible for realizing this new palette
(ex: TImage) sets it to False.
OnProgress - Generic progress indicator event. Propagates out to TPicture
and TImage OnProgress events.}
TGraphic = class(TPersistent)
private
FModified: Boolean;
FOnChange: TNotifyEvent;
FOnProgress: TProgressEvent;
FPaletteModified: Boolean;
protected
procedure Changed(Sender: TObject); virtual;
function Equals(Graphic: TGraphic): Boolean; virtual; {$IF declared(vmtEquals)}overload;{$ENDIF}
procedure DefineProperties(Filer: TFiler); override;
procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract;
function GetEmpty: Boolean; virtual; abstract;
function GetHeight: Integer; virtual; abstract;
function GetMimeType: string; virtual;
function GetPalette: HPALETTE; virtual;
function GetTransparent: Boolean; virtual; abstract;
function GetWidth: Integer; virtual; abstract;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: string; var DoContinue: boolean); virtual;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: string); virtual;
procedure ReadData(Stream: TStream); virtual; // used by Filer
procedure SetHeight(Value: Integer); virtual; abstract;
procedure SetPalette(Value: HPALETTE); virtual;
procedure SetTransparent(Value: Boolean); virtual; abstract;
procedure SetWidth(Value: Integer); virtual; abstract;
procedure SetModified(Value: Boolean);
procedure WriteData(Stream: TStream); virtual; // used by filer
public
procedure Assign(ASource: TPersistent); override;
constructor Create; virtual;
procedure Clear; virtual;
{$IF declared(vmtEquals)}
function Equals(Obj: TObject): Boolean; override; overload;
{$ENDIF}
function LazarusResourceTypeValid(const AResourceType: string): boolean; virtual;
procedure LoadFromFile(const Filename: string); virtual;
procedure LoadFromStream(Stream: TStream); virtual; abstract;
procedure LoadFromMimeStream(AStream: TStream; const AMimeType: string); virtual;
procedure LoadFromLazarusResource(const ResName: String); virtual;
procedure LoadFromResourceName(Instance: THandle; const ResName: String); virtual;
procedure LoadFromResourceID(Instance: THandle; ResID: PtrInt); virtual;
procedure LoadFromClipboardFormat(FormatID: TClipboardFormat); virtual;
procedure LoadFromClipboardFormatID(ClipboardType: TClipboardType;
FormatID: TClipboardFormat); virtual;
procedure SaveToFile(const Filename: string); virtual;
procedure SaveToStream(Stream: TStream); virtual; abstract;
procedure SaveToClipboardFormat(FormatID: TClipboardFormat); virtual;
procedure SaveToClipboardFormatID(ClipboardType: TClipboardType;
FormatID: TClipboardFormat); virtual;
procedure GetSupportedSourceMimeTypes(List: TStrings); virtual;
function GetResourceType: TResourceType; virtual;
class function GetFileExtensions: string; virtual;
class function IsStreamFormatSupported(Stream: TStream): Boolean; virtual;
public
property Empty: Boolean read GetEmpty;
property Height: Integer read GetHeight write SetHeight;
property Modified: Boolean read FModified write SetModified;
property MimeType: string read GetMimeType;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
property Palette: HPALETTE read GetPalette write SetPalette;
property PaletteModified: Boolean read FPaletteModified write FPaletteModified;
property Transparent: Boolean read GetTransparent write SetTransparent;
property Width: Integer read GetWidth write SetWidth;
end;
TGraphicClass = class of TGraphic;
{ TPicture }
{ TPicture is a TGraphic container. It is used in place of a TGraphic if the
graphic can be of any TGraphic class. LoadFromFile and SaveToFile are
polymorphic. For example, if the TPicture is holding an Icon, you can
LoadFromFile a bitmap file, where if the class is TIcon you could only read
.ICO files.
LoadFromFile - Reads a picture from disk. The TGraphic class created
determined by the file extension of the file. If the file extension is
not recognized an exception is generated.
SaveToFile - Writes the picture to disk.
LoadFromClipboardFormat - ToDo: Reads the picture from the handle provided in
the given clipboard format. If the format is not supported, an
exception is generated.
SaveToClipboardFormats - ToDo: Allocates a global handle and writes the picture
in its native clipboard format (CF_BITMAP for bitmaps, CF_METAFILE
for metafiles, etc.). Formats will contain the formats written.
Returns the number of clipboard items written to the array pointed to
by Formats and Datas or would be written if either Formats or Datas are
nil.
SupportsClipboardFormat - Returns true if the given clipboard format
is supported by LoadFromClipboardFormat.
Assign - Copys the contents of the given TPicture. Used most often in
the implementation of TPicture properties.
RegisterFileFormat - Register a new TGraphic class for use in
LoadFromFile.
RegisterClipboardFormat - Registers a new TGraphic class for use in
LoadFromClipboardFormat.
UnRegisterGraphicClass - Removes all references to the specified TGraphic
class and all its descendents from the file format and clipboard format
internal lists.
Height - The native, unstretched, height of the picture.
Width - The native, unstretched, width of the picture.
Graphic - The TGraphic object contained by the TPicture
Bitmap - Returns a bitmap. If the contents is not already a bitmap, the
contents are thrown away and a blank bitmap is returned.
Pixmap - Returns a pixmap. If the contents is not already a pixmap, the
contents are thrown away and a blank pixmap is returned.
PNG - Returns a png. If the contents is not already a png, the
contents are thrown away and a blank png (TPortableNetworkGraphic) is
returned.
PNM - Returns a pnm. If the contents is not already a pnm, the
contents are thrown away and a blank pnm (TPortableAnyMapGraphic) is
returned.
Jpeg - Returns a jpeg. If the contents is not already a jpeg, the
contents are thrown away and a blank jpeg (TJPegImage) is
returned.
}
TPicture = class(TPersistent)
private
FGraphic: TGraphic;
FOnChange: TNotifyEvent;
//FNotify: IChangeNotifier;
FOnProgress: TProgressEvent;
procedure ForceType(GraphicType: TGraphicClass);
function GetBitmap: TBitmap;
function GetIcon: TIcon;
function GetJpeg: TJpegImage;
function GetPNG: TPortableNetworkGraphic;
function GetPNM: TPortableAnyMapGraphic;
function GetPixmap: TPixmap;
function GetHeight: Integer;
function GetWidth: Integer;
procedure ReadData(Stream: TStream);
procedure SetBitmap(Value: TBitmap);
procedure SetIcon(Value: TIcon);
procedure SetJpeg(Value: TJpegImage);
procedure SetPNG(const AValue: TPortableNetworkGraphic);
procedure SetPNM(const AValue: TPortableAnyMapGraphic);
procedure SetPixmap(Value: TPixmap);
procedure SetGraphic(Value: TGraphic);
procedure WriteData(Stream: TStream);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure Changed(Sender: TObject); virtual;
procedure DefineProperties(Filer: TFiler); override;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
const Msg: string; var DoContinue: boolean); virtual;
procedure LoadFromStreamWithClass(Stream: TStream; AClass: TGraphicClass);
public
constructor Create;
destructor Destroy; override;
procedure Clear; virtual;
// load methods
procedure LoadFromClipboardFormat(FormatID: TClipboardFormat);
procedure LoadFromClipboardFormatID(ClipboardType: TClipboardType; FormatID: TClipboardFormat);
procedure LoadFromFile(const Filename: string);
procedure LoadFromResourceName(Instance: THandle; const ResName: String);
procedure LoadFromResourceName(Instance: THandle; const ResName: String; AClass: TGraphicClass);
procedure LoadFromLazarusResource(const AName: string);
procedure LoadFromStream(Stream: TStream);
procedure LoadFromStreamWithFileExt(Stream: TStream; const FileExt: string);
// save methods
procedure SaveToClipboardFormat(FormatID: TClipboardFormat);
procedure SaveToFile(const Filename: string; const FileExt: string = '');
procedure SaveToStream(Stream: TStream);
procedure SaveToStreamWithFileExt(Stream: TStream; const FileExt: string);
class function SupportsClipboardFormat(FormatID: TClipboardFormat): Boolean;
procedure Assign(Source: TPersistent); override;
class procedure RegisterFileFormat(const AnExtension, ADescription: string;
AGraphicClass: TGraphicClass);
class procedure RegisterClipboardFormat(FormatID: TClipboardFormat;
AGraphicClass: TGraphicClass);
class procedure UnregisterGraphicClass(AClass: TGraphicClass);
function FindGraphicClassWithFileExt(const Ext: string;
ExceptionOnNotFound: boolean = true): TGraphicClass;
public
property Bitmap: TBitmap read GetBitmap write SetBitmap;
property Icon: TIcon read GetIcon write SetIcon;
property Jpeg: TJpegImage read GetJpeg write SetJpeg;
property Pixmap: TPixmap read GetPixmap write SetPixmap;
property PNG: TPortableNetworkGraphic read GetPNG write SetPNG;
property PNM: TPortableAnyMapGraphic read GetPNM write SetPNM;
property Graphic: TGraphic read FGraphic write SetGraphic;
//property PictureAdapter: IChangeNotifier read FNotify write FNotify;
property Height: Integer read GetHeight;
property Width: Integer read GetWidth;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
end;
EGraphicException = class(Exception);
EInvalidGraphic = class(EGraphicException);
EInvalidGraphicOperation = class(EGraphicException);
type
TGradientDirection = (
gdVertical, // Fill vertical
gdHorizontal // Fill Horizontal
);
TAntialiasingMode = (
amDontCare, // default antialiasing
amOn, // enabled
amOff // disabled
);
TLCLTextMetric = record
Ascender: Integer;
Descender: Integer;
Height: Integer;
end;
TDefaultColorType = (
dctBrush,
dctFont
);
{ TCanvas }
TCanvas = class(TFPCustomCanvas)
private
FAntialiasingMode: TAntialiasingMode;
FAutoRedraw: Boolean;
FState: TCanvasState;
FSavedFontHandle: HFont;
FSavedPenHandle: HPen;
FSavedBrushHandle: HBrush;
FSavedRegionHandle: HRGN;
FCopyMode: TCopyMode;
FHandle: HDC;
FOnChange: TNotifyEvent;
FOnChanging: TNotifyEvent;
FTextStyle: TTextStyle;
FLock: TCriticalSection;// FLock is initialized on demand
FRegion: TRegion;
FLazPen: TPen;
FLazFont: TFont;
FLazBrush: TBrush;
FSavedHandleStates: TFPList;
procedure BrushChanged(ABrush: TObject);
procedure FontChanged(AFont: TObject);
procedure PenChanged(APen: TObject);
procedure RegionChanged(ARegion: TObject);
function GetHandle: HDC;
procedure SetAntialiasingMode(const AValue: TAntialiasingMode);
procedure SetAutoRedraw(Value: Boolean); virtual;
procedure SetLazFont(Value: TFont);
procedure SetLazPen(Value: TPen);
procedure SetLazBrush(Value: TBrush);
procedure SetRegion(Value: TRegion);
protected
function DoCreateDefaultFont: TFPCustomFont; override;
function DoCreateDefaultPen: TFPCustomPen; override;
function DoCreateDefaultBrush: TFPCustomBrush; override;
procedure SetColor(x, y: integer; const Value: TFPColor); override;
function GetColor(x, y: integer): TFPColor; override;
procedure SetHeight(AValue: integer); override;
function GetHeight: integer; override;
procedure SetWidth(AValue: integer); override;
function GetWidth: integer; override;
procedure SetPenPos(const AValue: TPoint); override;
procedure DoLockCanvas; override;
procedure DoUnlockCanvas; override;
procedure DoTextOut(x, y: integer; Text: string); override;
procedure DoGetTextSize(Text: string; var w,h:integer); override;
function DoGetTextHeight(Text: string): integer; override;
function DoGetTextWidth(Text: string): integer; override;
procedure DoRectangle(const Bounds: TRect); override;
procedure DoRectangleFill(const Bounds: TRect); override;
procedure DoRectangleAndFill(const Bounds: TRect); override;
procedure DoEllipse(const Bounds: TRect); override;
procedure DoEllipseFill(const Bounds: TRect); override;
procedure DoEllipseAndFill(const Bounds: TRect); override;
procedure DoPolygon(const Points: array of TPoint); override;
procedure DoPolygonFill(const Points: array of TPoint); override;
procedure DoPolygonAndFill(const Points: array of TPoint); override;
procedure DoPolyline(const Points: array of TPoint); override;
procedure DoPolyBezier(Points: PPoint; NumPts: Integer;
Filled: boolean = False;
Continuous: boolean = False); override;
procedure DoFloodFill(x, y: integer); override;
procedure DoMoveTo(x, y: integer); override;
procedure DoLineTo(x, y: integer); override;
procedure DoLine(x1, y1, x2, y2: integer); override;
procedure DoCopyRect(x, y: integer; SrcCanvas: TFPCustomCanvas;
const SourceRect: TRect); override;
procedure DoDraw(x, y: integer; const Image: TFPCustomImage); override;
procedure CheckHelper(AHelper: TFPCanvasHelper); override;
function GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor; virtual;
protected
function GetClipRect: TRect; override;
procedure SetClipRect(const ARect: TRect); override;
function GetClipping: Boolean; override;
procedure SetClipping(const AValue: boolean); override;
function GetPixel(X,Y: Integer): TColor; virtual;
procedure CreateBrush; virtual;
procedure CreateFont; virtual;
procedure CreateHandle; virtual;
procedure CreatePen; virtual;
procedure CreateRegion; virtual;
procedure DeselectHandles; virtual;
procedure PenChanging(APen: TObject); virtual;
procedure FontChanging(AFont: TObject); virtual;
procedure BrushChanging(ABrush: TObject); virtual;
procedure RegionChanging(ARegion: TObject); virtual;
procedure RealizeAutoRedraw; virtual;
procedure RealizeAntialiasing; virtual;
procedure RequiredState(ReqState: TCanvasState); virtual;
procedure SetHandle(NewHandle: HDC); virtual;
procedure SetInternalPenPos(const Value: TPoint); virtual;
procedure SetPixel(X,Y: Integer; Value: TColor); virtual;
procedure FreeHandle;virtual;
public
constructor Create;
destructor Destroy; override;
procedure Lock; virtual;
function TryLock: Boolean;
procedure Unlock; virtual;
procedure Refresh; virtual;
procedure Changing; virtual;
procedure Changed; virtual;
procedure SaveHandleState; virtual;
procedure RestoreHandleState; virtual;
// extra drawing methods (there are more in the ancestor TFPCustomCanvas)
procedure Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure ArcTo(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual; //As Arc(), but updates pen position
procedure AngleArc(X, Y: Integer; Radius: Longword; StartAngle, SweepAngle: Single);
procedure BrushCopy(ADestRect: TRect; ABitmap: TBitmap; ASourceRect: TRect;
ATransparentColor: TColor); virtual;
procedure Chord(x1, y1, x2, y2,
Angle16Deg, Angle16DegLength: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Chord(x1, y1, x2, y2, SX, SY, EX, EY: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure CopyRect(const Dest: TRect; SrcCanvas: TCanvas;
const Source: TRect); virtual;
procedure Draw(X,Y: Integer; SrcGraphic: TGraphic); virtual;
procedure DrawFocusRect(const ARect: TRect); virtual;
procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual;
procedure Ellipse(const ARect: TRect); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Ellipse(x1, y1, x2, y2: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure FillRect(const ARect: TRect); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure FillRect(X1,Y1,X2,Y2: Integer); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure FloodFill(X, Y: Integer; FillColor: TColor;
FillStyle: TFillStyle); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Frame3d(var ARect: TRect; const FrameWidth: integer;
const Style: TGraphicsBevelCut); virtual;
procedure Frame3D(var ARect: TRect; TopColor, BottomColor: TColor;
const FrameWidth: integer); overload;
procedure Frame(const ARect: TRect); virtual; // border using pen
procedure Frame(X1,Y1,X2,Y2: Integer); // border using pen
procedure FrameRect(const ARect: TRect); virtual; // border using brush
procedure FrameRect(X1,Y1,X2,Y2: Integer); // border using brush
function GetTextMetrics(out TM: TLCLTextMetric): boolean; virtual;
procedure GradientFill(ARect: TRect; AStart, AStop: TColor; ADirection: TGradientDirection);
procedure RadialPie(x1, y1, x2, y2,
StartAngle16Deg, Angle16DegLength: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Pie(EllipseX1,EllipseY1,EllipseX2,EllipseY2,
StartX,StartY,EndX,EndY: Integer); virtual;
procedure PolyBezier(Points: PPoint; NumPts: Integer;
Filled: boolean = False;
Continuous: boolean = False); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure PolyBezier(const Points: array of TPoint;
Filled: boolean = False;
Continuous: boolean = False); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Polygon(const Points: array of TPoint;
Winding: Boolean;
StartIndex: Integer = 0;
NumPts: Integer = -1);
procedure Polygon(Points: PPoint; NumPts: Integer;
Winding: boolean = False); virtual;
procedure Polygon(const Points: array of TPoint); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Polyline(const Points: array of TPoint;
StartIndex: Integer;
NumPts: Integer = -1);
procedure Polyline(Points: PPoint; NumPts: Integer); virtual;
procedure Polyline(const Points: array of TPoint); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Rectangle(X1,Y1,X2,Y2: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Rectangle(const ARect: TRect); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); virtual;
procedure RoundRect(const Rect: TRect; RX,RY: Integer);
procedure TextOut(X,Y: Integer; const Text: String); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure TextRect(const ARect: TRect; X, Y: integer; const Text: string);
procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
const Style: TTextStyle); virtual;
function TextExtent(const Text: string): TSize; virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
function TextHeight(const Text: string): Integer; virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
function TextWidth(const Text: string): Integer; virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
function TextFitInfo(const Text: string; MaxWidth: Integer): Integer;
function HandleAllocated: boolean; virtual;
function GetUpdatedHandle(ReqState: TCanvasState): HDC; virtual;
public
property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
property Handle: HDC read GetHandle write SetHandle;
property TextStyle: TTextStyle read FTextStyle write FTextStyle;
published
property AntialiasingMode: TAntialiasingMode read FAntialiasingMode write SetAntialiasingMode default amDontCare;
property AutoRedraw: Boolean read FAutoRedraw write SetAutoRedraw;
property Brush: TBrush read FLazBrush write SetLazBrush;
property CopyMode: TCopyMode read FCopyMode write FCopyMode default cmSrcCopy;
property Font: TFont read FLazFont write SetLazFont;
property Height: integer read GetHeight;
property Pen: TPen read FLazPen write SetLazPen;
property Region: TRegion read FRegion write SetRegion;
property Width: integer read GetWidth;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
end;
beria » 04.02.2017 14:01:37
vitaly_l писал(а):в случае с картинками - проделывается двойная работа и она явно не оправдана.
Лекс Айрин » 04.02.2017 14:05:01
beria писал(а):Значит неявное обнуление, которое , в общем случае, надо как прошлогодний снег ибо компилятор и так даже параноично подсказывает где нет явной инициализации,
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6