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.1 by h677, Mon May 7 17:55:59 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            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);           //ギコナビスレ パート1の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.

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

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