From 68e2a02221a27331f7c98db91e8ca57141f914bd Mon Sep 17 00:00:00 2001
From: vincents <vincents@lazarus-ide.org>
Date: Mon, 8 Jan 2007 12:55:21 +0000
Subject: [PATCH] added support for reading cursor files from Paul Ishenin (bug
 #8082)

git-svn-id: trunk@10394 -
---
 docs/Contributors.txt  |  1 +
 lcl/graphics.pp        | 36 ++++++++++++++++++++++++++++++++++--
 lcl/include/bitmap.inc | 11 +++++++----
 lcl/intfgraphics.pas   | 19 ++++++++++++++++++-
 4 files changed, 60 insertions(+), 7 deletions(-)

diff --git a/docs/Contributors.txt b/docs/Contributors.txt
index 6b7e8e1c00..0e4e3f73a1 100644
--- a/docs/Contributors.txt
+++ b/docs/Contributors.txt
@@ -62,6 +62,7 @@ Michael A. Hess
 Micha Nelissen
 Michal Bukovjan
 Olivier Guilbaud
+Paul Ishenin
 Peter Dyson
 Pierre Gillmann
 Radek Cervinka
diff --git a/lcl/graphics.pp b/lcl/graphics.pp
index f0a597d4da..58949a11c5 100644
--- a/lcl/graphics.pp
+++ b/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');
diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc
index 1cb07ac8b6..173beda558 100644
--- a/lcl/include/bitmap.inc
+++ b/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;
diff --git a/lcl/intfgraphics.pas b/lcl/intfgraphics.pas
index 0bfdd9fad8..d6d3770497 100644
--- a/lcl/intfgraphics.pas
+++ b/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