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.3 - (show annotations) (download) (as text)
Tue May 8 22:25:45 2007 UTC (16 years, 11 months ago) by h677
Branch: bRESPOPUP
CVS Tags: v1_56_0_702
Changes since 1.1.2.2: +12 -13 lines
File MIME type: text/x-pascal
NewBrowserイベントが発生しない不具合対応

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 protected
23 procedure CreateParams(var Params: TCreateParams); override;
24 public
25 constructor Create(AOwner: TComponent); override;
26 destructor Destroy; override;
27 property Child: TResPopupBrowser read FChild;
28 property Title: String read FTitle write FTitle;
29 function CreateNewBrowser: TResPopupBrowser;
30 procedure Write(ADocument: String);
31 procedure Clear;
32 procedure ChildClear;
33 procedure NavigateBlank;
34 function CalcRect(MaxWidth: Integer): TRect;
35 property PopupType: TGikoPopupType read FPopupType write FPopupType;
36 end;
37
38 implementation
39 uses MojuUtils, GikoSystem, Setting, Giko;
40
41
42 constructor TResPopupBrowser.Create(AOwner: TComponent);
43 begin
44 inherited Create(AOwner);
45 FChild := nil;
46 Visible := False;
47 Title := '';
48 end;
49
50 destructor TResPopupBrowser.Destroy;
51 begin
52 inherited Destroy;
53 end;
54
55 procedure TResPopupBrowser.CreateParams(var Params: TCreateParams);
56 begin
57 inherited CreateParams(Params);
58 end;
59 function TResPopupBrowser.CreateNewBrowser: TResPopupBrowser;
60 begin
61 if (Self.Visible) then begin
62 if (FChild <> nil) then begin
63 if (FChild.Visible) then begin
64 Result := FChild.CreateNewBrowser;
65 end else begin
66 Result := FChild;
67 end;
68 end else begin
69 FChild := TResPopupBrowser.Create(Self);
70 TOleControl(FChild).Parent := nil;
71 FChild.NavigateBlank;
72 FChild.OnEnter := GikoForm.BrowserEnter;
73 FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
74 FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
75 FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
76 ShowWindow(FChild.Handle, SW_HIDE);
77 Result := FChild;
78 end;
79 end else begin
80 TOleControl(Self).Parent := nil;
81 Self.NavigateBlank;
82 Self.OnEnter := GikoForm.BrowserEnter;
83 Self.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
84 Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
85 Self.OnNewWindow2 := GikoForm.BrowserNewWindow2;
86 Result := Self;
87 end;
88
89 end;
90 procedure TResPopupBrowser.NavigateBlank;
91 begin
92 if (not Assigned(Self.Document)) then begin
93 Self.Navigate('about:blank');
94 end;
95 while (Self.ReadyState <> READYSTATE_COMPLETE) and
96 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
97 Forms.Application.ProcessMessages;
98 end;
99 end;
100 procedure TResPopupBrowser.Write(ADocument: String);
101 var
102 doc: Variant;
103 ARect: TRect;
104 begin
105 try
106 doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
107 doc.open;
108 doc.charset := 'Shift_JIS';
109 doc.Write('<html><head>'#13#10 +
110 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10 +
111 Title + GetBodyStyle + '</head><body>' +
112 ADocument + '</body></html>');
113 doc.Close;
114
115 while (Self.ReadyState <> READYSTATE_COMPLETE) and
116 (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
117 Sleep(1);
118 Forms.Application.ProcessMessages;
119 end;
120
121 ARect := CalcRect(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 Self.Visible := True;
128 ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
129
130 except
131 end;
132
133 end;
134
135 function TResPopupBrowser.GetBodyStyle(): string;
136 begin
137
138 Result := '<style type="text/css">' +
139 'dl { margin :0px; padding :0px}'#13#10 +
140 'body { ' +
141 'border-width: 1px; border-style: solid;white-space: nowrap; ' +
142 'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px';
143
144 if Length( GikoSys.Setting.HintFontName ) > 0 then
145 Result := Result + 'font-family:"' + GikoSys.Setting.HintFontName + '";';
146 if GikoSys.Setting.HintFontSize <> 0 then
147 Result := Result + 'font-size:' + IntToStr( GikoSys.Setting.HintFontSize ) + 'pt;';
148 if GikoSys.Setting.HintFontColor <> -1 then
149 Result := Result + 'color:#' + IntToHex( GikoSys.Setting.HintFontColor, 6 ) + ';';
150 if GikoSys.Setting.HintBackColor <> -1 then
151 Result := Result + 'background-color:#' +
152 IntToHex(
153 (GikoSys.Setting.HintBackColor shr 16) or
154 (GikoSys.Setting.HintBackColor and $ff00) or
155 ((GikoSys.Setting.HintBackColor and $ff) shl 16), 6 ) + ';';
156
157 Result := Result + '}</style>';
158 end;
159
160 procedure TResPopupBrowser.Clear;
161 begin
162 ChildClear;
163 if (Self.Visible) then begin
164 Self.Title := '';
165 Self.Visible := False;
166 ShowWindow(Self.Handle, SW_HIDE);
167 end;
168 end;
169 procedure TResPopupBrowser.ChildClear;
170 begin
171 if (FChild <> nil) then begin
172 FChild.Clear;
173 end;
174 end;
175
176 function TResPopupBrowser.CalcRect(MaxWidth: Integer): TRect;
177 var
178 p: TPoint;
179 ele: IHTMLElement2;
180 begin
181 GetCursorpos(p);
182 ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
183 Result := Rect(0, 0,
184 ele.scrollWidth + 15,
185 ele.scrollHeight + 15);
186 case GikoSys.Setting.PopupPosition of
187 gppRightTop: OffsetRect(Result, p.x - (Result.Right - Result.Left) - 2, p.y - (Result.Bottom - Result.Top) - 2);
188 gppRight: OffsetRect(Result, p.x - (Result.Right - Result.Left) - 2, p.y - ((Result.Bottom - Result.Top) div 2));
189 gppRightBottom: OffsetRect(Result, p.x - (Result.Right - Result.Left) -2, p.y + 2);
190 gppTop: OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y - (Result.Bottom - Result.Top) - 2);
191 gppCenter: OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y - ((Result.Bottom - Result.Top) div 2));
192 gppBottom: OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y + 2);
193 gppLeftTop: OffsetRect(Result, p.x + 2, p.y - (Result.Bottom - Result.Top) - 2);
194 gppLeft: OffsetRect(Result, p.x + 2, p.y - ((Result.Bottom - Result.Top) div 2));
195 gppLeftBottom: OffsetRect(Result, p.x + 2, p.y + 2);
196 end;
197 if (Result.Left < 0) then begin
198 OffsetRect(Result, -Result.Left, 0);
199 end;
200 if (Result.Top < 0) then begin
201 OffsetRect(Result, 0, -Result.Top);
202 end;
203 end;
204
205 end.

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