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.5 - (hide 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 h677 1.1.2.1 unit ResPopupBrowser;
2     interface
3     uses
4     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
5 h677 1.1.2.2 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     TResPopupBrowser = class(TWebBrowser)
17     private
18     FChild :TResPopupBrowser;
19     FTitle :String;
20     FPopupType: TGikoPopupType;
21 h677 1.1.2.2 function GetBodyStyle(): string;
22 h677 1.1.2.4 function GetWindowHeight : Integer;
23 h677 1.1.2.1 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 h677 1.1.2.4 function CalcRect(MaxHeight: Integer; MaxWidth: Integer): TRect;
36 h677 1.1.2.1 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 h677 1.1.2.2 Title := '';
49 h677 1.1.2.1 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 h677 1.1.2.3 FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
75 h677 1.1.2.1 FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
76 h677 1.1.2.2 FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
77 h677 1.1.2.1 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 h677 1.1.2.3 Self.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
85 h677 1.1.2.1 Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
86 h677 1.1.2.2 Self.OnNewWindow2 := GikoForm.BrowserNewWindow2;
87 h677 1.1.2.1 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 h677 1.1.2.4 // 鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申
108     SetWindowPos(Self.Handle, HWND_TOP,
109     0, 0, 50 , 50,
110     SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
111    
112 h677 1.1.2.1 doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
113     doc.open;
114     doc.charset := 'Shift_JIS';
115 h677 1.1.2.2 doc.Write('<html><head>'#13#10 +
116     '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10 +
117 h677 1.1.2.5 '<span id="hTitle">' + Title +'</span>'+ GetBodyStyle + '</head><body>' +
118 h677 1.1.2.4 ADocument + '<a name="bottom"></a></body></html>');
119 h677 1.1.2.1 doc.Close;
120    
121 h677 1.1.2.4 ARect := CalcRect(Screen.Height, Screen.Width);
122 h677 1.1.2.3 SetWindowPos(Self.Handle, HWND_TOP,
123 h677 1.1.2.1 ARect.Left, ARect.Top,
124     (ARect.Right - ARect.Left) ,
125     (ARect.Bottom - ARect.Top),
126     SWP_NOACTIVATE or SWP_HIDEWINDOW);
127 h677 1.1.2.2 ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
128 h677 1.1.2.4 Self.Visible := True;
129 h677 1.1.2.1 except
130     end;
131 h677 1.1.2.2
132     end;
133    
134     function TResPopupBrowser.GetBodyStyle(): string;
135 h677 1.1.2.4 var
136     i : Integer;
137 h677 1.1.2.2 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 h677 1.1.2.4 'margin: 2px 4px 0px 0px; padding: 0px 4px 0px 0px; ';
144 h677 1.1.2.2
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 h677 1.1.2.4 if GikoSys.Setting.HintBackColor <> -1 then begin
152     i := ColorToRGB( GikoSys.Setting.HintBackColor );
153 h677 1.1.2.2 Result := Result + 'background-color:#' +
154 h677 1.1.2.4 IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';
155     end;
156 h677 1.1.2.2
157 h677 1.1.2.5 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 h677 1.1.2.1 end;
163 h677 1.1.2.2
164 h677 1.1.2.1 procedure TResPopupBrowser.Clear;
165     begin
166     ChildClear;
167     if (Self.Visible) then begin
168 h677 1.1.2.2 Self.Title := '';
169 h677 1.1.2.5 NavigateBlank;
170 h677 1.1.2.1 ShowWindow(Self.Handle, SW_HIDE);
171 h677 1.1.2.5 Self.Visible := False;
172 h677 1.1.2.1 end;
173     end;
174     procedure TResPopupBrowser.ChildClear;
175     begin
176     if (FChild <> nil) then begin
177     FChild.Clear;
178     end;
179     end;
180    
181 h677 1.1.2.4 function TResPopupBrowser.CalcRect(MaxHeight: Integer; MaxWidth: Integer): TRect;
182 h677 1.1.2.1 var
183     p: TPoint;
184 h677 1.1.2.2 ele: IHTMLElement2;
185 h677 1.1.2.4 h, w: Integer;
186 h677 1.1.2.1 begin
187     GetCursorpos(p);
188 h677 1.1.2.2 ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
189 h677 1.1.2.5 h := GetWindowHeight + 10;
190 h677 1.1.2.4 w := ele.scrollWidth + 25;
191     Result := Rect(0, 0, w, h);
192 h677 1.1.2.1 case GikoSys.Setting.PopupPosition of
193 h677 1.1.2.4 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 h677 1.1.2.3 gppLeftBottom: OffsetRect(Result, p.x + 2, p.y + 2);
202 h677 1.1.2.1 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 h677 1.1.2.4 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 h677 1.1.2.5
216 h677 1.1.2.4 // 鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
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 h677 1.1.2.1 end;
226 h677 1.1.2.4 function TResPopupBrowser.GetWindowHeight : Integer;
227     var
228     top: Integer;
229     item: OleVariant;
230     begin
231 h677 1.1.2.5 Result := 0;
232 h677 1.1.2.4 //鐃?鐃緒申鐃?鐃?鐃緒申鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
233     while (Self.ReadyState <> READYSTATE_COMPLETE) and
234     (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
235     Sleep(1);
236     Forms.Application.ProcessMessages;
237     end;
238 h677 1.1.2.1
239 h677 1.1.2.4 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 h677 1.1.2.1 end.

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