ufldemo.pas

Delphi/BCB 各种版本都支持的Excel 读写控件.一成功应用在N个项目中 .

  Fi.AddPicture(DemoData.LoadImageAsJPEG(ExePath+'flexcel.bmp'),xli_Jpeg ,PicProps);
  Fi.DeletePicture(4);
  Fi.ClearPicture(1); //clear second pic
  inc(PicProps.Row1,3); inc(PicProps.Row2,3);inc(PicProps.Col1);inc(PicProps.Col2);
  Fi.AddPicture(DemoData.LoadImageAsJPEG(ExePath+'flexcel.bmp'),xli_Jpeg ,PicProps);
  inc(PicProps.Row1,3); inc(PicProps.Row2,3);inc(PicProps.Col1);inc(PicProps.Col2);
  Fi.AddPicture('',xli_Jpeg ,PicProps);

  Fi.AssignPicture(2,'',xli_Jpeg);

  Fi.AddPicture(DemoData.LoadImageAsJPEG(ExePath+'flexcel.bmp'),xli_JPeg,20,2, 0, 0, 150,80, at_MoveAndDontResize);
  Fi.AddPicture(DemoData.LoadImageAsJPEG(ExePath+'flexcel.bmp'),xli_JPeg,20,2, 5, 5, 150,80, at_DontMoveAndDontResize);
  Fi.AddPicture(DemoData.LoadImageAsJPEG(ExePath+'flexcel.bmp'),xli_JPeg,20,2, 45, 45, 150,80, at_MoveAndResize);
end;

procedure TMain.DoCreateFile(const Automatic: boolean);
var
  Fi: TFlexCelImport;
  F: TFlxFormat;
  FName: string;
  w: widestring;
  St: TFileStream;
  Fmt: array of integer;
  ExePath: string;
  i: integer;
