added support for reading cursor files from Paul Ishenin (bug #8082)

git-svn-id: trunk@10394 -

docs/Contributors.txt

@@ -62,6 +62,7 @@ Michael A. Hess
 Micha Nelissen
 Michal Bukovjan
 Olivier Guilbaud
+Paul Ishenin
 Peter Dyson
 Pierre Gillmann
 Radek Cervinka

lcl/graphics.pp

@@ -1050,7 +1050,8 @@ type
     bnNone,  // not a TBitmap native type
     bnWinBitmap,
     bnXPixmap,
-    bnIcon
+    bnIcon,
+    bnCursor
     );
   TBitmapNativeTypes = set of TBitmapNativeType;
 
@@ -1293,7 +1294,11 @@ type
     procedure AddBitmap(Bitmap: TBitmap); { Note that Ownership passes to TIcon }
   end;
 
-
+  TCursorImage = class(TIcon)
+  public
+    class function GetFileExtensions: string; override;
+    function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
+  end;
 
 function GraphicFilter(GraphicClass: TGraphicClass): string;
 function GraphicExtension(GraphicClass: TGraphicClass): string;
@@ -1362,6 +1367,7 @@ function TestStreamBitmapNativeType(const AStream: TStream): TBitmapNativeType;
 function TestStreamIsBMP(const AStream: TStream): boolean;
 function TestStreamIsXPM(const AStream: TStream): boolean;
 function TestStreamIsIcon(const AStream: TStream): boolean;
+function TestStreamIsCursor(const AStream: TStream): boolean;
 
 function XPMToPPChar(const XPM: string): PPChar;
 function LazResourceXPMToPPChar(const ResourceName: string): PPChar;
@@ -1864,6 +1870,7 @@ end;
 
 const
   IconSignature: array [0..3] of char = #0#0#1#0;
+  CursorSignature: array [0..3] of char = #0#0#2#0;
 
 function TestStreamIsIcon(const AStream: TStream): boolean;
 var
@@ -1877,6 +1884,18 @@ begin
   AStream.Position:=OldPosition;
 end;
 
+function TestStreamIsCursor(const AStream: TStream): boolean;
+var
+  Signature: array[0..3] of char;
+  ReadSize: Integer;
+  OldPosition: TStreamSeekType;
+begin
+  OldPosition:=AStream.Position;
+  ReadSize:=AStream.Read(Signature, SizeOf(Signature));
+  Result:=(ReadSize=SizeOf(Signature)) and CompareMem(@Signature,@CursorSignature,4);
+  AStream.Position:=OldPosition;
+end;
+
 procedure TIcon.ReadData(Stream: TStream);
 var
   Size: longint;
@@ -1919,6 +1938,19 @@ begin
   FBitmaps.Add(Bitmap);
 end;
 
+{ TCursorImage }
+
+class function TCursorImage.GetFileExtensions: string;
+begin
+  Result := 'cur';
+end;
+
+function TCursorImage.LazarusResourceTypeValid(const ResourceType: string): boolean;
+begin
+  Result := inherited LazarusResourceTypeValid(ResourceType) or
+            (AnsiCompareText(ResourceType,'CUR')=0);
+end;
+
 procedure InterfaceFinal;
 begin
   //debugln('Graphics.InterfaceFinal');

lcl/include/bitmap.inc

@@ -26,6 +26,8 @@ begin
     Result:=bnXPixmap
   else if TestStreamIsIcon(AStream) then
     Result := bnIcon
+  else if TestStreamIsCursor(AStream) then
+    Result := bnCursor
   else
     Result:=bnNone;
 end;
@@ -575,7 +577,7 @@ procedure TBitmap.ReadStream(Stream: TStream; UseSize: boolean; Size: Longint);
      ' Size=',dbgs(Size),' Stream.Position=',dbgs(Stream.Position),
      ' Stream.Size=',dbgs(Stream.Size));
     raise EInOutError.Create(
-      'TBitmap.ReadStream: Invalid size of bitmap stream (bmp,xpm,ico)');
+      'TBitmap.ReadStream: Invalid size of bitmap stream (bmp,xpm,ico,cur)');
   end;
 
 var
@@ -617,9 +619,10 @@ begin
     //debugln('TBitmap.ReadStream ',dbgs(ord(StreamType)),' UseSize=',dbgs(UseSize),' Size=',dbgs(Size),' Stream=',DbgSName(Stream));
     ReaderClass:=nil;
     case StreamType of
-    bnWinBitmap:  ReaderClass:=TLazReaderBMP;
-    bnXPixmap:    ReaderClass:=TLazReaderXPM;
-    bnIcon:       ReaderClass:=TLazReaderIcon;
+      bnWinBitmap:  ReaderClass:=TLazReaderBMP;
+      bnXPixmap:    ReaderClass:=TLazReaderXPM;
+      bnIcon:       ReaderClass:=TLazReaderIcon;
+      bnCursor:     ReaderClass:=TLazReaderCursor;
     else
       RaiseInvalidBitmapHeader;
     end;

lcl/intfgraphics.pas

@@ -390,6 +390,11 @@ type
     property Icon: TObject read FIcon write SetIcon;
   end;
 
+  TLazReaderCursor = class (TLazReaderIcon)
+  protected
+    function  InternalCheck(Stream: TStream) : boolean; override;
+  end;
+
 function ReadCompleteStreamToString(Str: TStream; StartSize: integer): string;
 procedure ReadCompleteStreamToStream(SrcStream, DestStream: TStream;
                                      StartSize: integer);
@@ -3601,7 +3606,7 @@ end;
 type
   TIconHeader = packed record
     idReserved: Word; {0}
-    idType: Word;     {1}
+    idType: Word;     {1 - Icon, 2 - Cursor}
     idCount: Word;    {number of icons in file}
   end;
   
@@ -3690,6 +3695,18 @@ begin
   FnIcons := LEtoN(IconHeader.idCount);
 end;
 
+{ TLazReaderCursor }
+function TLazReaderCursor.InternalCheck(Stream: TStream): boolean;
+var
+  IconHeader: TIconHeader;
+begin
+  FnStartPos := Stream.Position;
+  Stream.Read(IconHeader,SizeOf(IconHeader));
+  With IconHeader do
+    Result := (idReserved=0) and (LEtoN(idType)=2);
+  FnIcons := LEtoN(IconHeader.idCount);
+end;
+
 //------------------------------------------------------------------------------
 procedure InternalInit;
 var