paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-25 14:59:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

gtk, gtk2: implement ExtCreatePen

Browse Source 
git-svn-id: trunk@17128 -
This commit is contained in:
paul 2008-10-24 15:10:58 +00:00
parent 15ef38ddd1
commit 7e1fb92a72
5 changed files with 92 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/include/canvas.inc
View File

@ -1189,7 +1189,7 @@ begin
if LCLIntf.MoveToEx(FHandle, X1, Y1, nil) then begin
SetInternalPenPos(Point(X1, Y1));
end;
End;
end;
{------------------------------------------------------------------------------
Method: TCanvas.LineTo

7
lcl/interfaces/gtk/gtkdef.pp
View File

@ -183,9 +183,12 @@ type
);
gdiPen: (
IsNullPen : Boolean;//GDK will bomb with a NULL Pen Hatch
IsExtPen: Boolean;
GDIPenColor: TGDIColor;
GDIPenWidth: Integer;
GDIPenStyle: Word;
GDIPenWidth: DWord;
GDIPenStyle: DWord;
GDIPenDashes: Pgint8;
GDIPenDashesCount: DWord;
);
gdiRegion: (
GDIRegionObject: PGdkRegion;

84
lcl/interfaces/gtk/gtkdevicecontext.inc
View File

@ -778,6 +778,13 @@ const
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
var
PenStyle: DWord;
LineStyle: TGdkLineStyle;
JoinStyle: TGdkJoinStyle;
CapStyle: TGdkCapStyle;
IsGeometric, IsExtPen: Boolean;
PenWidth: gint;
begin
// if IsNullPen then Exit;
@ -791,32 +798,65 @@ begin
// force pen
GetPen;
CurrentPen^.IsNullPen := CurrentPen^.GDIPenStyle = PS_NULL;
if (CurrentPen^.GDIPenStyle = PS_SOLID)
or (CurrentPen^.GDIPenStyle = PS_INSIDEFRAME)
then begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC, CurrentPen^.GDIPenWidth, GDK_LINE_SOLID, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end
else begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC, CurrentPen^.GDIPenWidth, GDK_LINE_ON_OFF_DASH, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
PenStyle := CurrentPen^.GDIPenStyle and PS_STYLE_MASK;
IsGeometric := (CurrentPen^.GDIPenStyle and PS_TYPE_MASK) = PS_GEOMETRIC;
IsExtPen := CurrentPen^.IsExtPen;
// Paul Ishenin: I compared patterns with windows and changed numbers to make them the same
// but under linux dot is thinner than in windows, so I added os_multiplier to make them the same
// in the resulting image
CurrentPen^.IsNullPen := PenStyle = PS_NULL;
case CurrentPen^.GDIPenStyle of
PS_DASH: SetDashes([6*OS_multiplier,2*OS_multiplier]);
PS_DOT: SetDashes([1*OS_multiplier,1*OS_multiplier]);
PS_DASHDOT: SetDashes([3*OS_multiplier,2*OS_multiplier,1*OS_multiplier,2*OS_multiplier]);
PS_DASHDOTDOT: SetDashes([3*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier]);
PenWidth := CurrentPen^.GDIPenWidth;
if IsExtPen and IsGeometric then
begin
case CurrentPen^.GDIPenStyle and PS_JOIN_MASK of
PS_JOIN_ROUND: JoinStyle := GDK_JOIN_ROUND;
PS_JOIN_BEVEL: JoinStyle := GDK_JOIN_BEVEL;
PS_JOIN_MITER: JoinStyle := GDK_JOIN_MITER;
end;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
case CurrentPen^.GDIPenStyle and PS_ENDCAP_MASK of
PS_ENDCAP_ROUND: CapStyle := GDK_CAP_ROUND;
PS_ENDCAP_SQUARE: CapStyle := GDK_CAP_PROJECTING;
PS_ENDCAP_FLAT: CapStyle := GDK_CAP_NOT_LAST;
end;
end
else
begin
JoinStyle := GDK_JOIN_MITER;
CapStyle := GDK_CAP_NOT_LAST;
if IsExtPen then // if we are using ExtCreatePen and does not set geometric => use cosmetic pen
PenWidth := 0;
end;
gdk_gc_get_values(GC,@FGCValues);
if not IsExtPen and (PenStyle = PS_USERSTYLE) then
PenStyle := PS_SOLID;
if (PenStyle = PS_SOLID) or (PenStyle = PS_INSIDEFRAME) then
LineStyle := GDK_LINE_SOLID
else
LineStyle := GDK_LINE_ON_OFF_DASH;
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC, PenWidth, LineStyle, CapStyle, JoinStyle);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
// Paul Ishenin: I compared patterns with windows and changed numbers to make them the same
// but under linux dot is thinner than in windows, so I added os_multiplier to make them the same
// in the resulting image
case PenStyle of
PS_DASH: SetDashes([6*OS_multiplier,2*OS_multiplier]);
PS_DOT: SetDashes([1*OS_multiplier,1*OS_multiplier]);
PS_DASHDOT: SetDashes([3*OS_multiplier,2*OS_multiplier,1*OS_multiplier,2*OS_multiplier]);
PS_DASHDOTDOT: SetDashes([3*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier]);
PS_USERSTYLE:
begin
laz_gdk_gc_set_dashes(GC, 0, CurrentPen^.GDIPenDashes, CurrentPen^.GDIPenDashesCount);
end;
end;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
gdk_gc_get_values(GC, @FGCValues);
Include(FFlags, dcfPenSelected);
end;

23
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -2009,7 +2009,9 @@ begin
Assert(False, 'trace:[TGtkWidgetSet.CreatePenIndirect]');
//write('CreatePenIndirect->');
GObject := NewGDIObject(gdiPen);
GObject^.GDIPenDashes := nil;
GObject^.IsExtPen := False;
with LogPen do
begin
GObject^.GDIPenStyle := lopnStyle;
@ -2484,6 +2486,7 @@ begin
gdiPen:
begin
FreeGDIColor(@GDIPenColor);
FreeMem(GDIPenDashes);
end;
gdiRegion:
begin
@ -3911,6 +3914,26 @@ begin
Result := Inherited ExcludeClipRect(DC, Left, Top, Right, Bottom);
end;
function TGTKWidgetSet.ExtCreatePen(dwPenStyle, dwWidth: DWord;
const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN;
var
GObject: PGdiObject;
i: integer;
begin
GObject := NewGDIObject(gdiPen);
GObject^.IsExtPen := True;
GObject^.GDIPenStyle := dwPenStyle;
GObject^.GDIPenWidth := dwWidth;
SetGDIColorRef(GObject^.GDIPenColor, lplb.lbColor);
GObject^.GDIPenDashesCount := dwStyleCount;
GetMem(GObject^.GDIPenDashes, dwStyleCount * SizeOf(gint8));
for i := 0 to dwStyleCount - 1 do
GObject^.GDIPenDashes[i] := lpStyle[i];
Result := HPEN(PtrUInt(GObject));
end;
{------------------------------------------------------------------------------
Function: ExtSelectClipRGN
Params: dc, RGN, Mode

1
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -79,6 +79,7 @@ procedure EnterCriticalSection(var CritSection: TCriticalSection); Override;
function EnumFontFamilies(DC: HDC; Family: Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint; override;
function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; override;
function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
function ExtCreatePen(dwPenStyle, dwWidth: DWord; const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN; override;
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; override;