bottleclient/TalkShowFrame.pas

   1 unit TalkShowFrame;
   2
   3 interface
   4
   5 uses
   6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   7   Dialogs, StdCtrls, SsParser, ExtCtrls, SppList, Logs,
   8   BottleDef;
   9
  10 type
  11   TfrmTalkShow = class(TFrame)
  12     PanelBevel: TPanel;
  13     PaintBox: TPaintBox;
  14     ScrollBar: TScrollBar;
  15     procedure PaintBoxPaint(Sender: TObject);
  16     procedure ScrollBarChange(Sender: TObject);
  17     procedure FrameResize(Sender: TObject);
  18     procedure ScrollBarEnter(Sender: TObject);
  19   private
  20     FSsParser: TSsParser;
  21     FGhost: String;
  22     FScript: String;
  23     FWholeHeight: integer;
  24     FBuffer: TBitmap;
  25     FPrevControl: TWinControl;
  26     procedure SetSsParser(const Value: TSsParser);
  27     procedure SetPrevControl(const Value: TWinControl);
  28   protected
  29     function DrawSingleTalk(VertPos: integer;
  30       Sur0, Sur1: integer; Talk: String): integer;
  31     function DrawSingleImage(X, Y, Surface: integer;
  32       var Height: integer): integer;
  33     function DrawSeparateLine(VertPos: integer): integer;
  34   public
  35     { Public \90é\8c¾ }
  36     // \82³\82\82ç\83X\83N\83\8a\83v\83g\82Ì\89ð\90Í\82É\8eg\82¤\83p\81[\83T
  37     property SsParser: TSsParser read FSsParser write SetSsParser;
  38     // \83X\83N\83\8d\81[\83\8b\83o\81[\82ª\83N\83\8a\83b\83N\82³\82ê\82½\8cã\82Å\83t\83H\81[\83J\83X\82ð\88Ú\93®\82·\82é\83R\83\93\83g\83\8d\81[\83\8b
  39     // \83X\83N\83\8d\81[\83\8b\83o\81[\8e©\91Ì\82ª\83t\83H\81[\83J\83X\82ð\8e\9d\82Á\82Ä\82µ\82Ü\82í\82È\82¢\82½\82ß\82Ì\91[\92u
  40     property PrevControl: TWinControl read FPrevControl write SetPrevControl;
  41     procedure View(ALog: TLogItem); overload;
  42     procedure View(Script, Ghost: String); overload;
  43     constructor Create(AOwner: TComponent); override;
  44     destructor Destroy; override;
  45     procedure SetPreviewFont(Font: TFont);
  46   end;
  47
  48 implementation
  49
  50 {$R *.dfm}
  51
  52 { TfrmTalkShow }
  53
  54 procedure TfrmTalkShow.SetSsParser(const Value: TSsParser);
  55 begin
  56   FSsParser := Value;
  57 end;
  58
  59 procedure TfrmTalkShow.View(ALog: TLogItem);
  60 begin
  61   if (ALog.Ghost = FGhost) and (ALog.Script = FScript) then
  62     Exit;
  63   FGhost := ALog.Ghost;
  64   FScript := ALog.Script;
  65   FWholeHeight := -1; // \96¢\92è\8b`
  66   PaintBoxPaint(self);
  67 end;
  68
  69 procedure TfrmTalkShow.PaintBoxPaint(Sender: TObject);
  70 var i, y, sur, sur0, sur1: integer;
  71     UnyuTalking, InSync: boolean;
  72     Talk: String;
  73   procedure TalkEnd;
  74   begin
  75     if FWholeHeight > 0 then // 2\93x\96Ú\88È\8d~\82Ì\95`\89æ\82Å\82Í
  76       if (i < FSsParser.Count) and
  77          (StrToInt(FSsParser.Extra[i]) < ScrollBar.Position) then
  78       begin
  79         y := StrToInt(FSsParser.Extra[i]) - ScrollBar.Position;
  80         Talk := '';
  81         Exit;
  82       end;
  83     if Talk <> '' then
  84     begin
  85       if InSync then
  86       begin
  87         FBuffer.Canvas.Font.Color := Pref.TalkColorS;
  88         y := y + DrawSingleTalk(y, sur0, sur1, Talk) + 5
  89       end else if UnyuTalking then
  90       begin
  91         FBuffer.Canvas.Font.Color := Pref.TalkColorU;
  92         y := y + DrawSingleTalk(y, -1, sur1, Talk) + 5
  93       end else begin
  94         FBuffer.Canvas.Font.Color := Pref.TalkColorH;
  95         y := y + DrawSingleTalk(y, sur0, -1, Talk) + 5;
  96       end;
  97       Talk := '';
  98     end;
  99   end;
 100 begin
 101   // \8fÁ\8b\8e
 102   FBuffer.Width  := PaintBox.Width;
 103   FBuffer.Height := PaintBox.Height;
 104
 105   with FBuffer.Canvas do
 106   begin
 107     Brush.Color := Pref.BgColor;
 108     Brush.Style := bsSolid;
 109     FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
 110     Brush.Style := bsClear;
 111   end;
 112   if FSsParser.InputString <> FScript then
 113   begin
 114     with FSsParser do
 115     begin
 116       LeaveEscape := false;
 117       EscapeInvalidMeta := false;
 118       InputString := FScript;
 119     end;
 120   end;
 121
 122   if FWholeHeight < 0 then // -1\82Í\96¢\92è\8b`
 123     y := 2
 124   else
 125     y := - ScrollBar.Position + 2;
 126   sur0 := 0;  // \83X\83R\81[\83v0\91¤\8f\89\8aú\83T\81[\83t\83B\83X
 127   sur1 := 10; // \83X\83R\81[\83v1\91¤\8f\89\8aú\83T\81[\83t\83B\83X
 128   Talk := '';
 129   UnyuTalking := false;
 130   InSync := false;
 131   //
 132   i := 0;
 133   while i < FSsParser.Count do
 134   begin
 135     case FSsParser.MarkUpType[i] of
 136       mtTag:
 137         begin
 138           if (FSsParser[i] = '\h') and UnyuTalking then
 139           begin
 140             if not InSync then
 141               TalkEnd;
 142             UnyuTalking := false;
 143           end else if (FSsParser[i] = '\u') and not UnyuTalking then
 144           begin
 145             if not InSync then
 146               TalkEnd;
 147             UnyuTalking := true;
 148           end else if FSsParser[i] = '\_s' then
 149           begin
 150             TalkEnd;
 151             InSync := not InSync;
 152           end else if (FSsParser.Match(FSsParser[i], '\s[%D]') > 0) or (FSsParser[i] = '\s[-1]') then
 153           begin
 154             TalkEnd;
 155             sur := StrToInt(FSsParser.GetParam(FSsParser[i], 1));
 156             if InSync then
 157             begin
 158               sur0 := sur;
 159               sur1 := sur;
 160             end else if UnyuTalking then
 161               sur1 := sur
 162             else
 163               sur0 := sur;
 164           end else if FSsParser.Match(FSsParser[i], '\s%d') > 0 then
 165           begin
 166             TalkEnd;
 167             sur := Ord(FSsParser[i][3]) - Ord('0');
 168             if InSync then
 169             begin
 170               sur0 := sur;
 171               sur1 := sur;
 172             end else if UnyuTalking then
 173               sur1 := sur
 174             else
 175               sur0 := sur;
 176           end else if FSsParser.Match(FSsParser[i], '\n') >= 2 then
 177           begin
 178             if Talk <> '' then
 179               Talk := Talk + #13#10;
 180           end else if FSsParser[i] = '\c' then
 181           begin
 182             TalkEnd;
 183             y := y + DrawSeparateLine(y);
 184           end;
 185         end;
 186       mtStr, mtMeta:
 187         Talk := Talk + FSsParser[i];
 188     end;
 189     if FWholeHeight < 0 then // \8f\89\89ñ\82Ì\95`\89æ\82Å\82Í
 190     begin
 191       // \8e©\95ª\82ª\95`\89æ\82³\82ê\82½\8cã\82Ì\88Ê\92u\82ð\8bL\89¯\82µ\82Ä\82¨\82\81B
 192       // \8e\9f\89ñ\88È\8d~\82Ì\95`\89æ\82ª\8d\82\91¬\89»\82³\82ê\82é
 193       FSsParser.Extra[i] := IntToStr(y);
 194     end;
 195     // \95`\89æ\97Ì\88æ\82ª\83E\83B\83\93\83h\83E\82Ì\89º\92[\82ð\89ß\82¬\82½\82ç
 196     // \8fI\97¹\81A\82½\82¾\82µ\8f\89\89ñ\95`\89æ\82¾\82¯\82Í\91S\91Ì\82ð\91\96\8d¸
 197     if (y > ScrollBar.Position + PaintBox.Height) and
 198       (FWholeHeight > 0) then
 199     begin
 200       Break;
 201     end;
 202     Inc(i);
 203   end;
 204   TalkEnd;
 205   PaintBox.Canvas.Draw(0, 0, FBuffer);
 206
 207   if FWholeHeight = -1 then
 208   begin
 209     if FScript <> '' then
 210       FWholeHeight := y;
 211     ScrollBar.Position := 0;
 212     if FWholeHeight > PaintBox.Height then
 213     begin
 214       with ScrollBar do
 215       begin
 216         Max := FWholeHeight - PaintBox.Height;
 217         Min := 0;
 218         Enabled := true;
 219         LargeChange := PaintBox.Height;
 220         SmallChange := PaintBox.Canvas.Font.Size;
 221         // PageSize := Max * PaintBox.Height div FWholeHeight;
 222       end;
 223     end else
 224     begin
 225       ScrollBar.Enabled := false;
 226     end;
 227   end;
 228 end;
 229
 230 function TfrmTalkShow.DrawSingleTalk(VertPos, Sur0, Sur1: integer;
 231   Talk: String): integer;
 232 var Bmp: TBitmap;
 233     H, BH, X: integer;
 234     ARect: TRect;
 235 begin
 236   Bmp := TBitmap.Create;
 237   try
 238     X := 2;
 239     BH := 0;
 240     if Sur0 >= 0 then
 241       X := X + DrawSingleImage(X, VertPos, Sur0, BH) + 2;
 242     if Sur1 >= 0 then
 243       X := X + DrawSingleImage(X, VertPos, Sur1, BH) + 2;
 244
 245     ARect := Rect(X + 10, VertPos, PaintBox.Width-5, VertPos+10000);
 246     H := DrawTextEx(FBuffer.Canvas.Handle, PChar(Talk), -1, ARect,
 247       DT_WORDBREAK or DT_NOPREFIX, nil);
 248
 249     if H > BH then
 250       Result := H
 251     else
 252       Result := BH;
 253   finally
 254     Bmp.Free;
 255   end;
 256 end;
 257
 258 procedure TfrmTalkShow.ScrollBarChange(Sender: TObject);
 259 begin
 260   PaintBoxPaint(self);
 261 end;
 262
 263 function TfrmTalkShow.DrawSingleImage(X, Y, Surface: integer;
 264   var Height: integer): integer;
 265 var Bmp: TBitmap;
 266 begin
 267   Result := 0;
 268   if FGhost = '' then
 269     Exit; // \83S\81[\83X\83g\82ª\8ew\92è\82³\82ê\82Ä\82¢\82È\82¢\82È\82ç\95\\8e¦\82Å\82«\82È\82¢
 270   Bmp := TBitmap.Create;
 271   try
 272     if Spps.TryGetImage(FGhost, Surface, Bmp) then
 273     begin
 274       Result := Bmp.Width;
 275       FBuffer.Canvas.Draw(X, Y, Bmp);
 276       if Bmp.Height > Height then
 277         Height := Bmp.Height;
 278     end;
 279   finally
 280     Bmp.Free;
 281   end;
 282 end;
 283
 284 procedure TfrmTalkShow.FrameResize(Sender: TObject);
 285 begin
 286   FWholeHeight := -1; // \8d\82\82³\82ª\82í\82©\82ç\82È\82\82È\82é
 287 end;
 288
 289 procedure TfrmTalkShow.View(Script, Ghost: String);
 290 begin
 291   if (Ghost = FGhost) and (Script = FScript) then
 292     Exit;
 293   FGhost := Ghost;
 294   FScript := Script;
 295   with FSsParser do
 296   begin
 297     LeaveEscape := false;
 298     EscapeInvalidMeta := false;
 299     InputString := FScript;
 300   end;
 301   FWholeHeight := -1; // \96¢\92è\8b`
 302   PaintBoxPaint(self);
 303 end;
 304
 305 function TfrmTalkShow.DrawSeparateLine(VertPos: integer): integer;
 306 begin
 307   with FBuffer.Canvas do
 308   begin
 309     Pen.Color := Pref.TextColor;
 310     Pen.Mode := pmCopy;
 311     MoveTo(5, VertPos);
 312     LineTo(PaintBox.Width-5, VertPos);
 313     Result := 4;
 314   end;
 315 end;
 316
 317 constructor TfrmTalkShow.Create(AOwner: TComponent);
 318 begin
 319   inherited Create(AOwner);
 320   FBuffer := TBitmap.Create;
 321   FWholeHeight := -1;
 322 end;
 323
 324 destructor TfrmTalkShow.Destroy;
 325 begin
 326   FBuffer.Free;
 327   inherited;
 328 end;
 329
 330 procedure TfrmTalkShow.SetPreviewFont(Font: TFont);
 331 begin
 332   FBuffer.Canvas.Font.Assign(Font);
 333 end;
 334
 335 procedure TfrmTalkShow.SetPrevControl(const Value: TWinControl);
 336 begin
 337   FPrevControl := Value;
 338 end;
 339
 340 procedure TfrmTalkShow.ScrollBarEnter(Sender: TObject);
 341 begin
 342   if PrevControl <> nil then
 343     PrevControl.SetFocus;
 344 end;
 345
 346 end.