tmsadvgridexcel.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

      ImportAllNodes(Workbook, XlsStartRow, MaxR);
  finally
    CurrentGrid.EndUpdate;
  end;
end;

procedure TAdvGridExcelIO.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FAdapter then
      FAdapter := nil;
    if AComponent = FAdvStringGrid then
      FAdvStringGrid := nil;
    if AComponent = FAdvGridWorkbook then
      FAdvGridWorkbook := nil;
  end;
end;

//procedure TAdvGridExcelIO.SetAdapter(const Value: TExcelAdapter);
//begin
//  FAdapter := Value;
//end;

procedure TAdvGridExcelIO.SetAdvStringGrid(const Value: TAdvStringGrid);
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);
begin
end;

procedure TAdvGridExcelIO.InternalXLSImport(const FileName: TFileName; const SheetNumber: integer; const SheetName: UTF16String);
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 might be 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: UTF16String);
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;

{$IFDEF USEPNGLIB}
type
  {$IFDEF DELPHI2008UP}
    TPng = TPNGImage;
  {$ELSE}
    TPng = TPNGObject;
  {$ENDIF}
{$ENDIF}


procedure TAdvGridExcelIO.ExportImage(const Workbook: TExcelFile; const Pic: TGraphic; const rx, cx, cg, rg: integer);
//Adapted from FlexCelImport.AddPicture
var
  s: ByteArray;
  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 TPng 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.ReadBuffer(s[0], Ms.Size);
    //PSize := CurrentGrid.CellGraphicSize[cg, rg];
 
    PSize := CurrentGrid.GetPrintGraphicSize(cg, rg, CurrentGrid.ColWidths[cg], CurrentGrid.RowHeights[rg], 1.0);
 
    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;

    if (dw = 0) or (dh = 0) then
    begin
      dw := PSize.x;
      dh := PSize.y;
    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: UTF16String): UTF16String;
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;