paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 23:38:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

added auto column sizing from Jesus

Browse Source 
git-svn-id: trunk@6413 -
This commit is contained in:
mattias 2004-12-23 19:24:46 +00:00
parent 9103a0a167
commit caa5ef7bac
3 changed files with 275 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
examples/codepageconverter/lazconverter.lpi
View File

@ -35,7 +35,7 @@
<UsageCount Value="29"/>
</Unit1>
<Unit2>
<CursorPos X="30" Y="16"/>
<CursorPos X="6" Y="26"/>
<EditorIndex Value="1"/>
<Filename Value="viewunit.pas"/>
<ComponentName Value="ViewForm"/>

138
lcl/dbgrids.pas
View File

@ -188,6 +188,7 @@ type
FFont: TFont;
FisDefaultFont: Boolean;
FPickList: TStrings;
FMinSize, FMaxSize, FSizePriority: ^Integer;
procedure FontChanged(Sender: TObject);
function GetAlignment: TAlignment;
@ -197,6 +198,9 @@ type
function GetFont: TFont;
function GetGrid: TCustomDBGrid;
function GetLayout: TTextLayout;
function GetMaxSize: Integer;
function GetMinSize: Integer;
function GetSizePriority: Integer;
function GetPickList: TStrings;
function GetReadOnly: Boolean;
function GetVisible: Boolean;
@ -205,7 +209,10 @@ type
function IsColorStored: boolean;
function IsFontStored: boolean;
function IsLayoutStored: boolean;
function IsMinSizeStored: boolean;
function IsMaxSizeStored: boolean;
function IsReadOnlyStored: boolean;
function IsSizePriorityStored: boolean;
function IsVisibleStored: boolean;
function IsWidthStored: boolean;
procedure SetAlignment(const AValue: TAlignment);
@ -216,8 +223,11 @@ type
procedure SetFieldName(const AValue: String);
procedure SetFont(const AValue: TFont);
procedure SetLayout(const AValue: TTextLayout);
procedure SetMaxSize(const AValue: Integer);
procedure SetMinSize(const Avalue: Integer);
procedure SetPickList(const AValue: TStrings);
procedure SetReadOnly(const AValue: Boolean);
procedure SetSizePriority(const AValue: Integer);
procedure SetTitle(const AValue: TColumnTitle);
procedure SetVisible(const AValue: Boolean);
procedure SetWidth(const AValue: Integer);
@ -225,6 +235,9 @@ type
function GetDataSet: TDataSet;
function GetDefaultReadOnly: boolean;
function GetDefaultWidth: Integer;
function GetDefaultMinSize: Integer;
function GetDefaultMaxSize: Integer;
function GetDefaultSizePriority: Integer;
protected
{$ifdef ver1_0}
// workaround to access protected procedure in base class
@ -252,8 +265,11 @@ type
property FieldName: String read FFieldName write SetFieldName;
property Font: TFont read GetFont write SetFont stored IsFontStored;
property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored;
property MinSize: Integer read GetMinSize write SetMinSize stored IsMinSizeStored;
property MaxSize: Integer read GetMaxSize write SetMaxSize stored isMaxSizeStored;
property PickList: TStrings read GetPickList write SetPickList;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly stored IsReadOnlyStored;
property SizePriority: Integer read GetSizePriority write SetSizePriority stored IsSizePriorityStored;
property Title: TColumnTitle read FTitle write SetTitle;
property Width: Integer read GetWidth write SetWidth stored IsWidthStored;
property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored;
@ -387,6 +403,7 @@ type
function EditorCanAcceptKey(const ch: Char): boolean; override;
function EditorIsReadOnly: boolean; override;
procedure EndLayout;
procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); override;
function GetEditMask(aCol, aRow: Longint): string; override;
function GetEditText(aCol, aRow: Longint): string; override;
function GridCanModify: boolean;
@ -440,6 +457,7 @@ type
property Align;
property Anchors;
property AutoAdvance;
property AutoFillColumns;
//property BiDiMode;
property BorderStyle;
property Color;
@ -1723,6 +1741,25 @@ begin
DoLayoutChanged;
end;
procedure TCustomDbGrid.GetAutoFillColumnInfo(const Index: Integer; var aMin,
aMax, aPriority: Integer);
var
C: TColumn;
begin
if Index<FixedCols then
APriority := 0
else if FColumns.Enabled then begin
C := ColumnFromGridColumn(Index);
if C<>nil then begin
aMin := C.MinSize;
aMax := C.MaxSize;
aPriority := C.SizePriority;
end else
APriority := 1;
end else
APriority := 1;
end;
procedure TCustomDbGrid.DoExit;
begin
if not EditorShowing then begin
@ -2384,6 +2421,30 @@ begin
result := FLayout^;
end;
function TColumn.GetMaxSize: Integer;
begin
if FMaxSize=nil then
result := GetDefaultMaxSize
else
result := FMaxSize^;
end;
function TColumn.GetMinSize: Integer;
begin
if FMinSize=nil then
result := GetDefaultMinSize
else
result := FMinSize^;
end;
function TColumn.GetSizePriority: Integer;
begin
if FMaxSize=nil then
result := GetDefaultSizePriority
else
result := FSizePriority^;
end;
function TColumn.GetPickList: TStrings;
begin
Result := FPickList;
@ -2436,11 +2497,26 @@ begin
result := FLayout <> nil;
end;
function TColumn.IsMinSizeStored: boolean;
begin
result := FMinSize <> nil;
end;
function TColumn.IsMaxSizeStored: boolean;
begin
result := FMaxSize <> nil;
end;
function TColumn.IsReadOnlyStored: boolean;
begin
result := FReadOnly <> nil;
end;
function TColumn.IsSizePriorityStored: boolean;
begin
result := FSizePriority <> nil;
end;
function TColumn.IsVisibleStored: boolean;
begin
result := (FVisible<>nil) and not FVisible^;
@ -2518,6 +2594,26 @@ begin
FieldChanged;
end;
procedure TColumn.SetMaxSize(const AValue: Integer);
begin
if FMaxSize = nil then
New(FMaxSize)
else if FMaxSize^ = AVAlue then
exit;
FMaxSize^ := AValue;
FieldChanged;
end;
procedure TColumn.SetMinSize(const Avalue: Integer);
begin
if FMinSize = nil then
New(FMinSize)
else if FMinSize^ = AVAlue then
exit;
FMinSize^ := AValue;
FieldChanged;
end;
procedure TColumn.SetPickList(const AValue: TStrings);
begin
if AValue=nil then
@ -2536,6 +2632,16 @@ begin
FieldChanged;
end;
procedure TColumn.SetSizePriority(const AValue: Integer);
begin
if FSizePriority = nil then
New(FSizePriority)
else if FSizePriority^ = AVAlue then
exit;
FSizePriority^ := AValue;
FieldChanged;
end;
procedure TColumn.SetTitle(const AValue: TColumnTitle);
begin
FTitle.Assign(AValue);
@ -2591,6 +2697,31 @@ begin
result := 64;
end;
function TColumn.GetDefaultMinSize: Integer;
begin
// get a better default
result := 10;
end;
function TColumn.GetDefaultMaxSize: Integer;
begin
// get a better default
result := 200;
end;
function TColumn.GetDefaultSizePriority: Integer;
var
TheGrid: TCustomDbGrid;
begin
// Get a better default
TheGrid := Grid;
Result := 0;
if (theGrid<>nil)and(TheGrid.AutoFillColumns) then
result := 1
else
result := 0;
end;
procedure TColumn.FillDefaultFont;
var
TheGrid: TCustomDbGrid;
@ -2667,7 +2798,8 @@ function TColumn.IsDefault: boolean;
begin
result := FTitle.IsDefault and (FAlignment=nil) and (FColor=nil)
and (FVisible=nil) and (FReadOnly=nil) and (FWidth=nil) and FIsDefaultFont
and (FLayout=nil);
and (FLayout=nil) and (FMaxSize=nil) and (FMinSize=nil)
and (FSizePriority=nil);
end;
{ TColumnTitle }
@ -2854,8 +2986,8 @@ end.
{
$Log$
Revision 1.23 2004/12/22 20:02:25 mattias
defaultrowheight property is set to 20 pixels and fixes from Jesus
Revision 1.24 2004/12/23 19:24:46 mattias
added auto column sizing from Jesus
Revision 1.22 2004/12/21 22:49:29 mattias
implemented scrollbar codes for gtk intf from Jesus

153
lcl/grids.pas
View File

@ -267,6 +267,7 @@ type
TCustomGrid=class(TCustomControl)
private
FAutoAdvance: TAutoAdvance;
FAutoFillColumns: boolean;
FDefaultDrawing: Boolean;
FEditor: TWinControl;
FEditorHiding: Boolean;
@ -305,12 +306,15 @@ type
FGSMHBar, FGSMVBar: Integer; // Scrollbar's metrics
FVSbVisible, FHSbVisible: boolean;
FDefaultTextStyle: TTextStyle;
FLastWidth: Integer;
procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer);
procedure CacheVisibleGrid;
function CalcColumnWidth(Index: Integer): Integer;
procedure CheckFixedCount(aCol,aRow,aFCol,aFRow: Integer);
procedure CheckCount(aNewColCount, aNewRowCount: Integer);
function CheckTopLeft(aCol,aRow: Integer; CheckCols,CheckRows: boolean): boolean;
procedure SetAutoFillColumns(const AValue: boolean);
procedure SetFlat(const AValue: Boolean);
procedure SetFocusRectVisible(const AValue: Boolean);
function doColSizing(X,Y: Integer): Boolean;
@ -339,6 +343,7 @@ type
function GetVisibleColCount: Integer;
function GetVisibleGrid: TRect;
function GetVisibleRowCount: Integer;
procedure InternalAutoFillColumns;
procedure MyTextRect(R: TRect; Offx,Offy:Integer; S:string; Clipping: boolean);
procedure ReadColWidths(Reader: TReader);
procedure ReadRowHeights(Reader: TReader);
@ -346,6 +351,7 @@ type
function ScrollGrid(Relative:Boolean; DCol,DRow: Integer): TPoint;
procedure SetCol(Valor: Integer);
procedure SetColwidths(Acol: Integer; Avalue: Integer);
procedure SetRawColWidths(ACol: Integer; AValue: Integer);
procedure SetColCount(Valor: Integer);
procedure SetDefColWidth(Valor: Integer);
procedure SetDefRowHeight(Valor: Integer);
@ -381,6 +387,7 @@ type
fGridState: TGridState;
procedure AutoAdjustColumn(aCol: Integer); virtual;
procedure BeforeMoveSelection(const DCol,DRow: Integer); virtual;
procedure CalcAutoSizeColumn(const Index: Integer; var AMin,AMax,APriority: Integer); dynamic;
procedure CalcFocusRect(var ARect: TRect);
procedure CellClick(const aCol,aRow: Integer); virtual;
procedure CheckLimits(var aCol,aRow: Integer);
@ -397,6 +404,7 @@ type
procedure DoExit; override;
procedure DoEnter; override;
procedure DoOnChangeBounds; override;
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
procedure DrawBackGround; virtual;
procedure DrawBorder;
procedure DrawByRows; virtual;
@ -413,6 +421,7 @@ type
procedure EditordoSetValue; virtual;
function EditorCanAcceptKey(const ch: Char): boolean; virtual;
function EditorIsReadOnly: boolean; virtual;
procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); dynamic;
function GetFixedcolor: TColor; virtual;
function GetSelectedColor: TColor; virtual;
function GetEditMask(ACol, ARow: Longint): string; dynamic;
@ -466,6 +475,7 @@ type
procedure WndProc(var TheMessage : TLMessage); override;
property AutoAdvance: TAutoAdvance read FAutoAdvance write FAutoAdvance default aaRight;
property AutoFillColumns: boolean read FAutoFillColumns write SetAutoFillColumns;
property BorderStyle default bsSingle;
property Col: Integer read FCol write SetCol;
property ColCount: Integer read GetColCount write SetColCount;
@ -568,6 +578,7 @@ type
procedure DrawFocusRect(aCol,aRow: Integer; ARect: TRect); override;
procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
procedure HeaderSized(IsColumn: Boolean; index: Integer); override;
procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); override;
function GetEditMask(aCol, aRow: Longint): string; override;
function GetEditText(aCol, aRow: Longint): string; override;
function SelectCell(aCol,aRow: Integer): boolean; override;
@ -873,20 +884,8 @@ procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor);
inc(X1, constRubberSpace);
end;
end;
// var OldStyle: TPenStyle;
begin
with aRect do begin
{
OldStyle := Canvas.Pen.Style;
Canvas.Pen.Color:=Color;
Canvas.Pen.Style:=psDot;
Canvas.MoveTo(Left, Top);
Canvas.LineTo(Right-2, Top);
Canvas.LineTo(Right-2, Bottom-2);
Canvas.LineTo(Left, Bottom-2);
Canvas.LineTo(Left, Top+1);
Canvas.Pen.Style:=OldStyle
}
DrawHorzLine(Left, Top, Right-1);
DrawVertLine(Right-1, Top, Bottom-1);
DrawHorzLine(Right-1, Bottom-1, Left);
@ -926,6 +925,77 @@ begin
Result:=r.bottom-r.top+1;
end;
procedure TCustomGrid.InternalAutoFillColumns;
var
I, ForcedIndex: Integer;
Count: Integer;
aPriority, aMin, aMax: Integer;
AvailableSize: Integer;
TotalWidth: Integer; // total grid's width
FixedSizeWidth: Integer; // total width of Fixed Sized Columns
begin
if not AutoFillColumns then
exit;
// if needed, last size can be obtained from FLastWidth
// when InternalAutoFillColumns is called from DoChangeBounds
// for example.
// Insert the algorithm that modify ColWidths accordingly
//
// For testing purposes, a simple algortihm is implemented:
// if SizePriority=0, column size should be unmodified
// if SizePriority<>0 means variable size column, its size
// is the average avalilable size.
Count := 0;
FixedSizeWidth := 0;
TotalWidth := 0;
for i:=0 to ColCount-1 do begin
GetAutoFillColumnInfo(i, aMin, aMax, aPriority);
AvailableSize := GetColWidths(i);
if aPriority>0 then
Inc(Count)
else
Inc(FixedSizeWidth, AvailableSize);
Inc(TotalWidth, AvailableSize);
end;
if Count=0 then begin
//it's an autofillcolumns grid, so at least one
// of the columns must fill completly the grid's
// available width, let it be that column the last
ForcedIndex := ColCount-1;
Count := 1;
end else
ForcedIndex := -1;
AvailableSize := Width - FixedSizeWidth;
if AvailableSize<0 then begin
// There is no space available to fill with
// Variable Size Columns, what to do?
// Simply set all Variable Size Columns
// to 0, decreasing the size beyond this
// shouldn't be allowed.
for i:=0 to ColCount-1 do begin
GetAutoFillColumnInfo(i, aMin, aMax, aPriority);
if aPriority>0 then
SetRawColWidths(i,0);
end;
end else begin
// Simpler case: There is actually available space to
// to be shared for variable size columns.
AvailableSize := AvailableSize div Count;
for i:=0 to ColCount-1 do begin
GetAutoFillColumnInfo(i, aMin, aMax, aPriority);
if (APriority>0) or (i=ForcedIndex) then
SetRawColWidths(i, AvailableSize);
end;
end;
end;
function TCustomGrid.GetLeftCol: Integer;
begin
result:=fTopLeft.x;
@ -947,7 +1017,8 @@ begin
Result:=Integer(FCols[aCol])
else
Result:=-1;
if result<0 then Result:=fDefColWidth;
if result<0 then
Result:=fDefColWidth;
end;
procedure TCustomGrid.SetEditor(AValue: TWinControl);
@ -1073,13 +1144,18 @@ procedure TCustomGrid.Setcolwidths(Acol: Integer; Avalue: Integer);
begin
if AValue<0 then Avalue:=-1;
if Avalue<>Integer(FCols[ACol]) then begin
FCols[ACol]:=Pointer(AValue);
SetRawColWidths(ACol, Avalue);
VisualChange;
if (FEditor<>nil)and(Feditor.Visible)and(ACol<=FCol) then EditorPos;
ColWidthsChanged;
end;
end;
procedure TCustomGrid.SetRawColWidths(ACol: Integer; AValue: Integer);
begin
FCols[ACol]:=Pointer(Avalue);
end;
procedure TCustomGrid.AdjustCount(IsColumn: Boolean; OldValue, newValue: Integer);
procedure AddDel(Lst: TList; aCount: Integer);
begin
@ -1296,6 +1372,9 @@ var
var
i: Integer;
begin
// Recalc colwidths if it is necesary
InternalAutoFillColumns;
// Calculate New Cached Values
FGCache.GridWidth:=0;
FGCache.FixedWidth:=0;
@ -2419,6 +2498,13 @@ begin
doTopleftChange(False)
end;
procedure TCustomGrid.SetAutoFillColumns(const AValue: boolean);
begin
FAutoFillColumns := AValue;
if FAutoFillColumns then
VisualChange;
end;
procedure TCustomGrid.SetFlat(const AValue: Boolean);
begin
if FFlat=AValue then exit;
@ -2468,6 +2554,18 @@ begin
end;
end;
function TCustomGrid.CalcColumnWidth(Index: Integer): Integer;
var
AMin,AMax,APriority: Integer;
begin
CalcAutoSizeColumn(Index, aMin, aMax, aPriority);
if aPriority=0 then
Result := GetColWidths(Index)
else begin
end;
end;
function TCustomGrid.GetSelection: TGridRect;
begin
Result:=FRange;
@ -3003,6 +3101,12 @@ begin
VisualChange;
end;
procedure TCustomGrid.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);
begin
FLastWidth := ClientWidth;
inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
end;
procedure TCustomGrid.doExit;
begin
if FEditorShowing then begin
@ -3436,6 +3540,12 @@ begin
if Assigned(OnBeforeSelection) then OnBeforeSelection(Self, DCol, DRow);
end;
procedure TCustomGrid.CalcAutoSizeColumn(const Index: Integer; var AMin, AMax,
APriority: Integer);
begin
APriority := 0;
end;
procedure TCustomGrid.CalcFocusRect(var ARect: TRect);
{
var
@ -3672,6 +3782,11 @@ begin
result := false;
end;
procedure TCustomGrid.GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer);
begin
aPriority := 0;
end;
procedure TCustomGrid.EditorExit(Sender: TObject);
begin
if not FEditorHiding then begin
@ -4625,6 +4740,15 @@ begin
if Assigned(OnHeaderSized) then OnHeaderSized(Self, IsColumn, index);
end;
procedure TDrawGrid.GetAutoFillColumnInfo(const Index: Integer; var aMin, aMax,
aPriority: Integer);
begin
if Index<FixedCols then
aPriority := 0
else
aPriority := 1;
end;
function TDrawGrid.GetEditMask(aCol, aRow: Longint): string;
begin
result:='';
@ -4924,6 +5048,7 @@ begin
//MyTExtRect(aRect, 3, 0, Cells[aCol,aRow], Canvas.Textstyle.Clipping);
end;
end;
{
procedure TStringGrid.EditordoGetValue;
var