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.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 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 18  type Line 18  type
18          FChild :TResPopupBrowser;          FChild :TResPopupBrowser;
19          FTitle :String;          FTitle :String;
20                  FPopupType: TGikoPopupType;                  FPopupType: TGikoPopupType;
21            function GetBodyStyle(): string;
22          protected          protected
23                  procedure CreateParams(var Params: TCreateParams); override;                  procedure CreateParams(var Params: TCreateParams); override;
24          public          public
# Line 43  begin Line 44  begin
44          inherited Create(AOwner);          inherited Create(AOwner);
45      FChild := nil;      FChild := nil;
46      Visible := False;      Visible := False;
47        Title := '';
48  end;  end;
49    
50  destructor TResPopupBrowser.Destroy;  destructor TResPopupBrowser.Destroy;
# Line 69  begin Line 71  begin
71              FChild.NavigateBlank;              FChild.NavigateBlank;
72              FChild.OnEnter := GikoForm.BrowserEnter;              FChild.OnEnter := GikoForm.BrowserEnter;
73              FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;              FChild.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
74                FChild.OnNewWindow2 := GikoForm.BrowserNewWindow2;
75              ShowWindow(FChild.Handle, SW_HIDE);              ShowWindow(FChild.Handle, SW_HIDE);
76              Result := FChild;              Result := FChild;
77          end;          end;
# Line 77  begin Line 80  begin
80          Self.NavigateBlank;          Self.NavigateBlank;
81          Self.OnEnter := GikoForm.BrowserEnter;          Self.OnEnter := GikoForm.BrowserEnter;
82          Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;          Self.OnStatusTextChange := GikoForm.BrowserStatusTextChange;
83            Self.OnNewWindow2 := GikoForm.BrowserNewWindow2;
84          Result := Self;          Result := Self;
85      end;      end;
86    
# Line 96  var Line 100  var
100      doc: Variant;      doc: Variant;
101          ARect: TRect;          ARect: TRect;
102  begin  begin
103        Self.Visible := True;
104        ShowWindow(Self.Handle, SW_SHOW);
105      try      try
106          doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;          doc := Idispatch( olevariant(Self.ControlInterface).Document) as IHTMLDocument2;
107          doc.open;          doc.open;
108          doc.charset := 'Shift_JIS';          doc.charset := 'Shift_JIS';
109          doc.Write('<html><body topmargin="2" leftmargin="2" style="border-width: 1px; border-style: solid;white-space: nowrap">'          doc.Write('<html><head>'#13#10 +
110              + ADocument + '</body></html>');                  '<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;          doc.Close;
         Self.Visible := True;  
114    
115          ARect := CalcRect(Screen.Width);          while (Self.ReadyState <> READYSTATE_COMPLETE) and
116          SetWindowPos(Self.Handle, HWND_TOPMOST,                  (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,              ARect.Left, ARect.Top,
124              (ARect.Right - ARect.Left) ,              (ARect.Right - ARect.Left) ,
125              (ARect.Bottom - ARect.Top),              (ARect.Bottom - ARect.Top),
126              SWP_NOACTIVATE or SWP_HIDEWINDOW);              SWP_NOACTIVATE or SWP_HIDEWINDOW);
127    
128              ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);          ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
129    
130      except      except
131      end;      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;  end;
159    
160  procedure TResPopupBrowser.Clear;  procedure TResPopupBrowser.Clear;
161  begin  begin
162      ChildClear;      ChildClear;
163      if (Self.Visible) then begin      if (Self.Visible) then begin
164            Self.Title := '';
165          Self.Visible := False;          Self.Visible := False;
166          ShowWindow(Self.Handle, SW_HIDE);          ShowWindow(Self.Handle, SW_HIDE);
167      end;      end;
# Line 134  end; Line 176  end;
176  function TResPopupBrowser.CalcRect(MaxWidth: Integer): TRect;  function TResPopupBrowser.CalcRect(MaxWidth: Integer): TRect;
177  var  var
178          p: TPoint;          p: TPoint;
179        doc: Variant;
180        ele: IHTMLElement2;
181  begin  begin
182          GetCursorpos(p);          GetCursorpos(p);
183          Result := Rect(0, 0, 500, 200);      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      case GikoSys.Setting.PopupPosition of
188          gppRightTop:            OffsetRect(Result, p.x - (Result.Right - Result.Left) - 5, p.y - (Result.Bottom - Result.Top) - 5);          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) - 5, p.y - ((Result.Bottom - Result.Top) div 2));          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) - 5, p.y + 5);          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) -     5);          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));          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 + 5);          gppBottom:                      OffsetRect(Result, p.x - ((Result.Right - Result.Left) div 2), p.y);
194          gppLeftTop:                     OffsetRect(Result, p.x + 5, p.y - (Result.Bottom - Result.Top) -        5);          gppLeftTop:                     OffsetRect(Result, p.x, p.y - (Result.Bottom - Result.Top));
195          gppLeft:                                OffsetRect(Result, p.x + 5, p.y - ((Result.Bottom - Result.Top) div 2));          gppLeft:                                OffsetRect(Result, p.x, p.y - ((Result.Bottom - Result.Top) div 2));
196          gppLeftBottom:  OffsetRect(Result, p.x + 5, p.y + 5);           //ギコナビスレ パート1の453氏に感謝          gppLeftBottom:  OffsetRect(Result, p.x, p.y);
197      end;      end;
198      if (Result.Left < 0) then begin      if (Result.Left < 0) then begin
199          OffsetRect(Result, -Result.Left, 0);          OffsetRect(Result, -Result.Left, 0);
# Line 154  begin Line 201  begin
201      if (Result.Top < 0) then begin      if (Result.Top < 0) then begin
202          OffsetRect(Result, 0, -Result.Top);          OffsetRect(Result, 0, -Result.Top);
203      end;      end;
   
204  end;  end;
205    
206  end.  end.

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

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