String grid prints with no brush style

Question

I am having trouble with printing string grid. I use this code which works good except brush style. In application it works - where in cell is 'XXXX', it is overwritten with brush.style:= bsDiagCross; But when I try to print it, brush style is gone and on printed page is table with 'XXXX'. What´s wrong?

procedure frmPrint.Gridd(grd:TStringGrid; links, oben: Integer; scal:double; farbig:boolean);
       var
          x, y, li, ob, re, un, waag, senk, a,  vSpalte, bSpalte, vZeile, bZeile: integer;
          fix, grund, schrift, Barva: TColor;
          r: TRect;
          RR: TRect;
          Sirka,Vyska, Velikost : integer;

          function rech(i,j:integer):integer;
          begin
             result:=round(((i*j) / 72) * scal);
          end;
       begin
     if printdialog.execute then // offnet den print dialog
     begin
          vZeile := 0;
          vSpalte := 0;
          Sirka := Printer.PageWidth;
          Vyska := Printer.PageHeight;

          bZeile := grd.rowcount - 1;
          bSpalte := grd.colcount - 1;
          if (scal > 0) and
             (vZeile < grd.rowcount) and
             (vSpalte < grd.colcount) then
          begin
             if farbig then
             begin
                fix := grd.fixedcolor;
                grund := grd.color;
                schrift := grd.font.color;
             end
             else
             begin
                fix := clsilver;
                grund := clwhite;
                schrift := clblack;
             end;
             waag := GetDeviceCaps(Printer.Handle, LogPixelSX);
             senk := GetDeviceCaps(Printer.Handle, LogPixelSY);
             links := rech(links, waag);
             oben := rech(oben, senk);
             li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
             a := rech(3, waag);
             with Printer do
             begin
                Title := 'report';
                Orientation := poLandscape; //poLandscape;
                BeginDoc;
                if grd.gridlinewidth > 0 then
                begin
                   Canvas.Pen.color := $333333;
                   Canvas.Pen.width := 1;
                   Canvas.Pen.Style := psSolid
                end
                else
                   Canvas.Pen.Style := psClear;
                Canvas.Font := Grd.Font;
                Canvas.Font.Color := Schrift;
                Canvas.Font.Size := round((Grd.Font.Size / 0.72) * scal);
                ob := GetDeviceCaps(Printer.Handle, PhysicalOffsetY) + 1 + oben;
                for y := vZeile to bZeile do
                begin
                   un := ob + rech(Grd.RowHeights[y]+1, senk);
                   //neue Seite + Kopf
                   if (un > Printer.PageHeight) and
                      (Printing) then
                   begin
                      EndDoc;
                      BeginDoc;
                      ob := GetDeviceCaps(Printer.Handle, PhysicalOffsetY) + 1 + oben;
                      un := ob + rech(Grd.RowHeights[y]+1, senk);
                      for x := vSpalte to bSpalte do
                      begin
                         Canvas.Brush.Color := fix;
                         re := li + rech(Grd.ColWidths[x] + 1, waag);

                         Canvas.Rectangle(li, ob, re + 2, un + 2);
                         r := rect(li + a, ob + 1, re - a, un - 2);
                         DrawText(Canvas.Handle, PChar(Grd.Cells[x,0]), length(Grd.Cells[x,0]), r, DT_SINGLELINE or DT_VCENTER);
                         li := re;
                      end;
                      li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
                      ob := un;
                   end;
                   un := ob + rech(Grd.RowHeights[y]+1, senk);
                   for x := vSpalte to bSpalte do
                   begin
                      if (x < Grd.FixedCols) or
                         (y < Grd.FixedRows) then
                         Canvas.Brush.Color := fix
                      else
                         Canvas.Brush.Color := Grund;
                      re := li + rech(Grd.ColWidths[x]+ 1, waag);
                      Canvas.Rectangle(li, ob, re + 2, un + 2);
                      r := rect(li + a, ob + 1, re - a, un - 2);
                      DrawText(Canvas.Handle, PChar(Grd.Cells[x,y]), length(Grd.Cells[x,y]), r, DT_SINGLELINE or DT_VCENTER);
                      li := re;
                   end;
                   ob := un;
                   li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
                end;
                if Printing then
                   EndDoc;
             end;
          end;
       end;
    end; 

procedure frmPrint.sgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
  State: TGridDrawState);
var
  sg : TStringGrid;
  c : TCanvas;
