diff options
Diffstat (limited to 'plugins/Utils.pas/TextBlock.pas')
| -rw-r--r-- | plugins/Utils.pas/TextBlock.pas | 335 |
1 files changed, 335 insertions, 0 deletions
diff --git a/plugins/Utils.pas/TextBlock.pas b/plugins/Utils.pas/TextBlock.pas new file mode 100644 index 0000000000..13535b832a --- /dev/null +++ b/plugins/Utils.pas/TextBlock.pas @@ -0,0 +1,335 @@ +unit TextBlock;
+
+interface
+
+uses KOL, windows;
+
+const
+ ppLeft = 0;
+ ppRight = 1;
+ //effects
+ effCut = 0;
+ effWrap = 1;
+ effRoll = 2;
+ effPong = 3;
+ effCenter = $100;
+
+type
+ pChunk = ^tChunk;
+ tChunk = record
+ _type:integer; // type
+ val :integer; // sign value or text length
+ txt :pWideChar; // text value pointer
+ add :integer; // offset for text effect
+ dir :integer; // ping-pong directon
+ end;
+ pChunkArray = ^tChunkArray;
+ tChunkArray = array [0..1000] of tChunk;
+
+type
+ pTextData = ^tTextData;
+ tTextData = record
+ // runtime data
+ UpdTimer :cardinal;
+ TextFont :HFONT;
+ NeedResize :Boolean;
+
+ // working data
+ TextChunk :pChunkArray;
+ Text :pWideChar; // for text chunks
+
+ TextColor :TCOLORREF;
+ BkColor :TCOLORREF;
+ TextLF :TLOGFONTW;
+
+ // options
+ TextEffect :dword;
+ RollStep :integer;
+ RollGap :integer;
+// RollTail :integer;
+ UpdInterval :cardinal;
+ end;
+
+const
+ MaxTxtScrollSpeed = 20;
+ awkTextPad = 4; // text block pad from frame border
+
+const
+ idx_effect = 0;
+ idx_rollstep = 1;
+ idx_rollgap = 2;
+ idx_timer = 3;
+ idx_txtcolor = 4;
+ idx_bkcolor = 5;
+ idx_font = 6;
+type
+ pTextBlock = ^tTextBlock;
+ tTextBlock = object(TControl)
+ private
+ procedure myCtrlResize(Sender: PObj);
+ procedure myTextPaint(Sender: PControl; DC: HDC);
+ procedure myMouseDown(Sender:PControl;var Mouse:TMouseEventData);
+
+ procedure ClearText;
+ function Split(src:pWideChar):pChunkArray;
+
+ procedure DrawChunks(dc:HDC;Chunk:pChunk;rc:TRECT;justpaint:boolean);
+ procedure DrawLines (dc:HDC;Chunk:pChunk;rc:TRECT;justpaint:boolean);
+
+ function GetEffect(idx:integer):integer;
+ procedure SetEffect(idx:integer;value:integer);
+
+ function GetText:pWideChar;
+ procedure SetText(value:pWideChar);
+
+ function GetFontData:TLOGFONTW;
+ procedure SetFontData(const value:TLOGFONTW);
+
+ public
+ procedure DrawText(DC: HDC; justpaint:boolean);
+
+ property Effects :integer index idx_effect read GetEffect write SetEffect;
+ property RollStep :integer index idx_rollstep read GetEffect write SetEffect;
+ property RollGap :integer index idx_rollgap read GetEffect write SetEffect;
+ property UpdateTime:integer index idx_timer read GetEffect write SetEffect;
+ property TextColor :integer index idx_txtcolor read GetEffect write SetEffect;
+ property BkColor :integer index idx_bkcolor read GetEffect write SetEffect;
+ property Font :integer index idx_font read GetEffect write SetEffect;
+
+ property FontData :TLOGFONTW read GetFontData write SetFontData;
+ property BlockText:pWideChar read GetText write SetText;
+ end;
+
+function MakeNewTextBlock(AOwner:PControl;BkColor:TCOLORREF):pTextBlock;
+
+implementation
+
+uses messages,common;
+
+{$include tb_chunk.inc}
+
+function tTextBlock.GetFontData:TLOGFONTW;
+begin
+ result:=pTextData(CustomData).TextLF;
+end;
+
+procedure tTextBlock.SetFontData(const value:TLOGFONTW);
+begin
+ move(value,pTextData(CustomData).TextLF,SizeOf(TLOGFONTW));
+end;
+
+function tTextBlock.GetEffect(idx:integer):integer;
+begin
+ with pTextData(CustomData)^ do
+ case idx of
+ idx_effect : result:=TextEffect;
+ idx_rollstep: result:=RollStep;
+ idx_rollgap : result:=RollGap;
+ idx_txtcolor: result:=TextColor;
+ idx_bkcolor : result:=BkColor;
+ idx_font : result:=0;
+ idx_timer : result:=UpdInterval;
+ else // it can't be really
+ result:=0;
+ end;
+end;
+
+procedure TimerProc(wnd:HWND;uMsg:uint;TB:pTextBlock;dwTime:dword); stdcall;
+var
+ DC:HDC;
+begin
+ DC:=GetDC(wnd);
+ TB.DrawText(DC,false);
+ ReleaseDC(wnd,DC);
+end;
+
+procedure tTextBlock.SetEffect(idx:integer;value:integer);
+var
+ DC:HDC;
+ OldFont:HFONT;
+begin
+ with pTextData(CustomData)^ do
+ case idx of
+ idx_effect : TextEffect :=value;
+ idx_rollstep: RollStep :=value;
+ idx_rollgap : RollGap :=value;
+ idx_txtcolor: TextColor :=value;
+ idx_bkcolor : BkColor :=value;
+ idx_font : begin
+ DC:=GetDC(0);
+ OldFont:=SelectObject(DC,value);
+ GetObject(GetCurrentObject(dc,OBJ_FONT),SizeOf(TLOGFONT),@TextLF);
+ SelectObject(DC,OldFont);
+ ReleaseDC(0,DC);
+ end;
+ idx_timer : begin
+ // stoptimer
+ if UpdTimer<>0 then
+ begin
+ KillTimer(0,UpdTimer);
+ UpdTimer:=0;
+ end;
+
+ UpdInterval:=value;
+ // starttimer
+ if UpdInterval>0 then
+ UpdTimer:=SetTimer(Self.GetWindowHandle,integer(@Self),(MaxTxtScrollSpeed+1-UpdInterval)*100,@TimerProc);
+ end;
+ end;
+end;
+
+procedure tTextBlock.ClearText;
+var
+ D:pTextData;
+begin
+ D:=CustomData;
+ if D.Text<>nil then
+ begin
+ DeleteChunks(D.TextChunk);
+ FreeMem(D.Text);
+ D.Text:=nil;
+ end;
+end;
+
+function tTextBlock.GetText:pWideChar;
+begin
+ result:=pTextData(CustomData)^.Text;
+end;
+
+procedure tTextBlock.SetText(value:pWideChar);
+var
+ D:pTextData;
+begin
+ D:=CustomData;
+ if (D.Text<>value) or
+ (StrCmpW(D.Text, value)<>0) then
+ begin
+ self.ClearText;
+ if (value<>nil) and (value^<>#0) then
+ begin
+ GetMem(D.Text,(StrLenW(value)+1)*SizeOf(WideChar));
+ WStrCopy(D.Text,value);
+ D.TextChunk:=Split(D.Text);
+
+ // start timer if was stopped
+ if (D.UpdTimer=0) and (D.UpdInterval>0) then
+ D.UpdTimer:=SetTimer(Self.GetWindowHandle,integer(@Self),
+ (MaxTxtScrollSpeed+1-D.UpdInterval)*100,@TimerProc);
+ end
+ else // stop timer for empty text
+ begin
+ if D.UpdTimer<>0 then
+ begin
+ KillTimer(0,D.UpdTimer);
+ D.UpdTimer:=0;
+ end;
+ end;
+ Invalidate;
+ end;
+end;
+
+procedure tTextBlock.DrawText(DC:HDC; justpaint:boolean);
+var
+ dst:TRECT;
+ D:pTextData;
+ MemDC:HDC;
+begin
+ D:=CustomData;
+ with D^ do
+ if TextChunk<>nil then
+ begin
+ CopyRect(dst,Self.BoundsRect);
+
+ MemDC:=CreateCompatibleDC(dc);
+ SetTextColor(MemDC,TextColor);
+ SelectObject(MemDC,CreateCompatibleBitmap(DC,dst.right,dst.bottom));
+ DeleteObject(SelectObject(MemDC,CreateFontIndirectW(D.TextLF)));
+
+ BitBlt(MemDC,dst.left,dst.top,dst.right-dst.left,dst.bottom-dst.top,
+ dc,dst.left,dst.top,SRCCOPY);
+
+ InflateRect(dst,-4,-2); // text padding from text block
+ DrawChunks(MemDC,@TextChunk[0],dst,justpaint); // i.e. only paint or roll
+ InflateRect(dst,4,2); // text padding from text block
+
+ BitBlt(dc,dst.left,dst.top,dst.right-dst.left,dst.bottom-dst.top,
+ MemDC,dst.left,dst.top,SRCCOPY);
+ DeleteDC(MemDC);
+ end;
+end;
+
+procedure tTextBlock.myTextPaint(Sender: PControl; DC: HDC);
+begin
+ DrawText(DC,true);
+end;
+
+procedure tTextBlock.myMouseDown(Sender:PControl;var Mouse:TMouseEventData);
+var
+ wnd:HWND;
+begin
+ wnd:=GetParent(GetParent(Sender.GetWindowHandle));
+ SendMessage(wnd,WM_SYSCOMMAND,
+ SC_MOVE or HTCAPTION,MAKELPARAM(Mouse.x,Mouse.y));
+end;
+
+// avoiding anchors problems
+procedure tTextBlock.myCtrlResize(Sender: PObj);
+var
+ tmp:integer;
+ D:pTextData;
+begin
+ D:=CustomData;
+ if D.NeedResize then
+ begin
+ D.NeedResize:=false;
+
+ tmp:=PControl(Sender).Parent.Width-2*awkTextPad;
+
+ if (PControl(Sender)^.Width)>tmp then
+ PControl(Sender)^.Width:=tmp;
+
+ D.NeedResize:=true;
+ end;
+end;
+
+procedure Destroy(dummy:PControl;sender:PObj);
+var
+ D:pTextData;
+begin
+ D:=PTextBlock(sender).CustomData;
+ if D.UpdTimer<>0 then
+ begin
+ KillTimer(0,D.UpdTimer);
+ D.UpdTimer:=0;
+ end;
+ PTextBlock(sender).ClearText;
+end;
+
+function MakeNewTextBlock(AOwner:PControl;BkColor:TCOLORREF):pTextBlock;
+var
+ D:pTextData;
+begin
+ result:=pTextBlock(NewPanel(AOwner,esNone));
+// result:=NewLabel(AOwner,'');
+// result:=NewLabelEffect(AOwner,'',0);
+ GetMem(D,SizeOf(tTextData));
+ FillChar(D^,SizeOf(tTextData),0);
+ result.CustomData :=D;
+ result.Transparent:=true;
+
+ result.SetSize(AOwner.Width-awkTextPad*2,40);
+ result.SetPosition(AOwner.Left+awkTextPad,awkTextPad);
+ result.Anchor(true,true,true,true);
+
+ result.OnResize :=result.myCtrlResize;
+ result.OnPaint :=result.myTextPaint;
+ result.OnMouseDown:=result.myMouseDown;
+ Result.OnDestroy:=TOnEvent(MakeMethod(nil,@Destroy));
+
+// result..InitFrame;
+ D.BkColor :=BkColor;
+ D.TextChunk :=nil;
+ D.NeedResize:=true;
+end;
+
+end.
|