ufldemodata.pas

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

    9:  Result:= RepFishFacts;
   10:  Result:= RepEvents;
   11:  Result:= RepCustom;
   12:  Result:= RepSideBySide;
   13:  Result:= RepMemory;
    else Raise Exception.Create('Invalid tag');
  end; //Case
end;

procedure TDemoData.ItemsCalcFields(DataSet: TDataSet);
begin
  ItemsExtPrice.Value := ItemsQty.Value *
    ItemsSellPrice.Value * (100 - ItemsDiscount.Value) / 100;
  ItemsDiscountPc.Value:=ItemsDiscount.Value / 100;
end;

procedure TDemoData.EmpsCalcFields(DataSet: TDataSet);
begin
  EmpsFullName.Value := Format('%s, %s', [EmpsLastName.Value, EmpsFirstName.Value]);
end;

procedure TDemoData.CustCalcFields(DataSet: TDataSet);
begin
  CustTotAddr1.Value:= CustAddr1.Value+' '+ CustAddr2.Value;
  CustTotAddr2.Value:= CustCity.Value+' '+ CustState.Value + ' '+ CustZip.Value;
end;


{ Paradox graphic BLOB header }
type
  TGraphicHeader = record
    Count: Word;                { Fixed at 1 }
    HType: Word;                { Fixed at $0100 }
    Size: Longint;              { Size not including header }
  end;

procedure TDemoData.RepFishFactsGetCellValue(Sender: TObject;
  const FieldName: WideString; var FieldValue: Variant);

var
  Jp: TJPEGImage;
  Bmp: Graphics.TBitmap;
  Ms: TMemoryStream;
  s:string;
begin
  if FieldName='##FISH##Graphic##JPEG' then
  begin
    Jp:= TJPEGImage.Create;
    try
      Bmp:= TBitmap.Create;
      try
        Ms:= TMemoryStream.Create;
        try
          s:=FieldValue;
          Ms.Write(s[1+SizeOf(TGraphicHeader)], Length(s)-SizeOf(TGraphicHeader));
          Ms.Position:=0;
          Bmp.LoadFromStream(Ms);
          Jp.Assign(Bmp);
          Ms.Clear;
          Jp.SaveToStream(Ms);
          Ms.Position:=0;
          setLength(s, Ms.Size);
          Ms.Read(s[1],Ms.Size);
          FieldValue:=s;
        finally
          FreeAndNil(Ms);
        end; //finally
      finally
        FreeAndNil(Bmp);
      end; //finally
    finally
      FreeAndNil(Jp);
    end; //finally
  end;
end;

procedure TDemoData.RepEventsGetCellValue(Sender: TObject;
  const FieldName: WideString; var FieldValue: Variant);
var
  Jp: TJPEGImage;
  Bmp: Graphics.TBitmap;
  Ms: TMemoryStream;
  s:string;
begin
  if FieldName='##Events##Event_Photo##JPEG' then
  begin
    Jp:= TJPEGImage.Create;
    try
      Bmp:= TBitmap.Create;
      try
        Ms:= TMemoryStream.Create;
        try
          s:=FieldValue;
          Ms.Write(s[1+SizeOf(TGraphicHeader)], Length(s)-SizeOf(TGraphicHeader));
          Ms.Position:=0;
          Bmp.LoadFromStream(Ms);
          Jp.Assign(Bmp);
          Ms.Clear;
          Jp.SaveToStream(Ms);
          Ms.Position:=0;
          setLength(s, Ms.Size);
          Ms.Read(s[1],Ms.Size);
          FieldValue:=s;
        finally
          FreeAndNil(Ms);
        end; //finally
      finally
        FreeAndNil(Bmp);
      end; //finally
    finally
      FreeAndNil(Jp);
    end; //finally
  end;
end;

function TDemoData.GetAvailability: variant;
var
  w:Widestring;
  wc: word;
begin
  if (EventsEventNo.Value=2) or (EventsEventNo.Value=4) then
    begin
      //There should be a better way to create a widestring... but this works
      setLength(w,6);
      wc:=$FB46;move(wc,w[1],2);
      wc:=64335; move(wc,w[2],2);
      wc:=65209; move(wc,w[3],2);
      wc:=65272; move(wc,w[4],2);
      wc:=65153; move(wc,w[5],2);
      wc:=65179; move(wc,w[6],2);
      w:='This is some no-no-sense unicode: '+w;
    end else w:='';
  result:=w;
end;

function TDemoData.GetCurrentDate: variant;
begin
  Result:= double(Now); //Dates should be passed as numbers, and the corresponding cell in excel have Date format.
end;

function TDemoData.GetCurrentSQL: variant;
begin
  Result:=''; //Not implemented here, see DbDump.exe for an implementation
end;

function TDemoData.GetDsName: variant;
begin
  Result:='DBDEMOS';
end;

procedure TDemoData.RepMemoryAfterGenerateWorkbook(Sender: TObject;
  const ExcelApp: TExcelFile);
var
  Wb: TExcelWorkbook;
  i: integer; v:variant ;
