started reading TImageList in Delphi format

git-svn-id: trunk@5143 -

lcl/graphics.pp

@@ -900,14 +900,12 @@ type
     procedure UnshareImage;
     procedure FreeSaveStream;
     procedure ReadData(Stream: TStream); override;
-    procedure ReadStream(Stream: TStream; Size: Longint); virtual;
     procedure SetWidthHeight(NewWidth, NewHeight: integer); virtual;
     procedure SetHeight(NewHeight: Integer); override;
     procedure SetPalette(Value: HPALETTE); override;
     procedure SetTransparentMode(Value: TTransparentMode);
     procedure SetWidth(NewWidth: Integer); override;
     procedure WriteData(Stream: TStream); override;
-    procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual;
     procedure StoreOriginalStream(Stream: TStream; Size: integer); virtual;
     {$IFDEF UseFPImage}
     procedure ReadStreamWithFPImage(Stream: TStream; Size: Longint;
@@ -936,6 +934,8 @@ type
     Procedure LoadFromXPMFile(const Filename : String);
     procedure Mask(ATransparentColor: TColor);
     procedure SaveToStream(Stream: TStream); override;
+    procedure ReadStream(Stream: TStream; Size: Longint); virtual;
+    procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual;
     Function ReleaseHandle: HBITMAP;
     function ReleasePalette: HPALETTE;
     {$IFDEF UseFPImage}
@@ -1261,6 +1261,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.106  2004/02/02 19:13:31  mattias
+  started reading TImageList in Delphi format
+
   Revision 1.105  2004/02/02 15:46:19  mattias
   implemented basic TSplitter, still many ToDos
 

lcl/imglist.pp

@@ -50,7 +50,8 @@ interface
 {$endif}
 
 uses
-  SysUtils, Classes, LCLStrConsts, vclGlobals, Graphics, GraphType;
+  SysUtils, Classes, FPCAdds, LCLStrConsts, vclGlobals, LCLProc, Graphics,
+  GraphType;
 
 type
   TImageIndex = type integer;
@@ -94,13 +95,19 @@ type
       
       So a lot ToDo.
   }
+  TDrawingStyle = (dsFocus, dsSelected, dsNormal, dsTransparent);
+  TImageType = (itImage, itMask);
+
   TCustomImageList = Class(TComponent)
   private
+    FDrawingStyle: TDrawingStyle;
     FImageList : TList;  //shane
     FBitmap: TBitmap;
+    FImageType: TImageType;
     FMaskBitmap: TBitmap;
     FHeight: Integer;
     FMasked: boolean;
+    FShareImages: Boolean;
     FWidth: Integer;
     FAllocBy: Integer;
     FCount: Integer;
@@ -110,28 +117,40 @@ type
     FChangeLinkList: TList;
     FBkColor: TColor;
     FHandle: THandle;
+    FChanged: boolean;
     procedure AllocBitmap(Amount: Integer);
     procedure NotifyChangeLink;
     procedure SetBkColor(const Value: TColor);
+    procedure SetDrawingStyle(const AValue: TDrawingStyle);
     procedure SetHeight(const Value: Integer);
     procedure SetMasked(const AValue: boolean);
+    procedure SetShareImages(const AValue: Boolean);
     procedure SetWidth(const Value: Integer);
 
     Function GetCount: Integer;
 
     procedure ShiftImages(const Source: TCanvas; Start, Shift: Integer);
   protected
+    FUpdateCount: integer;
     procedure GetImages(Index: Integer; const Image, Mask: TBitmap);
     procedure Initialize; virtual;
     procedure DefineProperties(Filer: TFiler); override;
+    procedure SetWidthHeight(NewWidth,NewHeight: integer); virtual;
+    procedure ReadDelphi2Stream(Stream: TStream);
+    procedure ReadDelphi3Stream(Stream: TStream);
   public
     constructor Create(AOwner: TComponent); override;
 
+    procedure AssignTo(Dest: TPersistent); override;
     procedure Assign(Source: TPersistent); override;
     procedure WriteData(Stream: TStream); virtual;
     procedure ReadData(Stream: TStream); virtual;
