ブラシスタイルのない文字列グリッドプリント

Question

文字列グリッドの印刷に問題があります。私はこのコードを使用して、ブラシスタイル以外ではうまく動作します。アプリケーションでは、それは動作します - セルでは 'XXXX'は、brush.style:= bsDiagCross;で上書きされますが、印刷しようとするとブラシスタイルはなくなり、印刷されたページには 'XXXX'という表があります。どうしましたか？印刷コード（frmPrint.Gridd()）で

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

あなたは「XXXX」とBrush.Styleの対応を設定するためのチェックが欠落してFillRect()代わりのDrawText()への呼び出しに呼び出しされています。第for xループ変化frmPrint.Gridd()で

この行：（未テスト）に

 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

トム、ありがとうございました！ ソリューションは、ブラシブロックが背景にある。これは完璧に動作 を描く交換することです：

印刷コードで、あなたが「XXXX」とBrush.Style` `の対応を設定するためのチェックが欠落していると（FillRect`を呼び出すので

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