Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/ResPopupBrowser.pas

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


Revision 1.7 - (hide 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 h677 1.2 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 h677 1.5 function ResPopupBrowserDbClick(Sender: TObject): WordBool;
33 h677 1.2 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 h677 1.3 uses MojuUtils, GikoSystem, Setting, Giko, GikoDataModule, Preview;
58 h677 1.2
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 h677 1.6 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 h677 1.2 end;
165     procedure TResPopupBrowser.Write(ADocument: String; OnlyTitle: Boolean = False);
166     var
167     p: TPoint;
168     doc: Variant;
169 h677 1.4 ARect: TRect;
170 h677 1.2 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 h677 1.7 // ???????≪???水?綽?
193     ARect := CalcRect(Screen.MonitorFromPoint(p).WorkareaRect,
194     not OnlyTitle);
195 h677 1.2
196     FDispHtmlDocument := Idispatch(OleVariant(Self.ControlInterface).Document) as DispHTMLDocument;
197     FEvent := THTMLDocumentEventSink.Create(Self, FDispHtmlDocument, HTMLDocumentEvents2);
198     FEvent.OnClick := ResPopupBrowserClick;
199 h677 1.5 FEvent.OnDoubleClick := ResPopupBrowserDbClick;
200 h677 1.2 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 h677 1.4 DIV_X, DIV_Y: Integer;
275 h677 1.2 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 h677 1.4 DIV_X := GikoSys.Setting.RespopupDeltaX;
287     DIV_Y := GikoSys.Setting.RespopupDeltaY;
288    
289 h677 1.2 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 h677 1.3 dx1 := 0; dx2 := + DIV_X;
297     dy1 := -h; dy2 := - DIV_Y;
298 h677 1.2 end;
299     gppRight:
300     begin
301 h677 1.3 dx1 := 0; dx2 := + DIV_X;
302 h677 1.2 dy1 := - (h div 2); dy2 := 0;
303     end;
304     gppRightBottom:
305     begin
306 h677 1.3 dx1 := 0; dx2 := + DIV_X;
307     dy1 := 0; dy2 := + DIV_Y;
308 h677 1.2 end;
309     gppTop:
310     begin
311     dx1 := - (w div 2); dx2 := 0;
312 h677 1.3 dy1 := -h; dy2 := - DIV_Y;
313 h677 1.2 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 h677 1.3 dy1 := 0; dy2 := + DIV_Y;
319 h677 1.2 end;
320     gppLeftTop:
321     begin
322 h677 1.3 dx1 := -w; dx2 := - DIV_X ;
323     dy1 := -h; dy2 := - DIV_Y;
324 h677 1.2 end;
325     gppLeft:
326     begin
327 h677 1.3 dx1 := -w; dx2 := - DIV_X;
328 h677 1.2 dy1 := - (h div 2); dy2 := 0;
329     end;
330     gppLeftBottom:
331     begin
332 h677 1.3 dx1 := -w; dx2 := - DIV_X;
333     dy1 := 0; dy2 := + DIV_Y;
334 h677 1.2 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 h677 1.7 if ((p.X - WorkArea.Left) * 2 < MaxWidth) then begin
345 h677 1.2 if ( (GikoSys.Setting.PopupPosition = gppTop) or
346     (GikoSys.Setting.PopupPosition = gppBottom)) then begin
347 h677 1.7 OffsetRect(Result, -Result.Left, 0);
348 h677 1.2 end else begin
349     OffsetRect(Result, - (dx1 + 2 * dx2), 0);
350     end;
351     end else begin
352     // ?脂?∝??障?х?脂?√???絨???????
353 h677 1.7 Result := Rect(WorkArea.Left, Result.Top,
354 h677 1.2 Result.Right, Result.Bottom);
355     end;
356     end;
357     if (Result.Top < WorkArea.Top) then begin
358     // 綺??眼???茖????????違???阪??篏?臀????筝?荵∽?/span>
359 h677 1.7 if ((p.Y - WorkArea.Top) * 2 < MaxHeight) then begin
360 h677 1.2 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 h677 1.7 if ((p.X - WorkArea.Left) * 2 > WorkArea.Right) then begin
370 h677 1.2 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 h677 1.7 if ((p.Y - WorkArea.Top) * 2 > WorkArea.Bottom) then begin
390 h677 1.2 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 h677 1.5 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 h677 1.2 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