froleexl.pas

不错的报表工具

  CurrentPage := 0;
  CurY := 0;
  FirstPage := true;
  ClearLastPage;
  CY := 0;
  lastY := 0;
  CntPics := 0;
end;

procedure TfrOLEExcelExport.OnBeginPage;
begin
  Inc(CurrentPage);
end;

procedure TfrOLEExcelExport.OnData(x, y: Integer; View: TfrView);
var
    MemoView : TfrMemoView;
    PicView : TfrPictureView;
    ind, maxy, j, k, dy : integer;
    delta : Extended;
    bit : TBitmap;
begin
  ind := 0;
  if (pgList.Find(IntToStr(CurrentPage),ind)) or (pgList.Count = 0) then
  begin
      if View is TfrMemoView then
      begin
        if (TfrMemoView(View).Memo.Count > 0) or (TfrMemoView(View).FrameTyp > 0) then
        begin
          MemoView := TfrMemoView.Create;
          MemoView.Assign(View);
          MemoView.y := MemoView.y + CY;
          PageObj.Add(MemoView);
        end;
      end
      else
      begin
          PicView := TfrPictureView.Create;
          PicView.x := View.x;
          PicView.y := View.y;
          PicView.dx := View.dx;
          PicView.dy := View.dy;
          bit := TBitmap.Create;
          bit.Height := View.dy+1;
          bit.Width := View.dx+1;
          View.x := 0;
          View.y := 0;
          View.Draw(bit.Canvas);
          View.x := PicView.x;
          View.y := PicView.y;
          PicView.Picture.Bitmap.Assign(bit);
          bit.Destroy;
          PicView.y := PicView.y + CY;
          PageObj.Add(PicView);
      end;
      ObjCellAdd(RX, View.x);
      ObjCellAdd(RX, View.x + View.dx);
      ObjCellAdd(RY, View.y + CY);
      ObjCellAdd(RY, View.y + View.dy + CY);

      // Excel capability code
      if (View.y + CY) > lastY then
      begin
        delta := expScaleY * (View.y + CY - LastY) / Ydivider;
        if delta > XLMaxHeight then
        begin
          k := Trunc (delta / XLMaxHeight);
          dy :=  Trunc (XLMaxHeight * Ydivider / expScaleY);
          for j := 1 to k do
            ObjCellAdd(RY, LastY + dy * k);
        end;
      end;

      maxy := View.y + View.dy + CY;
      if maxy > LastY then
        LastY := maxy;
  end;
end;

procedure TfrOLEExcelExport.OnEndPage;
var
    ind: integer;
begin
  CY := LastY;
  ind := 0;
  if (pgList.Find(IntToStr(CurrentPage),ind)) or (pgList.Count = 0) then
    pgBreakList.Add(IntToStr(LastY));
end;

procedure TfrOLEExcelExport.OnEndDoc;
begin
//
end;

procedure TfrOLEExcelExport.AfterExport(const FileName: string);
begin
  RX.Sort(@ComparePoints);
  RY.Sort(@ComparePoints);
  DeleteMultiplePoint(RX);
  DeleteMultiplePoint(RY);
  PageObj.Sort(@CompareObjects);
  OrderObjectByCells;

  frProgressForm.Show;
  frProgressForm.Label1.Caption := frLoadStr(frRes + 1843);
  frProgressForm.Refresh;

  ExportPage;

  Excel.SetRange(1, 1, 1, 1);
  Excel.Range.Select;

  frProgressForm.Close;
  if expOpenAfter then
    Excel.Visible := true;
  try
   DeleteFile(FileName);
{$IFDEF Delphi3}
   Excel.WorkBook.SaveAs(FileName,xlNormal);
{$ELSE}
   Excel.WorkBook.SaveAs(FileName,xlNormal, EmptyParam,
     EmptyParam, EmptyParam, EmptyParam, xlNoChange, EmptyParam, EmptyParam, EmptyParam);
{$ENDIF}
  except
  end;
end;

///////////////////////////////////////////////////////////
constructor TFrExcel.Create (AOwner : TComponent);
begin
  inherited Create(AOwner);
  IsOpened := false;
  IsVisible := false;
end;

destructor TFrExcel.Destroy;
begin
  if IsOpened then
   try
    Excel.Quit;
   except
   end;
  Excel := Unassigned;
  inherited Destroy;
end;

