PDA

Просмотр полной версии : Бегущая строка в титуле


Br1nk
17.01.2008, 01:53
Предлагаю вам мой вариант скрипта для бегущей строки в титуле. Сделал поскольку не понравилось то, что видел у других.
100% no lags :]
Обратите внимание на процедуру Init, и подправьте под себя значения переменных.

// Бегущая строка в титуле, ©Br1nk v0.2
// пишем rt в пати чате для включения и выключения

var
title, temp, titleoff: string;
activated, mult, safemode: integer;
tmr: TTimer;

procedure Init; //Вызывается при включении скрипта
begin
title := 'Running string by Br1nk'; // текст титула
titleoff := 'Powered by Br1nk';
activated := 0; // Определяет, включается ли бегущая строка сразу при запуске скрипта или только после введения команды rt в патичат
safemode := 1; // безопасный режим, стандартная длина титула. Если вы играете на кривой яве, поставьте 0, это даст вам более длинный титул, соответственно выглядит пижже..)
tmr := TTimer.Create(nil);
tmr.Interval := 800; // Частота обновления (мс)
tmr.Enabled := False;
tmr.OnTimer := @Tick;
mult := 3; // Определяет на сколько букв сдвигается строка в титуле при обновлении
end;

procedure Free;
begin
tmr.Free;
SetTitle(titleoff);
end;

procedure Tick;
begin
temp := copy(title, 2 + mult, Length(title) - 1 - mult) + copy(title, 1, 1 + mult);
title := temp;
if safemode then
SetTitle(Copy(temp, 0, 16))
else
SetTitle(temp);
end;

procedure Announce(text:string); // for debug purposes
begin
buf := #$4A;
WriteD(0);
WriteD(10);
WriteS('');
WriteS(text);
SendToClient;
end;

procedure SetTitle(text: string);
begin
buf := HStr('55');
WriteS(ConnectName);
WriteS(text);
WriteD(0);
SendToServer;
end;

begin
if FromClient and (pck=HStr('38 72 00 74 00 00 00 03 00 00 00')) then
begin
if (activated = 1) then
begin
activated := 0;
SetTitle(titleoff);
Announce('Title script powered off.');
end
else
activated := 1;
pck := '';
end;
if (activated = 1) then
tmr.Enabled := True
else
tmr.Enabled := False;
end.