[SOLVED] Redraw dbgrid with DefaultDrawing false - background

[BigChimp]

Posted this in LCL as this might be a more generic problem...

I've modified a dbgrid to show the text of memo lines (normally it just shows (Memo); thanks to User137.

I use DefaultDrawing:=false and a OnDrawColumnCell handler (see code below).

This works as it draws the cells.

However, when I show e.g. a message box, I suppose the drawing code does not take into account that it should not draw over the messagebox which is in the foreground... See screenshot.
Additionally, when moving the showmessage dialog, I get the unique opportunity to use it as some kind of pencil eraser on the grid... (hard to say in words, but I'm sure the effect will be well-known to the seasoned GUI guys)

That's strange, because I'm basically just reusing the code already in the LCL.... obviously though I forgot something....

How can I fix this?

Thanks!

Code: [Select]

procedure TForm1.ResultsGridDrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
// Draw memo text instead of (Memo)
// Note: grid DefaultDrawing property must be off to avoid duplicate drawing
// To get this, I basically copied the existing DefaultDrawColumnCell procedure
// but tested for memo first. If no memo, pass on to default procedure.
// Maybe slower, more complicated, but it allows for changes in the
// core Lazarus DefaultDrawColumnCell procedure.
// Thanks to User137 on the forum
var
  OverrideDraw: boolean; //determine if we're going to override normal Lazarus draw routines
  OurDisplayString: string;
  CurrentField: TField;
  DataRow: Integer;
begin
  OverrideDraw:=false;
  try
    CurrentField := Column.Field;
    if CurrentField.DataType = ftMemo then
    begin
      OverRideDraw:=true;
    end;
  except
    on E: exception do
    begin
      // We might have an inactive datalink or whatever,
      // in that case, pass on our problems to the existing
      // procedure.
      //showMessage('Exception: ' + E.Classname + '/' + E.Message);
      OverRideDraw:=false;
    end;
  end;

  if OverRideDraw=false then
  begin
    // Call normal procedure to handle drawing for us.
    ResultsGrid.DefaultDrawColumnCell(Rect,DataCol,Column,State);
  end
  else
  begin
    // Get to work displaying our memo contents
    // Basically shamelessly ripped from
    // DefaultDrawColumnCell
    // maybe fix something for first/header row
    if CurrentField<>nil then
    begin
      //DO display memo ;) OurDisplayString is string to be displayed
      OurDisplayString := CurrentField.AsString; //DisplayText will only show (Memo)
    end
    else
    begin
      OurDisplayString := '';
    end;
    //Actual drawing, taken from Grids.DrawCellText coding:
    ResultsGrid.Canvas.TextRect(Rect,Rect.Left,Rect.Top, OurDisplayString);
  end;
end;


[User137]

Well.. you did 99% of the code    Also it's free code here in the forums, don't need to mention me.

As for the problem, the second image is showing that background is not being drawn. If i see that right, you draw TextRect() but not the background behind it.

But, what is "custom drawn messagebox"? Wouldn't simple Showmessage() work in this case?

And the grid itself looks normal, just text in it. Is there really need to do special drawing things? I have actually never used databases with Lazarus, and someone else may be able to tell more about customizing DBGrid content based on your data. You can also use TStringGrid if need to, manually filling the values in.

[ludob]

DefaultDrawing:=false : no background is painted.
ResultsGrid.Canvas.TextRect(Rect,Rect.Left,Rect.Top, OurDisplayString): only a the text is painted on top of whatever background was there.

Add  ResultsGrid.Canvas.FillRect(Rect); before ResultsGrid.Canvas.TextRect and at least the "pencil eraser" will be gone. 

[BigChimp]

Well.. you did 99% of the code    Also it's free code here in the forums, don't need to mention me.

Actually, it was 99% LCL code I like mentioning people in my code - makes it easier to bug people afterwards

As for the problem, the second image is showing that background is not being drawn. If i see that right, you draw TextRect() but not the background behind it.
[/quote
[quote ludob]
Add  ResultsGrid.Canvas.FillRect(Rect); before ResultsGrid.Canvas.TextRect and at least the "pencil eraser" will be gone. 

mmm. thanks, guys, this does help: calling FillRect in the beginning of the code works for the actual data cells... Now looking at the header columns and rows...

But, what is "custom drawn messagebox"? Wouldn't simple Showmessage() work in this case?

There is no custom drawn messagebox; it is a regular ShowMessage, as you say.

And the grid itself looks normal, just text in it. Is there really need to do special drawing things? [...] You can also use TStringGrid if need to, manually filling the values in.

Yes, it seems I really have to do this... unless a similar workaround already exists. Note: this is for memo/varchar fields that can have thousands of characters, probably why you only see a place marker by default. I just happen to know the fields aren't very big and that the user would like to have an idea of the actual content if the field is bigger than the cell.
Yes, I know about the stringgrid... wanted to keep it as simple as possible though (was already switching between bufdataset and dbf, and got a bit tired of changing things just because of limitations)

[BigChimp]

Partial success!

I do get normal drawing in my data cells, but the header rows and columns are still not ok.
They get filled in with a grey background as usual, but this turns out to be translucent (e.g. switching programs with alt-tab, then coming back shows the canvas of the other program).

I suspect it is because OnDrawColumnCell only fires for data cells, not fixed cells.

In that case, presumably I have to subclass/derive a child from TDBGrid and create my own event (which will be another nice project for a relative newb like me)... or is there an easier way?

Code now:

Code: [Select]

procedure TForm1.ResultsGridDrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
// Draw memo text instead of (Memo), draw other text as usual.
// Note: grid DefaultDrawing property must be off to avoid duplicate drawing
// Basically copied the existing DefaultDrawColumnCell procedure
// but tested for memo first. If no memo, pass on to default procedure.
// Maybe slower, more complicated, but it allows for changes in the
// core Lazarus DefaultDrawColumnCell procedure.
// Thanks to User137 & ludob on the Lazarus forum
var
  //determine if we're going to override normal Lazarus draw routines
  OverrideDraw: boolean;
  OurDisplayString: string;
  CurrentField: TField;
  DataRow: Integer;
begin
  OverrideDraw:=false;

  // Make sure selected cells are highlighted
  if (gdSelected in State) then
  begin
    ResultsGrid.Canvas.Brush.Color := clHighlight;
  end
  else
  begin
    ResultsGrid.Canvas.Brush.Color := ResultsGrid.Color;
  end;

  // Draw background in any case - thanks to ludob on the forum:
  ResultsGrid.Canvas.FillRect(Rect);

  //Foreground
  try
    CurrentField := Column.Field;
    if CurrentField.DataType = ftMemo then
    begin
      OverrideDraw:=true;
    end;
  except
    on E: exception do
    begin
      // We might have an inactive datalink or whatever,
      // in that case, pass on our problems to the LCL
      OverrideDraw:=false;
    end;
  end;

  //Exception: fixed header should always be drawn like normal:
  // this never gets picked up as OnDrawColumnCell apparently only deals with data cells!!!
  if (gdFixed in State) then
  begin
    OverrideDraw:=false;
  end;

  if OverrideDraw=false then
  begin
    // Call normal procedure to handle drawing for us.
    ResultsGrid.DefaultDrawColumnCell(Rect,DataCol,Column,State);
  end
  else
  begin
    // Get to work displaying our memo contents
    // Basically shamelessly ripped from
    // DefaultDrawColumnCell
    OurDisplayString := '';
    if CurrentField<>nil then
    begin
      //DO display memo ;) OurDisplayString is string to be displayed
      try
        OurDisplayString := CurrentField.AsString; //DisplayText will only show (Memo)
      except
        // Ignore errors; use empty string as specified above
      end;
    end;
    //Actual foreground drawing, taken from Grids.DrawCellText coding:
    ResultsGrid.Canvas.TextRect(Rect,Rect.Left,Rect.Top, OurDisplayString);
  end;
end;


[ludob]

I suspect it is because OnDrawColumnCell only fires for data cells, not fixed cells.

That seems to be a bug in DBGrids. When you look at the following code (lcl/dbgrids.pas)

Code: [Select]

procedure TCustomDBGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
  aState: TGridDrawState);
var
  DataCol: Integer;
begin
  PrepareCanvas(aCol, aRow, aState);

  {$ifdef dbgGridPaint}
  DbgOut(' ',IntToStr(aCol));
  if gdSelected in aState then DbgOut('S');
  if gdFocused in aState then DbgOut('*');
  if gdFixed in aState then DbgOut('F');
  {$endif dbgGridPaint}

  if DefaultDrawing then
    DefaultDrawCell(aCol, aRow, aRect, aState);

  if (ARow>=FixedRows) and Assigned(OnDrawColumnCell) and
    not (csDesigning in ComponentState) then begin

    DataCol := ColumnIndexFromGridColumn(aCol);
    if DataCol>=0 then
      OnDrawColumnCell(Self, aRect, DataCol, TColumn(Columns[DataCol]), aState);

  end;

  DrawCellGrid(aCol, aRow, aRect, aState);
end;
in case DefaultDrawing=false you'll notice that for fixed rows (ARow>=FixedRows) and for fixed columns (DataCol>=0) nobody draws anything. I tried the following change:

Code: [Select]

procedure TCustomDBGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
  aState: TGridDrawState);
