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.1 - (hide annotations) (download) (as text)
Mon May 7 17:55:59 2007 UTC (16 years, 11 months ago) by h677
Branch: bRESPOPUP
CVS Tags: v1_56_0_701
Changes since 1.1: +160 -0 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     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     protected
22     procedure CreateParams(var Params: TCreateParams); override;
23     public
24     constructor Create(AOwner: TComponent); override;
25     destructor Destroy; override;
26     property Child: TResPopupBrowser read FChild;
27     property Title: String read FTitle write FTitle;
28     function CreateNewBrowser: TResPopupBrowser;
29     procedure Write(ADocument: String);
30     procedure Clear;
31     procedure ChildClear;
32     procedure NavigateBlank;
33     function CalcRect(MaxWidth: Integer): TRect;
34     property PopupType: TGikoPopupType read FPopupType write FPopupType;
35     end;
36    
37     implementation
38     uses MojuUtils, GikoSystem, Setting, Giko;
39    
40    
41     constructor TResPopupBrowser.Create(AOwner: TComponent);
42     begin
43     inherited Create(AOwner);
44     FChild := nil;
45     Visible := False;
46     end;
47    
48     destructor TResPopupBrowser.Destroy;
49     begin
50     inherited Destroy;
51     end;
52    
53     procedure TResPopupBrowser.CreateParams(var Params: TCreateParams);
54     begin
55     inherited CreateParams(Params);
56     end;
57     function TResPopupBrowser.CreateNewBrowser: TResPopupBrowser;
58     begin
59     if (Self.Visible) then begin
60     if (FChild <> nil) then begin
61     if (FChild.Visible) then begin
62     Result := FChild.CreateNewBrowser;
63     end else begin
64     Result := FChild;
65     end;
66     end else begin
67     FChild := TResPopupBrowser.Create(Self);
68     TOleControl(FChild).Parent := nil;
69     FChild.NavigateBlank;
70     FChild.OnEnter := GikoForm.BrowserEnter;
71     FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
72     ShowWindow(FChild.Handle, SW_HIDE);
73     Result := FChild;
74     end;
75     end else begin
76     TOleControl(Self).Parent := nil;
77     Self.NavigateBlank;
78     Self.OnEnter := GikoForm.BrowserEnter;
79     Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
80     Result := Self;
81     end;
82    
83     end;
84     procedure TResPopupBrowser.NavigateBlank;
85     begin
86     if (not Assigned(Self.Document)) then begin
87     Self.Navigate('about:blank');
88     end;
89     while (Self.ReadyState <> READYSTATE_COMPLETE) and
90     (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
91     Forms.Application.ProcessMessages;
92     end;
93     end;
94     procedure TResPopupBrowser.Write(ADocument: String);
95     var
96     doc: Variant;
97     ARect: TRect;
98     begin
99     try
100     doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
101     doc.open;
102     doc.charset := 'Shift_JIS';
103     doc.Write('<html><body topmargin="2" leftmargin="2" style="border-width: 1px; border-style: solid;white-space: nowrap">'
104     + ADocument + '</body></html>');
105     doc.Close;
106     Self.Visible := True;
107    
108     ARect := CalcRect(Screen.Width);
109     SetWindowPos(Self.Handle, HWND_TOPMOST,
110     ARect.Left, ARect.Top,
111     (ARect.Right - ARect.Left) ,
112     (ARect.Bottom - ARect.Top),
113     SWP_NOACTIVATE or SWP_HIDEWINDOW);
114    
115     ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
116     except
117     end;
118     end;
119     procedure TResPopupBrowser.Clear;
120     begin
121     ChildClear;
122     if (Self.Visible) then begin
123     Self.Visible := False;
124     ShowWindow(Self.Handle, SW_HIDE);
125     end;
126     end;
127     procedure TResPopupBrowser.ChildClear;
128     begin
129     if (FChild <> nil) then begin
130     FChild.Clear;
131     end;
132     end;
133    
134     function TResPopupBrowser.CalcRect(MaxWidth: Integer): TRect;
135     var
136     p: TPoint;
137     begin
138     GetCursorpos(p);
139     Result := Rect(0, 0, 500, 200);
140     case GikoSys.Setting.PopupPosition of
141     gppRightTop: OffsetRect(Result, p.x - (Result.Right - Result.Left) - 5, p.y - (Result.Bottom - Result.Top) - 5);
142     gppRight: OffsetRect(Result, p.x - (Result.Right - Result.Left) - 5, p.y - ((Result.Bottom - Result.Top) div 2));
143     gppRightBottom: OffsetRect(Result, p.x - (Result.Right - Result.Left) - 5, p.y + 5);
144     gppTop: OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y - (Result.Bottom - Result.Top) - 5);
145     gppCenter: OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y - ((Result.Bottom - Result.Top) div 2));
146     gppBottom: OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y + 5);
147     gppLeftTop: OffsetRect(Result, p.x + 5, p.y - (Result.Bottom - Result.Top) - 5);
148     gppLeft: OffsetRect(Result, p.x + 5, p.y - ((Result.Bottom - Result.Top) div 2));
149     gppLeftBottom: OffsetRect(Result, p.x + 5, p.y + 5); //鐃?鐃?鐃?鐃?鐃?鐃緒申 鐃?鐃?鐃?鐃?鐃緒申453鐃緒申鐃緒申鐃緒申鐃緒申
150     end;
151     if (Result.Left < 0) then begin
152     OffsetRect(Result, -Result.Left, 0);
153     end;
154     if (Result.Top < 0) then begin
155     OffsetRect(Result, 0, -Result.Top);
156     end;
157    
158     end;
159    
160     end.

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