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

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