47
LCLStrConsts, LCLType, LCLProc, LMessages, LCLIntf, LResources, LCLResCache,
48
GraphType, IcnsTypes, GraphMath, InterfaceBase, WSReferences;
51
LCLStrConsts, LCLType, LCLProc, LMessages, LResources, LCLResCache,
52
GraphType, IcnsTypes, GraphMath, WSReferences;
685
696
constructor Create; override;
686
697
destructor Destroy; override;
687
698
property Bitmap: TCustomBitmap read FBitmap write SetBitmap;
688
property Handle: HBRUSH read GetHandle write SetHandle; deprecated;
699
property Handle: HBRUSH read GetHandle write SetHandle; deprecated; // use instead Reference.Handle
689
700
property Reference: TWSBrushReference read GetReference;
691
702
property Color: TColor read FColor write SetColor default clWhite;
692
703
property Style default bsSolid;
706
TRegionCombineMode = (rgnAnd, rgnCopy, rgnDiff, rgnOr, rgnXOR);
708
TRegionOperationType = (rgnNewRect, rgnCombine);
710
TRegionOperation = record
711
ROType: TRegionOperationType;
712
Source1, Source2, Dest: Integer; // Index to the list of sub-regions, -1 indicates the main region
713
CombineMode: TRegionCombineMode; // Used only if ROType=rgnCombine
714
Rect: TRect; // Used for ROType=rgnNewRect
717
TRegionOperations = array of TRegionOperation;
699
Reference: TWSRegionReference;
701
{Polygon Region Info - not used yet}
702
Polygon: PPoint; //Polygon Points
703
NumPoints: Longint; //Number of Points
704
Winding: Boolean; //Use Winding mode
707
721
TRegion = class(TGraphicsObject)
709
FRegionData: TRegionData;
723
FReference: TWSRegionReference;
724
// Description of the region
725
RegionOperations: TRegionOperations;
726
SubRegions: array of HRGN;
727
procedure AddOperation(AOp: TRegionOperation);
728
procedure ClearSubRegions();
729
procedure AddSubRegion(AHandle: HRGN);
710
731
procedure FreeReference;
711
732
function GetReference: TWSRegionReference;
712
733
function GetHandle: HRGN;
1084
1108
procedure RestoreHandleState; virtual;
1086
1110
// extra drawing methods (there are more in the ancestor TFPCustomCanvas)
1087
procedure Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer); virtual;
1088
procedure Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual;
1089
//procedure BrushCopy(Dest: TRect; InternalImages: TBitmap; Src: TRect;
1090
// TransparentColor: TColor); virtual;
1111
procedure Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1112
procedure Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1113
procedure BrushCopy(ADestRect: TRect; ABitmap: TBitmap; ASourceRect: TRect;
1114
ATransparentColor: TColor); virtual;
1091
1115
procedure Chord(x1, y1, x2, y2,
1092
Angle16Deg, Angle16DegLength: Integer); virtual;
1093
procedure Chord(x1, y1, x2, y2, SX, SY, EX, EY: Integer); virtual;
1116
Angle16Deg, Angle16DegLength: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1117
procedure Chord(x1, y1, x2, y2, SX, SY, EX, EY: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1094
1118
procedure CopyRect(const Dest: TRect; SrcCanvas: TCanvas;
1095
1119
const Source: TRect); virtual;
1096
1120
procedure Draw(X,Y: Integer; SrcGraphic: TGraphic); virtual;
1097
1121
procedure DrawFocusRect(const ARect: TRect); virtual;
1098
1122
procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual;
1099
procedure Ellipse(const ARect: TRect); // already in fpcanvas
1100
procedure Ellipse(x1, y1, x2, y2: Integer); virtual; // already in fpcanvas
1101
procedure FillRect(const ARect: TRect); virtual;
1102
procedure FillRect(X1,Y1,X2,Y2: Integer);
1123
procedure Ellipse(const ARect: TRect); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1124
procedure Ellipse(x1, y1, x2, y2: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1125
procedure FillRect(const ARect: TRect); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1126
procedure FillRect(X1,Y1,X2,Y2: Integer); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1103
1127
procedure FloodFill(X, Y: Integer; FillColor: TColor;
1104
FillStyle: TFillStyle); virtual;
1128
FillStyle: TFillStyle); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1105
1129
procedure Frame3d(var ARect: TRect; const FrameWidth: integer;
1106
1130
const Style: TGraphicsBevelCut); virtual;
1131
procedure Frame3D(var ARect: TRect; TopColor, BottomColor: TColor;
1132
const FrameWidth: integer); overload;
1107
1133
procedure Frame(const ARect: TRect); virtual; // border using pen
1108
1134
procedure Frame(X1,Y1,X2,Y2: Integer); // border using pen
1109
1135
procedure FrameRect(const ARect: TRect); virtual; // border using brush
1111
1137
function GetTextMetrics(out TM: TLCLTextMetric): boolean; virtual;
1112
1138
procedure GradientFill(ARect: TRect; AStart, AStop: TColor; ADirection: TGradientDirection);
1113
1139
procedure RadialPie(x1, y1, x2, y2,
1114
StartAngle16Deg, Angle16DegLength: Integer); virtual;
1140
StartAngle16Deg, Angle16DegLength: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1115
1141
procedure Pie(EllipseX1,EllipseY1,EllipseX2,EllipseY2,
1116
1142
StartX,StartY,EndX,EndY: Integer); virtual;
1117
1143
procedure PolyBezier(Points: PPoint; NumPts: Integer;
1118
1144
Filled: boolean = False;
1119
Continuous: boolean = False); virtual;
1145
Continuous: boolean = False); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1120
1146
procedure PolyBezier(const Points: array of TPoint;
1121
1147
Filled: boolean = False;
1122
Continuous: boolean = False);
1148
Continuous: boolean = False); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1123
1149
procedure Polygon(const Points: array of TPoint;
1124
1150
Winding: Boolean;
1125
1151
StartIndex: Integer = 0;
1126
1152
NumPts: Integer = -1);
1127
1153
procedure Polygon(Points: PPoint; NumPts: Integer;
1128
1154
Winding: boolean = False); virtual;
1129
procedure Polygon(const Points: array of TPoint); // already in fpcanvas
1155
procedure Polygon(const Points: array of TPoint); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1130
1156
procedure Polyline(const Points: array of TPoint;
1131
1157
StartIndex: Integer;
1132
1158
NumPts: Integer = -1);
1133
1159
procedure Polyline(Points: PPoint; NumPts: Integer); virtual;
1134
procedure Polyline(const Points: array of TPoint); // already in fpcanvas
1135
procedure Rectangle(X1,Y1,X2,Y2: Integer); virtual; // already in fpcanvas
1136
procedure Rectangle(const ARect: TRect); // already in fpcanvas
1160
procedure Polyline(const Points: array of TPoint); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1161
procedure Rectangle(X1,Y1,X2,Y2: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1162
procedure Rectangle(const ARect: TRect); {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1137
1163
procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); virtual;
1138
1164
procedure RoundRect(const Rect: TRect; RX,RY: Integer);
1139
procedure TextOut(X,Y: Integer; const Text: String); virtual; // already in fpcanvas
1165
procedure TextOut(X,Y: Integer; const Text: String); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1140
1166
procedure TextRect(const ARect: TRect; X, Y: integer; const Text: string);
1141
1167
procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
1142
1168
const Style: TTextStyle); virtual;
1143
function TextExtent(const Text: string): TSize; virtual;
1144
function TextHeight(const Text: string): Integer; virtual;
1145
function TextWidth(const Text: string): Integer; virtual;
1169
function TextExtent(const Text: string): TSize; virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1170
function TextHeight(const Text: string): Integer; virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1171
function TextWidth(const Text: string): Integer; virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
1172
function TextFitInfo(const Text: string; MaxWidth: Integer): Integer;
1146
1173
function HandleAllocated: boolean; virtual;
1147
1174
function GetUpdatedHandle(ReqState: TCanvasState): HDC; virtual;
1218
1245
{ TRasterImage }
1220
{ TCustomBitmap is the data of an image. The image can be loaded from a file,
1221
stream or resource in .bmp (windows bitmap format) or .xpm (XPixMap format)
1222
The loading routine automatically recognizes the format, so it is also used
1223
to load the imagess from Delphi form streams (e.g. .dfm files).
1224
When the handle is created, it is up to the interface (gtk, win32, ...)
1225
to convert it automatically to the best internal format. That is why the
1226
Handle is interface dependent.
1227
To access the raw data, see TLazIntfImage in IntfGraphics.pas }
1231
1247
TRasterImage = class(TGraphic)
1233
1249
FCanvas: TCanvas;
1358
1374
property Width: Integer read GetWidth;
1378
is the data of an image. The image can be loaded from a file,
1379
stream or resource in .bmp (windows bitmap format) or .xpm (XPixMap format)
1380
The loading routine automatically recognizes the format, so it is also used
1381
to load the imagess from Delphi form streams (e.g. .dfm files).
1382
When the handle is created, it is up to the interface (gtk, win32, ...)
1383
to convert it automatically to the best internal format. That is why the
1384
Handle is interface dependent.
1385
To access the raw data, see TLazIntfImage in IntfGraphics.pas }
1363
1387
TCustomBitmap = class(TRasterImage)
1365
1389
FPixelFormat: TPixelFormat;
1524
1549
procedure FreeHandle; override;
1525
1550
procedure UpdateFromHandle(NewHandle: THandle); virtual;
1526
1551
function IsEmpty: boolean; override;
1552
function GetImage(const AIndex: Integer): TIconImage;
1528
1554
constructor Create; override;
1529
1555
destructor Destroy; override;
1530
1556
procedure Clear;
1531
procedure Delete(Aindex: Integer);
1557
procedure Delete(AIndex: Integer);
1532
1558
function GetIndex(AFormat: TPixelFormat; AHeight, AWidth: Word): Integer;
1533
1559
class function GetImagesClass: TIconImageClass; virtual;
1534
1560
procedure Add(AIconImage: TIconImage);
1535
1561
function Count: Integer;
1562
property Images[AIndex: Integer]: TIconImage read GetImage;
1597
1625
function GetIndex(AFormat: TPixelFormat; AHeight, AWidth: Word): Integer;
1598
1626
function GetBitmapHandle: HBITMAP; override;
1599
1627
class function GetDefaultSize: TSize; virtual;
1600
function GetMasked: Boolean; override;
1601
1628
function GetMaskHandle: HBITMAP; override;
1602
1629
function GetPalette: HPALETTE; override;
1603
1630
function GetPixelFormat: TPixelFormat; override;
1604
1631
function GetRawImagePtr: PRawImage; override;
1605
1632
function GetRawImageDescriptionPtr: PRawImageDescription; override;
1606
1633
function GetTransparent: Boolean; override;
1634
class function GetSharedImageClass: TSharedRasterImageClass; override;
1635
class function GetStreamSignature: Cardinal; virtual;
1607
1636
class function GetTypeID: Word; virtual;
1608
class function GetSharedImageClass: TSharedRasterImageClass; override;
1609
1637
procedure HandleNeeded; override;
1610
1638
function InternalReleaseBitmapHandle: HBITMAP; override;
1611
1639
function InternalReleaseMaskHandle: HBITMAP; override;
1734
1764
procedure HandleNeeded; override;
1735
1765
class function GetDefaultSize: TSize; override;
1766
class function GetStreamSignature: Cardinal; override;
1736
1767
class function GetSharedImageClass: TSharedRasterImageClass; override;
1737
1768
class function GetTypeID: Word; override;
1739
1770
class function GetFileExtensions: string; override;
1740
1771
function GetResourceType: TResourceType; override;
1772
procedure LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle); override;
1741
1773
function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
1742
1774
function ReleaseHandle: HCURSOR;
1743
1775
property HotSpot: TPoint read GetHotSpot;
1872
1904
// Color / Identifier mapping
1873
1905
TGetColorStringProc = procedure(const s: AnsiString) of object;
1875
function IdentEntry(Entry: Longint; var MapEntry: TIdentMapEntry): boolean;
1876
function ColorToIdent(Color: Longint; var Ident: String): Boolean;
1877
function IdentToColor(const Ident: string; var Color: Longint): Boolean;
1878
function ColorIndex(Color: Longint; var Index: Integer): Boolean;
1907
function IdentEntry(Entry: Longint; out MapEntry: TIdentMapEntry): boolean;
1908
function ColorToIdent(Color: Longint; out Ident: String): Boolean;
1909
function IdentToColor(const Ident: string; out Color: Longint): Boolean;
1910
function ColorIndex(Color: Longint; out Index: Integer): Boolean;
1879
1911
function SysColorToSysColorIndex(Color: TColor): integer;
1880
function ColorToRGB(Color: TColor): TColor;
1912
function ColorToRGB(Color: TColor): Longint;
1881
1913
function ColorToString(Color: TColor): AnsiString;
1882
1914
function StringToColor(const S: shortstring): TColor;
1915
function StringToColorDef(const S: shortstring; const DefaultValue: TColor): TColor;
1883
1916
procedure GetColorValues(Proc: TGetColorStringProc);
1884
1917
function InvertColor(AColor: TColor): TColor;
1885
1918
function DecColor(AColor: TColor; AQuantity: Byte): TColor;
1886
function IsSysColor(AColor: TColor): Boolean;
1919
function IsSysColor(AColor: TColorRef): Boolean;
1888
function Blue(rgb: TColor): BYTE; // does not work on system color
1889
function Green(rgb: TColor): BYTE; // does not work on system color
1890
function Red(rgb: TColor): BYTE; // does not work on system color
1921
function Blue(rgb: TColorRef): BYTE; // does not work on system color
1922
function Green(rgb: TColorRef): BYTE; // does not work on system color
1923
function Red(rgb: TColorRef): BYTE; // does not work on system color
1891
1924
function RGBToColor(R, G, B: Byte): TColor;
1892
procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); // does not work on system color
1925
procedure RedGreenBlue(rgb: TColorRef; out Red, Green, Blue: Byte); // does not work on system color
1926
function FPColorToTColorRef(const FPColor: TFPColor): TColorRef;
1893
1927
function FPColorToTColor(const FPColor: TFPColor): TColor;
1894
function TColorToFPColor(const c: TColor): TFPColor; // does not work on system color
1928
function TColorToFPColor(const c: TColorRef): TFPColor; overload;
1929
function TColorToFPColor(const c: TColor): TFPColor; overload; // does not work on system color
1897
1932
procedure GetCharsetValues(Proc: TGetStrProc);
1898
function CharsetToIdent(Charset: Longint; var Ident: string): Boolean;
1899
function IdentToCharset(const Ident: string; var Charset: Longint): Boolean;
1933
function CharsetToIdent(Charset: Longint; out Ident: string): Boolean;
1934
function IdentToCharset(const Ident: string; out Charset: Longint): Boolean;
1900
1935
function GetFontData(Font: HFont): TFontData;
1902
1937
function GetDefFontCharSet: TFontCharSet;
1938
1973
function ReadXPMFromStream(Stream: TStream; Size: integer): PPChar;
1939
1974
function ReadXPMSize(XPM: PPChar; var Width, Height, ColorCount: integer): boolean;
1940
1975
function LoadCursorFromLazarusResource(ACursorName: String): HCursor;
1976
// for winapi compatibility
1977
function LoadBitmap(hInstance: THandle; lpBitmapName: PChar): HBitmap;
1978
function LoadCursor(hInstance: THandle; lpCursorName: PChar): HCursor;
1979
function LoadIcon(hInstance: THandle; lpIconName: PChar): HIcon;
1942
1981
function LoadBitmapFromLazarusResource(const ResourceName: String): TBitmap; deprecated;
1943
1982
function LoadBitmapFromLazarusResourceHandle(Handle: TLResource): TBitmap; deprecated;
2041
2081
Result:='['+Result+']';
2045
2084
function LoadCursorFromLazarusResource(ACursorName: String): HCursor;
2047
2086
CursorImage: TCursorImage;
2049
2088
CursorImage := TCursorImage.Create;
2050
CursorImage.LoadFromLazarusResource(ACursorName);
2051
Result := CursorImage.ReleaseHandle;
2090
CursorImage.LoadFromLazarusResource(ACursorName);
2091
Result := CursorImage.ReleaseHandle;
2097
function LoadBitmap(hInstance: THandle; lpBitmapName: PChar): HBitmap;
2101
Bmp := TBitmap.Create;
2103
if PtrUInt(lpBitmapName) > High(Word)
2104
then Bmp.LoadFromResourceName(hInstance, lpBitmapName)
2105
else Bmp.LoadFromResourceID(hInstance, PtrInt(lpBitmapName));
2106
Result := Bmp.ReleaseHandle;
2112
function LoadCursor(hInstance: THandle; lpCursorName: PChar): HCursor;
2116
Cur := TCursorImage.Create;
2118
if PtrUInt(lpCursorName) > High(Word)
2119
then Cur.LoadFromResourceName(hInstance, lpCursorName)
2120
else Cur.LoadFromResourceID(hInstance, PtrInt(lpCursorName));
2121
Result := Cur.ReleaseHandle;
2127
function LoadIcon(hInstance: THandle; lpIconName: PChar): HIcon;
2131
Ico := TIcon.Create;
2133
if PtrUInt(lpIconName) > High(Word)
2134
then Ico.LoadFromResourceName(hInstance, lpIconName)
2135
else Ico.LoadFromResourceID(hInstance, PtrInt(lpIconName));
2136
Result := Ico.ReleaseHandle;
2056
2142
function CreateBitmapFromLazarusResource(AStream: TLazarusResourceStream; AMinimumClass: TCustomBitmapClass): TCustomBitmap;
2187
2273
DstImage.CopyPixels(SrcImage, 0, 0, True, $8000);
2276
// update DevDesc because of unusual bitmaps. issue #12362
2277
// widgetset can provide same DevDesc, but also can change it
2278
// like gtk/gtk2 does since it expects XBM format for mono bitmaps.
2279
if DevDesc.Depth = 1 then
2281
QueryFlags := QueryFlags + [riqfUpdate];
2282
QueryDescription(DevDesc, QueryFlags);
2190
2284
DstImage.DataDescription := DevDesc;
2191
2285
DstImage.CopyPixels(SrcImage);
2408
function ColorToIdent(Color: Longint; var Ident: String): Boolean;
2502
function ColorToIdent(Color: Longint; out Ident: String): Boolean;
2410
2504
Result := IntToIdent(Color, Ident, Colors);
2413
function IdentToColor(const Ident: string; var Color: Longint): Boolean;
2507
function IdentToColor(const Ident: string; out Color: Longint): Boolean;
2415
2509
Result := IdentToInt(Ident, Color, Colors);
2418
function ColorIndex(Color: Longint; var Index: Integer): Boolean;
2512
function ColorIndex(Color: Longint; out Index: Integer): Boolean;
2537
2642
Result := (B shl 16) or (G shl 8) or R;
2540
procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte);
2645
procedure RedGreenBlue(rgb: TColorRef; out Red, Green, Blue: Byte);
2542
2647
Red := rgb and $000000ff;
2543
2648
Green := (rgb shr 8) and $000000ff;
2544
2649
Blue := (rgb shr 16) and $000000ff;
2547
function FPColorToTColor(const FPColor: TFPColor): TColor;
2652
function FPColorToTColorRef(const FPColor: TFPColor): TColorRef;
2549
2654
Result:=((FPColor.Red shr 8) and $ff)
2550
2655
or (FPColor.Green and $ff00)
2551
2656
or ((FPColor.Blue shl 8) and $ff0000);
2554
function TColorToFPColor(const c: TColor): TFPColor;
2659
function FPColorToTColor(const FPColor: TFPColor): TColor;
2661
Result:=TColor(FPColorToTColorRef(FPColor));
2664
function TColorToFPColor(const c: TColorRef): TFPColor;
2556
2666
Result.Red:=(c and $ff);
2557
2667
Result.Red:=Result.Red+(Result.Red shl 8);
2645
2760
UpdateLock := TCriticalSection.Create;
2646
2761
OnGetSystemFont := @LocalGetSystemFont;
2647
RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);
2648
RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent);
2762
RegisterIntegerConsts(TypeInfo(TColor), TIdentToInt(@IdentToColor), TIntToIdent(@ColorToIdent));
2763
RegisterIntegerConsts(TypeInfo(TFontCharset), TIdentToInt(@IdentToCharset), TIntToIdent(@CharsetToIdent));
2649
2764
RegisterInterfaceInitializationHandler(@InterfaceInit);
2650
2765
RegisterInterfaceFinalizationHandler(@InterfaceFinal);