Струнная сетка печатает без стиля кисти

Question

У меня проблемы с печатью сетки строк. Я использую этот код, который хорошо работает, кроме стиля кисти. В приложении это работает - где в ячейке 'XXXX', оно перезаписывается brush.style:= bsDiagCross; Но когда я пытаюсь его напечатать, стиль кисти исчезает, и на распечатанной странице появляется таблица с "XXXX". В чем дело?

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;

Answer 1

В печатном коде (frmPrint.Gridd()) вы пропускаете проверку "XXXX" и соответствующую настройку Brush.Style и позвонить FillRect() вместо вызова DrawText(),

В frmPrint.Gridd() во-вторых for x цикл изменить эту строку:

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

до (не проверено):

        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;

Если строка заголовка также может иметь эти ячейки "XXXX", то выполните соответствующее изменение также в первом for x петля.

Answer 2

Том, большое спасибо за помощь!! Решение состоит в том, чтобы поменять блок кисти за рисованием. Это прекрасно работает:

...
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;