paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 01:19:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: added TDevContextColorType

Browse Source 
git-svn-id: trunk@919 -
This commit is contained in:
lazarus 2002-02-09 01:47:22 +00:00
parent 3d86abcb40
commit dfd2edf053
1 changed files with 48 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5497,7 +5497,49 @@ begin
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Procedure: TGTKObject.SelectGDKPenProps Procedure: TGTKObject.SelectGDKBrushProps
Params: DC: a (LCL)devicecontext
Returns: Nothing
Sets the forecolor and fill according to the brush
------------------------------------------------------------------------------}
procedure TGTKObject.SelectGDKBrushProps(DC: HDC);
begin
with TDeviceContext(DC), CurrentBrush^ do
begin
Assert(False, Format('Trace: [SelectGDKBrushProps] Fill: %d | Color: 0x%x', [Integer(GDIBrushFill), GDIBrushColor.ColorRef]));
EnsureGCColor(DC, dccCurrentBackColor, True, True);//BKColor
EnsureGCColor(DC, dccGDIBrushColor, GDIBrushFill = GDK_Solid, False);//Brush Color
If GDIBrushFill <> GDK_Solid then
If GDIBrushPixmap <> nil then begin
gdk_gc_set_fill(GC, GDIBrushFill);
gdk_error_trap_push;//Image errors can kill us
gdk_gc_set_Stipple(GC,GDIBrushPixmap);
end
end;
end;
{------------------------------------------------------------------------------
Procedure: TGTKObject.SelectGDKTextProps
Params: DC: a (LCL)devicecontext
Returns: Nothing
Sets the forecolor and fill according to the Textcolor
------------------------------------------------------------------------------}
procedure TGTKObject.SelectGDKTextProps(DC: HDC);
begin
with TDeviceContext(DC) do
begin
EnsureGCColor(DC, dccCurrentBackColor, True, True);//BKColor
EnsureGCColor(DC, dccCurrentTextColor, False, False);//Font Color
Assert(False, Format('trace: [SelectGDKTextProps] Color --> pixel: %d, red: 0x%x, green: 0x%x, blue: 0x%x', [CurrentTextColor.Color.Pixel, CurrentTextColor.Color.Red, CurrentTextColor.Color.Green, CurrentTextColor.Color.Blue]));
end;
end;
{------------------------------------------------------------------------------
Procedure: TGTKObject.TGTKObject.SelectGDKPenProps
Params: DC: a (LCL)devicecontext Params: DC: a (LCL)devicecontext
Returns: Nothing Returns: Nothing
@ -5507,8 +5549,8 @@ procedure TGTKObject.SelectGDKPenProps(DC: HDC);
begin begin
if IsValidGDIObject(HGDIOBJ(TDeviceContext(DC).CurrentPen)) then begin if IsValidGDIObject(HGDIOBJ(TDeviceContext(DC).CurrentPen)) then begin
with TDeviceContext(DC), CurrentPen^ do begin with TDeviceContext(DC), CurrentPen^ do begin
EnsureGCColor(DC, GC, CurrentBackColor, True, True);//BKColor EnsureGCColor(DC, dccCurrentBackColor, True, True);//BKColor
EnsureGCColor(DC, GC, GDIPenColor, False, False);//Pen Color EnsureGCColor(DC, dccGDIPenColor, False, False);//Pen Color
end; end;
if (not (dcfPenSelected in TDeviceContext(DC).DCFlags)) then begin if (not (dcfPenSelected in TDeviceContext(DC).DCFlags)) then begin
@ -5946,6 +5988,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.237 2002/10/08 13:42:23 lazarus
MG: added TDevContextColorType
Revision 1.236 2002/10/08 10:08:46 lazarus Revision 1.236 2002/10/08 10:08:46 lazarus
MG: accelerated GDIColor allocating MG: accelerated GDIColor allocating