home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Demos / Activex / Oleauto / SrvComp / PowerPoint / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  5.0 KB  |  184 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, msppt8, OleServer, DBCtrls, ExtCtrls, Grids, DBGrids, Db,
  8.   DBTables, office97, ComCtrls, ToolWin;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     PowerPointApplication1: TPowerPointApplication;
  13.     PowerPointSlide1: TPowerPointSlide;
  14.     PowerPointPresentation1: TPowerPointPresentation;
  15.     Table1: TTable;
  16.     DataSource1: TDataSource;
  17.     DBGrid1: TDBGrid;
  18.     DBNavigator1: TDBNavigator;
  19.     DBImage1: TDBImage;
  20.     ToolBar1: TToolBar;
  21.     RunSlideShow: TToolButton;
  22.     AddPresentation: TToolButton;
  23.     ClosePPoint: TToolButton;
  24.     StartPPoint: TToolButton;
  25.     TV1: TTreeView;
  26.     Label1: TLabel;
  27.     AddSlide: TToolButton;
  28.     procedure Form1Activate(Sender: TObject);
  29.     procedure Form1Close(Sender: TObject; var Action: TCloseAction);
  30.     procedure RunSlideShowClick(Sender: TObject);
  31.     procedure AddPresentationClick(Sender: TObject);
  32.     procedure ClosePPointClick(Sender: TObject);
  33.     procedure StartPPointClick(Sender: TObject);
  34.     procedure AddSlideClick(Sender: TObject);
  35.   private
  36.     SWindow:SlideShowWindow;
  37.     TN:TTreeNode;
  38.     { Private declarations }
  39.   public
  40.     { Public declarations }
  41.   end;
  42.  
  43. var
  44.   Form1: TForm1;
  45.  
  46. implementation
  47.  
  48. {$R *.DFM}
  49.  
  50. procedure TForm1.Form1Activate(Sender: TObject);
  51. begin
  52.   Table1.Open;
  53.   TN := nil;
  54. end;
  55.  
  56. procedure TForm1.Form1Close(Sender: TObject; var Action: TCloseAction);
  57. begin
  58.   Table1.Close;
  59. end;
  60.  
  61. procedure TForm1.RunSlideShowClick(Sender: TObject);
  62. var
  63.   i: Integer;
  64.   Found: Boolean;
  65.   
  66. begin
  67.   Found := False;
  68.   if (PowerPointApplication1.Presentations.Count > 0) and (TN <> nil) then
  69.   begin
  70.     for i := 1 to PowerPointApplication1.Presentations.Count do
  71.     begin
  72.       TN := TV1.Selected;
  73.       {Get Parent node to find Presentation name in case a slide is selected}
  74.       if TN.GetPrev <> nil then
  75.         TN := TN.Parent;
  76.  
  77.       if PowerPointApplication1.Presentations.Item(i).Name = TN.Text then
  78.       begin
  79.         Found := True;
  80.         Break;
  81.       end;
  82.     end;
  83.     if Found then
  84.     begin
  85.       PowerPointPresentation1.ConnectTo(PowerPointApplication1.Presentations.Item(i));
  86.       with PowerPointPresentation1 do
  87.       begin
  88.         SlideShowSettings.AdvanceMode := ppSlideShowUseSlideTimings;
  89.         SlideShowSettings.LoopUntilStopped := msoTrue;
  90.         SWindow := SlideShowSettings.Run;
  91.         Form1.SetFocus;
  92.       end;
  93.     end
  94.     else
  95.       ShowMessage('Presentation ' + TN.Text + ' not found');
  96.   end
  97.   else
  98.     Showmessage('No Presentations available');
  99. end;
  100.  
  101. procedure TForm1.AddPresentationClick(Sender: TObject);
  102. begin
  103.   try
  104.     AddSlide.Enabled := True;
  105.     PowerPointPresentation1.ConnectTo(PowerPointApplication1.Presentations.Add(1));
  106.     TN := TV1.Items.Insert(TN, PowerPointPresentation1.Name);
  107.     TN.Selected := True;
  108.     TV1.SetFocus;
  109.   except
  110.     on E: Exception do
  111.       begin
  112.         Showmessage(E.Message);
  113.       end;
  114.   end;
  115. end;
  116.  
  117.  
  118. procedure TForm1.ClosePPointClick(Sender: TObject);
  119. begin
  120.   PowerPointApplication1.Quit;
  121.   PowerPointApplication1.Disconnect;
  122. end;
  123.  
  124. procedure TForm1.StartPPointClick(Sender: TObject);
  125. begin
  126.   try
  127.     try
  128.       PowerPointApplication1.Connect;
  129.     except on E: Exception do
  130.       begin
  131.         E.Message := 'PowerPoint does not appear to be installed';
  132.         raise;
  133.       end;
  134.     end;
  135.     PowerPointApplication1.Visible := 1;
  136.     AddPresentation.Enabled := True;
  137.     ClosePPoint.Enabled := True;
  138.     Form1.SetFocus;
  139.   except
  140.     on E: Exception do
  141.       begin
  142.         Showmessage(E.Message);
  143.         PowerPointApplication1.Disconnect;
  144.       end;
  145.   end;
  146. end;
  147.  
  148. procedure TForm1.AddSlideClick(Sender: TObject);
  149. begin
  150.   PowerPointSlide1.ConnectTo(PowerPointPresentation1.Slides.Add(PowerPointPresentation1.Slides.Count + 1, 1));
  151.  
  152.   with PowerPointSlide1 do
  153.   begin
  154.     RunSlideShow.Enabled := True;
  155.     {Select layout where a bitmap is in the left corner}
  156.     Layout := 10;
  157.     {Set background}
  158.     FollowMasterBackground := 0;
  159.     Background.Fill.PresetGradient(2, 2, 10);
  160.     {Set text}
  161.     Shapes.Item(1).TextFrame.TextRange.InsertAfter(Table1.Fieldbyname('Common_Name').AsString);
  162.     Shapes.Item(2).TextFrame.TextRange.Font.Name := 'Arial';
  163.     Shapes.Item(2).TextFrame.TextRange.InsertAfter('Category    : ' + Table1.FieldByName('Category').AsString + #13 +
  164.                                                    'Species Name: ' + Table1.FieldByName('Species Name').AsString);
  165.     {Add Image}
  166.     DbImage1.CopyToClipboard;
  167.     Shapes.Item(3).Delete;
  168.     Shapes.Paste;
  169.     Shapes.Item(3).Left := 100;
  170.     Shapes.Item(3).Top := 180;
  171.     Shapes.Item(3).Width := 150;
  172.     Shapes.Item(3).Height := 150;
  173.     {Set time displayed for each slide}
  174.     SlideShowTransition.AdvanceOnTime := 1;
  175.     SlideShowTransition.AdvanceTime := 2;
  176.     Name := Table1.FieldByName('Common_Name').AsString + (IntToStr(PowerPointPresentation1.Slides.Count));
  177.     TV1.Items.AddChild(TN, Name);
  178.     TN.Selected;
  179.     TV1.SetFocus;
  180.   end;
  181. end;
  182.  
  183. end.
  184.