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

* Added dataowner to LazIntfImage

Browse Source 
* fixes imagelist code

git-svn-id: trunk@10938 -
This commit is contained in:
marc 2007-04-11 23:54:17 +00:00
parent dc067a5a2b
commit 1a84ef8f8a
4 changed files with 53 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/controls.pp
View File

@ -1829,11 +1829,11 @@ type
TImageList = class(TDragImageList) TImageList = class(TDragImageList)
published published
property BkColor: TColor; property BkColor;
Property Height; Property Height;
property Masked; property Masked;
Property Width; property Width;
Property OnChange; property OnChange;
end; end;

4
lcl/imglist.pp
View File

@ -147,7 +147,7 @@ type
{$ifndef IMGLIST_OLDSTYLE} {$ifndef IMGLIST_OLDSTYLE}
procedure InternalMove(ACurIndex, ANewIndex: Cardinal; AIgnoreCurrent: Boolean); procedure InternalMove(ACurIndex, ANewIndex: Cardinal; AIgnoreCurrent: Boolean);
function InternalSetImage(AIndex: Integer; AImage: TRawImage): PRGBAQuad; function InternalSetImage(AIndex: Integer; AImage: TRawImage; AFreeImage: Boolean): PRGBAQuad;
{$endif} {$endif}
procedure NotifyChangeLink; procedure NotifyChangeLink;
@ -163,7 +163,7 @@ type
{$endif} {$endif}
protected protected
procedure CheckIndex(AIndex: Integer; AForInsert: Boolean = False); procedure CheckIndex(AIndex: Integer; AForInsert: Boolean = False);
procedure FillDescription(var ADesc: TRawImageDescription); procedure FillDescription(out ADesc: TRawImageDescription);
procedure GetImages(Index: Integer; const Image, Mask: TBitmap); procedure GetImages(Index: Integer; const Image, Mask: TBitmap);
procedure Initialize; virtual; procedure Initialize; virtual;
procedure DefineProperties(Filer: TFiler); override; procedure DefineProperties(Filer: TFiler); override;

25
lcl/include/imglist.inc
View File

