[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]
(**************************************************************************
* *
* STATUS.PAS - A Statusline unit, by Thomas S. Carlisle *
* Free for public use, all I ask is that my name remain *
* with this code. *
* *
* This unit provides easy implementation of a status line. The *
* statusline will be at the bottom of the screen, and will take on the *
* colors defined in the system as button face, and button shadow. *
* *
* The statusline can have multiple partitions to display different *
* information. For example, you could have a partition that displays *
* a clock (see STATUSEX.PAS), another one that displays the current *
* file open in a word processing application, or virtually anything you *
* can think up. *
* *
* The main object is TStatusLine. TStatusline is an abstract object with *
* limited default functionality. TStatusline is a statusline with no *
* partitions. It knows how to draw itself, and most importantly it knows *
* how to insert partitions. However, TStatusline does not Insert any *
* partitions. The user must create a descendant object of TStatusLine *
* that overrides the Setup method to insert some partitions. *
* *
* A typical Setup method may look something like this: *
* PROCEDURE TMyStatusline.Setup; *
* BEGIN *
* InsertItem(100,DrawProc); *
* END; *
* *
* That would insert a partition that is 100 pixels wide. The second *
* parameter is important. It is a procedure. Each partition must be *
* passed a procedure so it knows who to call to fill in the partition *
* with the appropriate text. The procedure passed in the InsertItem *
* statement MUST be a procedure that was previously declared like this: *
* *
* PROCEDURE DrawProc(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);FAR; *
* BEGIN *
* { your custom draw code goes here... } *
* END; *
* *
* Note proceduremust be declared as FAR. It also MUST have the exact *
* parameter list as shown. In the body, you can do what you want. A *
* simple example would be to simply write out a line of text: *
* *
* PROCEDURE DrawProc(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);FAR; *
* BEGIN *
* TextOut(PaintHdc,3,1,'Test',4); *
* END; *
* *
* Usually you will not have a simple procedure like that. For a better, *
* more functional example see the procedure Clock in STATUSEX.PAS *
* *
*************************************************************************)
UNIT Status;
INTERFACE
USES
WObjects,WinTypes,WinProcs,WinCrt;
TYPE
TPaintProc = PROCEDURE(PaintHdc : HDC; VAR PaintInfo : TPaintStruct);
PPartitionCollection = ^TPartitionCollection;
TPartitionCollection = OBJECT(TCollection)
END;
PPartition = ^TPartition;
TPartition = OBJECT(TWindow)
PRIVATE
LeftPosition,
RightPosition : WORD;
PaintProc : TPaintProc;
CONSTRUCTOR Init(AParent : PWindowsObject; ATitle : PCHAR;
LPos,RPos : WORD; Proc : TPaintProc);
PROCEDURE Paint(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);
VIRTUAL;
END;
PStatusLine = ^TStatusLine;
TStatusLine = OBJECT(TWindow)
CONSTRUCTOR Init(AParent : PWindowsObject; ATitle : PCHAR);
PROCEDURE Paint(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);
VIRTUAL;
DESTRUCTOR Done;VIRTUAL;
PROCEDURE InsertItem(StrLength : WORD; Proc : TPaintProc);
PROCEDURE Setup;VIRTUAL;
FUNCTION GetPartition(Index : BYTE):PPartition;VIRTUAL;
PRIVATE
Partitions : PPartitionCollection;
END;
IMPLEMENTATION
(************************** TPartition Methods ***************************)
{ TPartition is an object descendant of TWindow. All TPartition objects
are child windows with TStatusLine as the parent.
When a TPartition is inserted in the statusline, it is automaticlly
inserted right next to the previous TPartition on the statusline.
The Init constructor method is called whenevr a new TPartition is
inserted in the statusline. The parameters of Init include the
TPartition's parent window, its title (Nil), the TPartitions left position
on the statusline, it's right position on the statusline, and most
importantly -- the last parameter -- is a procedure parameter. This
procedure parameter is a user defined procedure that will be used by
the TPartition.Paint method.
Each TPartition knows how to draw itself, with the Paint method. The Paint
method draws an empty partition (i.e - only the frame, not filled with
text. The paint method calls the user defined procedure, which is
responsible for filling the partition frame with the appropriate text.
See STATUSEX.PAS for an example of the user defined procedure }
CONSTRUCTOR TPartition.Init(AParent : PWindowsObject; ATitle : PCHAR;
LPos,RPos : WORD; Proc : TPaintProc);
VAR
R : TRect;
BEGIN
TWindow.Init(AParent,ATitle);
LeftPosition:=LPos;
RightPosition:=RPos;
PaintProc:=Proc;
WITH Attr DO BEGIN
Style:=Style OR ws_Child;
X:=LPos;
Y:=0;
W:=RPos-LPos;
H:=17;
END;
END;
PROCEDURE TPartition.Paint(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);
VAR
R : TRect;
TheBrush,
OldBrush : HBrush;
Pen,
OldPen : HPen;
BEGIN
GetClientRect(HWindow,R);
TheBrush:=CreateSolidBrush(GetSysColor(color_BtnFace));
FillRect(PaintHdc,R,TheBrush);
DeleteObject(TheBrush);
SetBkColor(PaintHdc,GetSysColor(color_BtnFace));
PaintProc(PaintHdc,PaintInfo);
Pen:=CreatePen(ps_Solid,1,RGB(255,255,255));
OldPen:=SelectObject(PaintHDC,Pen);
MoveTo(PaintHDC,R.Left,R.Top);
LineTo(PaintHDC,R.Right,R.Top);
MoveTo(PaintHdc,R.Left,R.Top);
LineTo(PaintHdc,R.Left,R.Bottom);
MoveTo(PaintHdc,R.Left+2,R.Top+15);
LineTo(PaintHdc,R.Right-3,R.Top+15);
LineTo(PaintHdc,R.Right-3,R.Top+2);
DeleteObject(SelectObject(PaintHdc,OldPen));
Pen:=CreatePen(ps_Solid,1,GetSysColor(color_btnShadow));
OldPen:=SelectObject(PaintHDC,Pen);
MoveTo(PaintHdc,R.Left+2,R.Top+2);
LineTo(PaintHdc,R.Right-3,R.Top+2);
MoveTo(PaintHdc,R.Right-1,R.Top);
LineTo(PaintHdc,R.Right-1,R.Bottom);
MoveTo(PaintHdc,R.Left+2,R.Top+2);
LineTo(PaintHdc,R.Left+2,R.Top+15);
DeleteObject(SelectObject(PaintHDC,OldPen));
END;
(*************************** TStatusLine Methods *************************)
{ TStatusLine is an object descendant of TWindow. TStatusLine has a field
called Partitions, which is a collection of TPartitions.
The InsertItem method is the method responsible for inserting new
TPartitions in the Partition collection.
The Paint method draws the statusline, and iterates through the Partition
collection call each ones Paint method. This results in the entire
statusline being redrawn. }
CONSTRUCTOR TStatusLine.Init(AParent : PWindowsObject; ATitle : PCHAR);
BEGIN
TWindow.Init(AParent,ATitle);
WITH Attr DO BEGIN
Style := Style OR ws_Child OR ws_Border;
END;
Partitions:=New(PPartitionCollection,Init(1,1));
Setup;
END;
PROCEDURE TStatusLine.InsertItem(StrLength : WORD; Proc : TPaintProc);
BEGIN
IF Partitions^.Count=0 THEN BEGIN
Partitions^.Insert(New(PPartition,Init(@Self,Nil,0,StrLength,
Proc)));
END
ELSE BEGIN
Partitions^.Insert(New(PPartition,Init(@Self,NIL,PPartition(
Partitions^.At(Partitions^.Count-1))^.RightPosition,PPartition(
Partitions^.At(Partitions^.Count-1))^.RightPosition+StrLength,
Proc)));
END;
END;
FUNCTION TStatusLine.GetPartition(Index : BYTE):PPartition;
BEGIN
GetPartition:=NIL;
IF Partitions^.Count<>0 THEN BEGIN
GetPartition:=Partitions^.At(Index);
END;
END;
PROCEDURE TStatusLine.Setup;
BEGIN
END;
PROCEDURE TStatusLine.Paint(PaintHDC : HDC; VAR PaintInfo : TPaintStruct);
VAR
R : TRect;
TheBrush : HBrush;
Pen,
OldPen : HPen;
PROCEDURE CallPaint(P : PPartition);FAR;
BEGIN
P^.Paint(PaintHDC,PaintInfo);
END;
BEGIN
GetClientRect(Parent^.HWindow,R);
MoveWindow(HWindow,0,R.Bottom-18,R.Right-R.Left,R.Bottom,TRUE);
GetClientRect(HWindow,R);
IF Partitions^.Count<>0 THEN BEGIN
R.Left:=PPartition(
Partitions^.At(Partitions^.Count-1))^.RightPosition;
END;
TheBrush:=CreateSolidBrush(GetSysColor(color_BtnFace));
FillRect(PaintHdc,R,TheBrush);
DeleteObject(TheBrush);
Pen:=CreatePen(ps_Solid,1,RGB(255,255,255));
OldPen:=SelectObject(PaintHDC,Pen);
MoveTo(PaintHDC,R.Left,R.Top);
LineTo(PaintHDC,R.Right,R.Top);
MoveTo(PaintHdc,R.Left,R.Top);
LineTo(PaintHdc,R.Left,R.Bottom);
MoveTo(PaintHdc,R.Left+2,R.Top+15);
LineTo(PaintHdc,R.Right-3,R.Top+15);
LineTo(PaintHdc,R.Right-3,R.Top+2);
DeleteObject(SelectObject(PaintHdc,OldPen));
Pen:=CreatePen(ps_Solid,1,GetSysColor(color_btnShadow));
OldPen:=SelectObject(PaintHDC,Pen);
MoveTo(PaintHdc,R.Left+2,R.Top+2);
LineTo(PaintHdc,R.Right-3,R.Top+2);
MoveTo(PaintHdc,R.Right-1,R.Top);
LineTo(PaintHdc,R.Right-1,R.Bottom);
MoveTo(PaintHdc,R.Left+2,R.Top+2);
LineTo(PaintHdc,R.Left+2,R.Top+15);
DeleteObject(SelectObject(PaintHdc,OldPen));
Partitions^.ForEach(@CallPaint);
END;
DESTRUCTOR TStatusLine.Done;
BEGIN
Dispose(Partitions,Done);
TWindow.Done;
END;
END.
{------------------------ DEMO -------------------------}
(*************************************************************************
* *
* STATUSEX.PAS - example program using the STATUS unit. *
* By Thomas S. Carlisle *
* *
* *
* This program sets up an example application demonstrating the use of *
* the STATUS unit. A main window is created that has a statusline with *
* a single partition that will display the current time. *
* *
* I picked a clock example because it demonstrates how the main window *
* can communicate with the statusline to tell it a certain partition *
* needs to be redrawn. *
* *
*************************************************************************)
PROGRAM StatusEx;
USES
WObjects,WinTypes,WinProcs,Status,WinDOS,Strings;
CONST
wm_UpdateTime = $0400; { User defined message }
TYPE
TimeRec = RECORD
Hour,
Min : WORD;
END;
PMyStatusLine = ^TMyStatusLine;
TMyStatusLine = OBJECT(TStatusLine)
PROCEDURE Setup;VIRTUAL;
PROCEDURE UpdateTime(VAR Msg : TMessage);
VIRTUAL wm_First + wm_UpdateTime;
END;
PMyWindow = ^TMyWindow;
TMyWindow = OBJECT(TWindow)
StatusLine : PMyStatusLine;
CONSTRUCTOR Init(AParent : PWindowsObject; ATitle : PCHAR);
PROCEDURE SetupWindow;VIRTUAL;
DESTRUCTOR Done;VIRTUAL;
PROCEDURE Timer(VAR Msg : TMessage);VIRTUAL wm_Timer;
END;
TMyApp = OBJECT(TApplication)
PROCEDURE InitMainWindow;VIRTUAL;
END;
(********************************* Globals **************************)
VAR
OldTime : TimeRec; { OldTime will be used to keep track of
whether or not the time has changed and
needs to be redrawn }
PROCEDURE Clock(PaintHdc : HDC; VAR PaintInfo : TPaintStruct);FAR;
{ This procedure MUST be declared as FAR because it is passed as a
parameter to the statusline, so the statusline will know what procedure
to call when the statusline needs to be drawn. The statusline draws the
actual box, but this procedure must fill in the text.
Note the parameter list. It is mandatory, but also convenient. You will
need to use the PaintHDC as the device context for your text output. The
PaintInfo is there just in case you need it. All procedures designed to be
passed to the statusline to be used to fill in the statusline partitions
MUST have these two parameters!
This procedure simply fills the box with the current time. }
VAR
TimeStr : ARRAY[0..5] OF CHAR;
Hour,
Minute,
Sec,
HSec : WORD;
TempStr,
Temp1 : ARRAY[0..2] OF CHAR;
BEGIN
StrCopy(TimeStr,' ');
GetTime(Hour,Minute,Sec,HSec);
OldTime.Hour:=Hour; { Fill in OldTime record for future use }
OldTime.Min:=Minute;
Str(Hour,TempStr); { Build the string that holds the time }
StrCat(TimeStr,TempStr);
StrCopy(TempStr,':');
StrCat(TimeStr,TempStr);
Str(Minute,TempStr);
IF StrLen(TempStr)=1 THEN BEGIN
StrCopy(Temp1,'0');
StrCat(Temp1,TempStr);
StrCopy(TempStr,Temp1);
END;
StrCat(TimeStr,TempStr);
TextOut(PaintHdc,3,1,TimeStr,StrLen(TimeStr)); { Output the time }
END;
(************************ TMyStatusLine Methods ************************)
PROCEDURE TMyStatusLine.UpdateTime(VAR Msg : TMessage);
{ This procedure is a response method for TMyStatusLine. It responds to
the wm_UpdateTime user defined message. The procedure first checks
the current time against the time in OldTime. If they are different,
then the clock status window is invalidated, to force it to be redrawn
with the new time.
The reason this program is setup to keep track of the OldTime, and have
this procedure check it, is to avoid flicker that occurs if the time
is updated when it isn't necessary. }
VAR
Hour,Min,Sec,HSec : WORD;
BEGIN
GetTime(Hour,Min,Sec,HSec);
IF (OldTime.Hour<>Hour) OR (OldTime.Min<>Min) THEN
InvalidateRect(GetPartition(0)^.HWindow,NIL,TRUE);
END;
PROCEDURE TMyStatusLine.Setup;
{ Overrides the inherited Setup method. This setup method inserts one
statusline partition in the status line. }
BEGIN
InsertItem(75,Clock); { This inserts a new item in the statsuline.
The first parameter is the length (in pixels)
of the desired statusline partition. The
second parameter is the procedure this new
partition will call whenever it needs to be
redrawn. As stated earlier, the statusline
takes care of drawing the statusline and it's
partitions, but the procedure passed here is
responsible for filling the partition with
text }
{ If you need more than one partition,
simply add more InsertItem statements. Each
one can be passed a length and procedure
parameter. Very powerful. }
END;
(************************* TMyWindow Methods ***************************)
CONSTRUCTOR TMyWindow.Init(AParent : PWindowsObject; ATitle : PCHAR);
{ TMyWindow is a descendant of TWindow. The only difference is it has a
StatusLine. }
BEGIN
TWindow.Init(AParent,ATitle);
Statusline:=New(PMyStatusLine,Init(@Self,Nil));
END;
PROCEDURE TMyWindow.SetupWindow;
{ SetupWindow is needed in this application to start the timer that will
be used to spark messages every second to make sure the statusline clock
is kept up to date. }
BEGIN
TWindow.SetupWindow;
IF SetTimer(HWindow,1,1000,NIL) = 0 THEN
MessageBox(HWindow,'ERROR','Timer not available',mb_OK);
END;
PROCEDURE TMyWindow.Timer(VAR Msg : TMessage);
{ Responds to wm_Timer messages. First checks to make sure the incomming
message is ours (ID=1). If it is, it sends a wm_UpdateTime message
to the statusline. That is the message the statusline responds to by
updating the time, if it has changed. }
BEGIN
IF Msg.wParam=1 THEN BEGIN
SendMessage(StatusLine^.HWindow,wm_UpdateTime,0,0);
END;
END;
DESTRUCTOR TMyWindow.Done;
{ Cleans up by killing the timer we started, and disposing the statusline }
BEGIN
KillTimer(HWindow,1);
Dispose(StatusLine,Done);
TWindow.Done;
END;
(****************************** TMyApp Methods ************************)
PROCEDURE TMyApp.InitMainWindow;
{ Gets our main window (TMyWindow) in action }
BEGIN
MainWindow:=New(PMyWindow,Init(NIL,'Test'));
END;
VAR
MyApp : TMyApp;
BEGIN
MyApp.Init('Test');
MyApp.Run;
MyApp.Done;
END.
[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]