advgridexcel.pas

来自「delphi 第三方控件很出色,表格制作的」· PAS 代码 · 共 1,506 行 · 第 1/4 页

          if CurrentGrid.IsRotated(cg, rg, AAngle) then
          begin
            if AAngle < 0 then AAngle := 360 - (Abs(AAngle) mod 360) else
              AAngle := AAngle mod 360;
            if (AAngle >= 0) and (AAngle <= 90) then Fm.Rotation := AAngle
            else if (AAngle >= 270) then Fm.Rotation := 360 - AAngle + 90;
          end;

          if FUseUnicode then
            w := SupressCR(CurrentGrid.WideCells[creal, rg])
          else
            w := SupressCR(CurrentGrid.SaveCell(creal, rg));

          Formula := SupressCR(CurrentGrid.SaveCell(creal, rg));

          if not Options.ExportHTMLTags then
          begin
            StringReplace(w,'<br>','#13#10',[rfReplaceAll, rfIgnoreCase]);
          end;

          if (pos(#10, w) > 0) or (CurrentGrid.WordWrap and Options.ExportWordWrapped) then
            Fm.WrapText := true;

          if (pos('</',w) > 0) and not Options.ExportHTMLTags then
            w := HTMLStrip(w);

          //Cell Align
          case HA of
            taLeftJustify: Fm.HAlignment := fha_left;
            taCenter: Fm.HAlignment := fha_center;
            taRightJustify: Fm.HAlignment := fha_right;
          else Fm.HAlignment := fha_general;
          end; //case

          case VA of
            vtaTop: Fm.VAlignment := fva_top;
            vtaCenter: Fm.VAlignment := fva_center;
          else Fm.VAlignment := fva_bottom;
          end; //case

          if Assigned(OnCellFormat) then
            OnCellFormat(CurrentGrid, creal, rg, cx, rx, w, Fm);

          if FOptions.ExportCellFormats then
          begin
            aDateFormat := FDateFormat;
            aTimeFormat := FTimeFormat;
            if Assigned(OnDateTimeFormat) then
              OnDateTimeFormat(CurrentGrid, creal, rg, cx, rx, w, aDateFormat, aTimeFormat);

            if (pos('=',Formula) = 1) and FOptions.ExportFormulas then
            begin
              Workbook.CellFormula[rx,cx] := Formula;
            end
            else
            begin
              if Options.ExportCellProperties then
                Workbook.SetCellString(rx, cx, w, Fm, aDateFormat, aTimeFormat)
              else
              begin
                Fm := CellFormatDef(Workbook, rx, cx);
                Workbook.SetCellString(rx, cx, w, Fm, aDateFormat, aTimeFormat);
              end;
              CopyFmToMerged(Workbook, cp, rx, cx, Fm) ;
            end;
          end
          else
          begin
            if (pos('=',Formula) = 1) then
            begin
              Workbook.CellFormula[rx,cx] := Formula;
            end
            else
            begin
              Workbook.CellValue[rx, cx] := w;
              if Options.ExportCellProperties then
              begin
                Workbook.CellFormat[rx, cx] := Workbook.AddFormat(Fm);
              CopyFmToMerged(Workbook, cp, rx, cx, Fm) ;
              end;
            end;
          end;
        finally
          FreeAndNil(ABrush);
        end; //finally
      finally
        FreeAndNil(AFont);
      end; //finally

      //Export Images
      Pic := CurrentGrid.GetPicture(cg, rg);
      if Pic <> nil then
      begin
        ExportImage(Workbook, Pic, rx, cx, cg, rg);
      end;

    //Export Comments
      if CurrentGrid.IsComment(cg, rg, Comment) then
      begin
        Cr := Workbook.CellMergedBounds[rx, cx];
        CalcImgCells(Workbook, rx - 1, cx + Cr.Right - Cr.Left + 1, 8, 14, 75, 130, Properties);
        Workbook.SetCellComment(rx, cx, Comment, Properties);
      end;

      if Assigned(FOnProgress) then
        FOnProgress(Self, FWorksheet, FWorkSheetNum, rg - GridStartRow, CurrentGrid.RowCount - 1 - GridStartRow);

    end;


    //Export Nodes
    if Options.ExportCellProperties then
      if (CurrentGrid.GetNodeLevel(rg)>=0) and (CurrentGrid.GetNodeLevel(rg)<=7) then
        Workbook.SetRowOutlineLevel(rx+1, rx+CurrentGrid.GetNodeSpan(rg)-1, CurrentGrid.GetNodeLevel(rg));

  end;
  
  if Options.ExportHiddenColumns then
    CurrentGrid.ColCount := CurrentGrid.ColCount - HiddenCount;

  CurrentGrid.ExportNotification(esExportDone,-1);
end;

function TAdvGridExcelIO.FindSheet(const Workbook: TExcelFile; const SheetName: widestring; var index: integer): boolean;
var
  i: integer;
begin
  Result := False;
  for i := 1 to Workbook.SheetCount do
  begin
    Workbook.ActiveSheet := i;
    if (Workbook.ActiveSheetName = SheetName) then
    begin
      Result := True;
      Index := i;
      Exit;
    end;
  end;
end;

procedure TAdvGridExcelIO.XLSExport(const FileName: TFileName; const SheetName: widestring = ''; const SheetPos: integer = -1; const SelectSheet: integer = 1);
var
  Workbook: TExcelFile;
  UseWorkbook: boolean;
  Sp, i: integer;
begin
  if CurrentGrid = nil then
    raise Exception.Create(ErrNoAdvStrGrid);


  case Options.ExportOverwrite of
  omAlways:
    begin
      if FileExists(FileName) then
        DeleteFile(FileName);
    end;
  omWarn:
    begin
      if FileExists(FileName) then
      begin
        if MessageDlg(Format(Options.ExportOverwriteMessage,[FileName]),mtCOnfirmation,[mbYes,mbNo],0) = mrYes then
          DeleteFile(FileName)
        else
          Exit;
      end;
    end;
  end;

  UseWorkbook := (FAdvGridWorkbook <> nil) and (SheetName = '') and (SheetPos = -1);
  //Open the file
  if FAdapter = nil then
    Workbook := TXLSFile.Create(nil) else
    Workbook := FAdapter.GetWorkbook;
  try
    Workbook.Connect;

    if UseWorkbook then
    begin
      Workbook.NewFile(FAdvGridWorkbook.Sheets.Count);
      for i := 1 to Workbook.SheetCount do
      begin
        Workbook.ActiveSheet := i;
        Workbook.ActiveSheetName := '_xx_@' + IntToStr(i) + '__' + IntToStr(i); //Just to make sure it is an unique name
      end;
    end else
      if FileExists(FileName) then
      begin
        Workbook.OpenFile(FileName);
        if FindSheet(Workbook, SheetName, Sp) then
        begin
          Workbook.ActiveSheet := Sp;
          Workbook.ClearSheet;
        end else
        begin
          if (SheetPos <= 0) or (SheetPos > Workbook.SheetCount) then
            Sp := Workbook.SheetCount + 1 else Sp := SheetPos;
          Workbook.InsertAndCopySheets(-1, Sp, 1);
          Workbook.ActiveSheet := Sp;
        end;
      end else
        Workbook.NewFile(1);

    if UseWorkbook then
    begin
      FWorkSheetNum := FAdvGridWorkbook.Sheets.Count;
      for i := 1 to FAdvGridWorkbook.Sheets.Count do
      begin
        FWorkSheet := i;
        Workbook.ActiveSheet := i;
        FAdvGridWorkbook.ActiveSheet := i - 1;
        ExportData(Workbook);
        Workbook.ActiveSheetName := FAdvGridWorkbook.Sheets[i - 1].Name;
      end;
    end
    else
    begin
      FWorkSheetNum := 1;
      FWorkSheet := 1;
      ExportData(Workbook);
    end;

    if SheetName <> '' then Workbook.ActiveSheetName := SheetName;
    if FileExists(FileName) then DeleteFile(FileName);
    Workbook.SelectSheet(SelectSheet);
    Workbook.Save(true, FileName, nil);
  finally
    CloseFile(Workbook);
  end;

  if Options.ExportShowInExcel then
    ShellExecute(0,'open',pchar(FileName),nil,nil,SW_NORMAL);
end;

constructor TAdvGridExcelIO.Create(AOwner: TComponent);
begin
  inherited;
  FAutoResizeGrid := true;

  FGridStartCol := 1;
  FGridStartRow := 1;
  FXlsStartCol := 1;
  FXlsStartRow := 1;

  FZoomSaved := true;
  FZoom := 100;

  FOptions := TASGIOOptions.Create;
end;

function TAdvGridExcelIO.GetSheetNames(index: integer): widestring;
begin
  Result := FSheetNames[index];
end;

function TAdvGridExcelIO.GetSheetNamesCount: integer;
begin
  Result := Length(FSheetNames);
end;

procedure TAdvGridExcelIO.SetGridStartCol(const Value: integer);
begin
  if Value >= 0 then FGridStartCol := Value else FGridStartCol := 1;
end;

procedure TAdvGridExcelIO.SetGridStartRow(const Value: integer);
begin
  if Value >= 0 then FGridStartRow := Value else FGridStartRow := 1;
end;

procedure TAdvGridExcelIO.SetXlsStartCol(const Value: integer);
begin
  if Value > 0 then FXlsStartCol := Value else FXlsStartCol := 1;
end;

procedure TAdvGridExcelIO.SetXlsStartRow(const Value: integer);
begin
  if Value > 0 then FXlsStartRow := Value else FXlsStartRow := 1;
end;

procedure TAdvGridExcelIO.SetZoom(const Value: integer);
begin
  if Value < 10 then FZoom := 10 else if Value > 400 then FZoom := 400 else
    FZoom := Value;
end;



function TAdvGridExcelIO.CurrentGrid: TAGrid;
begin
  if FAdvGridWorkbook <> nil then
    Result := TAGrid(FAdvGridWorkbook.Grid)
  else
    Result := TAGrid(FAdvStringGrid);
end;


destructor TAdvGridExcelIO.Destroy;
begin
  FOptions.Free;
  inherited;
end;

procedure TAdvGridExcelIO.SetOptions(const Value: TASGIOOptions);
begin
  FOptions := Value;
end;

procedure TAdvGridExcelIO.LoadSheetNames(const FileName: string);
var
  Workbook: TExcelFile;
  ext: string;
  i: integer;
begin
  if FAdapter = nil then
    Workbook := TXLSFile.Create(nil) else
    Workbook := FAdapter.GetWorkbook;
  try
    Workbook.Connect;
    Ext := UpperCase(ExtractFileExt(FileName));
    if Ext = '.CSV' then OpenText(Workbook, FileName, ListSeparator) else //Note that ListSeparator mightbe other than "," (for example ";") so CSV might not be "comma" separated. This is the way excel handles it.
      if Ext = '.TXT' then OpenText(Workbook, FileName, #9) else
        Workbook.OpenFile(FileName);

    SetLength(FSheetNames, Workbook.SheetCount);
    FWorkSheetNum := Workbook.SheetCount;

    for i := 0 to Workbook.SheetCount - 1 do
    begin
      FWorkSheet := i + 1;
      Workbook.ActiveSheet := i + 1;
      FSheetNames[i] := Workbook.ActiveSheetName;
      end;
  finally
    CloseFile(Workbook);
  end;
end;

{ TASGIOOptions }

procedure TASGIOOptions.Assign(Source: TPersistent);
begin
  if Source is TASGIOOptions then
  begin
    FImportCellProperties := (Source as TASGIOOptions).ImportCellProperties;
    FImportCellFormats := (Source as TASGIOOptions).ImportCellFormats;
    FImportCellSizes := (Source as TASGIOOptions).ImportCellSizes;
    FImportImages := (Source as TASGIOOptions).ImportImages;
  end;
end;

constructor TASGIOOptions.Create;
begin
  inherited Create;
  FImportFormulas := True;
  FImportCellProperties := False;
  FImportCellFormats := True;
  FImportCellSizes := True;
  FImportImages := True;
  FExportFormulas := True;
  FExportCellFormats := True;
  FExportCellProperties := True;
  FExportCellSizes := True;
  FExportWordWrapped := False;
  FExportHTMLTags := True;
  FExportHiddenColumns := False;
  FExportOverwrite := omNever;
  FExportShowInExcel := False;
  FExportOverwriteMessage := 'File %s already exists'#13'Ok to overwrite ?';
end;

{$ENDIF}

end.