I'm trying to get the text in my StringGrid to center. After some research I came up with this function posted by someone else here that when used on DefaultDraw:False should work.
procedure TForm1.StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
S: string;
SavedAlign: word;
begin
if ACol = 1 then begin // ACol is zero based
S := StringGrid1.Cells[ACol, ARow]; // cell contents
SavedAlign := SetTextAlign(StringGrid1.Canvas.Handle, TA_CENTER);
StringGrid1.Canvas.TextRect(Rect,
Rect.Left + (Rect.Right - Rect.Left) div 2, Rect.Top + 2, S);
SetTextAlign(StringGrid1.Canvas.Handle, SavedAlign);
end;
end;
However if I set DefaultDraw:False, the StringGrid just appears glitchey.
The lines in the function that fill the StringGrid with text is
Sg.RowCount := Length(arrpos);
for I := 0 to (Length(arrpos) - 1) do
begin
sg.Cells[0,i] := arrpos[i];
sg.Cells[1,i] := arrby[i];
end;
arrpos and arrby are arrays of string. sg is the StringGrid.
I need after that has been executing the text to appear in the center on the cell.
UPDATE
For those suffering from similar problems one of the key issues with this piece of code is if the if statement
if ACol = 1 then begin
That line means it will only run the code for column 1 e.g. the second column since StringGrid is 0 based. You can safely remove the if statement and it will execute and work WITHOUT having to disable default drawing.
this works in my test
procedure TForm1.sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState);
var
LStrCell: string;
LRect: TRect;
begin
LStrCell := sg.Cells[ACol, ARow]; // grab cell text
sg.Canvas.FillRect(Rect); // clear the cell
LRect := Rect;
LRect.Top := LRect.Top + 3; // adjust top to center vertical
// draw text
DrawText(sg.Canvas.Handle, PChar(LStrCell), Length(LStrCell), LRect, DT_CENTER);
end;
Related
Problem.
I have two TStringGrids on the same Form.
When I click on a cell (x, y) of the first Table, the background of the same cell (x, y) of the second table must turn red.
How can I do since the tables are different?
I know how to find a cell using the OnClick method on table1, but I don't know how to color a cell in table2
You must tell grid2 somehow which cell(s) you want highlighted. There are many ways to do this, depending on what you want to do.
If you just want the last cell clicked highlighted create a couple of form variables, say fx and fy and set them in your onclick event and refresh grid2. Then use the following OnDraw event for grid 2.
procedure TFormAdobeTest.StringGrid2DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if (ACol = fx) and (ACol =fy) then
begin
StringGrid2.Canvas.Brush.Color := clRed;
StringGrid2.Canvas.Rectangle( Rect );
end
else
begin
StringGrid2.Canvas.Brush.Color := clWhite;
StringGrid2.Canvas.Rectangle( Rect );
end;
end;
Obviously this could be extended of you want all clicked boxes recorded. Another way to do this is to instead use the objects property to tell StringGrid2 to pass this information for example by assigning StringGrid1 to the objects property (or any other object!)
an then the routine become
procedure TFormAdobeTest.StringGrid2DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if Assigned( StringGrid2.Objects [ ACol, ARow]) then
begin
StringGrid2.Canvas.Brush.Color := clRed;
StringGrid2.Canvas.Rectangle( Rect );
end
else
begin
StringGrid2.Canvas.Brush.Color := clWhite;
StringGrid2.Canvas.Rectangle( Rect );
end;
end;
These are just a starting point of course.
Thanks, I have achieved part of my purpose with this:
procedure TForm1.StringGrid1Click(Sender: TObject);
begin
if (StringGrid1.col > 0) and (StringGrid1.row > 0) then
begin
cc := StringGrid1.col;
rr := StringGrid1.row;
end
else
begin
cc := -1;
rr := -1;
end;
memo1.Lines.Append(cc.ToString+','+rr.ToString);
StringGrid2.Repaint;
end;
procedure TForm1.StringGrid2DrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
begin
if (ACol = cc) and (aRow = rr) then
begin
StringGrid2.Canvas.Brush.Color := clRed;
StringGrid2.Canvas.Rectangle(aRect);
end;
end;
Am having a string grid(TStringGrid) with 2 column and 1 row (Property: ColCount = 2 & Rowcount = 1.
Code for OnDrawCell Event:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
Parametertext : string;
begin
case ACol of
0 : Parametertext := 'Test';
1 : Parametertext := 'Test1';
end;
stringgrid1.Brush.Color := clBtnFace;
stringgrid1.Font.Color := clWindowText;
stringgrid1.Canvas.FillRect(Rect);
DrawText(stringgrid1.Canvas.Handle, PChar(parameterText), -1, Rect,
DT_SINGLELINE);
end;
When I run the application, I get the below output:
Question:
When I try to get the text using StringGrid1.Cells[0,0] , StringGrid1.Cells[1,0] ,
I except "Test" & "Test1" but it always gives a empty string"".
How can I get the text from string grid using StringGrid.Cells[aCol,aRow]?
You are generating the text to draw it, but not storing it. You also need to set the stringGrid.Cells value, probably not in the OnDrawCell event, though.
Think about your variable Parametertext. It is a local variable destroyed on exit. Nowhere do you save it anywhere else. So why would you expect it to magically appear in the cells property?
To do what you are asking, you need to actually store the string values in the Cells property, not generate them dynamically in the OnDrawCell event:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
Parametertext : string;
begin
Parametertext := StringGrid1.Cells[ACol, ARow];
StringGrid1.Brush.Color := clBtnFace;
StringGrid1.Font.Color := clWindowText;
StringGrid1.Canvas.FillRect(Rect);
DrawText(StringGrid1.Canvas.Handle, PChar(ParameterText), Length(ParameterText), Rect, DT_SINGLELINE);
end;
...
StringGrid1.Cells[0, 0] := 'Test';
StringGrid1.Cells[1, 0] := 'Test1';
If you are not going to use the Cells property to store strings, you may as well have just used TDrawGrid instead.
I am trying to write custom date picker(calendar). The dates will be displayed on the stringgrid. I am trying to fill the clicked cell with a custom color and make that selected celltext bold.
Here is my code:
type
TStringGrid = Class(Vcl.Grids.TStringGrid)
private
FHideFocusRect: Boolean;
protected
Procedure Paint;override;
public
Property HideFocusRect:Boolean Read FHideFocusRect Write FHideFocusRect;
End;
TfrmNepaliCalendar = class(TForm)
...
...
...
end;
procedure TfrmNepaliCalendar.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdSelected in State then begin
StringGrid.Canvas.Brush.Color := $00940A4B;
StringGrid.Canvas.FillRect(Rect);
StringGrid.Canvas.Font.Style := [fsBold];
StringGrid.Canvas.Font.Color := clHighlightText;
StringGrid.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5, StringGrid.Cells[ACol,ARow]);
StringGrid.HideFocusRect := True;
end;
end;
{ TStringGrid }
procedure TStringGrid.Paint;
var
LRect: TRect;
begin
inherited;
if HideFocusRect then begin
LRect := CellRect(Col,Row);
if DrawingStyle = gdsThemed then InflateRect(LRect,-1,-1);
DrawFocusrect(Canvas.Handle,LRect)
end;
end;
The output, I am getting:
Problem #1: I need to hide that unwanted rectangle appearing as border for the selected cell
Problem #2: Avoid the cell background clipping
In the OnDrawCell procedure add just before FillRect
Rect.Left := Rect.Left-4;
Seems to work.
An alternative
The above doesn't fully solve the focus issue even with your paint procedure addon. Sometimes a white line is visible just inside the cell borders.
But the following is an alternative, that solves both your issues. It requires a little more coding, but not so much. On the other hand, subclassing TStringGrid is not needed, neither the Rect adjustment
The basis is to disable default drawing, so set the grids property DefaultDrawing := false;
and then add to the OnDrawCell event:
procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdFixed in State then
begin
StringGrid.Canvas.Brush.Color := clGradientInactiveCaption;
StringGrid.Canvas.Font.Style := [];
StringGrid.Canvas.Font.Color := clBlack;
end
else
if gdSelected in State then
begin
StringGrid.Canvas.Brush.Color := $00940A4B;
StringGrid.Canvas.Font.Style := [fsBold];
StringGrid.Canvas.Font.Color := clHighlightText;
end
else
begin
StringGrid.Canvas.Brush.Color := $00FFFFFF;
StringGrid.Canvas.Font.Style := [];
StringGrid.Canvas.Font.Color := clWindowText;
end;
StringGrid.Canvas.FillRect(Rect);
StringGrid.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5, StringGrid.Cells[ACol,ARow]);
end;
With default drawing disabled, the grid draws the grid frame and the grid lines, but leaves all other drawing to the programmer. The caveat is that you have to add fancy themed drawing yourself if you need it.
With above coding I get this result:
I assume you (want to) use the default DefaultDrawing = True setting, otherwise your question does not exist.
To get rid of the focus rect, you need to draw it again (because it is a XOR-operation, the focus rect will disappear), or prevent it from being drawn.
Drawing again is done by utilizing the OnDrawCell event:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdFocused in State then
DrawFocusRect(StringGrid1.Canvas.Handle, Rect);
end;
Preventing it from drawing at all e.g. is done by disabling the possibility to set focus to the StringGrid. I assume you do not use its editor, so that should give no further usability concerns.
type
TStringGrid = class(Vcl.Grids.TStringGrid)
public
function CanFocus: Boolean; override;
end;
function TStringGrid.CanFocus: Boolean;
begin
Result := False;
end;
This actually is a bit strange working solution, because you are still able to tab into the control and it keeps responding to keyboard events.
I cannot reproduce your cliping problem with this code (XE2 here):
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if gdSelected in State then
begin
StringGrid1.Canvas.Brush.Color := $00940A4B;
StringGrid1.Canvas.FillRect(Rect);
StringGrid1.Canvas.Font.Style := [fsBold];
StringGrid1.Canvas.Font.Color := clHighlightText;
StringGrid1.Canvas.TextOut(Rect.Left + 3, Rect.Top + 5,
StringGrid1.Cells[ACol, ARow]);
end;
end;
The Rect will be and ís the correct CellRect. The cliping effect is due to something else elsewhere.
But if there really is a spurious +4 in the source code of XE8 like Tom Brunberg mentions, which is easily overcome with -4, then that obviously is a bug and should be reported.
I'm using the OnDrawItem event in the TlistView component to draw the content using custom colors, but when scroll the listview some artifacts appears.
This is the code used.
procedure TForm35.FormCreate(Sender: TObject);
var
i, j : integer;
Item : TListItem;
s : string;
begin
for i:= 0 to 99 do
begin
Item:=ListView1.Items.Add;
for j:= 0 to ListView1.Columns.Count-1 do
begin
s:= Format('Row %d Column %d',[i+1, j+1]);
if j=0 then
Item.Caption :=s
else
Item.SubItems.Add(s);
end;
end;
end;
procedure TForm35.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
Rect: TRect; State: TOwnerDrawState);
var
x, y, i: integer;
begin
if odSelected in State then
begin
TListView(Sender).Canvas.Brush.Color := clYellow;
TListView(Sender).Canvas.Font.Color := clBlack;
end
else
begin
TListView(Sender).Canvas.Brush.Color := clLtGray;
TListView(Sender).Canvas.Font.Color := clGreen;
end;
TListView(Sender).Canvas.FillRect(Rect);
x := 5;
y := (Rect.Bottom - Rect.Top - TListView(Sender).Canvas.TextHeight('Hg')) div 2 + Rect.Top;
TListView(Sender).Canvas.TextOut(x, y, Item.Caption);
for i := 0 to Item.SubItems.Count - 1 do
begin
inc(x, TListView(Sender).Columns[i].Width);
TListView(Sender).Canvas.TextOut(x, y, Item.SubItems[i]);
end;
end;
I tested this code in Delphi 2007 and XE3, but I'm getting the same results. How i can prevent this issue?
Ok. Change X := 5 to X := Rect.Left;
And another solution (may be more accuracy):
uses
Graphics;
//... Form or something else declarations ...
implementation
procedure TForm35.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
s: string;
ts: TTextStyle; // Text style (used for drawing)
begin
// inherited;
// Clear target rectangle
// Set Canvas'es Font, Pen, Brush according for Item state
// Get into s variable text value of the Cell.
ts.Alignment := taLeftJustify; // Horz left alignment
ts.Layout := tlCenter; // Vert center alignment
ts.EndEllipsis := True; // End ellipsis (...) If line of text is too long too fit between left and right boundaries
// Other fields see in the Graphics.TTextStyle = packed record
ListView1.Canvas.TextRect(
Rect,
Rect.Left, // Not sure, but there are a small chance of this values equal to zero instead of Rect...
Rect.Top,
s,
ts)
end;
end.
And to prevent some flicking...
...
var
b: TBitmap;
begin
b := TBitmap.Create;
try
b.Widht := Rect.Right - Rect.Left;
b.Height := Rect.Bottom - Rect.Top;
//...
// Draw content on the b.Canvas
//...
ListView.Canvas.Draw(Rect.Left, Rect.Top, b);
finally
b.Free;
end;
end;
1st Question:
How do you call the part in stringgrid that is not visible? You need to scroll to see it.
For example:
There are 20 rows in a stringgrid but you can see only 10 at a time. You need to scroll to see other 10. How are the "hidden" ones called?
2nd Question:
I know this is probably not the right way to do it so some pointers would be appreciated.
I have a string grid with 1 fixed row. I add ColorButtons at runtime. So I populate 1 column with buttons.
I use this buttons to "insert/delete" rows. As long as all of the grid is in the "visible" part this works well.
Problem occcurs when I "insert" new rows and move the buttons to the "hidden" part. The last button is then drawn to Cell[0,0]. Other buttons in the "hidden" part are drawn correctly. Any idea why this happens? Should I find a way to manage this problem in the OnDraw method or is there a better (correct) way to do this?
Code:
procedure Tform1.addButton(Grid : TStringGrid; ACol : Integer; ARow : Integer);
var
bt : TColorButton;
Rect : TRect;
index : Integer;
begin
Rect := Grid.CellRect(ACol,ARow);
bt := TColorButton.Create(Grid);
bt.Parent := Grid;
bt.BackColor := clCream;
bt.Font.Size := 14;
bt.Width := 50;
bt.Top := Rect.Top;
bt.Left := Rect.Left;
bt.Caption := '+';
bt.Name := 'bt'+IntToStr(ARow);
index := Grid.ComponentCount-1;
bt :=(Grid.Components[index] as TColorButton);
Grid.Objects[ACol,ARow] := Grid.Components[index];
bt.OnMouseUp := Grid.OnMouseUp;
bt.OnMouseMove := Grid.OnMouseMove;
bt.Visible := true;
end;
procedure MoveRowPlus(Grid : TStringGrid; Arow : Integer; stRow : Integer);
var
r, index : Integer;
bt : TColorButton;
Rect : TRect;
begin
Grid.RowCount := Grid.RowCount+stRow;
for r := Grid.RowCount - 1 downto ARow+stRow do
begin
Grid.Rows[r] := Grid.Rows[r-StRow];
end;
index := Grid.ComponentCount-1;
for r := Grid.RowCount - 1 downto ARow+stRow do
begin
bt :=(Grid.Components[index] as TColorButton);
Rect := Grid.CellRect(10,r);
bt.Top := Rect.Top;
bt.Left := Rect.Left;
Grid.Objects[10,r] := Grid.Components[index];
dec(index);
end;
for r := ARow to (ARow +stRow-1) do
begin
Grid.Rows[r].Clear;
end;
end;
procedure MoveRowMinus(Grid : TStringGrid; Arow : Integer; stRow : Integer);
var
r, index : Integer;
bt : TColorButton;
Rect : TRect;
begin
for r := ARow to Grid.RowCount-stRow-1 do
begin
Grid.Rows[r] := Grid.Rows[r+StRow];
end;
index := ARow-1;
for r := ARow to Grid.RowCount-stRow-1 do
begin
Rect := Grid.CellRect(10,r);
bt :=(Grid.Components[index] as TColorButton);
bt.Top := Rect.Top;
bt.Left := Rect.Left;
Grid.Objects[10,r] := Grid.Components[index];
bt.Visible := true;
inc(index);
end;
for r := Grid.RowCount-stRow to Grid.RowCount-1 do
begin
Grid.Rows[r].Clear;
end;
Grid.RowCount := Grid.RowCount-stRow;
end;
For the visible part there exist the VisibleRowCount and VisibleColCount properties. The TGridAxisDrawInfo record type names the visible part Boundary and all parts together Extent (or vice versa, I never remember). So there is no specific by the VCL declared name for the unvisible part of a string grid. It just is the unvisible part.
I think you are making a logical error: the buttons are not moved when you scroll the grid. Though it may seem like they move, that is just the result of moving the device context contents due to an internal call to ScrollWindow. The scroll bars in the string grid component are custom added, and do not work like those of e.g. a TScrollBox.
To always show all buttons on the locations where they really are, repaint the string grid in the OnTopLeftChanged event:
procedure TForm1.StringGrid1TopLeftChanged(Sender: TObject);
begin
StringGrid1.Repaint;
end;
When the row heights of all rows and the height of string grid never change, then it is sufficient to create all buttons only once, and let them stay where they are. This means that every button no longer is "attached" to a row, and storing them in the Objects property has no significance any more. When a button is pressed, simply calculate the intended row index from the position of the button in combination with the TopRow property of the string grid which specifies the index of the first visible scrollable row in the grid.
If the grid can resize, e.g. by anchors, then update the button count in the parent's OnResize event. And if the row count of the string grid may become less then the maximum visible row count, then also update the (visible) button count.
If you want more of an answer, then please update your question and explain how the MoveRowPlus and the MoveRowMinus routines are called due to interaction with the grid and or buttons, because now I do not fully understand what it is that you want.
And about CellRect giving the wrong coordinates: that is because CellRect only works on full (or partial) visible cells. To quote the documentation:
If the indicated cell is not visible, CellRect returns an empty rectangle.
Addition due to OP's comments
I think the following code does what you want. The original row index of every button is stored in the Tag property.
unit Unit1;
interface
uses
Windows, Classes, Controls, Forms, StdCtrls, Grids;
type
TForm1 = class(TForm)
Grid: TStringGrid;
procedure GridTopLeftChanged(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FPrevTopRow: Integer;
procedure CreateGridButtons(ACol: Integer);
procedure GridButtonClick(Sender: TObject);
procedure RearrangeGridButtons;
function GetInsertRowCount(ARow: Integer): Integer;
function GridButtonToRow(AButton: TButton): Integer;
procedure MoveGridButtons(ButtonIndex, ARowCount: Integer);
end;
implementation
{$R *.dfm}
type
TStringGridAccess = class(TStringGrid);
procedure TForm1.FormCreate(Sender: TObject);
begin
FPrevTopRow := Grid.TopRow;
CreateGridButtons(2);
end;
procedure TForm1.CreateGridButtons(ACol: Integer);
var
R: TRect;
I: Integer;
Button: TButton;
begin
R := Grid.CellRect(ACol, Grid.FixedRows);
Inc(R.Right, Grid.GridLineWidth);
Inc(R.Bottom, Grid.GridLineWidth);
for I := Grid.FixedRows to Grid.RowCount - 1 do
begin
Button := TButton.Create(Grid);
Button.BoundsRect := R;
Button.Caption := '+';
Button.Tag := I;
Button.ControlStyle := [csClickEvents];
Button.OnClick := GridButtonClick;
Button.Parent := Grid;
Grid.Objects[0, I] := Button;
OffsetRect(R, 0, Grid.DefaultRowHeight + Grid.GridLineWidth);
end;
end;
procedure TForm1.GridButtonClick(Sender: TObject);
var
Button: TButton absolute Sender;
N: Integer;
I: Integer;
begin
N := GetInsertRowCount(Button.Tag);
if Button.Caption = '+' then
begin
Button.Caption := '-';
Grid.RowCount := Grid.RowCount + N;
for I := 1 to N do
TStringGridAccess(Grid).MoveRow(Grid.RowCount - 1,
GridButtonToRow(Button) + 1);
MoveGridButtons(Button.Tag, N);
end
else
begin
Button.Caption := '+';
for I := 1 to N do
TStringGridAccess(Grid).MoveRow(GridButtonToRow(Button) + 1,
Grid.RowCount - 1);
Grid.RowCount := Grid.RowCount - N;
MoveGridButtons(Button.Tag, -N);
end;
end;
procedure TForm1.GridTopLeftChanged(Sender: TObject);
begin
RearrangeGridButtons;
FPrevTopRow := Grid.TopRow;
end;
procedure TForm1.RearrangeGridButtons;
var
I: Integer;
Shift: Integer;
begin
Shift := (Grid.TopRow - FPrevTopRow) *
(Grid.DefaultRowHeight + Grid.GridLineWidth);
for I := 0 to Grid.ControlCount - 1 do
begin
Grid.Controls[I].Top := Grid.Controls[I].Top - Shift;
Grid.Controls[I].Visible := Grid.Controls[I].Top > 0;
end;
end;
function TForm1.GetInsertRowCount(ARow: Integer): Integer;
begin
//This function should return the number of rows which is to be inserted
//below ARow. Note that ARow refers to the original row index, that is:
//without account for already inserted rows. For now, assume three rows:
Result := 3;
end;
function TForm1.GridButtonToRow(AButton: TButton): Integer;
begin
for Result := 0 to Grid.RowCount - 1 do
if Grid.Objects[0, Result] = AButton then
Exit;
Result := -1;
end;
procedure TForm1.MoveGridButtons(ButtonIndex, ARowCount: Integer);
var
I: Integer;
begin
for I := 0 to Grid.ControlCount - 1 do
if Grid.Controls[I].Tag > ButtonIndex then
Grid.Controls[I].Top := Grid.Controls[I].Top +
ARowCount * (Grid.DefaultRowHeight + Grid.GridLineWidth);
end;
end.
But may I say that this is also possible without the use of button controls: I suggest drawing fake button controls in the string grid's OnDrawCell event.