paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-31 10:00:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, Win32: Fix Rangecheck error when assigning ImageList to ListView. Issue #20861

Browse Source 
git-svn-id: trunk@34080 -
This commit is contained in:
juha 2011-12-10 10:58:09 +00:00
parent 43874efc17
commit 66508f5197
2 changed files with 22 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/include/imglist.inc
View File

@ -1443,8 +1443,16 @@ end;
Instructs the widgtset to create an imagelist
------------------------------------------------------------------------------}
function TCustomImageList.WSCreateReference(AParams: TCreateParams): PWSReference;
var
ilc: TWSCustomImageListClass;
dt: PRGBAQuad;
begin
FReference := TWSCustomImageListClass(WidgetSetClass).CreateReference(Self, FCount, FAllocBy, FWidth, FHeight, @FData[0]);
ilc := TWSCustomImageListClass(WidgetSetClass);
if FCount = 0 then
dt := nil
else
dt := @FData[0];
FReference := ilc.CreateReference(Self, FCount, FAllocBy, FWidth, FHeight, dt);
Result := @FReference;
end;

20
lcl/interfaces/win32/win32wsimglist.pp
View File

@ -47,7 +47,8 @@ type
TWin32WSCustomImageList = class(TWSCustomImageList)
protected
class procedure AddData(AListHandle: TLCLIntfHandle; ACount, AReplaceIndex, AWidth, AHeight: Integer; AData: PRGBAQuad);
class procedure AddData(AListHandle: TLCLIntfHandle;
ACount, AReplaceIndex, AWidth, AHeight: Integer; AData: PRGBAQuad);
published
class procedure Clear(AList: TCustomImageList); override;
class function CreateReference(AList: TCustomImageList; ACount, AGrow, AWidth,
@ -55,9 +56,11 @@ type
class procedure Delete(AList: TCustomImageList; AIndex: Integer); override;
class procedure DestroyReference(AComponent: TComponent); override;
class procedure Draw(AList: TCustomImageList; AIndex: Integer; ACanvas: TCanvas;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); override;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect;
AStyle: TDrawingStyle; AImageType: TImageType); override;
class procedure DrawToDC(AList: TCustomImageList; AIndex: Integer; ADC: HDC;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect;
AStyle: TDrawingStyle; AImageType: TImageType);
class procedure Insert(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); override;
class procedure Move(AList: TCustomImageList; ACurIndex, ANewIndex: Integer); override;
class procedure Replace(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); override;
@ -106,7 +109,9 @@ begin
ReleaseDC(0, DC);
end;
class procedure TWin32WSCustomImageList.AddData(AListHandle: TLCLIntfHandle; ACount, AReplaceIndex, AWidth, AHeight: Integer; AData: PRGBAQuad);
class procedure TWin32WSCustomImageList.AddData(AListHandle: TLCLIntfHandle;
ACount, AReplaceIndex, AWidth, AHeight: Integer; AData: PRGBAQuad);
procedure DoAddAlpha;
var
Info: Windows.TBitmapInfo;
@ -253,8 +258,8 @@ begin
end;
end;
Result._Init(ImageList_Create(AWidth, AHeight, Flags, ACount, AGrow));
if Result.Allocated
then AddData(Result._Handle, ACount, -1, AWidth, AHeight, AData);
if Result.Allocated and (ACount > 0) then
AddData(Result._Handle, ACount, -1, AWidth, AHeight, AData);
end;
class procedure TWin32WSCustomImageList.Delete(AList: TCustomImageList;
@ -273,7 +278,8 @@ begin
end;
class procedure TWin32WSCustomImageList.Draw(AList: TCustomImageList; AIndex: Integer;
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor;
ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
begin
if not WSCheckReferenceAllocated(AList, 'Draw')
then Exit;