[Back to OOP SWAG index] [Back to Main SWAG index] [Original]
{ see test program at the end of this unit !! }
{************************************************}
{ }
{ UNIT INFOBAR A procent bar }
{ Copyright (c) 1997 by Tom Wellige }
{ Donated as FREEWARE }
{ }
{ Ortsmuehle 4, 44227 Dortmund, Germany }
{ E-Mail: wellige@itk.de }
{ }
{************************************************}
unit infobar;
{$X+,V-,O+,F+}
interface
uses Drivers, Objects, Views;
type
PInfoBarRec = ^ TInfoBarRec;
TInfoBarRec = record
Text1, { not blinking text }
Text2: string; { blinking text }
Size: LongInt;
end;
PInfoBar = ^TInfoBar;
TInfoBar = object(TView)
Text1, Text2: string; { Text1 blinks not, Text2 blinks }
max, actuell: LongInt;
ShowBar: boolean;
constructor Init(Bounds: TRect; ARec: PInfoBarRec);
procedure HandleEvent(var Event: TEvent); virtual;
function GetPalette: PPalette; virtual;
procedure Draw; virtual;
procedure Update(ARec: PInfoBarRec);
procedure Reset(ARec: PInfoBarRec);
end;
const
cmInfoBarRec = 4100;
cmResetInfoBar = 4101;
CInfoBar = #19#20;
implementation
(********************************************************************)
(** TInfoBar **)
(********************************************************************)
constructor TInfoBar.Init(Bounds: TRect; ARec: PInfoBarRec);
begin
inherited Init(Bounds);
Text1:= ARec^.Text1; { not blinking text }
Text2:= ARec^.Text2; { blinking text }
if ARec^.Size <> 0 then
begin
ShowBar:= true;
Max := ARec^.Size;
end else
begin
ShowBar:= false;
Max:= 0;
end;
Actuell:= 0;
end;
procedure TInfoBar.HandleEvent(var Event: TEvent);
begin
inherited HandleEvent(Event);
if Event.What = evBroadcast then
case Event.Command of
cmInfoBarRec: Update(PInfoBarRec(Event.InfoPtr));
cmResetInfoBar: Reset(PInfoBarRec(Event.InfoPtr));
end;
end;
function TInfoBar.GetPalette: PPalette;
const
P : string[Length(CInfoBar)] = CInfoBar;
begin
GetPalette := PPalette(@P);
end;
procedure TInfoBar.Draw;
var
Buf: TDrawBuffer;
Color1: Byte;
Color2: Byte;
i, First, Second, Last, Act: integer;
chr, attr: word;
s: string;
begin
Color1:= GetColor(1);
Color2:= GetColor(2);
First := (Size.X div 2) - (length(Text1+Text2) div 2); (* start Text1 *)
Second:= First + length(Text1); (* start Text2 *)
Last := Second + length(Text2); (* end Text2 *)
if Actuell < Max then Act:= (Size.X * Actuell) div Max (* current pos. *)
else Act:= Size.X;
if not ShowBar then
begin
MoveChar(Buf, ' ', Color1, Size.X);
WriteLine(0, 0, Size.X, 1, Buf);
if length(Text1+Text2)<= Size.X then
begin
MoveStr(Buf, Text1, Color1);
WriteLine(First, 0, length(Text1), 1, Buf);
MoveStr(Buf, Text2, Color1+128);
WriteLine(Second, 0, length(Text2), 1, Buf);
end;
end else
begin
(* bar not visible *)
if act = 0 then
begin
MoveChar(Buf, ' ', Color1, Size.X);
WriteLine(0, 0, Size.X, 1, Buf);
if length(Text1+Text2)<= Size.X then
begin
MoveStr(Buf, Text1, Color1);
WriteLine(First, 0, length(Text1), 1, Buf);
MoveStr(Buf, Text2, Color1+128);
WriteLine(Second, 0, length(Text2), 1, Buf);
end;
end;
(* bar before Text1 *)
if Act < First then
begin
MoveChar(Buf, ' ', Color2, Act);
WriteLine(0, 0, Act, 1, Buf);
end else
(* bar inside Text1 *)
if Act < Second then
begin
MoveChar(Buf, ' ', Color2, First);
WriteLine(0, 0, First, 1, Buf);
if Act - First > 0 then
begin
s:= copy(Text1, 1, Act-First);
MoveStr(Buf, s, Color2);
WriteLine(First, 0, length(s), 1, Buf);
end;
end else
(* bar inside Text2 *)
if Act < Last then
begin
MoveChar(Buf, ' ', Color2, First);
WriteLine(0, 0, First, 1, Buf);
MoveStr(Buf, Text1, Color2);
WriteLine(First, 0, length(Text1), 1, Buf);
MoveStr(Buf, copy(Text2, 1, Act-Second), Color2+128);
WriteLine(Second, 0, length(copy(Text2, 1, Act-Second)), 1, Buf);
end else
(* bar behind Text2 *)
begin
MoveChar(Buf, ' ', Color2, First);
WriteLine(0, 0, First, 1, Buf);
MoveStr(Buf, Text1, Color2);
WriteLine(First, 0, length(Text1), 1, Buf);
MoveStr(Buf, Text2, Color2+128);
WriteLine(Second, 0, length(Text2), 1, Buf);
MoveChar(Buf, ' ', Color2, Act-Last);
WriteLine(Last, 0, Act-Last, 1, Buf);
end;
end;
end;
procedure TInfoBar.Update(ARec: PInfoBarRec);
begin
if ARec^.Text1 <> '' then
Text1:= ARec^.Text1;
if ARec^.Text2 <> '' then
Text2:= ARec^.Text2;
if ARec^.Size <> 0 then
if Max <> 0 then
if ARec^.Size > Actuell then Actuell:= ARec^.Size;
DrawView;
end;
procedure TInfoBar.Reset(ARec: PInfoBarRec);
begin
if ARec^.Text1 <> '' then
Text1:= ARec^.Text1;
if ARec^.Text2 <> '' then
Text2:= ARec^.Text2;
Max := ARec^.Size;
Actuell:= 0;
if Max <> 0 then
ShowBar:= true else
ShowBar:= false;
DrawView;
end;
end.
{************************************************}
{ }
{ PROGRAM INFOTEST Testapp for Unit INFOBAR }
{ Copyright (c) 1997 by Tom Wellige }
{ Donated as FREEWARE }
{ }
{ Ortsmuehle 4, 44227 Dortmund, Germany }
{ E-Mail: wellige@itk.de }
{ }
{************************************************}
program infotest;
uses dos, drivers, objects, app, views, dialogs, menus, infobar;
type
TMyApp = object(TApplication)
pInfo : PInfoBar; { the "procent" bar }
activ : boolean; { is bar curretnly active ? }
lastsec : word; { last time }
cursec : longint; { num of seconds since start }
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitStatusLine; virtual;
{ will be called when there is nothing else to do }
procedure Idle; virtual;
{ starts the bar }
procedure StartIdle;
{ opens the bar dialog }
procedure Print;
end;
PPrint = ^TPrint;
TPrint = object(TDialog)
constructor Init(var pInfo: PInfoBar);
procedure HandleEvent(var Event: TEvent); virtual;
end;
const
cmStart = 100; { will be used by the dialog }
cmPrint = 1000; { will be used by the application }
cmStartIdle = 1001; { dialog sends this message to application }
maxsec: longint = 20; { number of seconds until bar reaches the end }
(********************************************************************)
(** TMyApp **)
(********************************************************************)
procedure TMyApp.HandleEvent(var Event: TEvent);
begin
inherited HandleEvent(Event);
{ user wants to open the bar dialog }
if Event.What = evCommand then
if Event.Command = cmPrint then Print;
{ user has pressed the "start" button inside the dialog }
if Event.What = evBroadCast then
if Event.Command = cmStartIdle then StartIdle;
ClearEvent(Event);
end;
procedure TMyApp.InitStatusLine;
var R: TRect;
begin
GetExtent(R);
R.A.Y:= R.B.Y - 1;
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
NewStatusKey('~F3~ Print', kbF3, cmPrint,
NewStatusKey('', kbAltF3, cmClose,
nil))),
nil)));
end;
procedure TMyApp.Idle;
var
hh, mm, ss, hs: word;
Rec: TInfoBarRec;
begin
inherited Idle;
{ as long the dialog is not opend and so the infobar object is
not in memory nothing happens }
if assigned (pInfo) then
begin
{ was the start button pressed ? }
if activ then
begin
GetTime(hh,mm,ss,hs);
{ is one secnd left since last bar update ? }
if ss <> lastsec then
begin
lastsec:= ss;
inc(cursec);
{ are we still in time ? }
if cursec <= maxsec then
begin
{ set new bar value. as long as Text1 and Text2 are '' they
won't be changed }
with Rec do
begin
Text1:= '';
Text2:= '';
Size := cursec;
end;
Message(pInfo, evBroadCast, cmInfoBarRec, @Rec);
end else
begin
{ "maxsec" are over, everything back to start position }
write(#7);
activ:= false;
EnableCommands([cmStart]);
with Rec do
begin
Text1:= 'press the ';
Text2:= 'start button';
Size := maxsec;
end;
Message(pInfo, evBroadCast, cmResetInfoBar, @Rec);
end;
end;
end;
end;
end;
procedure TMyApp.StartIdle;
var Rec: TInfoBarRec;
begin
{ now the Idle will know that it's time to update the infobar }
activ:= true;
{ reset number of seconds }
cursec:= 0;
with Rec do
begin
Text1:= 'just doing something...';
Text2:= ' '; { IMPORTANT: must be at least one character to force
the update of this value }
Size := 0;
end;
{ send all values to inforbar }
Message(pInfo, evBroadCast, cmInfoBarRec, @Rec);
end;
procedure TMyApp.Print;
var
p: PPrint;
begin
p:= new(PPrint, Init(pInfo));
ExecuteDialog(p, nil);
pInfo:= nil;
end;
(********************************************************************)
(** TPrint **)
(********************************************************************)
constructor TPrint.Init(var pInfo: PInfoBar);
var
R: TRect;
Rec: TInfoBarRec;
Control: PView;
begin
R.Assign(14, 5, 65, 18);
inherited Init(R, '');
Options:= Options or ofCenterX or ofCenterY;
{ start values for Text1, Text2 and Size }
with Rec do
begin
Text1:= 'press the ';
Text2:= 'start button';
Size := maxsec;
end;
R.Assign(5, 5, 46, 6);
pInfo:= New(PInfoBar, Init(R, @rec));
Insert(pInfo);
R.Assign(19, 9, 30, 11);
Control:= New(PButton, Init(R, '~S~tart', cmStart, bfDefault));
Insert(Control);
SelectNext(False);
end;
procedure TPrint.HandleEvent(var Event: TEvent);
begin
if Event.What = evCommand then
if Event.Command = cmStart then
begin
{ disable button }
DisableCommands([cmStart]);
{ ok, application's Idle methode will do the rest }
Message(Application, evBroadCast, cmStartIdle, nil);
ClearEvent(Event);
end;
inherited HandleEvent(Event);
end;
(********************************************************************)
(** Main **)
(********************************************************************)
var MyApp: TMyApp;
begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.
[Back to OOP SWAG index] [Back to Main SWAG index] [Original]