//a lot cheaper to print your rulers instead of buying them
procedure Tform1.PrintCmRuler;
var j,k,margin,m : integer;
begin PrinterSetupDialog1.Execute; //for best result set it to 300 DPI
printer.BeginDoc;
margin:=0; //margin in inches if desired
//Each logical unit is mapped to 0.1 millimeter.
//Positive x is to the right; positive y is up.
SetMapMode(printer.Canvas.Handle, MM_HIMETRIC); // unit is 1/100 milimeter
with printer.Canvas do
begin font.Size:=60; k:=-26500;
for j:=0 downto k do //10*image1.Height-1 do
begin m:=26-(-j div 1000);
if j mod 1000 =0 then
begin moveto(margin,j); lineto(margin+750,j); //moveto(0,j);
textout(margin+760,j,inttostr(m))
end
else
if (m>0)and(j mod 500 =0) then
begin
moveto(margin,j); lineto(margin+300,j);
end else
if (m>0)and(j mod 100 =0) then
begin
moveto(margin,j); lineto(150+margin,j);
end;
end;
moveto(margin,0); lineto(margin,k)
end;
printer.EndDoc
end;
How to export a Delphi Stringgrid ot Tstringgrid into EMF file
Saturday, April 26, 2014
Create dynamic SQL at runtime
Long time ago I used this routine for creating dynamic sql at run time that uses sql parameter instead of string values.
function CreateSQLedit(SqlTable,fieldnames,wherefields : string; vf,vw: array of variant) : integer;
var i : integer; s,t : string; st, sw : tstringlist;
//vw for wherefields clauses & vf for fieldnames
CONST c = #13#10;
begin
if (pos(' ',fieldnames)>0)or(pos(',',fieldnames)>0) then
begin showmessage('Error in fieldnames format'); result:=-100;
exit
end;
if (pos(' ',wherefields)>0)or(pos(',',wherefields)>0) then
begin showmessage('Error in where field format'); result:=-100;
exit
end;
st:=tstringlist.Create; st.Sorted:=false; sW:=tstringlist.Create; sW.Sorted:=false;
t:=fieldnames;
repeat
i:=pos(';',t); if i=0 then break;
delete(t,i,1); insert(c,t,i)
until false;
st.Text:=t;
if st.count-1<>high(vf) then
begin showmessage('Mismatch in number of fields and their values'); st.Free; sw.Free;
exit
end;
t:=trim(wherefields);
repeat
i:=pos(';',t); if i=0 then break;
delete(t,i,1); insert(c,t,i)
until false;
sw.Text:=t;
s:='UPDATE '+SqlTable+c+'SET'+c;
with st do
for i:=0 to count-1 do
s:=s+strings[i] +' =:'+strings[i]+',';
setlength(s, length(s)-1); s:=s+c+'WHERE ';
with sw do
for i:=0 to count-1 do
s:=c+s+strings[i]+' =:'+strings[i]+' AND ';
setlength(s,length(s)-5);
//CLIPBOARD.AsText:=S;
with dm.qrygeneral do
begin sql.Clear; Parameters.Clear; sql.Text:=s;
parameters.ParseSQL(s, true); //not neded for BDE
for i:=0 to high(vf) do
parameters.ParamByName(st[i]).Value:=vf[i];
for i:=0 to high(vw) do
parameters.ParamByName(sw[i]).Value:=vw[i];
Execsql
end;
st.Free; sw.Free
end;
function CreateSQLedit(SqlTable,fieldnames,wherefields : string; vf,vw: array of variant) : integer;
var i : integer; s,t : string; st, sw : tstringlist;
//vw for wherefields clauses & vf for fieldnames
CONST c = #13#10;
begin
if (pos(' ',fieldnames)>0)or(pos(',',fieldnames)>0) then
begin showmessage('Error in fieldnames format'); result:=-100;
exit
end;
if (pos(' ',wherefields)>0)or(pos(',',wherefields)>0) then
begin showmessage('Error in where field format'); result:=-100;
exit
end;
st:=tstringlist.Create; st.Sorted:=false; sW:=tstringlist.Create; sW.Sorted:=false;
t:=fieldnames;
repeat
i:=pos(';',t); if i=0 then break;
delete(t,i,1); insert(c,t,i)
until false;
st.Text:=t;
if st.count-1<>high(vf) then
begin showmessage('Mismatch in number of fields and their values'); st.Free; sw.Free;
exit
end;
t:=trim(wherefields);
repeat
i:=pos(';',t); if i=0 then break;
delete(t,i,1); insert(c,t,i)
until false;
sw.Text:=t;
s:='UPDATE '+SqlTable+c+'SET'+c;
with st do
for i:=0 to count-1 do
s:=s+strings[i] +' =:'+strings[i]+',';
setlength(s, length(s)-1); s:=s+c+'WHERE ';
with sw do
for i:=0 to count-1 do
s:=c+s+strings[i]+' =:'+strings[i]+' AND ';
setlength(s,length(s)-5);
//CLIPBOARD.AsText:=S;
with dm.qrygeneral do
begin sql.Clear; Parameters.Clear; sql.Text:=s;
parameters.ParseSQL(s, true); //not neded for BDE
for i:=0 to high(vf) do
parameters.ParamByName(st[i]).Value:=vf[i];
for i:=0 to high(vw) do
parameters.ParamByName(sw[i]).Value:=vw[i];
Execsql
end;
st.Free; sw.Free
end;
Friday, April 25, 2014
Export Delphi Stringgrid into EMF file
Delphi Tstringgrid can be exported into EMF and then pasted into MSWORD. Delphi stringgrids are more flexible than MS WORD tables. Bellow is the code for doing that.
procedure StringGrid2EMF(grid : Tstringgrid; Horlines,Verlines : boolean; filename : string);
var i,j,w,h,h1,w1 : integer; m : tmetafile; c: tmetafilecanvas; r : trect;
begin m:=tmetafile.Create;w:=0; h:=0;
with grid do for i:=0 to colcount-1 do w:=w+ColWidths[i]+gridlinewidth;
with grid do for i:=0 to rowcount-1 do h:=h+RowHeights[i]+gridlinewidth;
m.Width:=w; m.Height:=h;
c:=tmetafilecanvas.Create(m,0); c.Font:=grid.Font;
c.Brush.Color:=grid.Color; c.Brush.Style:=bssolid;
c.FillRect(rect(0,0,m.width,m.height));
with grid do
for i:=0 to colcount-1 do
for j:=0 to rowcount-1 do
begin r:=grid.CellRect(i,j);
if (i=0)or(j=0) then
c.Brush.Color:=grid.FixedColor
else
c.Brush.Color:=grid.Color;
c.FillRect(r);
c.TextOut(r.left+3,r.top+1,cells[i,j])
end;
c.pen.Color:=$b0b0b0;
w1:=0; h1:=0;
with grid do
begin c.MoveTo(0,0); c.LineTo(w,0); //first hor line
for i:=0 to rowcount-1 do
if HorLines then
begin h1:=h1+RowHeights[i]+gridlinewidth;
c.MoveTo(0,h1);
c.LineTo(w,h1);
end;
c.MoveTo(0,h); c.LineTo(w,h); //do last hor line
c.MoveTo(0,0); c.LineTo(0,h); //first ver line
if VerLines then
for i:=0 to colcount do
begin w1:=w1+colwidths[i]+gridlinewidth;
c.MoveTo(w1,0);
c.LineTo(w1,h);
end;
c.MoveTo(w,0); c.LineTo(w,h) //last ver line
end;
c.Free; clipboard.Assign(m); m.SaveToFile(filename);
m.free;
showmessage('Meta file saved and put in clipboard')
end;
procedure StringGrid2EMF(grid : Tstringgrid; Horlines,Verlines : boolean; filename : string);
var i,j,w,h,h1,w1 : integer; m : tmetafile; c: tmetafilecanvas; r : trect;
begin m:=tmetafile.Create;w:=0; h:=0;
with grid do for i:=0 to colcount-1 do w:=w+ColWidths[i]+gridlinewidth;
with grid do for i:=0 to rowcount-1 do h:=h+RowHeights[i]+gridlinewidth;
m.Width:=w; m.Height:=h;
c:=tmetafilecanvas.Create(m,0); c.Font:=grid.Font;
c.Brush.Color:=grid.Color; c.Brush.Style:=bssolid;
c.FillRect(rect(0,0,m.width,m.height));
with grid do
for i:=0 to colcount-1 do
for j:=0 to rowcount-1 do
begin r:=grid.CellRect(i,j);
if (i=0)or(j=0) then
c.Brush.Color:=grid.FixedColor
else
c.Brush.Color:=grid.Color;
c.FillRect(r);
c.TextOut(r.left+3,r.top+1,cells[i,j])
end;
c.pen.Color:=$b0b0b0;
w1:=0; h1:=0;
with grid do
begin c.MoveTo(0,0); c.LineTo(w,0); //first hor line
for i:=0 to rowcount-1 do
if HorLines then
begin h1:=h1+RowHeights[i]+gridlinewidth;
c.MoveTo(0,h1);
c.LineTo(w,h1);
end;
c.MoveTo(0,h); c.LineTo(w,h); //do last hor line
c.MoveTo(0,0); c.LineTo(0,h); //first ver line
if VerLines then
for i:=0 to colcount do
begin w1:=w1+colwidths[i]+gridlinewidth;
c.MoveTo(w1,0);
c.LineTo(w1,h);
end;
c.MoveTo(w,0); c.LineTo(w,h) //last ver line
end;
c.Free; clipboard.Assign(m); m.SaveToFile(filename);
m.free;
showmessage('Meta file saved and put in clipboard')
end;
Subscribe to:
Posts (Atom)