@ -579,7 +579,7 @@ end;
Fills the description with the default info of the imagedata Fills the description with the default info of the imagedata
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TCustomImageList.FillDescription(var ADesc: TRawImageDescription); procedure TCustomImageList.FillDescription(out ADesc: TRawImageDescription);
begin begin
ADesc.Format := ricfRGBA; ADesc.Format := ricfRGBA;
ADesc.HasPalette := False; ADesc.HasPalette := False;
@ -592,11 +592,11 @@ begin
ADesc.BitsPerPixel := 32; ADesc.BitsPerPixel := 32;
ADesc.LineEnd := rileDWordBoundary; ADesc.LineEnd := rileDWordBoundary;
ADesc.RedPrec := 8; // red precision. bits for red ADesc.RedPrec := 8; // red precision. bits for red
ADesc.RedShift := 24; ADesc.RedShift := 8;
ADesc.GreenPrec := 8; ADesc.GreenPrec := 8;
ADesc.GreenShift := 16; ADesc.GreenShift := 16;
ADesc.BluePrec := 8; ADesc.BluePrec := 8;
ADesc.BlueShift := 8; ADesc.BlueShift := 24;
ADesc.AlphaPrec := 8; ADesc.AlphaPrec := 8;
ADesc.AlphaShift := 0; ADesc.AlphaShift := 0;
ADesc.AlphaSeparate := False; ADesc.AlphaSeparate := False;
@ -628,7 +628,7 @@ begin
RawImg.DataSize := FWidth * FHeight * SizeOF(FData[0]); RawImg.DataSize := FWidth * FHeight * SizeOF(FData[0]);
RawImg.Data := @FData[Index * FWidth * FHeight]; RawImg.Data := @FData[Index * FWidth * FHeight];
IntfImg := TLazIntfImage.Create(RawImg); IntfImg := TLazIntfImage.Create(RawImg, False);
Image.LoadFromIntfImage(IntfImg); Image.LoadFromIntfImage(IntfImg);
IntfImg.Free; IntfImg.Free;
{$endif} {$endif}
@ -807,11 +807,15 @@ begin
then InternalMove(FCount - 1, AIndex, True); then InternalMove(FCount - 1, AIndex, True);
if AMask = nil if AMask = nil
then msk := 0 then begin
if AImage.MaskHandleAllocated
then msk := AImage.MaskHandle
else msk := 0;
end
else msk := AMask.Handle; else msk := AMask.Handle;
R := Rect(0, 0, FWidth, FHeight); R := Rect(0, 0, FWidth, FHeight);
GetRawImageFromBitmap(AImage.Handle, msk, R, RawImg); GetRawImageFromBitmap(AImage.Handle, msk, R, RawImg);
ImgData := InternalSetImage(AIndex, RawImg); ImgData := InternalSetImage(AIndex, RawImg, True);
if HandleAllocated if HandleAllocated
then TWSCustomImageListClass(WidgetSetClass).Insert(Self, AIndex, ImgData); then TWSCustomImageListClass(WidgetSetClass).Insert(Self, AIndex, ImgData);
@ -913,24 +917,25 @@ end;
Method: TCustomImageList.InternalSetImage Method: TCustomImageList.InternalSetImage
Params: AIndex: the index of the location where the image should be set Params: AIndex: the index of the location where the image should be set
AImage: the new image AImage: the new image
AFreeImage: if set, the rawimagedata is freed
Returns: Pointer to the updated image data Returns: Pointer to the updated image data
Copies the imagedata into the FData array Copies the imagedata into the FData array
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
{$ifndef IMGLIST_OLDSTYLE} {$ifndef IMGLIST_OLDSTYLE}
function TCustomImageList.InternalSetImage(AIndex: Integer; AImage: TRawImage): PRGBAQuad; function TCustomImageList.InternalSetImage(AIndex: Integer; AImage: TRawImage; AFreeImage: Boolean): PRGBAQuad;
var var
RawImg: TRawImage; RawImg: TRawImage;
SrcImg, DstImg: TLazIntfImage; SrcImg, DstImg: TLazIntfImage;
begin begin
SrcImg := TLazIntfImage.Create(AImage); SrcImg := TLazIntfImage.Create(AImage, AFreeImage);
FillChar(RawImg, SizeOf(RawImg), 0); FillChar(RawImg, SizeOf(RawImg), 0);
FillDescription(RawImg.Description); FillDescription(RawImg.Description);
Result := @FData[AIndex * FWidth * FHeight]; Result := @FData[AIndex * FWidth * FHeight];
RawImg.DataSize := FWidth * FHeight * SizeOF(FData[0]); RawImg.DataSize := FWidth * FHeight * SizeOF(FData[0]);
RawImg.Data := PByte(Result); RawImg.Data := PByte(Result);
DstImg := TLazIntfImage.Create(RawImg); DstImg := TLazIntfImage.Create(RawImg, False);
DstImg.CopyPixels(SrcImg); DstImg.CopyPixels(SrcImg);
DstImg.Free; DstImg.Free;
@ -1327,7 +1332,7 @@ begin
else msk := AMask.Handle; else msk := AMask.Handle;
R := Rect(0, 0, FWidth, FHeight); R := Rect(0, 0, FWidth, FHeight);
GetRawImageFromBitmap(AImage.Handle, AMask.Handle, R, RawImage); GetRawImageFromBitmap(AImage.Handle, AMask.Handle, R, RawImage);
ImgData := InternalSetImage(AIndex, RawImage); ImgData := InternalSetImage(AIndex, RawImage, True);
if HandleAllocated if HandleAllocated
then TWSCustomImageListClass(WidgetSetClass).Replace(Self, AIndex, ImgData); then TWSCustomImageListClass(WidgetSetClass).Replace(Self, AIndex, ImgData);
{$endif} {$endif}

50
lcl/intfgraphics.pas
View File

