advgridexcel.pas

DELPHI tms.component.pack.v4.6.0.7

begin
  FAdvGridWorkbook := nil;
  FAdvStringGrid := Value;
end;

procedure TAdvGridExcelIO.SetAdvGridWorkbook(const Value: TAdvGridWorkbook);
begin
  FAdvStringGrid := nil;
  FAdvGridWorkbook := Value;
end;


procedure TAdvGridExcelIO.OpenText(const Workbook: TExcelFile; const FileName: TFileName; const Delimiter: char);
var
  DataStream: TFileStream;
begin
  DataStream := TFileStream.Create(FileName, fmOpenRead);
  try
    Workbook.NewFile;
    LoadFromTextDelim(DataStream, Workbook, Delimiter, 1, 1, []);
  finally
    FreeAndNil(DataStream);
  end; //finally
end;

procedure TAdvGridExcelIO.InternalXLSImport(const FileName: TFileName; const SheetNumber: integer; const SheetName: widestring);
var
  Workbook: TExcelFile;
  i: integer;
  Ext: string;
  aSheetNumber: integer;
  UseWorkbook: boolean;
begin
  aSheetNumber := SheetNumber;
  UseWorkbook := (FAdvGridWorkbook <> nil) and (SheetNumber < 0) and (SheetName = '');

  if CurrentGrid = nil then raise Exception.Create(ErrNoAdvStrGrid);
  //Open the file
  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);

    if UseWorkbook then
    begin
      FAdvGridWorkbook.ActiveSheet := 0;
      FAdvGridWorkbook.Sheets.Clear;
    end;


    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;
      if WideUpperCase98(SheetName) = WideUpperCase98(FSheetNames[i]) then aSheetNumber := i + 1;
      if UseWorkbook then
      begin
        FAdvGridWorkbook.Sheets.Add;
        FAdvGridWorkbook.ActiveSheet := i;
        FAdvGridWorkbook.Sheets[i].Name := FSheetNames[i];
        Workbook.ParseComments;
        ImportData(Workbook);
        CurrentGrid.VAlignment := vtaBottom;
      end;
    end;

    if not UseWorkbook then
    begin
      if aSheetNumber < 1 then
        aSheetNumber := 1;

      FWorkSheetNum := 1;
      FWorkSheet := 1;
      if (aSheetNumber = 0) and (SheetName <> '') then raise Exception.CreateFmt(ErrInvalidSheetName, [SheetName]);
      if (aSheetNumber > 0) and (aSheetNumber <= Workbook.SheetCount) then
      begin
        Workbook.ActiveSheet := aSheetNumber;
        Workbook.SelectSheet(aSheetNumber);
      end
      else raise Exception.CreateFmt(ErrIndexOutBounds, [aSheetNumber, 'ActiveSheet', 1, Workbook.SheetCount]);

      Workbook.ParseComments;
      ImportData(Workbook);
      CurrentGrid.VAlignment := vtaBottom;
    end;
  finally
    CloseFile(Workbook);
  end;
end;

procedure TAdvGridExcelIO.XLSImport(const FileName: TFileName);
begin
  XlsImport(FileName, -1);
  if FAdvGridWorkbook <> nil then
    FAdvGridWorkbook.ActiveSheet := 0;
end;

procedure TAdvGridExcelIO.XLSImport(const FileName: TFileName; const SheetName: widestring);
begin
  if SheetName = '' then raise Exception.CreateFmt(ErrInvalidSheetName, [SheetName]);
  InternalXLSImport(FileName, 0, SheetName);
end;

procedure TAdvGridExcelIO.XLSImport(const FileName: TFileName; const SheetNumber: integer);
begin
  InternalXLSImport(FileName, SheetNumber, '');
end;


procedure TAdvGridExcelIO.ExportImage(const Workbook: TExcelFile; const Pic: TGraphic; const rx, cx, cg, rg: integer);
//Adapted from FlexCelImport.AddPicture
var
  s: string;
  Ms: TMemoryStream;
  Props: TImageProperties;
  PicType: TXlsImgTypes;
  JPic: TJPEGImage;
  BPic: TBitmap;
  PSize, CSize: TPoint;
  dh, dw: integer;
  Cr: TCellGraphic;
begin
  PicType := xli_Jpeg;
{$IFDEF USEPNGLIB}
  if Pic is TPNGObject then PicType := xli_Png;
{$ENDIF}

  Ms := TMemoryStream.Create;
  try
    if (PicType = xli_Jpeg) and not (Pic is TJPEGImage) then
    begin //Convert the image
      JPic := TJPEGImage.Create;
      try
        BPic := TBitmap.Create; //we can't assign a metafile to a jpeg, so the temporary bitmap.
        try
          BPic.Width := Pic.Width;
          BPic.Height := Pic.Height;
          BPic.Canvas.Draw(0, 0, Pic);
          JPic.Assign(BPic);
        finally
          FreeAndNil(BPic);
        end; //finally
        JPic.SaveToStream(Ms);
      finally
        FreeAndNil(JPic);
      end; //finally
    end
    else
      Pic.SaveToStream(Ms);

    Ms.Position := 0;
    SetLength(s, Ms.Size);
    Ms.Read(s[1], Ms.Size);
    PSize := CurrentGrid.CellGraphicSize[cg, rg];
    CSize := CurrentGrid.CellSize(cg, rg);
    dh := 1;
    dw := 1;
    Cr := CurrentGrid.CellGraphics[cg, rg];

    case Cr.CellHAlign of
      haLeft:
        begin
        //Nothing, this is default
        end;
      haRight:
        begin
          dw := CSize.X - PSize.X;
        end;
      haCenter:
        begin
          if (PSize.X < CSize.X) then
          begin
            dw := (CSize.X - PSize.X) div 2;
          end
        end;
      haBeforeText:
        begin
        //Nothing
        end;
      haAfterText:
        begin
        //Nothing
        end;
      haFull:
        begin
        //Nothing
        end;
    end;

    case Cr.CellVAlign of
      vaTop, vaAboveText:
        begin
        //This is default
        end;
      vaBottom:
        begin
          dh := CSize.Y - PSize.Y;
        end;
      vaCenter:
        begin
          if PSize.Y < CSize.Y then
          begin
            dh := (CSize.Y - PSize.Y) div 2;
          end
        end;
      vaUnderText:
        begin
        //Nothing
        end;
      vaFull:
        begin
        //Nothing
        end;
    end;


    CalcImgCells(Workbook, rx, cx, dh, dw, PSize.y, PSize.x, Props);
    Workbook.AddImage(s, PicType, Props, at_MoveAndDontResize);
  finally
    FreeAndNil(Ms);
  end; //finally
