LCL carbon: implemented Bitmap.Canvas.GetPixels

git-svn-id: trunk@15781 -

examples/dropfiles/dropfiles.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="\"/>
+    <PathDelim Value="/"/>
     <Version Value="6"/>
     <General>
       <MainUnit Value="0"/>
@@ -53,7 +53,7 @@
         <Loaded Value="True"/>
       </Unit1>
       <Unit2>
-        <Filename Value="..\..\lcl\forms.pp"/>
+        <Filename Value="../../lcl/forms.pp"/>
         <UnitName Value="Forms"/>
         <CursorPos X="3" Y="567"/>
         <TopLine Value="627"/>
@@ -66,113 +66,113 @@
         <ResourceFilename Value="unit2.lrs"/>
         <UnitName Value="Unit2"/>
         <CursorPos X="19" Y="37"/>
-        <TopLine Value="25"/>
+        <TopLine Value="20"/>
         <EditorIndex Value="1"/>
         <UsageCount Value="22"/>
         <Loaded Value="True"/>
       </Unit3>
       <Unit4>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkproc.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkproc.pp"/>
         <UnitName Value="GTKProc"/>
         <CursorPos X="50" Y="266"/>
         <TopLine Value="299"/>
         <UsageCount Value="11"/>
       </Unit4>
       <Unit5>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkcallback.inc"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkcallback.inc"/>
         <CursorPos X="29" Y="3223"/>
         <TopLine Value="3223"/>
         <UsageCount Value="11"/>
       </Unit5>
       <Unit6>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkobject.inc"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkobject.inc"/>
         <CursorPos X="61" Y="5188"/>
         <TopLine Value="5177"/>
         <UsageCount Value="11"/>
       </Unit6>
       <Unit7>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkint.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkint.pp"/>
         <UnitName Value="GtkInt"/>
         <CursorPos X="23" Y="317"/>
         <TopLine Value="303"/>
         <UsageCount Value="10"/>
       </Unit7>
       <Unit8>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkwscontrols.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkwscontrols.pp"/>
         <UnitName Value="GtkWSControls"/>
         <CursorPos X="40" Y="336"/>
         <TopLine Value="316"/>
         <UsageCount Value="10"/>
       </Unit8>
       <Unit9>
-        <Filename Value="..\..\..\fpc\fpcsrc\packages\extra\gtk2\gtk+\gtk\gtkincludes.inc"/>
+        <Filename Value="../../../fpc/fpcsrc/packages/extra/gtk2/gtk+/gtk/gtkincludes.inc"/>
         <CursorPos X="11" Y="166"/>
         <TopLine Value="152"/>
         <UsageCount Value="10"/>
       </Unit9>
       <Unit10>
-        <Filename Value="..\..\lcl\lmessages.pp"/>
+        <Filename Value="../../lcl/lmessages.pp"/>
         <UnitName Value="LMessages"/>
         <CursorPos X="3" Y="241"/>
         <TopLine Value="227"/>
         <UsageCount Value="10"/>
       </Unit10>
       <Unit11>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkwsstdctrls.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkwsstdctrls.pp"/>
         <UnitName Value="GtkWSStdCtrls"/>
         <CursorPos X="1" Y="1"/>
         <TopLine Value="296"/>
         <UsageCount Value="10"/>
       </Unit11>
       <Unit12>
-        <Filename Value="..\..\lcl\interfaces\qt\qtwidgets.pas"/>
+        <Filename Value="../../lcl/interfaces/qt/qtwidgets.pas"/>
         <UnitName Value="qtwidgets"/>
         <CursorPos X="3" Y="853"/>
         <TopLine Value="824"/>
         <UsageCount Value="10"/>
       </Unit12>
       <Unit13>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkdragcallback.inc"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkdragcallback.inc"/>
         <CursorPos X="3" Y="29"/>
         <TopLine Value="16"/>
         <UsageCount Value="10"/>
       </Unit13>
       <Unit14>
-        <Filename Value="..\..\lcl\interfaces\gtk2\gtk2wsstdctrls.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk2/gtk2wsstdctrls.pp"/>
         <UnitName Value="Gtk2WSStdCtrls"/>
         <CursorPos X="71" Y="903"/>
         <TopLine Value="887"/>
         <UsageCount Value="10"/>
       </Unit14>
       <Unit15>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkwsforms.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkwsforms.pp"/>
         <UnitName Value="GtkWSForms"/>
         <CursorPos X="28" Y="213"/>
         <TopLine Value="201"/>
         <UsageCount Value="10"/>
       </Unit15>
       <Unit16>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkdef.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkdef.pp"/>
         <UnitName Value="GTKDef"/>
         <CursorPos X="45" Y="42"/>
         <TopLine Value="36"/>
         <UsageCount Value="10"/>
       </Unit16>
       <Unit17>
-        <Filename Value="..\..\lcl\interfaces\gtk2\gtk2wscustommemo.inc"/>
+        <Filename Value="../../lcl/interfaces/gtk2/gtk2wscustommemo.inc"/>
         <CursorPos X="31" Y="131"/>
         <TopLine Value="118"/>
         <UsageCount Value="10"/>
       </Unit17>
       <Unit18>
-        <Filename Value="..\..\lcl\interfaces\gtk2\gtk2wsspin.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk2/gtk2wsspin.pp"/>
         <UnitName Value="Gtk2WSSpin"/>
         <CursorPos X="19" Y="50"/>
         <TopLine Value="41"/>
         <UsageCount Value="10"/>
       </Unit18>
       <Unit19>
