DBGrid column visible width - delphi

I've been trying to find a way to find the visible/viewable width of a
column that is very wide, based on the underlying field's length.
When the grid is viewed at runtime one of the column's data often runs
off the screen to the right. In order to see the data you have to scroll
to the right. Unfortunately the UI design doesn't fit displaying a
separate memo field.
What I've done is to use TJvBalloonHint from the JEDI project in
conjunction with the TJvDBGrid. Using the grid's OnShowCellHint I call a
custom method that builds the hint text, calculates the display position
for the hint and displays it.
******TJvDBGrid descendant*******
procedure TMyJvDBGrid.ShowGridCellHint(Sender: TObject; Field: TField;
var AHint: String; var ATimeOut: Integer);
begin
FBalloonHint.HintPos(ScreenToClient(Mouse.CursorPos).X,ScreenToClient(Mouse.CursorPos).Y);
end;
********************************
function GetTextWidth(const Text: UnicodeString; AFont: TFont): Integer;
var
bmp: Vcl.Graphics.TBitmap;
begin
bmp := Vcl.Graphics.TBitmap.Create;
try
bmp.Canvas.Font := AFont;
Result := bmp.Canvas.TextWidth(Text);
finally
FreeAndNil(bmp);
end;
end;
******TJvBalloonHint descendant*******
procedure TMyJvBalloonHint.HintPos(X, Y: Integer);
var
Cell: TGridCoord;
ActRec: Integer;
r: TRect;
Grid: TMyJvDBGrid;
sTitle: UnicodeString;
begin
Grid := TMyJvDBGrid(Self.Owner);
// correlates pixel location of the mouse
// cursor to the row & column in the grid
Cell := Grid.MouseCoord(X, Y);
if dgIndicator in Grid.Options then
// indicator column counts as a column
Dec(Cell.X);
if dgTitles in Grid.Options then
// titles counts as a row
Dec(Cell.Y);
// is the grid connected to a dataset via a TDataSource object?
if Grid.DataLink.Active and (Cell.X >= 0) and (Cell.Y >= 0) then
begin
// preserve the active record
ActRec := Grid.DataLink.ActiveRecord;
try
// set active record to the row under the mouse cursor
Grid.DataLink.ActiveRecord := Cell.Y;
// set hint to the field value under the mouse cursor
Hint := Grid.Columns[Cell.X].Field.AsString;
// set hint title to the name of the column under the mouse cursor
sTitle := Grid.Columns[Cell.X].Field.FieldName;
if CellChanged(Cell.X,Cell.Y) then
if GetTextWidth(Hint,Grid.Font) > Grid.Width then
begin
r.TopLeft := Point(mouse.CursorPos.X,Mouse.CursorPos.Y);
r.BottomRight := Point(mouse.CursorPos.X,Mouse.CursorPos.Y);
Grid.BalloonHint.ActivateHintRect(r,sTitle,Hint,0,ikNone);
end;
finally
Grid.DataLink.ActiveRecord := ActRec;
end;
end;
end;
function TMyJvBalloonHint.CellChanged(const X, Y: Integer): Boolean;
var
Grid: TMyJvDBGrid;
begin
// persists cell position in order to determine if the
// mouse cursor position has changed to another cell
Result := False;
if (X <> FX) or (Y <> FY) then
begin
Grid := TMyJvDBGrid(Self.Owner);
if Grid.BalloonHint.Active then
Grid.BalloonHint.CancelHint;
Result := True;
if Assigned(FOnShowHint) and FShowHint then
FOnShowHint(Self);
FX := X;
FY := Y;
end;
end;
procedure TMyJvBalloonHint.SetHint(AValue: UnicodeString);
var
i,n: Integer;
chars: TSysCharSet;
begin
FHint := '';
chars := [];
if Length(TextWrapChars.Chars) > 0 then
begin
for i := 0 to Pred(Length(TextWrapChars.Chars)) do
for n := 1 to Length(TextWrapChars[i]) do
if TextWrapChars[i] <> #0 then
Include(chars,TextWrapChars[i]);
FHint := WrapText(AValue, #13#10, chars, TextWrapWidth);
end
else
FHint := AValue;
end;
**************************************
This code only displays a hint - with the text of the field wrapped so
that it is visible in it's entirety - if the field text is longer than
the display width of the entire grid.
1st Q):
What I want to do is display the hint only if the field text is greater
in length than the displayed/visible width of the column. But I can't
find a way to measure the displayed/visible width of a column. In other
words, if a column is wider than it's displayed width, I'd like to know
what the width of the displayed/visible part of the column is. Then I
can measure the width of the text in the underlying field and determine
if the text is chopped off on the right or left side of the grid.
2nd Q):
The above code displays the hint at the cursor position. I'd like to
display the hint at the bottom of the visible part of the cell, in the
center of the visible part of the cell, no matter where the cursor is
laterally within the cell rect.
Thanks for any assistance.