begin
  if BtnUseNative.Down then
    DemoData.SetAdapter(DemoData.XLSAdapter) else
    DemoData.SetAdapter(DemoData.OLEAdapter);

  if Automatic then
    FName:=Directory+'\TestImport'+IntToStr(Tabs.ActivePage.Tag)+'.xls'
  else
  begin
    if not DemoData.XlsSaveDialog.Execute then exit;
    FName:=DemoData.XlsSaveDialog.FileName;
  end;

  if FileExists(FName) then DeleteFile(FName);

  Fi:=DemoData.FlexCelImport;
  ExePath:=ExtractFilePath(ParamStr(0))+'\';

  //We could also use Fi.NewFile here. But we are testing OpenFile, and also we use NewFile.xls to store some cell formats
  Fi.OpenFile(ExePath+'Templates\NewFile.xls');


  Fi.CellValue[6,1]:=integer(Fi.ColorPalette[3]);
  Fi.ColorPalette[3]:=Rgb(0,200,20);
  Fi.CellValue[6,2]:=integer(Fi.ColorPalette[3]);

  Fi.CellValue[3,3]:=5;
  Fi.CellFormat[2,2]:=Fi.CellFormat[1,1];
  Fi.CellValue[2,1]:='Test';
  Fi.CellValue[3,1]:='T閟t';
  w:=WideChar($266b);
  Fi.CellValue[4,1]:=w;

  Fi.RowHeight[3]:=1000;
  Fi.ColumnWidth[4]:=2000;
  Fi.RowHeight[4]:=4000;
  Fi.CellValue[1,3]:=Fi.RowHeight[4];
  Fi.AutoRowHeight[4]:=true;
  Fi.CellValue[1,4]:=Fi.RowHeight[4];

  Fi.ActiveSheet:=2;
  Fi.CellValue[1,1]:=Fi.RowFormat[6];
  Fi.CellValue[1,2]:=Fi.ColumnFormat[2];
  Fi.CellValue[6,1]:='Testing';
  //Fi.CellValue[6,2]:='Testing';
  Fi.CellValue[6,3]:='Testing';
  Fi.RowFormat[6]:=Fi.FormatListCount-1;
  Fi.ColumnFormat[2]:=Fi.FormatListCount-2;
  Fi.CellValue[2,1]:=Fi.RowFormat[6];
  Fi.CellValue[2,2]:=Fi.ColumnFormat[2];
  Fi.CellValue[6,4]:='Testing';

  //Add some user formats
  SetLength(Fmt, 2);
  F:=Fi.DefaultFormat;
  F.Font.Name:='Courier New';
  F.Format:='0.00';
  F.Rotation:=45;
  F.FillPattern.FgColorIndex:=13;
  Fmt[0]:=Fi.AddFormat(F);

  F:=Fi.DefaultFormat;
  F.Font.Name:='Times New Roman';
  F.Borders.Left.Style:=fbs_Medium_dashed;
  F.Borders.Left.ColorIndex:=4;
  F.FillPattern.FgColorIndex:=11;
  F.FillPattern.BgColorIndex:=0;
  F.FillPattern.Pattern:= 5;
  Fmt[1]:=Fi.AddFormat(F);

  Fi.CellValue[10,1]:=4;
  Fi.CellFormat[10,1]:=Fmt[0];
  Fi.CellValue[10,2]:='Custom Format';
  Fi.CellFormat[10,2]:=Fmt[1];

  //TestFormulas
  Fi.CellValue[15,20]:='This cell should be deleted by a formula';
  Fi.CellValue[16,20]:=0;
  Fi.Cellformat[17,20]:=Fmt[0];
  Fi.CellFormula[15,20]:='=Now()';
  Fi.CellFormula[15,20]:='=Now()+1';
  Fi.CellFormula[16,20]:='=1/2+(A2)*3^-1% & "a""b"';
  Fi.CellFormula[17,20]:='=Indirect(b5)+sum(sum(a$1:a$3),7,6,3.2)';
  Fi.CellFormula[18,1]:='=-1^2';
  Fi.CellFormula[19,1]:='=-if(true, if( false, 5, 2.2), 7)';
  Fi.CellFormula[20,1]:='=-$IV65536';

  Fi.CellFormula[22,1]:='=Indirect(b5)';
  Fi.CellFormula[23,1]:='=sum(sum(a$1:a$3),7,6,3.2)';
  Fi.CellFormula[24,1]:='=sum(a1:a2, 7,6,3.2)';
  Fi.CellFormula[25,1]:='=sum(b1:b2)/2';
  Fi.CellFormula[26,1]:='=sum($c$1)';
  Fi.CellFormula[27,1]:='=sum($c$1, d4, 47, COUNT(A1:A2,A6,3))+count(a1:a5, 5)';
  Fi.CellFormula[28,1]:='=Max(A1:A5,A6)+Average(a1:b7)-Min(a3)+Row(b7)-Column(b8)+Abs(a1)-Round(b2,2)';
  Fi.CellFormula[29,1]:='=vlookup("a",F3:H18,A22, false)';
  Fi.CellFormula[30,1]:='=sin(pi())+Index(a1,1,1)';
  Fi.CellFormula[31,1]:='=Match(a1,a1:h1,h2)+Trunc(b3)';
  Fi.CellFormula[32,1]:='=hlookup(a1,F3:H18,A22)';
  Fi.CellFormula[33,1]:='=choose(a1,a2,a3,a4)';
  Fi.CellFormula[34,1]:='=cell("width",a1)';
//  Fi.CellFormula[35,1]:='=SUM(Hoja1:Hoja3!E5)';

  Fi.CellValue[5,2]:='A1';
  for i:= 15 to 35 do Fi.CellValue[i,2]:=Fi.CellFormula[i,1];

  //Test insert sheet
  Fi.InsertEmptySheets(3,2);


  //Test Images
  Fi.ActiveSheet:=3;
  TestImages(Fi);
  for i:= Fi.PicturesCount-1 downto 0 do
    Fi.DeletePicture(i);    //Kind of silly... but good for testing
  Fi.ActiveSheet:=3;
  TestImages(Fi);
  Fi.ActiveSheet:=2;
  TestImages(Fi);
  Fi.ActiveSheet:=1;
  TestImages(Fi);

  //Test Merged Cells
  Fi.ActiveSheet:=3;
  Fi.MergeCells(1,1,3,5);
  Fi.MergeCells(-1,2,2,2); //an invalid one
  Fi.MergeCells(5,5,5,6); //horizontal
  Fi.MergeCells(6,6,7,6); //Vertical

  Fi.MergeCells(10,10,13,12);
  Fi.MergeCells(13,12,15,16); //expand an existing range

  Fi.MergeCells(20,1,20,3);
  Fi.MergeCells(22,1,22,3);
  Fi.MergeCells(19,3,23,3); //Merge multiple existing ranges.

  Fi.MergeCells(35,2,38,2);
  Fi.MergeCells(37,4,42,4);
  Fi.MergeCells(42,2,45,3);
  Fi.MergeCells(45,4,45,11);
  Fi.MergeCells(35,2,35,4);  //Cascading...

  //Test Zoom
  Fi.SheetZoom:=75;
  Fi.SheetZoom:=79; //this one modifies an existing one

  //Test Comments
  w:=widechar($FEEB);
  w:=w+widechar($FEEB);
  Fi.SetCellComment(2,7,w);
  Fi.SetCellComment(3,7,'Regards');
  Fi.SetCellComment(1,1,'Test comment');
  Fi.SetCellComment(65536,256,'This is a last-cell comment!');


  Fi.Save(FName);
  Fi.CloseFile;
  //Just to test I can read what I wrote...
  Fi.OpenFile(FName);

  St:=TFileStream.Create(FName, fmCreate);
  try
    Fi.SaveToStream(St);
  finally
    FreeAndNil(St);
  end;
  Fi.CloseFile;

  //Just to test I can read what I wrote... again
  Fi.OpenFile(FName);
  Fi.CloseFile;


