4 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
5 ActiveX, OleCtrls, {HintWindow,} HTMLDocumentEvent, BoardGroup,
16 TGikoPopupType = (gptRaw, gptThread);
18 TResPopupBrowser = class(TWebBrowser)
20 FChild :TResPopupBrowser;
21 FParentBrowser :TResPopupBrowser;
24 FPopupType: TGikoPopupType;
25 FEvent: THTMLDocumentEventSink;//
\83u
\83\89\83E
\83U
\83h
\83L
\83\85\83\81\83\93\83g
\83C
\83x
\83\93\83g
27 function GetBodyStyle(OnlyTitle: Boolean = False): string;
28 function GetWindowHeight : Integer;
29 function GetTitle(OnlyTitle: Boolean): string;
30 function CalcRect(WorkArea: TRect; Scroll: Boolean): TRect;
31 function ResPopupBrowserClick(Sender: TObject): WordBool;
32 function ResPopupBrowserDbClick(Sender: TObject): WordBool;
33 function GetThread: TThreadItem;
35 procedure CreateParams(var Params: TCreateParams); override;
37 constructor Create(AOwner: TComponent); override;
38 destructor Destroy; override;
39 property Child: TResPopupBrowser read FChild;
40 property ParentBrowser:TResPopupBrowser read FParentBrowser write FParentBrowser;
41 property Title: String read FTitle write FTitle;
42 property RawDocument: String read FRawDocument write FRawDocument;
43 property Thread: TThreadItem read GetThread write FThread;
44 function CreateNewBrowser: TResPopupBrowser;
45 function CurrentBrowser: TResPopupBrowser;
46 procedure Write(ADocument: String; OnlyTitle: Boolean = False);
49 procedure NavigateBlank(Forced: Boolean);
50 property PopupType: TGikoPopupType read FPopupType write FPopupType;
57 uses MojuUtils, GikoSystem, Setting, Giko, GikoDataModule, Preview;
59 constructor TResPopupBrowser.Create(AOwner: TComponent);
61 inherited Create(AOwner);
62 TOleControl(Self).Parent := nil;
68 ShowWindow(Self.Handle, SW_HIDE);
69 GikoSys.ShowRefCount('ResPop Create', Self.ControlInterface);
70 GikoSys.ShowRefCount('ResPop.Document Create', Self.ControlInterface.Document);
73 destructor TResPopupBrowser.Destroy;
77 Self.OnBeforeNavigate2 := nil;
78 Self.OnStatusTextChange := nil;
79 Self.OnNewWindow2 := nil;
80 if (FChild <> nil) then begin
84 if (FEvent <> nil) then begin
90 GikoSys.ShowRefCount('ResPop Desctroy', Self.ControlInterface);
91 GikoSys.ShowRefCount('ResPop.Document Create', Self.ControlInterface.Document);
96 procedure TResPopupBrowser.CreateParams(var Params: TCreateParams);
99 Params.Style := Params.Style or WS_EX_TOOLWINDOW;
102 function TResPopupBrowser.CreateNewBrowser: TResPopupBrowser;
104 if (Self.Visible) then begin
105 if (FChild <> nil) then begin
106 if (FChild.Visible) then begin
107 Result := FChild.CreateNewBrowser;
112 FChild := TResPopupBrowser.Create(Self.Owner);
113 FChild.ParentBrowser := Self;
114 FChild.NavigateBlank(False);
115 FChild.OnEnter := GikoForm.BrowserEnter;
116 FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
117 FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
118 FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
119 SetWindowPos(FChild.Handle, HWND_BOTTOM,
121 SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
125 FParentBrowser := nil;
126 Self.NavigateBlank(False);
127 Self.OnEnter := GikoForm.BrowserEnter;
128 Self.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
129 Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
130 Self.OnNewWindow2 := GikoForm.BrowserNewWindow2;
131 SetWindowPos(Self.Handle, HWND_BOTTOM,
133 SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
137 function TResPopupBrowser.CurrentBrowser: TResPopupBrowser;
139 Result := Self.CreateNewBrowser;
140 if (Result.ParentBrowser <> nil) then
141 Result := Result.ParentBrowser;
143 procedure TResPopupBrowser.NavigateBlank(Forced: Boolean);
145 if (not Assigned(Self.ControlInterface.Document)) or (Forced) then begin
146 Self.Navigate('about:blank');
148 while (Self.ReadyState <> READYSTATE_COMPLETE) and
149 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
151 Forms.Application.ProcessMessages;
154 procedure TResPopupBrowser.TitlePopup;
158 procedure TResPopupBrowser.Popup;
160 if (GetAsyncKeyState(VK_SHIFT) = Smallint($8001)) then begin
161 //
\83V
\83t
\83g
\89\9f\82µ
\82Ä
\82é
\8fê
\8d\87\82Í
\82»
\82Ì
\82Ü
\82Ü
\8fo
\82·
162 Write(Self.RawDocument, false);
164 // éx
\82µ
\8aG
\82ª
\8c©
\82¦
\82é
\82æ
\82¤
\82É
\94¼
\8ap
\83X
\83y
\81[
\83X*2
\82ð *2
\82É
\92u
\8a·
\82·
\82é
166 MojuUtils.CustomStringReplace(
167 Self.RawDocument, ' ', ' '),
171 procedure TResPopupBrowser.Write(ADocument: String; OnlyTitle: Boolean = False);
178 //
\83^
\83X
\83N
\83o
\81[
\82©
\82ç
\8fÁ
\82·
179 SetWindowLongA(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
181 //
\82¢
\82Á
\82½
\82ñ
\8fk
\8f¬
182 SetWindowPos(Self.Handle, HWND_BOTTOM,
184 SWP_NOACTIVATE or SWP_HIDEWINDOW);
185 doc := Self.OleObject.Document;
187 doc.charset := 'Shift_JIS';
188 doc.Write('<html><head>'#13#10 +
189 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10 +
190 '<meta http-equiv="Pragma" content="no-cache">'#13#10 +
191 '<meta http-equiv="Cache-Control" content="no-cache">'#13#10 +
192 GetBodyStyle(OnlyTitle) + '</head><body>'
193 + GetTitle(OnlyTitle)
194 + ADocument + '<a name="bottom"></a></body></html>');
197 //
\83}
\83\8b\83`
\83\82\83j
\83^
\91Î
\89\9e
198 ARect := CalcRect(Screen.MonitorFromPoint(p).WorkareaRect,
201 FEvent := THTMLDocumentEventSink.Create(Self, Self.OleObject.Document, HTMLDocumentEvents2);
202 FEvent.OnClick := ResPopupBrowserClick;
203 FEvent.OnDoubleClick := ResPopupBrowserDbClick;
204 Self.Visible := True;
205 SetWindowPos(Self.Handle, HWND_TOPMOST,
206 ARect.Left, ARect.Top,
207 (ARect.Right - ARect.Left) ,
208 (ARect.Bottom - ARect.Top),
209 SWP_NOACTIVATE or SWP_HIDEWINDOW);
210 ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
214 function TResPopupBrowser.GetTitle(OnlyTitle: Boolean): string;
216 Result := '<span id="hTitle">' + Title +'</span>';
217 if OnlyTitle then Result := Result + '<BR>';
219 function TResPopupBrowser.GetBodyStyle(OnlyTitle: Boolean = False): string;
224 Result := '<style type="text/css">' +
225 'dl { margin :0px; padding :0px}'#13#10 +
227 'border-width: 1px; border-style: solid;white-space: nowrap; ' +
228 'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px; ';
230 if Length( GikoSys.Setting.HintFontName ) > 0 then
231 Result := Result + 'font-family:"' + GikoSys.Setting.HintFontName + '";';
232 if GikoSys.Setting.HintFontSize <> 0 then
233 Result := Result + 'font-size:' + IntToStr( GikoSys.Setting.HintFontSize ) + 'pt;';
234 if GikoSys.Setting.HintFontColor <> -1 then
235 Result := Result + 'color:#' + IntToHex( GikoSys.Setting.HintFontColor, 6 ) + ';';
236 if GikoSys.Setting.HintBackColor <> -1 then begin
237 i := ColorToRGB( GikoSys.Setting.HintBackColor );
238 Result := Result + 'background-color:#' +
239 IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';
242 Result := Result + 'overflow: hidden; ';
244 Result := Result + '}';
245 if GikoSys.Setting.ResPopupHeaderBold then begin
246 Result := Result + #13#10'span#hTitle{font-weight: bold; }';
248 Result := Result + '</style>';
251 procedure TResPopupBrowser.Clear;
254 if (Self.Visible) then begin
256 Self.RawDocument := '';
261 ShowWindow(Self.Handle, SW_HIDE);
262 Self.Visible := False;
265 procedure TResPopupBrowser.ChildClear;
267 if (FChild <> nil) then begin
272 function TResPopupBrowser.CalcRect(WorkArea: TRect; Scroll: Boolean): TRect;
276 h, w, dx1, dx2, dy1, dy2: Integer;
277 MaxWidth, MaxHeight: Integer;
278 DIV_X, DIV_Y: Integer;
281 ele := ((Self.ControlInterface.Document as IHTMLDocument2).body as IHTMLElement2);
283 h := GetWindowHeight + 10;
284 w := ele.scrollWidth + 25
286 h := GetWindowHeight + 5;
287 w := ele.scrollWidth + 10;
290 DIV_X := GikoSys.Setting.RespopupDeltaX;
291 DIV_Y := GikoSys.Setting.RespopupDeltaY;
296 Result := Rect(0, 0, w, h);
297 case GikoSys.Setting.PopupPosition of
300 dx1 := 0; dx2 := + DIV_X;
301 dy1 := -h; dy2 := - DIV_Y;
305 dx1 := 0; dx2 := + DIV_X;
306 dy1 := - (h div 2); dy2 := 0;
310 dx1 := 0; dx2 := + DIV_X;
311 dy1 := 0; dy2 := + DIV_Y;
315 dx1 := - (w div 2); dx2 := 0;
316 dy1 := -h; dy2 := - DIV_Y;
318 //
\94p
\8e~ gppCenter: OffsetRect(Result, p.x - (w div 2), p.y - (h div 2));
321 dx1 := - (w div 2); dx2 := 0;
322 dy1 := 0; dy2 := + DIV_Y;
326 dx1 := -w; dx2 := - DIV_X ;
327 dy1 := -h; dy2 := - DIV_Y;
331 dx1 := -w; dx2 := - DIV_X;
332 dy1 := - (h div 2); dy2 := 0;
336 dx1 := -w; dx2 := - DIV_X;
337 dy1 := 0; dy2 := + DIV_Y;
340 //
\8f\89\8aú
\88Ê
\92u
\82É
\88Ú
\93®
341 OffsetRect(Result, p.x + dx1 + dx2, p.y + dy1 + dy2);
343 MaxWidth := WorkArea.Right - WorkArea.Left;
344 MaxHeight := WorkArea.Bottom - WorkArea.Top;
345 //
\88È
\89º
\81A
\8f\89\8aú
\88Ê
\92u
\82É
\96â
\91è
\82ª
\82 \82é
\82Æ
\82«
\82Ì
\88Ú
\93®
346 if (Result.Left < WorkArea.Left) then begin
347 //
\8bt
\83T
\83C
\83h
\82É
\97]
\97T
\82ª
\82 \82ê
\82Î
\81A
\8fo
\97Í
\88Ê
\92u
\82Ì
\8d¶
\89E
\93]
\8a·
348 if ((p.X - WorkArea.Left) * 2 < MaxWidth) then begin
349 if ( (GikoSys.Setting.PopupPosition = gppTop) or
350 (GikoSys.Setting.PopupPosition = gppBottom)) then begin
351 OffsetRect(Result, -Result.Left, 0);
353 OffsetRect(Result, - (dx1 + 2 * dx2), 0);
356 //
\89æ
\96Ê
\92[
\82Ü
\82Å
\89æ
\96Ê
\95\9d\82ð
\8f¬
\82³
\82
\82·
\82é
357 Result := Rect(WorkArea.Left, Result.Top,
358 Result.Right, Result.Bottom);
361 if (Result.Top < WorkArea.Top) then begin
362 //
\92ê
\91¤
\82É
\97]
\97T
\82ª
\82 \82ê
\82Î
\81A
\8fo
\97Í
\88Ê
\92u
\82Ì
\8fã
\89º
\93]
\8a·
363 if ((p.Y - WorkArea.Top) * 2 < MaxHeight) then begin
364 OffsetRect(Result, 0, - (dy1 + 2 * dy2));
366 //
\89æ
\96Ê
\92[
\82Ü
\82Å
\89æ
\96Ê
\8d\82\82ð
\8f¬
\82³
\82
\82·
\82é
367 Result := Rect(Result.Left, WorkArea.Top,
368 Result.Right, Result.Bottom);
371 if (Result.Right > WorkArea.Right) then begin
372 //
\8bt
\83T
\83C
\83h
\82É
\97]
\97T
\82ª
\82 \82ê
\82Î
\81A
\8fo
\97Í
\88Ê
\92u
\82Ì
\8d¶
\89E
\93]
\8a·
373 if ((p.X - WorkArea.Left) * 2 > MaxWidth) then begin
374 if( (GikoSys.Setting.PopupPosition = gppTop) or
375 (GikoSys.Setting.PopupPosition = gppBottom)) then begin
376 OffsetRect(Result, -(Result.Right - WorkArea.Right), 0);
378 OffsetRect(Result, -w - (dx1 + 2 * dx2), 0);
380 //
\8bt
\83T
\83C
\83h
\82É
\83I
\81[
\83o
\81[
\82µ
\82½
\8fê
\8d\87\82Í
\89æ
\96Ê
\92[
\82Ü
\82Å
\95\9d\82ð
\8f¬
\82³
\82
\82·
\82é
381 if (Result.Left < WorkArea.Left) then begin
382 Result := Rect(WorkArea.Left, Result.Top,
383 Result.Right, Result.Bottom);
386 //
\89æ
\96Ê
\92[
\82Ü
\82Å
\89æ
\96Ê
\95\9d\82ð
\8f¬
\82³
\82
\82·
\82é
387 Result := Rect(Result.Left, Result.Top,
388 WorkArea.Right, Result.Bottom);
391 if (Result.Bottom > WorkArea.Bottom) then begin
392 //
\8fã
\91¤
\82É
\97]
\97T
\82ª
\82 \82ê
\82Î
\81A
\8fo
\97Í
\88Ê
\92u
\82Ì
\8fã
\89º
\93]
\8a·
393 if ((p.Y - WorkArea.Top) * 2 > WorkArea.Bottom) then begin
394 OffsetRect(Result, 0, -h - (dy1 + 2 * dy2));
395 //
\8fã
\82É
\8aÑ
\82¢
\82½
\8fê
\8d\87\82Í
\81A
396 if (Result.Top < WorkArea.Top) then begin
397 Result := Rect(Result.Left, WorkArea.Top,
398 Result.Right, Result.Bottom);
401 //
\89æ
\96Ê
\92[
\82Ü
\82Å
\89æ
\96Ê
\8d\82\82ð
\8f¬
\82³
\82
\82·
\82é
402 Result := Rect(Result.Left, Result.Top,
403 Result.Right, WorkArea.Bottom);
407 function TResPopupBrowser.GetWindowHeight : Integer;
413 //
\83u
\83\89\83E
\83U
\82ª
\83f
\81[
\83^
\82Ì
\93Ç
\82Ý
\8d\9e\82Ý
\92\86\82Ì
\8e\9e\82Í
\93Ç
\82Ý
\8d\9e\82Ý
\82ð
\91Ò
\82Â
414 while (Self.ReadyState <> READYSTATE_COMPLETE) and
415 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
417 Forms.Application.ProcessMessages;
422 item := Self.OleObject.Document.anchors.item(OleVariant('bottom'));
425 top := top + item.offsetTop;
426 item := item.offsetParent;
427 until AnsiCompareText(item.tagName, 'body' ) = 0;
432 function TResPopupBrowser.ResPopupBrowserClick(Sender: TObject): WordBool;
434 //
\83M
\83R
\83i
\83r
\82Ì
\83t
\83H
\81[
\83J
\83X
\82ð
\92D
\82Á
\82Ä
\82é
\82Ì
\82Å
\83t
\83H
\81[
\83\80\82É
\96³
\97\9d\82â
\82è
\95Ô
\82·
438 function TResPopupBrowser.GetThread: TThreadItem;
441 if (FThread <> nil) then begin
443 //
\96³
\8cø
\82È
\83|
\83C
\83\93\83^
\8c\9f\8d¸
444 if (FThread.ParentBoard <> nil) then begin
448 //
\96³
\8cø
\82È
\83|
\83C
\83\93\83^
\82¾
\82Á
\82½
453 procedure TResPopupBrowser.Blur;
455 FOleInPlaceActiveObject: IOleInPlaceActiveObject;
457 FOleInPlaceActiveObject := Self.ControlInterface as IOleInPlaceActiveObject;
458 FOleInPlaceActiveObject.OnFrameWindowActivate(False);
460 function TResPopupBrowser.ResPopupBrowserDbClick(Sender: TObject): WordBool;
462 //
\83M
\83R
\83i
\83r
\82Ì
\83t
\83H
\81[
\83J
\83X
\82ð
\92D
\82Á
\82Ä
\82é
\82Ì
\82Å
\83t
\83H
\81[
\83\80\82É
\96³
\97\9d\82â
\82è
\95Ô
\82·
464 //
\8e©
\95ª
\82Å
\8e©
\95ª
\82Í
\8fÁ
\82¹
\82È
\82¢
\82Ì
\82Å
\81A
\83\81\83b
\83Z
\81[
\83W
\8co
\97R
\82Å
\8fÁ
\82µ
\82Ä
\82à
\82ç
\82¤
465 PostMessage( GikoForm.Handle , USER_POPUPCLEAR, Integer( Self ), 0 );