e-mail    Debatní kniha    Mapa stránek    Hlavní  
 perličky 
 

Screen--saver pro Turbo Vision

Jaromír Junek

Při některých aplikacích v prostředí Turbo Vision se vyskytla potřeba šetřit obrazovku v okamžiku, kdy obsluha počítače přemýšlí, odskočila si uvařit kafe, nebo si zdřímla. Uvedená jednotka řeší tento problém. Při jejím vytváření jsem se snažil, aby její použití v aplikacích bylo co nejjednodušší.

Jednotka poskytuje následující služby:
  • inicializaci s možností definovat reklamní nápis
  • po nastaveném čase od poslední manipulace s klávesnicí nebo myší zhasne obrazovku, na které pouze proletuje reklamní nápis s chvostem a tu a tam problikne puntík
  • dialogové okno pro nastavení/změnu časové konstanty
  • proceduru pro okamžitý přechod do zhasnutého módu (např. pro zhasnutí obrazovky příkazem z klávesnice)
  • proceduru pro nové "natažení" časového čítače -- tuto službu lze využít např. po zavolání externího programu pomocí funkce EXEC, protože v době běhu externího programu není testováno, zda byla stisknuta nějaká klapka, resp. použita myš a po návratu z programu by obrazovka (v případě dosažení čas. limitu) okamžitě zhasla


Zde je ještě třeba poznamenat, že jedinou částí, která je poněkud ošizena, pokud se týká programátorské invence, je metoda DRAW, která je aktivována v době, kdy program (a možná i obsluha) spí. Tato metoda v mém podání nejprve pouze zhasínala obrazovku a postupně se k ní "přilepovaly" další pohyby, takže nakonec se v uvedené jednotce náhodně generuje nápis specifikovaný při inicializaci a posléze se vlní ke spodnímu okraji obrazovky. Tato metoda by šla napsat efektivněji, ale myslím, že si ji stejně většina uživatelů upraví (přepíše) k obrazu svému.

Nejdříve jak se s jednotkou pracuje:

  • Na konci inicializační části hlavní aplikace se uvede příkaz InstallDime (Retez);, kde Retez je reklamní nápis typu string
  • Na konci metody Idle hlavní aplikace se uvede Dime^.Idle;


Implicitní doba zhasínání obrazovky je 5 min. Tato doba může být modifikována pomocí metody SetDimeTime (Vteřiny:word), nebo pomocí dialogového okna aktivovaného metodou ChangeDimeTime. Při nastavení doby aktivace na nulu se činnost jednotky vypne.

Pro okamžité zhasnutí obrazovky slouží metoda Blank, pro natažení časovače (což se rovná např. stisku klávesy) metoda Trigger. V jednotce je navíc předdefinována proměnná Dime, která je použita jako instance objektu Screen-saveru.

Funkce RestrictedInputBox použitá v jednotce je modifikací funkce InputBox ze standardní jednotky MsgBox, umožňující nadefinovat znaky, které vstupní řádek přijímá. Z důvodu úspory místa ji zde neuvádím; lze ji nahradit uvedenou funkcí InputBox.

unit Un_Dime;

    {****************************}
    {                            }
    { Un_DIME                    }
    {                            }
    { Jaromír JUNEK, Lakšmí-soft }
    {****************************}

{$X+,D-,R-}

interface
uses Objects, Drivers, Views, App, UnMsgBox;

const DimeTime:word = 60*5; {seconds}
      MaxTime = 3200;
      LogoTick: byte = 2;
      Version = '1.1: 15.6.92';
{------------------------------------------------------}
type

pDime = ^tDime;
tDime = object (tView)
  LogoTime: word;
  OldTime: word;
  X1,Y1,OldX,OldY,OldOldX,OldOldY,OldOldOldX,
  OldOldOldY :byte;
  Logo: string;

  constructor Init (Bounds:tRect; LogoStr:string);
  procedure Draw; virtual;
  procedure HandleEvent (var Event:tEvent); virtual;
  procedure Idle; virtual;

  procedure Blank; {imediately enters the blank mode}
  procedure SetDimeTime (Time:word); {Time in seconds}
  function GetDimeTime: word; {Time in seconds}
  procedure ChangeDimeTime; {opens a window}
  procedure Trigger; {Re-triggers the time}
end;
{------------------------------------------------------}
procedure InstallDime (Logo:string);

var Dime: pDime;