function TfrExcel.Pos2Str(Pos: Integer): String;
var
  i, j: integer;
begin
    if Pos > 26 then
    begin
      i := Pos mod 26; j := Pos div 26;
      if i = 0 then Result := Chr(64 + j - 1)
        else Result := Chr(64 + j);
      if i = 0 then Result := Result + chr(90)
        else result := Result + Chr(64 + i);
    end
    else Result := Chr(64 + Pos);
end;

procedure TFrExcel.SetVisible(DoShow: Boolean);
begin
  if not IsOpened then exit;
  if DoShow then
  begin
    Excel.Application.Interactive := true;
    Excel.Application.ScreenUpdating := true;
    Excel.Application.DisplayAlerts := true;
    Excel.Visible := True
  end
  else
    Excel.Visible := false;
end;

function TFrExcel.IntToCoord(X, Y: Integer): string;
begin
  Result := Pos2Str(X) + IntToStr(Y);
end;

function TFrExcel.GetCell(x, y: Integer): string;
begin
  result := WorkSheet.Cells[y, x];
end;

procedure TFrExcel.SetCell(x, y: Integer; const Value: string);
var
  Cell: Variant;
begin
  Cell := WorkSheet.Cells[y, x];
  Cell.Value := Value;
end;

procedure TFrExcel.SetColSize(x: Integer; Size: Extended);
var
  r: variant;
begin
  r := WorkSheet.Columns;
  r.Columns[x].ColumnWidth := Size;
end;

procedure TFrExcel.SetRowSize(y: Integer; Size: Extended);
var
  r: variant;
begin
  r := WorkSheet.Rows;
  if size > 409 then size := 409;
  r.Rows[y].RowHeight := Size;
end;

procedure TFrExcel.MergeCells;
begin
  Range.MergeCells := true;
end;

procedure TFrExcel.OpenExcel;
begin
    try
      Excel := CreateOLEObject('Excel.Application'); //GetActiveOLEObject('Excel.Application')
      Excel.Application.EnableEvents := false;
      Excel.Application.EnableAutoComplete := false;
      Excel.Application.EnableAnimations := false;
      Excel.Application.ScreenUpdating := false;
      Excel.Application.Interactive := False;
      Excel.Application.DisplayAlerts := False;
      WorkBook := Excel.WorkBooks.Add;
      WorkSheet := WorkBook.WorkSheets[1];
      WorkSheet.Cells.WrapText := true;
      IsOpened := True;
    except
      IsOpened := false;
    end;
end;

function TFrExcel.IsOpen: Boolean;
begin
  result := IsOpened;
end;

procedure TFrExcel.SetPageMargin(Left, Right, Top, Bottom: Extended; Orient : Integer);
begin
    try
      Excel.ActiveSheet.PageSetup.LeftMargin := Left;
      Excel.ActiveSheet.PageSetup.RightMargin := Right;
      Excel.ActiveSheet.PageSetup.TopMargin := Top;
      Excel.ActiveSheet.PageSetup.BottomMargin := Bottom;
      Worksheet.PageSetup.Orientation := Orient;
    except
    end;
end;

procedure TFrExcel.SetCellFontName(FontName: string);
begin
  if length(FontName) > 0 then
    Range.Cells.Font.Name := FontName;
end;

procedure TFrExcel.SetCellFontSize(FontSize: integer);
begin
  Range.Cells.Font.Size := FontSize;
end;

procedure TFrExcel.SetCellFontColor(FontColor: integer);
begin
  Range.Cells.Font.Color:= FontColor;
end;

procedure TFrExcel.SetCellFontStyle(Style: TFontStyles);
begin
  Range.Cells.Font.Bold := fsBold in Style;
  Range.Cells.Font.Italic := fsItalic in Style;
  Range.Cells.Font.Underline := fsUnderline in Style;;
end;

procedure TFrExcel.SetCellVAlign(Vert: Integer);
begin
  Range.Select;
  Excel.Selection.Rows.VerticalAlignment := Vert;
end;

procedure TFrExcel.SetCellHAlign(Horiz: Integer);
begin
  Range.Select;
  Excel.Selection.Columns.HorizontalAlignment := Horiz;
end;

procedure TFrExcel.SetCellOrientation(Grad: Integer);
begin
  Range.Cells.Orientation := Grad;
end;