@ -129,6 +129,7 @@ type
FWriteRawImageBits: TOnWriteRawImageBits; FWriteRawImageBits: TOnWriteRawImageBits;
FAlphaReadRawImageBits: TOnReadRawImageBits; FAlphaReadRawImageBits: TOnReadRawImageBits;
FAlphaWriteRawImageBits: TOnWriteRawImageBits; FAlphaWriteRawImageBits: TOnWriteRawImageBits;
FDataOwner: Boolean;
function GetTColors(x, y: integer): TGraphicsColor; function GetTColors(x, y: integer): TGraphicsColor;
procedure SetAutoCreateMask(const AValue: boolean); procedure SetAutoCreateMask(const AValue: boolean);
procedure SetTColors(x, y: integer; const AValue: TGraphicsColor); procedure SetTColors(x, y: integer; const AValue: TGraphicsColor);
@ -173,7 +174,7 @@ type
procedure SetColor_BPP32_R8G8B8_A1_BIO_TTB_RBO(x, y: integer; const Value: TFPColor); procedure SetColor_BPP32_R8G8B8_A1_BIO_TTB_RBO(x, y: integer; const Value: TFPColor);
public public
constructor Create(AWidth, AHeight: integer); override; constructor Create(AWidth, AHeight: integer); override;
constructor Create(ARawImage: TRawImage); constructor Create(ARawImage: TRawImage; ADataOwner: Boolean);
destructor Destroy; override; destructor Destroy; override;
procedure BeginUpdate; procedure BeginUpdate;
procedure EndUpdate; procedure EndUpdate;
@ -188,7 +189,7 @@ type
procedure LoadFromBitmap(Bitmap, MaskBitmap: HBitmap; AWidth: integer = -1; AHeight: integer = -1); virtual; procedure LoadFromBitmap(Bitmap, MaskBitmap: HBitmap; AWidth: integer = -1; AHeight: integer = -1); virtual;
procedure CreateBitmap(var Bitmap, MaskBitmap: HBitmap; procedure CreateBitmap(var Bitmap, MaskBitmap: HBitmap;
AlwaysCreateMask: boolean); virtual; AlwaysCreateMask: boolean); virtual;
procedure SetRawImage(const RawImage: TRawImage); virtual; procedure SetRawImage(const RawImage: TRawImage; ADataOwner: Boolean = True); virtual;
procedure GetRawImage(out RawImage: TRawImage); virtual; procedure GetRawImage(out RawImage: TRawImage); virtual;
procedure FillPixels(const Color: TFPColor); virtual; procedure FillPixels(const Color: TFPColor); virtual;
procedure CopyPixels(Src: TFPCustomImage); virtual; procedure CopyPixels(Src: TFPCustomImage); virtual;
@ -404,7 +405,8 @@ function dbgs(const FPColor: TFPColor): string; overload;
implementation implementation
uses Graphics; uses
Graphics;
var var
IsSpaceChar, IsNumberChar, IsHexNumberChar: array[char] of Boolean; IsSpaceChar, IsNumberChar, IsHexNumberChar: array[char] of Boolean;
@ -1559,16 +1561,18 @@ end;
procedure TLazIntfImage.FreePixelData; procedure TLazIntfImage.FreePixelData;
begin begin
ReallocMem(FPixelData,0); if FDataOwner then
FPixelDataSize:=0; ReallocMem(FPixelData, 0);
ReallocMem(FLineStarts,0); FPixelDataSize := 0;
ReallocMem(FLineStarts, 0);
end; end;
procedure TLazIntfImage.FreeMaskData; procedure TLazIntfImage.FreeMaskData;
begin begin
ReallocMem(FMaskData,0); if FDataOwner then
FMaskDataSize:=0; ReallocMem(FMaskData, 0);
ReallocMem(FMaskLineStarts,0); FMaskDataSize := 0;
ReallocMem(FMaskLineStarts, 0);
end; end;
procedure TLazIntfImage.CreateAllData; procedure TLazIntfImage.CreateAllData;
@ -1630,17 +1634,19 @@ end;
constructor TLazIntfImage.Create(AWidth, AHeight: integer); constructor TLazIntfImage.Create(AWidth, AHeight: integer);
begin begin
FDataOwner := true;
FAutoCreateMask:=true; FAutoCreateMask:=true;
OnGetInternalColor:=@GetColor_NULL; OnGetInternalColor:=@GetColor_NULL;
OnSetInternalColor:=@SetColor_NULL; OnSetInternalColor:=@SetColor_NULL;
inherited Create(AWidth, AHeight); inherited Create(AWidth, AHeight);
end; end;
constructor TLazIntfImage.Create(ARawImage: TRawImage); constructor TLazIntfImage.Create(ARawImage: TRawImage; ADataOwner: Boolean);
begin begin
Create(FDataDescription.Width, FDataDescription.Height);
FDataDescription := ARawImage.Description; FDataDescription := ARawImage.Description;
Create(FDataDescription.Width, FDataDescription.Height);
FDataOwner := ADataOwner;
FPixelData := ARawImage.Data; FPixelData := ARawImage.Data;
FPixelDataSize := ARawImage.DataSize; FPixelDataSize := ARawImage.DataSize;
FMaskData := ARawImage.Mask; FMaskData := ARawImage.Mask;
@ -1786,7 +1792,7 @@ begin
raise FPImageException.Create('Failed to create bitmaps'); raise FPImageException.Create('Failed to create bitmaps');
end; end;
procedure TLazIntfImage.SetRawImage(const RawImage: TRawImage); procedure TLazIntfImage.SetRawImage(const RawImage: TRawImage; ADataOwner: Boolean);
var var
OldRawImage: TRawImage; OldRawImage: TRawImage;
begin begin
@ -1800,6 +1806,7 @@ begin
FPixelDataSize:=RawImage.DataSize; FPixelDataSize:=RawImage.DataSize;
FMaskData:=RawImage.Mask; FMaskData:=RawImage.Mask;
FMaskDataSize:=RawImage.MaskSize; FMaskDataSize:=RawImage.MaskSize;
FDataOwner := ADataOwner;
SetSize(FDataDescription.Width,FDataDescription.Height); SetSize(FDataDescription.Width,FDataDescription.Height);
fCreateAllDataNeeded:=false; fCreateAllDataNeeded:=false;
CreateRawImageLineStarts(Width,Height,FDataDescription.BitsPerPixel, CreateRawImageLineStarts(Width,Height,FDataDescription.BitsPerPixel,
@ -1979,12 +1986,13 @@ end;
procedure TLazIntfImage.CopyPixels(Src: TFPCustomImage); procedure TLazIntfImage.CopyPixels(Src: TFPCustomImage);
var var
y: Integer; x, y, xStop, yStop: Integer;
x: Integer;
SrcImg: TLazIntfImage; SrcImg: TLazIntfImage;
begin begin
{
if (Src.Width<>Width) or (Src.Height<>Height) then if (Src.Width<>Width) or (Src.Height<>Height) then
SetSize(Src.Width,Src.Height); SetSize(Src.Width,Src.Height);
}
if Src is TLazIntfImage then begin if Src is TLazIntfImage then begin
SrcImg:=TLazIntfImage(Src); SrcImg:=TLazIntfImage(Src);
if CompareMem(@FDataDescription,@SrcImg.FDataDescription, if CompareMem(@FDataDescription,@SrcImg.FDataDescription,
@ -2000,8 +2008,16 @@ begin
end; end;
// copy pixels // copy pixels
for y:=0 to Height-1 do xStop := SrcImg.FDataDescription.Width;
for x:=0 to Width-1 do if Width < xStop
then xStop := Width;
yStop := SrcImg.FDataDescription.Height;
if Height < yStop
then yStop := Height;
Dec(xStop);
Dec(yStop);
for y:=0 to yStop do
for x:=0 to xStop do
Colors[x,y]:=Src.Colors[x,y]; Colors[x,y]:=Src.Colors[x,y];
end; end;