-        <Filename Value="..\..\lcl\interfaces\gtk\gtkwsspin.pp"/>
+        <Filename Value="../../lcl/interfaces/gtk/gtkwsspin.pp"/>
         <UnitName Value="GtkWSSpin"/>
         <CursorPos X="26" Y="163"/>
         <TopLine Value="152"/>
@@ -183,7 +183,6 @@
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="5"/>
-    <PathDelim Value="\"/>
     <CodeGeneration>
       <Generate Value="Faster"/>
     </CodeGeneration>

examples/dropfiles/unit1.lrs

@@ -1,5 +1,3 @@
-{ This is an automatically generated lazarus resource file }
-
 LazarusResources.Add('TForm1','FORMDATA',[
   'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'+'#1#6'Height'#3'a'#1#3'Top'#3#155#0#5'Wi'
   +'dth'#3#189#2#18'HorzScrollBar.Page'#3#188#2#18'VertScrollBar.Page'#3'`'#1#13

examples/dropfiles/unit2.lrs

@@ -1,5 +1,3 @@
-{ This is an automatically generated lazarus resource file }
-
 LazarusResources.Add('TForm2','FORMDATA',[
   'TPF0'#6'TForm2'#5'Form2'#4'Left'#3#166#1#6'Height'#2'8'#3'Top'#3'P'#2#5'Widt'
   +'h'#3#217#1#18'HorzScrollBar.Page'#3#216#1#18'VertScrollBar.Page'#2'7'#13'Ac'

lcl/interfaces/carbon/carboncanvas.pp

@@ -35,7 +35,7 @@ uses
   MacOSAll,
 {$endif}
  // LCL
-  LCLProc, LCLType, Graphics, GraphType, Controls, Forms,
+  LCLProc, LCLType, Graphics, GraphType, IntfGraphics, Controls, Forms,
  // LCL Carbon
   CarbonDef, CarbonUtils,
   {$ifdef DebugBitmaps}
@@ -123,6 +123,7 @@ type
     procedure Frame(X1, Y1, X2, Y2: Integer);
     procedure Frame3D(var ARect: TRect; const FrameWidth: integer; const Style: TBevelCut);
     function GetClipRect: TRect;
+    function GetPixel(X, Y: Integer): TGraphicsColor; virtual;
     function GetTextExtentPoint(Str: PChar; Count: Integer; var Size: TSize): Boolean;
     function GetTextMetrics(var TM: TTextMetric): Boolean;
     procedure InvertRectangle(X1, Y1, X2, Y2: Integer);
@@ -189,6 +190,8 @@ type
     constructor Create;
     destructor Destroy; override;
     procedure Reset; override;
+    
+    function GetPixel(X, Y: Integer): TGraphicsColor; override;
   public
     property Bitmap: TCarbonBitmap read GetBitmap write SetBitmap;
   end;
@@ -928,6 +931,17 @@ begin
   Result := CGRectToRect(CGContextGetClipBoundingBox(CGContext));
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonDeviceContext.GetPixel
+  Params:  X, Y - Coordinates of pixel
+  Returns: Specified pixel color
+ ------------------------------------------------------------------------------}
+function TCarbonDeviceContext.GetPixel(X, Y: Integer): TGraphicsColor;
+begin
+  Result := clNone;
+  DebugLn('TODO: Implement get pixel for CGContext.');
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonDeviceContext.GetTextExtentPoint
   Params:  Str   - Text string
@@ -1541,6 +1555,33 @@ begin
   inherited Reset;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonBitmapContext.GetPixel
+  Params:  X, Y - Coordinates of pixel
+  Returns: Specified pixel color
+ ------------------------------------------------------------------------------}
+function TCarbonBitmapContext.GetPixel(X, Y: Integer): TGraphicsColor;
+var
+  S: TPoint;
+  R: TRect;
+  RawImage: TRawImage;
+  IntfImage: TLazIntfImage;
+begin
+  Result := clNone;
+  
+  S := GetSize;
+  if (X < 0) or (Y < 0) or (X > S.X - 1) or (Y > S.Y - 1) then Exit;
+  
+  R := Classes.Rect(X, Y, 1, 1);
+  if not RawImage_FromBitmap(RawImage, HBITMAP(Bitmap), 0, @R) then Exit;
+  IntfImage := TLazIntfImage.Create(RawImage, True);
+  try
+    Result := IntfImage.TColors[X, Y];
+  finally
+    IntfImage.Free;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonBitmapContext.GetBitmap
   Returns: The bitmap of bitmap context

lcl/interfaces/carbon/carbonobject.inc

@@ -1024,17 +1024,19 @@ end;
   Params:  CanvasHandle - Canvas handle to get color from
            X, Y         - Position
   Returns: Color of the specified pixel on the canvas
-  Not implemented!
  ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer
   ): TGraphicsColor;
 begin
+  Result := clNone;
+  
   {$IFDEF VerboseObject}
     DebugLn('TCarbonWidgetSet.DCGetPixel DC: ' + DbgS(CanvasHandle) + ' X: ' + DbgS(X) + ' Y: ' + DbgS(Y));
   {$ENDIF}
   
-  DebugLn('TCarbonWidgetSet.DCGetPixel TODO');
+  if not CheckDC(CanvasHandle, 'DCGetPixel') then Exit;
-  Result := clNone;
+
+  Result := TCarbonDeviceContext(CanvasHandle).GetPixel(X, Y);
 end;
 
 {------------------------------------------------------------------------------