advgridexcel.pas

DELPHI界面增强控件,非常好,里面有显示GIF的图片控件,更美观的下拉框控件,

  begin
    rg:=r+GridStartRow-XlsStartRow;
    for c:=XlsStartCol to MaxC do
    begin
      cg:=c+GridStartCol-XlsStartCol;
      Fm:=CellFormatDef(Workbook,r,c);

      //Merged Cells
      //We check this first, so if its not the first of a merged cell we exit
      Mb:=Workbook.CellMergedBounds[r,c];
      if ((Mb.Left<>c) or (Mb.Top<>r)) then continue;

      if ((Mb.Left=c) and (Mb.Top=r))and((Mb.Right> c)or (Mb.Bottom>r)) then
        AdvStringGrid.MergeCells(cg, rg, Mb.Right-Mb.Left+1, Mb.Bottom-Mb.Top+1);

      //Font
      if (Fm.Font.ColorIndex>0)and (integer(Fm.Font.ColorIndex)<56) then
        AdvStringGrid.FontColors[cg,rg]:=Workbook.ColorPalette[Fm.Font.ColorIndex]
        else AdvStringGrid.FontColors[cg,rg]:=0;
      AdvStringGrid.FontSizes[cg,rg]:= Trunc((Fm.Font.Size20 / 20 *Zoom100));
      AdvStringGrid.FontNames[cg,rg]:=Fm.Font.Name;
      if flsBold in Fm.Font.Style then
        AdvStringGrid.FontStyles[cg,rg]:=AdvStringGrid.FontStyles[cg,rg]+[fsBold];
      if flsItalic in Fm.Font.Style then
        AdvStringGrid.FontStyles[cg,rg]:=AdvStringGrid.FontStyles[cg,rg]+[fsItalic];
      if flsStrikeOut in Fm.Font.Style then
        AdvStringGrid.FontStyles[cg,rg]:=AdvStringGrid.FontStyles[cg,rg]+[fsStrikeOut];
      if Fm.Font.Underline<>fu_None then
        AdvStringGrid.FontStyles[cg,rg]:=AdvStringGrid.FontStyles[cg,rg]+[fsUnderline];

      //Pattern
      {Bmp:=nil;
      try
        if Fm.FillPattern.Pattern=1 then
        begin
          if (ACanvas.Brush.Color<>clwhite) then
            ACanvas.Brush.Color:=clwhite;
        end else
        if Fm.FillPattern.Pattern=2 then
        begin
          if (ACanvas.Brush.Color<>ABrushFg) then
            ACanvas.Brush.Color:=ABrushFg;
        end else
        begin
          Bmp:=CreateBmpPattern(Fm.FillPattern.Pattern, ABrushFg, ABrushBg);
          Acanvas.Brush.Bitmap:=Bmp;
        end;

        ACanvas.FillRect(Rect(Round(Cw*ZoomPreview), Round(Ch*ZoomPreview), Round((Cw+RealColWidth(Col,Zoom100,XPpi))*ZoomPreview), Round((Ch+RealRowHeight(Row,Zoom100,YPpi))*ZoomPreview)));

      finally
        ACanvas.Brush.Bitmap:=nil;
        FreeAndNil(Bmp);
      end; //finally
      }
      AdvStringGrid.Colors[cg,rg]:=GetColor(Workbook, Fm);

      if Fm.Rotation>0 then
        if Fm.Rotation<=90 then AdvStringGrid.SetRotated(cg, rg, Fm.Rotation) else
        if Fm.Rotation<=180 then AdvStringGrid.SetRotated(cg, rg, 90-Fm.Rotation);

      //pending: cellborders, brush, cell align, empty right cells, imagesize,
      //pending: fechas y otros formatos, copy/paste, events, comentarios on flexcel .

      //pending: export deafultreowheights/colwidths
      //Ask for: Rotated unicode. Image Size.  Vertical Aligns Word wraps in cells.
      //pending keepexcelformat on import/export don't work with dates
      //pending: export placement of images

      v:=Workbook.CellValue[r,c];

      //Cell Align
      case Fm.HAlignment of
        fha_left: HAlign:=taLeftJustify;
        fha_center:HAlign:=taCenter;
        fha_right: HAlign:=taRightJustify;
        else
        begin
        if VarType(v)=VarBoolean then HAlign:=taCenter else
          if (VarType(v)<>VarOleStr)and(VarType(v)<>VarString) then HAlign:=taRightJustify
          else HAlign:=taLeftJustify;
        end;
      end;//case