This isn't perfect, but it's fairly close to answering both questions.
Since I subclassed TDBGrid I have access to the protected members including 'LeftCol'. Using the grid's 'ClientWidth' property and an iteration over the columns I was able to roughly calculate the starting position of the 'chopped off' column and it's displayed/visible width using this method:
function ColumnIsChopped(Grid: TIniSectionDBGrid; const ColNum: Integer;
out ColumnDisplayWidth, ColumnLeftPos: Integer): Boolean;
var
i: Integer;
begin
if ColNum > Pred(Grid.Columns.Count) then
Exit;
// the whole enchilada...
ColumnDisplayWidth := Grid.ClientWidth;
if ColNum <> Grid.LeftCol then
begin
// start iteration & measurements with the left most displayed column in grid
i := Grid.LeftCol;
while i < ColNum do
begin
// subtract width of column from overall grid client (displayed) width
ColumnDisplayWidth := ColumnDisplayWidth - Grid.Columns[i].Width;
inc(i);
end;
end;
// determine the starting position in pixels of the provided column
ColumnLeftPos := Grid.ClientWidth - ColumnDisplayWidth;
// if remaining display width is less than the text width of text in column,
// assume that the column text display is chopped off on the right
Result := ColumnDisplayWidth <= GetTextWidth(Grid.Columns[ColNum].Field.AsString,Grid.Font);
end;
In preparation for displaying the hint I call the ColumnIsChopped method to determine the following:
) Is the column under the mouse cursor getting chopped?
) What is the approximate left position in pixels of the current column?
) What is the displayed/visible width of the column under the cursor?
) Is the width of the text in the column greater than the displayed/visible width of the column?
procedure TIniSectionDBGrid.TIniSectionDBGridHint.HintPos(Position: TPoint);
var
Cell: TGridCoord;
ActRec,colDisplayWidth,iLeft,iLeftPos: Integer;
r: TRect;
Grid: TIniSectionDBGrid;
sTitle: UnicodeString;
begin
Grid := TIniSectionDBGrid(Self.Owner);
// correlates pixel location of the mouse
// cursor to the row & column in the grid
Cell := Grid.MouseCoord(Position.X, Position.Y);
if dgIndicator in Grid.Options then
// indicator column counts as a column
Dec(Cell.X);
if dgTitles in Grid.Options then
// titles counts as a row
Dec(Cell.Y);
// is the grid connected to a dataset via a TDataSource object?
if Grid.DataLink.Active and (Cell.X >= 0) and (Cell.Y >= 0) then
begin
// preserve the active record
ActRec := Grid.DataLink.ActiveRecord;
try
// set active record to the row under the mouse cursor
Grid.DataLink.ActiveRecord := Cell.Y;
if CellChanged(Cell.X,Cell.Y) then
if ColumnIsChopped(Grid,Cell.X,colDisplayWidth,iLeft) then
begin
// calc x position for hint
iLeftPos := iLeft + Round(colDisplayWidth / 2);
// set hint to the field value under the mouse cursor
Hint := Grid.Columns[Cell.X].Field.AsString;
// set hint title to the name of the column under the mouse cursor
sTitle := Grid.Columns[Cell.X].Field.FieldName;
r.TopLeft := Point(iLeftPos,Mouse.CursorPos.Y);
r.BottomRight := Point(iLeftPos,Mouse.CursorPos.Y);
Grid.BalloonHint.ActivateHintRect(r,sTitle,Hint,0,ikNone);
end;
finally
Grid.DataLink.ActiveRecord := ActRec;
end;
end;
end;
Now all that is left is to figure out how to position the hint at the bottom of the cell or the top of the cell depending on the cell's vertical orientation in the grid and the corresponding hint orientation in relation to the cell (above or below?).

Related

How to show a universal data label for any type of chart series?

