units/webbrowser/mckWebBrowser.pas

   1 //////////////////////////////////////////////////////////////////////////////////
   2 //                                                                              //
   3 //                                                                              //
   4 //              TKOLWebBrowser v1.0                                             //
   5 //                                                                              //
   6 //      Author: Dimaxx (dimaxx@atnet.ru)                                        //
   7 //                                                                              //
   8 //                                                                              //
   9 //////////////////////////////////////////////////////////////////////////////////
  10
  11 unit mckWebBrowser;
  12
  13 interface
  14
  15 uses Classes, Kol, Mirror;
  16
  17 type
  18   TWebBrowserStatusTextChange = procedure(Sender: TObject; const Text: WideString) of object;
  19   TWebBrowserProgressChange = procedure(Sender: TObject; Progress: Integer; ProgressMax: Integer) of object;
  20   TWebBrowserCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object;
  21   TWebBrowserTitleChange = procedure(Sender: TObject; const Text: WideString) of object;
  22   TWebBrowserPropertyChange = procedure(Sender: TObject; const szProperty: WideString) of object;
  23   TWebBrowserBeforeNavigate2 = procedure(Sender: TObject; const pDisp: IDispatch;
  24                                                           var URL: OleVariant;
  25                                                           var Flags: OleVariant;
  26                                                           var TargetFrameName: OleVariant;
  27                                                           var PostData: OleVariant;
  28                                                           var Headers: OleVariant;
  29                                                           var Cancel: WordBool) of object;
  30   TWebBrowserNewWindow2 = procedure(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool) of object;
  31   TWebBrowserNavigateComplete2 = procedure(Sender: TObject; const pDisp: IDispatch;
  32                                                             var URL: OleVariant) of object;
  33   TWebBrowserDocumentComplete = procedure(Sender: TObject; const pDisp: IDispatch;
  34                                                            var URL: OleVariant) of object;
  35   TWebBrowserOnVisible = procedure(Sender: TObject; Visible: WordBool) of object;
  36   TWebBrowserOnToolBar = procedure(Sender: TObject; ToolBar: WordBool) of object;
  37   TWebBrowserOnMenuBar = procedure(Sender: TObject; MenuBar: WordBool) of object;
  38   TWebBrowserOnStatusBar = procedure(Sender: TObject; StatusBar: WordBool) of object;
  39   TWebBrowserOnFullScreen = procedure(Sender: TObject; FullScreen: WordBool) of object;
  40   TWebBrowserOnTheaterMode = procedure(Sender: TObject; TheaterMode: WordBool) of object;
  41
  42   TKOLWebBrowser = class(TKOLCustomControl)
  43   private
  44     FOnStatusTextChange: TWebBrowserStatusTextChange;
  45     FOnProgressChange: TWebBrowserProgressChange;
  46     FOnCommandStateChange: TWebBrowserCommandStateChange;
  47     FOnTitleChange: TWebBrowserTitleChange;
  48     FOnPropertyChange: TWebBrowserPropertyChange;
  49     FOnBeforeNavigate2: TWebBrowserBeforeNavigate2;
  50     FOnNewWindow2: TWebBrowserNewWindow2;
  51     FOnNavigateComplete2: TWebBrowserNavigateComplete2;
  52     FOnDocumentComplete: TWebBrowserDocumentComplete;
  53     FOnVisible: TWebBrowserOnVisible;
  54     FOnToolBar: TWebBrowserOnToolBar;
  55     FOnMenuBar: TWebBrowserOnMenuBar;
  56     FOnStatusBar: TWebBrowserOnStatusBar;
  57     FOnFullScreen: TWebBrowserOnFullScreen;
  58     FOnTheaterMode: TWebBrowserOnTheaterMode;
  59
  60     FOffline: boolean;
  61     FSilent: boolean;
  62     FRegisterAsBrowser: boolean;
  63     FRegisterAsDropTarget: boolean;
  64   protected
  65     function AdditionalUnits: string; override;
  66     procedure SetupFirst(SL: TStringList; const AName,AParent,Prefix: string); override;
  67     procedure AssignEvents(SL: TStringList; const AName: string); override;
  68     procedure SetOnStatusTextChange(E: TWebBrowserStatusTextChange);
  69     procedure SetOnProgressChange(E: TWebBrowserProgressChange);
  70     procedure SetOnCommandStateChange(E: TWebBrowserCommandStateChange);
  71     procedure SetOnTitleChange(E: TWebBrowserTitleChange);
  72     procedure SetOnPropertyChange(E: TWebBrowserPropertyChange);
  73     procedure SetOnBeforeNavigate2(E: TWebBrowserBeforeNavigate2);
  74     procedure SetOnNewWindow2(E: TWebBrowserNewWindow2);
  75     procedure SetOnNavigateComplete2(E: TWebBrowserNavigateComplete2);
  76     procedure SetOnDocumentComplete(E: TWebBrowserDocumentComplete);
  77     procedure SetOnVisible(E: TWebBrowserOnVisible);
  78     procedure SetOnToolBar(E: TWebBrowserOnToolBar);
  79     procedure SetOnMenuBar(E: TWebBrowserOnMenuBar);
  80     procedure SetOnStatusBar(E: TWebBrowserOnStatusBar);
  81     procedure SetOnFullScreen(E: TWebBrowserOnFullScreen);
  82     procedure SetOnTheaterMode(E: TWebBrowserOnTheaterMode);
  83
  84     procedure SetOffline(V: boolean);
  85     procedure SetSilent(V: boolean);
  86     procedure SetRegisterAsBrowser(V: boolean);
  87     procedure SetRegisterAsDropTarget(V: boolean);
  88   public
  89     constructor Create(AOwner: TComponent); override;
  90   published
  91     property Align;
  92     property Visible;
  93     property TabStop;
  94     property TabOrder;
  95     property OnEnter;
  96     property OnExit;
  97
  98     property Offline: boolean read FOffline write SetOffline default True;
  99     property Silent: boolean read FSilent write SetSilent default False;
 100     property RegisterAsBrowser: boolean read FRegisterAsBrowser write SetRegisterAsBrowser default True;
 101     property RegisterAsDropTarget: boolean read FRegisterAsDropTarget write SetRegisterAsDropTarget default False;
 102
 103     property OnStatusTextChange: TWebBrowserStatusTextChange read FOnStatusTextChange write SetOnStatusTextChange;
 104     property OnProgressChange: TWebBrowserProgressChange read FOnProgressChange write SetOnProgressChange;
 105     property OnCommandStateChange: TWebBrowserCommandStateChange read FOnCommandStateChange write SetOnCommandStateChange;
 106     property OnTitleChange: TWebBrowserTitleChange read FOnTitleChange write SetOnTitleChange;
 107     property OnPropertyChange: TWebBrowserPropertyChange read FOnPropertyChange write SetOnPropertyChange;
 108     property OnBeforeNavigate2: TWebBrowserBeforeNavigate2 read FOnBeforeNavigate2 write SetOnBeforeNavigate2;
 109     property OnNewWindow2: TWebBrowserNewWindow2 read FOnNewWindow2 write SetOnNewWindow2;
 110     property OnNavigateComplete2: TWebBrowserNavigateComplete2 read FOnNavigateComplete2 write SetOnNavigateComplete2;
 111     property OnDocumentComplete: TWebBrowserDocumentComplete read FOnDocumentComplete write SetOnDocumentComplete;
 112     property OnVisible: TWebBrowserOnVisible read FOnVisible write SetOnVisible;
 113     property OnToolBar: TWebBrowserOnToolBar read FOnToolBar write SetOnToolBar;
 114     property OnMenuBar: TWebBrowserOnMenuBar read FOnMenuBar write SetOnMenuBar;
 115     property OnStatusBar: TWebBrowserOnStatusBar read FOnStatusBar write SetOnStatusBar;
 116     property OnFullScreen: TWebBrowserOnFullScreen read FOnFullScreen write SetOnFullScreen;
 117     property OnTheaterMode: TWebBrowserOnTheaterMode read FOnTheaterMode write SetOnTheaterMode;
 118   end;
 119
 120   procedure Register;
 121
 122 {$R *.dcr}
 123
 124 implementation
 125
 126 const
 127   AlignValues: array[TKOLAlign] of string = ('caNone','caLeft','caTop','caRight','caBottom','caClient');
 128   Bool2Str: array [Boolean] of string = ('False','True');
 129
 130 procedure Register;
 131 begin
 132   RegisterComponents('KOL',[TKOLWebBrowser]);
 133 end;
 134
 135 constructor TKOLWebBrowser.Create;
 136 begin
 137   inherited;
 138   FOffline:=True;
 139   FSilent:=True;
 140   FRegisterAsBrowser:=True;
 141   FRegisterAsDropTarget:=False;
 142 end;
 143
 144 function TKOLWebBrowser.AdditionalUnits;
 145 begin
 146   Result:=', KOLWebBrowser';
 147 end;
 148
 149 procedure TKOLWebBrowser.SetupFirst;
 150 begin
 151   SL.Add(Prefix+AName+' := NewKOLWebBrowser(Result.Form); ');
 152   if Align<>caNone then
 153     begin
 154       SL.Add(Prefix+AName+'.SetAlign( '+AlignValues[Align]+'); ');
 155     end
 156   else
 157     begin
 158       SL.Add(Prefix+AName+'.SetPosition(' +int2str(Left)+', '+int2str(Top)+' );');
 159       SL.Add(Prefix+AName+'.SetSize(' +int2str(Width)+', '+int2str(Height)+' );');
 160     end;
 161   SL.Add(Prefix+AName+'.Offline := '+Bool2Str[FOffline]+';');
 162   SL.Add(Prefix+AName+'.Silent := '+Bool2Str[FSilent]+';');
 163   SL.Add(Prefix+AName+'.RegisterAsBrowser := '+Bool2Str[FRegisterAsBrowser]+';');
 164   SL.Add(Prefix+AName+'.RegisterAsDropTarget := '+Bool2Str[FRegisterAsDropTarget]+';');
 165   AssignEvents(SL,AName);
 166 end;
 167
 168 procedure TKOLWebBrowser.AssignEvents;
 169 begin
 170   inherited;
 171   DoAssignEvents(SL,AName,
 172     ['OnStatusTextChange','OnProgressChange','OnCommandStateChange',
 173      'OnTitleChange','OnPropertyChange','OnBeforeNavigate2','OnNewWindow2',
 174      'OnNavigateComplete2','OnDocumentComplete','OnVisible','OnToolBar',
 175      'OnMenuBar','OnStatusBar','OnFullScreen','OnTheaterMode'],
 176     [@OnStatusTextChange,@OnProgressChange,@OnCommandStateChange,
 177      @OnTitleChange,@OnPropertyChange,@OnBeforeNavigate2,@OnNewWindow2,
 178      @OnNavigateComplete2,@OnDocumentComplete,@OnVisible,@OnToolBar,
 179      @OnMenuBar,@OnStatusBar,@OnFullScreen,@OnTheaterMode]);
 180 end;
 181
 182 procedure TKOLWebBrowser.SetOffline;
 183 begin
 184   FOffline:=V;
 185   Change;
 186 end;
 187
 188 procedure TKOLWebBrowser.SetSilent;
 189 begin
 190   FSilent:=V;
 191   Change;
 192 end;
 193
 194 procedure TKOLWebBrowser.SetRegisterAsBrowser;
 195 begin
 196   FRegisterAsBrowser:=V;
 197   Change;
 198 end;
 199
 200 procedure TKOLWebBrowser.SetRegisterAsDropTarget;
 201 begin
 202   FRegisterAsDropTarget:=V;
 203   Change;
 204 end;
 205
 206 procedure TKOLWebBrowser.SetOnStatusTextChange;
 207 begin
 208   FOnStatusTextChange:=E;
 209   Change;
 210 end;
 211
 212 procedure TKOLWebBrowser.SetOnProgressChange;
 213 begin
 214   FOnProgressChange:=E;
 215   Change;
 216 end;
 217
 218 procedure TKOLWebBrowser.SetOnCommandStateChange;
 219 begin
 220   FOnCommandStateChange:=E;
 221   Change;
 222 end;
 223
 224 procedure TKOLWebBrowser.SetOnTitleChange;
 225 begin
 226   FOnTitleChange:=E;
 227   Change;
 228 end;
 229
 230 procedure TKOLWebBrowser.SetOnPropertyChange;
 231 begin
 232   FOnPropertyChange:=E;
 233   Change;
 234 end;
 235
 236 procedure TKOLWebBrowser.SetOnBeforeNavigate2;
 237 begin
 238   FOnBeforeNavigate2:=E;
 239   Change;
 240 end;
 241
 242 procedure TKOLWebBrowser.SetOnNewWindow2;
 243 begin
 244   FOnNewWindow2:=E;
 245   Change;
 246 end;
 247
 248 procedure TKOLWebBrowser.SetOnNavigateComplete2;
 249 begin
 250   FOnNavigateComplete2:=E;
 251   Change;
 252 end;
 253
 254 procedure TKOLWebBrowser.SetOnDocumentComplete;
 255 begin
 256   FOnDocumentComplete:=E;
 257   Change;
 258 end;
 259
 260 procedure TKOLWebBrowser.SetOnVisible;
 261 begin
 262   FOnVisible:=E;
 263   Change;
 264 end;
 265
 266 procedure TKOLWebBrowser.SetOnToolBar;
 267 begin
 268   FOnToolBar:=E;
 269   Change;
 270 end;
 271
 272 procedure TKOLWebBrowser.SetOnMenuBar;
 273 begin
 274   FOnMenuBar:=E;
 275   Change;
 276 end;
 277
 278 procedure TKOLWebBrowser.SetOnStatusBar;
 279 begin
 280   FOnStatusBar:=E;
 281   Change;
 282 end;
 283
 284 procedure TKOLWebBrowser.SetOnFullScreen;
 285 begin
 286   FOnFullScreen:=E;
 287   Change;
 288 end;
 289
 290 procedure TKOLWebBrowser.SetOnTheaterMode;
 291 begin
 292   FOnTheaterMode:=E;
 293   Change;
 294 end;
 295
 296 end.
 297