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

improved TLabel autosizing

Browse Source 
git-svn-id: trunk@6627 -
This commit is contained in:
mattias 2005-01-17 16:42:35 +00:00
parent 2d37fafe6a
commit ed02f73289
6 changed files with 75 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
designer/anchoreditor.pas
View File

@ -329,6 +329,7 @@ begin
if (Values=nil) then begin
Caption:='Anchor Editor - no control selected';
BorderSpaceGroupBox.Enabled:=false;
TopGroupBox.Enabled:=false;
LeftGroupBox.Enabled:=false;
RightGroupBox.Enabled:=false;
@ -337,6 +338,7 @@ begin
Caption:='Anchors of selected controls';
// all
BorderSpaceGroupBox.Enabled:=true;
if Values.AmbigiousBorderspaceAround then
AroundBorderSpaceSpinEdit.Value:=-1
else

7
lcl/controls.pp
View File

@ -1402,7 +1402,7 @@ type
FBrush: TBrush;
FAdjustClientRectRealized: TRect;
FChildSizing: TControlChildSizing;
FControls: TList;
FControls: TList; // the child controls (only TControl, no TWinControl)
FDefWndProc: Pointer;
FDockClients: TList;
//FDockSite: Boolean;
@ -1435,7 +1435,7 @@ type
FTabStop: Boolean;
FTabList: TList;
FUseDockManager: Boolean;
FWinControls: TList;
FWinControls: TList; // the child controls (only TWinControl, no TControl)
procedure AlignControl(AControl: TControl);
function GetBrush: TBrush;
function GetControl(const Index: Integer): TControl;
@ -2820,6 +2820,9 @@ end.
{ =============================================================================
$Log$
Revision 1.268 2005/01/17 16:42:35 mattias
improved TLabel autosizing
Revision 1.267 2005/01/17 11:53:39 mattias
added showing all four sides to AnchorEditor

29
lcl/include/customlabel.inc
View File

@ -29,21 +29,27 @@ Procedure TCustomLabel.DoAutoSize;
var
R : TRect;
DC : hDC;
Flags: Cardinal;
OldFont: HGDIOBJ;
begin
//debugln('TCustomLabel.DoAutoSize ',DbgSName(Self),' AutoSizing=',dbgs(AutoSizing),' AutoSize=',dbgs(AutoSize),' Parent=',DbgSName(Parent),' Parent.HandleAllocated=',dbgs(Parent.HandleAllocated),' csLoading=',dbgs(csLoading in ComponentState));
If AutoSizing or not AutoSize then
Exit;
if (Parent = nil) or (not Parent.HandleAllocated) or ([csLoading,csDestroying]*ComponentState<>[]) then
if (Parent = nil) or (not Parent.HandleAllocated)
or ([csLoading,csDestroying]*ComponentState<>[]) then
exit;
AutoSizing := True;
DC := GetDC(Parent.Handle);
Try
R := Rect(0,0, Width, Height);
SelectObject(DC, Font.Handle);
DrawText(DC, PChar(Caption), Length(Caption), R,
DT_CalcRect or DT_NoPrefix or DT_WordBreak);
OldFont:=SelectObject(DC, Font.Handle);
Flags:=DT_CalcRect or DT_NoPrefix;
if WordWrap then inc(Flags,DT_WordBreak);
DrawText(DC, PChar(Caption), Length(Caption), R, Flags);
SelectObject(DC, OldFont);
//debugln('TCustomLabel.DoAutoSize R=',dbgs(R));
Width := R.Right - R.Left;
Height := R.Bottom - R.Top;
SetBounds(Left,Top,R.Right - R.Left,R.Bottom - R.Top);
Finally
ReleaseDC(Parent.Handle, DC);
AutoSizing := False;
@ -146,6 +152,12 @@ begin
end;
end;
procedure TCustomLabel.Loaded;
begin
inherited Loaded;
DoAutoSize;
end;
Procedure TCustomLabel.Paint;
var
TR : TTextStyle;
@ -179,6 +191,8 @@ begin
LineTo(Width - 1,Height);
end;
}
//Brush.Color:=clRed;
//FillRect(R);
FillChar(TR,SizeOf(TR),0);
With TR do begin
Alignment := Self.Alignment;
@ -202,6 +216,9 @@ end;
{
$Log$
Revision 1.22 2005/01/17 16:42:35 mattias
improved TLabel autosizing
Revision 1.21 2005/01/08 22:13:21 vincents
TLabel.ShowAccelChar default value is True

7
lcl/include/wincontrol.inc
View File

@ -3557,6 +3557,7 @@ procedure TWinControl.CreateWnd;
var
Params: TCreateParams;
n: Integer;
i: Integer;
{ procedure WriteClientRect(const Prefix: string);
var r: TRect;
@ -3619,6 +3620,9 @@ begin
// size this control
{$IFDEF EnablePreferredSize}
AdjustSize;
if FControls<>nil then
for i:=0 to FControls.Count-1 do
TControl(FControls[i]).DoAutoSize;
{$ENDIF}
// realign childs
ReAlign;
@ -4299,6 +4303,9 @@ end;
{ =============================================================================
$Log$
Revision 1.299 2005/01/17 16:42:35 mattias
improved TLabel autosizing
Revision 1.298 2005/01/16 11:40:10 mattias
fixed TGtkWidgetSet.ExtSelectClipRGN for DCOrigin

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

@ -2700,7 +2700,8 @@ end;
Returns: If the string was drawn, or CalcRect run
------------------------------------------------------------------------------}
function TGtkWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer;
function TGtkWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer;
var Rect: TRect; Flags: Cardinal): Integer;
var
TM : TTextmetric;
theRect : TRect;
@ -2748,6 +2749,7 @@ var
MaxLength := theRect.Right - theRect.Left;
If (Flags and DT_SingleLine) = DT_SingleLine then begin
// ignore word and line breaks
GetTextExtentPoint(DC, Str, Count, AP);
theRect.Right := theRect.Left + Min(MaxLength, AP.cX);
theRect.Bottom := theRect.Top + TM.tmHeight;
@ -2761,24 +2763,28 @@ var
end;
end
else begin
If (Flags and DT_WordBreak) <> DT_WordBreak then
MaxLength := Count*TM.tmMaxCharWidth;
// consider line breaks
If (Flags and DT_WordBreak) <> DT_WordBreak then begin
// do not break at word boundaries
GetTextExtentPoint(DC, Str, Count, AP);
MaxLength := AP.cX;
end;
Self.WordWrap(DC, Str, MaxLength, Lines, NumLines);
If (Lines = nil) or (NumLines = 0) then
exit;
LineWidth := 0;
For J := 0 to NumLines - 1 do begin
GetTextExtentPoint(DC, Lines[J], StrLen(Lines[J]), AP);
LineWidth := Max(LineWidth, AP.cX);
If (Lines <> nil) then begin
For J := 0 to NumLines - 1 do begin
GetTextExtentPoint(DC, Lines[J], StrLen(Lines[J]), AP);
LineWidth := Max(LineWidth, AP.cX);
end;
end;
LineWidth := Min(MaxLength, LineWidth);
theRect.Right := theRect.Left + LineWidth;
theRect.Bottom := theRect.Top + NumLines*TM.tmHeight;
//debugln('TGtkWidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines));
end;
If not CalcRect then
@ -2876,8 +2882,13 @@ begin
DoCalcRect;
If (Flags and DT_CalcRect) <> DT_CalcRect then begin
If (Flags and DT_CalcRect) = DT_CalcRect then begin
CopyRect(Rect, theRect);
Result := 1;
exit;
end else begin
TempDC := SaveDC(DC);
end;
If (Flags and DT_NOCLIP) <> DT_NOCLIP then begin
If theRect.Right > Rect.Right then
@ -2892,25 +2903,19 @@ begin
DrawLine(Str, Count, theRect.Top);
Result := 1;
end
else
If (Lines <> nil) and (NumLines <> 0) then begin
For I := 0 to NumLines - 1 do begin
If (((Flags and DT_EditControl) = DT_EditControl) and
(tm.tmHeight > (theRect.Bottom - theRect.Top))) or
(theRect.Top > theRect.Bottom)
then
break;
else If (Lines <> nil) and (NumLines <> 0) then begin
For I := 0 to NumLines - 1 do begin
If (((Flags and DT_EditControl) = DT_EditControl) and
(tm.tmHeight > (theRect.Bottom - theRect.Top))) or
(theRect.Top > theRect.Bottom)
then
break;
If Lines[I] <> nil then
DrawLine(Lines[I], StrLen(Lines[I]), theRect.Top);
If Lines[I] <> nil then
DrawLine(Lines[I], StrLen(Lines[I]), theRect.Top);
Inc(theRect.Top, TM.tmHeight);
end;
Result := 1;
Inc(theRect.Top, TM.tmHeight);
end;
end
else begin
CopyRect(Rect, theRect);
Result := 1;
end;
@ -8852,6 +8857,9 @@ end;
{ =============================================================================
$Log$
Revision 1.387 2005/01/17 16:42:35 mattias
improved TLabel autosizing
Revision 1.386 2005/01/17 15:36:31 mattias
improved gtk intf to calculate TextHeight

4
lcl/stdctrls.pp
View File

@ -1099,6 +1099,7 @@ type
procedure SetLayout(Value: TTextLayout);
procedure SetShowAccelChar(Value: Boolean);
procedure SetWordWrap(Value: Boolean);
procedure Loaded; override;
property Alignment: TAlignment read GetAlignment write SetAlignment;
property FocusControl: TWinControl read FFocusControl write SetFocusControl;
@ -1212,6 +1213,9 @@ end.
{ =============================================================================
$Log$
Revision 1.184 2005/01/17 16:42:35 mattias
improved TLabel autosizing
Revision 1.183 2005/01/11 21:36:36 micha
remove TStaticText.Layout property, not supported by delphi, hard to implement