Firemonkey MouseToCell equivalent - delphi

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.

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;

Change chart values with mouse cursor in Delphi

I need to create a chart in Delphi 10, where the values of the Series can be changed with the mouse. I want to press a value of the chart with the mouse cursor and drag to change its value. Is there any property that needs to be enabled or does it have a specific chart component for it?
I saw another similar question, as shown by #KenWhite, but I did not understand it, because in that topic C# was used and the TeeChart component works differently in Delphi.
Can someone explain me how to use it in Delphi?
thanks
Simple example of dragging.
I've set chart AllowPanning to False to use right mouse button freely, line series, point style is circle with size=4, and seek for touched points with simple list traversal (don't sure whether Std has methods to get the nearest point to cursor).
Perhaps you would need some limitations (for example, limit horizontal shift by neighbor values etc)
DragIdx: integer = -1;
procedure TForm1.Button18Click(Sender: TObject);
var
i: Integer;
begin
for i := 0 to 19 do
Series1.AddXY(i, Sin(i/2));
end;
procedure TForm1.Chart1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i, xx, yy: Integer;
begin
if Button = mbRight then begin
DragIdx := -1;
for i := 0 to Series1.Count - 1 do begin
xx := Series1.CalcXPos(i);
yy := Series1.CalcYPos(i);
if Sqr(xx - x) + Sqr(yy - y) <= 5 * 5 then begin
DragIdx := i;
Break;
end;
end;
Memo1.Lines.Add(Format('grab %d', [DragIdx]));
end;
end;
procedure TForm1.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
xx, yy: Double;
begin
if (ssRight in Shift) and (DragIdx >=0) then begin
Series1.GetCursorValues(xx, yy);
Memo1.Lines.Add(Format('change %d to %f %f', [DragIdx, xx, yy]));
Series1.XValues[DragIdx] := xx;
Series1.YValues[DragIdx] := yy;
Chart1.Repaint;
end;
end;

DBGrid column visible width

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?).

StringGrid Cells Delphi

I've written some code which colours individual cells on my stringgrid, within my delphi application, according to a list of data.
I now need to write some code in the OnDblClick event on my stringgrid which deduces whether or not a cell is coloured and then proceeds according to the result found. For instance:
DOUBLE CLICK CELL
IS CELL COLOURED
YES > PROCEED A
NO > PROCEED B
Store the color at the time you draw it into the predefined TStringGrid.Objects property. When you need to retrieve it, you can get it back from the Column and Row coordinates. Here's a trivial example that stores either clWhite or clBlack in the Objects for the cell based on whether or not it's an odd-numbered column, and simply displays the stored value as a string when the cell is selected. It should get you started.
procedure TForm1.FormCreate(Sender: TObject);
var
r, c: Integer;
const
ColorSel: array[Boolean] of TColor = (clWhite, clBlack);
begin
StringGrid1.RowCount := 10;
StringGrid1.ColCount := 6;
for c := 1 to StringGrid1.ColCount - 1 do
for r := 1 to StringGrid1.RowCount - 1 do
begin
StringGrid1.Cells[c, r] := Format('C: %d R: %d', [c, r]);
StringGrid1.Objects[c, r] := TObject(ColorSel[Odd(c)]);
end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
begin
ShowMessage(ColorToString(TColor(StringGrid1.Objects[ACol, ARow])));
end;
You can use this in the OnMouseUp event easily to detect what color is in the cell. Remove the StringGrid1SelectCell (using the Object Inspector, just remove the value for the event) and add this as the OnMouseUp event for the grid instead:
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Col, Row: Integer;
begin
StringGrid1.MouseToCell(X, Y, Col, Row);
if (Col > -1) and (Row > -1) then
ShowMessage(ColorToString(TColor(StringGrid1.Objects[Col, Row])));
end;
Handling the double-click then becomes pretty easy (thanks to #TLama for a big assist):
procedure TForm1.StringGrid1DblClick(Sender: TObject);
var
IsDefaultColor: Boolean;
CurrCellColor: TColor;
CurrCol, CurrRow: Integer;
begin
// Save typing by grabbing the currently selected cell col/row
CurrCol := StringGrid1.Col;
CurrRow := StringGrid1.Row;
// Get the stored color for the selected cell
CurrCellColor := TColor(StringGrid1.Objects[CurrCol, CurrRow]);
// See if it's been painted a different color than the default
IsDefaultColor := (CurrCellColor = StringGrid1.Color);
if not IsDefaultColor then
HandleDifferentColorCell
else
HandleNormalColorCell;
end;
Note that if you're choosing not to change the color for a cell, you should still assign the default color of the cell to the Objects[Column, Row] so that there's something meaningful there in order to avoid an improper conversion when retrieving the value.

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