paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-31 22:49:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL carbon: implemented Bitmap.Canvas.GetPixels

Browse Source 
git-svn-id: trunk@15781 -
This commit is contained in:
tombo 2008-07-14 13:16:07 +00:00
parent e3ee66f002
commit 3e0f21b461
5 changed files with 66 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
examples/dropfiles/dropfiles.lpi
View File

@ -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>

2
examples/dropfiles/unit1.lrs
View File

@ -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

2
examples/dropfiles/unit2.lrs
View File

@ -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'

43
lcl/interfaces/carbon/carboncanvas.pp
View File

@ -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

8
lcl/interfaces/carbon/carbonobject.inc
View File

@ -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;
{------------------------------------------------------------------------------