[Back to OOP SWAG index] [Back to Main SWAG index] [Original]
{************************************************}
{ }
{ UNIT MSGOBJ MessageObjects }
{ Copyright (c) 1993-97 by Tom Wellige }
{ Donated as FREEWARE }
{ }
{ Ortsmuehle 4, 44227 Dortmund, GERMANY }
{ E-Mail: wellige@itk.de }
{ }
{************************************************}
unit MsgObj;
{$O+,F+,X+,I-,S-}
interface
uses Objects, Drivers, App, Views, Menus, Dialogs, MsgBox;
type
{ display any messages in this status line }
PMsgStatusLine = ^TMsgStatusLine;
TMsgStatusLine = object (TStatusLine)
MsgText: string;
ShowHint: boolean;
constructor Init(var Bounds: TRect; ADefs: PStatusDef);
procedure HandleEvent(var Event: TEvent); virtual;
function GetPalette: PPalette; virtual;
procedure Draw; virtual;
procedure Update; virtual;
private
procedure DrawMessage;
procedure FindItems;
end;
{ change the displayed text by a message }
PMsgStaticText = ^TMsgStaticText;
TMsgStaticText = object(TStaticText)
cmMessage: Word;
txt: string;
constructor Init(var Bounds: TRect; AText: String; ACommand: word);
procedure HandleEvent(var Event: TEvent); virtual;
procedure Draw; virtual;
procedure SetText(AText: string); virtual;
end;
{ this text is not only changeable it is also colored }
PMsgColoredText = ^TMsgColoredText;
TMsgColoredText = object(TStaticText)
Attr : Byte;
cmMessage: Word;
txt: string;
constructor Init(var Bounds: TRect; AText: String;
ACommand: word; Attribute : Byte);
function GetTheColor : byte; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Draw; virtual;
procedure SetText(AText: string); virtual;
end;
{ change the text inside an inputline with a simple message }
PMsgInputLine = ^TMsgInputLine;
TMsgInputLine = object(TInputLine)
procedure HandleEvent(var Event:TEvent); virtual;
end;
{ by changing the focus in the list a message will be created }
PMsgListBox = ^TMsgListBox;
TMsgListBox = object(TListBox)
Command: word;
constructor Init(var Bounds: TRect; ANumCols: Word;
AScrollBar: PScrollBar; ACommand: word);
procedure FocusItem(Item: Integer); virtual;
end;
{ displayes a changeable text inside a dialog }
PMsgDialog = ^TMsgDialog;
TMsgDialog = object(TDialog)
Text: string;
P: PStaticText;
constructor Init(var Bounds: TRect; ATitle: string);
procedure HandleEvent(var Event: TEvent); virtual;
end;
const
{ TMsgStatusLine messages }
cmStatusLineMessage = 1000;
cmStatusLineRestore = 1001;
cmShowHint = 1002;
{ TMsgStatictext & TMsgColoredText }
cmTextMessage = 1003;
{ TMsgDialog messages }
cmShowMessageText = 1004;
cmShowText = 1020; { Message - Command }
implementation
{ -------------- TMsgDialog --------------------}
constructor TMsgDialog.Init(var Bounds: TRect; ATitle: string);
begin
inherited Init(Bounds, ATitle);
Options:= Options and ofCentered;
Text:= '';
P:= nil;
end;
procedure TMsgDialog.HandleEvent(var Event: TEvent);
var R: TRect;
begin
inherited HandleEvent(Event);
if (Event.What = evBroadCast) and (Event.Command = cmShowMessageText) then
begin
if P <> nil then
begin
Delete(P);
Dispose(P, Done);
end;
GetExtent(R);
R.Grow(-2, -2);
P:= New(PStaticText, Init(R, PString(Event.InfoPtr)^));
insert(P);
end;
end;
{ -------------- TMsgStatusLine ----------------}
constructor TMsgStatusLine.Init(var Bounds: TRect; ADefs: PStatusDef);
begin
inherited Init(Bounds, ADefs);
MsgText:= '';
ShowHint:= false;
end;
procedure TMsgStatusLine.HandleEvent(var Event: TEvent);
begin
if Event.What=evBroadcast then
case Event.Command of
cmStatusLineMessage:
begin
MsgText:= PString(Event.InfoPtr)^;
DrawView;
ClearEvent(Event);
end;
cmStatusLineRestore:
begin
MsgText:= '';
DrawView;
ClearEvent(Event);
end;
cmShowHint:
begin
if Event.InfoPtr <> nil then
begin
ShowHint:= true;
HelpCtx:= Word(Event.InfoPtr^);
Update;
end else
if ShowHint then
begin
ShowHint:= false;
Update;
end;
ClearEvent(Event);
end;
end;
inherited HandleEvent(Event);
end;
procedure TMsgStatusLine.Update;
var
P: PView;
H: word;
begin
if ShowHint then
begin
FindItems;
DrawView;
end else
begin
P:= Application^.TopView;
if P <> nil then
H:= P^.GetHelpCtx else
H:= hcNoContext;
if HelpCtx <> H then
begin
HelpCtx := H;
FindItems;
DrawView;
end;
end;
end;
procedure TMsgStatusLine.FindItems;
var
P: PStatusDef;
begin
P := Defs;
while (P <> nil) and ((HelpCtx < P^.Min) or (HelpCtx > P^.Max)) do
P := P^.Next;
if P = nil then Items := nil else Items := P^.Items;
end;
function TMsgStatusLine.GetPalette: PPalette;
const
P: string[Length(CStatusLine)] = CStatusLine;
begin
GetPalette := PPalette(@P);
end;
procedure TMsgStatusLine.Draw;
begin
if MsgText <> '' then DrawMessage else
begin
inherited Draw;
end;
end;
procedure TMsgStatusLine.DrawMessage;
var
B: TDrawBuffer;
I, L: Integer;
Color: Word;
MsgBuf: string;
begin
Color := GetColor($0103);
MoveChar(B, ' ', Byte(Color), Size.X);
MsgBuf := MsgText;
L:= 0;
if MsgBuf <> '' then
begin
if Length(MsgBuf) > Size.X then
MsgBuf := copy(MsgBuf, 1, Size.X);
MoveCStr(B[L+1], MsgBuf, Byte(Color));
end;
WriteLine(0, 0, Size.X, 1, B);
end;
{ ----------------- TMsgStaticText ------------------ }
constructor TMsgStaticText.Init(var Bounds: TRect; AText: string;
ACommand: word);
begin
inherited Init(Bounds, AText);
EventMask := EventMask or evBroadcast;
cmMessage:= ACommand;
SetText(AText);
end;
procedure TMsgStaticText.HandleEvent(var Event: TEvent);
begin
inherited HandleEvent(Event);
if (Event.What = evBroadcast) and (Event.Command = cmMessage) then
begin
SetText(PString(Event.InfoPtr)^);
ClearEvent(Event);
DrawView;
end;
end;
procedure TMsgStaticText.SetText(AText: string);
begin
Txt:= AText;
DisposeStr(Text);
Text:= NewStr(Txt);
end;
procedure TMsgStaticText.Draw;
var
Color: Byte;
Center: Boolean;
I, J, L, P, Y: Integer;
B: TDrawBuffer;
S: String;
begin
Color := GetColor(1);
GetText(S);
L := Length(S);
P := 1;
Y := 0;
Center := False;
while Y < Size.Y do
begin
MoveChar(B, ' ', Color, Size.X);
if P <= L then
begin
if S[P] = #3 then
begin
Center := True;
Inc(P);
end;
I := P;
repeat
J := P;
while (P <= L) and (S[P] = ' ') do Inc(P);
while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
until (P > L) or (P >= I + Size.X) or (S[P] = #13);
if P > I + Size.X then
if J > I then P := J else P := I + Size.X;
if Center then J := (Size.X - P + I) div 2 else J := 0;
MoveBuf(B[J], S[I], Color, P - I);
while (P <= L) and (S[P] = ' ') do Inc(P);
if (P <= L) and (S[P] = #13) then
begin
Center := False;
Inc(P);
if (P <= L) and (S[P] = #10) then Inc(P);
end;
end;
WriteLine(0, Y, Size.X, 1, B);
Inc(Y);
end;
end;
{ ---------- TMsgColorStaticText ------------------ }
constructor TMsgColoredText.Init(var Bounds: TRect; AText: String;
ACommand: word; Attribute : Byte);
begin
inherited Init(Bounds, AText);
EventMask := EventMask or evBroadcast;
cmMessage:= ACommand;
SetText(AText);
Attr := Attribute;
end;
procedure TMsgColoredText.HandleEvent(var Event: TEvent);
begin
inherited HandleEvent(Event);
if (Event.What = evBroadcast) and (Event.Command = cmMessage) then
begin
SetText(PString(Event.InfoPtr)^);
ClearEvent(Event);
DrawView;
end;
end;
function TMsgColoredText.GetTheColor : byte;
begin
if AppPalette = apColor then
GetTheColor := Attr
else
GetTheColor := GetColor(1);
end;
procedure TMsgColoredText.SetText(AText: string);
begin
Txt:= AText;
DisposeStr(Text);
Text:= NewStr(Txt);
end;
procedure TMsgColoredText.Draw;
var
Color: Byte;
Center: Boolean;
I, J, L, P, Y: Integer;
B: TDrawBuffer;
S: String;
begin
Color := GetTheColor;
GetText(S);
L := Length(S);
P := 1;
Y := 0;
Center := False;
while Y < Size.Y do
begin
MoveChar(B, ' ', Color, Size.X);
if P <= L then
begin
if S[P] = #3 then
begin
Center := True;
Inc(P);
end;
I := P;
repeat
J := P;
while (P <= L) and (S[P] = ' ') do Inc(P);
while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
until (P > L) or (P >= I + Size.X) or (S[P] = #13);
if P > I + Size.X then
if J > I then P := J else P := I + Size.X;
if Center then J := Size.X - P + I div 2 else J := 0;
MoveBuf(B[J], S[I], Color, P - I);
while (P <= L) and (S[P] = ' ') do Inc(P);
if (P <= L) and (S[P] = #13) then
begin
Center := False;
Inc(P);
if (P <= L) and (S[P] = #10) then Inc(P);
end;
end;
WriteLine(0, Y, Size.X, 1, B);
Inc(Y);
end;
end;
{ ---------- TMsgInputLine ------------------ }
procedure TMsgInputLine.HandleEvent(var Event:TEvent);
var s: string;
begin
inherited HandleEvent(Event);
if Event.What = evBroadCast then
if Event.Command = cmShowText then
begin
s:= PString(Event.InfoPtr)^;
SetData(s);
end;
end;
{ ---------- TMsgListBox -------------------- }
constructor TMsgListBox.Init(var Bounds: TRect; ANumCols: Word;
AScrollBar: PScrollBar; ACommand: word);
begin
inherited Init(Bounds, ANumCols, AScrollBar);
Command:= ACommand;
end;
procedure TMsgListBox.FocusItem(Item: Integer);
var s: string;
begin
inherited FocusItem(Item);
Message(Owner, evBroadCast, Command, nil);
end;
end.
[Back to OOP SWAG index] [Back to Main SWAG index] [Original]