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

gtk2 intf: added GetDefaultPangoLayout

Browse Source 
git-svn-id: trunk@9494 -
This commit is contained in:
mattias 2006-06-24 08:35:25 +00:00
parent 1617d48364
commit 3385779d03
10 changed files with 169 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
examples/openglcontrol/openglcontrol_demo.lpi
View File

@ -14,10 +14,8 @@
<TargetFileExt Value=""/>
<Title Value="openglcontrol_demo"/>
</General>
<LazDoc Paths=""/>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
<RunParams>
<local>

25
lcl/dynhasharray.pp
View File

@ -180,24 +180,18 @@ const
type
TRecentListEntry = record
Item: Pointer;
Data: Pointer;
end;
PRecentListEntry = ^TRecentListEntry;
TRecentList = class
private
FCapacity: integer;
FCount: integer;
FItems: PRecentListEntry;
FItems: PPointer;
procedure FreeItems;
procedure SetCapacity(NewCapacity: integer);
public
constructor Create(TheCapacity: integer);
destructor Destroy; override;
function Contains(Item: Pointer): boolean;
procedure Add(Item, Data: Pointer);
procedure Add(Item: Pointer);
procedure Remove(Item: Pointer);
function IndexOf(Item: Pointer): integer;
procedure Clear;
@ -220,7 +214,7 @@ procedure TRecentList.SetCapacity(NewCapacity: integer);
begin
if NewCapacity=FCapacity then exit;
if NewCapacity>0 then
ReAllocMem(FItems,NewCapacity*SizeOf(TRecentListEntry))
ReAllocMem(FItems,NewCapacity*SizeOf(Pointer))
else
FreeItems;
FCapacity:=NewCapacity;
@ -245,16 +239,15 @@ begin
Result:=IndexOf(Item)>=0;
end;
procedure TRecentList.Add(Item, Data: Pointer);
procedure TRecentList.Add(Item: Pointer);
begin
if FCount=FCapacity then begin
if FCount>1 then
Move(FItems[1],FItems[0],SizeOf(TRecentListEntry)*(FCount-1));
Move(FItems[1],FItems[0],SizeOf(PPointer)*(FCount-1));
end else begin
inc(FCount);
end;
FItems[FCount-1].Item:=Item;
FItems[FCount-1].Data:=Data;
FItems[FCount-1]:=Item;
end;
procedure TRecentList.Remove(Item: Pointer);
@ -263,14 +256,14 @@ begin
i:=IndexOf(Item);
if i<0 then exit;
if i<FCount-1 then
Move(FItems[i+1],FItems[i],SizeOf(TRecentListEntry)*(FCount-i-1));
Move(FItems[i+1],FItems[i],SizeOf(PPointer)*(FCount-i-1));
dec(FCount);
end;
function TRecentList.IndexOf(Item: Pointer): integer;
begin
Result:=FCount-1;
while (Result>=0) and (FItems[Result].Item<>Item) do dec(Result);
while (Result>=0) and (FItems[Result]<>Item) do dec(Result);
end;
procedure TRecentList.Clear;
@ -614,7 +607,7 @@ begin
then begin
Result:=FindHashItem(Item)<>nil;
if Result and (FContainsCache<>nil) then
TRecentList(FContainsCache).Add(Item,nil);
TRecentList(FContainsCache).Add(Item);
end else
Result:=true;
end;

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

@ -21,7 +21,7 @@ interface
uses
SysUtils, Classes, InterfaceBase,
{$IFDEF gtk2}
glib2, gdk2pixbuf, gdk2, gtk2,
Pango, glib2, gdk2pixbuf, gdk2, gtk2,
{$ELSE}
glib, gdk, gtk,
{$ENDIF}
@ -136,6 +136,11 @@ const
var
Styles : TStrings;
{$IFDEF Gtk2}
var
DefaultPangoLayout: PPangoLayout = nil;
{$ENDIF}
const
KEYMAP_VKUNKNOWN = $10000;

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

