Saturday, April 26, 2014

Print a simple cm based ruler instead of buying

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

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;

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;