procedure TFrExcel.SetRange(x, y, dx, dy: Integer);
begin
 if (dx > 0) and (dy > 0) then
  Range := WorkSheet.Range[IntToCoord(x, y), IntToCoord(x + dx - 1, y + dy - 1)];
end;

procedure TfrExcel.SetCellFrame(Frame: integer);
begin
  if (Frame and frftLeft) <> 0 then
     Range.Cells.Borders.Item[xlEdgeLeft].Linestyle := xlSolid;
  if (Frame and frftRight) <> 0 then
     Range.Cells.Borders.Item[xlEdgeRight].Linestyle := xlSolid;
  if (Frame and frftTop) <> 0 then
     Range.Borders.Item[xlEdgeTop].Linestyle := xlSolid;
  if (Frame and frftBottom) <> 0 then
     Range.Borders.Item[xlEdgeBottom].Linestyle := xlSolid;
end;

procedure TfrExcel.SetCellFrameInsideH;
begin
  Range.Cells.Borders.Item[xlInsideVertical].Linestyle := xlSolid;
end;
procedure TfrExcel.SetCellFrameInsideV;
begin
  Range.Cells.Borders.Item[xlInsideHorizontal].Linestyle := xlSolid;
end;

procedure TfrExcel.SetCellFillColor(Color: integer);
begin
   Range.Interior.Color := Color;
end;

procedure TfrExcel.SendArrayValue(Arr: variant);
begin
    Range.Value:=Arr;
end;

//////////////////////////////////////////////

procedure TfrOLEExcelSet.Localize;
begin
  Ok.Caption := frLoadStr(SOk);
  Cancel.Caption := frLoadStr(SCancel);
  GroupPageRange.Caption := frLoadStr(frRes + 44);
  Pages.Caption := frLoadStr(frRes + 47);
  Descr.Caption := frLoadStr(frRes + 48);
  Caption := frLoadStr(frRes + 1844);
  GroupPageSettings.Caption := frLoadStr(frRes + 1845);
  Topm.Caption := frLoadStr(frRes + 1846);
  Leftm.Caption := frLoadStr(frRes + 1847);
  ScX.Caption := frLoadStr(frRes + 1848);
  ScY.Caption := frLoadStr(frRes + 1849);
  GroupCellProp.Caption := frLoadStr(frRes + 1850);
  CB_Merged.Caption := frLoadStr(frRes + 1851);
  CB_Align.Caption := frLoadStr(frRes + 1852);
  CB_FillColor.Caption := frLoadStr(frRes + 1853);
  CB_Borders.Caption := frLoadStr(frRes + 1854);
  CB_WrapWords.Caption := frLoadStr(frRes + 1855);
  CB_FontName.Caption := frLoadStr(frRes + 1856);
  CB_FontSize.Caption := frLoadStr(frRes + 1857);
  CB_FontStyle.Caption := frLoadStr(frRes + 1858);
  CB_FontColor.Caption := frLoadStr(frRes + 1859);
  CB_PageBreaks.Caption := frLoadStr(frRes + 1860);
  Better.Caption := frLoadStr(frRes + 1861);
  Faster.Caption := frLoadStr(frRes + 1862);
  CB_Pictures.Caption := frLoadStr(frRes + 1863);
  CB_OpenExcel.Caption := frLoadStr(frRes + 1864);
end;

procedure TfrOLEExcelSet.BetterClick(Sender: TObject);
begin
   CB_Merged.Checked := true;
   CB_WrapWords.Checked := true;
   CB_FillColor.Checked := true;
   CB_Borders.Checked := true;
   CB_Align.Checked := true;
   CB_PageBreaks.Checked := true;
   CB_FontName.Checked := true;
   CB_FontSize.Checked := true;
   CB_FontStyle.Checked := true;
   CB_FontColor.Checked := true;
   CB_Pictures.Checked := true;
end;

procedure TfrOLEExcelSet.FasterClick(Sender: TObject);
begin
   CB_Merged.Checked := true;
   CB_WrapWords.Checked := true;
   CB_FillColor.Checked := false;
   CB_Borders.Checked := false;
   CB_Align.Checked := false;
   CB_PageBreaks.Checked := true;
   CB_FontName.Checked := false;
   CB_FontSize.Checked := false;
   CB_FontStyle.Checked := false;
   CB_FontColor.Checked := false;
   CB_Pictures.Checked := false;
end;

procedure TfrOLEExcelSet.FormCreate(Sender: TObject);
begin
   Localize;
end;

end.