{######################################################}

implementation

var
  Ticks: word absolute $40:$6C;

constructor tDime.Init (Bounds:tRect; LogoStr:string);
  var R:tRect;
begin
  R.Assign (0,0,80,25);
  Application^.GetExtent (R);
  tView.Init (R);
  EventMask := $FFFF;
  Options := Options or ofPreProcess;
  LogoTime := 0;
  OldTime := Ticks;
  Logo := LogoStr;
  OldX := 10; OldY := 3; OldOldX := 10; OldOldY := 2;
  OldOldOldX := 10; OldOldOldY := 1;
  Hide;
end;
{------------------------------------------------------}
procedure tDime.Draw;
var
  B: TDrawBuffer; C1: Byte; i,Y:byte; Sgn: integer;
  LogoShadow, LogoShadow2: string; R: tRect;
begin
  GetExtent (R);
  X1 := OldX + Random (4) - 2;
  inc (Y1);
  if Y1 > R.B.Y then begin
    Y1 := Random (R.B.X - 20);
    X1 := Random (70);
  end;
  C1 := 15;
  LogoShadow := ' '; LogoShadow2 := ' ';
  for i := 1 to length (Logo)-4 do begin
    LogoShadow := LogoShadow + #7;
    LogoShadow2 := LogoShadow2 + '.';
  end;
  dec (byte(LogoShadow2[0]),2);

  for Y := 0 to Size.Y -1 do begin
    MoveChar (B, ' ', $80, Size.X);
    if odd (Y) then Sgn := +1 else Sgn := -1;
    if (Random (100-abs(Y-13))>80) then
      MoveChar (B [40 + Sgn*Random ( 10+3 * abs(Y-13)) ],
                '*', $08, 1);
    WriteLine (0, Y, Size.X, 1, B);
    if Y = Y1 then begin
      MoveStr(B, Logo, C1);
      WriteLine(X1, Y, Size.X, 1, B);
    end
    else
      if Y = OldY then begin
        MoveStr(B, copy (Logo,2,length (Logo)-2), 7);
        WriteLine(OldX+1, Y, Size.X, 1, B);
      end
    else
      if Y = OldOldY then begin
        MoveStr(B, LogoShadow, 8);
        WriteLine(OldOldX, Y, Size.X, 1, B);
      end
    else
      if Y = OldOldOldY then begin
        MoveStr(B, LogoShadow2, 8);
        WriteLine(OldOldOldX, Y, Size.X, 1, B);
      end
    else
      WriteLine(0, Y, Size.X, 1, B);
  end;
  OldOldOldX := OldOldX; OldOldOldY := OldOldY;
  OldOldX := OldX; OldOldY := OldY;
  OldX := X1; OldY := Y1;
end;
{------------------------------------------------------}
procedure tDime.HandleEvent (var Event:tEvent);
begin
  if ((State and sfVisible) <> 0)
  and (Event.What and (evKeyBoard or evMouse) <>0)
  then begin
    Hide;
    ShowMouse;
    Trigger;
    ClearEvent (Event);
  end;
  if (Event.What and (evKeyBoard or evMouse) <>0)
  then Trigger;
  tView.HandleEvent (Event);
end;
{------------------------------------------------------}
procedure tDime.Idle;
  var Event:tEvent;
begin
  GetMouseEvent (Event);
  if Event.What <> 0 then begin
    Trigger;
    PutEvent (Event);
  end;
  if (DimeTime <> 0)
  and (abs (Ticks - OldTime) > DimeTime * 20)
  and not ((State and sfVisible) <>0) then
    Blank;
  if ((Dime^.State and sfVisible) <>0)
  and (abs (Ticks - LogoTime) > LogoTick) then
  begin
    DrawView;
    LogoTime := Ticks;
  end;
end;
{------------------------------------------------------}
procedure tDime.Blank;
  var R:tRect;
begin
  Application^.GetExtent (R);
  ChangeBounds (R);
  MakeFirst;
  Show;
  HideMouse;
end;
{------------------------------------------------------}
procedure tDime.ChangeDimeTime;
  var TimeStr:string; Time,ErPos: integer; R:tRect;
begin
  Str (DimeTime div 60,TimeStr);
  R.Assign (25,4,50,12);
  if RestrictedInputBox (3,3,'Set dime time','Minutes',
                     TimeStr,'0123456789',mbHistoryOff)
                                 <> cmCancel then begin
    Val (TimeStr, Time, ErPos);
    if ErPos = 0 then SetDimeTime (Time*60);
  end;
end;
{------------------------------------------------------}
function tDime.GetDimeTime: word;
begin
  GetDimeTime := DimeTime;
end;

{------------------------------------------------------}
procedure tDime.SetDimeTime (Time:word);
begin
  if Time < MaxTime then DimeTime := Time;
  Trigger;
end;
{------------------------------------------------------}
procedure tDime.Trigger;
begin
  OldTime := Ticks;
end;

{######################################################}
procedure InstallDime (Logo:string);
  var R: tRect;
begin
  while length (Logo) < 4 do Logo := Logo + ' ';
  Dime := New (pDime,Init (R,Logo));
  Application^.InsertBefore (Dime,Application^.Last^.Next);
end;
{######################################################}

var R: tRect;
begin
  Dime := nil;
end.
{######################################################}
A na závěr příklad jednoduché aplikace, která uvedenou jednotku využívá. Po spuštění jsou aktivní tři klapky:
  • "ESC" -- umožňuje změnit dobu, po které obrazovka zhasne
  • "MEZERA" -- zhasne obrazovku okamžitě
  • "Alt--X" -- ukončení programu
program Dime_Test;
  uses App,Drivers,Un_Dime;

type
tMJApp = object (tApplication)
  constructor Init;
  procedure Idle; virtual;
  procedure HandleEvent (var Event: tEvent); virtual;
end;

var MjApp: tMJApp;

constructor tMJApp.Init;
begin
  tApplication.Init;
  InstallDime ('BAJT & BYTE');
end;

procedure tMJApp.Idle;
begin
  tApplication.Idle;
  Dime^.Idle;
end;

procedure tMJApp.HandleEvent (var Event: tEvent);
  const ESC = #$1B;
begin
  tApplication.HandleEvent (Event);
  if (Event.What = evKeyDown) then
    case Event.CharCode of
      ' ': Dime^.Blank;
      ESC: Dime^.ChangeDimeTime;
      else Exit;
    end;
  ClearEvent (Event);
end;

begin
  MjApp.Init;
  MjApp.Run;
  MjApp.Done;
end.



Pascal - hlavní
Překladače
Vlastní články
Převzaté články
Věci na stáhnutí
Odkazy k tématu
BP7 buglist
Chyba Run-time 200

BASIC