| 2 |
interface |
interface |
| 3 |
uses |
uses |
| 4 |
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, |
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, |
| 5 |
ActiveX, OleCtrls, {HintWindow,} |
ActiveX, OleCtrls, {HintWindow,} HTMLDocumentEvent, BoardGroup, |
| 6 |
{$IF Defined(DELPRO) } |
{$IF Defined(DELPRO) } |
| 7 |
SHDocVw, |
SHDocVw, |
| 8 |
MSHTML |
MSHTML |
| 22 |
FTitle :String; |
FTitle :String; |
| 23 |
FRawDocument: String; |
FRawDocument: String; |
| 24 |
FPopupType: TGikoPopupType; |
FPopupType: TGikoPopupType; |
| 25 |
|
FEvent: THTMLDocumentEventSink;//ブラウザドキュメントイベント |
| 26 |
|
FThread: TThreadItem; |
| 27 |
function GetBodyStyle(OnlyTitle: Boolean = False): string; |
function GetBodyStyle(OnlyTitle: Boolean = False): string; |
| 28 |
function GetWindowHeight : Integer; |
function GetWindowHeight : Integer; |
| 29 |
function GetTitle(OnlyTitle: Boolean): string; |
function GetTitle(OnlyTitle: Boolean): string; |
| 30 |
function CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect; |
function CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect; |
| 31 |
|
function ResPopupBrowserClick(Sender: TObject): WordBool; |
| 32 |
|
function GetThread: TThreadItem; |
| 33 |
protected |
protected |
| 34 |
procedure CreateParams(var Params: TCreateParams); override; |
procedure CreateParams(var Params: TCreateParams); override; |
| 35 |
public |
public |
| 39 |
property ParentBrowser:TResPopupBrowser read FParentBrowser write FParentBrowser; |
property ParentBrowser:TResPopupBrowser read FParentBrowser write FParentBrowser; |
| 40 |
property Title: String read FTitle write FTitle; |
property Title: String read FTitle write FTitle; |
| 41 |
property RawDocument: String read FRawDocument write FRawDocument; |
property RawDocument: String read FRawDocument write FRawDocument; |
| 42 |
|
property Thread: TThreadItem read GetThread write FThread; |
| 43 |
function CreateNewBrowser: TResPopupBrowser; |
function CreateNewBrowser: TResPopupBrowser; |
| 44 |
function CurrentBrowser: TResPopupBrowser; |
function CurrentBrowser: TResPopupBrowser; |
| 45 |
procedure Write(ADocument: String; OnlyTitle: Boolean = False); |
procedure Write(ADocument: String; OnlyTitle: Boolean = False); |
| 52 |
end; |
end; |
| 53 |
|
|
| 54 |
implementation |
implementation |
| 55 |
uses MojuUtils, GikoSystem, Setting, Giko; |
uses MojuUtils, GikoSystem, Setting, Giko, GikoDataModule; |
| 56 |
|
|
| 57 |
|
|
| 58 |
constructor TResPopupBrowser.Create(AOwner: TComponent); |
constructor TResPopupBrowser.Create(AOwner: TComponent); |
| 108 |
function TResPopupBrowser.CurrentBrowser: TResPopupBrowser; |
function TResPopupBrowser.CurrentBrowser: TResPopupBrowser; |
| 109 |
begin |
begin |
| 110 |
Result := Self.CreateNewBrowser; |
Result := Self.CreateNewBrowser; |
| 111 |
if (Result.Parent <> nil) then |
if (Result.ParentBrowser <> nil) then |
| 112 |
Result := Result.ParentBrowser; |
Result := Result.ParentBrowser; |
| 113 |
end; |
end; |
| 114 |
procedure TResPopupBrowser.NavigateBlank; |
procedure TResPopupBrowser.NavigateBlank; |
| 133 |
var |
var |
| 134 |
doc: Variant; |
doc: Variant; |
| 135 |
ARect: TRect; |
ARect: TRect; |
| 136 |
|
FDispHtmlDocument: DispHTMLDocument; |
| 137 |
begin |
begin |
| 138 |
Self.OnStatusTextChange := nil; |
Self.OnStatusTextChange := nil; |
| 139 |
try |
try |
| 160 |
(ARect.Right - ARect.Left) , |
(ARect.Right - ARect.Left) , |
| 161 |
(ARect.Bottom - ARect.Top), |
(ARect.Bottom - ARect.Top), |
| 162 |
SWP_NOACTIVATE or SWP_HIDEWINDOW); |
SWP_NOACTIVATE or SWP_HIDEWINDOW); |
| 163 |
|
FDispHtmlDocument := Idispatch(OleVariant(Self.ControlInterface).Document) as DispHTMLDocument; |
| 164 |
|
FEvent := THTMLDocumentEventSink.Create(Self, FDispHtmlDocument, HTMLDocumentEvents2); |
| 165 |
|
FEvent.OnClick := ResPopupBrowserClick; |
| 166 |
ShowWindow(Self.Handle, SW_SHOWNOACTIVATE); |
ShowWindow(Self.Handle, SW_SHOWNOACTIVATE); |
| 167 |
Self.Visible := True; |
Self.Visible := True; |
| 168 |
except |
except |
| 215 |
if (Self.Visible) then begin |
if (Self.Visible) then begin |
| 216 |
Self.Title := ''; |
Self.Title := ''; |
| 217 |
Self.RawDocument := ''; |
Self.RawDocument := ''; |
| 218 |
|
Self.FThread := nil; |
| 219 |
|
FEvent.Free; |
| 220 |
NavigateBlank; |
NavigateBlank; |
| 221 |
ShowWindow(Self.Handle, SW_HIDE); |
ShowWindow(Self.Handle, SW_HIDE); |
| 222 |
Self.Visible := False; |
Self.Visible := False; |
| 305 |
except |
except |
| 306 |
end; |
end; |
| 307 |
end; |
end; |
| 308 |
|
function TResPopupBrowser.ResPopupBrowserClick(Sender: TObject): WordBool; |
| 309 |
|
begin |
| 310 |
|
Result := True; |
| 311 |
|
end; |
| 312 |
|
function TResPopupBrowser.GetThread: TThreadItem; |
| 313 |
|
begin |
| 314 |
|
Result := nil; |
| 315 |
|
if (FThread <> nil) then begin |
| 316 |
|
try |
| 317 |
|
// 無効なポインタ検査 |
| 318 |
|
if (FThread.ParentBoard <> nil) then begin |
| 319 |
|
Result := FThread |
| 320 |
|
end; |
| 321 |
|
except |
| 322 |
|
//無効なポインタだった |
| 323 |
|
Result := nil; |
| 324 |
|
end; |
| 325 |
|
end; |
| 326 |
|
end; |
| 327 |
end. |
end. |