var
  DataCol: Integer;
begin
  PrepareCanvas(aCol, aRow, aState);

  {$ifdef dbgGridPaint}
  DbgOut(' ',IntToStr(aCol));
  if gdSelected in aState then DbgOut('S');
  if gdFocused in aState then DbgOut('*');
  if gdFixed in aState then DbgOut('F');
  {$endif dbgGridPaint}

  if DefaultDrawing then
    DefaultDrawCell(aCol, aRow, aRect, aState);

  if (ARow>=FixedRows) and Assigned(OnDrawColumnCell) and
    not (csDesigning in ComponentState) then begin

    DataCol := ColumnIndexFromGridColumn(aCol);
    if DataCol>=0 then
      OnDrawColumnCell(Self, aRect, DataCol, TColumn(Columns[DataCol]), aState)
    else
      if not DefaultDrawing then // don't draw twice
        DefaultDrawCell(aCol, aRow, aRect, aState);
  end
  else
    if not DefaultDrawing then // don't draw twice
      DefaultDrawCell(aCol, aRow, aRect, aState);

  DrawCellGrid(aCol, aRow, aRect, aState);
end;
and now the fixed columns and rows are drawn also. If this solves your problem, feel free to raise a mantis issue.

Probably an easier fix for your problem (for the lazy among us) is to set DefaultDrawing true. The OnDrawColumnCell will now clear whatever DefaultDrawCell has drawn and display your own output. Data fields are accessed twice, fillrect and drawtext called twice, a waste of resources but the result should be fine.

