Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/Giko.pas

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

revision 1.342 by h677, Sat Jun 19 15:15:33 2004 UTC revision 1.343 by h677, Sun Jun 20 05:40:40 2004 UTC
# Line 13  uses Line 13  uses
13          MSHTML_TLB,          MSHTML_TLB,
14  {$IFEND}  {$IFEND}
15          IdHTTP, ActiveX, ActnList, ImgList,          IdHTTP, ActiveX, ActnList, ImgList,
16      ToolWin, Buttons, {Clipbrd,} {HTTPApp,} YofUtils, IdComponent,          ToolWin, Buttons, {Clipbrd,} {HTTPApp,} YofUtils, IdComponent,
17          ShellAPI,  UrlMon, Tabs, IdGlobal, StrUtils,          ShellAPI,  UrlMon, Tabs, IdGlobal, StrUtils,
18          CommCtrl, IniFiles, Dialogs,          CommCtrl, IniFiles, Dialogs,
19          GikoSystem, GikoUtil, Setting, BoardGroup, ThreadControl, ItemDownload,          GikoSystem, GikoUtil, Setting, BoardGroup, ThreadControl, ItemDownload,
# Line 250  type Line 250  type
250                  N21: TMenuItem;                  N21: TMenuItem;
251                  URLC3: TMenuItem;                  URLC3: TMenuItem;
252                  URLN2: TMenuItem;                  URLN2: TMenuItem;
                 N22: TMenuItem;  
253                  N23: TMenuItem;                  N23: TMenuItem;
254                  ListCoolBar: TGikoCoolBar;                  ListCoolBar: TGikoCoolBar;
255                  ListToolBar: TToolBar;                  ListToolBar: TToolBar;
# Line 544  type Line 543  type
543      SelectThreadSave: TMenuItem;      SelectThreadSave: TMenuItem;
544      SelectItemSaveForHTML: TAction;      SelectItemSaveForHTML: TAction;
545      FileSaveAs1: TFileSaveAs;      FileSaveAs1: TFileSaveAs;
     SelectItemSaveForHTML1: TMenuItem;  