I'm using the TeeChart (TChart) which is distributed with Delphi 10.4 to display data. Different types of data are displayed in different types of chart series. More specifically, I support 4 different types of charts:
Line Chart
Pie Chart
Vertical Bar Chart
Horizontal Bar Chart
When it comes to the Line Chart and Vertical Bar Chart, I have successfully implemented a label which displays next to the cursor when the user hovers over any part of the chart. This label displays the detailed values associated with each possible series of those charts, and some charts might have 10 different series, for example, in which case all those values show in the label.
Now I am trying to add the same support for the other 2 chart types (Pie and Horizontal Bar). However, I'm not having much luck. Let's take the Horizontal Bar Chart for example. When I apply the same code below, the data does not display correctly. More specifically, when I hover over a horizontal bar, it seems to depend on whether I'm hovering over the upper or lower half of the bar. Hovering over the upper half shows data for the previous item (or nothing at all if it's the first item in the chart), and hovering over the lower half of a bar shows the expected data, so it seems to be offset.
Further, I cannot make it work at all on pie charts. It shows a small little bit of the label, but the label is never populated, so it never successfully identifies the SeriesIndex.
The way this code works is that it expects to find a value for Tag on the TChart control..
Handles the X axis (line and Vert Bar Chart)
Handles the Y axis (Horz Bar Chart)
The charts have a label inside them named lblChartData (the TChart is also a container).
Then the charts have an OnMouseMove event handler:
procedure TDashChartBase.ChartMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
ShowDataLabel(X, Y);
lblChartData.Left:= X + 15;
lblChartData.Top:= Y;
Chart.Repaint;
end;
Then the code for ShowDataLabel:
procedure TDashChartBase.ShowDataLabel(const X, Y: Integer);
var
S: String;
SeriesIndex: Integer;
V: Double;
I: Integer;
CursorX: Double;
CursorY: Double;
Serie: TChartSeries;
function GetXValueIndex(const ASerie: TChartSeries; const AX: Double): Integer;
var
Idx: Integer;
begin
for Idx := 0 to ASerie.XValues.Count - 1 do begin
if ASerie.XValue[Idx] >= AX then
Break;
end;
Result := Idx - 1;
end;
function GetYValueIndex(const ASerie: TChartSeries; const AY: Double): Integer;
var
Idx: Integer;
begin
for Idx := 0 to ASerie.YValues.Count - 1 do begin
if ASerie.YValue[Idx] >= AY then
Break;
end;
Result := Idx - 1;
end;
begin
try
Chart.Cursor:= crCross;
if not (Chart.SeriesCount > 0) then begin
//Chart does not have any series to display...
lblChartData.Visible:= False;
end else begin
//Get cursor position of first series...
Chart.Series[0].GetCursorValues(CursorX, CursorY);
for I := 0 to Chart.SeriesCount-1 do begin
Serie:= Chart.Series[I];
//Identify index of item based on mouse position...
case Chart.Tag of
1: SeriesIndex:= GetXValueIndex(Serie, CursorX);
else SeriesIndex:= GetYValueIndex(Serie, CursorY);
end;
if (SeriesIndex < 0) or (SeriesIndex > Serie.Count-1) then begin
//Series index is out of range...
lblChartData.Visible:= False;
Break;
end else begin
if I = 0 then begin
//Add the value mark text as the first line in label...
S:= S + Serie.ValueMarkText[SeriesIndex] + sLineBreak;
if (Trim(S) = '') then begin
//No value exists for this plot point...
lblChartData.Visible:= False;
Break;
end;
end;
//Add the value associated with this series to the label...
case Chart.Tag of
1: V:= Double(Serie.ValuesList[1].Value[SeriesIndex]);
else V:= Double(Serie.ValuesList[0].Value[SeriesIndex]);
end;
S:= S + Serie.Title+': '+FormatFloat(Serie.ValueFormat, V) + sLineBreak;
end;
end;
lblChartData.Caption:= S;
end;
except
on E: Exception do begin
lblChartData.Visible:= False;
end;
end;
end;
How can I make this work properly for the other series types?
(NOTE: Some irrelevant code was stripped out from above snippets)
How to show a universal data label for any type of chart series?
Could be rewritten as:
How to find series and point's index under mouse cursor for any type of chart series?
You can easily get both using CalcClickedPart. Your mouse move handler can then be written as follows:
TDashChartBase.ChartMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var Part:TChartClickedPart;
begin
lblChartData.Visible:=false;
Chart.CalcClickedPart(Point(X,Y),Part);
if (Part.Part=cpSeries) or (Part.Part=cpSeriesPointer) then
begin
//extract all needed data using Part.ASeries and Part.PointIndex
lblChartData.Caption:=Part.ASeries.Name + ';' + Part.PointIndex.ToString;
lblChartData.Left:= X + 15;
lblChartData.Top:= Y;
lblChartData.Visible:=true;
end;
end;