+    procedure BeginUpdate;
+    procedure EndUpdate;
 
-    function Add(Image, Mask: TBitmap): Integer;
+    function Add(Image, Mask: TBitmap): Integer; // currently AddDirect
+    function AddDirect(Image, Mask: TBitmap): Integer;
+    function AddCopy(SrcImage, SrcMask: TBitmap): Integer;
     function AddIcon(Image: TIcon): Integer;
     procedure AddImages(Value: TCustomImageList);
     function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
@@ -160,6 +179,7 @@ type
     property BlendColor: TColor read FBlendColor write FBlendColor default clNone;
     property BkColor: TColor read FBkColor write SetBkColor default clNone;
     property Count: Integer read GetCount;
+    property DrawingStyle: TDrawingStyle read FDrawingStyle write SetDrawingStyle default dsNormal;
     property Handle: THandle read FHandle;
     property Height: Integer read FHeight write SetHeight default 16;
     property Width: Integer read FWidth write SetWidth default 16;
@@ -167,6 +187,8 @@ type
     property Masked: boolean read FMasked write SetMasked;
     property Bitmap: TBitmap read FBitmap;
     property MaskBitmap: TBitmap read FMaskBitmap;
+    property ShareImages: Boolean read FShareImages write SetShareImages;
+    property ImageType: TImageType read FImageType write FImageType default itImage;
   end;
 
 
@@ -188,6 +210,9 @@ end.
 
 {
   $Log$
+  Revision 1.14  2004/02/02 19:13:31  mattias
+  started reading TImageList in Delphi format
+
   Revision 1.13  2004/02/02 16:59:28  mattias
   more Actions  TAction, TBasicAction, ...
 

lcl/include/imglist.inc

@@ -50,6 +50,11 @@ end;
   If Mask is nil, the image has no transparent parts.
  ------------------------------------------------------------------------------}
 function TCustomImageList.Add(Image, Mask: TBitmap): Integer;
+begin
+  Result:=AddDirect(Image,Mask);
+end;
+
+function TCustomImageList.AddDirect(Image, Mask: TBitmap): Integer;
 begin
   try
     Result := Count;
@@ -63,6 +68,27 @@ begin
   end;
 end;
 
+function TCustomImageList.AddCopy(SrcImage, SrcMask: TBitmap): Integer;
+var
+  NewImage: TBitmap;
+  NewMask: TBitmap;
+begin
+  NewImage:=nil;
+  NewMask:=nil;
+  try
+    NewImage:=TBitmap.Create;
+    NewMask:=TBitmap.Create;
+    NewImage := TBitmap.Create;
+    NewImage.Assign(SrcImage);
+    NewMask := TBitmap.Create;
+    NewMask.Assign(SrcMask);
+  finally
+    NewImage.Free;
+    NewMask.Free;
+  end;
+  Result:=AddDirect(NewImage, NewMask);
+end;
+
 {------------------------------------------------------------------------------
   Function: TCustomImageList.AddIcon
   Params:   Image: the Icon to be added;
@@ -91,36 +117,28 @@ var
   n: Integer;
   Image, Mask: TBitmap;
 begin
-  //!!! check one or more
+  if Value = nil then exit;
-  if Value <> nil 
+  Image:=nil;
-  then begin
+  Mask:=nil;
+  try
     Image := TBitmap.Create;
-    try
+    with Image do begin
-      with Image do
+      Height := FHeight;
-      begin
+      Width := FWidth;
-        Height := FHeight;
-        Width := FWidth;
-      end;
-      Mask := TBitmap.Create;
-      try
-        with Mask do
-        begin
-          Height := FHeight;
-          Width := FWidth;
-        end;
-        with Value do 
-          for n := 0 to Count - 1 do 
-        begin
-          GetImages(n, Image, Mask);
-          Add(Image, Mask);
-        end;
-        Change;
-      finally
-        Mask.Free;
-      end;
-    finally
-      Image.Free;
     end;
+    Mask := TBitmap.Create;
+    with Mask do begin
+      Height := FHeight;
+      Width := FWidth;
+    end;
+    for n := 0 to Count - 1 do begin
+      Value.GetImages(n, Image, Mask);
+      Add(Image, Mask);
+    end;
+    Change;
+  finally
+    Image.Free;
+    Mask.Free;
   end;
 end;
 
@@ -184,6 +202,8 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCustomImageList.Change;
 begin
+  FChanged := true;
+  if FUpdateCount > 0 then exit;
   NotifyChangeLink;
   if Assigned(FOnChange) then FOnChange(Self);
 end;
@@ -220,6 +240,14 @@ begin
   Initialize;
 end;
 
+procedure TCustomImageList.AssignTo(Dest: TPersistent);
+begin
+  if Dest is TCustomImageList then
+    TCustomImageList(Dest).Assign(Self)
+  else
+    inherited AssignTo(Dest);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCustomImageList.CreateSize
   Params:  AHeight: The height of an image 
@@ -317,7 +345,7 @@ end;
            Image: a bitmap as a container for the bitmap
   Returns: Nothing
 
-  Fetches the index'th image into a bitmap.
+  Creates a copy of the index'th image.
  ------------------------------------------------------------------------------}
 procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap);
 Var Stream : TMemoryStream;
