⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gridtoword.pas

📁 delphi 读 excel ,并生成各种文件。
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit GridToWord;

{***********************************************************************}
{*                                                                     *}
{*           Export Grid To Word VCL Control for D5 & D6               *}
{*        Copyright(C) Kingron 2002.8.2 All rights reserved            *}
{*            Bug Report: Kingron@163.net                              *}
{*                                                                     *}
{***********************************************************************}
{*                                                                     *}
{*          This is a Simple Version                                   *}
{*                                                                     *}
{***********************************************************************}
{*                                                                     *}
{* Install:                                                            *}
{*    Please Save as file GridToWord.pas then open the file            *}
{*    Click the menu item [Component] --> [Install Component]          *}
{*    Click [Install] button in the Install Component dialog           *}
{*    after install ,you can find the control at component             *}
{*    page [sample]                                                    *}
{*                                                                     *}
{***********************************************************************}
{*                                                                     *}
{* 安装:                                                              *}
{*   把附件保存,然后用Delphi打开这个GridToWord.Pas文件,              *}
{*   选择Delphi菜单--〉Component-->Install Component,                 *}
{*   然后选择Install即可。安装之后,在控件面板的Samples页面上面,      *}
{*   会有一个GridToWord控件,把它放到窗体上面,然后设置它的Grid        *}
{*   属性即可,此后,你就可以调用她的ExportToWord方法。就这么简单,    *}
{*   熟悉之后,你可以试着设置一些复杂的属性,其他的自己摸索吧,        *}
{*   如果不希望控件设置表格的属性,只希望有一个干净的Word表格,        *}
{*   请设置控件的TableFormat的Style为tfDefault即可。                   *}
{*   这样你会得到一个完全没有任何格式的表格。                          *}
{*                                                                     *}
{* 控件功能:                                                          *}
{*   能够现实进度条;                                                  *}
{*   提供事件支持(OnProgress);                                      *}
{*   能够自动设置表格格式(支持Word所支持的40多个预定义自动套用格式,   *}
{*          并且允许设置自动套用格式的应用范围);                     *}
{*   支持StringGrid和DBGrid;                                          *}
{*   能够设置字体、对齐方式等常见格式;                                *}
{*   支持表头、支持标题和表格主体,并且可以分别设置格式;              *}
{*                                                                     *}
{***********************************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Forms, DBGrids, Grids, Graphics, ComObj,
  ExtCtrls, Controls, StdCtrls, ComCtrls, DB,dxDBGrid;

const
  wdAutoFitContent  = 1;

resourcestring
  SPromptExport     = '请等待,正在导出数据……';
  SConnectWord      = '正在启动Word,请稍候……';
  SConnectWordError = '连接Word失败,可能没有安装Word。';
  SCancel           = '取消(&C)';
  SError            = '错误';
  SConfirm          = '真的要终止数据的导出吗?';
  SCaption          = '确认';
  SGridError        = '没有指定Grid,请指定Grid控件!';

type
  TWordAlignment = (waLeft, waCenter, waRight, waJustify, waDistribute,
    waJustifyMed, waJustifyHi, waJustifyLow);                      
  TTableAlignment = (tlLeft, tlCenter, tlRight);

  TTableFormatStyle = (tfNone, tfSimple1, tfSimple2, tfSimple3, tfClassic1, tfClassic2,
    tfClassic3, tfClassic4, tfColorful1, tfColorful2, tfColorful3, tfColumns1,
    tfColumns2, tfColumns3, tfColumns4, tfColumns5, tfGrid1, tfGrid2, tfGrid3, tfGrid4,
    tfGrid5, tfGrid6, tfGrid7, tfGrid8, tfList1, tfList2, tfList3, tfList4, tfList5,
    tfList6, tfList7, tfList8, tf3DEffects1, tf3DEffects2, tf3DEffects3, tfContemporary,
    tfElegant, tfProfessional, tfSubtle1, tfSubtle2, tfWeb1, tfWeb2, tfWeb3, tfDefault);

  TTableFormatOption = (tfoBorders, tfoShading, tfoFont, tfoColor,
    tfoHeadingRows, tfoLastRow, tfoFirstColumn, tfoLastColumn, tfoAutoFit);
  TTableFormatOptions = set of TTableFormatOption;

  TSaveFormat = (sfWord, sfTemplate, sfText, sfTextLineBreak, sfDOSText,
    sfDOSTextLineBreak, sfRTF, sfUnicodeText, sfHTML);

type
  TTableFormat = class(TPersistent)
  private
    FStyle: TTableFormatStyle;
    FOptions: TTableFormatOptions;
    FAlign: TTableAlignment;
  public
    constructor Create;
  published
    property Align: TTableAlignment read FAlign write FAlign;
    property Style: TTableFormatStyle read FStyle write FStyle;
    property Options: TTableFormatOptions read FOptions write FOptions;
  end;

type
  { Word Paragraph Format Object }
  TFormats = class(TPersistent)
  private
    FFont: TFont;
    FAlign: TWordAlignment;
    FUseFont: boolean;
    procedure SetFont(const Value: TFont);
  published
    property UseFont: boolean read FUseFont write FUseFont;
    property Align: TWordAlignment read FAlign write FAlign;
    property Font: TFont read FFont write SetFont;
  public
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  { Word Table Title Object }
  TTitle = class(TFormats)
  private
    FCaption: TCaption;
  public
    constructor Create; override;
  published
    property Caption: TCaption read FCaption write FCaption;
  end;

  { Word Table Body Format Object }
  TBody = class(TFormats);
  
  { Word Table Header Format Object }
  THeader = class(TFormats)
  public
    constructor Create; override;
  end;

  { Convert Grid To Word Table Object }
  TGridToWord = class(TComponent)
  private
    { Private declarations }
    ProgressForm: TForm;
    FShowProgress: boolean;
    WordApp: Variant;
    WordDoc: Variant;
    WordTable: Variant;
    FWordFileName: TFileName;
    FTitle: TTitle;
    FGrid: TCustomdxDBGrid;
    FOnProgress: TNotifyEvent;
    Quit: Boolean;

    ProgressBar: TProgressBar;
    Prompt: TLabel;
    FAutoExit: boolean;
    FBody: TBody;
    FTableFormat: TTableFormat;
    FHeader: THeader;
    FSaveFormat: TSaveFormat;
    FAutoSize: boolean;

    function GetRowCount: integer;
    function GetColCount: integer;
    function ConnectToWord: boolean; { Connect Word Application }
    procedure CreateProgressForm; { Create the Progress Form }
    procedure ButtonClick(Sender: TObject); { Cancel Button Click Event Handle }
    procedure SetFont(Selection: OleVariant; Font: TFont);

    procedure InsertTitle; { Insert Title }
    procedure InsertHeader(R, C: integer; Value: string);
    procedure InsertBody(R, C: integer; Value: string);
    procedure ExportStringGrid; { Export String Grid to Word }
    procedure ExportDBGrid; { Export DBGrid to Word }
    procedure SetFormat(Selection: Variant; Value: string; Formats: TFormats);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExportToWord; { Export Grid To Word }
  published
    { Published declarations }
    property AutoSize: boolean read FAutoSize write FAutoSize; { Auto Size }
    property AutoExit: boolean read FAutoExit write FAutoExit; { Auto close Word when done? }
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
    property Grid: TCustomdxDBGrid read FGrid write FGrid; { which Grid will be export? }
    property ShowProgress: boolean read FShowProgress write FShowProgress; { Show Progress? }
    property SaveFormat: TSaveFormat read FSaveFormat write FSaveFormat; { Save Format }
    property WordFileName: TFileName read FWordFileName write FWordFileName; { Word File Name }
    property Title: TTitle read FTitle write FTitle; { Title and Format }
    property Body: TBody read FBody write FBody; { Body Format }
    property Header: THeader read FHeader write FHeader; { Header Format }
    property TableFormat: TTableFormat read FTableFormat write FTableFormat;
  end;

procedure Register;

implementation

{ TMyGrid:Get Rows Count & Columns Count}
type
  TMyGrid = class(TCustomGrid)
  published
    property ColCount;
    property RowCount;
  end;

procedure Register;
begin
  RegisterComponents('Samples', [TGridToWord]);
end; { Register }

{ TGridToWord }

procedure TGridToWord.ButtonClick(Sender: TObject);
begin
  { Confirm for Button Cancel Click }
  Quit := MessageBox(ProgressForm.Handle, pchar(SConfirm), pchar(SCaption),
    MB_OKCANCEL + MB_ICONINFORMATION) = IDOK;
end; { TGridToWord.ButtonClick }

function TGridToWord.ConnectToWord: boolean;
begin
  Result := False;
  try
    WordApp := CreateOleObject('Word.Application');
    WordDoc := WordApp.Documents.Add;
    if Title.Caption <> '' then InsertTitle;
    WordTable := WordDoc.Tables.Add(WordApp.Selection.Range, GetRowCount, GetColCount);
    Result := True;
  except
    MessageBox(GetActiveWindow, pchar(SConnectWordError), pchar(SError), MB_OK +
      MB_ICONERROR);
  end;
end; { TGridToWord.ConnectToWord }

constructor TGridToWord.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowProgress := True;
  FAutoExit := False;
  FAutoSize := True;
  FSaveFormat := sfWord;

  FTitle := TTitle.Create;
  FTitle.Font.Assign(TForm(Owner).Font);

  FBody := TBody.Create;
  FBody.Font.Assign(FTitle.Font);

  FHeader := THeader.Create;
  FHeader.Font.Assign(FTitle.Font);
  
  FTableFormat := TTableFormat.Create;
end; { TGridToWord.Create }

procedure TGridToWord.CreateProgressForm;
var
  Panel             : TPanel;
  Button            : TButton;
begin
  if Assigned(ProgressForm) then exit; { Aleady Create? }

  ProgressForm := TForm.Create(Owner);
  with ProgressForm do { Create Progress Form }
  begin
    Font.Name := '宋体';
    Font.Size := 9;
    BorderStyle := bsNone;
    Width := 300;
    Height := 125;
    BorderWidth := 2;
    Color := clBlue;
    Position := poOwnerFormCenter;
  end;

  Panel := TPanel.Create(ProgressForm);
  with Panel do { Create Panel }
  begin
    Parent := ProgressForm;
    Align := alClient;
    BevelInner := bvNone;
    BevelOuter := bvRaised;
    Caption := '';

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -