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