X-Git-Url: http://deadsoftware.ru/gitweb?p=d2df-sdl.git;a=blobdiff_plain;f=src%2Flib%2Fvampimg%2FImagingClasses.pas;h=b196fdd1048689ef64c73ba6831f65b9c7f59c3c;hp=c00c105c5323ba3d0d511b339c674abd1d4fb129;hb=48fffe15692e9dcd2bdc2ed64f6e998af13211cf;hpb=ecfa6c6b626717711a8ae93cc455f69f0048498a diff --git a/src/lib/vampimg/ImagingClasses.pas b/src/lib/vampimg/ImagingClasses.pas index c00c105..b196fdd 100644 --- a/src/lib/vampimg/ImagingClasses.pas +++ b/src/lib/vampimg/ImagingClasses.pas @@ -1,5 +1,4 @@ { - $Id: ImagingClasses.pas 173 2009-09-04 17:05:52Z galfar $ Vampyre Imaging Library by Marek Mauder http://imaginglib.sourceforge.net @@ -40,29 +39,31 @@ type { Base abstract high level class wrapper to low level Imaging structures and functions.} TBaseImage = class(TPersistent) + private + function GetEmpty: Boolean; protected FPData: PImageData; FOnDataSizeChanged: TNotifyEvent; FOnPixelsChanged: TNotifyEvent; function GetFormat: TImageFormat; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetHeight: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetSize: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetWidth: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetHeight: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetSize: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetWidth: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} function GetBits: Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF} function GetPalette: PPalette32; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetPaletteEntries: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetScanLine(Index: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetPixelPointer(X, Y: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetPaletteEntries: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetScanline(Index: Integer): Pointer; + function GetPixelPointer(X, Y: Integer): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetScanlineSize: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} function GetFormatInfo: TImageFormatInfo; {$IFDEF USE_INLINE}inline;{$ENDIF} function GetValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} function GetBoundsRect: TRect; procedure SetFormat(const Value: TImageFormat); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetHeight(const Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetWidth(const Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF} + procedure SetHeight(const Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} + procedure SetWidth(const Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} procedure SetPointer; virtual; abstract; procedure DoDataSizeChanged; virtual; procedure DoPixelsChanged; virtual; - published public constructor Create; virtual; constructor CreateFromImage(AImage: TBaseImage); @@ -72,9 +73,18 @@ type { Creates a new image data with the given size and format. Old image data is lost. Works only for the current image of TMultiImage.} - procedure RecreateImageData(AWidth, AHeight: LongInt; AFormat: TImageFormat); + procedure RecreateImageData(AWidth, AHeight: Integer; AFormat: TImageFormat); + { Maps underlying image data to given TImageData record. Both TBaseImage and + TImageData now share some image memory (bits). So don't call FreeImage + on TImageData afterwards since this TBaseImage would get really broken.} + procedure MapImageData(const ImageData: TImageData); + { Deletes current image.} + procedure Clear; + { Resizes current image with optional resampling.} - procedure Resize(NewWidth, NewHeight: LongInt; Filter: TResizeFilter); + procedure Resize(NewWidth, NewHeight: Integer; Filter: TResizeFilter); + + procedure ResizeToFit(FitWidth, FitHeight: Integer; Filter: TResizeFilter; DstImage: TBaseImage); { Flips current image. Reverses the image along its horizontal axis the top becomes the bottom and vice versa.} procedure Flip; @@ -88,21 +98,21 @@ type negative X and Y coordinates. Note that copying is fastest for images in the same data format (and slowest for images in special formats).} - procedure CopyTo(SrcX, SrcY, Width, Height: LongInt; DstImage: TBaseImage; DstX, DstY: LongInt); + procedure CopyTo(SrcX, SrcY, Width, Height: Integer; DstImage: TBaseImage; DstX, DstY: Integer); { Stretches the contents of the source rectangle to the destination rectangle with optional resampling. No blending is performed - alpha is simply copied/resampled to destination image. Note that stretching is fastest for images in the same data format (and slowest for images in special formats).} - procedure StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: LongInt; DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter); + procedure StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: Integer; DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: Integer; Filter: TResizeFilter); { Replaces pixels with OldPixel in the given rectangle by NewPixel. OldPixel and NewPixel should point to the pixels in the same format as the given image is in.} - procedure ReplaceColor(X, Y, Width, Height: LongInt; OldColor, NewColor: Pointer); + procedure ReplaceColor(X, Y, Width, Height: Integer; OldColor, NewColor: Pointer); { Swaps SrcChannel and DstChannel color or alpha channels of image. Use ChannelRed, ChannelBlue, ChannelGreen, ChannelAlpha constants to identify channels.} - procedure SwapChannels(SrcChannel, DstChannel: LongInt); + procedure SwapChannels(SrcChannel, DstChannel: Integer); { Loads current image data from file.} procedure LoadFromFile(const FileName: string); virtual; @@ -116,25 +126,27 @@ type procedure SaveToStream(const Ext: string; Stream: TStream); { Width of current image in pixels.} - property Width: LongInt read GetWidth write SetWidth; + property Width: Integer read GetWidth write SetWidth; { Height of current image in pixels.} - property Height: LongInt read GetHeight write SetHeight; + property Height: Integer read GetHeight write SetHeight; { Image data format of current image.} property Format: TImageFormat read GetFormat write SetFormat; { Size in bytes of current image's data.} - property Size: LongInt read GetSize; + property Size: Integer read GetSize; { Pointer to memory containing image bits.} property Bits: Pointer read GetBits; { Pointer to palette for indexed format images. It is nil for others. Max palette entry is at index [PaletteEntries - 1].} property Palette: PPalette32 read GetPalette; { Number of entries in image's palette} - property PaletteEntries: LongInt read GetPaletteEntries; + property PaletteEntries: Integer read GetPaletteEntries; { Provides indexed access to each line of pixels. Does not work with special format images (like DXT).} - property ScanLine[Index: LongInt]: Pointer read GetScanLine; + property Scanline[Index: Integer]: Pointer read GetScanline; { Returns pointer to image pixel at [X, Y] coordinates.} - property PixelPointers[X, Y: LongInt]: Pointer read GetPixelPointer; + property PixelPointer[X, Y: Integer]: Pointer read GetPixelPointer; + { Size/length of one image scanline in bytes.} + property ScanlineSize: Integer read GetScanlineSize; { Extended image format information.} property FormatInfo: TImageFormatInfo read GetFormatInfo; { This gives complete access to underlying TImageData record. @@ -144,7 +156,9 @@ type { Indicates whether the current image is valid (proper format, allowed dimensions, right size, ...).} property Valid: Boolean read GetValid; - {{ Specifies the bounding rectangle of the image.} + { Indicates whether image containst any data (size in bytes > 0).} + property Empty: Boolean read GetEmpty; + { Specifies the bounding rectangle of the image.} property BoundsRect: TRect read GetBoundsRect; { This event occurs when the image data size has just changed. That means image width, height, or format has been changed.} @@ -161,13 +175,15 @@ type procedure SetPointer; override; public constructor Create; override; - constructor CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); + constructor CreateFromParams(AWidth, AHeight: Integer; AFormat: TImageFormat = ifDefault); constructor CreateFromData(const AData: TImageData); constructor CreateFromFile(const FileName: string); constructor CreateFromStream(Stream: TStream); destructor Destroy; override; { Assigns single image from another single image or multi image.} procedure Assign(Source: TPersistent); override; + { Assigns single image from image data record.} + procedure AssignFromImageData(const AImageData: TImageData); end; { Extension of TBaseImage which uses array of TImageData records to @@ -180,34 +196,36 @@ type TMultiImage = class(TBaseImage) protected FDataArray: TDynImageDataArray; - FActiveImage: LongInt; - procedure SetActiveImage(Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetImageCount: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetImageCount(Value: LongInt); + FActiveImage: Integer; + procedure SetActiveImage(Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetImageCount: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} + procedure SetImageCount(Value: Integer); function GetAllImagesValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetImage(Index: LongInt): TImageData; {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetImage(Index: LongInt; Value: TImageData); {$IFDEF USE_INLINE}inline;{$ENDIF} + function GetImage(Index: Integer): TImageData; {$IFDEF USE_INLINE}inline;{$ENDIF} + procedure SetImage(Index: Integer; Value: TImageData); {$IFDEF USE_INLINE}inline;{$ENDIF} procedure SetPointer; override; - function PrepareInsert(Index, Count: LongInt): Boolean; - procedure DoInsertImages(Index: LongInt; const Images: TDynImageDataArray); - procedure DoInsertNew(Index: LongInt; AWidth, AHeight: LongInt; AFormat: TImageFormat); + function PrepareInsert(Index, Count: Integer): Boolean; + procedure DoInsertImages(Index: Integer; const Images: TDynImageDataArray); + procedure DoInsertNew(Index: Integer; AWidth, AHeight: Integer; AFormat: TImageFormat); public constructor Create; override; - constructor CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat; Images: LongInt); - constructor CreateFromArray(ADataArray: TDynImageDataArray); + constructor CreateFromParams(AWidth, AHeight: Integer; AFormat: TImageFormat; ImageCount: Integer); + constructor CreateFromArray(const ADataArray: TDynImageDataArray); constructor CreateFromFile(const FileName: string); constructor CreateFromStream(Stream: TStream); destructor Destroy; override; { Assigns multi image from another multi image or single image.} procedure Assign(Source: TPersistent); override; + { Assigns multi image from array of image data records.} + procedure AssignFromArray(const ADataArray: TDynImageDataArray); { Adds new image at the end of the image array. } - procedure AddImage(AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); overload; + function AddImage(AWidth, AHeight: Integer; AFormat: TImageFormat = ifDefault): Integer; overload; { Adds existing image at the end of the image array. } - procedure AddImage(const Image: TImageData); overload; + function AddImage(const Image: TImageData): Integer; overload; { Adds existing image (Active image of a TmultiImage) at the end of the image array. } - procedure AddImage(Image: TBaseImage); overload; + function AddImage(Image: TBaseImage): Integer; overload; { Adds existing image array ((all images of a multi image)) at the end of the image array. } procedure AddImages(const Images: TDynImageDataArray); overload; @@ -215,29 +233,31 @@ type procedure AddImages(Images: TMultiImage); overload; { Inserts new image image at the given position in the image array. } - procedure InsertImage(Index, AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); overload; + procedure InsertImage(Index, AWidth, AHeight: Integer; AFormat: TImageFormat = ifDefault); overload; { Inserts existing image at the given position in the image array. } - procedure InsertImage(Index: LongInt; const Image: TImageData); overload; + procedure InsertImage(Index: Integer; const Image: TImageData); overload; { Inserts existing image (Active image of a TmultiImage) at the given position in the image array. } - procedure InsertImage(Index: LongInt; Image: TBaseImage); overload; + procedure InsertImage(Index: Integer; Image: TBaseImage); overload; { Inserts existing image at the given position in the image array. } - procedure InsertImages(Index: LongInt; const Images: TDynImageDataArray); overload; + procedure InsertImages(Index: Integer; const Images: TDynImageDataArray); overload; { Inserts existing images (all images of a TmultiImage) at the given position in the image array. } - procedure InsertImages(Index: LongInt; Images: TMultiImage); overload; + procedure InsertImages(Index: Integer; Images: TMultiImage); overload; { Exchanges two images at the given positions in the image array. } - procedure ExchangeImages(Index1, Index2: LongInt); + procedure ExchangeImages(Index1, Index2: Integer); { Deletes image at the given position in the image array.} - procedure DeleteImage(Index: LongInt); + procedure DeleteImage(Index: Integer); { Rearranges images so that the first image will become last and vice versa.} procedure ReverseImages; + { Deletes all images.} + procedure ClearAll; { Converts all images to another image data format.} procedure ConvertImages(Format: TImageFormat); { Resizes all images.} - procedure ResizeImages(NewWidth, NewHeight: LongInt; Filter: TResizeFilter); + procedure ResizeImages(NewWidth, NewHeight: Integer; Filter: TResizeFilter); { Overloaded loading method that will add new image to multiimage if image array is empty bero loading. } @@ -258,9 +278,9 @@ type { Indicates active image of this multi image. All methods inherited from TBaseImage operate on this image only.} - property ActiveImage: LongInt read FActiveImage write SetActiveImage; + property ActiveImage: Integer read FActiveImage write SetActiveImage; { Number of images of this multi image.} - property ImageCount: LongInt read GetImageCount write SetImageCount; + property ImageCount: Integer read GetImageCount write SetImageCount; { This value is True if all images of this TMultiImage are valid.} property AllImagesValid: Boolean read GetAllImagesValid; { This gives complete access to underlying TDynImageDataArray. @@ -269,15 +289,14 @@ type property DataArray: TDynImageDataArray read FDataArray; { Array property for accessing individual images of TMultiImage. When you set image at given index the old image is freed and the source is cloned.} - property Images[Index: LongInt]: TImageData read GetImage write SetImage; default; + property Images[Index: Integer]: TImageData read GetImage write SetImage; default; end; implementation const - DefaultWidth = 16; - DefaultHeight = 16; - DefaultImages = 1; + DefaultWidth = 16; + Defaultheight = 16; function GetArrayFromImageData(const ImageData: TImageData): TDynImageDataArray; begin @@ -303,7 +322,7 @@ begin inherited Destroy; end; -function TBaseImage.GetWidth: LongInt; +function TBaseImage.GetWidth: Integer; begin if Valid then Result := FPData.Width @@ -311,7 +330,7 @@ begin Result := 0; end; -function TBaseImage.GetHeight: LongInt; +function TBaseImage.GetHeight: Integer; begin if Valid then Result := FPData.Height @@ -327,7 +346,7 @@ begin Result := ifUnknown; end; -function TBaseImage.GetScanLine(Index: LongInt): Pointer; +function TBaseImage.GetScanline(Index: Integer): Pointer; var Info: TImageFormatInfo; begin @@ -343,7 +362,15 @@ begin Result := nil; end; -function TBaseImage.GetPixelPointer(X, Y: LongInt): Pointer; +function TBaseImage.GetScanlineSize: Integer; +begin + if Valid then + Result := FormatInfo.GetPixelsSize(Format, Width, 1) + else + Result := 0; +end; + +function TBaseImage.GetPixelPointer(X, Y: Integer): Pointer; begin if Valid then Result := @PByteArray(FPData.Bits)[(Y * FPData.Width + X) * GetFormatInfo.BytesPerPixel] @@ -351,7 +378,7 @@ begin Result := nil; end; -function TBaseImage.GetSize: LongInt; +function TBaseImage.GetSize: Integer; begin if Valid then Result := FPData.Size @@ -375,7 +402,7 @@ begin Result := nil; end; -function TBaseImage.GetPaletteEntries: LongInt; +function TBaseImage.GetPaletteEntries: Integer; begin Result := GetFormatInfo.PaletteEntries; end; @@ -398,12 +425,17 @@ begin Result := Rect(0, 0, GetWidth, GetHeight); end; -procedure TBaseImage.SetWidth(const Value: LongInt); +function TBaseImage.GetEmpty: Boolean; +begin + Result := FPData.Size = 0; +end; + +procedure TBaseImage.SetWidth(const Value: Integer); begin Resize(Value, GetHeight, rfNearest); end; -procedure TBaseImage.SetHeight(const Value: LongInt); +procedure TBaseImage.SetHeight(const Value: Integer); begin Resize(GetWidth, Value, rfNearest); end; @@ -427,18 +459,45 @@ begin FOnPixelsChanged(Self); end; -procedure TBaseImage.RecreateImageData(AWidth, AHeight: LongInt; AFormat: TImageFormat); +procedure TBaseImage.RecreateImageData(AWidth, AHeight: Integer; AFormat: TImageFormat); begin if Assigned(FPData) and Imaging.NewImage(AWidth, AHeight, AFormat, FPData^) then DoDataSizeChanged; end; -procedure TBaseImage.Resize(NewWidth, NewHeight: LongInt; Filter: TResizeFilter); +procedure TBaseImage.MapImageData(const ImageData: TImageData); +begin + Clear; + FPData.Width := ImageData.Width; + FPData.Height := ImageData.Height; + FPData.Format := ImageData.Format; + FPData.Size := ImageData.Size; + FPData.Bits := ImageData.Bits; + FPData.Palette := ImageData.Palette; +end; + +procedure TBaseImage.Clear; +begin + FreeImage(FPData^); +end; + +procedure TBaseImage.Resize(NewWidth, NewHeight: Integer; Filter: TResizeFilter); begin if Valid and Imaging.ResizeImage(FPData^, NewWidth, NewHeight, Filter) then DoDataSizeChanged; end; +procedure TBaseImage.ResizeToFit(FitWidth, FitHeight: Integer; + Filter: TResizeFilter; DstImage: TBaseImage); +begin + if Valid and Assigned(DstImage) then + begin + Imaging.ResizeImageToFit(FPData^, FitWidth, FitHeight, Filter, + DstImage.FPData^); + DstImage.DoDataSizeChanged; + end; +end; + procedure TBaseImage.Flip; begin if Valid and Imaging.FlipImage(FPData^) then @@ -453,12 +512,15 @@ end; procedure TBaseImage.Rotate(Angle: Single); begin - if Valid and Imaging.RotateImage(FPData^, Angle) then + if Valid then + begin + Imaging.RotateImage(FPData^, Angle); DoPixelsChanged; + end; end; -procedure TBaseImage.CopyTo(SrcX, SrcY, Width, Height: LongInt; - DstImage: TBaseImage; DstX, DstY: LongInt); +procedure TBaseImage.CopyTo(SrcX, SrcY, Width, Height: Integer; + DstImage: TBaseImage; DstX, DstY: Integer); begin if Valid and Assigned(DstImage) and DstImage.Valid then begin @@ -467,8 +529,8 @@ begin end; end; -procedure TBaseImage.StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: LongInt; - DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter); +procedure TBaseImage.StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: Integer; + DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: Integer; Filter: TResizeFilter); begin if Valid and Assigned(DstImage) and DstImage.Valid then begin @@ -532,10 +594,10 @@ end; constructor TSingleImage.Create; begin inherited Create; - RecreateImageData(DefaultWidth, DefaultHeight, ifDefault); + Clear; end; -constructor TSingleImage.CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat); +constructor TSingleImage.CreateFromParams(AWidth, AHeight: Integer; AFormat: TImageFormat); begin inherited Create; RecreateImageData(AWidth, AHeight, AFormat); @@ -544,13 +606,7 @@ end; constructor TSingleImage.CreateFromData(const AData: TImageData); begin inherited Create; - if Imaging.TestImage(AData) then - begin - Imaging.CloneImage(AData, FImageData); - DoDataSizeChanged; - end - else - Create; + AssignFromImageData(AData); end; constructor TSingleImage.CreateFromFile(const FileName: string); @@ -580,59 +636,57 @@ procedure TSingleImage.Assign(Source: TPersistent); begin if Source = nil then begin - Create; + Clear; end else if Source is TSingleImage then begin - CreateFromData(TSingleImage(Source).FImageData); + AssignFromImageData(TSingleImage(Source).FImageData); end else if Source is TMultiImage then begin if TMultiImage(Source).Valid then - CreateFromData(TMultiImage(Source).FPData^) + AssignFromImageData(TMultiImage(Source).FPData^) else - Assign(nil); + Clear; end else inherited Assign(Source); end; +procedure TSingleImage.AssignFromImageData(const AImageData: TImageData); +begin + if Imaging.TestImage(AImageData) then + begin + Imaging.CloneImage(AImageData, FImageData); + DoDataSizeChanged; + end + else + Clear; +end; { TMultiImage class implementation } constructor TMultiImage.Create; begin - SetImageCount(DefaultImages); - SetActiveImage(0); + inherited Create; end; -constructor TMultiImage.CreateFromParams(AWidth, AHeight: LongInt; - AFormat: TImageFormat; Images: LongInt); +constructor TMultiImage.CreateFromParams(AWidth, AHeight: Integer; + AFormat: TImageFormat; ImageCount: Integer); var - I: LongInt; + I: Integer; begin Imaging.FreeImagesInArray(FDataArray); - SetLength(FDataArray, Images); + SetLength(FDataArray, ImageCount); for I := 0 to GetImageCount - 1 do Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[I]); - SetActiveImage(0); + if GetImageCount > 0 then + SetActiveImage(0); end; -constructor TMultiImage.CreateFromArray(ADataArray: TDynImageDataArray); -var - I: LongInt; +constructor TMultiImage.CreateFromArray(const ADataArray: TDynImageDataArray); begin - Imaging.FreeImagesInArray(FDataArray); - SetLength(FDataArray, Length(ADataArray)); - for I := 0 to GetImageCount - 1 do - begin - // Clone only valid images - if Imaging.TestImage(ADataArray[I]) then - Imaging.CloneImage(ADataArray[I], FDataArray[I]) - else - Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]); - end; - SetActiveImage(0); + AssignFromArray(ADataArray); end; constructor TMultiImage.CreateFromFile(const FileName: string); @@ -651,20 +705,20 @@ begin inherited Destroy; end; -procedure TMultiImage.SetActiveImage(Value: LongInt); +procedure TMultiImage.SetActiveImage(Value: Integer); begin FActiveImage := Value; SetPointer; end; -function TMultiImage.GetImageCount: LongInt; +function TMultiImage.GetImageCount: Integer; begin Result := Length(FDataArray); end; -procedure TMultiImage.SetImageCount(Value: LongInt); +procedure TMultiImage.SetImageCount(Value: Integer); var - I, OldCount: LongInt; + I, OldCount: Integer; begin if Value > GetImageCount then begin @@ -689,13 +743,13 @@ begin Result := (GetImageCount > 0) and TestImagesInArray(FDataArray); end; -function TMultiImage.GetImage(Index: LongInt): TImageData; +function TMultiImage.GetImage(Index: Integer): TImageData; begin if (Index >= 0) and (Index < GetImageCount) then Result := FDataArray[Index]; end; -procedure TMultiImage.SetImage(Index: LongInt; Value: TImageData); +procedure TMultiImage.SetImage(Index: Integer; Value: TImageData); begin if (Index >= 0) and (Index < GetImageCount) then Imaging.CloneImage(Value, FDataArray[Index]); @@ -715,9 +769,9 @@ begin end; end; -function TMultiImage.PrepareInsert(Index, Count: LongInt): Boolean; +function TMultiImage.PrepareInsert(Index, Count: Integer): Boolean; var - I: LongInt; + I: Integer; begin // Inserting to empty image will add image at index 0 if GetImageCount = 0 then @@ -741,9 +795,9 @@ begin Result := False; end; -procedure TMultiImage.DoInsertImages(Index: LongInt; const Images: TDynImageDataArray); +procedure TMultiImage.DoInsertImages(Index: Integer; const Images: TDynImageDataArray); var - I, Len: LongInt; + I, Len: Integer; begin Len := Length(Images); if PrepareInsert(Index, Len) then @@ -753,7 +807,7 @@ begin end; end; -procedure TMultiImage.DoInsertNew(Index, AWidth, AHeight: LongInt; +procedure TMultiImage.DoInsertNew(Index, AWidth, AHeight: Integer; AFormat: TImageFormat); begin if PrepareInsert(Index, 1) then @@ -766,38 +820,62 @@ var begin if Source = nil then begin - Create; + ClearAll; end else if Source is TMultiImage then begin - CreateFromArray(TMultiImage(Source).FDataArray); + AssignFromArray(TMultiImage(Source).FDataArray); SetActiveImage(TMultiImage(Source).ActiveImage); end else if Source is TSingleImage then begin SetLength(Arr, 1); Arr[0] := TSingleImage(Source).FImageData; - CreateFromArray(Arr); - Arr := nil; + AssignFromArray(Arr); end else inherited Assign(Source); end; -procedure TMultiImage.AddImage(AWidth, AHeight: LongInt; AFormat: TImageFormat); +procedure TMultiImage.AssignFromArray(const ADataArray: TDynImageDataArray); +var + I: Integer; begin - DoInsertNew(GetImageCount, AWidth, AHeight, AFormat); + Imaging.FreeImagesInArray(FDataArray); + SetLength(FDataArray, Length(ADataArray)); + for I := 0 to GetImageCount - 1 do + begin + // Clone only valid images + if Imaging.TestImage(ADataArray[I]) then + Imaging.CloneImage(ADataArray[I], FDataArray[I]) + else + Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]); + end; + if GetImageCount > 0 then + SetActiveImage(0); end; -procedure TMultiImage.AddImage(const Image: TImageData); +function TMultiImage.AddImage(AWidth, AHeight: Integer; AFormat: TImageFormat): Integer; begin - DoInsertImages(GetImageCount, GetArrayFromImageData(Image)); + Result := GetImageCount; + DoInsertNew(Result, AWidth, AHeight, AFormat); end; -procedure TMultiImage.AddImage(Image: TBaseImage); +function TMultiImage.AddImage(const Image: TImageData): Integer; +begin + Result := GetImageCount; + DoInsertImages(Result, GetArrayFromImageData(Image)); +end; + +function TMultiImage.AddImage(Image: TBaseImage): Integer; begin if Assigned(Image) and Image.Valid then - DoInsertImages(GetImageCount, GetArrayFromImageData(Image.FPData^)); + begin + Result := GetImageCount; + DoInsertImages(Result, GetArrayFromImageData(Image.FPData^)); + end + else + Result := -1; end; procedure TMultiImage.AddImages(const Images: TDynImageDataArray); @@ -810,35 +888,35 @@ begin DoInsertImages(GetImageCount, Images.FDataArray); end; -procedure TMultiImage.InsertImage(Index, AWidth, AHeight: LongInt; +procedure TMultiImage.InsertImage(Index, AWidth, AHeight: Integer; AFormat: TImageFormat); begin DoInsertNew(Index, AWidth, AHeight, AFormat); end; -procedure TMultiImage.InsertImage(Index: LongInt; const Image: TImageData); +procedure TMultiImage.InsertImage(Index: Integer; const Image: TImageData); begin DoInsertImages(Index, GetArrayFromImageData(Image)); end; -procedure TMultiImage.InsertImage(Index: LongInt; Image: TBaseImage); +procedure TMultiImage.InsertImage(Index: Integer; Image: TBaseImage); begin if Assigned(Image) and Image.Valid then DoInsertImages(Index, GetArrayFromImageData(Image.FPData^)); end; -procedure TMultiImage.InsertImages(Index: LongInt; +procedure TMultiImage.InsertImages(Index: Integer; const Images: TDynImageDataArray); begin DoInsertImages(Index, FDataArray); end; -procedure TMultiImage.InsertImages(Index: LongInt; Images: TMultiImage); +procedure TMultiImage.InsertImages(Index: Integer; Images: TMultiImage); begin DoInsertImages(Index, Images.FDataArray); end; -procedure TMultiImage.ExchangeImages(Index1, Index2: LongInt); +procedure TMultiImage.ExchangeImages(Index1, Index2: Integer); var TempData: TImageData; begin @@ -851,9 +929,9 @@ begin end; end; -procedure TMultiImage.DeleteImage(Index: LongInt); +procedure TMultiImage.DeleteImage(Index: Integer); var - I: LongInt; + I: Integer; begin if (Index >= 0) and (Index < GetImageCount) then begin @@ -871,20 +949,25 @@ begin end; end; +procedure TMultiImage.ClearAll; +begin + ImageCount := 0; +end; + procedure TMultiImage.ConvertImages(Format: TImageFormat); var - I: LongInt; + I: Integer; begin for I := 0 to GetImageCount - 1 do Imaging.ConvertImage(FDataArray[I], Format); end; -procedure TMultiImage.ResizeImages(NewWidth, NewHeight: LongInt; +procedure TMultiImage.ResizeImages(NewWidth, NewHeight: Integer; Filter: TResizeFilter); var - I: LongInt; + I: Integer; begin - for I := 0 to GetImageCount do + for I := 0 to GetImageCount - 1 do Imaging.ResizeImage(FDataArray[I], NewWidth, NewHeight, Filter); end; @@ -937,9 +1020,21 @@ end; -- TODOS ---------------------------------------------------- - nothing now - - add SetPalette, create some pal wrapper first - - put all low level stuff here like ReplaceColor etc, change - CopyTo to Copy, and add overload Copy(SrcRect, DstX, DstY) ... + + -- 0.77.1 --------------------------------------------------- + - Added TSingleImage.AssignFromData and TMultiImage.AssigntFromArray + as a replacement for constructors used as methods (that is + compiler error in Delphi XE3). + - Added TBaseImage.ResizeToFit method. + - Changed TMultiImage to have default state with no images. + - TMultiImage.AddImage now returns index of newly added image. + - Fixed img index bug in TMultiImage.ResizeImages + + -- 0.26.5 Changes/Bug Fixes --------------------------------- + - Added MapImageData method to TBaseImage + - Added Empty property to TBaseImage. + - Added Clear method to TBaseImage. + - Added ScanlineSize property to TBaseImage. -- 0.24.3 Changes/Bug Fixes --------------------------------- - Added TMultiImage.ReverseImages method.