TVirtualStringTree - setting column cells/nodes Alignment

I have a VirtualStringTree with a Header.Column set to taLeftJustify (default).
Is there a way to set the cells/nodes of that column to taRightJustify so that the nodes will be justified to the right, but the header column text will be justified to the left?
This is my desired result (in column 1):
I'm using a rather old VT version 4.5.5
For Column caption alignment use:
Header.Columns[x].CaptionAlignment := taLeftJustify;
and for nodes alignment:
Header.Columns[x].Alignment := taRightJustify;
x = your column
In my old VT version, there is no TVirtualTreeColumn.CaptionAlignment, so I managed to use OnAdvancedHeaderDraw to draw my own columns captions. I set column 1 to taRightJustify and handle the header Text drawing myself for the desired column.
This code might be helpful for others, so I'll post it anyway:
type
TVirtualTreeColumnsAccess = class(TVirtualTreeColumns);
procedure TForm1.FormCreate(Sender: TObject);
begin
VST.Header.Options := VST.Header.Options + [hoOwnerDraw];
VST.OnHeaderDrawQueryElements := VSTHeaderDrawQueryElements;
VST.OnAdvancedHeaderDraw := VSTAdvancedHeaderDraw;
end;
procedure TForm1.VSTHeaderDrawQueryElements(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo;
var Elements: THeaderPaintElements);
begin
{ Use OwnerDraw only for desired column(s) }
{ other columns drawing will be handled by VST }
if Assigned(PaintInfo.Column) and (PaintInfo.Column.Index = 1) then
Elements := [hpeText];
end;
procedure TForm1.VSTAdvancedHeaderDraw(Sender: TVTHeader;
var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements);
var
DrawFormat: Cardinal;
R: TRect;
begin
{ The event will fire only for the desired column(s) }
if (hpeText in Elements) and Assigned(PaintInfo.Column) then
with PaintInfo do
begin
DrawFormat := DT_LEFT or DT_TOP or DT_NOPREFIX;
if Column.UseRightToLeftReading then
DrawFormat := DrawFormat or DT_RTLREADING;
R := TextRectangle;
R.Left := PaintRectangle.Left + Column.Margin;
TVirtualTreeColumnsAccess(Column.Owner).DrawButtonText(
TargetCanvas.Handle, Column.Text, R,
IsEnabled,
IsHoverIndex and (hoHotTrack in Sender.Options)
and not (tsUseThemes in Sender.Treeview.TreeStates),
DrawFormat);
end;
end;

Filling blank space in delphi stringgrid

