Стартовый пул

2024-04-02 08:46:59 +03:00
parent fd57fffd3a
commit 3bb34d000b
5591 changed files with 3291734 additions and 0 deletions
--- a/SHDocVw/Example/~history/wbmain.pas;1
+++ b/SHDocVw/Example/~history/wbmain.pas;1
@@ -0,0 +1,138 @@
+unit wbmain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, SHDocVw, activexcontainer, Forms, Controls,
+  Graphics, Dialogs, StdCtrls, ExtCtrls, Buttons, LCLType;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Edit1: TEdit;
+    Label1: TLabel;
+    Panel1: TPanel;
+    Panel2: TPanel;
+    SpeedButton1: TSpeedButton;
+    SpeedButton2: TSpeedButton;
+    WebBrowser1: TWebBrowser;
+    procedure Button1Click(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
+    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure FormCreate(Sender: TObject);
+    procedure SpeedButton2Click(Sender: TObject);
+    procedure WebBrowser1BeforeNavigate2(Sender: TObject; pDisp: IDispatch;
+      var URL: OleVariant; var Flags: OleVariant;
+      var TargetFrameName: OleVariant; var PostData: OleVariant;
+      var Headers: OleVariant; var Cancel: WordBool);
+    procedure WebBrowser1NavigateError(Sender: TObject; pDisp: IDispatch;
+      var URL: OleVariant; var Frame: OleVariant; var StatusCode: OleVariant;
+      var Cancel: WordBool);
+    procedure WebBrowser1NewProcess(Sender: TObject; lCauseFlag: Integer;
+      pWB2: IDispatch; var Cancel: WordBool);
+    procedure WebBrowser1ProgressChange(Sender: TObject; Progress: Integer;
+      ProgressMax: Integer);
+    procedure WebBrowser1Resize(Sender: TObject);
+    procedure WebBrowser1SetPhishingFilterStatus(Sender: TObject;
+      PhishingFilterStatus: Integer);
+    procedure WebBrowser1StatusTextChange(Sender: TObject; Text_: WideString);
+    procedure WebBrowser1UpdatePageStatus(Sender: TObject; pDisp: IDispatch;
+      var nPage: OleVariant; var fDone: OleVariant);
+  private
+   { private declarations }
+  public
+    { public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject; pDisp: IDispatch;
+  var URL: OleVariant; var Flags: OleVariant; var TargetFrameName: OleVariant;
+  var PostData: OleVariant; var Headers: OleVariant; var Cancel: WordBool);
+begin
+
+end;
+
+procedure TForm1.WebBrowser1NavigateError(Sender: TObject; pDisp: IDispatch;
+  var URL: OleVariant; var Frame: OleVariant; var StatusCode: OleVariant;
+  var Cancel: WordBool);
+begin
+   StatusCode:=0;
+end;
+
+procedure TForm1.WebBrowser1NewProcess(Sender: TObject; lCauseFlag: Integer;
+  pWB2: IDispatch; var Cancel: WordBool);
+begin
+    Application.ProcessMessages;
+end;
+
+procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress: Integer;
+  ProgressMax: Integer);
+begin
+  Application.ProcessMessages;
+end;
+
+procedure TForm1.WebBrowser1Resize(Sender: TObject);
+begin
+  Application.ProcessMessages;
+end;
+
+procedure TForm1.WebBrowser1SetPhishingFilterStatus(Sender: TObject;
+  PhishingFilterStatus: Integer);
+begin
+
+end;
+
+procedure TForm1.WebBrowser1StatusTextChange(Sender: TObject; Text_: WideString
+  );
+begin
+  Label1.Caption:=UTF8Encode(Text_);
+    Application.ProcessMessages;
+end;
+
+procedure TForm1.WebBrowser1UpdatePageStatus(Sender: TObject; pDisp: IDispatch;
+  var nPage: OleVariant; var fDone: OleVariant);
+begin
+
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+begin
+  ShowMessage(WebBrowser1.LocationURL);
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  WebBrowser1.Navigate(Edit1.Text);
+end;
+
+procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
+  );
+begin
+  if Key=vk_return then Button1Click(self);
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Button1Click(self);
+end;
+
+
+procedure TForm1.SpeedButton2Click(Sender: TObject);
+begin
+  WebBrowser1.Refresh;
+end;
+
+end.
+