begin
  if Protect and ((Sender as TCustomFlexCelReport).Adapter is TOLEAdapter) then
  begin
    Wb:=(ExcelApp as TOleFile ).ExcelWorkbook;
    Wb.Protect('pass',EmptyParam, EmptyParam);
    for i:=1 to Wb.Sheets.Count do
    begin
      //we could use (Wb.Sheets[i] as WorkSheet).Protect('pass', EmptyParam, EmptyParam, EmptyParam, EmptyParam, (ExcelApp as TOleFile ).LCID);
      //if there were no charts
      v:=Wb.Sheets[i];v.Protect('pass');
    end;
  end;
  if AutoPrint then
    if ((Sender as TCustomFlexCelReport).Adapter is TOLEAdapter) then
    begin
      Wb:=(ExcelApp as TOleFile ).ExcelWorkbook;
      Wb.PrintOut;
    end else
    begin
      ShellExecute( 0,'print', PCHAR((Sender as TCustomFlexCelReport).FileName), NIL,NIL, SW_SHOW);
    end;

end;

function TDemoData.GetMyImage: variant;
begin
  Result:=LoadImageAsJPEG(MyImageFilename);
end;

function TDemoData.LoadImageAsJPEG(const FileName: string): string;
var
  Fs: TFileStream;
  Pic: TPicture;
  Jp: TJPEGImage;
  Ms: TMemoryStream;
  s: string;
begin
  if Uppercase(ExtractFileExt(Filename))<>'.JPG' then
  begin //We have to convert it to a JPEG
    Pic:=TPicture.Create;
    try
      Jp:= TJPEGImage.Create;
      try
        Pic.LoadFromFile(Filename);
        Jp.Assign(Pic.Graphic);
        Ms:= TMemoryStream.Create;
        try
          Jp.SaveToStream(Ms);
          Ms.Position:=0;
          setLength(s, Ms.Size);
          Ms.Read(s[1],Ms.Size);
          Result:=s;
        finally
          FreeAndNil(Ms);
        end; //finally
      finally
        FreeAndNil(Jp);
      end; //finally
    finally
      FreeAndNil(Pic);
    end; //finally
  end else //File is already JPEG, we dont need to convert it
  begin
    Fs:= TFileStream.Create(Filename, fmOpenRead);
    try
      SetLength(s, Fs.Size);
      Fs.Read(s[1], Length(s));
      Result:=s;
    finally
      FreeAndNil(Fs);
    end; //finally
  end;
end;

procedure TDemoData.RepChartsAfterGenerateWorkbook(Sender: TObject;
  const ExcelApp: TExcelFile);
var
  Wb: TExcelWorkbook;
  Ws: variant;
  v,v2:variant ;
  i:integer;
  LCID: integer;
begin
  if ((Sender as TCustomFlexCelReport).Adapter is TOLEAdapter) then
  begin
    Wb:=(ExcelApp as TOleFile ).ExcelWorkbook;
      LCID:=(ExcelApp as TOleFile ).LCID;
      Wb.Charts.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam, LCID);

      wb.ActiveChart.ChartType := xl3DColumnStacked100;
      v:=Wb.Sheets['Hoja1'];
      v:=v.Range['ChartData'];
      v2:=wb.ActiveChart;
      v2.SetSourceData(v, xlRows);
      wb.ActiveChart.Location(xlLocationAsObject,'Hoja1');
      v:=wb.ActiveChart;
      v.HasTitle := False;
      v.Axes(xlCategory).HasTitle := False;
      v.Axes(xlSeries).HasTitle := False;
      v.Axes(xlValue).HasTitle := False;
      Ws:=(ExcelApp as TOleFile ).ExcelApplication.ActiveSheet ;
      i:=Ws.ChartObjects.Count;
      Ws.ChartObjects(i).Left:=400;
      Ws.ChartObjects(i).Top:=200;
   end;
end;

procedure TDemoData.FillMemTable(const aStg: TStringGrid);
var
  R:ArrayOfVariant;
  i: integer;
begin
  Birthday.Clear;
  SetLength(R,4);
  for i:=1 to aStg.RowCount-1 do
    if aStg.Cells[1,i]<>'' then
    begin
      R[0]:=StrtoInt(aStg.Cells[0,i]);
      R[1]:=aStg.Cells[1,i];
      R[2]:=StrToDate(aStg.Cells[2,i]);
      R[3]:=aStg.Cells[3,i];
      Birthday.AddRecord(R);
    end;
  BirthSex.Clear;
  BirthSex.AddRecord(['M']);
  BirthSex.AddRecord(['F']);

  //Setup for virtual table
  GridMem:=aStg;

end;

procedure TDemoData.VBirthdayGetData(Sender: TObject;
  const FieldName: String; const RecordPos: Integer; var Value: Variant);
begin
  if FieldName='Number' then Value:=StrToInt(GridMem.Cells[0,RecordPos+1]) else
  if FieldName='Name' then Value:=GridMem.Cells[1,RecordPos+1] else
  if FieldName='Birthday Date' then Value:=StrToDate(GridMem.Cells[2,RecordPos+1]) else
  if FieldName='Sex' then Value:=GridMem.Cells[3,RecordPos+1];

end;

procedure TDemoData.VBirthdayVirtualRecordCount(Sender: TObject;
  var RecordCount: Integer);
begin
  RecordCount:=GridMem.RowCount-1;
end;

procedure TDemoData.ChangeFastCount(const Value: boolean);
var
  i: integer;
begin
  for i:=0 to ComponentCount-1 do
  begin
    if (Components[i] is TFlexCelReport) then
      if Value then (Components[i] as TFlexCelReport).CalcRecordCount:=cr_None else
        (Components[i] as TFlexCelReport).CalcRecordCount:=cr_SlowCount; 
  end;
end;

end.