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.1.2.7 - (hide annotations) (download) (as text)
Sun May 13 14:49:06 2007 UTC (16 years, 11 months ago) by h677
Branch: bRESPOPUP
Changes since 1.1.2.6: +28 -13 lines
File MIME type: text/x-pascal
レスポップアップのメソッドを新設
ポップアップ中でメル欄のポップアップが利かない不具合の修正

1 h677 1.1.2.1 unit ResPopupBrowser;
2     interface
3     uses
4     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
5 h677 1.1.2.6 ActiveX, OleCtrls, {HintWindow,}
6 h677 1.1.2.1 {$IF Defined(DELPRO) }
7     SHDocVw,
8     MSHTML
9     {$ELSE}
10     SHDocVw_TLB,
11     MSHTML_TLB
12     {$IFEND}
13     ;
14    
15     type
16 h677 1.1.2.6 TGikoPopupType = (gptRaw, gptThread);
17    
18 h677 1.1.2.1 TResPopupBrowser = class(TWebBrowser)
19     private
20     FChild :TResPopupBrowser;
21 h677 1.1.2.7 FParentBrowser :TResPopupBrowser;
22 h677 1.1.2.1 FTitle :String;
23 h677 1.1.2.7 FRawDocument: String;
24 h677 1.1.2.1 FPopupType: TGikoPopupType;
25 h677 1.1.2.6 function GetBodyStyle(OnlyTitle: Boolean = False): string;
26 h677 1.1.2.4 function GetWindowHeight : Integer;
27 h677 1.1.2.6 function GetTitle(OnlyTitle: Boolean): string;
28     function CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect;
29 h677 1.1.2.1 protected
30     procedure CreateParams(var Params: TCreateParams); override;
31     public
32     constructor Create(AOwner: TComponent); override;
33     destructor Destroy; override;
34     property Child: TResPopupBrowser read FChild;
35 h677 1.1.2.7 property ParentBrowser:TResPopupBrowser read FParentBrowser write FParentBrowser;
36 h677 1.1.2.1 property Title: String read FTitle write FTitle;
37 h677 1.1.2.7 property RawDocument: String read FRawDocument write FRawDocument;
38 h677 1.1.2.1 function CreateNewBrowser: TResPopupBrowser;
39 h677 1.1.2.7 function CurrentBrowser: TResPopupBrowser;
40 h677 1.1.2.6 procedure Write(ADocument: String; OnlyTitle: Boolean = False);
41 h677 1.1.2.1 procedure Clear;
42     procedure ChildClear;
43     procedure NavigateBlank;
44 h677 1.1.2.6 property PopupType: TGikoPopupType read FPopupType write FPopupType;
45     procedure TitlePopup;
46 h677 1.1.2.7 procedure Popup;
47 h677 1.1.2.1 end;
48    
49     implementation
50     uses MojuUtils, GikoSystem, Setting, Giko;
51    
52    
53     constructor TResPopupBrowser.Create(AOwner: TComponent);
54     begin
55     inherited Create(AOwner);
56     FChild := nil;
57     Visible := False;
58 h677 1.1.2.2 Title := '';
59 h677 1.1.2.7 RawDocument := '';
60 h677 1.1.2.1 end;
61    
62     destructor TResPopupBrowser.Destroy;
63     begin
64     inherited Destroy;
65     end;
66    
67     procedure TResPopupBrowser.CreateParams(var Params: TCreateParams);
68     begin
69     inherited CreateParams(Params);
70     end;
71     function TResPopupBrowser.CreateNewBrowser: TResPopupBrowser;
72     begin
73     if (Self.Visible) then begin
74     if (FChild <> nil) then begin
75     if (FChild.Visible) then begin
76     Result := FChild.CreateNewBrowser;
77     end else begin
78     Result := FChild;
79     end;
80     end else begin
81 h677 1.1.2.7 FChild := TResPopupBrowser.Create(Self);
82     TOleControl(FChild).Parent := nil;
83     FChild.ParentBrowser := Self;
84     FChild.NavigateBlank;
85     FChild.OnEnter := GikoForm.BrowserEnter;
86     FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
87     FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
88     FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
89     ShowWindow(FChild.Handle, SW_HIDE);
90 h677 1.1.2.1 Result := FChild;
91     end;
92     end else begin
93     TOleControl(Self).Parent := nil;
94 h677 1.1.2.7 FParentBrowser := nil;
95 h677 1.1.2.1 Self.NavigateBlank;
96     Self.OnEnter := GikoForm.BrowserEnter;
97 h677 1.1.2.3 Self.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
98 h677 1.1.2.1 Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
99 h677 1.1.2.2 Self.OnNewWindow2 := GikoForm.BrowserNewWindow2;
100 h677 1.1.2.1 Result := Self;
101     end;
102 h677 1.1.2.7 end;
103     function TResPopupBrowser.CurrentBrowser: TResPopupBrowser;
104     begin
105     Result := Self.CreateNewBrowser;
106     if (Result.Parent <> nil) then
107     Result := Result.ParentBrowser;
108 h677 1.1.2.1 end;
109     procedure TResPopupBrowser.NavigateBlank;
110     begin
111     if (not Assigned(Self.Document)) then begin
112     Self.Navigate('about:blank');
113     end;
114     while (Self.ReadyState <> READYSTATE_COMPLETE) and
115     (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
116     Forms.Application.ProcessMessages;
117     end;
118     end;
119 h677 1.1.2.6 procedure TResPopupBrowser.TitlePopup;
120     begin
121     Write('', True);
122     end;
123 h677 1.1.2.7 procedure TResPopupBrowser.Popup;
124     begin
125     Write(Self.RawDocument, false);
126     end;
127 h677 1.1.2.6 procedure TResPopupBrowser.Write(ADocument: String; OnlyTitle: Boolean = False);
128 h677 1.1.2.1 var
129     doc: Variant;
130     ARect: TRect;
131     begin
132 h677 1.1.2.6 Self.OnStatusTextChange := nil;
133 h677 1.1.2.1 try
134 h677 1.1.2.6 try
135     // 鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申
136     SetWindowPos(Self.Handle, HWND_TOP,
137     0, 0, 50 , 50,
138     SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
139    
140     doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
141     doc.open;
142     doc.charset := 'Shift_JIS';
143     doc.Write('<html><head>'#13#10 +
144     '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10
145     + GetBodyStyle(OnlyTitle) + '</head><body>'
146     + GetTitle(OnlyTitle)
147     + ADocument + '<a name="bottom"></a></body></html>');
148     doc.Close;
149    
150     ARect := CalcRect(Screen.WorkAreaHeight, Screen.WorkAreaWidth,
151     not OnlyTitle);
152     SetWindowPos(Self.Handle, HWND_TOP,
153     ARect.Left, ARect.Top,
154     (ARect.Right - ARect.Left) ,
155     (ARect.Bottom - ARect.Top),
156     SWP_NOACTIVATE or SWP_HIDEWINDOW);
157    
158     ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
159     Self.Visible := True;
160     except
161     end;
162     finally
163     Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
164 h677 1.1.2.1 end;
165 h677 1.1.2.2
166     end;
167 h677 1.1.2.6 function TResPopupBrowser.GetTitle(OnlyTitle: Boolean): string;
168     begin
169     Result := '<span id="hTitle">' + Title +'</span>';
170     if OnlyTitle then Result := Result + '<BR>';
171     end;
172     function TResPopupBrowser.GetBodyStyle(OnlyTitle: Boolean = False): string;
173 h677 1.1.2.4 var
174     i : Integer;
175 h677 1.1.2.2 begin
176    
177     Result := '<style type="text/css">' +
178     'dl { margin :0px; padding :0px}'#13#10 +
179     'body { ' +
180     'border-width: 1px; border-style: solid;white-space: nowrap; ' +
181 h677 1.1.2.4 'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px; ';
182 h677 1.1.2.2
183     if Length( GikoSys.Setting.HintFontName ) > 0 then
184     Result := Result + 'font-family:"' + GikoSys.Setting.HintFontName + '";';
185     if GikoSys.Setting.HintFontSize <> 0 then
186     Result := Result + 'font-size:' + IntToStr( GikoSys.Setting.HintFontSize ) + 'pt;';
187     if GikoSys.Setting.HintFontColor <> -1 then
188     Result := Result + 'color:#' + IntToHex( GikoSys.Setting.HintFontColor, 6 ) + ';';
189 h677 1.1.2.4 if GikoSys.Setting.HintBackColor <> -1 then begin
190     i := ColorToRGB( GikoSys.Setting.HintBackColor );
191 h677 1.1.2.2 Result := Result + 'background-color:#' +
192 h677 1.1.2.4 IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';
193     end;
194 h677 1.1.2.6 if OnlyTitle then
195     Result := Result + 'overflow: hidden; ';
196 h677 1.1.2.2
197 h677 1.1.2.5 Result := Result + '}';
198     if GikoSys.Setting.ResPopupHeaderBold then begin
199     Result := Result + #13#10'span#hTitle{font-weight: bold; }';
200     end;
201     Result := Result + '</style>';
202 h677 1.1.2.1 end;
203 h677 1.1.2.2
204 h677 1.1.2.1 procedure TResPopupBrowser.Clear;
205     begin
206     ChildClear;
207     if (Self.Visible) then begin
208 h677 1.1.2.2 Self.Title := '';
209 h677 1.1.2.7 Self.RawDocument := '';
210 h677 1.1.2.5 NavigateBlank;
211 h677 1.1.2.1 ShowWindow(Self.Handle, SW_HIDE);
212 h677 1.1.2.5 Self.Visible := False;
213 h677 1.1.2.1 end;
214     end;
215     procedure TResPopupBrowser.ChildClear;
216     begin
217     if (FChild <> nil) then begin
218     FChild.Clear;
219     end;
220     end;
221    
222 h677 1.1.2.6 function TResPopupBrowser.CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect;
223 h677 1.1.2.1 var
224     p: TPoint;
225 h677 1.1.2.2 ele: IHTMLElement2;
226 h677 1.1.2.4 h, w: Integer;
227 h677 1.1.2.1 begin
228     GetCursorpos(p);
229 h677 1.1.2.2 ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
230 h677 1.1.2.6 if Scroll then begin
231     h := GetWindowHeight + 10;
232     w := ele.scrollWidth + 25
233     end else begin
234     h := GetWindowHeight + 5;
235     w := ele.scrollWidth + 10;
236     end;
237 h677 1.1.2.4 Result := Rect(0, 0, w, h);
238 h677 1.1.2.1 case GikoSys.Setting.PopupPosition of
239 h677 1.1.2.4 gppRightTop: OffsetRect(Result, p.x - w - 2, p.y - h - 2);
240     gppRight: OffsetRect(Result, p.x - w - 2, p.y - (h div 2));
241     gppRightBottom: OffsetRect(Result, p.x - w -2, p.y + 2);
242     gppTop: OffsetRect(Result, p.x - (w div 2), p.y - h - 2);
243     gppCenter: OffsetRect(Result, p.x - (w div 2), p.y - (h div 2));
244     gppBottom: OffsetRect(Result, p.x - (w div 2), p.y + 2);
245     gppLeftTop: OffsetRect(Result, p.x + 2, p.y - h - 2);
246     gppLeft: OffsetRect(Result, p.x + 2, p.y - (h div 2));
247 h677 1.1.2.3 gppLeftBottom: OffsetRect(Result, p.x + 2, p.y + 2);
248 h677 1.1.2.1 end;
249     if (Result.Left < 0) then begin
250     OffsetRect(Result, -Result.Left, 0);
251     end;
252     if (Result.Top < 0) then begin
253     OffsetRect(Result, 0, -Result.Top);
254     end;
255 h677 1.1.2.4 if (Result.Right > MaxWidth) then begin
256     OffsetRect(Result, - (Result.Right - MaxWidth), 0);
257     end;
258     if (Result.Bottom > MaxHeight) then begin
259     OffsetRect(Result, 0, - (Result.Bottom - MaxHeight));
260     end;
261 h677 1.1.2.5
262 h677 1.1.2.4 // 鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
263     if (Result.Left < 0) then begin
264     Result := Rect(0, Result.Top,
265     Result.Right, Result.Bottom);
266     end;
267     if (Result.Top < 0) then begin
268     Result := Rect(Result.Left, 0,
269     Result.Right, Result.Bottom);
270     end;
271 h677 1.1.2.1 end;
272 h677 1.1.2.4 function TResPopupBrowser.GetWindowHeight : Integer;
273     var
274     top: Integer;
275     item: OleVariant;
276     begin
277 h677 1.1.2.5 Result := 0;
278 h677 1.1.2.4 //鐃?鐃緒申鐃?鐃?鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
279     while (Self.ReadyState <> READYSTATE_COMPLETE) and
280     (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
281     Sleep(1);
282     Forms.Application.ProcessMessages;
283     end;
284 h677 1.1.2.1
285 h677 1.1.2.4 try
286     top := 0;
287     item := OleVariant( Self.Document as IHTMLDocument2)
288     .anchors.item(OleVariant('bottom'));
289     item.focus();
290     repeat
291     top := top + item.offsetTop;
292     item := item.offsetParent;
293     until AnsiCompareText(item.tagName, 'body' ) = 0;
294     Result := top;
295     except
296     end;
297     end;
298 h677 1.1.2.1 end.

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