546      N55: TMenuItem;      N55: TMenuItem;
547        N66: TMenuItem;
548        dat1: TMenuItem;
549        SelectItemSaveForDat: TAction;
550                                  procedure FormCreate(Sender: TObject);                                  procedure FormCreate(Sender: TObject);
551                  procedure FormDestroy(Sender: TObject);                  procedure FormDestroy(Sender: TObject);
552                  procedure CabinetPanelHide(Sender: TObject);                  procedure CabinetPanelHide(Sender: TObject);
# Line 877  type Line 878  type
878      procedure SelectItemSaveForHTMLExecute(Sender: TObject);      procedure SelectItemSaveForHTMLExecute(Sender: TObject);
879      procedure KidokuActionExecute(Sender: TObject);      procedure KidokuActionExecute(Sender: TObject);
880      procedure MidokuActionExecute(Sender: TObject);      procedure MidokuActionExecute(Sender: TObject);
881        procedure SelectItemSaveForDatExecute(Sender: TObject);
882          private          private
883                  { Private 宣言 }                  { Private 宣言 }
884          //RoundList : TRoundList;          //RoundList : TRoundList;
# Line 1024  type Line 1026  type
1026                  // 各所にあるキャビネット・ BBS メニューをセット/更新                  // 各所にあるキャビネット・ BBS メニューをセット/更新
1027                  procedure SetBBSMenu;                  procedure SetBBSMenu;
1028                  function WebBrowserClick(Sender: TObject): WordBool;                  function WebBrowserClick(Sender: TObject): WordBool;
1029                    procedure SkinorCSSFilesCopy(path: string);
1030          protected          protected
1031                  procedure CreateParams(var Params: TCreateParams); override;                  procedure CreateParams(var Params: TCreateParams); override;
1032                  procedure WndProc(var Message: TMessage); override;                  procedure WndProc(var Message: TMessage); override;
# Line 3372  var Line 3374  var
3374          idx: Integer;          idx: Integer;
3375          ThreadItem: TThreadItem;          ThreadItem: TThreadItem;
3376          Thread: TBrowserRecord;          Thread: TBrowserRecord;
3377            ThreadTitle, ThreadPTitle: string;
3378            ThreadScrollTop: Integer;
3379            ThreadIsLog, ThreadUnRead, ThreadNewArraical: boolean;
3380  begin  begin
3381      Thread := inThread;          Thread := inThread;
3382          idx := BrowserTab.TabIndex;          idx := BrowserTab.TabIndex;
3383          if (FActiveContent <> nil) and          if (FActiveContent <> nil) and
3384                  (FActiveContent.Thread <> Thread.Thread) and                  (FActiveContent.Thread <> Thread.Thread) and
# Line 3419  begin Line 3424  begin
3424                  Thread.Browser := TWebBrowser(FBrowsers[BROWSER_COUNT - 1]);                  Thread.Browser := TWebBrowser(FBrowsers[BROWSER_COUNT - 1]);
3425                  FBrowsers.Move(BROWSER_COUNT - 1, 0);                  FBrowsers.Move(BROWSER_COUNT - 1, 0);
3426          end;          end;
3427      ThreadItem := Thread.Thread;          ThreadTitle := Thread.Thread.Title;
3428            ThreadPTitle := Thread.Thread.ParentBoard.Title;
3429            ThreadScrollTop := Thread.Thread.ScrollTop;
3430            ThreadIsLog := Thread.Thread.IsLogFile;
3431            ThreadItem := Thread.Thread;
3432            ThreadNewArraical :=  Thread.Thread.NewArrival;
3433            ThreadUnRead := Thread.Thread.UnRead;
3434          BBSID := ThreadItem.ParentBoard.BBSID;          BBSID := ThreadItem.ParentBoard.BBSID;
3435          FileName := ThreadItem.FileName;          FileName := ThreadItem.FileName;
3436    
# Line 3453  begin Line 3464  begin
3464                                  Exit;                                  Exit;
3465                          end;                          end;
3466                  end;                  end;
3467                  if not ThreadItem.IsLogFile then begin                  if not ThreadIsLog then begin
3468                          Self.Caption := CAPTION_NAME ;                          Self.Caption := CAPTION_NAME ;
3469                          try                          try
3470                                  s := '<HTML><BODY><CENTER>このスレッドは取得していません</CENTER></BODY></HTML>';                                  s := '<HTML><BODY><CENTER>このスレッドは取得していません</CENTER></BODY></HTML>';
# Line 3465  begin Line 3476  begin
3476                          finally                          finally
3477                          end;                          end;
3478                  end else begin                  end else begin
3479                          Self.Caption := CAPTION_NAME + ' - [' + ThreadItem.Title + ']';                          Self.Caption := CAPTION_NAME + ' - [' + ThreadTitle + ']';
3480                          //Thread.Repaintは、スキン等の設定を変更したとき、Threadをダウンロードしたとき                          //Thread.Repaintは、スキン等の設定を変更したとき、Threadをダウンロードしたとき
3481                          //新規にThreadを開いたときに真になっている。                          //新規にThreadを開いたときに真になっている。
3482                          if(Thread.Repaint) or (Thread.OnlyHundred <> GikoSys.OnlyAHundredRes)then begin                          if(Thread.Repaint) or (Thread.OnlyHundred <> GikoSys.OnlyAHundredRes)then begin
# Line 3488  begin Line 3499  begin
3499                                          //相しないと一画面分しか描画できてないのでそれ以上のスクロール量を指定しても無効になる                                          //相しないと一画面分しか描画できてないのでそれ以上のスクロール量を指定しても無効になる
3500                                          // byもじゅ(2004/01/20)                                          // byもじゅ(2004/01/20)
3501                                          try                                          try
3502                                                  if (Assigned(Thread)) and (Assigned(ThreadItem))then begin                                                  //if (Assigned(Thread)) and (Assigned(ThreadItem))then begin
3503                                                          if(Thread <> nil) and (ThreadItem <>nil) then begin                                                          if(Thread <> nil) and (ThreadItem <>nil) then begin
3504                                                                  if ThreadItem.UnRead then                                                                  if ThreadUnRead then
3505                                                                          BrowserMovement('new', Thread)                                                                          BrowserMovement('new', Thread)
3506                                                                  else if ThreadItem.ScrollTop <> 0 then begin                                                                  else if ThreadScrollTop <> 0 then begin
3507                                                                          try                                                                          try
3508                                                                                  doc.Body.ScrollTop := ThreadItem.ScrollTop;                                                                                  doc.Body.ScrollTop := ThreadScrollTop;
3509                                                                          except                                                                          except
3510                                                                                  on E: Exception do                                                                                  on E: Exception do
3511                                                                                          MsgBox(Handle, E.Message, 'SetContent[ScrollTop<-]', 0);                                                                                          MsgBox(Handle, E.Message, 'SetContent[ScrollTop<-]', 0);
3512                                                                          end;                                                                          end;
3513                                                                  end;                                                                  end;
3514                                                          end;                                                  //      end;
3515                                                  end else begin                                                  end else begin
3516                                                          FActiveContent := nil;                                                          FActiveContent := nil;
3517                                                          BrowserTab.Repaint;                                                          BrowserTab.Repaint;
# Line 3521  begin Line 3532  begin
3532                  if (Assigned(Thread)) and (Assigned(Thread.Thread)) and (Thread <> nil) and (ThreadItem <>nil) then begin                  if (Assigned(Thread)) and (Assigned(Thread.Thread)) and (Thread <> nil) and (ThreadItem <>nil) then begin
3533                          //FActiveContent := Thread;                          //FActiveContent := Thread;
3534    
3535                          BrowserBoardNameLabel.Caption := ThreadItem.ParentBoard.Title;                          BrowserBoardNameLabel.Caption := ThreadPTitle;
3536                          ItemIcon16.GetBitmap(4, ItemBoardImage.Picture.Bitmap);                          ItemIcon16.GetBitmap(4, ItemBoardImage.Picture.Bitmap);
3537                          BrowserNameLabel.Caption := ThreadItem.Title;                          BrowserNameLabel.Caption := ThreadTitle;
3538                          ItemImage.Picture := nil;                          ItemImage.Picture := nil;
3539                          if ThreadItem.IsLogFile then                          if ThreadIsLog then
3540                                  if ThreadItem.NewArrival then                                  if ThreadNewArraical then
3541                                          ItemImageList.GetBitmap(2, ItemImage.Picture.Bitmap)                                          ItemImageList.GetBitmap(2, ItemImage.Picture.Bitmap)
3542                                  else                                  else
3543                                          ItemImageList.GetBitmap(0, ItemImage.Picture.Bitmap)                                          ItemImageList.GetBitmap(0, ItemImage.Picture.Bitmap)
# Line 5479  begin Line 5490  begin
5490          Item := GetActiveContent;          Item := GetActiveContent;
5491          if Item = nil then Exit;          if Item = nil then Exit;
5492    
         if Item.Count >= 1000 then begin  
                 msg := 'このスレッドはレス数が1000を超えているので書込み出来ません。' + #13#10  
                                  + '新スレッドを探してください。';  
                 if MsgBox(Handle, msg, '警告', MB_YESNO or MB_ICONEXCLAMATION) <> 7 then begin  
                         Exit;  
                 end;  
         end;  
