home *** CD-ROM | disk | FTP | other *** search
/ PC Expert 29 / Pce29cd.iso / RUNIMAGE / DELPHI40 / DEMOS / COOLSTUF / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-06-16  |  7KB  |  286 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.   NMHTML, ActnList, ImgList;
  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.     DocumentSource1: TMenuItem;
  21.     NavigatorImages: TImageList;
  22.     NavigatorHotImages: TImageList;
  23.     LinksImages: TImageList;
  24.     LinksHotImages: TImageList;
  25.     CoolBar1: TCoolBar;
  26.     ToolBar1: TToolBar;
  27.     BackBtn: TToolButton;
  28.     ForwardBtn: TToolButton;
  29.     StopBtn: TToolButton;
  30.     RefreshBtn: TToolButton;
  31.     ToolBar2: TToolBar;
  32.     ToolButton6: TToolButton;
  33.     ToolButton5: TToolButton;
  34.     ToolButton7: TToolButton;
  35.     ToolButton8: TToolButton;
  36.     Animate1: TAnimate;
  37.     URLs: TComboBox;
  38.     HTML1: THTML;
  39.     Help1: TMenuItem;
  40.     About1: TMenuItem;
  41.     N1: TMenuItem;
  42.     Toolbar3: TMenuItem;
  43.     Statusbar2: TMenuItem;
  44.     Go1: TMenuItem;
  45.     Back1: TMenuItem;
  46.     Forward1: TMenuItem;
  47.     Stop1: TMenuItem;
  48.     Refresh1: TMenuItem;
  49.     N2: TMenuItem;
  50.     ActionList1: TActionList;
  51.     BackAction: TAction;
  52.     ForwardAction: TAction;
  53.     StopAction: TAction;
  54.     RefreshAction: TAction;
  55.     procedure Exit1Click(Sender: TObject);
  56.     procedure About1Click(Sender: TObject);
  57.     procedure DocumentSource1Click(Sender: TObject);
  58.     procedure StopClick(Sender: TObject);
  59.     procedure HTML1BeginRetrieval(Sender: TObject);
  60.     procedure HTML1EndRetrieval(Sender: TObject);
  61.     procedure URLsKeyDown(Sender: TObject; var Key: Word;
  62.       Shift: TShiftState);
  63.     procedure FormCreate(Sender: TObject);
  64.     procedure LinksClick(Sender: TObject);
  65.     procedure RefreshClick(Sender: TObject);
  66.     procedure BackClick(Sender: TObject);
  67.     procedure ForwardClick(Sender: TObject);
  68.     procedure FormDestroy(Sender: TObject);
  69.     procedure URLsClick(Sender: TObject);
  70.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  71.       Shift: TShiftState);
  72.     procedure Toolbar3Click(Sender: TObject);
  73.     procedure Statusbar2Click(Sender: TObject);
  74.     procedure HTML1DoRequestDoc(Sender: TObject; const URL: WideString;
  75.       Element: HTMLElement; DocInput: DocInput;
  76.       var EnableDefault: WordBool);
  77.     procedure BackActionUpdate(Sender: TObject);
  78.     procedure ForwardActionUpdate(Sender: TObject);
  79.   private
  80.     HistoryIndex: Integer;
  81.     HistoryList: TStringList;
  82.     UpdateCombo: Boolean;
  83.     procedure FindAddress;
  84.     procedure HomePageRequest(var message: tmessage); message CM_HOMEPAGEREQUEST;
  85.   end;
  86.  
  87. var
  88.   MainForm: TMainForm;
  89.  
  90. implementation
  91.  
  92. uses DocSrc, About;
  93.  
  94. {$R *.DFM}
  95.  
  96. procedure TMainForm.Exit1Click(Sender: TObject);
  97. begin
  98.   Close;
  99. end;
  100.  
  101. procedure TMainForm.FindAddress;
  102. begin
  103.   HTML1.RequestDoc(URLs.Text);
  104. end;
  105.  
  106. procedure TMainForm.About1Click(Sender: TObject);
  107. begin
  108.   ShowAboutBox;
  109. end;
  110.  
  111. procedure TMainForm.DocumentSource1Click(Sender: TObject);
  112. begin
  113.   with DocSourceFrm do
  114.   begin
  115.     Show;
  116.     Memo1.Lines.Clear;
  117.     Memo1.Lines.Add(AdjustLineBreaks(HTML1.SourceText));
  118.     Memo1.SelStart := 0;
  119.     SendMessage(Memo1.Handle, EM_ScrollCaret, 0, 0);
  120.   end;
  121. end;
  122.  
  123. procedure TMainForm.StopClick(Sender: TObject);
  124. begin
  125.   HTML1.Cancel('Cancel');
  126.   HTML1EndRetrieval(nil);
  127. end;
  128.  
  129. procedure TMainForm.HTML1BeginRetrieval(Sender: TObject);
  130. begin
  131.   { Turn the stop button dark red }
  132.   StopBtn.ImageIndex := 4;
  133.   { Play the avi from the first frame indefinitely }
  134.   Animate1.Active := True;
  135. end;
  136.  
  137. procedure TMainForm.HTML1EndRetrieval(Sender: TObject);
  138. begin
  139.   { Turn the stop button grey }
  140.   StopBtn.ImageIndex := 2;
  141.   { Stop the avi and show the first frame }
  142.   Animate1.Active := False;
  143. end;
  144.  
  145. procedure TMainForm.URLsKeyDown(Sender: TObject; var Key: Word;
  146.   Shift: TShiftState);
  147. begin
  148.   if Key = VK_Return then
  149.   begin
  150.     UpdateCombo := True;
  151.     FindAddress;
  152.   end;
  153. end;
  154.  
  155. procedure TMainForm.URLsClick(Sender: TObject);
  156. begin
  157.   UpdateCombo := True;
  158.   FindAddress;
  159. end;
  160.  
  161. procedure TMainForm.LinksClick(Sender: TObject);
  162. begin
  163.   if (Sender as TToolButton).Hint = '' then Exit;
  164.   URLs.Text := (Sender as TToolButton).Hint;
  165.   FindAddress;
  166. end;
  167.  
  168. procedure TMainForm.RefreshClick(Sender: TObject);
  169. begin
  170.   FindAddress;
  171. end;
  172.  
  173. procedure TMainForm.BackClick(Sender: TObject);
  174. begin
  175.   URLs.Text := HistoryList[HistoryIndex - 1];
  176.   FindAddress;
  177. end;
  178.  
  179. procedure TMainForm.ForwardClick(Sender: TObject);
  180. begin
  181.   URLs.Text := HistoryList[HistoryIndex + 1];
  182.   FindAddress;
  183. end;
  184.  
  185. procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  186.   Shift: TShiftState);
  187. begin
  188.   if Shift = [ssAlt] then
  189.     if (Key = VK_RIGHT) and ForwardBtn.Enabled then
  190.       ForwardBtn.Click
  191.     else if (Key = VK_LEFT) and BackBtn.Enabled then
  192.       BackBtn.Click;
  193. end;
  194.  
  195. procedure TMainForm.Toolbar3Click(Sender: TObject);
  196. begin
  197.   with Sender as TMenuItem do
  198.   begin
  199.     Checked := not Checked;
  200.     Coolbar1.Visible := Checked;
  201.   end;
  202. end;
  203.  
  204. procedure TMainForm.Statusbar2Click(Sender: TObject);
  205. begin
  206.   with Sender as TMenuItem do
  207.   begin
  208.     Checked := not Checked;
  209.     StatusBar1.Visible := Checked;
  210.   end;
  211. end;
  212.  
  213. procedure TMainForm.HomePageRequest(var Message: TMessage);
  214. begin
  215.   URLs.Text := 'http://www.inprise.com';
  216.   UpdateCombo := True;
  217.   FindAddress;
  218. end;
  219.  
  220. procedure TMainForm.FormCreate(Sender: TObject);
  221. begin
  222.   HistoryIndex := -1;
  223.   HistoryList := TStringList.Create;
  224.   { Load the animation from the AVI file in the startup directory.  An
  225.     alternative to this would be to create a .RES file including the cool.avi
  226.     as an AVI resource and use the ResName or ResId properties of Animate1 to
  227.     point to it. }
  228.   Animate1.FileName := ExtractFilePath(Application.ExeName) + 'cool.avi';
  229.   { Find the home page - needs to be posted because HTML control hasn't been
  230.     registered yet. }
  231.   PostMessage(Handle, CM_HOMEPAGEREQUEST, 0, 0);
  232. end;
  233.  
  234. procedure TMainForm.FormDestroy(Sender: TObject);
  235. begin
  236.   HistoryList.Free;
  237. end;
  238.  
  239. procedure TMainForm.HTML1DoRequestDoc(Sender: TObject;
  240.   const URL: WideString; Element: HTMLElement; DocInput: DocInput;
  241.   var EnableDefault: WordBool);
  242. var
  243.   NewIndex: Integer;
  244. begin
  245.   NewIndex := HistoryList.IndexOf(URL);
  246.   if NewIndex = -1 then
  247.   begin
  248.     { Remove entries in HistoryList between last address and current address }
  249.     if (HistoryIndex >= 0) and (HistoryIndex < HistoryList.Count - 1) then
  250.       while HistoryList.Count > HistoryIndex do
  251.         HistoryList.Delete(HistoryIndex);
  252.     HistoryIndex := HistoryList.Add(URL);
  253.   end
  254.   else
  255.     HistoryIndex := NewIndex;
  256.   if UpdateCombo then
  257.   begin
  258.     UpdateCombo := False;
  259.     NewIndex := URLs.Items.IndexOf(URL);
  260.     if NewIndex = -1 then
  261.       URLs.Items.Insert(0, URL)
  262.     else
  263.       URLs.Items.Move(NewIndex, 0);
  264.   end;
  265.   URLs.Text := URL;
  266.   Statusbar1.Panels[0].Text := URL;
  267. end;
  268.  
  269. procedure TMainForm.BackActionUpdate(Sender: TObject);
  270. begin
  271.   if HistoryList.Count > 0 then
  272.     BackAction.Enabled := HistoryIndex > 0
  273.  else
  274.     BackAction.Enabled := False;
  275. end;
  276.  
  277. procedure TMainForm.ForwardActionUpdate(Sender: TObject);
  278. begin
  279.   if HistoryList.Count > 0 then
  280.     ForwardAction.Enabled := HistoryIndex < HistoryList.Count - 1
  281.   else
  282.     ForwardAction.Enabled := False;
  283. end;
  284.  
  285. end.
  286.