bottleclient/LogForm.pas

   1 unit LogForm;
   2
   3 interface
   4
   5 uses
   6   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   7   ComCtrls, ToolWin, StdCtrls, ExtCtrls, SsParser, BottleDef, Menus,
   8   Clipbrd, Logs, ShellAPI, Commctrl, DirectSstp, Contnrs, xmldom, XMLIntf,
   9   msxmldom, XMLDoc;
  10
  11 type
  12   TSaveLogType = (stLog, stLogWithChannels, stText, stXML);
  13
  14   TfrmLog = class(TForm)
  15     ToolBar: TToolBar;
  16     tbtnClear: TToolButton;
  17     pnlUpper: TPanel;
  18     SsParser: TSsParser;
  19     StatusBar: TStatusBar;
  20     tbtnSaveLog: TToolButton;
  21     PopupMenuPreview: TPopupMenu;
  22     mnPopCopy: TMenuItem;
  23     tbtnVoteMessage: TToolButton;
  24     PopupMenuListView: TPopupMenu;
  25     mnPopUpVoteMessage: TMenuItem;
  26     SaveDialog: TSaveDialog;
  27     pnlPanel: TPanel;
  28     Splitter: TSplitter;
  29     edtScript: TRichEdit;
  30     mnPopUpCopyScript: TMenuItem;
  31     PopupMenuSaveLog: TPopupMenu;
  32     mnSaveLog: TMenuItem;
  33     mnSaveLogChannel: TMenuItem;
  34     mnSaveLogScript: TMenuItem;
  35     mnSaveLogXML: TMenuItem;
  36     ToolButton1: TToolButton;
  37     mnJumpURL: TMenuItem;
  38     mnPopUpAgreeMessage: TMenuItem;
  39     tbtnAgreeMessage: TToolButton;
  40     ToolButton2: TToolButton;
  41     tbtnPreviewStyle: TToolButton;
  42     PopupMenuPreviewStyle: TPopupMenu;
  43     mnPreviewStyleConversation: TMenuItem;
  44     mnPreviewStyleScript: TMenuItem;
  45     mnPreviewStyleScriptWithLineBreak: TMenuItem;
  46     Panel1: TPanel;
  47     tabBottleLog: TTabControl;
  48     lvwLog: TListView;
  49     tbtnDownloadLog: TToolButton;
  50     PopupMenuTab: TPopupMenu;
  51     mnCloseTab: TMenuItem;
  52     tbtnFindBottle: TToolButton;
  53     XMLDocument: TXMLDocument;
  54     tbtnOpenLog: TToolButton;
  55     OpenDialog: TOpenDialog;
  56     procedure tbtnClearClick(Sender: TObject);
  57     procedure FormCreate(Sender: TObject);
  58     procedure lvwLogChange(Sender: TObject; Item: TListItem;
  59       Change: TItemChange);
  60     procedure lvwLogDblClick(Sender: TObject);
  61     procedure lvwLogKeyPress(Sender: TObject; var Key: Char);
  62     procedure FormDestroy(Sender: TObject);
  63     procedure lvwLogClick(Sender: TObject);
  64     procedure mnSaveLogClick(Sender: TObject);
  65     procedure lvwLogColumnClick(Sender: TObject; Column: TListColumn);
  66     procedure mnPopUpCopyScriptClick(Sender: TObject);
  67     procedure mnSaveLogChannelClick(Sender: TObject);
  68     procedure mnSaveLogScriptClick(Sender: TObject);
  69     procedure mnSaveLogXMLClick(Sender: TObject);
  70     procedure lvwLogData(Sender: TObject; Item: TListItem);
  71     procedure PopupMenuListViewPopup(Sender: TObject);
  72     procedure lvwLogCustomDrawItem(Sender: TCustomListView;
  73       Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  74     procedure lvwLogCustomDrawSubItem(Sender: TCustomListView;
  75       Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  76       var DefaultDraw: Boolean);
  77     procedure PopupMenuPreviewStylePopup(Sender: TObject);
  78     procedure mnPreviewStyleClick(Sender: TObject);
  79     procedure tbtnPreviewStyleClick(Sender: TObject);
  80     procedure tabBottleLogChange(Sender: TObject);
  81     procedure tabBottleLogChanging(Sender: TObject;
  82       var AllowChange: Boolean);
  83     procedure tabBottleLogContextPopup(Sender: TObject; MousePos: TPoint;
  84       var Handled: Boolean);
  85     procedure mnCloseTabClick(Sender: TObject);
  86     procedure tbtnFindBottleClick(Sender: TObject);
  87     procedure tbtnOpenLogClick(Sender: TObject);
  88   private
  89     { Private \90é\8c¾ }
  90     FLastScript: String; //\83X\83N\83\8a\83v\83g\8dÄ\95`\89æ\97}\90§\97p
  91     FBottleLogList: TObjectList;
  92     procedure UpdateScript(const Script: String);
  93     procedure UpdateScriptConversationColor(const Script: String);
  94     procedure UpdateScriptConversationNoColor(const Script: String);
  95     procedure UpdateScriptScript(const Script: String);
  96     procedure mnURLClick(Sender: TObject);
  97     procedure ExtractURLs(Script: String; Result: TStrings);
  98     function GetCurrentBottleLog: TBottleLogList;
  99     function GetDefaultFileName(const Name: String; const Ext: String): String;
 100   protected
 101     procedure CreateParams(var Params: TCreateParams); override;
 102   public
 103     { Public \90é\8c¾ }
 104     function SelectedBottleLog: TBottleLogList;
 105     property CurrentBottleLog: TBottleLogList read GetCurrentBottleLog;
 106     property BottleLogList: TObjectList read FBottleLogList;
 107     procedure AddCurrentScriptLog(const Script, Channel, MID, Ghost: String);
 108     procedure AddCurrentSystemLog(const MessageString: String);
 109     procedure VoteLog(const MID: String; const Vote: integer);
 110     procedure AgreeLog(const MID: String; const Agree: integer);
 111     procedure SetBottleStatusToPlaying(const MID: String);
 112     procedure SetBottleStatusToOpened(const MID: String);
 113     procedure LogLoaded(Sender: TObject);
 114     procedure LogLoadFailure(Sender: TObject; const Message: String);
 115     procedure UpdateTab;
 116     procedure UpdateWindow;
 117     procedure SelAndFocusMessage(const MID: String);
 118   end;
 119
 120
 121 var
 122   frmLog: TfrmLog;
 123
 124 function CurrentBottleLog: TBottleLogList;
 125
 126 const
 127   IconBottle    = 17;
 128   IconOpened    = 30;
 129   IconPlaying   = 31;
 130   IconSystemLog = 26;
 131   SubChannel    = 0;
 132   SubVotes      = 1;
 133   SubAgrees     = 2;
 134   SubScript     = 3;
 135
 136 implementation
 137
 138 uses MainForm, StrUtils;
 139
 140 {$R *.DFM}
 141
 142 function CurrentBottleLog: TBottleLogList;
 143 begin
 144   Result := frmLog.CurrentBottleLog;
 145 end;
 146
 147 { TfrmLog }
 148
 149 procedure TfrmLog.AddCurrentScriptLog(const Script, Channel, MID, Ghost: String);
 150 var Sel: integer;
 151 begin
 152   CurrentBottleLog.AddScriptLog(Script, Channel, MID, Ghost);
 153   if SelectedBottleLog <> CurrentBottleLog then Exit;
 154   lvwLog.OnChange := nil; //\83C\83x\83\93\83g\94\90¶(\82¢\82ë\82¢\82ë\8dÄ\95`\89æ\82ª\8bN\82«\82é)\82Ì\97}\90§
 155   if lvwLog.Selected <> nil then Sel := lvwLog.Selected.Index else Sel := -1;
 156   lvwLog.Items.Count := CurrentBottleLog.Count;
 157   UpdateWindow;
 158   if Sel >= 0 then begin
 159     lvwLog.Selected := lvwLog.Items[Sel + 1];
 160     lvwLog.Selected.Focused := true;
 161   end;
 162   if not lvwLog.Focused then
 163     ListView_Scroll(lvwLog.Handle, 0, High(integer));
 164   lvwLog.OnChange := lvwLogChange;
 165 end;
 166
 167 procedure TfrmLog.AddCurrentSystemLog(const MessageString: String);
 168 var Sel: integer;
 169 begin
 170   CurrentBottleLog.AddSystemLog(MessageString);
 171   if SelectedBottleLog <> CurrentBottleLog then Exit;
 172   lvwLog.OnChange := nil;
 173   if lvwLog.Selected <> nil then Sel := lvwLog.Selected.Index else Sel := -1;
 174   lvwLog.Items.Count := CurrentBottleLog.Count;
 175   UpdateWindow;
 176   if Sel >= 0 then begin
 177     lvwLog.Selected := lvwLog.Items[Sel + 1];
 178     lvwLog.Selected.Focused := true;
 179   end;
 180   if not lvwLog.Focused then
 181     ListView_Scroll(lvwLog.Handle, 0, High(integer));
 182   lvwLog.OnChange := lvwLogChange;
 183 end;
 184
 185
 186
 187 procedure TfrmLog.tbtnClearClick(Sender: TObject);
 188 begin
 189   if SelectedBottleLog = CurrentBottleLog then begin
 190     CurrentBottleLog.Clear;
 191     lvwLog.Items.Count := 0;
 192     lvwLog.Invalidate;
 193     lvwLogChange(Self, nil, ctState);
 194   end else begin
 195     FBottleLogList.Delete(tabBottleLog.TabIndex);
 196     tabBottleLog.TabIndex := 0;
 197     UpdateTab;
 198     UpdateWindow;
 199     lvwLogChange(Self, nil, ctState);
 200   end;
 201 end;
 202
 203 procedure TfrmLog.FormCreate(Sender: TObject);
 204 begin
 205   FBottleLogList := TObjectList.Create;
 206   FBottleLogList.Add(TBottleLogList.Create('\83J\83\8c\83\93\83g')); // CurrentBottleLog
 207
 208   SsParser.TagPattern.Assign(frmSender.SsParser.TagPattern);
 209   SsParser.MetaPattern.Assign(frmSender.SsParser.MetaPattern);
 210
 211   with Pref.LogWindowPosition do begin
 212     Self.Left   := Left;
 213     Self.Top    := Top;
 214     Self.Width  := Right - Left + 1;
 215     Self.Height := Bottom - Top + 1;
 216   end;
 217   lvwLog.DoubleBuffered := true;
 218   edtScript.Height := Pref.LogWindowDividerPos;
 219   UpdateWindow; // Reset window color and enabled status of some buttons
 220 end;
 221
 222 procedure TfrmLog.FormDestroy(Sender: TObject);
 223 begin
 224   with Pref.LogWindowPosition do begin
 225     Left   := Self.Left;
 226     Top    := Self.Top;
 227     Right  := Self.Left + Self.Width - 1;
 228     Bottom := Self.Top + Self.Height - 1;
 229   end;
 230   Pref.LogWindowDividerPos := edtScript.Height;
 231
 232   FreeAndNil(FBottleLogList);
 233 end;
 234
 235 procedure TfrmLog.lvwLogChange(Sender: TObject; Item: TListItem;
 236   Change: TItemChange);
 237 var Script: String;
 238     Log: TLogItem;
 239 begin
 240   StatusBar.Panels[0].Text := IntToStr(SelectedBottleLog.Count) + '\8c\8f';
 241   if Change = ctState then begin
 242     Script := '';
 243     if lvwLog.Selected <> nil then begin
 244       Log := SelectedBottleLog.Bottles[lvwLog.Selected.Index];
 245       if (Log.LogType = ltBottle) and not frmSender.Connecting then begin
 246         Script := Log.Script;
 247         frmSender.actVoteMessage.Enabled := true;
 248         frmSender.actAgreeMessage.Enabled := true;
 249         mnPopUpCopyScript.Enabled := true;
 250         UpdateScript(Script);
 251       end else begin
 252         frmSender.actVoteMessage.Enabled := false;
 253         frmSender.actAgreeMessage.Enabled := false;
 254         mnPopUpCopyScript.Enabled := false;
 255         UpdateScript(''); // \83\8d\83O\83v\83\8c\83r\83\85\81[\95\94\82ð\83N\83\8a\83A
 256       end;
 257     end else begin
 258       frmSender.actVoteMessage.Enabled := false;
 259       frmSender.actAgreeMessage.Enabled := false;
 260       mnPopUpCopyScript.Enabled := false;
 261       UpdateScript(Script); // \83\8d\83O\83v\83\8c\83r\83\85\81[\95\94\83N\83\8a\83A
 262     end;
 263   end;
 264   tbtnSaveLog.Enabled := lvwLog.Items.Count > 0;
 265 end;
 266
 267 procedure TfrmLog.lvwLogDblClick(Sender: TObject);
 268 var Script: String;
 269     Opt: TScriptTransOptions;
 270     SOpt: TSstpSendOptions;
 271     Ghost: String;
 272     Log: TLogItem;
 273 begin
 274   if lvwLog.Selected = nil then Exit;
 275   //Log := TLogItem(lvwLog.Selected.Data);
 276   Log := SelectedBottleLog.Bottles[lvwLog.Selected.Index];
 277   if Log = nil then Exit;
 278   if Log.LogType <> ltBottle then Exit;
 279   Script := Log.Script;
 280   Opt := [toConvertURL, toWaitScriptEnd];
 281   if Pref.NoTransUrl then Opt := Opt + [toNoChoice];
 282   if Pref.IgnoreFrequentYenS then Opt := Opt + [toIgnoreFrequentYenS];
 283   if Pref.FixMessySurface then Opt := Opt + [toFixMessySurface];
 284   frmSender.DoTrans(Script, Opt);
 285
 286   Ghost := frmSender.GetChannelPrefs(Log.Channel).TargetGhost;
 287   if Ghost = '' then //\83`\83\83\83\93\83l\83\8b\8ew\92è\83S\81[\83X\83g
 288     if frmSender.ChannelList.Channel[Log.Channel] <> nil then
 289       Ghost := frmSender.ChannelList.Channel[Log.Channel].Ghost;
 290   //\96Ú\95W\83S\81[\83X\83g\8c\88\92è
 291   if Log.Ghost <> '' then Ghost := Log.Ghost;
 292   if frmSender.GetChannelPrefs(Log.Channel).IgnoreIfGhost then
 293     Ghost := frmSender.GetChannelPrefs(Log.Channel).TargetGhost;
 294   //\83^\81[\83Q\83b\83g\83S\81[\83X\83g\8am\92è
 295   Ghost := frmSender.SetHWndToFavoriteGhost(Ghost);
 296   frmSender.DirectSstp.SstpSender := 'SSTP Bottle -\81y\83\8d\83O\8dÄ\90¶\81z';
 297   if Pref.NoTranslate then SOpt := [soNoTranslate] else SOpt := [];
 298   frmSender.DirectSstp.SstpSEND(Script, SOpt, frmSender.GhostNameToSetName(Ghost));
 299 end;
 300
 301 procedure TfrmLog.UpdateScriptConversationColor(const Script: String);
 302 var i: integer;
 303     scr: String;
 304     UnyuTalking, Talked: boolean;
 305 begin
 306   scr := Script;
 307   frmSender.DoTrans(scr, [toConvertURL]);
 308   SsParser.LeaveEscape := false;
 309   SsParser.InputString := scr;
 310   SsParser.LeaveEscape := true;
 311   UnyuTalking := false;
 312   Talked := false; //'\h\u\h\u'\82Ì\82æ\82¤\82È\83X\83N\83\8a\83v\83g\82Å\8bó\82«\8ds\82ð\8dì\82ç\82È\82¢\82½\82ß\82Ì\91[\92u
 313   edtScript.Text := '';
 314   edtScript.Color := Pref.BgColor;
 315   for i := 0 to SsParser.Count-1 do begin
 316     if (SsParser[i] = '\u') and not UnyuTalking then begin
 317       UnyuTalking := true;
 318       if Talked then begin
 319         edtScript.SelText := #13#10;
 320         Talked := false;
 321       end;
 322     end;
 323     if (SsParser[i] = '\h') and UnyuTalking then begin
 324       UnyuTalking := false;
 325       if Talked then begin
 326         edtScript.SelText := #13#10;
 327         Talked := false;
 328       end;
 329     end;
 330     if SsParser.MarkUpType[i] = mtStr then begin
 331       if UnyuTalking then
 332         edtScript.SelAttributes.Color := Pref.TalkColorU
 333       else
 334         edtScript.SelAttributes.Color := Pref.TalkColorH;
 335       edtScript.SelText := SsParser[i];
 336       Talked := true;
 337     end;
 338     if SsParser.MarkUpType[i] = mtMeta then begin
 339       edtScript.SelAttributes.Color := Pref.MetaWordColor;
 340       edtScript.SelText := SsParser[i];
 341       Talked := true;
 342     end;
 343   end;
 344 end;
 345
 346 procedure TfrmLog.UpdateScriptConversationNoColor(const Script: String);
 347 var Scr: String;
 348     i: integer;
 349     UnyuTalking, Talked, LastUnyuTalked: boolean;
 350 begin
 351   Scr := Script;
 352   frmSender.DoTrans(Scr, [toConvertURL]);
 353   SsParser.LeaveEscape := false;
 354   SsParser.InputString := Scr;
 355   SsParser.LeaveEscape := true;
 356   edtScript.Text := '';
 357   edtScript.Color := clWindow;
 358   edtScript.DefAttributes.Color := clWindowText;
 359   edtScript.SelAttributes.Color := clWindowText;
 360   Talked := false;
 361   UnyuTalking := false;
 362   LastUnyuTalked := false;
 363   for i := 0 to SsParser.Count-1 do begin
 364     if (SsParser[i] = '\u') and not UnyuTalking then begin
 365       UnyuTalking := true;
 366     end;
 367     if (SsParser[i] = '\h') and UnyuTalking then begin
 368       UnyuTalking := false;
 369     end;
 370     if SsParser.MarkUpType[i] in [mtStr, mtMeta] then begin
 371       if not Talked then begin
 372         if UnyuTalking then Scr := '\82¤:' else Scr := '\82³:';
 373       end;
 374       if Talked and (UnyuTalking <> LastUnyuTalked) then begin
 375         Scr := Scr + #13#10;
 376         if UnyuTalking then Scr := Scr + '\82¤:' else Scr := Scr + '\82³:';
 377       end;
 378       Scr := Scr + SsParser[i];
 379       Talked := true;
 380       LastUnyuTalked := UnyuTalking;
 381     end;
 382   end;
 383   edtScript.Text := Scr;
 384 end;
 385
 386 procedure TfrmLog.lvwLogKeyPress(Sender: TObject; var Key: Char);
 387 begin
 388   if Key = #13 then lvwLogDblClick(Sender);
 389 end;
 390
 391 procedure TfrmLog.CreateParams(var Params: TCreateParams);
 392 begin
 393   inherited;
 394   Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
 395 end;
 396
 397 procedure TfrmLog.lvwLogClick(Sender: TObject);
 398 begin
 399   //\89E\83N\83\8a\83b\83N\82Å\83\81\83j\83\85\81[\8fo\82·\82Æ\82«\82É\94\90¶\82·\82é\95s\8bï\8d\87\91Î\8dô
 400   with lvwLog do
 401     Selected := Selected;
 402 end;
 403
 404 procedure TfrmLog.lvwLogColumnClick(Sender: TObject; Column: TListColumn);
 405 var SortType: TBottleLogSortType;
 406     SelectedMID: String;
 407     SortColumn: integer;
 408 begin
 409   if lvwLog.Selected <> nil then
 410     SelectedMID := SelectedBottleLog.Bottles[lvwLog.Selected.Index].MID;
 411
 412   SortColumn := Column.Index;
 413   case SortColumn-1 of
 414     -1: SortType := stLogTime;
 415     subChannel: SortType := stChannel;
 416     subVotes:   SortType := stVote;
 417     subAgrees:  SortType := stAgree;
 418     subScript:  SortType := stScript;
 419   else SortType := stLogTime;
 420   end;
 421
 422   SelectedBottleLog.SortBottles(SortType);
 423   lvwLog.Invalidate;
 424   SelAndFocusMessage(SelectedMID);
 425 end;
 426
 427
 428 procedure TfrmLog.mnPopUpCopyScriptClick(Sender: TObject);
 429 var
 430   Log: TLogItem;
 431   Clip: TClipBoard;
 432 begin
 433   Log := SelectedBottleLog.Bottles[frmLog.lvwLog.Selected.Index];
 434   if Log = nil then Exit;
 435   Clip := ClipBoard();
 436   Clip.SetTextBuf(PChar(Log.Script));
 437 end;
 438
 439 procedure TfrmLog.SetBottleStatusToOpened(const MID: String);
 440 begin
 441   if CurrentBottleLog.Bottle(MID) <> nil then begin
 442     CurrentBottleLog.Bottle(MID).State := lsOpened;
 443     lvwLog.OnChange := nil;
 444     lvwLog.Invalidate;
 445     lvwLog.OnChange := lvwLogChange;
 446   end;
 447 end;
 448
 449 procedure TfrmLog.SetBottleStatusToPlaying(const MID: String);
 450 begin
 451   if CurrentBottleLog.Bottle(MID) <> nil then begin
 452     CurrentBottleLog.Bottle(MID).State := lsPlaying;
 453     lvwLog.OnChange := nil;
 454     lvwLog.Invalidate;
 455     lvwLog.OnChange := lvwLogChange;
 456   end;
 457 end;
 458
 459 procedure TfrmLog.mnSaveLogClick(Sender: TObject);
 460 begin
 461   SaveDialog.FileName := GetDefaultFileName(SelectedBottleLog.Title, '.log');
 462   SaveDialog.InitialDir := ExtractFileDir(Application.ExeName);
 463   SaveDialog.DefaultExt := 'log';
 464   SaveDialog.FilterIndex := 1;
 465   if SaveDialog.Execute then
 466     SelectedBottleLog.SaveToSstpLog(SaveDialog.FileName, false);
 467 end;
 468
 469 procedure TfrmLog.mnSaveLogChannelClick(Sender: TObject);
 470 begin
 471   SaveDialog.FileName := GetDefaultFileName(SelectedBottleLog.Title, '.log');
 472   SaveDialog.InitialDir := ExtractFileDir(Application.ExeName);
 473   SaveDialog.DefaultExt := 'log';
 474   SaveDialog.FilterIndex := 1;
 475   if SaveDialog.Execute then
 476     SelectedBottleLog.SaveToSstpLog(SaveDialog.FileName, true);
 477 end;
 478
 479 procedure TfrmLog.mnSaveLogScriptClick(Sender: TObject);
 480 begin
 481   SaveDialog.FileName := GetDefaultFileName(SelectedBottleLog.Title, '.txt');
 482   SaveDialog.InitialDir := ExtractFileDir(Application.ExeName);
 483   SaveDialog.DefaultExt := 'txt';
 484   SaveDialog.FilterIndex := 2;
 485   if SaveDialog.Execute then
 486     SelectedBottleLog.SaveToText(SaveDialog.FileName);
 487 end;
 488
 489 procedure TfrmLog.mnSaveLogXMLClick(Sender: TObject);
 490 begin
 491   SaveDialog.FileName := GetDefaultFileName(SelectedBottleLog.Title, '.xml');
 492   SaveDialog.InitialDir := ExtractFileDir(Application.ExeName);
 493   SaveDialog.DefaultExt := 'xml';
 494   SaveDialog.FilterIndex := 3;
 495   if SaveDialog.Execute then
 496     SelectedBottleLog.SaveToXmlFile(SaveDialog.FileName, XMLDocument);
 497 end;
 498
 499 procedure TfrmLog.lvwLogData(Sender: TObject; Item: TListItem);
 500 var i: integer;
 501     Log: TLogItem;
 502 begin
 503   if Item = nil then Exit;
 504   i := Item.Index;
 505   Log := SelectedBottleLog.Bottles[i];
 506   with Item do begin
 507     Caption := FormatDateTime('yy/mm/dd hh:nn:ss', Log.LogTime);
 508     SubItems.Clear;
 509     if Log.Ghost <> '' then
 510       SubItems.Add(Log.Channel + '/' + Log.Ghost)
 511     else
 512       SubItems.Add(Log.Channel);
 513     if Log.LogType = ltBottle then begin
 514       SubItems.Add(IntToStr(Log.Votes));
 515       SubItems.Add(IntToStr(Log.Agrees));
 516     end else begin
 517       // \83V\83X\83e\83\80\83\8d\83O\82È\82Ç\82Í\93\8a\95[\81E\93¯\88Ó\82ð\95\\8e¦\82µ\82È\82¢
 518       SubItems.Add('-');
 519       SubItems.Add('-');
 520     end;
 521     SubItems.Add(Log.Script);
 522
 523     if Log.LogType = ltBottle then begin
 524       case Log.State of
 525         lsUnopened: ImageIndex := IconBottle;
 526         lsPlaying:  ImageIndex := IconPlaying;
 527         lsOpened:   ImageIndex := IconOpened;
 528       end;
 529     end else
 530       ImageIndex := IconSystemLog;
 531   end;
 532 end;
 533
 534 procedure TfrmLog.UpdateWindow;
 535 begin
 536   StatusBar.Panels[0].Text := IntToStr(SelectedBottleLog.Count) + '\8c\8f';
 537   if Pref.ColorScript then begin
 538     if lvwLog.Color <> Pref.BgColor then lvwLog.Color := Pref.BgColor;
 539     if lvwLog.Font.Color <> Pref.TalkColorH then lvwLog.Font.Color := Pref.TalkColorH;
 540   end else begin
 541     if lvwLog.Color <> clWindow then lvwLog.Color := clWindow;
 542     if lvwLog.Font.Color <> clWindowText then lvwLog.Font.Color := clWindowText;
 543   end;
 544   lvwLog.Items.Count := SelectedBottleLog.Count;
 545   lvwLog.Invalidate;
 546   //lvwLogChange(Self, lvwLog.Selected, ctState);
 547 end;
 548
 549 procedure TfrmLog.PopupMenuListViewPopup(Sender: TObject);
 550 var Log: TLogItem;
 551     Child: TMenuItem;
 552     Urls: TStringList;
 553     i: integer;
 554 begin
 555   for i := mnJumpURL.Count-1 downto 0 do begin
 556     mnJumpURL.Items[i].Free;
 557   end;
 558   mnJumpURL.Enabled := false;
 559   if lvwLog.Selected = nil then Exit;
 560   Log := SelectedBottleLog.Bottles[lvwLog.Selected.Index];
 561   if Log = nil then Exit;
 562   Urls := nil;
 563   try
 564     Urls := TStringList.Create;
 565     ExtractURLs(Log.Script, Urls);
 566     for i := 0 to Urls.Count-1 do begin
 567       Child := TMenuItem.Create(Self);
 568       with Child do begin
 569         Caption := Format('(&%d) %s', [i+1, Urls[i]]);
 570         OnClick := mnURLClick;
 571         AutoHotkeys := maManual;
 572         mnJumpURL.Add(Child);
 573       end;
 574     end;
 575     mnJumpURL.Enabled := Urls.Count > 0;
 576   finally
 577     Urls.Free;
 578   end;
 579 end;
 580
 581 procedure TfrmLog.mnURLClick(Sender: TObject);
 582 var URL: String;
 583 begin
 584   URL := (Sender as TMenuItem).Caption;
 585   RegExp.Subst('s/^\(&?\d\) //', URL);
 586   ShellExecute(Handle, 'open', PChar(URL), nil, nil, SW_SHOW);
 587 end;
 588
 589 procedure TfrmLog.ExtractURLs(Script: String; Result: TStrings);
 590 var i, u, j: integer;
 591     s: String;
 592 begin
 593   Result.Clear;
 594   SsParser.LeaveEscape := false;
 595   SsParser.InputString := Script;
 596   SsParser.LeaveEscape := true;
 597   for i := 0 to SsParser.Count-1 do begin
 598     if (SsParser.Match(SsParser[i], '\URL%b') > 0) then begin
 599       for u := 7 downto 1 do begin
 600         if (SsParser.Match(SsParser[i],
 601             '\URL%b'+StringReplace(StringOfChar('-', u*2),
 602             '-', '%b', [rfReplaceAll]))) > 0 then begin
 603           for j := 1 to u do begin
 604             s := SsParser.GetParam(SsParser[i], j*2);
 605             if Pos('http://', s) > 0 then Result.Add(s);
 606           end;
 607           Break;
 608         end;
 609       end;
 610       if SsParser.Match(SsParser[i], '\URL%b%b') = 0 then begin //\8aÈ\88Õ\94ÅURL\95Ï\8a·
 611         //\8aÈ\88Õ\8c`\8e®\URL\83^\83O\95Ï\8a·
 612         s := SsParser.GetParam(SsParser[i], 1);
 613         if Pos('http://', s) > 0 then Result.Add(s);
 614       end;
 615     end;
 616   end;
 617 end;
 618
 619 procedure TfrmLog.SelAndFocusMessage(const MID: String);
 620 var i: integer;
 621     Log: TLogItem;
 622 begin
 623   for i := 0 to SelectedBottleLog.Count-1 do begin
 624     Log := SelectedBottleLog.Items[i] as TLogItem;
 625     if Log.MID = MID then begin
 626       lvwLog.Items[i].Selected := true;
 627       lvwLog.Items[i].Focused := true;
 628     end;
 629   end;
 630 end;
 631
 632 procedure TfrmLog.lvwLogCustomDrawItem(Sender: TCustomListView;
 633   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
 634 begin
 635   //
 636 end;
 637
 638 procedure TfrmLog.lvwLogCustomDrawSubItem(Sender: TCustomListView;
 639   Item: TListItem; SubItem: Integer; State: TCustomDrawState;
 640   var DefaultDraw: Boolean);
 641 {var
 642   DestRect: TRect;
 643   Script: String;
 644   i, x, w: integer;
 645   SavedDC: integer;
 646   Mark: TSsMarkUpType;}
 647 begin
 648   Exit // !!
 649   {if (SubItem <> SubScript+1) or (not Pref.ColorScript) then Exit; // DefaultDraw = true
 650   // Custom Script Coloring
 651   DefaultDraw := false;
 652   SavedDC := SaveDC(lvwLog.Canvas.Handle);
 653   try
 654     ListView_GetSubItemRect(lvwLog.Handle, Item.Index, SubScript+1, LVIR_BOUNDS, @DestRect);
 655
 656     lvwLog.Canvas.Brush.Style := bsSolid;
 657     if cdsSelected in State then begin
 658       lvwLog.Canvas.Brush.Color := clHighlight
 659     end else begin
 660       lvwLog.Canvas.Brush.Color := Pref.BgColor;
 661     end;
 662     lvwLog.Canvas.FillRect(DestRect);
 663     lvwLog.Canvas.Brush.Style := bsClear;
 664
 665     Script := Item.SubItems[SubScript];
 666     // DrawTextEx(lvwLog.Canvas.Handle, PChar(Script), -1, DestRect, DT_END_ELLIPSIS, nil);
 667     SsParser.InputString := Script;
 668     x := 6;
 669     for i := 0 to SsParser.Count - 1 do begin
 670       Mark := SsParser.MarkUpType[i];
 671       case Mark of
 672         mtMeta:   lvwLog.Canvas.Font.Color := Pref.MetaWordColor;
 673         mtTag:    lvwLog.Canvas.Font.Color := Pref.MarkUpColor;
 674         mtTagErr: lvwLog.Canvas.Font.Color := Pref.MarkErrorColor;
 675         else begin
 676           lvwLog.Canvas.Font.Color := Pref.TalkColorH;
 677         end;
 678       end;
 679       w := lvwLog.Canvas.TextWidth(SsParser[i]);
 680       lvwLog.Canvas.TextRect(DestRect, DestRect.Left + x, DestRect.Top + 2, SsParser[i]);
 681       x := x + w;
 682       if DestRect.Right - DestRect.Left < x then Break;
 683     end;
 684   finally
 685     RestoreDC(lvwLog.Canvas.Handle, SavedDC);
 686   end;}
 687 end;
 688
 689 procedure TfrmLog.UpdateScript(const Script: String);
 690 begin
 691   if Script <> FLastScript then begin
 692     if Pref.LogWindowPreviewStyle = psConversation then begin
 693       if Pref.ColorScript then begin
 694         UpdateScriptConversationColor(Script);
 695       end else begin
 696         UpdateScriptConversationNoColor(Script);
 697       end;
 698     end else begin
 699       UpdateScriptScript(Script);
 700     end;
 701     SendMessage(edtScript.Handle, EM_LINESCROLL, Low(integer), Low(integer)); //\83X\83N\83\8d\81[\83\8b\96ß\82µ
 702     FLastScript := Script;
 703   end;
 704 end;
 705
 706 procedure TfrmLog.PopupMenuPreviewStylePopup(Sender: TObject);
 707 var i: integer;
 708 begin
 709   with PopupMenuPreviewStyle do
 710     for i := 0 to Items.Count-1 do
 711       Items[i].Checked := Items[i].Tag = Ord(Pref.LogWindowPreviewStyle)
 712 end;
 713
 714 procedure TfrmLog.mnPreviewStyleClick(Sender: TObject);
 715 var i: integer;
 716 begin
 717   with PopupMenuPreviewStyle do
 718     for i := 0 to Items.Count-1 do
 719       Items[i].Checked := (Sender as TMenuItem).Tag = Items[i].Tag;
 720   Pref.LogWindowPreviewStyle := TLogWindowPreviewStyle((Sender as TMenuItem).Tag);
 721   FLastScript := '';
 722   lvwLogChange(self, lvwLog.Selected, ctState);
 723 end;
 724
 725 procedure TfrmLog.UpdateScriptScript(const Script: String);
 726 var
 727   UnyuTalking: boolean;
 728   i: integer;
 729 begin
 730   if Pref.ColorScript then begin
 731     edtScript.Color := Pref.BgColor;
 732   end else begin
 733     edtScript.Color := clWindow;
 734     edtScript.DefAttributes.Color := clWindowText;
 735     edtScript.SelAttributes.Color := clWindowText;
 736   end;
 737   SsParser.LeaveEscape := true;
 738   SsParser.InputString := Script;
 739   edtScript.Text := '';
 740   edtScript.SelAttributes.Color := clWindowText;
 741   UnyuTalking := false;
 742   for i := 0 to SsParser.Count-1 do begin
 743     if Pref.ColorScript then begin
 744       case SsParser.MarkUpType[i] of
 745         mtStr: begin
 746           if UnyuTalking then
 747             edtScript.SelAttributes.Color := Pref.TalkColorU
 748           else
 749             edtScript.SelAttributes.Color := Pref.TalkColorH;
 750         end;
 751         mtTag: begin
 752           edtScript.SelAttributes.Color := Pref.MarkUpColor;
 753           if SsParser[i] = '\h' then
 754             UnyuTalking := false
 755           else if SsParser[i] = '\u' then
 756             UnyuTalking := true;
 757         end;
 758         mtMeta:   edtScript.SelAttributes.Color := Pref.MetaWordColor;
 759         mtTagErr: edtScript.SelAttributes.Color := Pref.MarkErrorColor;
 760       end;
 761     end;
 762     edtScript.SelText := SsParser[i];
 763     if (SsParser[i] = '\n') and (Pref.LogWindowPreviewStyle = psScriptWithLineBreak) then
 764       edtScript.SelText := #13#10;
 765   end;
 766 end;
 767
 768 procedure TfrmLog.tbtnPreviewStyleClick(Sender: TObject);
 769 var sel: integer;
 770 begin
 771   sel := Ord(Pref.LogWindowPreviewStyle);
 772   sel := sel + 1;
 773   if sel > Ord(High(TLogWindowPreviewStyle)) then sel := 0;
 774   Pref.LogWindowPreviewStyle := TLogWindowPreviewStyle(sel);
 775   FLastScript := '';
 776   lvwLogChange(self, lvwLog.Selected, ctState);
 777 end;
 778
 779 function TfrmLog.SelectedBottleLog: TBottleLogList;
 780 begin
 781   Result := FBottleLogList.Items[tabBottleLog.TabIndex] as TBottleLogList;
 782 end;
 783
 784 function TfrmLog.GetCurrentBottleLog: TBottleLogList;
 785 begin
 786   Result := FBottleLogList.Items[0] as TBottleLogList;
 787 end;
 788
 789 procedure TfrmLog.tabBottleLogChange(Sender: TObject);
 790 begin
 791   UpdateWindow;
 792   if SelectedBottleLog.SelectedIndex >= 0 then begin
 793     lvwLog.Items[SelectedBottleLog.SelectedIndex].Selected := true;
 794     if lvwLog.Focused then lvwLog.Selected.Focused := true;
 795   end;
 796   lvwLogChange(Self, nil, ctState);
 797 end;
 798
 799 procedure TfrmLog.LogLoaded(Sender: TObject);
 800 begin
 801   if SelectedBottleLog = Sender then begin
 802     UpdateWindow;
 803   end;
 804 end;
 805
 806 procedure TfrmLog.UpdateTab;
 807 var i: integer;
 808     cur: TBottleLogList;
 809 begin
 810   cur := SelectedBottleLog;
 811   tabBottleLog.Tabs.Clear;
 812   for i := 0 to FBottleLogList.Count - 1 do begin
 813     tabBottleLog.Tabs.Add((FBottleLogList[i] as TBottleLogList).Title);
 814   end;
 815   tabBottleLog.TabIndex := FBottleLogList.IndexOf(cur);
 816 end;
 817
 818 procedure TfrmLog.LogLoadFailure(Sender: TObject; const Message: String);
 819 begin
 820   Beep;
 821   ShowMessage(Message);
 822   (Sender as TBottleLogList).AddSystemLog(Message);
 823   lvwLog.Invalidate;
 824 end;
 825
 826 procedure TfrmLog.AgreeLog(const MID: String; const Agree: integer);
 827 var i: integer;
 828     flag: boolean;
 829 begin
 830   flag := false;
 831   for i := 0 to FBottleLogList.Count - 1 do begin
 832     if (FBottleLogList[i] as TBottleLogList).Bottle(MID) <> nil then begin
 833       (FBottleLogList[i] as TBottleLogList).Bottle(MID).Agrees := Agree;
 834       flag := true;
 835     end;
 836   end;
 837   if flag then lvwLog.Invalidate;
 838 end;
 839
 840 procedure TfrmLog.VoteLog(const MID: String; const Vote: integer);
 841 var i: integer;
 842     flag: boolean;
 843 begin
 844   flag := false;
 845   for i := 0 to FBottleLogList.Count - 1 do begin
 846     if (FBottleLogList[i] as TBottleLogList).Bottle(MID) <> nil then begin
 847       (FBottleLogList[i] as TBottleLogList).Bottle(MID).Votes := Vote;
 848       flag := true;
 849     end;
 850   end;
 851   if flag then lvwLog.Invalidate;
 852 end;
 853
 854 procedure TfrmLog.tabBottleLogChanging(Sender: TObject;
 855   var AllowChange: Boolean);
 856 begin
 857   if lvwLog.Selected <> nil then
 858     SelectedBottleLog.SelectedIndex := lvwLog.Selected.Index
 859   else
 860     SelectedBottleLog.SelectedIndex := -1;
 861 end;
 862
 863 procedure TfrmLog.tabBottleLogContextPopup(Sender: TObject;
 864   MousePos: TPoint; var Handled: Boolean);
 865 begin
 866   with tabBottleLog do begin
 867     Tag := IndexOfTabAt(MousePos.X, MousePos.Y);
 868     if Tag < 0 then Handled := true;
 869     mnCloseTab.Enabled := Tag > 0;
 870   end;
 871 end;
 872
 873 procedure TfrmLog.mnCloseTabClick(Sender: TObject);
 874 begin
 875   if tabBottleLog.Tag = 0 then Exit;
 876   FBottleLogList.Delete(tabBottleLog.Tag);
 877   tabBottleLog.TabIndex := 0;
 878   UpdateTab;
 879   UpdateWindow;
 880   lvwLogChange(Self, nil, ctState);
 881 end;
 882
 883 procedure TfrmLog.tbtnFindBottleClick(Sender: TObject);
 884 var Query: String;
 885     ResultLog: TBottleLogList;
 886     Item1, Item2: TLogItem;
 887     i, matched: integer;
 888 begin
 889   if SelectedBottleLog.Count = 0 then begin
 890     ShowMessage('\8c\9f\8dõ\91Î\8fÛ\82ª\8bó\82Å\82·\81B');
 891     Exit;
 892   end;
 893   Query := '';
 894   matched := 0;
 895   if InputQuery('\83X\83N\83\8a\83v\83g\96{\95¶\82ð\8c\9f\8dõ', '\8c\9f\8dõ\95¶\8e\9a\97ñ', Query) then begin
 896     if Query = '' then Exit;
 897     ResultLog := TBottleLogList.Create('\8c\9f\8dõ\8c\8b\89Ê');
 898     for i := 0 to SelectedBottleLog.Count-1 do begin
 899       Item1 := SelectedBottleLog.Items[i] as TLogItem;
 900       if AnsiContainsText(Item1.Script, Query) and (Item1.LogType = ltBottle) then begin
 901         matched := matched + 1;
 902         Item2 := TLogItem.Create(ltBottle, Item1.MID, Item1.Channel,
 903           Item1.Script, Item1.Ghost, Item1.LogTime);
 904         Item2.State := lsOpened;
 905         Item2.Votes := Item1.Votes;
 906         Item2.Agrees := Item1.Agrees;
 907         ResultLog.Add(Item2);
 908       end;
 909     end;
 910     if matched = 0 then
 911       ResultLog.AddSystemLog('\8c©\82Â\82©\82è\82Ü\82¹\82ñ\82Å\82µ\82½');
 912     BottleLogList.Add(ResultLog);
 913     UpdateTab;
 914     tabBottleLog.TabIndex := BottleLogList.Count-1;
 915     UpdateWindow;
 916   end;
 917 end;
 918
 919 procedure TfrmLog.tbtnOpenLogClick(Sender: TObject);
 920 var BottleLog: TBottleLogList;
 921     i: integer;
 922 begin
 923   BottleLog := nil;
 924   if OpenDialog.Execute then begin
 925     try
 926       for i := 0 to OpenDialog.Files.Count-1 do begin
 927         BottleLog := TBottleLogList.Create(ExtractFileName(OpenDialog.Files[i]));
 928         BottleLog.LoadFromXMLFile(OpenDialog.Files[i], XMLDocument);
 929         BottleLogList.Add(BottleLog);
 930       end;
 931     except
 932       on E: EXMLFileOpenException do begin
 933         Beep;
 934         ShowMessage(E.Message);
 935         BottleLog.Free;
 936       end;
 937     end;
 938     UpdateTab;
 939     UpdateWindow;
 940   end;
 941 end;
 942
 943 function TfrmLog.GetDefaultFileName(const Name, Ext: String): String;
 944 begin
 945   Result := StringReplace(Name, '/', '', [rfReplaceAll]);
 946   Result := StringReplace(Result, ' ', '', [rfReplaceAll]);
 947   Result := ChangeFileExt(Result, Ext);
 948 end;
 949
 950 end.