I have a grid that can be resized. And i'm now stuggeling with filling the blank space around columns in the grid. I'm trying to achieve this on FormResize.
First i calculate what is the total of columns width and then i'm comparing it to the string grid width. if the stringgrid widths is bigger then i add to each columns width equal portions of the blank space left. This is how it looks in formResize Procedure:
procedure TBDDTool.FormResize(Sender: TObject);
var
totColWidth,i : integer;
begin
totColWidth := 0;
for i := 0 to sgFilePreview.ColCount - 1 do
totColWidth := totColWidth + sgFilePreview.ColWidths[i];
if sgFilePreview.Width > TotColWidth then
begin
for i := 0 to sgFilePreview.ColCount - 1 do
begin
sgFilePreview.ColWidths[i] := round(sgFilePreview.ColWidths[i] +
((sgFilePreview.Width - totColWidth)/(sgFilePreview.colCount)));
end;
end;
end;
This actualy doesn't work cause sgFilePReview.Width is the width of my grid. And i don't know how to get the width of the whole space inside the grid, like every columns + blank space left. How can i get the real width of the grid? Cause sgFilePreview.Width return the width of the grid but as seen from outside the grid.
Thank you!
EDIT
Addine new columns
for val in sLineSplitted do
begin
if Pos('#',val) <> 0 then propVal := copy(val,0,pos('#',val)-1)
else propVal := val;
col := col +1;
if (row = 1) then
begin
if (col >1) then
//Add column
sgFilePreview.ColCount := col;
sgFilePreview.Cols[col-1].Text := propVal;
SetLength(aSourceData[row-1],col);
aSourceData[row-1,col-1] := val;
end
else
begin
sgFilePreview.RowCount := row;
SetLength(aSourceData[row-1],col);
aSourceData[row-1, col-1] := val;
sgFilePreview.Cells[col-1, row-1] := propVal;
pnlFileManager.Visible := true;
end;
end;
Auto size columns to fit word if the world is bigger than the cell's width
procedure TBDDTool.AutoSizeGrid(Grid: TStringGrid);
const
ColWidthMin = 10;
var
C,R,W, ColWidthMax: integer;
begin
for c := 0 to Grid.ColCount - 1 do
begin
ColWidthMax := ColWidthMin;
for R := 0 to Grid.RowCount - 1 do
begin
W := Grid.Canvas.TextWidth(Grid.Cells[C,R]);
if W > ColWidthMax then
ColWidthMax :=W;
end;
Grid.ColWidths[C] := ColWidthMax +5;
end;
end;
The main problem why these empty spaces are occurring to you even when you have too many columns so that all of them can be seen at the same time is the fact that in StringGrid scrolling works a bit different than you are used to in other controls.
When you scroll around in StringGrid the scrolling position is always aligned to the position of TopLeft visible cell. So if the combined width of visible cols isn't the same as ClientWidth this means that you will either have partially visible col at the right side or and empty space when you have scrolled all the way to the right.
Now one possible way to avoid this is to resize the columns so that they always fit into the client width (no partially visible columns). But the problem is that this becomes practically impossible if you have different widths for each column.
In case if you can live with the fact that all columns will have same width you can use the code below which works in most cases. It isn't perfect because you can only set column width to integer values where sometimes you would need larger precision.
procedure TForm1.FormResize(Sender: TObject);
var cwDefaultWidth: Integer;
VisibleCols: Integer;
ColWidth: Integer;
begin
cwDefaultWidth := 64;
VisibleCols := StringGrid1.ClientWidth div cwDefaultWidth;
if VisibleCols >= StringGrid1.ColCount then
begin
ColWidth := Round(StringGrid1.ClientWidth / StringGrid1.ColCount-1);
end
else
begin
ColWidth := Round(StringGrid1.ClientWidth / VisibleCols-1);
end;
StringGrid1.DefaultColWidth := ColWidth;
end;
But if you are using variable column widths then the only thing that you could do is adjust the size of the last column so that it's width fills the empty space that would otherwise appear.
In order to do that you would first have to check to see if you are scrolled fully to the right. Then you would have to sum up the width of currently seen columns. You could do this by using:
for I := StringGrid1.LeftCol to StringGrid1.RowCount-1 do
begin
VisibleColsWidth := VisibleColsWidth + StringGrid1.ColWidths[I];
end;
Then you subtract this width from StringGrid1.ClientWidth and you get the width of empty space. So finally you increase the size of last column for the empty space width.
I really hope that even if my answer doesn't provide you with an actual solution it would at least guide you towards finding the right solution.

Firemonkey MouseToCell equivalent

In Delphi VCL if I wanted to see which cell (column and row) of a TStringGrid my mouse was hovering over I'd use MouseToCell. This method is no longer in Delphi (XE2) for FireMonkey apps. Does anyone know how I can determine the cell my mouse is over? OnMouseMove has X & Y values but these are screen coordinates and not cell coordinates.
Many thanks.
There's actually a MouseToCell method in TCustomGrid, which the StringGrid descends, but it's private. Looking at its source, it makes use of ColumnByPoint and RowByPoint methods, which are fortunately public.
The 'column' one returns a TColumn, or nil if there's no column. The 'row' one returns a positive integer, or -1 when there's no row. Furthermore, the row one does not care the row count, it just accounts for row height and returns a row number based on this, even if there are no rows. Also, I should note that, behavior on grid header is buggy. Anyway, sample example could be like:
procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Single);
var
Col: TColumn;
C, R: Integer;
begin
Col := StringGrid1.ColumnByPoint(X, Y);
if Assigned(Col) then
C := Col.Index
else
C := -1;
R := StringGrid1.RowByPoint(X, Y);
Caption := Format('Col:%d Row:%d', [C, R]);
end;
TStringGrid has a ColumnByPoint and RowByPoint method.
ColumnByPoint and RowByPoint go by the coordinates of the string grid. So, if you use the OnMouseOver of the string grid, the X and Y parameters will already be in the string grid's cooridnates.
Here's how to display the row and column (0 based) in the string grid's OnMouseOver:
var
row: Integer;
col: TColumn;
colnum: Integer;
begin
row := StringGrid1.RowByPoint(X, Y);
col := StringGrid1.ColumnByPoint(X, Y);
if Assigned(col) then
begin
colnum := col.Index;
end
else
begin
colnum := -1;
end;
Label1.Text := IntToStr(row) + ':' + IntToStr(colnum);
end;
Note that -1 will be displayed when outside the bounds of the rows and columns.

