asgunit-tms.pas

delphi的超级好用的表格控件

procedure TDemo.Loadfromfile1Click(Sender: TObject);
begin
 advstringgrid1.Clear;
 advstringgrid1.loadfromfile('test.txt');
end;

procedure TDemo.Savetofile1Click(Sender: TObject);
begin
advstringgrid1.savetofile('test.txt');
end;

procedure TDemo.SavetoHTML1Click(Sender: TObject);
begin
 advstringgrid1.Savetohtml('test.htm');
end;

procedure TDemo.SavetoCSV1Click(Sender: TObject);
begin
 advstringgrid1.savefixedcells:=false;
 advstringgrid1.Savetocsv('test.csv');
end;

procedure TDemo.LoadfromCSV1Click(Sender: TObject);
begin
 advstringgrid1.savefixedcells:=false;
 advstringgrid1.loadfromcsv('test.csv');
end;

procedure TDemo.AdvStringGrid1AutoInsertRow(Sender: TObject;
  ARow: Longint);
begin
 advstringgrid1.autonumbercol(0);
end;

procedure TDemo.AdvStringGrid1AutoDeleteRow(Sender: TObject;
  aRow: Longint);
begin
 advstringgrid1.autonumbercol(0);
end;

procedure TDemo.AdvStringGrid1ClickSort(Sender: TObject; aCol: Longint);
begin
 if not advstringgrid1.sortfixedcols then
 advstringgrid1.autonumbercol(0);
end;

procedure TDemo.CopytoExcel1Click(Sender: TObject);
begin
 Advstringgrid1.savetoxls('test.xls');
end;

procedure TDemo.SaveasXLS1Click(Sender: TObject);
begin
 advstringgrid1.savetoxls('text.xls');
end;

procedure TDemo.Copytoclipboard2Click(Sender: TObject);
begin
 advstringgrid1.copytoclipboard;
end;

procedure TDemo.Copyselectiontoclipboard1Click(Sender: TObject);
begin
 advstringgrid1.copyselectiontoclipboard;
end;

procedure TDemo.Pastefromclipboard2Click(Sender: TObject);
begin
 advstringgrid1.pasteselectionfromclipboard;
end;

procedure TDemo.Pastefromclipboard1Click(Sender: TObject);
begin
 advstringgrid1.pastefromclipboard;
end;

procedure TDemo.SetPrintOptions;
begin
 advstringgrid1.printsettings.titlelines.Assign(memo1.lines);

 if checkbox2.checked then
    advstringgrid1.printsettings.time:=ppTopLeft
 else
    advstringgrid1.printsettings.time:=ppNone;

 if checkbox1.checked then
    advstringgrid1.printsettings.date:=ppTopRight
 else
    advstringgrid1.printsettings.date:=ppNone;

 if checkbox3.checked then
    advstringgrid1.printsettings.pagenr:=ppBottomCenter
 else
    advstringgrid1.printsettings.pagenr:=ppNone;

 if checkbox4.checked then
   begin
     if radiobutton1.checked then
       advstringgrid1.PrintSettings.Borders :=advgrid.pbVertical;
     if radiobutton2.checked then
       advstringgrid1.PrintSettings.Borders :=advgrid.pbHorizontal;
     if radiobutton3.checked then
       advstringgrid1.PrintSettings.Borders :=advgrid.pbSingle;
   end
 else
    advstringgrid1.printsettings.borders:=advgrid.pbNoborder;

  if checkbox5.checked then
    advstringgrid1.printsettings.FitToPage := fpAlways
  else
    advstringgrid1.printsettings.FitToPage := fpNever;

  advstringgrid1.printsettings.NoAutoSize:=not checkbox7.checked;

  advstringgrid1.printsettings.Centered :=checkbox6.checked;
end;

procedure TDemo.Print2Click(Sender: TObject);
begin
 SetPrintOptions;
 advstringgrid1.print;
end;

procedure TDemo.Printpreview1Click(Sender: TObject);
var
 pagepreview:tpagepreview;
begin
 SetPrintOptions;
 advstringgrid1.previewpage:=1;
 pagepreview:=tpagepreview.create(self,advstringgrid1);
 try
  pagepreview.showmodal;
 finally
  pagepreview.free;
 end;
end;

procedure TDemo.About1Click(Sender: TObject);
var
 About:tAbout;
begin
 About:=tAbout.Create(self);
 try
  About.showmodal;
 finally
  about.free;
 end;
end;

procedure TDemo.Setselection1Click(Sender: TObject);
var
 gridrect:tgridrect;
begin
 gridrect.left:=1;
 gridrect.top:=5;
 gridrect.right:=advstringgrid1.colcount-1;
 gridrect.bottom:=advstringgrid1.rowcount-1;
 advstringgrid1.printrect(gridrect);
end;

procedure TDemo.fixedsortClick(Sender: TObject);
begin
 advstringgrid1.sortfixedcols:=fixedsort.checked;
