repair patch
Darek
Mattias Gaertner wrote:
2. When I test my Delphi application, I noticed that function with any
strings operators work longer, even if then not reach that line (Delphi
make longer "preamble" to that functions) , enough to move that code to
subfunction - in FPC is the same (if somebody understand me)
That's because of the hidden exception frame.
AFAIK using string constants without operators do not create such frames.
That's why the lazarus code at all time critical places works without string
operators.
Thanks for explain!!
Darek
PS. What with my last patch about tComboBox
I will search ...
Mattias
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
Index: interfaces/gtk/gtklclintfh.inc
===================================================================
--- interfaces/gtk/gtklclintfh.inc (wersja 8890)
+++ interfaces/gtk/gtklclintfh.inc (kopia robocza)
@@ -39,6 +39,7 @@
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
+function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint):
Boolean; override;
function FontCanUTF8(Font: HFont): boolean; override;
Index: interfaces/gtk/gtkwinapi.inc
===================================================================
--- interfaces/gtk/gtkwinapi.inc (wersja 8890)
+++ interfaces/gtk/gtkwinapi.inc (kopia robocza)
@@ -2785,13 +2785,6 @@
theRect.Right := theRect.Left + Min(MaxLength, AP.cX);
theRect.Bottom := theRect.Top + TM.tmHeight;
- If not CalcRect then
- Case TopOffset of
- DT_VCENTER :
- OffsetRect(theRect, 0, (Rect.Bottom - theRect.Bottom) div 2);
- DT_Bottom :
- OffsetRect(theRect, 0, Rect.Bottom - theRect.Bottom);
- end;
end
else begin
// consider line breaks
@@ -2802,17 +2795,17 @@
end;
Self.WordWrap(DC, Str, MaxLength, Lines, NumLines);
- LineWidth := 0;
- If (Lines <> nil) then begin
+ If (Lines <> nil) and (NumLines>1) then begin
+ LineWidth := 0;
For J := 0 to NumLines - 1 do begin
GetTextExtentPoint(DC, Lines[J], StrLen(Lines[J]), AP);
LineWidth := Max(LineWidth, AP.cX);
end;
- end;
-
+ end else LineWidth:=10000;
LineWidth := Min(MaxLength, LineWidth);
+
theRect.Right := theRect.Left + LineWidth;
theRect.Bottom := theRect.Top + NumLines*TM.tmHeight;
if NumLines>1 then
@@ -2862,7 +2855,7 @@
end;
{Draw line of Text}
- TextOut(DC, LeftPos, TopPos, PChar(aStr), Length(aStr));
+ TextUtf8Out(DC, LeftPos, TopPos, PChar(aStr), Length(aStr));
{Draw Prefix}
If pIndex > 0 then begin
@@ -3694,7 +3687,7 @@
with TDeviceContext(DC) do begin
if (Dx=nil) then begin
// no dist array -> write as one block
- //debugln('TGtkWidgetSet.ExtTextOut.DrawTextLine Dx=nil
',dbgs(LineLen),'
DCTextMetric.IsDoubleByteChar=',dbgs(DCTextMetric.IsDoubleByteChar));
+
gdk_draw_text(Buffer, UseFont, GC, TxtPt.X, TxtPt.Y,
LineStart, LineLen);
end else begin
@@ -5940,6 +5933,7 @@
end;
end;
Assert(False, 'trace:< [TGtkWidgetSet.GetTextExtentPoint]');
+
end;
{$EndIf}
@@ -9330,6 +9324,9 @@
TempPen : hPen;
LogP : TLogPen;
Points : array[0..1] of TSize;
+
+ lbearing, rbearing, width, ascent,descent: LongInt;
+
begin
Result := IsValidDC(DC);
if Result and (Count>0)
@@ -9357,7 +9354,18 @@
DebugLn('WARNING: [TGtkWidgetSet.TextOut] Missing Font')
else begin
DCOrigin:=GetDCOffset(TDeviceContext(DC));
- GetTextExtentPoint(DC, Str, Count, Sz);
+ descent:=0;
+ gdk_text_extents(UseFont, Str, Count,
+ @lbearing, @rBearing, @width, @ascent, @descent);
+ sz.cx:=width;
+ Sz.cY :={$IFDEF Win32}
+ GDK_String_Height(UseFont, Str)
+ {$ELSE}
+ ascent+descent;
+ {$ENDIF}
+
+
+
aRect := Rect(X+DCOrigin.X,Y+DCOrigin.Y,X + Sz.CX, Sz.CY);
//DebugLn('TGtkWidgetSet.TextOut
',ARect.Left,',',ARect.Top,',',ARect.RIght,',',ARect.Bottom);
FillRect(DC,aRect,hBrush(CurrentBrush));
Index: interfaces/gtk/gtklclintf.inc
===================================================================
--- interfaces/gtk/gtklclintf.inc (wersja 8890)
+++ interfaces/gtk/gtklclintf.inc (kopia robocza)
@@ -259,7 +259,27 @@
Result:=ExtTextOut(DC,X,Y,Options,Rect,Str,Count,Dx);
end;
end;
+function TGtkWidgetSet.TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count:
Longint): Boolean;
+var
+ IsDBCSFont: Boolean;
+ NewCount: Integer;
+begin
+ UpdateDCTextMetric(TDeviceContext(DC));
+ IsDBCSFont:=TDeviceContext(DC).DCTextMetric.IsDoubleByteChar;
+ if IsDBCSFont then begin
+ NewCount:=Count*2;
+ if FExtUTF8OutCacheSize<NewCount then begin
+ ReAllocMem(FExtUTF8OutCache,NewCount);
+ FExtUTF8OutCacheSize:=NewCount;
+ end;
+ NewCount:=UTF8ToDoubleByte(Str,Count,FExtUTF8OutCache)*2;
+ Result:=TextOut(DC,X,Y,FExtUTF8OutCache,NewCount);
+ end else begin
+ Result:=TextOut(DC,X,Y,Str,Count);
+ end;
+end;
+
{------------------------------------------------------------------------------
function TGTKWidgetSet.FontCanUTF8(Font: HFont): boolean;
Index: include/customlabel.inc
===================================================================
--- include/customlabel.inc (wersja 8890)
+++ include/customlabel.inc (kopia robocza)
@@ -370,12 +370,15 @@
ShowPrefix := ShowAccelChar;
SystemFont:=false;
end;
- CalcSize(lTextWidth, lTextHeight);
TextLeft := R.Left;
- case Layout of
- tlTop: TextTop := R.Top;
- tlCenter: TextTop := (R.Bottom - R.Top - lTextHeight) div 2;
- tlBottom: TextTop := R.Bottom - R.Top - lTextHeight;
+ if layout = tlTop then begin
+ TextTop := R.Top;
+ end else begin
+ CalcSize(lTextWidth, lTextHeight);
+ case Layout of
+ tlCenter: TextTop := (R.Bottom - R.Top - lTextHeight) div 2;
+ tlBottom: TextTop := R.Bottom - R.Top - lTextHeight;
+ end;
end;
//debugln('TCustomLabel.Paint ',dbgs(Alignment=tacenter),'
',dbgs(Layout=tlCenter),' ',dbgs(TextLeft),' TextTop=',dbgs(TextTop),'
',dbgs(R));
if not Enabled then begin
Index: include/lclintfh.inc
===================================================================
--- include/lclintfh.inc (wersja 8890)
+++ include/lclintfh.inc (kopia robocza)
@@ -63,6 +63,7 @@
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); {$IFDEF
IF_BASE_MEMBER}virtual;{$ENDIF}
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
Str: PChar; Count: Longint; Dx: PInteger): Boolean; {$IFDEF
IF_BASE_MEMBER}virtual;{$ENDIF}
+function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint):
Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function FontCanUTF8(Font: HFont): boolean; {$IFDEF
IF_BASE_MEMBER}virtual;{$ENDIF}
function Frame(DC: HDC; const ARect: TRect): Integer; {$IFDEF
IF_BASE_MEMBER}virtual;{$ENDIF}
Index: include/intfbaselcl.inc
===================================================================
--- include/intfbaselcl.inc (wersja 8890)
+++ include/intfbaselcl.inc (kopia robocza)
@@ -139,6 +139,12 @@
Result:=ExtTextOut(DC,X,Y,Options,Rect,Str,Count,Dx);
end;
+function TWidgetSet.TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count:
Longint): Boolean;
+begin
+ Result:=TextOut(DC,X,Y,Str,Count);
+end;
+
+
function TWidgetSet.FontCanUTF8(Font: HFont): boolean;
begin
Result:=false;
Index: include/lclintf.inc
===================================================================
--- include/lclintf.inc (wersja 8890)
+++ include/lclintf.inc (kopia robocza)
@@ -136,6 +136,12 @@
Result := WidgetSet.ExtUTF8Out(DC,X,Y,Options,Rect,Str,Count,Dx);
end;
+
+function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint):
Boolean;
+begin
+ Result := WidgetSet.TextUTF8Out(DC,X,Y,Str,Count);
+end;
+
function FontCanUTF8(Font: HFont): boolean;
begin
Result := WidgetSet.FontCanUTF8(Font);