How to find the actual width of grid component with scrollbar in Delphi

I have a grid component (DBGrid) which has lots of columns on it. Because of large number of columns, a scrollbar was created, and thus some part of grid remains hidden. I need to find out what is the real width of DBGrid, including the part which is not shown due to scroll bar. But Width property gives only the width of the component itself. Anybody has any idea?
TDBGrid has a Columns property. Each of the columns has its own Width property. So you could loop through all of the columns and sum up their widths.
Like this:
function TotalColumnsWidth(var AGrid: TDBGrid);
var
i: Integer;
begin
Result := 0;
for i := to AGrid.Columns.Count - 1 do
Result := Result + AGrid.Columns[i].Width;
end;
Perhaps this may be helpful. It is part of a class helper for TDBGrid that auto sizes the last column, so that the grid has no empty space. Should be easy to adjust to your needs.
As you may notice, the CalcDrawInfo method is what you are seeking for. As it is protected you can either use a class helper or the usual protected-hack to get hands on it.
procedure TDbGridHelper.AutoSizeLastColumn;
var
DrawInfo: TGridDrawInfo;
ColNo: Integer;
begin
ColNo := ColCount - 1;
CalcDrawInfo(DrawInfo);
if (DrawInfo.Horz.LastFullVisibleCell < ColNo - 1) then Exit;
if (DrawInfo.Horz.LastFullVisibleCell < ColNo) then
ColWidths[ColNo] := DrawInfo.Horz.GridBoundary - DrawInfo.Horz.FullVisBoundary
else
ColWidths[ColNo] := ColWidths[ColNo] + DrawInfo.Horz.GridExtent - DrawInfo.Horz.FullVisBoundary
end;
I think I have found a solution (although it seems a little strange). In order to find the difference between column widths and real width of the DBgrid (that means find the width of the empty space left after last column), we need to keep track of which column is shown on the left now (what is current column that is scrolled to). We can do that using OnDrawColumnCell event, since it will draw only columns which are scrolled on now. Then we need to calculate sum of widths of all visible columns, and subtract that from DBGrid's width. P.S. Sorry for bad english
Ex code:
For i:=0 to Last do
if Vis[i] then
Begin
Sum:=Sum+DBG.Columns[i].Width;
Inc(Cnt);
End;
if dgColLines in DBG.Options then
Sum := Sum + Cnt;
//add indicator column width
if dgIndicator in DBG.Options then
Sum := Sum + IndicatorWidth;
Dif:=DBG.ClientWidth - Sum;
Here are functions we have used in the past. It takes into account the width of data based on the font and also compensates for vertical lines if they are visible
function GridTextWidth(fntFont : TFont; const sString : OpenString) :
integer;
var
f: TForm;
begin
try
f:=TForm.Create(nil);
f.Font:=fntFont;
result:=f.canvas.textwidth(sstring);
finally
f.Free;
end;
end;
function CalcGridWidth(dbg : TDBGrid { the grid to meaure }): integer; { the "exact" width }
const cMEASURE_CHAR = '0';
iEXTRA_COL_PIX = 4;
iINDICATOR_WIDE = 11;
var i, iColumns, iColWidth, iTitleWidth, iCharWidth : integer;
begin
iColumns := 0;
result := GetSystemMetrics(SM_CXVSCROLL);
iCharWidth := GridTextWidth(dbg.font,cMeasure_char);
with dbg.dataSource.dataSet do begin
DisableControls;
for i := 0 to FieldCount - 1 do with Fields[i] do
if visible then
begin
iColWidth := iCharWidth * DisplayWidth;
if dgTitles in dbg.Options then begin
ititlewidth:=GridTextWidth(dbg.titlefont,displaylabel);
if iColWidth < iTitleWidth then
iColWidth := iTitleWidth;
end;
inc(iColumns, 1);
inc(result, iColWidth + iEXTRA_COL_PIX);
end;
EnableControls;
end;
if dgIndicator in dbg.Options then
begin
inc(iColumns, 1);
inc(result, iINDICATOR_WIDE);
end;
if dgColLines in dbg.Options then
inc(result, iColumns)
else
inc(result, 1);
end;

Resources