Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 20 - Project DBOffice

Project Structure

DBOffice.dpr
program DBOffice;

uses
  Forms,
  OfficeForm in 'OfficeForm.pas' {FormOff};

{$R *.RES}

begin
  Application.CreateForm(TFormOff, FormOff);
  Application.Run;
end.
OfficeForm.pas
unit OfficeForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics,
  Controls, Forms, DBCtrls, StdCtrls, DBTables,
  ExtCtrls, Mask, Db, Dialogs, Excel97, Word97,
  OleServer, Variants;

type
  TFormOff = class(TForm)
    DBEdit3: TDBEdit;
    Label3: TLabel;
    Label2: TLabel;
    DBEdit2: TDBEdit;
    DBEdit1: TDBEdit;
    Label1: TLabel;
    DBNavigator1: TDBNavigator;
    Table1: TTable;
    DataSource1: TDataSource;
    BtnWord: TButton;
    BtnExcel: TButton;
    SaveDialog1: TSaveDialog;
    ExcelApplication1: TExcelApplication;
    WordDocument1: TWordDocument;
    procedure BtnWordClick(Sender: TObject);
    procedure BtnExcelClick(Sender: TObject);
  end;

var
  FormOff: TFormOff;

implementation

{$R *.DFM}

uses
  ComObj, ActiveX;

procedure TFormOff.BtnWordClick(Sender: TObject);
var
  Bookmark: TBookmark;
  RangeW: Word97.Range;
  v1: Variant;
  ov1: OleVariant;
  Row1: Word97.Row;
begin
  WordDocument1.Activate;
  // insert title
  WordDocument1.Range.Text := 'American Capitals from ' + Table1.TableName;
  WordDocument1.Range.Font.Size := 14;
  // disable the UI
  Table1.DisableControls;
  try
    // store the current position
    Bookmark := Table1.GetBookmark;
    try
      // scan the database table
      Table1.First;
      while not Table1.EOF do
      begin
        // send the two fields
        WordDocument1.Range.InsertParagraphAfter;
        WordDocument1.Paragraphs.Last.Range.Text :=
          Table1.FieldByName ('Name').AsString + #9 +
          Table1.FieldByName ('Capital').AsString;
        Table1.Next;
      end;
    finally
      // go back to the bookmark and destroy it
      Table1.GotoBookmark (Bookmark);
      Table1.FreeBookmark (Bookmark);
    end;
  finally
    // re-enable the controls
    Table1.EnableControls;
  end;
  RangeW := WordDocument1.Content;
  v1 := RangeW;
  v1.ConvertToTable (#9, 19, 2);
  Row1 := WordDocument1.Tables.Item(1).Rows.Get_First;
  Row1.Range.Bold := 1;
  Row1.Range.Font.Size := 30;
  Row1.Range.InsertParagraphAfter;
  ov1 := ' ';
  Row1.ConvertToText (ov1);
end;

procedure TFormOff.BtnExcelClick(Sender: TObject);
var
  RangeE: Excel97.Range;
  I, Row: Integer;
  Bookmark: TBookmarkStr;
begin
  // create and show
  ExcelApplication1.Visible [0] := True;
  ExcelApplication1.Workbooks.Add (NULL, 0);
  // fill is the first row with field titles
  RangeE := ExcelApplication1.ActiveCell;
  for I := 0 to Table1.Fields.Count - 1 do
  begin
    RangeE.Value := Table1.Fields [I].DisplayLabel;
    RangeE := RangeE.Next;
  end;
  // add field data in following rows
  Table1.DisableControls;
  try
    Bookmark := Table1.Bookmark;
    try
      Table1.First;
      Row := 2;
      while not Table1.EOF do
      begin
        RangeE := ExcelApplication1.Range ['A' + IntToStr (Row),
          'A' + IntToStr (Row)];
        for I := 0 to Table1.Fields.Count - 1 do
        begin
          RangeE.Value := Table1.Fields [I].AsString;
          RangeE := RangeE.Next;
        end;
        Table1.Next;
        Inc (Row);
      end;
    finally
      Table1.Bookmark := Bookmark;
    end;
  finally
    Table1.EnableControls;
  end;
  // format the section
  RangeE := ExcelApplication1.Range ['A1', 'E' + IntToStr (Row - 1)];
  RangeE.AutoFormat (3, NULL, NULL, NULL, NULL, NULL, NULL);
end;

initialization
  CoInitialize (nil);
end.
OfficeForm.dfm
object FormOff: TFormOff
  Left = 187
  Top = 152
  Width = 414
  Height = 209
  Caption = 'DB Office'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label3: TLabel
    Left = 40
    Top = 124
    Width = 48
    Height = 13
    HelpType = htKeyword
    Caption = 'Continent:'
  end
  object Label2: TLabel
    Left = 40
    Top = 91
    Width = 35
    Height = 13
    HelpType = htKeyword
    Caption = 'Capital:'
  end
  object Label1: TLabel
    Left = 40
    Top = 56
    Width = 39
    Height = 13
    HelpType = htKeyword
    Caption = 'Country:'
  end
  object DBEdit3: TDBEdit
    Left = 104
    Top = 120
    Width = 169
    Height = 21
    DataField = 'Continent'
    DataSource = DataSource1
    TabOrder = 0
  end
  object DBEdit2: TDBEdit
    Left = 104
    Top = 86
    Width = 169
    Height = 21
    DataField = 'Capital'
    DataSource = DataSource1
    TabOrder = 1
  end
  object DBEdit1: TDBEdit
    Left = 104
    Top = 52
    Width = 169
    Height = 21
    DataField = 'Name'
    DataSource = DataSource1
    TabOrder = 2
  end
  object DBNavigator1: TDBNavigator
    Left = 0
    Top = 0
    Width = 406
    Height = 25
    DataSource = DataSource1
    VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbEdit, nbPost, nbCancel]
    Align = alTop
    Flat = True
    TabOrder = 3
  end
  object BtnWord: TButton
    Left = 296
    Top = 67
    Width = 89
    Height = 25
    Caption = '&Word Table'
    TabOrder = 4
    OnClick = BtnWordClick
  end
  object BtnExcel: TButton
    Left = 296
    Top = 104
    Width = 89
    Height = 25
    Caption = '&Excel Table'
    TabOrder = 5
    OnClick = BtnExcelClick
  end
  object Table1: TTable
    Active = True
    DatabaseName = 'DBDEMOS'
    TableName = 'COUNTRY.DB'
    Left = 16
    Top = 48
  end
  object DataSource1: TDataSource
    DataSet = Table1
    Left = 16
    Top = 96
  end
  object SaveDialog1: TSaveDialog
    DefaultExt = 'DOC'
    Filter = 'Word Document (*.doc)|*.doc|Any file (*.*)|*.*'
    Options = [ofPathMustExist, ofCreatePrompt]
    Left = 16
    Top = 136
  end
  object ExcelApplication1: TExcelApplication
    AutoConnect = False
    ConnectKind = ckRunningOrNew
    AutoQuit = False
    Left = 312
    Top = 32
  end
  object WordDocument1: TWordDocument
    AutoConnect = False
    ConnectKind = ckRunningOrNew
    Left = 312
    Top = 128
  end
end