Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/HTMLCreate.pas

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

revision 1.23 by h677, Wed Feb 22 18:28:48 2006 UTC revision 1.24 by h677, Sat Feb 25 02:43:51 2006 UTC
# Line 25  type Line 25  type
25                  FKey : string;                  FKey : string;
26          end;          end;
27    
28            TBufferedWebBrowser = class(TStringList)
29            private
30                    //! 書き込むブラウザ
31                    FBrowser: TWebBrowser;
32                    //! 何行までためるかのサイズ
33                    FBuffSize: Integer;
34                    //! ブラウザのIHTMLDocument2インタフェースを保持する openからcloseの間で
35                    FBrowserDoc: Variant;
36            public
37                    constructor Create(Browser: TWebBrowser; BuffSize: Integer);
38                    destructor Destory;
39                    procedure Open;
40                    procedure Close;
41                    function Add(const S: string): Integer; override;
42            end;
43          THTMLCreate = class(TObject)          THTMLCreate = class(TObject)
44          private          private
45                  { Private 宣言 }                  { Private 宣言 }
# Line 54  type Line 69  type
69                  function SkinedRes(const skin: string; PRes: PResRec; const No: string): string;                  function SkinedRes(const skin: string; PRes: PResRec; const No: string): string;
70                  procedure ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false); overload;                  procedure ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false); overload;
71                  function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string; DatToHTML: boolean = false): string; overload;                  function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string; DatToHTML: boolean = false): string; overload;
72                  procedure CreateHTML2(doc: IDispatch; ThreadItem: TThreadItem; var sTitle: string);                  procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
73                  procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);                  procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
74                  //レスポップアップの作成                  //レスポップアップの作成
75                  procedure SetResPopupText(Hint :TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);                  procedure SetResPopupText(Hint :TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
# Line 1135  begin Line 1150  begin
1150          end;          end;
1151  end;  end;
1152    
1153  procedure THTMLCreate.CreateHTML2(doc: IDispatch; ThreadItem: TThreadItem; var sTitle: string);  procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
1154  var  var
1155          ReadList: TStringList;          ReadList: TStringList;
1156          CSSFileName: string;          CSSFileName: string;
1157          FileName: string;          FileName: string;
1158          Res: TResRec;          Res: TResRec;
1159          body : TStringList;          body : TBufferedWebBrowser;
         mStream : TMemoryStream;  
1160  {$IFDEF DEBUG}  {$IFDEF DEBUG}
1161          st, rt: Cardinal;          st, rt: Cardinal;
1162  {$ENDIF}  {$ENDIF}
# Line 1152  begin Line 1166  begin
1166          st := GetTickCount;          st := GetTickCount;
1167  {$ENDIF}  {$ENDIF}
1168          if ThreadItem <> nil then begin          if ThreadItem <> nil then begin
1169                  body := TStringList.Create;                  body := TBufferedWebBrowser.Create(Browser, 100);
1170                  try                  try
1171                          body.BeginUpdate;                          body.Open;
1172                          if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin                          if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1173                                  CreateUsePluginHTML(body, ThreadItem, sTitle);                                  CreateUsePluginHTML(body, ThreadItem, sTitle);
1174                          end else begin                          end else begin
# Line 1194  begin Line 1208  begin
1208                                          ReadList.Free;                                          ReadList.Free;
1209                                  end;                                  end;
1210                          end;                          end;
                         body.EndUpdate;  
                         //WebBrowserに書き込み  
                         mStream := TMemoryStream.Create;  
                         try  
                                 body.SaveToStream(mStream);  
                                 mStream.Seek(soFromBeginning, 0);  
                                 (doc as IPersistStreamInit).Load(TStreamAdapter.Create(mStream));  
                         finally  
                                 mStream.Free;  
                         end;  
1211                  finally                  finally
1212                            body.Close;
1213                          body.Free;                          body.Free;
1214                  end;                  end;
1215          end;          end;
# Line 1723  begin Line 1728  begin
1728          end;          end;
1729  end;  end;
1730    
1731    constructor TBufferedWebBrowser.Create(Browser: TWebBrowser; BuffSize: Integer);
1732    begin
1733            inherited Create;
1734            Self.Sorted := False;
1735            if (Browser = nil) then
1736                    Raise  Exception.Create('Browser is NULL');
1737            FBrowser := Browser;
1738    
1739            // バッファする行数を
1740            if (BuffSize < 0) then begin
1741                    FBuffSize := 100;
1742            end else begin
1743                    FBuffSize := BuffSize;
1744            end;
1745    end;
1746    procedure TBufferedWebBrowser.Open;
1747    begin
1748            Self.BeginUpdate;
1749            FBrowserDoc := Idispatch( olevariant(FBrowser.ControlInterface).Document);
1750            FBrowserDoc.open;
1751            FBrowserDoc.charset := 'Shift_JIS';
1752    end;
1753    procedure TBufferedWebBrowser.Close;
1754    begin
1755            Self.EndUpdate;
1756            if (Self.Count > 0) then begin
1757                    FBrowserDoc.Write(Self.Text);
1758                    Self.Clear;
1759            end;
1760            try
1761                    FBrowserDoc.Close;
1762            except
1763            end;
1764    end;
1765    function TBufferedWebBrowser.Add(const S: string): Integer;
1766    begin
1767            Result := 0;
1768            if (Self.Count + 1 > FBuffSize) then begin
1769                    Self.EndUpdate;
1770                    FBrowserDoc.Write(Self.Text)
1771                    FBrowserDoc.Write(S);
1772                    Self.Clear;
1773                    Self.BeginUpdate;
1774            end else begin
1775                    Result := inherited Add(S);
1776            end;
1777    end;
1778    destructor TBufferedWebBrowser.Destory;
1779    begin
1780            try
1781                    if (FBrowserDoc <> 0) then begin
1782                            FBrowserDoc.close;
1783                            FBrowserDoc := 0;
1784                    end;
1785            except
1786            end;
1787            inherited;
1788    end;
1789    
1790  initialization  initialization
1791           HTMLCreater := THTMLCreate.Create;           HTMLCreater := THTMLCreate.Create;

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

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