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.9 - (hide annotations) (download) (as text)
Mon Aug 11 10:35:29 2008 UTC (15 years, 8 months ago) by eggcake
Branch: MAIN
CVS Tags: v1_59_0_771, v1_59_0_770, v1_59_0_773, v1_59_0_772, v1_59_0_775, v1_59_0_774, v1_59_0_777, v1_59_0_776, v1_59_0_778, v1_59_1_765, v1_60_0_788, v1_60_0_789, v1_60_0_781, v1_60_0_782, v1_60_0_784, v1_60_0_786, v1_60_0_787, v1_59_0_767, v1_59_1_778, v1_59_0_768, v1_59_0_769, v1_60_0_780, v1_60_0_779, v1_60_0_783, v1_59_2_785
Branch point for: Bb59, Bb58
Changes since 1.8: +9 -3 lines
File MIME type: text/x-pascal
ResPopBrowserの参照カウントを正しくなるように修正

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 eggcake 1.9 GikoSys.ShowRefCount('ResPop Create', Self.ControlInterface);
70     GikoSys.ShowRefCount('ResPop.Document Create', Self.ControlInterface.Document);
71 h677 1.2 end;
72    
73     destructor TResPopupBrowser.Destroy;
74     begin
75     Self.Blur;
76     Self.OnEnter := nil;
77     Self.OnBeforeNavigate2 := nil;
78     Self.OnStatusTextChange := nil;
79     Self.OnNewWindow2 := nil;
80     if (FChild <> nil) then begin
81     FChild.Free;
82     FChild := nil;
83     end;
84     if (FEvent <> nil) then begin
85     FEvent.Free;
86     FEvent := nil;
87     end;
88     FThread := nil;
89 eggcake 1.9
90     GikoSys.ShowRefCount('ResPop Desctroy', Self.ControlInterface);
91     GikoSys.ShowRefCount('ResPop.Document Create', Self.ControlInterface.Document);
92    
93 h677 1.2 inherited Destroy;
94     end;
95    
96     procedure TResPopupBrowser.CreateParams(var Params: TCreateParams);
97     begin
98     inherited;
99     Params.Style := Params.Style or WS_EX_TOOLWINDOW;
100    
101     end;
102     function TResPopupBrowser.CreateNewBrowser: TResPopupBrowser;
103     begin
104     if (Self.Visible) then begin
105     if (FChild <> nil) then begin
106     if (FChild.Visible) then begin
107     Result := FChild.CreateNewBrowser;
108     end else begin
109     Result := FChild;
110     end;
111     end else begin
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,
120     0, 0, 0 , 0,
121     SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
122     Result := FChild;
123     end;
124     end else begin
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,
132     0, 0, 0 , 0,
133     SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
134     Result := Self;
135     end;
136     end;
137     function TResPopupBrowser.CurrentBrowser: TResPopupBrowser;
138     begin
139     Result := Self.CreateNewBrowser;
140     if (Result.ParentBrowser <> nil) then
141     Result := Result.ParentBrowser;
142     end;
143     procedure TResPopupBrowser.NavigateBlank(Forced: Boolean);
144     begin
145 eggcake 1.9 if (not Assigned(Self.ControlInterface.Document)) or (Forced) then begin
146 h677 1.2 Self.Navigate('about:blank');
147     end;
148     while (Self.ReadyState <> READYSTATE_COMPLETE) and
149     (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
150     Sleep(1);
151     Forms.Application.ProcessMessages;
152     end;
153     end;
154     procedure TResPopupBrowser.TitlePopup;
155     begin
156     Write('', True);
157     end;
158     procedure TResPopupBrowser.Popup;
159     begin
160 h677 1.6 if (GetAsyncKeyState(VK_SHIFT) = Smallint($8001)) then begin
161     // ?激?????若???????翫?????????障?上?冴??
162     Write(Self.RawDocument, false);
163     end else begin
164     // 薑???腟泣??荀?????????????茹??鴻???若??2??&nbsp;*2??舟??????
165     Write(
166     MojuUtils.CustomStringReplace(
167     Self.RawDocument, ' ', '&nbsp;&nbsp;'),
168     false);
169     end;
170 h677 1.2 end;
171     procedure TResPopupBrowser.Write(ADocument: String; OnlyTitle: Boolean = False);
172     var
173     p: TPoint;
174 eggcake 1.8 doc: OleVariant;
175 h677 1.4 ARect: TRect;
176 h677 1.2 begin
177     try
178     // ?帥?鴻?????若????羔???
179     SetWindowLongA(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
180     GetCursorpos(p);
181     // ???c????膰??
182     SetWindowPos(Self.Handle, HWND_BOTTOM,
183     p.X, p.Y, 50 , 50,
184     SWP_NOACTIVATE or SWP_HIDEWINDOW);
185 eggcake 1.8 doc := Self.OleObject.Document;
186 h677 1.2 doc.open;
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>');
195    
196     doc.Close;
197 h677 1.7 // ???????≪???水?綽?
198     ARect := CalcRect(Screen.MonitorFromPoint(p).WorkareaRect,
199     not OnlyTitle);
200 h677 1.2
201 eggcake 1.9 FEvent := THTMLDocumentEventSink.Create(Self, Self.OleObject.Document, HTMLDocumentEvents2);
202 h677 1.2 FEvent.OnClick := ResPopupBrowserClick;
203 h677 1.5 FEvent.OnDoubleClick := ResPopupBrowserDbClick;
204 h677 1.2 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);
211     except
212     end;
213     end;
214     function TResPopupBrowser.GetTitle(OnlyTitle: Boolean): string;
215     begin
216     Result := '<span id="hTitle">' + Title +'</span>';
217     if OnlyTitle then Result := Result + '<BR>';
218     end;
219     function TResPopupBrowser.GetBodyStyle(OnlyTitle: Boolean = False): string;
220     var
221     i : Integer;
222     begin
223    
224     Result := '<style type="text/css">' +
225     'dl { margin :0px; padding :0px}'#13#10 +
226     'body { ' +
227     'border-width: 1px; border-style: solid;white-space: nowrap; ' +
228     'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px; ';
229    
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 ) + ';';
240     end;
241     if OnlyTitle then
242     Result := Result + 'overflow: hidden; ';
243    
244     Result := Result + '}';
245     if GikoSys.Setting.ResPopupHeaderBold then begin
246     Result := Result + #13#10'span#hTitle{font-weight: bold; }';
247     end;
248     Result := Result + '</style>';
249     end;
250    
251     procedure TResPopupBrowser.Clear;
252     begin
253     ChildClear;
254     if (Self.Visible) then begin
255     Self.Title := '';
256     Self.RawDocument := '';
257     Self.FThread := nil;
258     Self.FEvent.Free;
259     Self.FEvent := nil;
260     Self.Blur;
261     ShowWindow(Self.Handle, SW_HIDE);
262     Self.Visible := False;
263     end;
264     end;
265     procedure TResPopupBrowser.ChildClear;
266     begin
267     if (FChild <> nil) then begin
268     FChild.Clear;
269     end;
270     end;
271    
272     function TResPopupBrowser.CalcRect(WorkArea: TRect; Scroll: Boolean): TRect;
273     var
274     p: TPoint;
275     ele: IHTMLElement2;
276     h, w, dx1, dx2, dy1, dy2: Integer;
277     MaxWidth, MaxHeight: Integer;
278 h677 1.4 DIV_X, DIV_Y: Integer;
279 h677 1.2 begin
280     GetCursorpos(p);
281 eggcake 1.9 ele := ((Self.ControlInterface.Document as IHTMLDocument2).body as IHTMLElement2);
282 h677 1.2 if Scroll then begin
283     h := GetWindowHeight + 10;
284     w := ele.scrollWidth + 25
285     end else begin
286     h := GetWindowHeight + 5;
287     w := ele.scrollWidth + 10;
288     end;
289    
290 h677 1.4 DIV_X := GikoSys.Setting.RespopupDeltaX;
291     DIV_Y := GikoSys.Setting.RespopupDeltaY;
292    
293 h677 1.2 dx1 := 0; dx2 := 0;
294     dy1 := 0; dy2 := 0;
295    
296     Result := Rect(0, 0, w, h);
297     case GikoSys.Setting.PopupPosition of
298     gppRightTop:
299     begin
300 h677 1.3 dx1 := 0; dx2 := + DIV_X;
301     dy1 := -h; dy2 := - DIV_Y;
302 h677 1.2 end;
303     gppRight:
304     begin
305 h677 1.3 dx1 := 0; dx2 := + DIV_X;
306 h677 1.2 dy1 := - (h div 2); dy2 := 0;
307     end;
308     gppRightBottom:
309     begin
310 h677 1.3 dx1 := 0; dx2 := + DIV_X;
311     dy1 := 0; dy2 := + DIV_Y;
312 h677 1.2 end;
313     gppTop:
314     begin
315     dx1 := - (w div 2); dx2 := 0;
316 h677 1.3 dy1 := -h; dy2 := - DIV_Y;
317 h677 1.2 end;
318     // 綮?罩 gppCenter: OffsetRect(Result, p.x - (w div 2), p.y - (h div 2));
319     gppBottom:
320     begin
321     dx1 := - (w div 2); dx2 := 0;
322 h677 1.3 dy1 := 0; dy2 := + DIV_Y;
323 h677 1.2 end;
324     gppLeftTop:
325     begin
326 h677 1.3 dx1 := -w; dx2 := - DIV_X ;
327     dy1 := -h; dy2 := - DIV_Y;
328 h677 1.2 end;
329     gppLeft:
330     begin
331 h677 1.3 dx1 := -w; dx2 := - DIV_X;
332 h677 1.2 dy1 := - (h div 2); dy2 := 0;
333     end;
334     gppLeftBottom:
335     begin
336 h677 1.3 dx1 := -w; dx2 := - DIV_X;
337     dy1 := 0; dy2 := + DIV_Y;
338 h677 1.2 end;
339     end;
340     // ????篏?臀???Щ??
341     OffsetRect(Result, p.x + dx1 + dx2, p.y + dy1 + dy2);
342    
343     MaxWidth := WorkArea.Right - WorkArea.Left;
344     MaxHeight := WorkArea.Bottom - WorkArea.Top;
345     // 篁ヤ???????篏?臀????馹?????????????Щ??
346     if (Result.Left < WorkArea.Left) then begin
347     // ???泣?ゃ?????茖????????違???阪??篏?臀???窪?活拶??
348 h677 1.7 if ((p.X - WorkArea.Left) * 2 < MaxWidth) then begin
349 h677 1.2 if ( (GikoSys.Setting.PopupPosition = gppTop) or
350     (GikoSys.Setting.PopupPosition = gppBottom)) then begin
351 h677 1.7 OffsetRect(Result, -Result.Left, 0);
352 h677 1.2 end else begin
353     OffsetRect(Result, - (dx1 + 2 * dx2), 0);
354     end;
355     end else begin
356     // ?脂?∝??障?х?脂?√???絨???????
357 h677 1.7 Result := Rect(WorkArea.Left, Result.Top,
358 h677 1.2 Result.Right, Result.Bottom);
359     end;
360     end;
361     if (Result.Top < WorkArea.Top) then begin
362     // 綺??眼???茖????????違???阪??篏?臀????筝?荵∽?/span>
363 h677 1.7 if ((p.Y - WorkArea.Top) * 2 < MaxHeight) then begin
364 h677 1.2 OffsetRect(Result, 0, - (dy1 + 2 * dy2));
365     end else begin
366     // ?脂?∝??障?х?脂?∫???絨???????
367     Result := Rect(Result.Left, WorkArea.Top,
368     Result.Right, Result.Bottom);
369     end;
370     end;
371     if (Result.Right > WorkArea.Right) then begin
372     // ???泣?ゃ?????茖????????違???阪??篏?臀???窪?活拶??
373 h677 1.7 if ((p.X - WorkArea.Left) * 2 > WorkArea.Right) then begin
374 h677 1.2 if( (GikoSys.Setting.PopupPosition = gppTop) or
375     (GikoSys.Setting.PopupPosition = gppBottom)) then begin
376     OffsetRect(Result, -(Result.Right - WorkArea.Right), 0);
377     end else begin
378     OffsetRect(Result, -w - (dx1 + 2 * dx2), 0);
379     end;
380     // ???泣?ゃ???????若???若?????翫?????脂?∝??障?у???絨???????
381     if (Result.Left < WorkArea.Left) then begin
382     Result := Rect(WorkArea.Left, Result.Top,
383     Result.Right, Result.Bottom);
384     end;
385     end else begin
386     // ?脂?∝??障?х?脂?√???絨???????
387     Result := Rect(Result.Left, Result.Top,
388     WorkArea.Right, Result.Bottom);
389     end;
390     end;
391     if (Result.Bottom > WorkArea.Bottom) then begin
392     // 筝??眼???茖????????違???阪??篏?臀????筝?荵∽?/span>
393 h677 1.7 if ((p.Y - WorkArea.Top) * 2 > WorkArea.Bottom) then begin
394 h677 1.2 OffsetRect(Result, 0, -h - (dy1 + 2 * dy2));
395     // 筝???黄?????翫??????
396     if (Result.Top < WorkArea.Top) then begin
397     Result := Rect(Result.Left, WorkArea.Top,
398     Result.Right, Result.Bottom);
399     end;
400     end else begin
401     // ?脂?∝??障?х?脂?∫???絨???????
402     Result := Rect(Result.Left, Result.Top,
403     Result.Right, WorkArea.Bottom);
404     end;
405     end;
406     end;
407     function TResPopupBrowser.GetWindowHeight : Integer;
408     var
409     top: Integer;
410     item: OleVariant;
411     begin
412     Result := 0;
413     //???????吟?????若?帥????粋昭?推賢????????粋昭?帥??緇???/span>
414     while (Self.ReadyState <> READYSTATE_COMPLETE) and
415     (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
416     Sleep(1);
417     Forms.Application.ProcessMessages;
418     end;
419    
420     try
421     top := 0;
422 eggcake 1.8 item := Self.OleObject.Document.anchors.item(OleVariant('bottom'));
423 h677 1.2 item.focus();
424     repeat
425     top := top + item.offsetTop;
426     item := item.offsetParent;
427     until AnsiCompareText(item.tagName, 'body' ) = 0;
428     Result := top;
429     except
430     end;
431     end;
432     function TResPopupBrowser.ResPopupBrowserClick(Sender: TObject): WordBool;
433     begin
434     // ???潟???????????若???鴻??絅??c???????с?????若?????∞??????菴???
435     Blur;
436     Result := True;
437     end;
438     function TResPopupBrowser.GetThread: TThreadItem;
439     begin
440     Result := nil;
441     if (FThread <> nil) then begin
442     try
443     // ?≦?鴻?????ゃ?潟?炊???/span>
444     if (FThread.ParentBoard <> nil) then begin
445     Result := FThread
446     end;
447     except
448     //?≦?鴻?????ゃ?潟?帥???c??
449     Result := nil;
450     end;
451     end;
452     end;
453     procedure TResPopupBrowser.Blur;
454     var
455     FOleInPlaceActiveObject: IOleInPlaceActiveObject;
456     begin
457     FOleInPlaceActiveObject := Self.ControlInterface as IOleInPlaceActiveObject;
458     FOleInPlaceActiveObject.OnFrameWindowActivate(False);
459     end;
460 h677 1.5 function TResPopupBrowser.ResPopupBrowserDbClick(Sender: TObject): WordBool;
461     begin
462     // ???潟???????????若???鴻??絅??c???????с?????若?????∞??????菴???
463     Blur;
464     // ?????ц????????????????с???<???祉?若?悟??宴?ф???????????
465     PostMessage( GikoForm.Handle , USER_RESPOPUPCLEAR, Integer( Self ), 0 );
466     Result := True;
467     end;
468 h677 1.2 initialization
469     OleInitialize(nil);
470    
471     finalization
472     OleUninitialize;
473    
474     end.

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