@ -6730,6 +6730,12 @@ var
i: Integer;
begin
if Styles=nil then exit;
{$IFDEF Gtk2}
if DefaultPangoLayout<>nil then begin
g_object_unref(DefaultPangoLayout);
DefaultPangoLayout:=nil;
end;
{$ENDIF}
for i:=Styles.Count-1 downto 0 do begin
StyleObject:=PStyleObject(Styles.Objects[i]);
FreeStyleObject(StyleObject);
@ -7141,6 +7147,15 @@ begin
end;
{$EndIf}
function GetDefaultPangoLayout: PPangoLayout;
begin
if DefaultPangoLayout=nil then begin
DefaultPangoLayout :=
gtk_widget_create_pango_layout (GetStyleWidget(lgsdefault), nil);
end;
Result := DefaultPangoLayout;
end;
function GetDefaultFontName: string;
var
Style: PGtkStyle;

3
lcl/interfaces/gtk/gtkproc.pp
View File

@ -763,8 +763,9 @@ function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean;
{$Ifdef GTK2}
function FontIsDoubleByteCharsFont(TheFont: PPangoFontDescription): boolean;
function LoadDefaultFontDesc: PPangoFontDescription;
Procedure GetTextExtentIgnoringAmpersands(FontDesc: PPangoFontDescription; Str: PChar;
procedure GetTextExtentIgnoringAmpersands(FontDesc: PPangoFontDescription; Str: PChar;
LineLength: Longint; lbearing, rbearing, width, ascent, descent: Pgint);
function GetDefaultPangoLayout: PPangoLayout;
{$ENDIF}
{$IFDEF GTK1}
function LoadDefaultFont: PGDKFont;

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

@ -3865,9 +3865,9 @@ begin
// TODO: implement other parameters.
// to reduce flickering calculate first and then paint
DCOrigin:=GetDCOffset(TDeviceContext(DC));
DCOrigin := GetDCOffset(TDeviceContext(DC));
buffered := false;
UseFont:=nil;
UseFont := nil;
buffer := Drawable;
UnRef := false;
UnderLine := false;

39
lcl/interfaces/gtk2/gtk2object.inc
View File

@ -1414,6 +1414,7 @@ var
AttrList : PPangoAttrList;
Attr : PPangoAttribute;
Extents : TPangoRectangle;
AttrListTemporary: Boolean;
begin
with TDeviceContext(DC) do begin
if dcfTextMetricsValid in DCFlags then begin
@ -1437,24 +1438,29 @@ begin
If UseFontDesc = nil then
DebugLn('WARNING: [TGtk2WidgetSet.GetTextMetrics] Missing font')
else begin
Layout := gtk_widget_create_pango_layout (GetStyleWidget(lgsdefault), nil);
Layout := GetDefaultPangoLayout;
pango_layout_set_font_description(Layout, UseFontDesc);
AttrList := pango_layout_get_attributes(Layout);
AttrList := nil;
AttrListTemporary := false;
if Underline or StrikeOut then begin
AttrList := pango_layout_get_attributes(Layout);
If (AttrList = nil) then begin
AttrList := pango_attr_list_new();
AttrListTemporary := true;
end;
If (AttrList = nil) then
AttrList := pango_attr_list_new();
If Underline then
Attr := pango_attr_underline_new(PANGO_UNDERLINE_SINGLE)
else
Attr := pango_attr_underline_new(PANGO_UNDERLINE_NONE);
pango_attr_list_change(AttrList,Attr);
If Underline then
Attr := pango_attr_underline_new(PANGO_UNDERLINE_SINGLE)
else
Attr := pango_attr_underline_new(PANGO_UNDERLINE_NONE);
Attr := pango_attr_strikethrough_new(StrikeOut);
pango_attr_list_change(AttrList,Attr);
pango_attr_list_change(AttrList,Attr);
Attr := pango_attr_strikethrough_new(StrikeOut);
pango_attr_list_change(AttrList,Attr);
pango_layout_set_attributes(Layout, AttrList);
pango_layout_set_attributes(Layout, AttrList);
end;
pango_layout_set_single_paragraph_mode(Layout, TRUE);
pango_layout_set_width(Layout, -1);
@ -1464,9 +1470,10 @@ begin
pango_layout_set_text(Layout, TestString, length(TestString));
pango_layout_get_extents(Layout, nil, @Extents);
g_object_unref(Layout);
If UnRef then
if AttrListTemporary then
pango_attr_list_unref(AttrList);
if UnRef then
pango_font_description_free(UseFontDesc);
FillChar(DCTextMetric, SizeOf(DCTextMetric), 0);

207
lcl/interfaces/gtk2/gtk2winapi.inc
View File

@ -202,6 +202,7 @@ var
UseFontDesc : PPangoFontDescription;
AttrList : PPangoAttrList;
Attr : PPangoAttribute;
AttrListTemporary: Boolean;
procedure DoTextOut(X,Y : Integer; Str : Pchar; Count: Integer);
var
@ -242,118 +243,130 @@ begin
then begin
DebugLn('WARNING: [TGtk2WidgetSet.ExtTextOut] Uninitialized GC');
Result := False;
end
else if ((Options and (ETO_OPAQUE+ETO_CLIPPED)) <> 0)
exit;
end;
if ((Options and (ETO_OPAQUE+ETO_CLIPPED)) <> 0)
and (Rect=nil) then begin
DebugLn('WARNING: [TGtk2WidgetSet.ExtTextOut] Rect=nil');
Result := False;
end else begin
// TODO: implement other parameters.
exit;
end;
UseFontDesc:=nil;
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin
UseFontDesc := GetDefaultFontDesc(true);
UnRef := True;
Underline := False;
StrikeOut := False;
end
else begin
UseFontDesc := CurrentFont^.GDIFontObject;
UnRef := False;
Underline := CurrentFont^.Underline;
StrikeOut := CurrentFont^.StrikeOut;
// TODO: implement other parameters.
UseFontDesc:=nil;
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin
UseFontDesc := GetDefaultFontDesc(true);
UnRef := True;
Underline := False;
StrikeOut := False;
end
else begin
UseFontDesc := CurrentFont^.GDIFontObject;
UnRef := False;
Underline := CurrentFont^.Underline;
StrikeOut := CurrentFont^.StrikeOut;
end;
If (UseFontDesc = nil) then begin
DebugLn('WARNING: [TGtk2WidgetSet.ExtTextOut] Missing Font');
Result:=false;
exit;
end;
// to reduce flickering calculate first and then paint
Layout := GetDefaultPangoLayout;
If (Layout = nil) then begin
DebugLn('WARNING: [TGtk2WidgetSet.ExtTextOut] Missing Default Pango Layout');
Result:=false;
exit;
end;
DCOrigin:=GetDCOffset(TDeviceContext(DC));
pango_layout_set_font_description(Layout, UseFontDesc);
AttrList:=nil;
AttrListTemporary := false;
if Underline or StrikeOut then begin
AttrList := pango_layout_get_attributes(Layout);
If (AttrList = nil) then begin
AttrList := pango_attr_list_new();
AttrListTemporary := true;
end;
If (UseFontDesc = nil) or (GetStyleWidget(lgsdefault)=nil) then
DebugLn('WARNING: [TGtk2WidgetSet.ExtTextOut] Missing Font')
else begin
// to reduce flickering calculate first and then paint
DCOrigin:=GetDCOffset(TDeviceContext(DC));
If Underline then
Attr := pango_attr_underline_new(PANGO_UNDERLINE_SINGLE)
else
Attr := pango_attr_underline_new(PANGO_UNDERLINE_NONE);
pango_attr_list_change(AttrList,Attr);
Layout := gtk_widget_create_pango_layout (GetStyleWidget(lgsdefault), nil);
Attr := pango_attr_strikethrough_new(StrikeOut);
pango_attr_list_change(AttrList,Attr);
end;
If (Layout = nil) then
DebugLn('WARNING: [TGtk2WidgetSet.ExtTextOut] Missing Pango Layout')
else begin
pango_layout_set_font_description(Layout, UseFontDesc);
if (Options and ETO_CLIPPED) <> 0 then
begin
X := Rect^.Left;
Y := Rect^.Top;
IntersectClipRect(DC, Rect^.Left, Rect^.Top,
Rect^.Right, Rect^.Bottom);
end;
AttrList := pango_layout_get_attributes(Layout);
LineLen := FindChar(#10,Str,Count);
TopY := Y;
UpdateDCTextMetric(TDeviceContext(DC));
TxtPt.X := X + DCOrigin.X;
LineHeight := DCTextMetric.TextMetric.tmHeight;
TxtPt.Y := TopY + DCOrigin.Y;
If (AttrList = nil) then
AttrList := pango_attr_list_new();
SelectedColors := dcscCustom;
If Underline then
Attr := pango_attr_underline_new(PANGO_UNDERLINE_SINGLE)
else
Attr := pango_attr_underline_new(PANGO_UNDERLINE_NONE);
if ((Options and ETO_OPAQUE) <> 0) then
begin
Width := Rect^.Right - Rect^.Left;
Height := Rect^.Bottom - Rect^.Top;
EnsureGCColor(DC, dccCurrentBackColor, True, False);
gdk_draw_rectangle(Drawable, GC, 1,
Rect^.Left+DCOrigin.X, Rect^.Top+DCOrigin.Y,
Width, Height);
end;
pango_attr_list_change(AttrList,Attr);
EnsureGCColor(DC, dccCurrentTextColor, True, False);
if AttrList<>nil then
pango_layout_set_attributes(Layout, AttrList);
Attr := pango_attr_strikethrough_new(StrikeOut);
pango_attr_list_change(AttrList,Attr);
Foreground := StyleForegroundColor(CurrentTextColor.ColorRef, nil);
if (Options and ETO_CLIPPED) <> 0 then
begin
X := Rect^.Left;
Y := Rect^.Top;
IntersectClipRect(DC, Rect^.Left, Rect^.Top,
Rect^.Right, Rect^.Bottom);
end;
LineLen := FindChar(#10,Str,Count);
TopY := Y;
UpdateDCTextMetric(TDeviceContext(DC));
TxtPt.X := X + DCOrigin.X;
LineHeight := DCTextMetric.TextMetric.tmHeight;
TxtPt.Y := TopY + DCOrigin.Y;
SelectedColors := dcscCustom;
if ((Options and ETO_OPAQUE) <> 0) then
begin
Width := Rect^.Right - Rect^.Left;
Height := Rect^.Bottom - Rect^.Top;
EnsureGCColor(DC, dccCurrentBackColor, True, False);
gdk_draw_rectangle(Drawable, GC, 1,
Rect^.Left+DCOrigin.X, Rect^.Top+DCOrigin.Y,
Width, Height);
end;
EnsureGCColor(DC, dccCurrentTextColor, True, False);
pango_layout_set_attributes(Layout, AttrList);
Foreground := StyleForegroundColor(CurrentTextColor.ColorRef, nil);
LineStart:=Str;
if LineLen < 0 then begin
LineLen:=Count;
if Count> 0 then DrawTextLine;
end else
Begin //write multiple lines
StrEnd:=Str+Count;
while LineStart < StrEnd do begin
LineEnd:=LineStart+LineLen;
if LineLen>0 then DrawTextLine;
inc(TxtPt.Y,LineHeight);
LineStart:=LineEnd+1; // skip #10
if (LineStart<StrEnd) and (LineStart^=#13) then
inc(LineStart); // skip #10
Count:=StrEnd-LineStart;
LineLen:=FindChar(#10,LineStart,Count);
if LineLen<0 then
LineLen:=Count;
end;
end;
g_object_unref(Layout);
Result := True;
end;
If UnRef then
pango_font_description_free(UseFontDesc);
LineStart:=Str;
if LineLen < 0 then begin
LineLen:=Count;
if Count> 0 then DrawTextLine;
end else
Begin //write multiple lines
StrEnd:=Str+Count;
while LineStart < StrEnd do begin
LineEnd:=LineStart+LineLen;
if LineLen>0 then DrawTextLine;
inc(TxtPt.Y,LineHeight);
LineStart:=LineEnd+1; // skip #10
if (LineStart<StrEnd) and (LineStart^=#13) then
inc(LineStart); // skip #10
Count:=StrEnd-LineStart;
LineLen:=FindChar(#10,LineStart,Count);
if LineLen<0 then
LineLen:=Count;
end;
end;
Result := True;
if AttrListTemporary then
pango_attr_list_unref(AttrList);
if UnRef then
pango_font_description_free(UseFontDesc);
end;
Assert(False, Format('trace:< [TGtk2WidgetSet.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
end;

2
tools/install/create_fpc_deb.sh
View File

@ -181,8 +181,6 @@ if [ "$PackageName" = "fpc" ]; then
make all
mkdir -p $DebianInstallDir
make install INSTALL_PREFIX=$DebianInstallDir
# ToDo: put this into an debian script and use the right prefix.
ln -s /usr/lib/fpc/$FPCVersion/ppc386 $DebianInstallDir/bin/ppc386
cd -
fi

2
tools/install/debian_fpc/postinst
View File

@ -1,2 +1,4 @@
#!/bin/sh
ln -s /usr/lib/fpc/FPCVERSION/ppc386 /usr/bin/ppc386
sh /usr/lib/fpc/FPCVERSION/samplecfg /usr/lib/fpc/\$fpcversion/ /etc