home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / Coolstuf / main.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  7KB  |  272 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, Buttons, ToolWin, Isp3,
  8.   ActnList, ImgList, shdocvw;
  9.  
  10. const
  11.   CM_HOMEPAGEREQUEST = WM_USER + $1000;
  12.  
  13. type
  14.   TMainForm = class(TForm)
  15.     StatusBar1: TStatusBar;
  16.     MainMenu1: TMainMenu;
  17.     File1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     View1: TMenuItem;
  20.     NavigatorImages: TImageList;
  21.     NavigatorHotImages: TImageList;
  22.     LinksImages: TImageList;
  23.     LinksHotImages: TImageList;
  24.     CoolBar1: TCoolBar;
  25.     ToolBar1: TToolBar;
  26.     BackBtn: TToolButton;
  27.     ForwardBtn: TToolButton;
  28.     StopBtn: TToolButton;
  29.     RefreshBtn: TToolButton;
  30.     ToolBar2: TToolBar;
  31.     ToolButton6: TToolButton;
  32.     ToolButton5: TToolButton;
  33.     ToolButton7: TToolButton;
  34.     ToolButton8: TToolButton;
  35.     Animate1: TAnimate;
  36.     URLs: TComboBox;
  37.     Help1: TMenuItem;
  38.     About1: TMenuItem;
  39.     Toolbar3: TMenuItem;
  40.     Statusbar2: TMenuItem;
  41.     Go1: TMenuItem;
  42.     Back1: TMenuItem;
  43.     Forward1: TMenuItem;
  44.     Stop1: TMenuItem;
  45.     Refresh1: TMenuItem;
  46.     N2: TMenuItem;
  47.     ActionList1: TActionList;
  48.     BackAction: TAction;
  49.     ForwardAction: TAction;
  50.     StopAction: TAction;
  51.     RefreshAction: TAction;
  52.     WebBrowser1: TWebBrowser;
  53.     procedure Exit1Click(Sender: TObject);
  54.     procedure About1Click(Sender: TObject);
  55.     procedure StopClick(Sender: TObject);
  56.     procedure URLsKeyDown(Sender: TObject; var Key: Word;
  57.       Shift: TShiftState);
  58.     procedure FormCreate(Sender: TObject);
  59.     procedure LinksClick(Sender: TObject);
  60.     procedure RefreshClick(Sender: TObject);
  61.     procedure BackClick(Sender: TObject);
  62.     procedure ForwardClick(Sender: TObject);
  63.     procedure FormDestroy(Sender: TObject);
  64.     procedure URLsClick(Sender: TObject);
  65.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  66.       Shift: TShiftState);
  67.     procedure Toolbar3Click(Sender: TObject);
  68.     procedure Statusbar2Click(Sender: TObject);
  69.     procedure BackActionUpdate(Sender: TObject);
  70.     procedure ForwardActionUpdate(Sender: TObject);
  71.     procedure WebBrowser1BeforeNavigate2(Sender: TObject;
  72.       const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  73.       Headers: OleVariant; var Cancel: WordBool);
  74.     procedure WebBrowser1DownloadBegin(Sender: TObject);
  75.     procedure WebBrowser1DownloadComplete(Sender: TObject);
  76.   private
  77.     HistoryIndex: Integer;
  78.     HistoryList: TStringList;
  79.     UpdateCombo: Boolean;
  80.     procedure FindAddress;
  81.     procedure HomePageRequest(var message: tmessage); message CM_HOMEPAGEREQUEST;
  82.   end;
  83.  
  84. var
  85.   MainForm: TMainForm;
  86.  
  87. implementation
  88.  
  89. uses About;
  90.  
  91. {$R *.DFM}
  92.  
  93. procedure TMainForm.Exit1Click(Sender: TObject);
  94. begin
  95.   Close;
  96. end;
  97.  
  98. procedure TMainForm.FindAddress;
  99. var
  100.   Flags: OLEVariant;
  101.  
  102. begin
  103.   Flags := 0;
  104.   UpdateCombo := True;
  105.   WebBrowser1.Navigate(WideString(Urls.Text), Flags, Flags, Flags, Flags);
  106. end;
  107.  
  108. procedure TMainForm.About1Click(Sender: TObject);
  109. begin
  110.   ShowAboutBox;
  111. end;
  112.  
  113. procedure TMainForm.StopClick(Sender: TObject);
  114. begin
  115.   WebBrowser1.Stop;
  116. end;
  117.  
  118. procedure TMainForm.URLsKeyDown(Sender: TObject; var Key: Word;
  119.   Shift: TShiftState);
  120. begin
  121.   if Key = VK_Return then
  122.   begin
  123.     FindAddress;
  124.   end;
  125. end;
  126.  
  127. procedure TMainForm.URLsClick(Sender: TObject);
  128. begin
  129.   FindAddress;
  130. end;
  131.  
  132. procedure TMainForm.LinksClick(Sender: TObject);
  133. begin
  134.   if (Sender as TToolButton).Hint = '' then Exit;
  135.   URLs.Text := (Sender as TToolButton).Hint;
  136.   FindAddress;
  137. end;
  138.  
  139. procedure TMainForm.RefreshClick(Sender: TObject);
  140. begin
  141.   FindAddress;
  142. end;
  143.  
  144. procedure TMainForm.BackClick(Sender: TObject);
  145. begin
  146.   URLs.Text := HistoryList[HistoryIndex - 1];
  147.   FindAddress;
  148. end;
  149.  
  150. procedure TMainForm.ForwardClick(Sender: TObject);
  151. begin
  152.   URLs.Text := HistoryList[HistoryIndex + 1];
  153.   FindAddress;
  154. end;
  155.  
  156. procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  157.   Shift: TShiftState);
  158. begin
  159.   if Shift = [ssAlt] then
  160.     if (Key = VK_RIGHT) and ForwardBtn.Enabled then
  161.       ForwardBtn.Click
  162.     else if (Key = VK_LEFT) and BackBtn.Enabled then
  163.       BackBtn.Click;
  164. end;
  165.  
  166. procedure TMainForm.Toolbar3Click(Sender: TObject);
  167. begin
  168.   with Sender as TMenuItem do
  169.   begin
  170.     Checked := not Checked;
  171.     Coolbar1.Visible := Checked;
  172.   end;
  173. end;
  174.  
  175. procedure TMainForm.Statusbar2Click(Sender: TObject);
  176. begin
  177.   with Sender as TMenuItem do
  178.   begin
  179.     Checked := not Checked;
  180.     StatusBar1.Visible := Checked;
  181.   end;
  182. end;
  183.  
  184. procedure TMainForm.HomePageRequest(var Message: TMessage);
  185. begin
  186.   URLs.Text := 'http://www.borland.com';
  187.   FindAddress;
  188. end;
  189.  
  190. procedure TMainForm.FormCreate(Sender: TObject);
  191. begin
  192.   HistoryIndex := -1;
  193.   HistoryList := TStringList.Create;
  194.   { Load the animation from the AVI file in the startup directory.  An
  195.     alternative to this would be to create a .RES file including the cool.avi
  196.     as an AVI resource and use the ResName or ResId properties of Animate1 to
  197.     point to it. }
  198.   Animate1.FileName := ExtractFilePath(Application.ExeName) + 'cool.avi';
  199.   { Find the home page - needs to be posted because HTML control hasn't been
  200.     registered yet. }
  201.   PostMessage(Handle, CM_HOMEPAGEREQUEST, 0, 0);
  202. end;
  203.  
  204. procedure TMainForm.FormDestroy(Sender: TObject);
  205. begin
  206.   HistoryList.Free;
  207. end;
  208.  
  209. procedure TMainForm.BackActionUpdate(Sender: TObject);
  210. begin
  211.   if HistoryList.Count > 0 then
  212.     BackAction.Enabled := HistoryIndex > 0
  213.  else
  214.     BackAction.Enabled := False;
  215. end;
  216.  
  217. procedure TMainForm.ForwardActionUpdate(Sender: TObject);
  218. begin
  219.   if HistoryList.Count > 0 then
  220.     ForwardAction.Enabled := HistoryIndex < HistoryList.Count - 1
  221.   else
  222.     ForwardAction.Enabled := False;
  223. end;
  224.  
  225. procedure TMainForm.WebBrowser1BeforeNavigate2(Sender: TObject;
  226.   const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  227.   Headers: OleVariant; var Cancel: WordBool);
  228. var
  229.   NewIndex: Integer;
  230. begin
  231.   NewIndex := HistoryList.IndexOf(URL);
  232.   if NewIndex = -1 then
  233.   begin
  234.     { Remove entries in HistoryList between last address and current address }
  235.     if (HistoryIndex >= 0) and (HistoryIndex < HistoryList.Count - 1) then
  236.       while HistoryList.Count > HistoryIndex do
  237.         HistoryList.Delete(HistoryIndex);
  238.     HistoryIndex := HistoryList.Add(URL);
  239.   end
  240.   else
  241.     HistoryIndex := NewIndex;
  242.   if UpdateCombo then
  243.   begin
  244.     UpdateCombo := False;
  245.     NewIndex := URLs.Items.IndexOf(URL);
  246.     if NewIndex = -1 then
  247.       URLs.Items.Insert(0, URL)
  248.     else
  249.       URLs.Items.Move(NewIndex, 0);
  250.   end;
  251.   URLs.Text := URL;
  252.   Statusbar1.Panels[0].Text := URL;
  253. end;
  254.  
  255. procedure TMainForm.WebBrowser1DownloadBegin(Sender: TObject);
  256. begin
  257.   { Turn the stop button dark red }
  258.   StopBtn.ImageIndex := 4;
  259.   { Play the avi from the first frame indefinitely }
  260.   Animate1.Active := True;
  261. end;
  262.  
  263. procedure TMainForm.WebBrowser1DownloadComplete(Sender: TObject);
  264. begin
  265.   { Turn the stop button grey }
  266.   StopBtn.ImageIndex := 2;
  267.   { Stop the avi and show the first frame }
  268.   Animate1.Active := False;
  269. end;
  270.  
  271. end.
  272.