@@ -337,13 +365,6 @@ begin
       Stream.Free;
     end;
   end;
-  {with Image do
-  begin
-    Width := FWidth;
-    Height := FHeight;
-    Self.Draw(Canvas, 0, 0, Index, True);
-  end;
-  }
 end;
 
 {------------------------------------------------------------------------------
@@ -435,7 +456,7 @@ end;
  ------------------------------------------------------------------------------}
 function TCustomImageList.HandleAllocated: Boolean;
 begin
-  Result := FBitmap <> nil;
+  Result := (FBitmap <> nil);
 end;
 
 {------------------------------------------------------------------------------
@@ -470,23 +491,6 @@ begin
   end;
 end;
 
-Type
-  THackBitMap = Class(TBitMap)
-  public
-    procedure ReadData(Stream : TStream); override;
-    procedure WriteData(Stream : TStream); override;
-  end;
-  
-procedure THackBitMap.ReadData(Stream : TStream);
-begin
-  Inherited ReadData(Stream);
-end;
-
-procedure THackBitMap.WriteData(Stream : TStream);
-begin
-  Inherited WriteData(Stream);
-end;
-
 procedure TCustomImageList.DefineProperties(Filer: TFiler);
 
   function DoWrite: Boolean;
@@ -506,33 +510,99 @@ begin
   Filer.DefineBinaryProperty('Bitmap', @ReadData, @WriteData, DoWrite);
 end;
 
+procedure TCustomImageList.SetWidthHeight(NewWidth, NewHeight: integer);
+begin
+  if (FHeight=NewHeight) and (FWidth=NewWidth) then exit;
+  FHeight := NewHeight;
+  FWidth := NewWidth;
+  FBitMap.Width := 0;
+  FBitMap.Height := 0;
+  AllocBitmap(0);
+  Clear;
+end;
+
+procedure TCustomImageList.ReadDelphi2Stream(Stream: TStream);
+var
+  FullImage, Image, FullMask, Mask: TBitmap;
+  I, J, Size, NewCount: Integer;
+  SrcRect: TRect;
+  Pos: TStreamSeekType;
+begin
+  FullImage := nil;
+  FullMask := nil;
+  Stream.ReadBuffer(Size, SizeOf(Size));
+  Stream.ReadBuffer(NewCount, SizeOf(NewCount));
+  try
+    Pos := Stream.Position;
+    // read FullImage
+    FullImage := TBitmap.Create;
+    FullImage.LoadFromStream(Stream);
+    Stream.Position := Pos + Size;
+    // read FullMask
+    FullMask := TBitmap.Create;
+    FullMask.LoadFromStream(Stream);
+    SrcRect := Rect(0, 0, Width, Height);
+    BeginUpdate;
+    try
+      for J := 0 to (FullImage.Height div Height) - 1 do
+      begin
+        if NewCount = 0 then Break;
+        for I := 0 to (FullImage.Width div Width) - 1 do
+        begin
+          if NewCount = 0 then Break;
+          Image := TBitmap.Create;
+          Image.Width := Width;
+          Image.Height := Height;
+          Mask := TBitmap.Create;
+          Mask.Monochrome := True;
+          Mask.Width := Width;
+          Mask.Height := Height;
+          Image.Canvas.CopyRect(SrcRect, FullImage.Canvas,
+            Bounds(I * Width, J * Height, Width, Height));
+          Mask.Canvas.CopyRect(SrcRect, FullMask.Canvas,
+            Bounds(I * Width, J * Height, Width, Height));
+          AddDirect(Image, Mask);
+          Image:=nil;
+          Mask:=nil;
+          Dec(NewCount);
+        end;
+      end;
+    finally
+      Image.Free;
+      Mask.Free;
+      EndUpdate;
+    end;
+  finally
+    FullMask.Free;
+    FullImage.Free;
+  end;
+end;
+
+procedure TCustomImageList.ReadDelphi3Stream(Stream: TStream);
+begin
+  // ToDo
+end;
+
 //Very simple assign with stream exchange
 procedure TCustomImageList.Assign(Source: TPersistent);
-Var Stream : TMemoryStream;
+Var
-    ImgSrc : TCustomImageList;
+  ImgSrc : TCustomImageList;
 begin
+  if (Source=Self) then exit;
   If Source is TCustomImageList then
   begin
     ImgSrc:=TCustomImageList(Source);
-    If (Width=ImgSrc.Width) and (Height=ImgSrc.Height) then
+    SetWidthHeight(ImgSrc.Width,ImgSrc.Height);
-    begin
+    Clear;
-      Clear;
+    AddImages(ImgSrc);
-      Stream:=TMemoryStream.Create;
-      try
-        ImgSrc.WriteData(Stream);
-        Stream.Position:=0;
-        ReadData(Stream);
-      finally
-        Stream.Free;
-      end;
-    end;
   end
   else inherited Assign(Source);
 end;
 
 procedure TCustomImageList.WriteData(Stream: TStream);
-Var Bmp     : THackBitMap;
+var
-    i       : Integer;
+  CurImage, CurMask: TBitMap;
+  i: Integer;
 begin
   //Write signature
   Stream.WriteWord($0001);
@@ -542,34 +612,64 @@ begin
 
   for i:=0 to Count-1 do
   begin
-    Bmp:=THackBitMap.Create;
+    GetInternalImage(i,CurImage,CurMask);
-    Bmp.Width:=Width;
+    CurImage.WriteStream(Stream,true);
-    Bmp.Height:=Height;
-    Try
-      GetBitmap(i,Bmp);
-      Bmp.WriteData(Stream);
-    finally
-      Bmp.Free;
-    end;
   end;
 end;
 
 procedure TCustomImageList.ReadData(Stream: TStream);
-Var Bmp     : THackBitMap;
+var
-    i       : LongInt;
+  CheckInt1, CheckInt2: Integer;
-    Sign,Nb : Word;
+  CheckByte1, CheckByte2: Byte;
+  StreamPos: TStreamSeekType;
+  NewImage, NewMask: TBitMap;
+  i       : integer;
+  Sign,NewCount : Word;
+  CurSize: integer;
 begin
+  Clear;
+  StreamPos := Stream.Position;                // check stream signature to
   Sign:=Stream.ReadWord;
-  if Sign=$0001 then
+  if Sign=$0001 then begin
-  begin
+    // LCL format
-      Nb:=Stream.ReadWord;
+    NewCount:=Stream.ReadWord;
-      for i:=0 to Nb-1 do
+    for i:=0 to NewCount-1 do begin
-      begin
+      NewImage:=TBitMap.Create;
-        Bmp:=THackBitMap.Create;
+      Stream.Read(CurSize, SizeOf(CurSize));
-        Bmp.ReadData(Stream);
+      NewImage.ReadStream(Stream,CurSize);
-        Bmp.Transparent:=True;
+      NewImage.Transparent:=True;
-        Add(Bmp,nil);
+      AddDirect(NewImage,nil);
-      end;
+    end;
+
+  end else begin
+    // Delphi formats
+    Stream.Position := StreamPos;              // check stream signature to
+    Stream.Read(CheckInt1, SizeOf(CheckInt1)); // determine a Delphi 2 or Delphi
+    Stream.Read(CheckInt2, SizeOf(CheckInt2)); // 3 imagelist stream.  Delphi 2
+    CheckByte1 := Lo(CheckInt1);       // streams can be read, but only
+    CheckByte2 := Hi(CheckInt1);       // Delphi 3 streams will be written
+    Stream.Position := StreamPos;
+    if (CheckInt1 <> CheckInt2) and (CheckByte1 = $49) and (CheckByte2 = $4C)
+    then
+      ReadDelphi3Stream(Stream)
+    else
+      ReadDelphi2Stream(Stream);
+  end;
+end;
+
+procedure TCustomImageList.BeginUpdate;
+begin
+  inc(FUpdateCount);
+end;
+
+procedure TCustomImageList.EndUpdate;
+begin
+  if FUpdateCount<=0 then
+    RaiseGDBException('');
+  dec(FUpdateCount);
+  if FChanged then begin
+    FChanged := False;
+    Change;
   end;
 end;
 
@@ -714,35 +814,10 @@ end;
   Moves an image from the CurIndex'th location to NewIndex'th location
  ------------------------------------------------------------------------------}
 procedure TCustomImageList.Move(CurIndex, NewIndex: Integer);
