Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/ResPopupBrowser.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by h677, Mon May 7 17:55:59 2007 UTC revision 1.1.2.2 by h677, Tue May 8 21:27:44 2007 UTC
# Line 0  Line 1 
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.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
74                FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
75                ShowWindow(FChild.Handle, SW_HIDE);
76                Result := FChild;
77            end;
78        end else begin
79            TOleControl(Self).Parent := nil;
80            Self.NavigateBlank;
81            Self.OnEnter := GikoForm.BrowserEnter;
82            Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
83            Self.OnNewWindow2 := GikoForm.BrowserNewWindow2;
84            Result := Self;
85        end;
86    
87    end;
88    procedure TResPopupBrowser.NavigateBlank;
89    begin
90        if (not Assigned(Self.Document)) then begin
91            Self.Navigate('about:blank');
92        end;
93        while (Self.ReadyState <> READYSTATE_COMPLETE) and
94                (Self.ReadyState <> READYSTATE_INTERACTIVE) do begin
95            Forms.Application.ProcessMessages;
96        end;
97    end;
98    procedure TResPopupBrowser.Write(ADocument: String);
99    var
100        doc: Variant;
101            ARect: TRect;
102    begin
103        Self.Visible := True;
104        ShowWindow(Self.Handle, SW_SHOW);
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_TOPMOST,
123                ARect.Left, ARect.Top,
124                (ARect.Right - ARect.Left) ,
125                (ARect.Bottom - ARect.Top),
126                SWP_NOACTIVATE or SWP_HIDEWINDOW);
127    
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        doc: Variant;
180        ele: IHTMLElement2;
181    begin
182            GetCursorpos(p);
183        ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
184            Result := Rect(0, 0,
185            ele.scrollWidth + 15,
186            ele.scrollHeight + 15);
187        case GikoSys.Setting.PopupPosition of
188            gppRightTop:            OffsetRect(Result, p.x - (Result.Right - Result.Left), p.y - (Result.Bottom - Result.Top));
189            gppRight:                       OffsetRect(Result, p.x - (Result.Right - Result.Left), p.y - ((Result.Bottom - Result.Top) div 2));
190            gppRightBottom: OffsetRect(Result, p.x - (Result.Right - Result.Left), p.y);
191            gppTop:                                 OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y - (Result.Bottom - Result.Top));
192            gppCenter:                      OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y - ((Result.Bottom - Result.Top) div 2));
193            gppBottom:                      OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y);
194            gppLeftTop:                     OffsetRect(Result, p.x, p.y - (Result.Bottom - Result.Top));
195            gppLeft:                                OffsetRect(Result, p.x, p.y - ((Result.Bottom - Result.Top) div 2));
196            gppLeftBottom:  OffsetRect(Result, p.x, p.y);
197        end;
198        if (Result.Left < 0) then begin
199            OffsetRect(Result, -Result.Left, 0);
200        end;
201        if (Result.Top < 0) then begin
202            OffsetRect(Result, 0, -Result.Top);
203        end;
204    end;
205    
206    end.

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.2.2

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