end;

function IsRtf(const Value: string): Boolean;
begin
  Result := (Pos(RtfStart, Value) = 1);
end;

function TAdvGridExcelIO.RichToText(const RTFText: string): string;
var
  MemoryStream: TMemoryStream;
begin
  if RtfText <> '' then
  begin
    MemoryStream := TMemoryStream.Create;
    try
      MemoryStream.Write(RtfText[1], Length(RtfText));
      MemoryStream.Position := 0;
      CurrentGrid.RichEdit.Lines.LoadFromStream(MemoryStream);
    finally
      MemoryStream.Free;
    end;
  end
  else
    CurrentGrid.RichEdit.Clear;

  Result := CurrentGrid.RichEdit.Text;
end;


function TAdvGridExcelIO.SupressCR(s: Widestring): widestring;
var
  i, k: integer;
begin
  if IsRtf(s) then
  begin
     s := RichToText(s);
  end;


  SetLength(Result, Length(s));
  k := 1;
  for i := 1 to Length(s) do if s[i] <> #13 then
    begin
      Result[k] := s[i];
      inc(k);
    end
    else
    begin
      if (i = Length(s)) or (s[i+1] <> #10) then
      begin
        Result[k] := #10;
        inc(k);
      end
    end;

  SetLength(Result, k - 1);
end;

procedure TAdvGridExcelIO.SetBorders(const cg, rg: integer; var LastRowBorders: TRowBorderArray; SpanRow, SpanCol: integer;
                                     var Fm: TFlxFormat; const Workbook: TExcelFile; const UsedColors: BooleanArray);
var
  Borders: TCellBorders;
  LeftPen, RightPen, TopPen, BottomPen: TPen;
  i: integer;
  Span: integer;
begin
  Span:=SpanCol;
  if (Span<0) then Span:=0;
  if cg+Span>Length(LastRowBorders)-1 then Span:=Length(LastRowBorders)-1-cg;

  Borders:=[];
  LeftPen:=TPen.Create;
  try
  TopPen:=TPen.Create;
  try
  RightPen:=TPen.Create;
  try
  BottomPen:=TPen.Create;
  try
    CurrentGrid.GetCellBorder(cg, rg, TopPen, Borders);
    BottomPen.Assign(TopPen);
    LeftPen.Assign(TopPen);
    RightPen.Assign(LeftPen);

    if Assigned(CurrentGrid.OnGetCellBorderProp) then
       CurrentGrid.OnGetCellBorderProp(CurrentGrid, rg, cg, LeftPen, TopPen, RightPen, BottomPen);

    if (Options.ExportHardBorders) and (CurrentGrid.GridLineWidth>0) then
    begin
      if (goVertLine in CurrentGrid.Options) then
      begin
        if not (cbTop in Borders) then
        begin
          TopPen.Color:= CurrentGrid.GridLineColor;
          Include( Borders, cbTop);
        end;

        if not (cbBottom in Borders) then
        begin
          BottomPen.Color:= CurrentGrid.GridLineColor;
          Include(Borders, cbBottom);
        end;
      end;
      if (goHorzLine in CurrentGrid.Options) then
      begin
        if not (cbLeft in Borders) then
        begin
          LeftPen.Color:= CurrentGrid.GridLineColor;
          Include( Borders, cbLeft);
        end;

        if not (cbRight in Borders) then
        begin
          RightPen.Color:= CurrentGrid.GridLineColor;
          Include(Borders, cbRight);
        end;
      end;
    end;

    if (cbTop in Borders) then
    begin
      Fm.Borders.Top.Style:= fbs_Thin;
      Fm.Borders.Top.ColorIndex:=NearestColorIndex(Workbook, ColorToRGB(TopPen.Color), UsedColors);
    end else
    if (LastRowBorders[cg].HasBottom) then
    begin
      Fm.Borders.Top.Style:= fbs_Thin;
      Fm.Borders.Top.ColorIndex:=LastRowBorders[cg].BottomColor;
    end;

    if (cbLeft in Borders) then
    begin
      Fm.Borders.Left.Style:= fbs_Thin;
      Fm.Borders.Left.ColorIndex:=NearestColorIndex(Workbook, ColorToRGB(LeftPen.Color), UsedColors);
    end
    else
    if (LastRowBorders[cg+Span].HasRight) then
    begin
      Fm.Borders.Left.Style:= fbs_Thin;
      Fm.Borders.Left.ColorIndex:=LastRowBorders[cg+Span].RightColor;
    end;

    if (cbBottom in Borders) then
    begin