advgridexcel.pas

TMS Component Pack Pro v4.2

          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) and FOptions.ExportFormulas 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.CellGraphics[cg, rg];
      if Pic <> nil then
      begin
      if (Pic.CellType = cTBitmap) then
         ExportImage(Workbook, Pic.CellBitmap, rx, cx, cg, rg);

      if (Pic.CellType = cTPicture) then
         ExportImage(Workbook, TPicture(Pic.CellBitmap).Graphic, 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;

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) then
    begin
      MinSq:=sq;
      Result:=i;
      if sq=0 then exit; //exact match...
    end;
  end;

  if (UsedColors = nil) then exit;

  //Find the nearest color between the ones that are not in use.
  UsedColors[0] := true; //not really used
  UsedColors[1] := true; //pure black
  UsedColors[2] := true; //pure white

  Result2:=-1;
  MinSq:=-1;
  for i:=1 to 55 do
  begin
    if (Length(UsedColors) <= i) or UsedColors[i] then continue;

    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) then
    begin
      MinSq:=sq;
      Result2:=i;
      if sq=0 then
      begin
        Result := Result2;
        exit; //exact match...
      end;
    end;
  end;

  if (Result2 < 0) or (Result2 >= Length(UsedColors)) then exit;  //Not available colors to modify
  Workbook.ColorPalette[Result2] := ColorToRGB(aColor);
  UsedColors[Result2] := true;
  Result:= Result2;
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 ?';
  FUseExcelStandardColorPalette := true;
  FExportShowGridLines := true;
end;

{$ENDIF}

end.