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

LCL, implements DbGrid's dgAutoSizeColumns option

Browse Source 
git-svn-id: trunk@20735 -
This commit is contained in:
jesus 2009-06-24 21:14:29 +00:00
parent 107085faaa
commit 3b2702a0e1
2 changed files with 138 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
lcl/dbgrids.pas
View File

@ -1,3 +1,4 @@
{ $Id$}
{
/***************************************************************************
@ -64,7 +65,9 @@ type
dgMultiselect, // Ya
dgHeaderHotTracking,
dgHeaderPushedLook,
dgPersistentMultiSelect
dgPersistentMultiSelect,
dgAutoSizeColumns
);
TDbGridOptions = set of TDbGridOption;
@ -75,7 +78,7 @@ type
TDbGridExtraOptions = set of TDbGridExtraOption;
TDbGridStatusItem = (gsUpdatingData, gsAddingAutoColumns,
gsRemovingAutoColumns);
gsRemovingAutoColumns, gsAutoSized);
TDbGridStatus = set of TDbGridStatusItem;
TDataSetScrolledEvent =
@ -345,6 +348,8 @@ type
procedure GetScrollbarParams(out aRange, aPage, aPos: Integer);
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
procedure ClearSelection(selCurrent:boolean=false);
function NeedAutoSizeColumns: boolean;
procedure RenewColWidths;
protected
procedure AddAutomaticColumns;
procedure BeforeMoveSelection(const DCol,DRow: Integer); override;
@ -408,6 +413,7 @@ type
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
function SelectCell(aCol, aRow: Integer): boolean; override;
procedure UpdateActive; virtual;
procedure UpdateAutoSizeColumns;
procedure UpdateData; virtual;
function UpdateGridCounts: Integer;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
@ -436,6 +442,7 @@ type
property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
public
constructor Create(AOwner: TComponent); override;
procedure AutoSizeColumns;
procedure InitiateAction; override;
procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override;
@ -752,7 +759,7 @@ begin
{$Ifdef dbgDBGrid}
DebugLn('(',name,') ','TCustomDBGrid.OnDataSetOpen');
{$endif}
FDefaultColWidths := True;
RenewColWidths;
LinkActive(True);
UpdateActive;
end;
@ -808,7 +815,7 @@ begin
{$ifdef dbgDBGrid}
DebugLn('(',name,') ','TCustomDBGrid.OnNewDataSet');
{$endif}
FDefaultColWidths := True;
RenewColWidths;
LinkActive(True);
UpdateActive;
end;
@ -870,7 +877,7 @@ end;
procedure TCustomDBGrid.SetDataSource(const AValue: TDataSource);
begin
if AValue = FDatalink.Datasource then Exit;
FDefaultColWidths := True;
RenewColWidths;
FDataLink.DataSource := AValue;
UpdateActive;
end;
@ -1281,6 +1288,9 @@ begin
if FDefaultColWidths then begin
if dgIndicator in Options then
ColWidths[0]:=12;
if NeedAutoSizeColumns then
UpdateAutoSizeColumns
else
for i:=FixedCols to ColCount-1 do
ColWidths[i] := GetColumnWidth(i);
end;
@ -1443,6 +1453,67 @@ begin
end;
procedure TCustomDBGrid.UpdateAutoSizeColumns;
var
ACol,ARow,w: Integer;
CurActiveRecord: Integer;
Field: TField;
ColWidth: Integer;
tmpCanvas: TCanvas;
C: TGridColumn;
s: string;
begin
if gsAutoSized in GridStatus then
exit;
CurActiveRecord := FDatalink.ActiveRecord;
tmpCanvas := GetWorkingCanvas(Canvas);
try
for aCol:=FixedCols to ColCount-1 do begin
Field := GetFieldFromGridColumn(ACol);
C := ColumnFromGridColumn(ACol);
if C<>nil then begin
tmpCanvas.Font := C.Title.Font;
ColWidth := tmpCanvas.TextWidth(C.Title.Caption);
tmpCanvas.Font := C.Font;
end else begin
ColWidth := 0;
tmpCanvas.Font := Font;
end;
if Field<>nil then
for ARow := FixedRows to RowCount-1 do begin
FDatalink.ActiveRecord := ARow - FixedRows;
if Field.dataType<>ftBlob then
s := Field.DisplayText
else
s := '(blob)';
w := tmpCanvas.TextWidth(s);
if w>ColWidth then
ColWidth := w;
end;
if ColWidth=0 then
ColWidth := GetColumnWidth(ACol);
ColWidths[ACol] := ColWidth + 15;
end;
finally
if TmpCanvas<>Canvas then
FreeWorkingCanvas(tmpCanvas);
FDatalink.ActiveRecord := CurActiveRecord;
include(FGridStatus, gsAutoSized);
end;
end;
procedure TCustomDBGrid.SwapCheckBox;
var
SelField: TField;
@ -2634,7 +2705,7 @@ begin
FSelectedRows := TBookmarkList.Create(Self);
FDefaultColWidths := True;
RenewColWidths;
FOptions := [dgColumnResize, dgColumnMove, dgTitles, dgIndicator, dgRowLines,
dgColLines, dgConfirmDelete, dgCancelOnExit, dgTabs, dgEditing,
@ -2653,6 +2724,12 @@ begin
ScrollBars:=ssBoth;
end;
procedure TCustomDBGrid.AutoSizeColumns;
begin
RenewColWidths;
LayoutChanged;
end;
procedure TCustomDBGrid.InitiateAction;
begin
{$ifdef dbgDBGrid}DebugLn('===> DBGrid.InitiateAction INIT');{$endif}
@ -2713,7 +2790,7 @@ end;
procedure TCustomDBGrid.ResetColWidths;
begin
if not FDefaultColWidths then begin
FDefaultColWidths := True;
RenewColWidths;
LayoutChanged;
end;
end;
@ -2766,6 +2843,19 @@ begin
FKeyBookmark:='';
end;
function TCustomDBGrid.NeedAutoSizeColumns: boolean;
begin
result := (dgAutoSizeColumns in Options)
//and (HandleAllocated)
;
end;
procedure TCustomDBGrid.RenewColWidths;
begin
FDefaultColWidths := True;
exclude(FGridStatus, gsAutoSized);
end;
destructor TCustomDBGrid.Destroy;
begin
FSelectedRows.Free;
@ -3176,22 +3266,18 @@ end;
function TColumn.GetDefaultWidth: Integer;
var
AGrid: TCustomDBGrid;
WasAllocated: boolean;
aDC: HDC;
tmpCanvas: TCanvas;
begin
AGrid := TCustomDBGrid(Grid);
if AGrid<>nil then begin
WasAllocated := aGrid.Canvas.HandleAllocated;
if not WasAllocated then begin
aDC := GetDC(0); // desktop canvas
aGrid.Canvas.Handle := aDC;
aGrid.Canvas.Font := aGrid.Font;
end;
if AGrid.Canvas.HandleAllocated then begin
tmpCanvas := GetWorkingCanvas(aGrid.Canvas);
tmpCanvas.Font := aGrid.Font;
if tmpCanvas=aGrid.Canvas then begin
if FField<>nil then
result := CalcColumnFieldWidth(
aGrid.Canvas,
tmpCanvas,
dgTitles in aGrid.Options,
Title.Caption,
Title.Font,
@ -3203,10 +3289,8 @@ begin
result := DEFCOLWIDTH;
end;
if not WasAllocated then begin
aGrid.Canvas.Handle := 0;
ReleaseDC(0, aDC);
end;
if tmpCanvas<>AGrid.Canvas then
FreeWorkingCanvas(tmpCanvas);
end else
result := DEFCOLWIDTH;

61
lcl/grids.pas
View File

@ -1535,9 +1535,9 @@ type
property OnContextPopup;
end;
procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor);
function GetWorkingCanvas(const Canvas: TCanvas): TCanvas;
procedure FreeWorkingCanvas(canvas: TCanvas);
procedure Register;
@ -1696,6 +1696,28 @@ begin
end;
end;
function GetWorkingCanvas(const Canvas: TCanvas): TCanvas;
var
DC: HDC;
begin
if (Canvas=nil) or (not Canvas.HandleAllocated) then begin
DC := GetDC(0);
Result := TCanvas.Create;
Result.Handle := DC;
end else
Result := Canvas;
end;
procedure FreeWorkingCanvas(canvas: TCanvas);
begin
ReleaseDC(0, Canvas.Handle);
Canvas.Free;
end;
function Between(const AValue,AMin,AMax: Integer): boolean;
begin
if AMin<AMax then
@ -6846,22 +6868,12 @@ end;
function TCustomGrid.GetDefaultRowHeight: integer;
var
TmpCanvas: TCanvas;
DC: HDC;
begin
if (Canvas<>nil) and Canvas.HandleAllocated then
Result := Canvas.TextHeight('Fj')+7
else begin
DC := GetDC(0);
TmpCanvas := TCanvas.Create;
try
tmpCanvas.Handle:=DC;
TmpCanvas.Font.Assign(Font);
Result := TmpCanvas.TextHeight('Fj')+7
finally
TmpCanvas.Free;
ReleaseDC(0, DC);
end;
end;
tmpCanvas := GetWorkingCanvas(Canvas);
tmpCanvas.Font := Font;
result := tmpCanvas.TextHeight('Fj')+7;
if tmpCanvas<>Canvas then
FreeWorkingCanvas(tmpCanvas);
end;
function TCustomGrid.GetScrollBarPosition(Which: integer): Integer;
@ -8457,13 +8469,8 @@ begin
if (aCol<0) or (aCol>ColCount-1) then
Exit;
if not Canvas.HandleAllocated then begin
DC := GetDC(0);
TmpCanvas := TCanvas.Create;
TmpCanvas.Handle := DC;
TmpCanvas.Font.Assign(Font);
end else
TmpCanvas := Canvas;
tmpCanvas := GetWorkingCanvas(Canvas);
tmpCanvas.Font := Font;
C := ColumnFromGridColumn(aCol);
@ -8480,10 +8487,8 @@ begin
W := Ts.Cx;
end;
finally
if not Canvas.HandleAllocated then begin
TmpCanvas.Free;
ReleaseDC(0, DC);
end;
if tmpCanvas<>Canvas then
FreeWorkingCanvas(Canvas);
end;
if W=0 then