From 4d64e4cd434426234a5c313c151cd79b6afc299e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Juha=20Vehvil=C3=A4inen?= <jusu@users.sourceforge.net>
Date: Sat, 6 Jul 2002 17:50:18 +0000
Subject: *** empty log message ***

svn path=/trunk/Framestein/; revision=27
---
 Source/fsbrowserunit.pas | 113 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 113 insertions(+)
 create mode 100644 Source/fsbrowserunit.pas

(limited to 'Source/fsbrowserunit.pas')

diff --git a/Source/fsbrowserunit.pas b/Source/fsbrowserunit.pas
new file mode 100644
index 0000000..b507902
--- /dev/null
+++ b/Source/fsbrowserunit.pas
@@ -0,0 +1,113 @@
+unit fsbrowserunit;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  fsframeunit, Filez, DIB, Menus, DXDraws, ExtCtrls, OleCtrls, SHDocVw,
+  C2PhotoShopHost, ExtDlgs, StdCtrls;
+
+type
+  Tfsbrowser = class(Tfsframe)
+    br: TWebBrowser;
+    procedure FormCreate(Sender: TObject);
+    procedure brBeforeNavigate2(Sender: TObject; const pDisp: IDispatch;
+      var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
+      var Cancel: WordBool);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    PdName: String;
+    procedure Parse(const S: String); override;
+    procedure CopyToSurface;
+  end;
+
+var
+  fsbrowser: Tfsbrowser;
+
+implementation
+
+uses
+  ActiveX,
+  Strz, mainunit;
+
+{$R *.DFM}
+
+{ Tfsbrowser }
+
+procedure Tfsbrowser.Parse(const S: String);
+var
+  s1, s2: String;
+begin
+  s1 := Trim(UpperCase(ExtractWord(1, S, [' '])));
+  if s1='' then Exit;
+  if (s1[1] in ['0'..'9']) and
+   (Pos('X', s1)>0) then begin
+    Width := MyStrToInt(ExtractWord(1, s1, ['X']));
+    Height := MyStrToInt(ExtractWord(2, s1, ['X']));
+  end else
+  if s1='OPEN' then begin
+    s2 := Copy(S, Length(s1)+2, 255);
+    br.Navigate(s2);
+  end else
+  if s1='STOP' then begin
+    br.Stop;
+  end else
+  if s1='REFRESH' then begin
+    br.Refresh;
+  end else begin
+    if
+     (UpperCase(Copy(S, 1, 4))='HTTP') or
+     (UpperCase(Copy(S, 1, 4))='FILE')
+    then
+      br.Navigate(S)
+    else
+      inherited Parse(S);
+  end;
+end;
+
+procedure Tfsbrowser.FormCreate(Sender: TObject);
+begin
+  inherited;
+  ClientWidth := 480;
+  ClientHeight := 360;
+end;
+
+procedure Tfsbrowser.CopyToSurface;
+var
+  DrawRect: TRect;
+begin
+  if (br.ClientWidth<>d1.Surface.Width) or
+   (br.ClientHeight<>d1.Surface.Height) then
+    d1.SetSize(br.ClientWidth, br.ClientHeight);
+
+  DrawRect := Rect(0, 0, d1.Surface.Width, d1.Surface.Height);
+  (br.Document as IViewObject).Draw(
+   DVASPECT_CONTENT, 1, nil, nil, 0,
+   d1.Surface.Canvas.Handle, @DrawRect, nil, nil, 0);
+
+  d1.Surface.Canvas.Release;
+end;
+
+procedure Tfsbrowser.brBeforeNavigate2(Sender: TObject;
+  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
+  Headers: OleVariant; var Cancel: WordBool);
+var
+  St: String;
+begin
+  if UpperCase(Copy(URL, 1, 3))='FS:' then begin
+    St := Copy(URL, 4, 255);
+
+    St := SearchAndReplace(St, '%exepath',
+     ExtractFilePath(Application.ExeName));
+    St := SearchAndReplace(St, '//', '/');
+    St := SearchAndReplace(St, '\/', '/');
+
+    main.SendReturnValuesString(PdName+'link', St);
+    Cancel:=True;
+  end;
+end;
+
+end.
+
-- 
cgit v1.2.1