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.1.2.9 - (show annotations) (download) (as text)
Mon May 14 22:02:43 2007 UTC (16 years, 11 months ago) by h677
Branch: bRESPOPUP
CVS Tags: v1_56_0_706
Changes since 1.1.2.8: +79 -36 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(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect;
31 function ResPopupBrowserClick(Sender: TObject): WordBool;
32 function GetThread: TThreadItem;
33 protected
34 procedure CreateParams(var Params: TCreateParams); override;
35 public
36 constructor Create(AOwner: TComponent); override;
37 destructor Destroy; override;
38 property Child: TResPopupBrowser read FChild;
39 property ParentBrowser:TResPopupBrowser read FParentBrowser write FParentBrowser;
40 property Title: String read FTitle write FTitle;
41 property RawDocument: String read FRawDocument write FRawDocument;
42 property Thread: TThreadItem read GetThread write FThread;
43 function CreateNewBrowser: TResPopupBrowser;
44 function CurrentBrowser: TResPopupBrowser;
45 procedure Write(ADocument: String; OnlyTitle: Boolean = False);
46 procedure Clear;
47 procedure ChildClear;
48 procedure NavigateBlank;
49 property PopupType: TGikoPopupType read FPopupType write FPopupType;
50 procedure TitlePopup;
51 procedure Popup;
52 end;
53
54 implementation
55 uses MojuUtils, GikoSystem, Setting, Giko, GikoDataModule;
56
57
58 constructor TResPopupBrowser.Create(AOwner: TComponent);
59 begin
60 inherited Create(AOwner);
61 FChild := nil;
62 Visible := False;
63 Title := '';
64 RawDocument := '';
65 FEvent := nil;
66 end;
67
68 destructor TResPopupBrowser.Destroy;
69 begin
70 Self.OnEnter := nil;
71 Self.OnBeforeNavigate2 := nil;
72 Self.OnStatusTextChange := nil;
73 Self.OnNewWindow2 := nil;
74 if (FChild <> nil) then begin
75 FChild.Free;
76 FChild := nil;
77 end;
78 if (FEvent <> nil) then begin
79 FEvent.Free;
80 FEvent := nil;
81 end;
82 FThread := nil;
83 inherited Destroy;
84 end;
85
86 procedure TResPopupBrowser.CreateParams(var Params: TCreateParams);
87 begin
88 inherited;
89 Params.Style := Params.Style or WS_EX_TOOLWINDOW;
90
91 end;
92 function TResPopupBrowser.CreateNewBrowser: TResPopupBrowser;
93 begin
94 if (Self.Visible) then begin
95 if (FChild <> nil) then begin
96 if (FChild.Visible) then begin
97 Result := FChild.CreateNewBrowser;
98 end else begin
99 Result := FChild;
100 end;
101 end else begin
102 FChild := TResPopupBrowser.Create(Self);
103 TOleControl(FChild).Parent := TOleControl(Self).Parent;
104 FChild.ParentBrowser := Self;
105 FChild.NavigateBlank;
106
107 FChild.OnEnter := GikoForm.BrowserEnter;
108 FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
109 FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
110 FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
111 SetWindowPos(FChild.Handle, HWND_BOTTOM,
112 0, 0, 0 , 0,
113 SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
114 ShowWindow(FChild.Handle, SW_HIDE);
115 Result := FChild;
116 end;
117 end else begin
118 TOleControl(Self).Parent := nil;
119 FParentBrowser := nil;
120 Self.NavigateBlank;
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;
138 begin
139 if (not Assigned(Self.Document)) then begin
140 Self.Navigate('about:blank');
141 end;
142 while (Self.ReadyState <> READYSTATE_COMPLETE) and
143 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
144 Forms.Application.ProcessMessages;
145 end;
146 end;
147 procedure TResPopupBrowser.TitlePopup;
148 begin
149 Write('', True);
150 end;
151 procedure TResPopupBrowser.Popup;
152 begin
153 Write(Self.RawDocument, false);
154 end;
155 procedure TResPopupBrowser.Write(ADocument: String; OnlyTitle: Boolean = False);
156 var
157 p: TPoint;
158 doc: Variant;
159 ARect: TRect;
160 FDispHtmlDocument: DispHTMLDocument;
161 begin
162 try
163 // ?帥?鴻?????若????羔???
164 SetWindowLongA(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
165 GetCursorpos(p);
166 // ???c????膰??
167 SetWindowPos(Self.Handle, HWND_BOTTOM,
168 p.X, p.Y, 50 , 50,
169 SWP_NOACTIVATE or SWP_HIDEWINDOW);
170 doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
171 doc.open;
172 doc.charset := 'Shift_JIS';
173 doc.Write('<html><head>'#13#10 +
174 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10
175 + GetBodyStyle(OnlyTitle) + '</head><body>'
176 + GetTitle(OnlyTitle)
177 + ADocument + '<a name="bottom"></a></body></html>');
178 doc.Close;
179
180 ARect := CalcRect(Screen.WorkAreaHeight, Screen.WorkAreaWidth,
181 not OnlyTitle);
182
183 FDispHtmlDocument := Idispatch(OleVariant(Self.ControlInterface).Document) as DispHTMLDocument;
184 FEvent := THTMLDocumentEventSink.Create(Self, FDispHtmlDocument, HTMLDocumentEvents2);
185 FEvent.OnClick := ResPopupBrowserClick;
186
187 Self.Visible := True;
188 SetWindowPos(Self.Handle, HWND_TOP,
189 ARect.Left, ARect.Top,
190 (ARect.Right - ARect.Left) ,
191 (ARect.Bottom - ARect.Top),
192 SWP_NOACTIVATE or SWP_HIDEWINDOW);
193
194 ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
195 except
196 end;
197 end;
198 function TResPopupBrowser.GetTitle(OnlyTitle: Boolean): string;
199 begin
200 Result := '<span id="hTitle">' + Title +'</span>';
201 if OnlyTitle then Result := Result + '<BR>';
202 end;
203 function TResPopupBrowser.GetBodyStyle(OnlyTitle: Boolean = False): string;
204 var
205 i : Integer;
206 begin
207
208 Result := '<style type="text/css">' +
209 'dl { margin :0px; padding :0px}'#13#10 +
210 'body { ' +
211 'border-width: 1px; border-style: solid;white-space: nowrap; ' +
212 'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px; ';
213
214 if Length( GikoSys.Setting.HintFontName ) > 0 then
215 Result := Result + 'font-family:"' + GikoSys.Setting.HintFontName + '";';
216 if GikoSys.Setting.HintFontSize <> 0 then
217 Result := Result + 'font-size:' + IntToStr( GikoSys.Setting.HintFontSize ) + 'pt;';
218 if GikoSys.Setting.HintFontColor <> -1 then
219 Result := Result + 'color:#' + IntToHex( GikoSys.Setting.HintFontColor, 6 ) + ';';
220 if GikoSys.Setting.HintBackColor <> -1 then begin
221 i := ColorToRGB( GikoSys.Setting.HintBackColor );
222 Result := Result + 'background-color:#' +
223 IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';
224 end;
225 if OnlyTitle then
226 Result := Result + 'overflow: hidden; ';
227
228 Result := Result + '}';
229 if GikoSys.Setting.ResPopupHeaderBold then begin
230 Result := Result + #13#10'span#hTitle{font-weight: bold; }';
231 end;
232 Result := Result + '</style>';
233 end;
234
235 procedure TResPopupBrowser.Clear;
236 var
237 body: IHTMLElement2;
238 begin
239 ChildClear;
240 if (Self.Visible) then begin
241 try
242 if (Self.ParentBrowser = nil) then begin
243 body := (Idispatch( olevariant(GikoForm.ActiveContent.Browser
244 .ControlInterface).Document) as IHTMLDocument2).body as IHTMLElement2;
245 body.focus;
246 end;
247 except
248 end;
249 Self.Title := '';
250 Self.RawDocument := '';
251 Self.FThread := nil;
252 FEvent.Free;
253 FEvent := nil;
254 NavigateBlank;
255 ShowWindow(Self.Handle, SW_HIDE);
256 Self.Visible := False;
257 end;
258 end;
259 procedure TResPopupBrowser.ChildClear;
260 begin
261 if (FChild <> nil) then begin
262 FChild.Clear;
263 end;
264 end;
265
266 function TResPopupBrowser.CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect;
267 var
268 p: TPoint;
269 ele: IHTMLElement2;
270 h, w: Integer;
271 begin
272 GetCursorpos(p);
273 ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
274 if Scroll then begin
275 h := GetWindowHeight + 10;
276 w := ele.scrollWidth + 25
277 end else begin
278 h := GetWindowHeight + 5;
279 w := ele.scrollWidth + 10;
280 end;
281 Result := Rect(0, 0, w, h);
282 case GikoSys.Setting.PopupPosition of
283 gppRightTop: OffsetRect(Result, p.x - w - 2, p.y - h - 2);
284 gppRight: OffsetRect(Result, p.x - w - 2, p.y - (h div 2));
285 gppRightBottom: OffsetRect(Result, p.x - w -2, p.y + 2);
286 gppTop: OffsetRect(Result, p.x - (w div 2), p.y - h - 2);
287 gppCenter: OffsetRect(Result, p.x - (w div 2), p.y - (h div 2));
288 gppBottom: OffsetRect(Result, p.x - (w div 2), p.y + 2);
289 gppLeftTop: OffsetRect(Result, p.x + 2, p.y - h - 2);
290 gppLeft: OffsetRect(Result, p.x + 2, p.y - (h div 2));
291 gppLeftBottom: OffsetRect(Result, p.x + 2, p.y + 2);
292 end;
293 if (Result.Left < 0) then begin
294 OffsetRect(Result, -Result.Left, 0);
295 end;
296 if (Result.Top < 0) then begin
297 OffsetRect(Result, 0, -Result.Top);
298 end;
299 if (Result.Right > MaxWidth) then begin
300 OffsetRect(Result, - (Result.Right - MaxWidth), 0);
301 end;
302 if (Result.Bottom > MaxHeight) then begin
303 OffsetRect(Result, 0, - (Result.Bottom - MaxHeight));
304 end;
305
306 // ?????у??綺?窪?????腆肴???????喝?冴???????????脂?≪?泣?ゃ?冴??絨???????
307 if (Result.Left < 0) then begin
308 Result := Rect(0, Result.Top,
309 Result.Right, Result.Bottom);
310 end;
311 if (Result.Top < 0) then begin
312 Result := Rect(Result.Left, 0,
313 Result.Right, Result.Bottom);
314 end;
315 end;
316 function TResPopupBrowser.GetWindowHeight : Integer;
317 var
318 top: Integer;
319 item: OleVariant;
320 begin
321 Result := 0;
322 //???????吟?????若?帥????粋昭?推賢????????粋昭?帥??緇???/span>
323 while (Self.ReadyState <> READYSTATE_COMPLETE) and
324 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
325 Sleep(1);
326 Forms.Application.ProcessMessages;
327 end;
328
329 try
330 top := 0;
331 item := OleVariant( Self.Document as IHTMLDocument2)
332 .anchors.item(OleVariant('bottom'));
333 item.focus();
334 repeat
335 top := top + item.offsetTop;
336 item := item.offsetParent;
337 until AnsiCompareText(item.tagName, 'body' ) = 0;
338 Result := top;
339 except
340 end;
341 end;
342 function TResPopupBrowser.ResPopupBrowserClick(Sender: TObject): WordBool;
343 var
344 doc: IHTMLDocument2;
345 body: IHTMLElement2;
346 begin
347 // doc := Idispatch( olevariant(
348 // GikoForm.ActiveContent.Browser.ControlInterface).Document) as IHTMLDocument2;
349 doc := Idispatch( olevariant(
350 Self.ControlInterface).Document) as IHTMLDocument2;
351 body := (doc.body as IHTMLElement2);
352 body.focus;
353 Result := True;
354 end;
355 function TResPopupBrowser.GetThread: TThreadItem;
356 begin
357 Result := nil;
358 if (FThread <> nil) then begin
359 try
360 // ?≦?鴻?????ゃ?潟?炊???/span>
361 if (FThread.ParentBoard <> nil) then begin
362 Result := FThread
363 end;
364 except
365 //?≦?鴻?????ゃ?潟?帥???c??
366 Result := nil;
367 end;
368 end;
369 end;
370 end.

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