begin
  sg := TStringGrid( Sender );
  c := sg.Canvas;

  if // Zellen
    ( sg.Cells[ACol,ARow] = 'XXXX' )
  then begin
    c.Brush.Style := bsDiagCross;
    c.FillRect(Rect);
  //  c.Brush.Color := clblack;
  end;



  sg.Canvas.Pen.Color := clblack;
    // "Set the Style property to bsClear to eliminate flicker when the object
    // repaints" (I don't know if this helps).
    sg.Canvas.Brush.Style := bsClear;
    // Draw a line from the cell's top-right to its bottom-right:
    sg.Canvas.MoveTo(Rect.Right, Rect.Top);
    sg.Canvas.LineTo(Rect.Right, Rect.Bottom);
    // Make the horizontal line.
    sg.Canvas.LineTo(Rect.Left, Rect.Bottom);
    // The other vertical line.
    sg.Canvas.LineTo(Rect.Left, Rect.Top);
  zmeneno:= false;
end;

Because in the printing code you are missing the check for 'XXXX' and corresponding setting of `Brush.Style` and call to `FillRect()` instead of the call to `DrawText()`. — Tom Brunberg, Sep 27 '16 at 21:17

Tom Brunberg · Accepted Answer · 2016-09-28T14:55:40.733

0

In the printing code (frmPrint.Gridd()) you are missing the check for 'XXXX' and corresponding setting of Brush.Style and call to FillRect() instead of the call to DrawText().

In frmPrint.Gridd() in the second for x loop change this line:

        DrawText(Canvas.Handle, PChar(grd.Cells[x, y]), length(grd.Cells[x, y]), r,
          DT_SINGLELINE or DT_VCENTER);

to (untested):

        if grd.Cells[x, y] = 'XXXX' then
        begin
          Canvas.Brush.Style := bsDiagCross;
          Canvas.FillRect(r);
          Canvas.Brush.Style := bsClear;
        end
        else
        begin
          DrawText(Canvas.Handle, PChar(grd.Cells[x, y]), length(grd.Cells[x, y]), r,
            DT_SINGLELINE or DT_VCENTER);
        end;

If the header row also may have those 'XXXX' cells then do the corresponding change also in the first for x loop.

edited Sep 28 '16 at 14:55

answered Sep 27 '16 at 21:38

Tom Brunberg

20,312
8
37
54

It is working, partially. Table 1 shows original print without brush.style. Table 2 shows how it works with Tom´s code, table 3 is printscreen from application. [link](https://ulozto.cz/!qCAGkAx7N/table1-pdf) [link](https://ulozto.cz/!omeNk3VRH/table2-pdf) [link](https://ulozto.cz/!igB36bkZa/table3-png) – Karel CZ Sep 28 '16 at 06:12
@KarelCZ I have edited my answer, to explicitly set `Canvas.Brush.Style`. – Tom Brunberg Sep 28 '16 at 07:05
Thanks Tom, I´m dumb as box of hammers:-) But, there is just one catch. It print fixed rows and cols right, but non fixed cols are wrong. These tables are for competition. So, there are number of matches in fixed cols and last three cols are for total points, number of wins and rank. Number of unfixed cols grows slower than fixed. Fixed 6 = unfixed 6 (ok, firs col is fixed), fixed 7 but unf. 5, fixed 10 but unf. 6, fixed 14, unf 7, fixed 19, unf 8. There is also overwriting - cells that should be empty are filled. Last correct filling is in 2.table. There is definitely a pattern i dont see it – Karel CZ Sep 28 '16 at 10:38
@KarelCZ I answered your question why the 'XXXX' cells are not printed with the `bsDiagCross` style, even if they showed up on the display correctly. If you have a new question regarding fixed or non-fixed columns or any other matter, please post a new question. – Tom Brunberg Sep 28 '16 at 11:24
©Tom I´m very thankfull and appreciate your help. That previous comment was not new question or at least I don´t think so. Version of code that printed those 'XXXX' printed the grid correctly (in therms of cols numbers). Problem with cols appeared after i added your modification. – Karel CZ Sep 28 '16 at 13:04
@KarelCZ I did not understand your comment about the cols, and did a test. Indeed, there's an error. Moving the line `Canvas.Brush.Style := bsClear;` as I edited my answer, resets the style before printing fixed cells. Don't know if this was the problem you refer to? – Tom Brunberg Sep 28 '16 at 14:59

score 0 · Answer 2 · answered Sep 28 '16 at 17:21

Tom, thank you very much for your help!! Solution is to swap the brush block behind draw This works perfectly:

...
DrawText(Canvas.Handle, PChar(Grd.Cells[x,y]), length(Grd.Cells[x,y]), r, DT_SINGLELINE or DT_VCENTER);

li := re;
if grd.Cells[x, y] = 'XXXX' then
  begin
    Canvas.Brush.Style := bsDiagCross;
    Canvas.FillRect(r);
    Canvas.Brush.Style := bsClear;
  end;

String grid prints with no brush style

2 Answers2