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

MG: from Andrew: style list fixes, autosize for radio/checkbtns

Browse Source 
git-svn-id: trunk@1866 -
This commit is contained in:
lazarus 2002-08-17 23:39:18 +00:00
parent 0f3b8ecd6b
commit 5d315e72e9
1 changed files with 167 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2020,11 +2020,14 @@ begin
if Boolean(Result) if Boolean(Result)
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
begin begin
if GC = nil If (FLAGS and DT_CalcRect) = DT_CalcRect then
then begin Result := Inherited DrawText(DC, Str, Count, Rect, Flags)
WriteLn('WARNING: [TgtkObject.DrawText] Uninitialized GC'); else
Result := 0; if GC = nil
end then begin
WriteLn('WARNING: [TgtkObject.DrawText] Uninitialized GC');
Result := 0;
end
else else
If not IsValidGDIObject(hFont(CurrentFont)) then begin If not IsValidGDIObject(hFont(CurrentFont)) then begin
WriteLn('WARNING: [TgtkObject.DrawText] Invalid Font'); WriteLn('WARNING: [TgtkObject.DrawText] Invalid Font');
@ -2174,99 +2177,98 @@ function TgtkObject.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
var var
LineStart, LineEnd, StrEnd: PChar; LineStart, LineEnd, StrEnd: PChar;
Width, Height: Integer; Width, Height: Integer;
//NewText,oldText : String;
AY, Num : Integer; AY, Num : Integer;
//Line : Integer;
TXTPt : TPoint; TXTPt : TPoint;
TM : TTextMetric; TM : TTextMetric;
//ADC : hDC; //ADC : hDC;
UseFont : PGDKFont;
UnRef : Boolean;
begin begin
Assert(False, Format('trace:> [TgtkObject.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count])); Assert(False, Format('trace:> [TgtkObject.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result if Result
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
begin begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin
UseFont := GetDefaultFont;
UnRef := True;
end
else begin
UseFont := CurrentFont^.GDIFontObject;
UnRef := False;
end;
if GC = nil if GC = nil
then begin then begin
WriteLn('WARNING: [TgtkObject.ExtTextOut] Uninitialized GC'); WriteLn('WARNING: [TgtkObject.ExtTextOut] Uninitialized GC');
Result := False; Result := False;
end end
else if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin
WriteLn('WARNING: [TgtkObject.ExtTextOut] Missing font');
Result := False;
end
else begin else begin
// TODO: implement other parameters. If UseFont = nil then begin
//ADC := SaveDC(DC); WriteLn('WARNING: [TgtkObject.ExtTextOut] Missing Font');
//pStr := StrAlloc(Count + 1); Result := False;
//StrLCopy(pStr, Str, Count); end
//pStr[Count] := #0; else begin
if (Options and ETO_OPAQUE) <> 0 then // TODO: implement other parameters.
begin //ADC := SaveDC(DC);
Width := Rect^.Right - Rect^.Left; if (Options and ETO_OPAQUE) <> 0 then
Height := Rect^.Bottom - Rect^.Top; begin
gdk_gc_set_fill(GC, GDK_SOLID); Width := Rect^.Right - Rect^.Left;
gdk_gc_set_foreground(GC, @CurrentBackColor); Height := Rect^.Bottom - Rect^.Top;
gdk_draw_rectangle(Drawable, GC, 1, gdk_gc_set_fill(GC, GDK_SOLID);
gdk_gc_set_foreground(GC, @CurrentBackColor);
gdk_draw_rectangle(Drawable, GC, 1,
Rect^.Left, Rect^.Top, Width, Height); Rect^.Left, Rect^.Top, Width, Height);
end;
SelectGDKTextProps(DC);
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;
//Line := 1;
//OldText := StrPas(pStr);
Num := FindChar(#10,Str,Count);
AY := Y;
GetTextMetrics(DC, TM);
TxtPt.X := X;
TxtPt.Y := AY + TM.tmAscent;
if Num < 0 then begin
if Count> 0 then
gdk_draw_text(Drawable, CurrentFont^.GDIFontObject, GC,
TxtPt.X, TxtPt.Y, Str, Count);
end else
Begin //write multiple lines
LineStart:=Str;
StrEnd:=Str+Count;
while LineStart < StrEnd do begin
//NewText := Copy(OldText,1,Num);
//Case OldText[Num] of
// #13,#10 : Delete(NewText,Num,1);
//end;
//If Num -1 > 0 then
// Case OldText[Num-1] of
// #13,#10 : Delete(NewText,Num-1,1);
// end;
LineEnd:=LineStart+Num;
if Num>0 then
gdk_draw_text(Drawable, CurrentFont^.GDIFontObject, GC,
TxtPt.X, TxtPt.Y, LineStart, Num);
AY := TxtPt.Y;
TxtPt.Y := AY + TM.tmAscent;
//Delete(OldText,1,Num);
//Num := pos(#10,OldText);
LineStart:=LineEnd+1; // skip #10
if (LineStart<StrEnd) and (LineStart^=#13) then
inc(LineStart); // skip #10
Count:=StrEnd-LineStart;
Num:=FindChar(#10,LineStart,Count);
if Num<0 then
Num:=Count;
//inc(line);
end; end;
//if OldText <> '' then begin if (Options and ETO_CLIPPED) <> 0 then
// gdk_draw_text(Drawable, CurrentFont^.GDIFontObject, GC, begin
// TxtPt.X, TxtPt.Y, pchar(OldText), length(OldText)); X := Rect^.Left;
//end; Y := Rect^.Top;
IntersectClipRect(DC, Rect^.Left, Rect^.Top, Rect^.Right,
Rect^.Bottom);
end;
Num := FindChar(#10,Str,Count);
AY := Y;
GetTextMetrics(DC, TM);
TxtPt.X := X;
{$IfDef Win32}
TxtPt.Y := AY + TM.tmHeight div 2;
{$Else}
TxtPt.Y := AY + TM.tmAscent;
{$EndIf}
SelectGDKTextProps(DC);
if Num < 0 then begin
if Count> 0 then
gdk_draw_text(Drawable, UseFont, GC,
TxtPt.X, TxtPt.Y, Str, Count);
end else
Begin //write multiple lines
LineStart:=Str;
StrEnd:=Str+Count;
while LineStart < StrEnd do begin
LineEnd:=LineStart+Num;
if Num>0 then
gdk_draw_text(Drawable, UseFont, GC,
TxtPt.X, TxtPt.Y, LineStart, Num);
AY := TxtPt.Y;
{$IfDef Win32}
TxtPt.Y := AY + TM.tmHeight div 2;
{$Else}
TxtPt.Y := AY + TM.tmAscent;
{$EndIf}
LineStart:=LineEnd+1; // skip #10
if (LineStart<StrEnd) and (LineStart^=#13) then
inc(LineStart); // skip #10
Count:=StrEnd-LineStart;
Num:=FindChar(#10,LineStart,Count);
if Num<0 then
Num:=Count;
end;
end;
//RestoreDC(DC, ADC);
If UnRef then
GDK_Font_UnRef(UseFont);
end; end;
//RestoreDC(DC, ADC);
//StrDispose(pStr);
end; end;
end; end;
Assert(False, Format('trace:< [TgtkObject.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count])); Assert(False, Format('trace:< [TgtkObject.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
@ -3306,6 +3308,8 @@ end;
function TgtkObject.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; function TgtkObject.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
var var
lbearing, rbearing, width, ascent,descent: LongInt; lbearing, rbearing, width, ascent,descent: LongInt;
UseFont : PGDKFont;
UnRef : Boolean;
begin begin
Assert(False, 'trace:> [TgtkObject.GetTextExtentPoint]'); Assert(False, 'trace:> [TgtkObject.GetTextExtentPoint]');
Result := IsValidDC(DC); Result := IsValidDC(DC);
@ -3314,14 +3318,23 @@ begin
begin begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin then begin
WriteLn('WARNING: [TgtkObject.GetTextExtentPoint] Missing font'); UseFont := GetDefaultFont;
Result := False; UnRef := True;
end end
else begin else begin
gdk_text_extents(CurrentFont^.GDIFontObject, Str, Count, @lbearing, @rBearing, @width, @ascent, @descent); UseFont := CurrentFont^.GDIFontObject;
UnRef := False;
end;
If UseFont = nil then
WriteLn('WARNING: [TgtkObject.GetTextExtentPoint] Missing font')
else begin
gdk_text_extents(UseFont, Str, Count, @lbearing, @rBearing, @width, @ascent, @descent);
Size.cX := Width; Size.cX := Width;
//I THINK this is accurate... //I THINK this is accurate...
Size.cY := GDK_String_Height(CurrentFont^.GDIFontObject, Str) + descent div 2; Size.cY := GDK_String_Height(UseFont, Str)
{$IfNDef Win32} + descent div 2{$EndIf};
If UnRef then
GDK_Font_UnRef(UseFont);
end; end;
end; end;
Assert(False, 'trace:< [TgtkObject.GetTextExtentPoint]'); Assert(False, 'trace:< [TgtkObject.GetTextExtentPoint]');
@ -3342,6 +3355,8 @@ const
var var
XT : TSize; XT : TSize;
lbearing, rbearing, dummy: LongInt; lbearing, rbearing, dummy: LongInt;
UseFont : PGDKFont;
UnRef : Boolean;
begin begin
Assert(False, Format('Trace:> TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC])); Assert(False, Format('Trace:> TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC]));
@ -3350,25 +3365,32 @@ begin
with PDeviceContext(DC)^ do begin with PDeviceContext(DC)^ do begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin then begin
WriteLn('WARNING: [TgtkObject.GetTGextMetrics] Missing font'); UseFont := GetDefaultFont;
Result := False; UnRef := True;
end end
else with TM do begin else begin
FillChar(TM, SizeOf(TM), 0); UseFont := CurrentFont^.GDIFontObject;
gdk_text_extents(CurrentFont^.GDIFontObject, TestString, UnRef := False;
length(TestString), @lbearing, @rBearing, @dummy, end;
@tmAscent, @tmDescent); If UseFont = nil then
GetTextExtentPoint(DC, AVGBuffer, StrLen(AVGBuffer), XT); WriteLn('WARNING: [TgtkObject.GetTGextMetrics] Missing font')
XT.cX := XT.cX div StrLen(AVGBuffer); else begin
tmHeight := XT.cY; with TM do begin
tmAscent := tmHeight - tmDescent; FillChar(TM, SizeOf(TM), 0);
tmAveCharWidth := XT.cX; gdk_text_extents(UseFont, TestString,
if tmAveCharWidth<2 then tmAveCharWidth:=2; length(TestString), @lbearing, @rBearing, @dummy,
tmMaxCharWidth := gdk_char_width(CurrentFont^.GDIFontObject, 'W'); // temp hack @tmAscent, @tmDescent);
if tmMaxCharWidth<2 then tmMaxCharWidth:=2; GetTextExtentPoint(DC, AVGBuffer, StrLen(AVGBuffer), XT);
//writeln('TgtkObject.GetTextMetrics lbearing=',lbearing,' rBearing=',rBearing, XT.cX := XT.cX div StrLen(AVGBuffer);
//' tmAscent=',tmAscent,' tmDescent=',tmDescent,' tmAveCharWidth=',tmAveCharWidth, tmHeight := XT.cY;
//' tmMaxCharWidth=',tmMaxCharWidth); tmAscent := tmHeight - tmDescent;
tmAveCharWidth := XT.cX;
if tmAveCharWidth<2 then tmAveCharWidth:=2;
tmMaxCharWidth := gdk_char_width(UseFont, 'W'); // temp hack
if tmMaxCharWidth<2 then tmMaxCharWidth:=2;
If UnRef then
GDK_Font_UnRef(UseFont);
end;
end; end;
end; end;
Assert(False, Format('Trace:< TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC])); Assert(False, Format('Trace:< TODO FINISH[TgtkObject.GetTextMetrics] DC: 0x%x', [DC]));
@ -5005,7 +5027,7 @@ begin
if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)),
gtk_clist_get_type) gtk_clist_get_type)
then then
Adjustment := gtk_clist_get_hadjustment(PgtkCList(handle)); Adjustment := {$IfDef Win32}nil{$Else}gtk_clist_get_hadjustment(PgtkCList(handle)){$EndIf};
SB_VERT: SB_VERT:
if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)),
@ -5022,7 +5044,7 @@ begin
if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)),
gtk_clist_get_type) gtk_clist_get_type)
then then
Adjustment := gtk_clist_get_vadjustment(PgtkCList(handle)); Adjustment := {$IfDef Win32}nil{$Else}gtk_clist_get_vadjustment(PgtkCList(handle)){$EndIf};
SB_CTL: SB_CTL:
if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_range_get_type) if gtk_type_is_a(gtk_object_type(PGTKObject(Handle)), gtk_range_get_type)
@ -5378,6 +5400,14 @@ var
ScaleBMP : hBITMAP; ScaleBMP : hBITMAP;
Scale : PGdiObject; Scale : PGdiObject;
{$IfDef Win32}
Procedure gdk_window_copy_area(Dest : PGDKWindow; GC : PGDKGC; X,
Y : Longint; SRC : PGDKWindow; XSRC, YSRC, Width, Height : Longint);
begin
gdk_draw_pixmap(Dest, GC, Src, XSrc, YSrc, X, Y, Width, Height);
End;
{$EndIf}
Procedure SetClipping(DestGC : PGDKGC; GDIBitmap : PGdiObject); Procedure SetClipping(DestGC : PGDKGC; GDIBitmap : PGdiObject);
begin begin
if (GDIBitmap <> NIL) AND (GDIBitmap^.GDIBitmapMaskObject <> nil) then if (GDIBitmap <> NIL) AND (GDIBitmap^.GDIBitmapMaskObject <> nil) then
@ -5823,6 +5853,8 @@ var
txtpt : TPoint; txtpt : TPoint;
sz : TSize; sz : TSize;
TM : TTextMetric; TM : TTextMetric;
UseFont : PGDKFont;
UnRef : Boolean;
begin begin
Result := IsValidDC(DC); Result := IsValidDC(DC);
if Result if Result
@ -5831,25 +5863,37 @@ begin
if GC = nil if GC = nil
then begin then begin
WriteLn('WARNING: [TgtkObject.TextOut] Uninitialized GC'); WriteLn('WARNING: [TgtkObject.TextOut] Uninitialized GC');
Result := False;
end
else
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin
WriteLn('WARNING: [TgtkObject.TextOut] Missing font');
Result := False;
end end
else begin else begin
GetTextExtentPoint(DC, Str, Count, Sz); if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
aRect := Rect(X,Y,X + Sz.CX, Sz.CY); then begin
FillRect(DC,aRect,hBrush(CurrentBrush)); UseFont := GetDefaultFont;
SelectGDKTextProps(DC); UnRef := True;
GetTextMetrics(DC, TM); end
TxtPt.X := X; else begin
TxtPt.Y := Y + TM.tmAscent; UseFont := CurrentFont^.GDIFontObject;
gdk_draw_text(Drawable,CurrentFont^.GDIFontObject, UnRef := False;
GC, TxtPt.X, TxtPt.Y, Str, Count); end;
Result := True; If UseFont = nil then
WriteLn('WARNING: [TgtkObject.TextOut] Missing Font')
else begin
GetTextExtentPoint(DC, Str, Count, Sz);
aRect := Rect(X,Y,X + Sz.CX, Sz.CY);
FillRect(DC,aRect,hBrush(CurrentBrush));
GetTextMetrics(DC, TM);
TxtPt.X := X;
{$IfDef Win32}
TxtPt.Y := Y + TM.tmHeight div 2;
{$Else}
TxtPt.Y := Y + TM.tmAscent;
{$EndIf}
SelectGDKTextProps(DC);
gdk_draw_text(Drawable, UseFont,
GC, TxtPt.X, TxtPt.Y, Str, Count);
Result := True;
If UnRef then
GDK_Font_UnRef(UseFont);
end;
end; end;
end; end;
end; end;
@ -6037,6 +6081,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.110 2002/08/24 06:51:24 lazarus
MG: from Andrew: style list fixes, autosize for radio/checkbtns
Revision 1.109 2002/08/22 16:43:36 lazarus Revision 1.109 2002/08/22 16:43:36 lazarus
MG: improved theme support from Andrew MG: improved theme support from Andrew