{************************************************}
{                                                }
{   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.