end;


procedure TMain.ActionReportUpdate(Sender: TObject);
begin
  ActionReport.Enabled:= Tabs.ActivePage.Tag>0;
  if Tabs.ActivePage.Tag<>100 then
  begin
    ActionReport.ImageIndex:= 13;
    ActionReport.Caption:='Report !';
  end else
  begin
    ActionReport.ImageIndex:= 0;
    ActionReport.Caption:='Import !';
  end;
end;

procedure TMain.ActionUseOleExecute(Sender: TObject);
begin
 //
end;

procedure TMain.ActionHtmlUpdate(Sender: TObject);
begin
  ActionUseNative.Checked:=  BtnUseNative.Down;
  ActionUseOle.Checked:=  BtnUseOle.Down and (Tabs.ActivePage.Tag<100);
  ActionProtect.Enabled:=ActionUseOle.Checked and (Tabs.ActivePage.Tag<100);
  ActionUseTStore.Enabled:=ActionUseNative.Checked and (Tabs.ActivePage.Tag<100);
  ActionAutoPrint.Enabled:=(Tabs.ActivePage.Tag<100);
  ActionFastCount.Enabled:=(Tabs.ActivePage.Tag>0)and(Tabs.ActivePage.Tag<100);

  {$IfDef Excel97}
  ActionHTML.Enabled:=false;
  {$Else}
  ActionHtml.Enabled:=ActionUseOle.Checked and (Tabs.ActivePage.Tag<100);
  {$Endif}

end;

procedure TMain.ActionViewTemplateExcelUpdate(Sender: TObject);
begin
  ActionViewTemplateExcel.Enabled:=ActionReport.Enabled and (Tabs.ActivePage.Tag<100);
  ActionViewTemplateInternal.Enabled:=ActionViewTemplateExcel.Enabled;
end;

procedure TMain.ActionUseTStoreExecute(Sender: TObject);
begin
  if DemoData.XlsTemplateStore.Templates.Count=0 then
  begin
    showmessage('For size considerations in the zipped file, this demo has the template store empty. If you want to use it, edit the unit UFLDemoData, double click the store, and add all the files from the folder "Templates"');
    BtnUseTStore.Down:=false;
    exit;
  end;


  if BtnUseTStore.Down then
   DemoData.XLSAdapter.TemplateStore:=DemoData.XlsTemplateStore
  else DemoData.XLSAdapter.TemplateStore:=nil;
end;

procedure TMain.ActionUseNativeExecute(Sender: TObject);
begin
  //
end;

procedure TMain.ActionViewTemplateExcelExecute(Sender: TObject);
var
  WaitCursor: IWaitCursor;
begin
  WaitCursor:=TWaitCursor.Create;
  BtnViewTemplate.Action:=ActionViewTemplateExcel;
  ShellExecute( Handle,'open', PCHAR(ExtractFilePath(Paramstr(0))+DemoData.GetReport(Tabs.ActivePage.Tag).Template), NIL,NIL, SW_SHOW);
end;

procedure TMain.ActionViewTemplateInternalExecute(Sender: TObject);
var
  WaitCursor: IWaitCursor;
begin
  WaitCursor:=TWaitCursor.Create;
  BtnViewTemplate.Action:=ActionViewTemplateInternal;
  InvokeExcelEditor( DemoData.GetReport(Tabs.ActivePage.Tag));
end;

procedure TMain.ActionReportExecute(Sender: TObject);
var
  WaitCursor: IWaitCursor;