end;

procedure TDemo.LoadfromXLS1Click(Sender: TObject);
begin
 advstringgrid1.loadfromxls('test.xls');
end;

procedure TDemo.AdvStringGrid1PrintPage(Sender: TObject; Canvas: TCanvas;
  pagenr, pagexsize, pageysize: Integer);
var
 savefont:tfont;
 ts,tw:integer;

const
 myowntitle:string='Your company name can go here using custom drawing';

begin
 if advstringgrid1.PrintColStart <>0 then exit;
 with canvas do
  begin

    savefont:=tfont.create;
    savefont.assign(font);

    font.name:='Arial';
    font.style:=[fsBold];
    font.height:=advstringgrid1.mapfontheight(14);
    font.color:=clRed;

    ts:=advstringgrid1.printcoloffset[0];
    tw:=advstringgrid1.printpagewidth;

    moveto(ts,-5);
    lineto(ts+tw,-5);
    lineto(ts+tw,-advstringgrid1.printsettings.headersize+5);
    lineto(ts,-advstringgrid1.printsettings.headersize+5);
    lineto(ts,-5);

    ts:=ts+ ((tw-textwidth(myowntitle)) shr 1);

    textout(ts,-10,myowntitle);

    font.assign(savefont);
    savefont.free;
  end;

end;

procedure TDemo.Column11Click(Sender: TObject);
var
 acol:longint;
begin
  acol:=(sender as tmenuitem).tag;
  with advstringgrid1 do
   begin
    if ishiddencolumn(acol) then unhidecolumn(acol)
    else hidecolumn(acol);
    (sender as tmenuitem).checked:=ishiddencolumn(acol);
   end;
end;

procedure TDemo.Findfirst1Click(Sender: TObject);
var
 res:tpoint;
 finddlg:tfinddlg;
 findparams:tfindparams;

begin
 finddlg:=tfinddlg.create(self);
 try
  if (finddlg.showmodal=mrOk) then
   begin
    findparams:=[];
    if finddlg.chkcase.checked then findparams:=findparams + [fnMatchCase];
    if finddlg.chkfull.checked then findparams:=findparams + [fnMatchFull];
    if finddlg.chkregular.checked then findparams:=findparams + [fnMatchRegular];
    if finddlg.dir.itemindex=1 then findparams:=findparams + [fnDirectionLeftRight];
    if finddlg.where.itemindex=1 then findparams:=findparams + [fnFindInCurrentCol];
    if finddlg.where.itemindex=2 then findparams:=findparams + [fnFindInCurrentRow];
    res:=advstringgrid1.findfirst(finddlg.findtext.text,findparams);
    if res.x>=0 then
     begin
      advstringgrid1.col:=res.x;
      advstringgrid1.row:=res.y;
     end
    else
      messagedlg('Text not found',mtinformation,[mbOK],0);
   end;
 finally
  finddlg.free;
 end;

end;

procedure TDemo.Findnext1Click(Sender: TObject);
var
 res:tpoint;
begin
 res:=advstringgrid1.findnext;
 if (res.x>=0) and (res.y>=0) then
   begin
    advstringgrid1.col:=res.x;
    advstringgrid1.row:=res.y;
   end
 else
  messagedlg('Text not found',mtinformation,[mbOK],0);
end;

procedure TDemo.multilineClick(Sender: TObject);
var
 i:integer;
begin

 if multiline.checked then
   advstringgrid1.defaultrowheight:=28
 else
   advstringgrid1.defaultrowheight:=16;

 advstringgrid1.multilinecells:=multiline.checked;

{
 if multiline.checked then
  begin
   for i:=1 to advstringgrid1.rowcount-1 do
    begin
     advstringgrid1.cells[2,i]:=advstringgrid1.cells[2,i]+#13#10+'line 2';
    end;
  end;
} 
end;

procedure TDemo.AdvStringGrid1CanEditCell(Sender: TObject; Arow,
  Acol: Integer; var canedit: Boolean);
begin
 canedit:=(acol<>3) or (colro.checked=false);
end;

procedure TDemo.AdvStringGrid1CellValidate(Sender: TObject; Col,
  Row: Integer; var Value: String; var Valid: Boolean);
var
 code,i:integer;
