Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/ResPopupBrowser.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.7 - (show annotations) (download) (as text)
Sun Oct 14 04:23:30 2007 UTC (16 years, 6 months ago) by h677
Branch: MAIN
CVS Tags: v1_57_0_737, v1_57_0_739, v1_57_0_738, v1_58_0_748, v1_58_0_745, v1_58_0_746, v1_57_1_744, v1_57_0_736, v1_58_0_750, v1_58_0_751, v1_58_0_747, v1_57_2_749, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_57_0_744
Branch point for: Bb57
Changes since 1.6: +9 -8 lines
File MIME type: text/x-pascal
マルチモニタ向けの修正(未確認)

1 unit ResPopupBrowser;
2 interface
3 uses
4 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
5 ActiveX, OleCtrls, {HintWindow,} HTMLDocumentEvent, BoardGroup,
6 {$IF Defined(DELPRO) }
7 SHDocVw,
8 MSHTML
9 {$ELSE}
10 SHDocVw_TLB,
11 MSHTML_TLB
12 {$IFEND}
13 ;
14
15 type
16 TGikoPopupType = (gptRaw, gptThread);
17
18 TResPopupBrowser = class(TWebBrowser)
19 private
20 FChild :TResPopupBrowser;
21 FParentBrowser :TResPopupBrowser;
22 FTitle :String;
23 FRawDocument: String;
24 FPopupType: TGikoPopupType;
25 FEvent: THTMLDocumentEventSink;//???????吟?????ャ?<?潟???ゃ???潟??
26 FThread: TThreadItem;
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;
34 protected
35 procedure CreateParams(var Params: TCreateParams); override;
36 public
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);
47 procedure Clear;
48 procedure ChildClear;
49 procedure NavigateBlank(Forced: Boolean);
50 property PopupType: TGikoPopupType read FPopupType write FPopupType;
51 procedure TitlePopup;
52 procedure Popup;
53 procedure Blur;
54 end;
55
56 implementation
57 uses MojuUtils, GikoSystem, Setting, Giko, GikoDataModule, Preview;
58
59 constructor TResPopupBrowser.Create(AOwner: TComponent);
60 begin
61 inherited Create(AOwner);
62 TOleControl(Self).Parent := nil;
63 Visible := False;
64 FChild := nil;
65 Title := '';
66 RawDocument := '';
67 FEvent := nil;
68 ShowWindow(Self.Handle, SW_HIDE);
69 end;
70
71 destructor TResPopupBrowser.Destroy;
72 begin
73 Self.Blur;
74 Self.OnEnter := nil;
75 Self.OnBeforeNavigate2 := nil;
76 Self.OnStatusTextChange := nil;
77 Self.OnNewWindow2 := nil;
78 if (FChild <> nil) then begin
79 FChild.Free;
80 FChild := nil;
81 end;
82 if (FEvent <> nil) then begin
83 FEvent.Free;
84 FEvent := nil;
85 end;
86 FThread := nil;
87 inherited Destroy;
88 end;
89
90 procedure TResPopupBrowser.CreateParams(var Params: TCreateParams);
91 begin
92 inherited;
93 Params.Style := Params.Style or WS_EX_TOOLWINDOW;
94
95 end;
96 function TResPopupBrowser.CreateNewBrowser: TResPopupBrowser;
97 begin
98 if (Self.Visible) then begin
99 if (FChild <> nil) then begin
100 if (FChild.Visible) then begin
101 Result := FChild.CreateNewBrowser;
102 end else begin
103 Result := FChild;
104 end;
105 end else begin
106 FChild := TResPopupBrowser.Create(Self.Owner);
107 FChild.ParentBrowser := Self;
108 FChild.NavigateBlank(False);
109 FChild.OnEnter := GikoForm.BrowserEnter;
110 FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
111 FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
112 FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
113 SetWindowPos(FChild.Handle, HWND_BOTTOM,
114 0, 0, 0 , 0,
115 SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
116 Result := FChild;
117 end;
118 end else begin
119 FParentBrowser := nil;
120 Self.NavigateBlank(False);
121 Self.OnEnter := GikoForm.BrowserEnter;
122 Self.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
123 Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
124 Self.OnNewWindow2 := GikoForm.BrowserNewWindow2;
125 SetWindowPos(Self.Handle, HWND_BOTTOM,
126 0, 0, 0 , 0,
127 SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
128 Result := Self;
129 end;
130 end;
131 function TResPopupBrowser.CurrentBrowser: TResPopupBrowser;
132 begin
133 Result := Self.CreateNewBrowser;
134 if (Result.ParentBrowser <> nil) then
135 Result := Result.ParentBrowser;
136 end;
137 procedure TResPopupBrowser.NavigateBlank(Forced: Boolean);
138 begin
139 if (not Assigned(Self.Document)) or (Forced) then begin
140 Self.Navigate('about:blank');
141 end;
142 while (Self.ReadyState <> READYSTATE_COMPLETE) and
143 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
144 Sleep(1);
145 Forms.Application.ProcessMessages;
146 end;
147 end;
148 procedure TResPopupBrowser.TitlePopup;
149 begin
150 Write('', True);
151 end;
152 procedure TResPopupBrowser.Popup;
153 begin
154 if (GetAsyncKeyState(VK_SHIFT) = Smallint($8001)) then begin
155 // ?激?????若???????翫?????????障?上?冴??
156 Write(Self.RawDocument, false);
157 end else begin
158 // 薑???腟泣??荀?????????????茹??鴻???若??2??&nbsp;*2??舟??????
159 Write(
160 MojuUtils.CustomStringReplace(
161 Self.RawDocument, ' ', '&nbsp;&nbsp;'),
162 false);
163 end;
164 end;
165 procedure TResPopupBrowser.Write(ADocument: String; OnlyTitle: Boolean = False);
166 var
167 p: TPoint;
168 doc: Variant;
169 ARect: TRect;
170 FDispHtmlDocument: DispHTMLDocument;
171 begin
172 try
173 // ?帥?鴻?????若????羔???
174 SetWindowLongA(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
175 GetCursorpos(p);
176 // ???c????膰??
177 SetWindowPos(Self.Handle, HWND_BOTTOM,
178 p.X, p.Y, 50 , 50,
179 SWP_NOACTIVATE or SWP_HIDEWINDOW);
180 doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
181 doc.open;
182 doc.charset := 'Shift_JIS';
183 doc.Write('<html><head>'#13#10 +
184 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10 +
185 '<meta http-equiv="Pragma" content="no-cache">'#13#10 +
186 '<meta http-equiv="Cache-Control" content="no-cache">'#13#10 +
187 GetBodyStyle(OnlyTitle) + '</head><body>'
188 + GetTitle(OnlyTitle)
189 + ADocument + '<a name="bottom"></a></body></html>');
190
191 doc.Close;
192 // ???????≪???水?綽?
193 ARect := CalcRect(Screen.MonitorFromPoint(p).WorkareaRect,
194 not OnlyTitle);
195
196 FDispHtmlDocument := Idispatch(OleVariant(Self.ControlInterface).Document) as DispHTMLDocument;
197 FEvent := THTMLDocumentEventSink.Create(Self, FDispHtmlDocument, HTMLDocumentEvents2);
198 FEvent.OnClick := ResPopupBrowserClick;
199 FEvent.OnDoubleClick := ResPopupBrowserDbClick;
200 Self.Visible := True;
201 SetWindowPos(Self.Handle, HWND_TOPMOST,
202 ARect.Left, ARect.Top,
203 (ARect.Right - ARect.Left) ,
204 (ARect.Bottom - ARect.Top),
205 SWP_NOACTIVATE or SWP_HIDEWINDOW);
206 ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
207 except
208 end;
209 end;
210 function TResPopupBrowser.GetTitle(OnlyTitle: Boolean): string;
211 begin
212 Result := '<span id="hTitle">' + Title +'</span>';
213 if OnlyTitle then Result := Result + '<BR>';
214 end;
215 function TResPopupBrowser.GetBodyStyle(OnlyTitle: Boolean = False): string;
216 var
217 i : Integer;
218 begin
219
220 Result := '<style type="text/css">' +
221 'dl { margin :0px; padding :0px}'#13#10 +
222 'body { ' +
223 'border-width: 1px; border-style: solid;white-space: nowrap; ' +
224 'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px; ';
225
226 if Length( GikoSys.Setting.HintFontName ) > 0 then
227 Result := Result + 'font-family:"' + GikoSys.Setting.HintFontName + '";';
228 if GikoSys.Setting.HintFontSize <> 0 then
229 Result := Result + 'font-size:' + IntToStr( GikoSys.Setting.HintFontSize ) + 'pt;';
230 if GikoSys.Setting.HintFontColor <> -1 then
231 Result := Result + 'color:#' + IntToHex( GikoSys.Setting.HintFontColor, 6 ) + ';';
232 if GikoSys.Setting.HintBackColor <> -1 then begin
233 i := ColorToRGB( GikoSys.Setting.HintBackColor );
234 Result := Result + 'background-color:#' +
235 IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';
236 end;
237 if OnlyTitle then
238 Result := Result + 'overflow: hidden; ';
239
240 Result := Result + '}';
241 if GikoSys.Setting.ResPopupHeaderBold then begin
242 Result := Result + #13#10'span#hTitle{font-weight: bold; }';
243 end;
244 Result := Result + '</style>';
245 end;
246
247 procedure TResPopupBrowser.Clear;
248 begin
249 ChildClear;
250 if (Self.Visible) then begin
251 Self.Title := '';
252 Self.RawDocument := '';
253 Self.FThread := nil;
254 Self.FEvent.Free;
255 Self.FEvent := nil;
256 Self.Blur;
257 ShowWindow(Self.Handle, SW_HIDE);
258 Self.Visible := False;
259 end;
260 end;
261 procedure TResPopupBrowser.ChildClear;
262 begin
263 if (FChild <> nil) then begin
264 FChild.Clear;
265 end;
266 end;
267
268 function TResPopupBrowser.CalcRect(WorkArea: TRect; Scroll: Boolean): TRect;
269 var
270 p: TPoint;
271 ele: IHTMLElement2;
272 h, w, dx1, dx2, dy1, dy2: Integer;
273 MaxWidth, MaxHeight: Integer;
274 DIV_X, DIV_Y: Integer;
275 begin
276 GetCursorpos(p);
277 ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
278 if Scroll then begin
279 h := GetWindowHeight + 10;
280 w := ele.scrollWidth + 25
281 end else begin
282 h := GetWindowHeight + 5;
283 w := ele.scrollWidth + 10;
284 end;
285
286 DIV_X := GikoSys.Setting.RespopupDeltaX;
287 DIV_Y := GikoSys.Setting.RespopupDeltaY;
288
289 dx1 := 0; dx2 := 0;
290 dy1 := 0; dy2 := 0;
291
292 Result := Rect(0, 0, w, h);
293 case GikoSys.Setting.PopupPosition of
294 gppRightTop:
295 begin
296 dx1 := 0; dx2 := + DIV_X;
297 dy1 := -h; dy2 := - DIV_Y;
298 end;
299 gppRight:
300 begin
301 dx1 := 0; dx2 := + DIV_X;
302 dy1 := - (h div 2); dy2 := 0;
303 end;
304 gppRightBottom:
305 begin
306 dx1 := 0; dx2 := + DIV_X;
307 dy1 := 0; dy2 := + DIV_Y;
308 end;
309 gppTop:
310 begin
311 dx1 := - (w div 2); dx2 := 0;
312 dy1 := -h; dy2 := - DIV_Y;
313 end;
314 // 綮?罩 gppCenter: OffsetRect(Result, p.x - (w div 2), p.y - (h div 2));
315 gppBottom:
316 begin
317 dx1 := - (w div 2); dx2 := 0;
318 dy1 := 0; dy2 := + DIV_Y;
319 end;
320 gppLeftTop:
321 begin
322 dx1 := -w; dx2 := - DIV_X ;
323 dy1 := -h; dy2 := - DIV_Y;
324 end;
325 gppLeft:
326 begin
327 dx1 := -w; dx2 := - DIV_X;
328 dy1 := - (h div 2); dy2 := 0;
329 end;
330 gppLeftBottom:
331 begin
332 dx1 := -w; dx2 := - DIV_X;
333 dy1 := 0; dy2 := + DIV_Y;
334 end;
335 end;
336 // ????篏?臀???Щ??
337 OffsetRect(Result, p.x + dx1 + dx2, p.y + dy1 + dy2);
338
339 MaxWidth := WorkArea.Right - WorkArea.Left;
340 MaxHeight := WorkArea.Bottom - WorkArea.Top;
341 // 篁ヤ???????篏?臀????馹?????????????Щ??
342 if (Result.Left < WorkArea.Left) then begin
343 // ???泣?ゃ?????茖????????違???阪??篏?臀???窪?活拶??
344 if ((p.X - WorkArea.Left) * 2 < MaxWidth) then begin
345 if ( (GikoSys.Setting.PopupPosition = gppTop) or
346 (GikoSys.Setting.PopupPosition = gppBottom)) then begin
347 OffsetRect(Result, -Result.Left, 0);
348 end else begin
349 OffsetRect(Result, - (dx1 + 2 * dx2), 0);
350 end;
351 end else begin
352 // ?脂?∝??障?х?脂?√???絨???????
353 Result := Rect(WorkArea.Left, Result.Top,
354 Result.Right, Result.Bottom);
355 end;
356 end;
357 if (Result.Top < WorkArea.Top) then begin
358 // 綺??眼???茖????????違???阪??篏?臀????筝?荵∽?/span>
359 if ((p.Y - WorkArea.Top) * 2 < MaxHeight) then begin
360 OffsetRect(Result, 0, - (dy1 + 2 * dy2));
361 end else begin
362 // ?脂?∝??障?х?脂?∫???絨???????
363 Result := Rect(Result.Left, WorkArea.Top,
364 Result.Right, Result.Bottom);
365 end;
366 end;
367 if (Result.Right > WorkArea.Right) then begin
368 // ???泣?ゃ?????茖????????違???阪??篏?臀???窪?活拶??
369 if ((p.X - WorkArea.Left) * 2 > WorkArea.Right) then begin
370 if( (GikoSys.Setting.PopupPosition = gppTop) or
371 (GikoSys.Setting.PopupPosition = gppBottom)) then begin
372 OffsetRect(Result, -(Result.Right - WorkArea.Right), 0);
373 end else begin
374 OffsetRect(Result, -w - (dx1 + 2 * dx2), 0);
375 end;
376 // ???泣?ゃ???????若???若?????翫?????脂?∝??障?у???絨???????
377 if (Result.Left < WorkArea.Left) then begin
378 Result := Rect(WorkArea.Left, Result.Top,
379 Result.Right, Result.Bottom);
380 end;
381 end else begin
382 // ?脂?∝??障?х?脂?√???絨???????
383 Result := Rect(Result.Left, Result.Top,
384 WorkArea.Right, Result.Bottom);
385 end;
386 end;
387 if (Result.Bottom > WorkArea.Bottom) then begin
388 // 筝??眼???茖????????違???阪??篏?臀????筝?荵∽?/span>
389 if ((p.Y - WorkArea.Top) * 2 > WorkArea.Bottom) then begin
390 OffsetRect(Result, 0, -h - (dy1 + 2 * dy2));
391 // 筝???黄?????翫??????
392 if (Result.Top < WorkArea.Top) then begin
393 Result := Rect(Result.Left, WorkArea.Top,
394 Result.Right, Result.Bottom);
395 end;
396 end else begin
397 // ?脂?∝??障?х?脂?∫???絨???????
398 Result := Rect(Result.Left, Result.Top,
399 Result.Right, WorkArea.Bottom);
400 end;
401 end;
402 end;
403 function TResPopupBrowser.GetWindowHeight : Integer;
404 var
405 top: Integer;
406 item: OleVariant;
407 begin
408 Result := 0;
409 //???????吟?????若?帥????粋昭?推賢????????粋昭?帥??緇???/span>
410 while (Self.ReadyState <> READYSTATE_COMPLETE) and
411 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
412 Sleep(1);
413 Forms.Application.ProcessMessages;
414 end;
415
416 try
417 top := 0;
418 item := OleVariant( Self.Document as IHTMLDocument2)
419 .anchors.item(OleVariant('bottom'));
420 item.focus();
421 repeat
422 top := top + item.offsetTop;
423 item := item.offsetParent;
424 until AnsiCompareText(item.tagName, 'body' ) = 0;
425 Result := top;
426 except
427 end;
428 end;
429 function TResPopupBrowser.ResPopupBrowserClick(Sender: TObject): WordBool;
430 begin
431 // ???潟???????????若???鴻??絅??c???????с?????若?????∞??????菴???
432 Blur;
433 Result := True;
434 end;
435 function TResPopupBrowser.GetThread: TThreadItem;
436 begin
437 Result := nil;
438 if (FThread <> nil) then begin
439 try
440 // ?≦?鴻?????ゃ?潟?炊???/span>
441 if (FThread.ParentBoard <> nil) then begin
442 Result := FThread
443 end;
444 except
445 //?≦?鴻?????ゃ?潟?帥???c??
446 Result := nil;
447 end;
448 end;
449 end;
450 procedure TResPopupBrowser.Blur;
451 var
452 FOleInPlaceActiveObject: IOleInPlaceActiveObject;
453 begin
454 FOleInPlaceActiveObject := Self.ControlInterface as IOleInPlaceActiveObject;
455 FOleInPlaceActiveObject.OnFrameWindowActivate(False);
456 end;
457 function TResPopupBrowser.ResPopupBrowserDbClick(Sender: TObject): WordBool;
458 begin
459 // ???潟???????????若???鴻??絅??c???????с?????若?????∞??????菴???
460 Blur;
461 // ?????ц????????????????с???<???祉?若?悟??宴?ф???????????
462 PostMessage( GikoForm.Handle , USER_RESPOPUPCLEAR, Integer( Self ), 0 );
463 Result := True;
464 end;
465 initialization
466 OleInitialize(nil);
467
468 finalization
469 OleUninitialize;
470
471 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26