(********************************************************)
(* Name:LPL_Message (Message routines for LPL Programs) *)
(* Last Revision: 28 March 2001                         *)
(* Version: 3.1                                         *)
(*                                                      *)
(* Copyright © 2000 - 2001 by Christian Aaangel         *)
(********************************************************)

unit LPL_Message;

interface

Uses Messages, Windows, Forms;

// You can use this one to pass directly from OnMessage
Procedure AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
// Or you can use this one to create a error-interceptor
Function USER_AppMessageHandler(var Msg: TMessage; var Handled: Boolean): Longint;
// Call This one to get the Unit Version
Function LPL_Message_Version: String;
// Call This one to get the handle of the Debug window
Function FindDebug: Hwnd;
// Use This one to send a string to the debug window
Procedure SendToDebug(Msg: String);
// Use This one to dial-up the Debugger
Procedure Dial(FClass, FCaption, AppName: String);
// Use this one the free the debugger
Procedure FreeDebug;

Const
 // Message Identifier
 LPL_TypeCast = WM_USER + 76 + 80 + 76; // Unique (?) - WM_USER plus the ASCII codes for L - P - L

 // LPL Typecast system
 LPL_TC_Terminate = 0;
 LPL_TC_Debug = 1;
 LPL_TC_DEBUG_CALLBACK = 2; // Callback to source app
 LPL_TC_DEBUG_SHUTDOWN = 3; // Debugger has been shutdown
 LPL_TC_DEBUG_RESET = 4; // Debugger has been reset
 LPL_PAD_LOAD = 5; // LPL Pad has been opened twice open file in the first running
 LPL_M3M_UPDATE_WINAMP_STAT = 6; // Codename M3M must update the current song playing info

 // Return codes for this unit
 SUCCES = 0;
 ERROR_Not_LPL = 1;
 ERROR_Undefined = 2;
 LPL_APP_READY = 3;

 // LPL DEBUG system
 LPL_DEBUG_Enter = 0;
 LPL_DEBUG_CLASS = 256;
 LPL_DEBUG_CAPTION = 257;
 LPL_DEBUG_CALLBACK = 258;
 LPL_DEBUG_FREE = 259; // Free debugger for use with other apps
 LPL_DEBUG_APPNAME = 260;

 // LPL CALLBACK RETURN VALUES
 LPL_DEBUG_CALLBACK_GOAHEAD = 0;
 LPL_DEBUG_CALLBACK_BUSY = 1;

implementation

Function LPL_Message_Version: String;
Begin
 Result := '3.0';
End;

Function USER_AppMessageHandler(var Msg: TMessage; var Handled: Boolean): Longint;
Var
 Res: Longint;
Begin
 Res := SUCCES;
 If Msg.Msg <> LPL_TypeCast Then Begin
  Handled := False;
  Res := ERROR_Not_LPL;
 End
  Else
 Begin
  Handled := True;
  Case Msg.wParam of
   0: Application.Terminate;
   1: Res := LPL_APP_READY; // Answer the callback with ready
   else Begin
    Handled := False;
    Res := ERROR_Undefined;
   End;
  End;
 End;
 Result := Res;
End;

Function FindDebug: Hwnd;
Begin
 Result := FindWindow('tty', 'LPLDebug');
End;

Procedure AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
Begin
 If Msg.Message <> LPL_TypeCast Then Begin
  Handled := False;
 End
  Else
 Begin
  Handled := True;
  Case Msg.wParam of
   0: Application.Terminate;
   else Begin
    Handled := False;
   End;
  End;
 End;
End;

Procedure SendToDebug(Msg: String);
Var
 I: Integer;
 Debug: Hwnd;
begin
 If Length(MSG) = 0 Then exit;
 Debug := LPL_Message.FindDebug;
 For I := 1 to length(Msg) do begin
  If Ord(Msg[I]) = 0 then begin
    Postmessage(Debug, LPL_Typecast, LPL_Tc_Debug, Ord('('));
    Postmessage(Debug, LPL_Typecast, LPL_Tc_Debug, Ord('#'));
    Postmessage(Debug, LPL_Typecast, LPL_Tc_Debug, Ord('0'));
    Postmessage(Debug, LPL_Typecast, LPL_Tc_Debug, Ord(')'));
  End
   else
    Postmessage(Debug, LPL_Typecast, LPL_Tc_Debug, Ord(Msg[I]));
 End;
 Postmessage(Debug, LPL_Typecast, LPL_TC_Debug, LPL_DEBUG_ENTER);
end;

Procedure Dial(FClass, FCaption, AppName: String);
Var
 I: Integer;
 Debug: Hwnd;
Begin
 If Length(FClass) = 0 Then Exit;
 If Length(FCaption) = 0 Then Exit;
 If Length(AppName) = 0 then Exit;
 Debug := LPL_Message.FindDebug;
 For I := 1 to length(FClass) do begin
  Postmessage(Debug, LPL_Typecast, LPL_TC_DEBUG, Ord(FClass[I]));
 End;
 Postmessage(Debug, LPL_Typecast, LPL_TC_DEBUG, LPL_DEBUG_CLASS); // Annouce Class just send
 For I := 1 to length(FCaption) do begin
  Postmessage(Debug, LPL_Typecast, LPL_TC_DEBUG, Ord(FCaption[I]));
 End;
 Postmessage(Debug, LPL_Typecast, LPL_TC_DEBUG, LPL_DEBUG_CAPTION); // Annouce Caption just send
 For I := 1 to length(AppName) do begin
  Postmessage(Debug, LPL_Typecast, LPL_TC_DEBUG, Ord(AppName[I]));
 End;
 Postmessage(Debug, LPL_Typecast, LPL_TC_DEBUG, LPL_DEBUG_APPNAME); // Annouce Application Name just send
 Postmessage(Debug, LPL_Typecast, LPL_TC_DEBUG, LPL_DEBUG_CALLBACK); // Perform Callback
End;

Procedure FreeDebug;
Var
 Debug: Hwnd;
Begin
 Debug := LPL_Message.FindDebug;
 Postmessage(Debug, LPL_Typecast, LPL_TC_DEBUG, LPL_DEBUG_FREE); // Free the debugger
End;

end.