5493          Editor := TEditorForm.Create(Self);          Editor := TEditorForm.Create(Self);
5494          Editor.SetThreadItem(Item);          Editor.SetThreadItem(Item);
5495          Editor.BodyEdit.Text := '>>' + IntToStr(Number) + #13#10;          Editor.BodyEdit.Text := '>>' + IntToStr(Number) + #13#10;
# Line 5509  begin Line 5513  begin
5513          LPMSep05.Visible := (GetActiveList is TCategory) or (GetActiveList is TBoard);          LPMSep05.Visible := (GetActiveList is TCategory) or (GetActiveList is TBoard);
5514          DeletePMenu.Visible := (GetActiveList is TBoard);          DeletePMenu.Visible := (GetActiveList is TBoard);
5515          LPMSep06.Visible := (GetActiveList is TCategory) or (GetActiveList is TBoard);          LPMSep06.Visible := (GetActiveList is TCategory) or (GetActiveList is TBoard);
         SelectItemSaveForHTML1.Visible := (GetActiveList is TBoard);  
5516          BoardFavoriteAddMenu.Visible := (GetActiveList is TCategory);          BoardFavoriteAddMenu.Visible := (GetActiveList is TCategory);
5517          ThreadFavoriteAddMenu.Visible := (GetActiveList is TBoard);          ThreadFavoriteAddMenu.Visible := (GetActiveList is TBoard);
5518    
# Line 9601  begin Line 9604  begin
9604  end;  end;
9605  procedure TGikoForm.ExportFavoriteFileAccept(Sender: TObject);  procedure TGikoForm.ExportFavoriteFileAccept(Sender: TObject);
9606  begin  begin
9607    
9608          if FavoriteDM.SaveFavoriteFile( ExportFavoriteFile.Dialog.FileName ) Then begin          if FavoriteDM.SaveFavoriteFile( ExportFavoriteFile.Dialog.FileName ) Then begin
9609                  ShowMessage('ファイルを出力しました');                  ShowMessage('ファイルを出力しました');
9610          end else begin          end else begin
# Line 10343  begin Line 10347  begin
10347                  end;                  end;
10348  end;  end;
10349    
10350    procedure TGikoForm.SelectItemSaveForDatExecute(Sender: TObject);
10351    var
10352            List: TList;
10353            i: Integer;
10354    begin
10355            List := TList.Create;
10356            try
10357                    SelectListItem(List);
10358                    FileSaveAs1.Dialog.Title := '選択スレッドをdatのまま保存';
10359                    FileSaveAs1.Dialog.Filter := 'DATファイル(*.dat)|*.dat';
10360                    for i := 0 to List.Count - 1 do begin
10361                            if (TObject(List[i]) is TThreadItem) and (TThreadItem(List[i]).IsLogFile) then begin
10362                                    FileSaveAs1.Dialog.FileName := TThreadItem(List[i]).FileName;
10363                                    if FileSaveAs1.Execute then begin
10364                                            //なぜかキャンセルでもこっちに入ってくる
10365                                            if ExtractFilePath(FileSaveAs1.Dialog.FileName) <> '' then begin
10366                                                    CopyFile(PChar(TThreadItem(List[i]).FilePath),
10367                                                            PChar(FileSaveAs1.Dialog.FileName), true);
10368                                            end;
10369                                    end;
10370                            end;
10371                    end;
10372            finally
10373                    List.Free;
10374            end;
10375    
10376    end;
10377    
10378  procedure TGikoForm.SelectItemSaveForHTMLExecute(Sender: TObject);  procedure TGikoForm.SelectItemSaveForHTMLExecute(Sender: TObject);
10379  var  var
# Line 10357  begin Line 10388  begin
10388                  FileSaveAs1.Dialog.Title := '選択スレッドをHTML化して保存';                  FileSaveAs1.Dialog.Title := '選択スレッドをHTML化して保存';
10389                  FileSaveAs1.Dialog.Filter := 'HTMLファイル(*.html)|*.html';                  FileSaveAs1.Dialog.Filter := 'HTMLファイル(*.html)|*.html';
10390                  for i := 0 to List.Count - 1 do begin                  for i := 0 to List.Count - 1 do begin
10391                          if TObject(List[i]) is TThreadItem then begin                          if (TObject(List[i]) is TThreadItem) and (TThreadItem(List[i]).IsLogFile) then begin
10392                                  FileSaveAs1.Dialog.FileName := TThreadItem(List[i]).Title + '.html';                                  FileSaveAs1.Dialog.FileName := TThreadItem(List[i]).Title + '.html';
10393                                  if FileSaveAs1.Execute then begin                                  if FileSaveAs1.Execute then begin
10394                                          html := TStringList.Create;                                          //なぜかキャンセルでもこっちに入ってくる
10395                                          title := TThreadItem(List[i]).Title;                                          if ExtractFilePath(FileSaveAs1.Dialog.FileName) <> '' then begin
10396                                          try                                                  html := TStringList.Create;
10397                                                  GikoSys.CreateHTML2(html, TThreadItem(List[i]), title);                                                  title := TThreadItem(List[i]).Title;
10398                                                  html.SaveToFile(FileSaveAs1.Dialog.FileName);                                                  try
10399                                          finally                                                          GikoSys.CreateHTML3(html, TThreadItem(List[i]), title);
10400                                                  html.Free;                                                          html.SaveToFile(FileSaveAs1.Dialog.FileName);
10401                                                            SkinorCSSFilesCopy(ExtractFilePath(FileSaveAs1.Dialog.FileName));
10402                                                    finally
10403                                                            html.Free;
10404                                                    end;
10405                                          end;                                          end;
10406                                  end;                                  end;
10407                          end;                          end;
# Line 10375  begin Line 10410  begin
10410                  List.Free;                  List.Free;
10411          end;          end;
10412  end;  end;
10413    procedure TGikoForm.SkinorCSSFilesCopy(path: string);
10414    var
10415            tmp, tmpD, tmpF: string;
10416            current: string;
10417            dirs: TStringList;
10418            files: TStringList;
10419            i, j: Integer;
10420    begin
10421            if GikoSys.Setting.UseSkin then begin
10422                    current := ExtractFilePath(GikoSys.GetSkinDir);
10423                    tmp := GikoSys.Setting.CSSFileName;
10424            end else if GikoSys.Setting.UseCSS then begin
10425                    current := ExtractFilePath(GikoSys.GetStyleSheetDir);
10426                    tmp := ExtractFilePath(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName);
10427            end;
10428            dirs := TStringList.Create;
10429            try
10430                    dirs.Add(tmp);
10431                    if tmp <> current then begin
10432                            GikoSys.GetDirectoryList(current, '*.*', dirs, true);
10433                            for i := 0 to dirs.Count - 1 do begin
10434                                    files := TStringList.Create;
10435                                    try
10436                                            gikoSys.GetFileList(dirs[i], '*.*', files, true);
10437                                            tmpD := CustomStringReplace(dirs[i], GikoSys.GetConfigDir, path);
10438                                            if (AnsiPos(dirs[i], tmp) <> 0) and not (DirectoryExists(tmpD)) then
10439                                                    ForceDirectories(tmpD);
10440    
10441                                            if(dirs[i] = tmp) and (dirs[i] <> current) then begin
10442                                                    for j := 0 to files.Count - 1 do begin
10443                                                            tmpF := CustomStringReplace(files[j], GikoSys.GetConfigDir, path);
10444                                                            if not FileExists(tmpF) then begin
10445                                                                    CopyFile(PChar(files[j]), PChar(tmpF),True);
10446                                                            end;
10447                                                    end;
10448                                            end;
10449                                    finally
10450                                            files.Free;
10451                                    end;
10452                            end;
10453                    end else begin
10454                            tmpD := CustomStringReplace(dirs[0], GikoSys.GetConfigDir, path);
10455                            if not DirectoryExists(tmpD) then
10456                                    ForceDirectories(tmpD);
10457                            tmpF := CustomStringReplace(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName
10458                                            , GikoSys.GetConfigDir, path);
10459                            if not FileExists(tmpF) then begin
10460                                    CopyFile(PChar(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName)
10461                                            , PChar(tmpF), True);
10462                            end;
10463                    end;
10464            finally
10465                    dirs.Free;
10466            end;
10467    
10468    
10469    end;
10470  procedure TGikoForm.KidokuActionExecute(Sender: TObject);  procedure TGikoForm.KidokuActionExecute(Sender: TObject);
10471  var  var
10472          List: TList;          List: TList;
# Line 10391  begin Line 10482  begin
10482                          end;                          end;
10483                  end;                  end;
10484                  if TreeView.Visible then                  if TreeView.Visible then
10485                          TreeView.Refresh;                          TreeView.Refresh;
10486          finally          finally
10487                  List.Free;                  List.Free;
10488          end;          end;

Legend:
Removed from v.1.342  
changed lines
  Added in v.1.343

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