begin
  WaitCursor:=TWaitCursor.Create;
  if Tabs.ActivePage.Tag<100 then DoReport(false, false) else
  if Tabs.ActivePage.Tag=100 then DoImport else DoCreateFile(false);
end;

procedure TMain.ActionPreviewUpdate(Sender: TObject);
begin
  ActionPreview.Enabled:= ActionViewTemplateExcel.Enabled and
     (not BtnUseOle.Down  or BtnHTML.Down);
end;

procedure TMain.ActionPreviewExecute(Sender: TObject);
var
  WaitCursor: IWaitCursor;
begin
  WaitCursor:=TWaitCursor.Create;
  DoReport(true, false);
end;

procedure TMain.btnOpenMyImageClick(Sender: TObject);
begin
  if not DemoData.OpenPictureDialog.Execute then exit;
  edMyImage.Text:= DemoData.OpenPictureDialog.FileName;
end;


procedure TMain.ActionAutoPrintExecute(Sender: TObject);
var
  WaitCursor:IWaitCursor;
begin
  if MessageDlg('This will print the report into a printer!'#10'Make sure you have a printer connected before you try'#10#10'Also, if in NATIVE mode, do not print reports with formulas'#10#10'緾ONTINUE?',
                mtWarning,[mbYes, mbNo], 0)<> mrYes then exit;

  WaitCursor:=TWaitCursor.Create;
  DemoData.AutoPrint:=true;
  try
    if Tabs.ActivePage.Tag<100 then DoReport(false, false);
  finally
    DemoData.AutoPrint:=false;
  end; //finally
end;

procedure TMain.ActionTestAllExecute(Sender: TObject);
var
  WaitCursor:IWaitCursor;
  i: integer;
begin
  if MessageDlg('This is a test I use to check the suite for memory leaks and more'#10'It will run all the reports and can take some time to complete'#10#10'緾ONTINUE?',
                mtWarning,[mbYes, mbNo], 0)<> mrYes then exit;

  WaitCursor:=TWaitCursor.Create;

  Directory:='';
  if not SelectDirectory('Select the folder to store the reports','', Directory) then exit;

  ListDemos.FullCollapse;
  for i:=0 to Tabs.PageCount-1 do
    if (Tabs.Pages[i].Tag>0)and (Tabs.Pages[i].Tag<>100) then
    begin
      Tabs.ActivePageIndex:=i;
      Application.ProcessMessages;
      if Tabs.Pages[i].Tag<100 then DoReport(false, true) else DoCreateFile(true);
    end;

  ListDemos.FullExpand;
  ListDemos.Selected:=ListDemos.Items[1];
  ListDemos.Selected:=ListDemos.Items[0];
end;


procedure TMain.ActionFastCountExecute(Sender: TObject);
begin
  ActionFastCount.Checked:=not ActionFastCount.Checked;
  DemoData.ChangeFastCount(ActionFastCount.Checked);
end;

procedure TMain.ActionReportToStreamUpdate(Sender: TObject);
begin
  ActionReportToStream.Enabled:= (Tabs.ActivePage.Tag>0)and(Tabs.ActivePage.Tag<100) and BtnUseNative.Down;
end;

procedure TMain.ActionReportToStreamExecute(Sender: TObject);
var
  WaitCursor: IWaitCursor;
  Rep: TCustomFlexCelReport;
begin
  if not ((Tabs.ActivePage.Tag>0)and(Tabs.ActivePage.Tag<100) and BtnUseNative.Down) then exit;
  WaitCursor:=TWaitCursor.Create;
  //Save the report to a file stream.
  //this is not useful on itself, but shows how to send the results to a generic stream.

  //There are 2 ways to do it:
  //1) assign the "GetOutStream" event
      // We will use this way here to show how it is done, as it is more complicated.
      // Normally you will want to use 2) just call savetostream instead of run.

      Rep:=DemoData.GetReport(Tabs.ActivePage.Tag);
      Rep.OnGetOutStream:=RepSimpleDemoGetOutStream;
      try
        DoReport(false, false, true);
      finally
        Rep.OnGetOutStream:=nil;
      end;

  //2) just call Rep.SaveToStream(DataStream);
      // this is the easiest approach, so we don't show it here.
end;


procedure TMain.RepSimpleDemoGetOutStream(Sender: TObject;
  const FileFormat: Integer; var OutStream: TStream);
begin
  OutStream:= DataStream;
end;

end.