pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

spktoolbar: Initial commit of TSpkPopupMenu.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8725 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-02-21 21:47:21 +00:00
parent e456d87021
commit 33121d356d
11 changed files with 964 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
components/spktoolbar/SpkGUITools/SpkGUITools.pas
View File

@ -18,7 +18,7 @@ interface
{$MESSAGE HINT 'Every rect in this module are exact rectanges (not like in WINAPI without right and bottom)'}
uses
LCLType, LCLVersion, Graphics, SysUtils, Classes, Controls, StdCtrls,
LCLType, LCLVersion, Graphics, SysUtils, Classes, Controls, StdCtrls, ImgList,
SpkGraphTools, SpkMath;
type
@ -36,7 +36,7 @@ type
TGUITools = class(TObject)
protected
class procedure FillGradientRectangle(ACanvas: TCanvas; Rect: T2DIntRect;
ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind);
ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind; ReflectionEdgePercent: Integer = 25);
class procedure SaveClipRgn(DC: HDC; out OrgRgnExists: boolean; out OrgRgn: HRGN);
class procedure RestoreClipRgn(DC: HDC; OrgRgnExists: boolean; var OrgRgn: HRGN);
public
@ -247,6 +247,12 @@ type
LeftBottomRound : boolean = true;
RightBottomRound : boolean = true); overload;
class procedure DrawPopupItemRect(ACanvas: TCanvas;
ARect: T2DIntRect;
ARadius: Integer;
AGradientColorFrom, AGradientColorTo: TColor;
AGradientKind: TBackgroundKind);
class procedure DrawRegion(ACanvas : TCanvas;
Region : HRGN;
Rect : T2DIntRect;
@ -263,46 +269,47 @@ type
// Imagelist tools
class procedure DrawImage(ABitmap : TBitmap;
Imagelist : TImageList;
Imagelist : TCustomImageList;
ImageIndex : integer;
Point : T2DIntVector); overload; inline;
class procedure DrawImage(ABitmap : TBitmap;
Imagelist : TImageList;
Imagelist : TCustomImageList;
ImageIndex : integer;
Point : T2DIntVector;
ClipRect : T2DIntRect); overload; inline;
class procedure DrawImage(ACanvas : TCanvas;
Imagelist : TImageList;
Imagelist : TCustomImageList;
ImageIndex : integer;
Point : T2DIntVector); overload; inline;
class procedure DrawImage(ACanvas : TCanvas;
Imagelist : TImageList;
Imagelist : TCustomImageList;
ImageIndex : integer;
Point : T2DIntVector;
ClipRect : T2DIntRect); overload;
class procedure DrawImage(ACanvas: TCanvas;
Imagelist: TImageList;
Imagelist: TCustomImageList;
ImageIndex: integer;
Point : T2DIntVector;
ClipRect: T2DIntRect;
AImageWidthAt96PPI, ATargetPPI: Integer;
ACanvasFactor: Double); overload;
ACanvasFactor: Double;
AEnabled: Boolean); overload;
class procedure DrawDisabledImage(ABitmap : TBitmap;
Imagelist : TImageList;
Imagelist : TCustomImageList;
ImageIndex : integer;
Point : T2DIntVector); overload; inline;
class procedure DrawDisabledImage(ABitmap : TBitmap;
Imagelist : TImageList;
Imagelist : TCustomImageList;
ImageIndex : integer;
Point : T2DIntVector;
ClipRect : T2DIntRect); overload; inline;
class procedure DrawDisabledImage(ACanvas : TCanvas;
Imagelist : TImageList;
Imagelist : TCustomImageList;
ImageIndex : integer;
Point : T2DIntVector); overload;
class procedure DrawDisabledImage(ACanvas : TCanvas;
Imagelist : TImageList;
Imagelist : TCustomImageList;
ImageIndex : integer;
Point : T2DIntVector;
ClipRect : T2DIntRect); overload; inline;
@ -1857,19 +1864,19 @@ begin
DeleteObject(ClipRgn);
end;
class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TImageList;
class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TCustomImageList;
ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect);
begin
DrawImage(ABitmap.Canvas, ImageList, ImageIndex, Point, ClipRect);
end;
class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TImageList;
class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TCustomImageList;
ImageIndex: integer; Point: T2DIntVector);
begin
DrawImage(ABitmap.Canvas, ImageList, ImageIndex, Point);
end;
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TCustomImageList;
ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect);
var
UseOrgClipRgn: Boolean;
@ -1919,9 +1926,9 @@ begin
DeleteObject(ClipRgn);
end;
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TCustomImageList;
ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect;
AImageWidthAt96PPI, ATargetPPI: Integer; ACanvasFactor: Double);
AImageWidthAt96PPI, ATargetPPI: Integer; ACanvasFactor: Double; AEnabled: Boolean);
var
UseOrgClipRgn: Boolean;
OrgRgn: HRGN;
@ -1940,9 +1947,9 @@ begin
{$IF LCL_FULLVERSION >= 1090000}
ImageList.DrawForPPI(ACanvas, Point.X, Point.Y, ImageIndex,
AImageWidthAt96PPI, ATargetPPI, ACanvasFactor);
AImageWidthAt96PPI, ATargetPPI, ACanvasFactor, AEnabled);
{$ELSE}
ImageList.Draw(ACanvas, Point.X, Point.Y, ImageIndex);
ImageList.Draw(ACanvas, Point.X, Point.Y, ImageIndex, AEnabled);
{$ENDIF}
(*
@ -2063,7 +2070,7 @@ begin
end;
end;
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TCustomImageList;
ImageIndex: integer; Point: T2DIntVector);
begin
ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex);
@ -2473,7 +2480,7 @@ end;
class procedure TGUITools.FillGradientRectangle(ACanvas: TCanvas;
Rect: T2DIntRect; ColorFrom: TColor; ColorTo: TColor;
GradientKind: TBackgroundKind);
GradientKind: TBackgroundKind; ReflectionEdgePercent: Integer = 25);
var
Mesh: array of GRADIENTRECT = nil;
GradientVertice: array of TRIVERTEX = nil;
@ -2531,7 +2538,7 @@ begin
with GradientVertice[1] do
begin
x := Rect.Right + 1;
y := Rect.Top + (Rect.height) div 4;
y := Rect.Top + Rect.height * ReflectionEdgePercent div 100;
Red := GetRValue(ConcaveColor) shl 8;
Green := GetGValue(ConcaveColor) shl 8;
Blue := GetBValue(ConcaveColor) shl 8;
@ -2540,7 +2547,7 @@ begin
with GradientVertice[2] do
begin
x := Rect.left;
y := Rect.Top + (Rect.height) div 4;
y := Rect.Top + Rect.Height * ReflectionEdgePercent div 100;
Red := GetRValue(ColorTo) shl 8;
Green := GetGValue(ColorTo) shl 8;
Blue := GetBValue(ColorTo) shl 8;
@ -2809,20 +2816,20 @@ begin
end;
class procedure TGUITools.DrawDisabledImage(ABitmap: TBitmap;
Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector;
Imagelist: TCustomImageList; ImageIndex: integer; Point: T2DIntVector;
ClipRect: T2DIntRect);
begin
DrawDisabledImage(ABitmap.Canvas, ImageList, ImageIndex, Point, ClipRect);
end;
class procedure TGUITools.DrawDisabledImage(ABitmap: TBitmap;
Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector);
Imagelist: TCustomImageList; ImageIndex: integer; Point: T2DIntVector);
begin
DrawDisabledImage(ABitmap.Canvas, ImageList, ImageIndex, Point);
end;
class procedure TGUITools.DrawDisabledImage(ACanvas: TCanvas;
Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector;
Imagelist: TCustomImageList; ImageIndex: integer; Point: T2DIntVector;
ClipRect: T2DIntRect);
var
UseOrgClipRgn: Boolean;
@ -2851,7 +2858,7 @@ begin
end;
class procedure TGUITools.DrawDisabledImage(ACanvas: TCanvas;
Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector);
Imagelist: TCustomImageList; ImageIndex: integer; Point: T2DIntVector);
var
DCStackPos : integer;
begin
@ -2919,4 +2926,42 @@ begin
end;
end;
class procedure TGUITools.DrawPopupItemRect(ACanvas: TCanvas; ARect: T2DIntRect;
ARadius: Integer; AGradientColorFrom, AGradientColorTo: TColor;
AGradientKind: TBackgroundKind);
var
RoundRgn: HRGN;
TmpRgn: HRGN;
OrgRgn: HRGN;
UseOrgClipRgn: Boolean;
begin
if ARadius < 0 then
exit;
if ARadius > 0 then
begin
if (ARadius*2 > ARect.Width) or (ARadius*2 > ARect.Height) then
exit;
SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
RoundRgn := CreateRoundRectRgn(ARect.Left, ARect.Top, ARect.Right + 2, ARect.Bottom + 2, ARadius*2, ARadius*2);
if UseOrgClipRgn then
CombineRgn(RoundRgn, RoundRgn, OrgRgn, RGN_AND);
SelectClipRgn(ACanvas.Handle, RoundRgn);
end; // if Radius > 0
AGradientColorFrom := ColorToRGB(AGradientColorFrom);
AGradientColorTo := ColorToRGB(AGradientColorTo);
FillGradientRectangle(ACanvas, ARect, AGradientColorFrom, AGradientColorTo, AGradientKind, 40);
if ARadius > 0 then
begin
// Restores previous ClipRgn and removes used regions
RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
DeleteObject(RoundRgn);
end;
end;
end.