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.7 by h677, Sun May 13 14:49:06 2007 UTC revision 1.1.2.8 by h677, Sun May 13 17:38: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,} HTMLDocumentEvent, BoardGroup,
6  {$IF Defined(DELPRO) }  {$IF Defined(DELPRO) }
7          SHDocVw,          SHDocVw,
8          MSHTML          MSHTML
# Line 22  type Line 22  type
22          FTitle :String;          FTitle :String;
23          FRawDocument: String;          FRawDocument: String;
24                  FPopupType: TGikoPopupType;                  FPopupType: TGikoPopupType;
25                    FEvent: THTMLDocumentEventSink;//ブラウザドキュメントイベント
26            FThread: TThreadItem;
27          function GetBodyStyle(OnlyTitle: Boolean = False): string;          function GetBodyStyle(OnlyTitle: Boolean = False): string;
28          function GetWindowHeight : Integer;          function GetWindowHeight : Integer;
29          function GetTitle(OnlyTitle: Boolean): string;          function GetTitle(OnlyTitle: Boolean): string;
30                  function CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect;                  function CalcRect(MaxHeight: Integer; MaxWidth: Integer; Scroll: Boolean): TRect;
31            function ResPopupBrowserClick(Sender: TObject): WordBool;
32            function GetThread: TThreadItem;
33          protected          protected
34                  procedure CreateParams(var Params: TCreateParams); override;                  procedure CreateParams(var Params: TCreateParams); override;
35          public          public
# Line 35  type Line 39  type
39          property ParentBrowser:TResPopupBrowser read FParentBrowser write FParentBrowser;          property ParentBrowser:TResPopupBrowser read FParentBrowser write FParentBrowser;
40          property Title: String read FTitle write FTitle;          property Title: String read FTitle write FTitle;
41          property RawDocument: String read FRawDocument write FRawDocument;          property RawDocument: String read FRawDocument write FRawDocument;
42            property Thread: TThreadItem read GetThread write FThread;
43          function CreateNewBrowser: TResPopupBrowser;          function CreateNewBrowser: TResPopupBrowser;
44          function CurrentBrowser: TResPopupBrowser;          function CurrentBrowser: TResPopupBrowser;
45          procedure Write(ADocument: String; OnlyTitle: Boolean = False);          procedure Write(ADocument: String; OnlyTitle: Boolean = False);
# Line 47  type Line 52  type
52          end;          end;
53    
54  implementation  implementation
55  uses MojuUtils, GikoSystem, Setting, Giko;  uses MojuUtils, GikoSystem, Setting, Giko, GikoDataModule;
56    
57    
58  constructor TResPopupBrowser.Create(AOwner: TComponent);  constructor TResPopupBrowser.Create(AOwner: TComponent);
# Line 103  end; Line 108  end;
108  function TResPopupBrowser.CurrentBrowser: TResPopupBrowser;  function TResPopupBrowser.CurrentBrowser: TResPopupBrowser;
109  begin  begin
110      Result := Self.CreateNewBrowser;      Result := Self.CreateNewBrowser;
111      if (Result.Parent <> nil) then      if (Result.ParentBrowser <> nil) then
112          Result := Result.ParentBrowser;          Result := Result.ParentBrowser;
113  end;  end;
114  procedure TResPopupBrowser.NavigateBlank;  procedure TResPopupBrowser.NavigateBlank;
# Line 128  procedure TResPopupBrowser.Write(ADocume Line 133  procedure TResPopupBrowser.Write(ADocume
133  var  var
134      doc: Variant;      doc: Variant;
135          ARect: TRect;          ARect: TRect;
136        FDispHtmlDocument: DispHTMLDocument;
137  begin  begin
138      Self.OnStatusTextChange := nil;      Self.OnStatusTextChange := nil;
139      try      try
# Line 154  begin Line 160  begin
160                  (ARect.Right - ARect.Left) ,                  (ARect.Right - ARect.Left) ,
161                  (ARect.Bottom - ARect.Top),                  (ARect.Bottom - ARect.Top),
162                  SWP_NOACTIVATE or SWP_HIDEWINDOW);                  SWP_NOACTIVATE or SWP_HIDEWINDOW);
163                FDispHtmlDocument := Idispatch(OleVariant(Self.ControlInterface).Document) as DispHTMLDocument;
164                FEvent := THTMLDocumentEventSink.Create(Self, FDispHtmlDocument, HTMLDocumentEvents2);
165                FEvent.OnClick := ResPopupBrowserClick;
166              ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);              ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
167              Self.Visible := True;              Self.Visible := True;
168          except          except
# Line 207  begin Line 215  begin
215      if (Self.Visible) then begin      if (Self.Visible) then begin
216          Self.Title := '';          Self.Title := '';
217          Self.RawDocument := '';          Self.RawDocument := '';
218            Self.FThread := nil;
219            FEvent.Free;
220          NavigateBlank;          NavigateBlank;
221          ShowWindow(Self.Handle, SW_HIDE);          ShowWindow(Self.Handle, SW_HIDE);
222          Self.Visible := False;          Self.Visible := False;
# Line 295  begin Line 305  begin
305      except      except
306      end;      end;
307  end;  end;
308    function TResPopupBrowser.ResPopupBrowserClick(Sender: TObject): WordBool;
309    begin
310        Result := True;
311    end;
312    function TResPopupBrowser.GetThread: TThreadItem;
313    begin
314        Result := nil;
315        if (FThread <> nil) then begin
316            try
317                // 無効なポインタ検査
318                if (FThread.ParentBoard <> nil) then begin
319                    Result := FThread
320                end;
321            except
322                //無効なポインタだった
323                Result := nil;
324            end;
325        end;
326    end;
327  end.  end.

Legend:
Removed from v.1.1.2.7  
changed lines
  Added in v.1.1.2.8

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