Registriert seit: 15. Nov 2004
Ort: Admont
140 Beiträge
|
Kleines Problem mit Canvas
4. Jan 2005, 14:15
Möchte ein Stringgrid drucken und ober dem Grid noch etwas hinschreiben
Das Stringgrid druckt er mir mit folgendem Code, aber wo schreib ich was rein um eine Überschrift ober dem Grid hinzuzufügen?
Kann mir das bitte wer sagen
Delphi-Quellcode:
procedure GridDruck(grd:TStringGrid;links,oben:word;scal:double);
var x,y,li,ob,re,un,waag,senk,h,a: integer;
s: string;
function rech(i,j:integer):integer;
begin
result:=round(((i*j) / 72) * scal);
end;
begin
if scal > 0 then
begin
waag:=getdevicecaps(printer.handle,logpixelsx);
senk:=getdevicecaps(printer.handle,logpixelsy); // hier + 200
links:=rech(links,waag);
oben:=rech(oben, senk);
a:=rech(3,waag);
li:=getdevicecaps(printer.handle,physicaloffsetx)+1+links;
with printer do
begin
s:='Grid-Druck';
title:=s;
BeginDoc;
Canvas.Font.Size := 30;
canvas.font:=grd.font;
canvas.font.size:=round((grd.font.size / 0.72) * scal);
h:=canvas.textheight(s);
canvas.pen.color:=$333333;
for x:=0 to grd.colcount-1 do
begin
if grd.gridlinewidth > 0 then
begin
canvas.pen.style:=pssolid;
canvas.pen.width:=1;
end
else
canvas.pen.style:=psclear;
ob:=getdevicecaps(printer.handle,physicaloffsety)+1+oben;
re:=li+rech(grd.ColWidths[x]+1,waag);
for y:=0 to grd.rowcount-1 do
begin
un:=ob+rech(grd.RowHeights[y]+1,senk);
if (x < grd.fixedcols) or (y < grd.fixedrows) then
canvas.brush.color:=grd.fixedcolor
else
canvas.brush.color:=grd.color;
canvas.rectangle(li,ob,re,un);
canvas.brush.style:=bsclear;
canvas.textrect(rect(li+a,ob+1,re-a,un-1),
li+a,ob+(un-ob-h)div 2,grd.Cells[x,y]);
ob:=un;
end;
canvas.brush.color:=clwhite;
canvas.pen.style:=psclear;
canvas.rectangle(li,ob+1,re,ob+h);
li:=re;
end;
enddoc;
end;
end;
end;
Hier noch der aufruf der Funktion
griddruck(sg_messekalender,sg_messekalender.left,sg_messekalender.top,0.45);
mfg
Franz
|
|
Zitat
|