advgridexcel.pas

DELPHI tms.component.pack.v4.6.0.7

              if not ExportCellAsString then
              begin
                aDateFormat := FDateFormat;
                aTimeFormat := FTimeFormat;
                if Assigned(OnDateTimeFormat) then
                  OnDateTimeFormat(CurrentGrid, creal, rreal, cx, rx, w, aDateFormat, aTimeFormat);

                if (pos('=',Formula) = 1) and FOptions.ExportFormulas then
                begin
                  Workbook.CellFormula[rx,cx] := Formula;
                  if Options.ExportCellProperties then
                    Workbook.CellFormat[rx, cx] := Workbook.AddFormat(Fm);
                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;
                end;
                CopyFmToMerged(Workbook, cp, rx, cx, Fm) ;
              end
              else
              begin
                if (pos('=',Formula) = 1) and FOptions.ExportFormulas then
                begin
                  Workbook.CellFormula[rx,cx] := Formula;
                end
                else
                begin
                  Workbook.CellValue[rx, cx] := w;
                end;
                if Options.ExportCellProperties then
                begin
                  Workbook.CellFormat[rx, cx] := Workbook.AddFormat(Fm);
                  CopyFmToMerged(Workbook, cp, rx, cx, Fm) ;
                end;
              end;
            finally
              FreeAndNil(ABrush);
            end; //finally
          finally
            FreeAndNil(AFont);
          end; //finally

          //Export Images
          Pic := CurrentGrid.CellGraphics[creal, rreal];
          if (Pic <> nil) and (Pic.CellBitmap <> nil) then
          begin
          if (Pic.CellType = cTBitmap) then
             ExportImage(Workbook, Pic.CellBitmap, rx, cx, creal, rreal);

          if (Pic.CellType = cTPicture) then
             ExportImage(Workbook, TPicture(Pic.CellBitmap).Graphic, rx, cx, creal, rreal);
          end;

        //Export Comments
          if CurrentGrid.IsComment(creal, rreal, Comment) then
          begin
            Cr := Workbook.CellMergedBounds[rx, cx];
            CommentHeight:= 75;
            CommentWidth:= 130;
            Comment := SupressCR(Comment);
            ResizeCommentBox(Workbook, Comment, CommentHeight, CommentWidth);
            if Assigned(OnGetCommentBoxSize) then OnGetCommentBoxSize(CurrentGrid, Comment, CommentHeight, CommentWidth);

            CalcImgCells(Workbook, rx - 1, cx + Cr.Right - Cr.Left + 1, 8, 14, CommentHeight, CommentWidth, 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(rreal)>=0) and (CurrentGrid.GetNodeLevel(rreal)<=7) then
            Workbook.SetRowOutlineLevel(rx+1, rx+CurrentGrid.GetNodeSpan(rreal)-1, CurrentGrid.GetNodeLevel(rreal));

      end;
    finally
      if Options.FExportHiddenRows then
        CurrentGrid.RowCount := CurrentGrid.RowCount - HiddenRowCount;
    end; //finally

  finally
    //if Options.ExportHiddenColumns then
      CurrentGrid.ColCount := CurrentGrid.ColCount - HiddenColCount;
  end; //finally

  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 (WideUpperCase98(Workbook.ActiveSheetName) = WideUpperCase98(SheetName)) then
    begin
      Result := True;
      Index := i;
      Exit;
    end;
  end;
end;

procedure TAdvGridExcelIO.OpenFile(const Workbook: TExcelFile; const FileName: string);
begin
  Workbook.OpenFile(FileName);
end;

procedure TAdvGridExcelIO.XLSExport(const FileName: TFileName; const SheetName: widestring = ''; const SheetPos: integer = -1; const SelectSheet: integer = 1; const InsertInSheet: TInsertInSheet = InsertInSheet_Clear);
var
  Workbook: TExcelFile;
  UseWorkbook: boolean;
  Sp, i: integer;
  rows, cols, dr, dc: integer;
  GridRowCount, GridColCount: 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
        OpenFile(Workbook, FileName);
        if FindSheet(Workbook, SheetName, Sp) then
        begin
          Workbook.ActiveSheet := Sp;
          case InsertInSheet of
             InsertInSheet_Clear:
               Workbook.ClearSheet;
             InsertInSheet_InsertRows,
             InsertInSheet_InsertRowsExceptFirstAndSecond:
             begin
               dr := 0;
               if (InsertInSheet = InsertInSheet_InsertRowsExceptFirstAndSecond) then dr:=1;
               GridRowCount := CurrentGrid.RowCount;
               if Options.FExportHiddenRows then Inc(GridRowCount, CurrentGrid.NumHiddenRows);
               rows := GridRowCount - GridStartRow - dr * 2;
               if rows > 0 then Workbook.InsertAndCopyRows(Max_Rows + 1, Max_Rows + 1, XlsStartRow + dr, rows ,true);
             end;

             InsertInSheet_InsertCols,
             InsertInSheet_InsertColsExceptFirstAndSecond:
             begin
               dc:=0;
               if (InsertInSheet = InsertInSheet_InsertColsExceptFirstAndSecond) then dc:=1;
               GridColCount := CurrentGrid.ColCount;
               if Options.ExportHiddenColumns then Inc(GridColCount, CurrentGrid.NumHiddenColumns);
               cols := GridColCount - GridStartCol - dc * 2;
               if cols > 0 then Workbook.InsertAndCopyRows(Max_Columns + 1, Max_Columns + 1, XlsStartCol + dc, cols ,true);
             end;
          end; //case.
        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;

function TAdvGridExcelIO.GetUsedPaletteColors(const Workbook: TExcelFile): BooleanArray;
begin
  if Options.UseExcelStandardColorPalette then
    begin Result := nil; exit; end;

  Result := Workbook.GetUsedPaletteColors;
end;

function TAdvGridExcelIO.NearestColorIndex(const Workbook: TExcelFile; const aColor: TColor;
  const UsedColors: BooleanArray): integer;
type
  TCb= array[0..3] of byte;
var
  i: integer;
  sq, MinSq: extended;
  ac1, ac2: TCb;
  Result2: integer;
begin
  Result:=1;
  MinSq:=-1;
  ac1:=TCb(ColorToRgb(aColor));
  for i:=1 to 55 do
  begin
    ac2:=TCb(Workbook.ColorPalette[i]);
    sq := Sqr(ac2[0] - ac1[0]) +
          Sqr(ac2[1] - ac1[1]) +
          Sqr(ac2[2] - ac1[2]);
    if (MinSq<0) or (sq< MinSq)