paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 03:39:48 +01:00
Code Issues Packages Projects Releases Wiki Activity

lcl: add overlay support to imagelist and treeview (based on patch of David Jenkins, issue #0021754)

Browse Source 
git-svn-id: trunk@36805 -
This commit is contained in:
paul 2012-04-16 05:16:43 +00:00
parent 49fc5776c9
commit 62cc1885af
3 changed files with 61 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/imglist.pp
View File

@ -103,6 +103,7 @@ type
TDrawingStyle = (dsFocus, dsSelected, dsNormal, dsTransparent);
TImageType = (itImage, itMask);
TOverlay = 0..14; // windows limitation
TCustomImageList = class(TLCLReferenceComponent)
private
@ -123,6 +124,7 @@ type
FBkColor: TColor;
FChanged: boolean;
FUpdateCount: integer;
FOverlays: array[TOverlay] of Integer;
procedure AllocData(ACount: Integer);
function GetReference: TWSCustomImageListReference;
@ -146,6 +148,7 @@ type
procedure Initialize; virtual;
procedure DefineProperties(Filer: TFiler); override;
procedure SetWidthHeight(NewWidth, NewHeight: integer); virtual;
procedure ClearOverlays;
class procedure WSRegisterClass; override;
function WSCreateReference(AParams: TCreateParams): PWSReference; override;
@ -177,6 +180,10 @@ type
AEnabled: Boolean = True); overload;
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
ADrawEffect: TGraphicsDrawEffect); overload; virtual;
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; AEnabled: Boolean = True);
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawEffect: TGraphicsDrawEffect);
procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawingStyle:
TDrawingStyle; AImageType: TImageType; ADrawEffect: TGraphicsDrawEffect); virtual;
procedure FillDescription(out ADesc: TRawImageDescription);
procedure GetBitmap(Index: Integer; Image: TCustomBitmap); overload;
@ -193,6 +200,7 @@ type
procedure InsertIcon(AIndex: Integer; AIcon: TCustomIcon);
procedure InsertMasked(Index: Integer; AImage: TCustomBitmap; MaskColor: TColor);
procedure Move(ACurIndex, ANewIndex: Integer);
procedure Overlay(AIndex: Integer; Overlay: TOverlay);
procedure Replace(AIndex: Integer; AImage, AMask: TCustomBitmap);
procedure ReplaceMasked(Index: Integer; NewImage: TCustomBitmap; MaskColor: TColor);
procedure RegisterChanges(Value: TChangeLink);

47
lcl/include/imglist.inc
View File

@ -376,6 +376,7 @@ begin
then TWSCustomImageListClass(WidgetSetClass).Clear(Self);
SetLength(FData, 0);
FAllocCount := 0;
ClearOverlays;
FCount := 0;
Change;
@ -519,6 +520,38 @@ begin
BkColor, BlendColor, ADrawEffect, ADrawingStyle, AImageType);
end;
procedure TCustomImageList.DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer;
AOverlay: TOverlay; AEnabled: Boolean = True);
begin
DrawOverlay(ACanvas, AX, AY, AIndex, AOverlay, EffectMap[AEnabled]);
end;
procedure TCustomImageList.DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer;
AOverlay: TOverlay; ADrawEffect: TGraphicsDrawEffect);
begin
DrawOverlay(ACanvas, AX, AY, AIndex, AOverlay, DrawingStyle, ImageType, ADrawEffect);
end;
procedure TCustomImageList.DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer;
AOverlay: TOverlay; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
ADrawEffect: TGraphicsDrawEffect);
var
OverlayIndex: Integer;
begin
if (AIndex < 0) or (AIndex >= FCount) then Exit;
ReferenceNeeded;
TWSCustomImageListClass(WidgetSetClass).Draw(Self, AIndex, ACanvas, Rect(AX, AY, FWidth, FHeight),
BkColor, BlendColor, ADrawEffect, ADrawingStyle, AImageType);
OverlayIndex := FOverlays[AOverlay];
if (OverlayIndex < 0) or (OverlayIndex >= FCount) then Exit;
TWSCustomImageListClass(WidgetSetClass).Draw(Self, OverlayIndex, ACanvas, Rect(AX, AY, FWidth, FHeight),
clNone, BlendColor, ADrawEffect, ADrawingStyle, AImageType);
end;
{------------------------------------------------------------------------------
Method: TCustomImageList.EndUpdate
Params: none
@ -738,6 +771,7 @@ begin
FBlendColor := clNone;
FBkColor := clNone;
FDrawingStyle := dsNormal;
ClearOverlays;
if (Height < 1) or (Height > 32768) or (Width < 1)
then raise EInvalidOperation.Create(SInvalidImageSize);
@ -751,6 +785,14 @@ begin
Clear;
end;
procedure TCustomImageList.ClearOverlays;
var
I: TOverlay;
begin
for I := Low(TOverlay) to High(TOverlay) do
FOverlays[I] := -1;
end;
class procedure TCustomImageList.WSRegisterClass;
begin
inherited WSRegisterClass;
@ -1321,6 +1363,11 @@ begin
{$ENDIF}
end;
procedure TCustomImageList.Overlay(AIndex: Integer; Overlay: TOverlay);
begin
FOverlays[Overlay] := AIndex;
end;
{------------------------------------------------------------------------------
Method: TCustomImageList.RegisterChanges
Params: Value: a reference to changelink object

6
lcl/include/treeview.inc
View File

@ -4884,8 +4884,12 @@ begin
ImgIndex := Node.SelectedIndex;
end;
if (ImgIndex >= 0) and (ImgIndex < Images.Count) then
if Node.OverlayIndex < 0 then
Images.Draw(Canvas, x + 1, (NodeRect.Top + NodeRect.Bottom - Images.Height) div 2,
ImgIndex, Node.FNodeEffect);
ImgIndex, Node.FNodeEffect)
else
Images.DrawOverlay(Canvas, x + 1, (NodeRect.Top + NodeRect.Bottom - Images.Height) div 2,
ImgIndex, Node.OverlayIndex, Node.FNodeEffect);
inc(x, Images.Width + 2);
end;