advgridexcel.pas

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

        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;

procedure TAdvGridExcelIO.ExportData(const Workbook: TExcelFile);
var
  Zoom100: extended;
  rg, cg, rx, cx: integer;
  Fm: TFlxFormat;

  w: widestring;

  Pic: TPicture;

  AState: TGridDrawState;
  ABrush: TBrush;
  AColorTo: TColor;
  AFont: TFont;
  HA: TAlignment; var VA: TVAlignment; WW: Boolean;
  cp: TCellProperties;
  AAngle: integer;

  Comment: string;
  Properties: TImageProperties;
  Cr: TXlsCellRange;
  aDateFormat, aTimeFormat: widestring;
begin
  Zoom100:=1;
  Assert(Workbook<>nil,'Workbook can''t be nil');
  Assert(AdvStringGrid<>nil,'AdvStringGrid can''t be nil');

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

  //Adjust Row/Column sizes and set Row/Column formats
  for rg:=GridStartRow to AdvStringGrid.RowCount-1 do
  begin
    rx:=rg-GridStartRow+XlsStartRow;
    Workbook.RowHeight[rx]:=Round(AdvStringGrid.RowHeights[rg]*RowMult/Zoom100)-CellOfs;
  end;

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

  //Export data
  for rg:=GridStartRow to AdvStringGrid.RowCount-1 do
  begin
    rx:=rg-GridStartRow+XlsStartRow;
    for cg:=GridStartCol to AdvStringGrid.ColCount-1 do
    begin
      cx:=cg-GridStartCol+XlsStartCol;

      cp:=AdvStringGrid.GetCellProperties(cg, rg);
      //Merged Cells
      //We check this first, so if its not the first of a merged cell we exit
      if not (cp.IsBaseCell) then continue;

      if (cp.CellSpanX>0)or(cp.CellSpanY>0) then Workbook.MergeCells(rx, cx, rx+cp.CellSpanY, cx+cp.CellSpanX);
      Fm:=CellFormatDef(Workbook,rx,cx);
      AFont:=TFont.Create;
      try
        ABrush:=TBrush.Create;
        try
          AdvStringGrid.GetVisualProperties(cg, rg, AState, false, false, false, ABrush, AColorTo, AFont, HA, VA, WW);

          //Font
          Fm.Font.ColorIndex:=MatchNearestColor(Workbook, AFont.Color);
          Fm.Font.Size20:= Trunc(-AFont.Height * 72/AFont.PixelsPerInch  *20/Zoom100);
          Fm.Font.Name:=AFont.Name;
          if fsBold in AFont.Style then
            Fm.Font.Style:=Fm.Font.Style+[flsBold] else Fm.Font.Style:=Fm.Font.Style-[flsBold];
          if fsItalic in AFont.Style then
            Fm.Font.Style:=Fm.Font.Style+[flsItalic] else Fm.Font.Style:=Fm.Font.Style-[flsItalic];
          if fsStrikeOut in AFont.Style then
            Fm.Font.Style:=Fm.Font.Style+[flsStrikeOut] else Fm.Font.Style:=Fm.Font.Style-[flsStrikeOut];
          if fsUnderline in AFont.Style then
            Fm.Font.Underline:=fu_Single else Fm.Font.Underline:=fu_None;

          //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
          }
          if ColorToRGB(ABrush.Color)=$FFFFFF then
          begin
            Fm.FillPattern.Pattern:=1; //no fill
          end else
          begin
            Fm.FillPattern.Pattern:=2; //Solid fill
            Fm.FillPattern.FgColorIndex:=MatchNearestColor(Workbook, ABrush.Color);
          end;

          if AdvStringGrid.IsRotated(cg, rg, AAngle) then
          begin
            if AAngle<0 then AAngle:= 360-(Abs(AAngle) mod 360) else
              AAngle:=AAngle mod 360;
            if (AAngle>=0) and (AAngle<=90) then Fm.Rotation:=AAngle
            else if (AAngle>=270) then Fm.Rotation:=360-AAngle+90;
          end;

          if FUseUnicode then w:= AdvStringGrid.WideCells[cg, rg] else
            w:= AdvStringGrid.Cells[cg, rg];

          //Cell Align
          case HA of
            taLeftJustify: Fm.HAlignment:=fha_left;
            taCenter:Fm.HAlignment:=fha_center;
            taRightJustify: Fm.HAlignment:=fha_right;
            else Fm.HAlignment:=fha_general;
          end;//case

          case VA of
            vtaTop: Fm.VAlignment:=fva_top;
            vtaCenter: Fm.VAlignment:=fva_center;
            else Fm.VAlignment:=fva_bottom ;
          end; //case

          if FKeepExcelCellFormat then
          begin
            aDateFormat:=FDateFormat;
            aTimeFormat:=FTimeFormat;
            if Assigned(OnDateTimeFormat) then
              OnDateTimeFormat(AdvStringGrid, cg, rg, cx, rx, w, aDateFormat, aTimeFormat);

            Workbook.SetCellString(rx, cx, w, Fm, aDateFormat, aTimeFormat);
          end else
          begin
            Workbook.CellValue[rx, cx]:=w;
            Workbook.CellFormat[rx, cx]:=Workbook.AddFormat(Fm);
          end;
        finally
          FreeAndNil(ABrush);
        end; //finally
      finally
        FreeAndNil(AFont);
      end; //finally

      //Export Images
      Pic:=AdvStringGrid.GetPicture(cg, rg);
      if Pic<>nil then
      begin
        ExportImage(Workbook, Pic, rx, cx, cg, rg);
      end;

    //Export Comments
    if AdvStringGrid.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;

    end;
  end;
end;


procedure TAdvGridExcelIO.XLSExport(const FileName: TFileName; const SheetName: widestring);
var
  Workbook: TExcelFile;
begin
  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;
    Workbook.NewFile;
    ExportData(Workbook);
    if SheetName<>'' then Workbook.ActiveSheetName:=SheetName;
    Workbook.Save(true, FileName, nil);
  finally
    CloseFile(Workbook);
  end;
end;

constructor TAdvGridExcelIO.Create(AOwner: TComponent);
begin
  inherited;
  FAutoResizeGrid := true;
  FLoadImages := true;

  FGridStartCol := 1;
  FGridStartRow := 1;
  FXlsStartCol := 1;
  FXlsStartRow := 1;

  FZoomSaved := true;
  FZoom := 100;
  FKeepExcelCellFormat := true;
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;

{$ENDIF}

end.