-var
-  Image, Mask: TBitmap;
 begin
-  if CurIndex <> NewIndex then
+  if CurIndex <> NewIndex then begin
-  begin
+    FImageList.Move(CurIndex,NewIndex);
-    Image := TBitmap.Create;
+    Change;
-    try
-      with Image do
-      begin
-        Height := FHeight;
-        Width := FWidth;
-      end;
-      Mask := TBitmap.Create;
-      try
-        with Mask do
-        begin
-          Height := FHeight;
-          Width := FWidth;
-        end;
-        GetImages(CurIndex, Image, Mask);
-        Delete(CurIndex);
-        Insert(NewIndex, Image, Mask);
-        Change;
-      finally
-        Mask.Free;
-      end;
-    finally
-      Image.Free;
-    end;
   end;
 end;
 
@@ -862,6 +937,12 @@ begin
   end;
 end;
 
+procedure TCustomImageList.SetDrawingStyle(const AValue: TDrawingStyle);
+begin
+  if FDrawingStyle=AValue then exit;
+  FDrawingStyle:=AValue;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCustomImageList.SetHeight
   Params:  Value: the height of an image
@@ -872,13 +953,7 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCustomImageList.SetHeight(const Value: Integer);
 begin
-  if FHeight <> Value
+  SetWidthHeight(Width,Value);
-  then begin
-    FHeight := Value;
-    FBitMap.Height := 0;
-    AllocBitmap(0);
-    Clear;
-  end;
 end;
 
 procedure TCustomImageList.SetMasked(const AValue: boolean);
@@ -887,6 +962,12 @@ begin
   FMasked:=AValue;
 end;
 
+procedure TCustomImageList.SetShareImages(const AValue: Boolean);
+begin
+  if FShareImages=AValue then exit;
+  FShareImages:=AValue;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCustomImageList.SetWidth
   Params:  Value: the width of an image
@@ -897,13 +978,7 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCustomImageList.SetWidth(const Value: Integer);
 begin
-  if FWidth <> Value
+  SetWidthHeight(Value,Height);
-  then begin
-    FWidth := Value;
-    FBitmap.Width := FWidth;
-    FMaskBitmap.Width := FWidth;
-    Clear;
-  end;
 end;
 
 {------------------------------------------------------------------------------
@@ -991,6 +1066,9 @@ end;
 {
 
   $Log$
+  Revision 1.21  2004/02/02 19:13:31  mattias
+  started reading TImageList in Delphi format
+
   Revision 1.20  2004/02/02 16:59:28  mattias
   more Actions  TAction, TBasicAction, ...