[BigChimp]

Thanks ludo, issue:
http://bugs.freepascal.org/view.php?id=21496
And yes, the lazy fix does work

Edit: mantis bug

[BigChimp]

For posterity: entire procedure after cleanup to make it portable (replaced reference to grid name with sender):

Code: [Select]

procedure TForm1.ResultsGridDrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
// Draw memo text instead of (Memo), draw other text as usual.

// Note: normally, grid DefaultDrawing property must be off to avoid duplicate drawing
// However, we need it on against bug 21496
// This will result in duplicate drawing but should work.

{
Basically copied the existing DefaultDrawColumnCell procedure
but tested for memo first. If no memo, pass on to default procedure.
Maybe slower, more complicated, but it allows for changes in the
core Lazarus DefaultDrawColumnCell procedure.
Thanks to User137 & ludob on the Lazarus forum
}
var
  //determine if we're going to override normal Lazarus draw routines
  OverrideDraw: boolean;
  OurDisplayString: string;
  CurrentField: TField;
  DataRow: Integer;
begin
  OverrideDraw:=false;

  // Make sure selected cells are highlighted
  if (gdSelected in State) then
  begin
    (Sender as TDBGrid).Canvas.Brush.Color := clHighlight;
  end
  else
  begin
    (Sender as TDBGrid).Canvas.Brush.Color := (Sender as TDBGrid).Color;
  end;

  // Draw background in any case - thanks to ludob on the forum:
  (Sender as TDBGrid).Canvas.FillRect(Rect);

  //Foreground
  try
    CurrentField := Column.Field;
    if CurrentField.DataType = ftMemo then
    begin
      OverrideDraw:=true;
    end;
  except
    on E: exception do
    begin
      // We might have an inactive datalink or whatever,
      // in that case, pass on our problems to the LCL
      OverrideDraw:=false;
    end;
  end;

  //Exception: fixed header should always be drawn like normal:
  // this never gets picked up as OnDrawColumnCell apparently only deals with data cells!!!
  if (gdFixed in State) then
  begin
    OverrideDraw:=false;
  end;

  if OverrideDraw=false then
  begin
    // Call normal procedure to handle drawing for us.
    (Sender as TDBGrid).DefaultDrawColumnCell(Rect,DataCol,Column,State);
  end
  else
  begin
    // Get to work displaying our memo contents
    // Basically shamelessly ripped from
    // DefaultDrawColumnCell
    OurDisplayString := '';
    if CurrentField<>nil then
    begin
      //DO display memo ;) OurDisplayString is string to be displayed
      try
        OurDisplayString := CurrentField.AsString; //DisplayText will only show (Memo)
      except
        // Ignore errors; use empty string as specified above
      end;
    end;
    //Actual foreground drawing, taken from Grids.DrawCellText coding:
    (Sender as TDBGrid).Canvas.TextRect(Rect,Rect.Left,Rect.Top, OurDisplayString);
  end;
end;


[micheus]

Not talking about the Title bug - but about DBGrid body - Delphi enable us to simply set new values for Canvas property and then use DefaultDrawColumnCell to paint the cells.

Code: [Select]

procedure TBrwAssistidos.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  ...
  with (Sender as TDBGrid) do
  begin
    if DataSource.DataSet.FieldByName('IND_TIPO_PESSOA').AsInteger = 0 then
    begin
      if (Column.FieldName = 'NOM_PESSOA') or (Column.FieldName = 'COD_PESSOA') then
        Canvas.Font.Style := [fsBold];
    end else
      Canvas.Font.Color := clGray;

    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;This makes easy to change the appearance of a few columns or lines with a small coding, but doesn't works with Lazarus (v0.9.30).


[edit 1] Added the event header

[edit 2] Ok, it works if I make the cell cleanup before call DefaultDrawColumnCell. I added Canvas.FillRect(Rect) before it.
Sorry bothering you.