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