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.2.5 by h677, Thu May 10 16:07:31 2007 UTC revision 1.1.2.6 by h677, Sat May 12 02:46:10 2007 UTC
# Line 2  unit ResPopupBrowser; Line 2  unit ResPopupBrowser;
2  interface  interface
3  uses  uses
4          Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,          Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
5          ActiveX, OleCtrls, HintWindow,          ActiveX, OleCtrls, {HintWindow,}
6  {$IF Defined(DELPRO) }  {$IF Defined(DELPRO) }
7          SHDocVw,          SHDocVw,
8          MSHTML          MSHTML
# Line 13  uses Line 13  uses
13  ;  ;
14    
15  type  type
16        TGikoPopupType = (gptRaw, gptThread);
17        
18          TResPopupBrowser = class(TWebBrowser)          TResPopupBrowser = class(TWebBrowser)
19          private          private
20          FChild :TResPopupBrowser;          FChild :TResPopupBrowser;
21            FParent:TResPopupBrowser;
22          FTitle :String;          FTitle :String;
23                  FPopupType: TGikoPopupType;                  FPopupType: TGikoPopupType;
24          function GetBodyStyle(): string;          function GetBodyStyle(OnlyTitle: Boolean = False): string;
25          function GetWindowHeight : Integer;          function GetWindowHeight : Integer;
26            function GetTitle(OnlyTitle: Boolean): string;
27                    function CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect;
28          protected          protected
29                  procedure CreateParams(var Params: TCreateParams); override;                  procedure CreateParams(var Params: TCreateParams); override;
30          public          public
31                  constructor Create(AOwner: TComponent); override;                  constructor Create(AOwner: TComponent); override;
32                  destructor Destroy; override;                  destructor Destroy; override;
33          property Child: TResPopupBrowser read FChild;          property Child: TResPopupBrowser read FChild;
34            property Parent:TResPopupBrowser read FParent write FParent;
35          property Title: String read FTitle write FTitle;          property Title: String read FTitle write FTitle;
36          function CreateNewBrowser: TResPopupBrowser;          function CreateNewBrowser: TResPopupBrowser;
37          procedure Write(ADocument: String);          procedure Write(ADocument: String; OnlyTitle: Boolean = False);
38          procedure Clear;          procedure Clear;
39          procedure ChildClear;          procedure ChildClear;
40          procedure NavigateBlank;          procedure NavigateBlank;
41                  function CalcRect(MaxHeight: Integer; MaxWidth: Integer): TRect;          property PopupType: TGikoPopupType read FPopupType write FPopupType;
42                  property PopupType: TGikoPopupType read FPopupType write FPopupType;          procedure TitlePopup;
43          end;          end;
44    
45  implementation  implementation
# Line 67  begin Line 73  begin
73                  Result := FChild;                  Result := FChild;
74              end;              end;
75          end else begin          end else begin
76              FChild := TResPopupBrowser.Create(Self);                  FChild := TResPopupBrowser.Create(Self);
77              TOleControl(FChild).Parent := nil;                  TOleControl(FChild).Parent := nil;
78              FChild.NavigateBlank;                  FChild.Parent := Self;
79              FChild.OnEnter := GikoForm.BrowserEnter;                  FChild.NavigateBlank;
80              FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;                  FChild.OnEnter := GikoForm.BrowserEnter;
81              FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;                  FChild.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
82              FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;                  FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
83              ShowWindow(FChild.Handle, SW_HIDE);                  FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
84                    ShowWindow(FChild.Handle, SW_HIDE);
85              Result := FChild;              Result := FChild;
86          end;          end;
87      end else begin      end else begin
88          TOleControl(Self).Parent := nil;          TOleControl(Self).Parent := nil;
89            FParent := nil;
90          Self.NavigateBlank;          Self.NavigateBlank;
91          Self.OnEnter := GikoForm.BrowserEnter;          Self.OnEnter := GikoForm.BrowserEnter;
92          Self.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;          Self.OnBeforeNavigate2 := GikoForm.BrowserBeforeNavigate2;
# Line 98  begin Line 106  begin
106          Forms.Application.ProcessMessages;          Forms.Application.ProcessMessages;
107      end;      end;
108  end;  end;
109  procedure TResPopupBrowser.Write(ADocument: String);  procedure TResPopupBrowser.TitlePopup;
110    begin
111        Write('', True);
112    end;
113    procedure TResPopupBrowser.Write(ADocument: String; OnlyTitle: Boolean = False);
114  var  var
115      doc: Variant;      doc: Variant;
116          ARect: TRect;          ARect: TRect;
117  begin  begin
118        Self.OnStatusTextChange := nil;
119      try      try
120          // いったん縮小          try
121          SetWindowPos(Self.Handle, HWND_TOP,              // いったん縮小
122              0, 0, 50 , 50,              SetWindowPos(Self.Handle, HWND_TOP,
123              SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);                  0, 0, 50 , 50,
124                    SWP_NOMOVE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
125          doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;  
126          doc.open;              doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
127          doc.charset := 'Shift_JIS';              doc.open;
128          doc.Write('<html><head>'#13#10 +              doc.charset := 'Shift_JIS';
129                  '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10 +              doc.Write('<html><head>'#13#10 +
130                  '<span id="hTitle">' + Title +'</span>'+ GetBodyStyle + '</head><body>' +                      '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10
131                  ADocument + '<a name="bottom"></a></body></html>');                      + GetBodyStyle(OnlyTitle) + '</head><body>'
132          doc.Close;                      + GetTitle(OnlyTitle)
133                        + ADocument + '<a name="bottom"></a></body></html>');
134          ARect := CalcRect(Screen.Height, Screen.Width);              doc.Close;
135          SetWindowPos(Self.Handle, HWND_TOP,  
136              ARect.Left, ARect.Top,              ARect := CalcRect(Screen.WorkAreaHeight, Screen.WorkAreaWidth,
137              (ARect.Right - ARect.Left) ,                   not OnlyTitle);
138              (ARect.Bottom - ARect.Top),              SetWindowPos(Self.Handle, HWND_TOP,
139              SWP_NOACTIVATE or SWP_HIDEWINDOW);                  ARect.Left, ARect.Top,
140          ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);                  (ARect.Right - ARect.Left) ,
141          Self.Visible := True;                  (ARect.Bottom - ARect.Top),
142      except                  SWP_NOACTIVATE or SWP_HIDEWINDOW);
143    
144                ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
145                Self.Visible := True;
146            except
147            end;
148        finally
149            Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
150      end;      end;
151    
152  end;  end;
153    function TResPopupBrowser.GetTitle(OnlyTitle: Boolean): string;
154  function TResPopupBrowser.GetBodyStyle(): string;  begin
155        Result := '<span id="hTitle">' + Title +'</span>';
156        if OnlyTitle then Result := Result + '<BR>';
157    end;
158    function TResPopupBrowser.GetBodyStyle(OnlyTitle: Boolean = False): string;
159  var  var
160      i : Integer;      i : Integer;
161  begin  begin
# Line 153  begin Line 177  begin
177                  Result := Result + 'background-color:#' +                  Result := Result + 'background-color:#' +
178              IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';              IntToHex( (i shr 16) or (i and $ff00) or ((i and $ff) shl 16), 6 ) + ';';
179      end;      end;
180        if OnlyTitle then
181            Result := Result + 'overflow: hidden; ';
182    
183      Result := Result + '}';      Result := Result + '}';
184      if GikoSys.Setting.ResPopupHeaderBold then begin      if GikoSys.Setting.ResPopupHeaderBold then begin
# Line 178  begin Line 204  begin
204      end;      end;
205  end;  end;
206    
207  function TResPopupBrowser.CalcRect(MaxHeight: Integer; MaxWidth: Integer): TRect;  function TResPopupBrowser.CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect;
208  var  var
209          p: TPoint;          p: TPoint;
210      ele: IHTMLElement2;      ele: IHTMLElement2;
# Line 186  var Line 212  var
212  begin  begin
213          GetCursorpos(p);          GetCursorpos(p);
214      ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);      ele := ((Self.Document as IHTMLDocument2).body as IHTMLElement2);
215      h := GetWindowHeight + 10;      if Scroll then begin
216      w := ele.scrollWidth + 25;          h := GetWindowHeight + 10;
217            w := ele.scrollWidth + 25
218        end else begin
219            h := GetWindowHeight + 5;
220            w := ele.scrollWidth + 10;
221        end;
222          Result := Rect(0, 0, w, h);          Result := Rect(0, 0, w, h);
223      case GikoSys.Setting.PopupPosition of      case GikoSys.Setting.PopupPosition of
224          gppRightTop:            OffsetRect(Result, p.x - w - 2, p.y - h - 2);          gppRightTop:            OffsetRect(Result, p.x - w - 2, p.y - h - 2);

Legend:
Removed from v.1.1.2.5  
changed lines
  Added in v.1.1.2.6

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