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