{      case Fm.VAlignment of
        fva_top: VAlign:=AL_TOP;
        fva_center: VAlign:=AL_VCENTER;
        else VAlign:=AL_BOTTOM ;
      end; //case
}
      AdvStringGrid.Alignments[cg, rg]:=HAlign;

      FontColor:=AdvStringGrid.FontColors[cg,rg];
      w:=XlsFormatValue(v,Fm.Format, FontColor);
      AdvStringGrid.FontColors[cg,rg]:=FontColor;

      if FKeepExcelCellFormat then
      begin
        if UseUnicode then
          AdvStringGrid.WideCells[cg,rg]:=w else
          AdvStringGrid.Cells[cg,rg]:=w;
      end else
      begin
        case VarType(V) of
          varByte,
          varSmallint,
          varInteger: AdvStringGrid.Ints[cg, rg]:=v;

          {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} varInt64,{$IFEND}{$ENDIF} //Delphi 6 or above
          varCurrency,
          varSingle,
          varDouble:
          begin
            if HasXlsDateTime(Fm.Format, HasDate, HasTime) then
            begin
              if HasTime and HasDate then   //We can't map this to a date or time cell.
                if UseUnicode then
                  AdvStringGrid.WideCells[cg,rg]:=w else
                  AdvStringGrid.Cells[cg,rg]:=w

               else if HasDate then AdvStringGrid.Dates[cg, rg]:=v else AdvStringGrid.Times[cg, rg]:=v
            end
            else AdvStringGrid.Floats[cg, rg]:=v;
          end;

          varDate     : AdvStringGrid.Dates[cg, rg]:=v;
          else
            if UseUnicode then
              AdvStringGrid.WideCells[cg,rg]:=w else
              AdvStringGrid.Cells[cg,rg]:=w;

        end; //case
      end;
    end;

    //Import Comments
    for i:=0 to Workbook.CommentsCount[r]-1 do
      AdvStringGrid.AddComment( Workbook.CommentColumn[r,i]+GridStartCol-XlsStartCol, r+GridStartRow-XlsStartRow, Workbook.CommentText[r,i]);

  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;
  end;
end;

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

procedure TAdvGridExcelIO.SetAdvStringGrid(const Value: TAdvStringGrid);
begin
  FAdvStringGrid := Value;
end;


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

procedure TAdvGridExcelIO.InternalXLSImport(const FileName: TFileName; const SheetNumber: integer; const SheetName: widestring);
var
  Workbook: TExcelFile;
  i: integer;
  Ext: string;
  aSheetNumber: integer;
begin
  aSheetNumber := SheetNumber;
  if AdvStringGrid=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);

    SetLength(FSheetNames, Workbook.SheetCount);
    for i:=0 to Workbook.SheetCount-1 do
    begin
      Workbook.ActiveSheet:=i+1;
      FSheetNames[i]:=Workbook.ActiveSheetName;
      if UpperCase(SheetName)=UpperCase(FSheetNames[i]) then aSheetNumber:=i+1;
    end;

    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);
    AdvStringGrid.VAlignment:=vtaBottom;
  finally
    CloseFile(Workbook);
  end;
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: TPicture; 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.Graphic is TPNGObject then PicType:=xli_Png;
  {$ENDIF}

  Ms:=TMemoryStream.Create;
  try

    if (PicType=xli_Jpeg) and not (Pic.Graphic is TJPEGImage) then
    begin  //Convert the image
      JPic:=TJPEGImage.Create;
      try
        BPic:=TBitmap.Create;  //we cant 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.Graphic);
          JPic.Assign(BPic);
        finally
          FreeAndNil(BPic);
        end; //finally
        JPic.SaveToStream(Ms);
      finally
        FreeAndNil(JPic);
      end; //finally
    end
    else
      Pic.Graphic.SaveToStream(Ms);

    Ms.Position:=0;
    SetLength(s, Ms.Size);
    Ms.Read(s[1], Ms.Size);
    PSize:=AdvStringGrid.CellGraphicSize[cg, rg];
    CSize:=AdvStringGrid.CellSize(cg, rg);
    dh:=1;
    dw:=1;
    Cr:=AdvStringGrid.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