begin
{
 if (col>=3) then
  begin
    val(value,i,code);
    valid:=(code=0) and (i>0);
    if not valid then messagedlg('Validation example'#13#10'Input should be a number > 0',mtinformation,[mbok],0);
  end;
}
end;

procedure TDemo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 icon1.free;
 icon2.free;
 icon3.free;
 icon4.free;
 icon5.free;

 bitmap1.free;
 bitmap2.free;
 bitmap3.free;
 bitmap4.free;
 bitmap5.free;
end;

procedure TDemo.AdvStringGrid2GetAlignment(Sender: TObject; ARow,
  ACol: Integer; var AAlignment: TAlignment);
begin
 if (acol<>2) {and (acol<>4)} then Aalignment:=taCenter;
 if (arow=0) then Aalignment:=taCenter;

end;


procedure TDemo.SavetoASCII1Click(Sender: TObject);
begin
 advstringgrid1.savetoascii('test.asc');
end;

procedure TDemo.editgridGetEditorType(Sender: TObject; aCol, aRow: Integer;
  var aEditor: TEditorType);
begin
 case acol of
 1:aEditor:=edComboList;
 2:aEditor:=edEditBtn;
 3:aEditor:=edSpinEdit;
 4:aEditor:=edDateEdit;
 end;
end;

procedure TDemo.editgridEllipsClick(Sender: TObject; aCol, aRow: Integer;
  var S: String);
var
 tmp:string;
begin
 tmp:=s;
 if inputquery('Edit ('+inttostr(aCol)+':'+inttostr(aRow)+')','Cell value',tmp) then
  s:=tmp;

end;



procedure TDemo.AdvStringGrid1GetFormat(Sender: TObject; ACol: Integer;
  var AStyle: TSortStyle; var aPrefix, aPostfix: String);
begin
  case acol of
  3:AStyle:=ssNumeric;
  4:AStyle:=ssDate;
  5:begin
     AStyle:=ssNumeric;
     apostfix:='pk';
    end;
  6:begin
     AStyle:=ssNumeric;
     aprefix:='$ ';
    end;
  end;
end;

procedure TDemo.RadioButton1Click(Sender: TObject);
begin
 radiobutton3.checked:=false;
 radiobutton2.checked:=false;
 radiobutton1.checked:=true;
end;

procedure TDemo.RadioButton3Click(Sender: TObject);
begin
 radiobutton2.checked:=false;
 radiobutton1.checked:=false;
 radiobutton3.checked:=true;
end;

procedure TDemo.RadioButton2Click(Sender: TObject);
begin
 radiobutton1.checked:=false;
 radiobutton3.checked:=false;
 radiobutton2.checked:=true;
end;

procedure TDemo.AdvStringGrid1PrintStart(Sender: TObject;
  NrOfPages: Integer; var FromPage, ToPage: Integer);
begin
 printdialog1.FromPage :=frompage;
 printdialog1.ToPage:= toPage;
 printdialog1.Maxpage:=toPage;
 printdialog1.minpage:=1;

 if printdialog1.execute then
  begin
   frompage:=printdialog1.FromPage;
   topage:=printdialog1.ToPage;
  end
 else
  begin
   frompage:=0;
   topage:=0;
  end;


end;

procedure TDemo.SavetoDOC1Click(Sender: TObject);
begin
 advstringgrid1.SavetoDOC('test.doc');
end;

procedure TDemo.Button1Click(Sender: TObject);
begin
 advstringgrid3.expandall;
end;

procedure TDemo.Button2Click(Sender: TObject);
begin
 advstringgrid3.contractall;
end;

procedure TDemo.RadioGroup2Click(Sender: TObject);
begin
 case radiogroup2.itemindex of
 0:advstringgrid3.cellnode.nodetype:=cnFlat;
 1:advstringgrid3.cellnode.nodetype:=cn3D;
 2:advstringgrid3.cellnode.nodetype:=cnGlyph;
 end;
end;

procedure TDemo.Exit1Click(Sender: TObject);
begin
self.Close;
end;

procedure TDemo.SavetoXML1Click(Sender: TObject);
var
 sl:tstringlist;
begin
 sl:=tstringlist.Create;
 sl.add('Nr');
 sl.add('Car');
 sl.add('Type');
 sl.add('Cylinders');
 sl.add('Intro');
 sl.add('Power');
 sl.add('Price');
 sl.add('Web');

 advstringgrid1.Savetoxml('test.xml','CARLIST','CAR',sl);
 sl.free;
end;

procedure TDemo.AdvStringGrid1IsFixedCell(Sender: TObject; Arow,
  Acol: Integer; var isfixed: Boolean);
begin
 isfixed:=colfix.checked and (acol=3);
end;

procedure TDemo.colfixClick(Sender: TObject);
begin
 colro.checked:=true;
 advstringgrid1.repaint;
end;

procedure TDemo.AdvStringGrid1CanSort(Sender: TObject; aCol: Integer;
  var dosort: Boolean);
begin
 dosort:=not ((acol=3) and colfix.checked);
end;

procedure TDemo.Printpreviewwithgraphics1Click(Sender: TObject);
begin
 advstringgrid2.previewpage:=1;

 pagepreview:=tpagepreview.create(self,advstringgrid2);
 try
  pagepreview.showmodal;
 finally
  pagepreview.free;
 end;

end;

procedure TDemo.Printwithgraphics1Click(Sender: TObject);
begin
 advstringgrid2.printerdriverfix:=true;
 advstringgrid2.print;
end;

end.