paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 23:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed GetPixel

Browse Source 
git-svn-id: trunk@341 -
This commit is contained in:
lazarus 2001-10-08 12:57:07 +00:00
parent 4c04295209
commit 596a86978a
2 changed files with 17 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lcl/interfaces/gtk/gtkobject.inc
View File

@ -2495,7 +2495,8 @@ var
PDC : PDeviceContext;
Image : pGDKImage;
Widget : PgtkWidget;
GDKColorIndex: Cardinal;
GDKColor: TGDKColor;
GdkColorContext: PGdkColorContext;
begin
PDC := PDeviceContext(TCanvas(Sender).Handle);
if PDC = nil then exit;
@ -2509,10 +2510,14 @@ begin
gtk_Object_set_data(pgtkobject(Widget),'Image',Image);
end;
GDKColorIndex := gdk_image_get_pixel(Image,
GDKColor.Pixel := gdk_image_get_pixel(Image,
TLMSetGetPixel(data^).X,TLMSetGetPixel(data^).Y);
TLMSetGetPixel(data^).PixColor := GDKColorIDToRGB(GDKColorIndex);
GdkColorContext:=
gdk_color_context_new(gdk_visual_get_system,gdk_colormap_get_system);
gdk_color_context_query_color(GdkColorContext,@GDKColor);
gdk_color_context_free(GdkColorContext);
TLMSetGetPixel(data^).PixColor := TGDKColorToTColor(GDKColor);
end;
{------------------------------------------------------------------------------
@ -3081,6 +3086,9 @@ end;
{ =============================================================================
$Log$
Revision 1.59 2001/10/08 12:57:07 lazarus
MG: fixed GetPixel
Revision 1.58 2001/10/08 08:05:08 lazarus
MG: fixed TColorDialog set color

31
lcl/interfaces/gtk/gtkproc.inc
View File

@ -51,30 +51,6 @@ begin
gdk_colormap_alloc_color(gdk_colormap_get_system, @Result, False, True);
end;
{------------------------------------------------------------------------------
Function: GDKColorIDToRGB
Params: AGDKColorID: A GDK color index
Returns: a RGB color (TColor)
------------------------------------------------------------------------------}
function GDKColorIDToRGB(AGDKColorID: cardinal): LongInt;
//var AColor: TGDKColor;
begin
//writeln('[GDKColorIDToRGB] ID=',HexStr(AGDKColorID,8),' ',gdk_colormap_get_system_size);
Result:=AGDKColorID;
exit;
{ MG: I don't know what the AGDKColorID from gdk_image_get_pixel is.
if AGDKColorID >= cardinal(gdk_colormap_get_system_size) then
Result:=0
else begin
AColor:=gdk_colormap_get_system^.Colors[AGDKColorID];
Result := (AColor.Red shr 8) or (AColor.Green and $ff00)
or ((AColor.Blue and $ff00) shl 8);
end;
}
end;
{------------------------------------------------------------------------------
Function: CopyDCData
Params: DestinationDC: a dc to copy data to
@ -719,8 +695,8 @@ end;
function TGDKColorToTColor(value : TGDKColor) : TColor;
begin
//ReportNotObsolete('TgdkColortoTColor');
Result := ((Value.Blue div 257) shl 16) + ((Value.Green div 257) shl 8)
+ (Value.Red div 257);
Result := ((Value.Blue shr 8) shl 16) + ((Value.Green shr 8) shl 8)
+ (Value.Red shr 8);
end;
function TColortoTGDKColor(value : TColor) : TGDKColor;
@ -772,6 +748,9 @@ end;
{ =============================================================================
$Log$
Revision 1.23 2001/10/08 12:57:07 lazarus
MG: fixed GetPixel
Revision 1.22 2001/10/08 08:05:08 lazarus
MG: fixed TColorDialog set color