home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Demos / Activex / Oleauto / SrvComp / Word / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  5.2 KB  |  183 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls, Db, DBTables, OleServer,
  8.   Word97, clipbrd;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     DataSource: TDataSource;
  13.     DBGrid: TDBGrid;
  14.     DBNavigator: TDBNavigator;
  15.     WordDocument: TWordDocument;
  16.     DBImgFishImg: TDBImage;
  17.     Table: TTable;
  18.     BtnInsertRecord: TButton;
  19.     WordApplication: TWordApplication;
  20.     WordFont: TWordFont;
  21.     ChkBoxNewDoc: TCheckBox;
  22.     GroupBox: TGroupBox;
  23.     lblFont: TLabel;
  24.     Fonttype: TListBox;
  25.     ChkBoxEmboss: TCheckBox;
  26.     ChkBoxItalic: TCheckBox;
  27.     ChkBoxBold: TCheckBox;
  28.     ChkBoxUnderline: TCheckBox;
  29.     ChkBoxEngrave: TCheckBox;
  30.     ChkBoxShadow: TCheckBox;
  31.     ChkBoxDoublestrike: TCheckBox;
  32.     ChkBoxStrike: TCheckBox;
  33.     Size: TEdit;
  34.     lblFontSize: TLabel;
  35.     btnCloseWord: TButton;
  36.     BtnPrint: TButton;
  37.     BtnPreview: TButton;
  38.     GroupBox2: TGroupBox;
  39.     lbDocs: TListBox;
  40.     procedure BtnInsertRecordClick(Sender: TObject);
  41.     procedure Form1Close(Sender: TObject; var Action: TCloseAction);
  42.     procedure Form1Create(Sender: TObject);
  43.     procedure Form1Activate(Sender: TObject);
  44.     procedure btnCloseWordClick(Sender: TObject);
  45.     procedure BtnPrintClick(Sender: TObject);
  46.     procedure BtnPreviewClick(Sender: TObject);
  47.     procedure WordApplicationDocumentChange(Sender: TObject);
  48.   private
  49.     { Private declarations }
  50.   public
  51.     { Public declarations }
  52.   end;
  53.  
  54. var
  55.   MainForm: TMainForm;
  56.  
  57. implementation
  58.  
  59. {$R *.DFM}
  60.  
  61. procedure TMainForm.BtnInsertRecordClick(Sender: TObject);
  62. var Template,NewTemplate,ItemIndex:OleVariant;
  63.  
  64.     procedure setfont;
  65.     begin
  66.       WordFont.ConnectTo(WordDocument.Sentences.Get_Last.Font);
  67.       if ChkBoxUnderline.checked then WordFont.Underline := 2;
  68.       if ChkBoxBold.checked then WordFont.Bold := 1;
  69.       if ChkBoxItalic.Checked then WordFont.Italic := 1;
  70.       if ChkBoxEmboss.Checked then WordFont.Emboss := 1;
  71.       if ChkBoxEngrave.checked then WordFont.Engrave := 1;
  72.       if ChkBoxShadow.checked then WordFont.shadow := 1;
  73.       if ChkBoxDoublestrike.checked then WordFont.DoubleStrikeThrough := 1;
  74.       if ChkBoxStrike.checked then WordFont.StrikeThrough := 1;
  75.       WordFont.Size := StrToInt(Size.text);
  76.       if Fonttype.Itemindex >= 0 then
  77.          WordFont.Name := FontType.Items[FontType.Itemindex];
  78.     end;
  79.  
  80. begin
  81.   try
  82.     Template := EmptyParam;
  83.     NewTemplate := True;
  84.     ItemIndex := 1;
  85.     try
  86.       Wordapplication.Connect;
  87.     except
  88.       MessageDlg('Word may not be installed', mtError, [mbOk], 0);
  89.       Abort;
  90.     end;
  91.     Wordapplication.Visible := True;
  92.     WordApplication.Caption := 'Delphi automation';
  93.     {Create new document}
  94.     Template := EmptyParam;
  95.     NewTemplate := False;
  96.     if ChkBoxNewDoc.Checked then
  97.     begin
  98.       WordApplication.Documents.Add(Template, NewTemplate);
  99.       {Assign WordDocument component}
  100.       WordDocument.ConnectTo(WordApplication.Documents.Item(ItemIndex));
  101.     end;
  102.     {Turn Spell checking of because it takes a long time if enabled and slows down Winword}
  103.     WordApplication.Options.CheckSpellingAsYouType := False;
  104.     WordApplication.Options.CheckGrammarAsYouType := False;
  105.     {Insert data}
  106.     DBImgFishImg.CopyToClipboard;
  107.     WordDocument.Sentences.Last.Paste;
  108.     WordDocument.Range.InsertAfter('Common Name: ' + Table.Fields.Fields[2].AsString + #13);
  109.     SetFont;
  110.     WordDocument.Range.InsertAfter('Species Name:' + Table.Fields.Fields[3].AsString + #13);
  111.     WordDocument.Range.InsertAfter('Length: ' + Table.Fields.Fields[4].AsString + #13);
  112.     WordDocument.Range.InsertAfter(' ' + #13);
  113.     WordDocument.Range.InsertAfter(' ' + #13);
  114.     WordDocument.Range.InsertAfter(' ' + #13);
  115.     BtnCloseWord.Enabled := True;
  116.     BtnPrint.Enabled := True;
  117.     BtnPreview.Enabled := True;
  118.   except
  119.     on E: Exception do
  120.     begin
  121.       ShowMessage(E.Message);
  122.       WordApplication.Disconnect;
  123.     end;
  124.   end;
  125. end;
  126.  
  127. procedure TMainForm.Form1Close(Sender: TObject; var Action: TCloseAction);
  128. begin
  129.   Table.Close;
  130. end;
  131.  
  132. procedure TMainForm.Form1Create(Sender: TObject);
  133. begin
  134.   Fonttype.Items := Screen.Fonts;
  135. end;
  136.  
  137. procedure TMainForm.Form1Activate(Sender: TObject);
  138. begin
  139.   Table.Open;
  140. end;
  141.  
  142. procedure TMainForm.btnCloseWordClick(Sender: TObject);
  143. var
  144.   SaveChanges,
  145.   OriginalFormat,
  146.   RouteDocument: OleVariant;
  147.   
  148. begin
  149.   SaveChanges := WdDoNotSaveChanges;
  150.   OriginalFormat := UnAssigned;
  151.   RouteDocument := UnAssigned;
  152.   try
  153.     WordApplication.Quit(SaveChanges, OriginalFormat, RouteDocument);
  154.     WordApplication.Disconnect;
  155.     BtnCloseWord.Enabled := False;
  156.     BtnPrint.Enabled := False;
  157.     BtnPreview.Enabled := False;
  158.   except
  159.     on E: Exception do
  160.     begin
  161.       Showmessage(E.Message);
  162.       WordApplication.Disconnect;
  163.     end;
  164.   end;
  165. end;
  166.  
  167. procedure TMainForm.BtnPrintClick(Sender: TObject);
  168. begin
  169.   WordDocument.PrintOut;
  170. end;
  171.  
  172. procedure TMainForm.BtnPreviewClick(Sender: TObject);
  173. begin
  174.   WordDocument.PrintPreview;
  175. end;
  176.  
  177. procedure TMainForm.WordApplicationDocumentChange(Sender: TObject);
  178. begin
  179.   lbDocs.items.add(WordDocument.Name);
  180. end;
  181.  
  182. end.
  183.