LCL carbon: implemented Bitmap.Canvas.GetPixels

git-svn-id: trunk@15781 -
2025-04-16 09:49:31 +02:00 · 2008-07-14 13:16:07 +00:00 · 2008-07-14 13:16:07 +00:00 · 3e0f21b461
commit 3e0f21b461
parent e3ee66f002
5 changed files with 66 additions and 28 deletions
--- a/examples/dropfiles/dropfiles.lpi
+++ b/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>
--- a/examples/dropfiles/unit1.lrs
+++ b/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
--- a/examples/dropfiles/unit2.lrs
+++ b/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'
--- a/lcl/interfaces/carbon/carboncanvas.pp
+++ b/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
--- a/lcl/interfaces/carbon/carbonobject.inc
+++ b/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');
-  Result := clNone;
+  if not CheckDC(CanvasHandle, 'DCGetPixel') then Exit;
+
+  Result := TCarbonDeviceContext(CanvasHandle).GetPixel(X, Y);
 end;

 {------------------------------------------------------------------------------