advgridexcel.pas

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

unit AdvGridExcel;
{$IFDEF LINUX}{$INCLUDE ../FLXCONFIG.INC}{$ELSE}{$INCLUDE ..\FLXCONFIG.INC}{$ENDIF}
interface
{$IFDEF FLEXCELADVSTRINGGRID}
uses
  Windows, SysUtils, Classes, XLSAdapter, UExcelAdapter, UFlxUtils, AdvGrid, UFlxFormats, UFlxMessages, BaseGrid, UXlsPictures,
  {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants, {$IFEND}{$ENDIF} //Delphi 6 or above
    {$IFDEF USEPNGLIB}
      //////////////////////////////// IMPORTANT ///////////////////////////////////////
      //To be able to display PNG images and WMFs, you have to install TPNGImage from http://pngdelphi.sourceforge.net/
      //If you don't want to install it, edit ../FLXCONFIG.INC and delete the line:
      // "{$DEFINE USEPNGLIB}" on the file
      //Note that this is only needed on Windows, CLX has native support for PNG
      ///////////////////////////////////////////////////////////////////////////////////
        pngimage, pngzlib,
      ///////////////////////////////////////////////////////////////////////////////////
      //If you are getting an error here, please read the note above.
      ///////////////////////////////////////////////////////////////////////////////////
    {$ENDIF}
  Graphics, JPEG,
  {$IFNDEF TMSASG}UTextDelim,{$ENDIF}
   UFlxNumberFormat, Grids;
                       
const                            
  CellOfs = 0;
type
  TFlxFormatCellEvent = procedure (Sender: TAdvStringGrid; const GridCol, GridRow, XlsCol, XlsRow: integer; const Value: widestring; var DateFormat, TimeFormat: Widestring) of object;

  TAdvGridExcelIO = class(TComponent)
  private
    FAdvStringGrid: TAdvStringGrid;
    FAdapter: TExcelAdapter;
    FAutoResizeGrid: boolean;
    FKeepExcelCellFormat: boolean;
    FUseUnicode: boolean;
    FMergeEmptyRightCells: boolean;
    FLoadImages: boolean;
    FSheetNames: array of widestring;
    FGridStartCol: integer;
    FGridStartRow: integer;
    FXlsStartRow: integer;
    FXlsStartCol: integer;
    FZoomSaved: boolean;
    FZoom: integer;
    FDateFormat: widestring;
    FTimeFormat: widestring;
    FOnDateTimeFormat: TFlxFormatCellEvent;
    // procedure SetAdapter(const Value: TExcelAdapter);
    procedure SetAdvStringGrid(const Value: TAdvStringGrid);

    procedure ImportData(const Workbook: TExcelFile);
    procedure ExportData(const Workbook: TExcelFile);
    procedure CloseFile(var Workbook: TExcelFile);
    function CellFormatDef(const Workbook: TExcelFile; const aRow, aCol: integer): TFlxFormat;
    function GetColor(const Workbook:TExcelFile; const Fm: TFlxFormat): TColor;
    function GetSheetNames(index: integer): widestring;
    function GetSheetNamesCount: integer;
    procedure SetGridStartCol(const Value: integer);
    procedure SetGridStartRow(const Value: integer);
    procedure SetXlsStartCol(const Value: integer);
    procedure SetXlsStartRow(const Value: integer);
    procedure OpenText(const Workbook: TExcelFile;
      const FileName: TFileName; const Delimiter: char);
    procedure SetZoom(const Value: integer);
    procedure ImportImages(const Workbook: TExcelFile; const Zoom100: extended);
    procedure ExportImage(const Workbook: TExcelFile; const Pic: TPicture; const rx, cx, cg, rg: integer);
    procedure InternalXLSImport(const FileName: TFileName; const SheetNumber: integer; const SheetName: widestring);
    { Private declarations }
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    { Protected declarations }
  public
    procedure XLSImport(const FileName: TFileName; const SheetNumber: integer=1);overload;
    procedure XLSImport(const FileName: TFileName; const SheetName: widestring);overload;
    procedure XLSExport(const FileName: TFileName; const SheetName: widestring='');

    property SheetNames[index: integer]: widestring read GetSheetNames;
    property SheetNamesCount: integer read GetSheetNamesCount;

    constructor Create(AOwner: TComponent); override;
    { Public declarations }
  published
    //property Adapter: TExcelAdapter read FAdapter write SetAdapter;
    property AdvStringGrid: TAdvStringGrid read FAdvStringGrid write SetAdvStringGrid;

    property AutoResizeGrid: boolean read FAutoResizeGrid write FAutoResizeGrid default true;
    property KeepExcelCellFormat: boolean read FKeepExcelCellFormat write FKeepExcelCellFormat default true;
    property UseUnicode: boolean read FUseUnicode write FUseUnicode;

    property LoadImages: boolean read FLoadImages write FLoadImages default true;
    property MergeEmptyRightCells: boolean read FMergeEmptyRightCells write FMergeEmptyRightCells;

    property GridStartRow:integer read FGridStartRow write SetGridStartRow default 1;
    property GridStartCol:integer read FGridStartCol write SetGridStartCol  default 1;
    property XlsStartRow:integer read FXlsStartRow write SetXlsStartRow  default 1;
    property XlsStartCol:integer read FXlsStartCol write SetXlsStartCol  default 1;

    property ZoomSaved: boolean read FZoomSaved write FZoomSaved default true;
    property Zoom: integer read FZoom write SetZoom default 100;

    property DateFormat: widestring read FDateFormat write FDateFormat;
    property TimeFormat: widestring read FTimeFormat write FTimeFormat;

    //Events
    property OnDateTimeFormat: TFlxFormatCellEvent read FOnDateTimeFormat write FOnDateTimeFormat;
    { Published declarations }
  end;

procedure Register;
{$ENDIF}
implementation
{$IFDEF FLEXCELADVSTRINGGRID}

procedure Register;
begin
  RegisterComponents('TMS Grids', [TAdvGridExcelIO]);
end;

{ TAdvGridExcelIO }

procedure TAdvGridExcelIO.CloseFile(var Workbook: TExcelFile);
begin
  if Workbook=nil then exit;
  try
    Workbook.CloseFile;
  except
    //nothing;
  end; //Except
  try
    Workbook.Disconnect;
  except
    //nothing;
  end; //Except
  FreeAndNil(Workbook);
end;

function TAdvGridExcelIO.CellFormatDef(const Workbook: TExcelFile;const aRow, aCol: integer): TFlxFormat;
var
  XF: integer;
begin
  XF:= Workbook.CellFormat[aRow, aCol];
  if XF<0 then
  begin

    XF:=Workbook.RowFormat[aRow];
    if XF<=0 then XF:=Workbook.ColumnFormat[aCol];
  end;
  if (XF<0) then XF:=15;
  Result:=Workbook.FormatList[XF];
end;

function TAdvGridExcelIO.GetColor(const Workbook:TExcelFile; const Fm: TFlxFormat): TColor;
var
  bc: TColor;
begin
  if Fm.FillPattern.Pattern= 1 then Result:=$FFFFFF
  else
  begin
    bc:=Fm.FillPattern.FgColorIndex;
    if (bc>0)and (integer(bc)<56) then
        Result:=Workbook.ColorPalette[bc] else
        Result:=$FFFFFF;
  end;
end;

procedure TAdvGridExcelIO.ImportImages(const Workbook: TExcelFile; const Zoom100: extended);
var
  i: integer;
  Pic: TStream;
  PicType: TXlsImgTypes;
  Picture, TmpPic: TPicture;
  Bmp:TBitmap;
  Anchor: TClientAnchor;
  Handled: boolean;
  w,h: integer;

  StartX, StartY, SpanX, SpanY: integer;
begin
  if LoadImages then
  begin
    for i:=0 to Workbook.PicturesCount[-1]-1 do
    begin
      Pic:=TMemoryStream.Create;
      try
        Workbook.GetPicture(-1, i, Pic, PicType, Anchor);

        if Anchor.Dx1>1024 div 2 then StartX:=Anchor.Col1+1 else StartX:=Anchor.Col1;
        SpanX:=Anchor.Col2-StartX+1;
        if Anchor.Dy1>255 div 2 then StartY:=Anchor.Row1+1 else StartY:=Anchor.Row1;
        SpanY:=Anchor.Row2-StartY+1;

        //Resize the grid if too small
        if FAutoResizeGrid then
        begin
          if Anchor.Col2+GridStartCol-XlsStartCol+2>AdvStringGrid.ColCount then AdvStringGrid.ColCount:=Anchor.Col2+GridStartCol-XlsStartCol+2;
          if Anchor.Row2+GridStartRow-XlsStartRow+2>AdvStringGrid.RowCount then AdvStringGrid.RowCount:=Anchor.Row2-XlsStartRow+GridStartRow+2;
        end;

        if Anchor.Row1<XlsStartRow then continue;
        if Anchor.Col1<XlsStartCol then continue;
        if Anchor.Col2+GridStartCol-XlsStartCol>AdvStringGrid.ColCount then continue;
        if Anchor.Row2+GridStartRow-XlsStartRow>AdvStringGrid.RowCount then continue;


        Picture:=AdvStringGrid.CreatePicture(StartX+GridStartCol-XlsStartCol, StartY+GridStartRow-XlsStartRow, false, noStretch, 0, haLeft, vaTop);
        try
          //Merge picture cells so we get a better size.

          AdvStringGrid.MergeCells(StartX+GridStartCol-XlsStartCol, StartY+GridStartRow-XlsStartRow, SpanX, SpanY);
          //Load the image
          Pic.Position:=0;
          CalcImgDimentions(Workbook, Anchor, w, h);
          TmpPic:=TPicture.Create;
          try
            SaveImgStreamToGraphic(Pic, PicType, TmpPic, Handled);
            if not Handled then raise Exception.Create('Not handled'); //This will be catched below. It is an internal exception so image is deleted
            Bmp:=TBitmap.Create;
            try
              Picture.Graphic:=Bmp;
            finally
              FreeAndNil(Bmp); //Remember TPicture.Graphic keeps a COPY of the TGraphic
            end;
            (Picture.Graphic as TBitmap).Width:=Round(w*Zoom100);
            (Picture.Graphic as TBitmap).Height:=Round(h*Zoom100);
            (Picture.Graphic as TBitmap).Canvas.StretchDraw(Rect(0,0,Round(w*Zoom100),Round(h*Zoom100)),TmpPic.Graphic);
          finally
            FreeAndNil(TmpPic);
          end; //finally
        except
          AdvStringGrid.RemovePicture(Anchor.Col1+GridStartCol-XlsStartCol, Anchor.Row1+GridStartRow-XlsStartRow);
          //Dont raise... is not a major error;
        end;    //except
      finally
        FreeAndNil(Pic);
      end; //Finally
    end;
  end;
end;

procedure TAdvGridExcelIO.ImportData(const Workbook: TExcelFile);
var
  r,c,i: integer;
  Fm: TFlxFormat;
  Mb: TXlsCellRange;

  MaxC, MaxR, cg, rg: integer;

  XF: integer;

  Zoom100: extended;
  FontColor: integer;
  w: widestring;
  v: variant;
  HAlign: TAlignment;

  HasTime, HasDate: boolean;
begin
  Assert(Workbook<>nil,'Workbook can''t be nil');
  Assert(AdvStringGrid<>nil,'AdvStringGrid can''t be nil');

  if FZoomSaved then Zoom100:=Workbook.SheetZoom/100 else Zoom100:=FZoom/100;


  if FAutoResizeGrid then
  begin
    AdvStringGrid.RowCount:=Workbook.MaxRow-XlsStartRow + 1 + GridStartRow;
    AdvStringGrid.ColCount:=Workbook.MaxCol-XlsStartCol + 1 + GridStartCol;
  end
  else
    AdvStringGrid.Clear;

  AdvStringGrid.DefaultRowHeight:=Round(Workbook.DefaultRowHeight/RowMult*Zoom100)+CellOfs;
  AdvStringGrid.DefaultColWidth:=Round(Workbook.DefaultColWidth/ColMult*Zoom100)+CellOfs;

  ImportImages(Workbook, Zoom100); //Load them first, so if there is some resizing to do, it is done here

  if Workbook.MaxRow>AdvStringGrid.RowCount+XlsStartRow-1-GridStartRow
    then MaxR:=AdvStringGrid.RowCount+XlsStartRow-1-GridStartRow else MaxR:=Workbook.MaxRow;
  if Workbook.MaxCol>AdvStringGrid.ColCount+XlsStartCol-1-GridStartCol
    then MaxC:=AdvStringGrid.ColCount+XlsStartCol-1-GridStartCol else MaxC:=Workbook.MaxCol;

  //Adjust Row/Column sizes and set Row/Column formats
  for r:=XlsStartRow to MaxR do
  begin
    rg:=r+GridStartRow-XlsStartRow;
    AdvStringGrid.RowHeights[rg]:=Round(Workbook.RowHeight[r]/RowMult*Zoom100)+CellOfs;
    XF:=Workbook.RowFormat[r];
    if XF>=0 then
    begin
      Fm:=Workbook.FormatList[XF];
      AdvStringGrid.RowColor[rg]:=GetColor(Workbook, Fm);
      if (Fm.Font.ColorIndex>0)and (integer(Fm.Font.ColorIndex)<56) then
        AdvStringGrid.RowFontColor[rg]:=Workbook.ColorPalette[Fm.Font.ColorIndex];
    end;
  end;

  for c:=XlsStartCol to MaxC do
  begin
    cg:=c+GridStartCol-XlsStartCol;
    AdvStringGrid.ColWidths[cg]:=Round(Workbook.ColumnWidth[c]/ColMult*Zoom100)+CellOfs;
  end;

  //Import data
  for r:=XlsStartRow to MaxR do