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

- some fixes in new imagelist implementation

Browse Source 
git-svn-id: trunk@10926 -
This commit is contained in:
paul 2007-04-10 03:12:23 +00:00
parent 1dfeafc69c
commit d090ceaad0
4 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/imglist.pp
View File

@ -163,7 +163,7 @@ type
{$endif}
protected
procedure CheckIndex(AIndex: Integer; AForInsert: Boolean = False);
procedure FillDescription(ADesc: TRawImageDescription);
procedure FillDescription(var ADesc: TRawImageDescription);
procedure GetImages(Index: Integer; const Image, Mask: TBitmap);
procedure Initialize; virtual;
procedure DefineProperties(Filer: TFiler); override;

6
lcl/include/imglist.inc
View File

@ -552,7 +552,8 @@ begin
ACanvas.Draw(AX,AY,aBitmap);
{$else}
HandleNeeded;
TWSCustomImageListClass(WidgetSetClass).Draw(Self, AIndex, ACanvas, Rect(AX, AY, FWidth, FHeight), AEnabled, FDrawingStyle);
TWSCustomImageListClass(WidgetSetClass).Draw(Self, AIndex, ACanvas,
Rect(AX, AY, FWidth, FHeight), AEnabled, DrawingStyle);
{$endif}
end;
@ -578,7 +579,7 @@ end;
Fills the description with the default info of the imagedata
------------------------------------------------------------------------------}
procedure TCustomImageList.FillDescription(ADesc: TRawImageDescription);
procedure TCustomImageList.FillDescription(var ADesc: TRawImageDescription);
begin
ADesc.Format := ricfRGBA;
ADesc.HasPalette := False;
@ -736,6 +737,7 @@ begin
FAllocCount := 0;
FBlendColor := clNone;
FBkColor := clNone;
FDrawingStyle := dsNormal;
if (Height < 1) or (Height > 32768) or (Width < 1)
then raise EInvalidOperation.Create(SInvalidImageSize);

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

@ -84,18 +84,23 @@ class function TWin32WSCustomImageList.CreateHandle(AList: TCustomImageList;
var
FLags: DWord;
hbmImage: HBITMAP;
i: integer;
begin
if (Win32Platform and VER_PLATFORM_WIN32_NT) <> 0 then
Flags := ILC_COLOR32 or ILC_MASK
else
Flags := ILC_COLOR16 or ILC_MASK;
Result := ImageList_Create(ACount * AWidth, AHeight, Flags, 0, AGrow);
Result := ImageList_Create(AWidth, AHeight, Flags, ACount, AGrow);
if AData <> nil then
begin
hbmImage := CreateBitmap(ACount * AWidth, AHeight, 4, 32, AData);
ImageList_Add(Result, hbmImage, 0);
DeleteObject(hbmImage);
// this is very slow method :(
for i := 0 to ACount - 1 do
begin
hbmImage := CreateBitmap(AWidth, AHeight, 1, 32, @AData[AWidth * AHeight * i]);
ImageList_Add(Result, hbmImage, 0);
DeleteObject(hbmImage);
end;
end;
end;
@ -140,7 +145,7 @@ begin
if (AIndex <= ACount) and (AIndex >= 0) then
begin
hbmImage := CreateBitmap(AList.Width, AList.Height, 4, 32, AData);
hbmImage := CreateBitmap(AList.Width, AList.Height, 1, 32, AData);
ImageList_Add(AImageList, hbmImage, 0);
DeleteObject(hbmImage);
if AIndex <> ACount
@ -182,7 +187,7 @@ begin
if not WSCheckHandleAllocated(AList, 'Replace')
then Exit;
hbmImage := CreateBitmap(AList.Width, AList.Height, 4, 32, AData);
hbmImage := CreateBitmap(AList.Width, AList.Height, 1, 32, AData);
ImageList_Replace(HImageList(AList.Handle), AIndex, hbmImage, 0);
DeleteObject(hbmImage);
end;

2
lcl/lclclasses.pp
View File

@ -152,7 +152,7 @@ procedure TLCLHandleComponent.HandleNeeded;
var
Params: TCreateParams;
begin
if FHandle = 0 then Exit;
if FHandle <> 0 then Exit;
if FCreating
then begin