
unit TraceDxInterface;

{
  Diese Datei ist nur zur Information, nicht als Unit einbinden !!!

  Das in den Client einzubindende Trace-Interface ist auf die Dateien

  uTraceDx:    Für normale Anwendungen
  uTraceDxSys: Für zu tracende Delphi-Sourcen

  aufgeteilt. Beachte: Die uTraceDx muss immer im Projekt eingebunden sein,
  nur uTraceDxSys reicht für Trace nicht, auch wenn das Projekt übersetzbar ist.

  Zur einfacheren Lesbarkeit ist hier die gesamte Schnittstelle in einer Datei
  dokumentiert.
}

interface

type

  (* ----------------------------------- Messages ------------------------------ *)

  { Darstellung der beiden Message-Parameter WParam und LParam }
  tMsgParam         = ( paNul, paInt, paIntWords, paHex, paHexWords );

  TWinMessage       = UINT;
  TMessageSelector  = record
                        Enabled    : boolean;
                        Color      : tTraceColor;
                        UseShowList: boolean;
                        ShowList,
                        HideList   : TArray<TWinMessage>;
                      end;

  TMessageType      = ( mtAppOnMessage, mtMainWindowHook, mtWindowProc, mtWinSend, mtWinSendTimeOut, mtWinSendCallBack, mtWinPost );
  tMessageSet       = set of tMessageType;

  (* ------------------------------------- Events ------------------------------ *)

  tEventApp         = ( evAppOnActionExecute, evAppOnActionUpdate, evAppOnActivate, evAppOnDeactivate,
                        evAppOnException, evAppOnGetActiveFormHandle, evAppOnGetMainFormHandle,
                        evAppOnHelp, evAppOnHint, evAppOnIdle, evAppOnMessage, evAppOnMinimize,
                        evAppOnModalBegin, evAppOnModalEnd, evAppOnRemoteSessionChanged,
                        evAppOnRestore, evAppOnSettingChange, evAppOnShortCut, evAppOnShowHint );
  tEventAppSet      = set of tEventApp;

  tEventScr         = ( evScrOnActiveControlChange, evScrOnActiveFormChange );
  tEventScrSet      = set of tEventScr;

  tEventFrm         = ( evFrmOnActivate, evFrmOnAfterMonitorDpiChanged, evFrmOnAlignInsertBefore, evFrmOnAlignPosition,
                        evFrmOnBeforeMonitorDpiChanged, evFrmOnCanResize, evFrmOnClick, evFrmOnClose, evFrmOnCloseQuery,
                        evFrmOnConstrainedResize, evFrmOnContextPopup, evFrmOnCreate, evFrmOnDblClick, evFrmOnDestroy,
                        evFrmOnDeactivate, evFrmOnDockDrop, evFrmOnDockOver, evFrmOnDragDrop, evFrmOnDragOver, evFrmOnEndDock,
                        evFrmOnGesture, evFrmOnGetSiteInfo, evFrmOnHide, evFrmOnHelp, evFrmOnKeyDown, evFrmOnKeyPress, evFrmOnKeyUp,
                        evFrmOnMouseActivate, evFrmOnMouseDown, evFrmOnMouseEnter, evFrmOnMouseLeave, evFrmOnMouseMove,
                        evFrmOnMouseUp, evFrmOnMouseWheel, evFrmOnMouseWheelDown, evFrmOnMouseWheelUp, evFrmOnPaint,
                        evFrmOnResize, evFrmOnShortCut, evFrmOnShow, evFrmOnStartDock, evFrmOnUnDock );
  tEventFrmSet      = set of tEventFrm;

  (* ------------------------------------- Traces ------------------------------ *)

  tTraceColor       =  ( tcDefault, tcBlue, tcRed, tcGreen, tcOrange );

  TraceDx           = class
        type
          (* Typ des im CallRet-Return anzuzeigenden Wertes *)
          tResultType       = ( rtNone,
                                rtByte,    rtWord,   rtCardinal,
                                rtInteger, rtInt64,
                                rtSingle,  rtDouble, rtExtended,
                                rtBool,
                                rtChar,    rtString,
                                rtPoint,   rtRect,
                                rtObject
                              );

          tModifierKeys     = set of VK_SHIFT..VK_MENU;

          (* für Trace von Interface-Typen von diesem Interface ableiten *)
          ITraceDx          = interface
                                function GetName: string;
                              end;

          (* Trace löschen *)
          class procedure Clear();   

          (* Trace Trennlinie *)
          class procedure Line; 

          (* Inc/Dec für Einrückung (bei Call() automatisch) *)
          class procedure IncIndent; 
          class procedure DecIndent; 

          (* Inc/Dec für Hide *)
          class procedure IncHide; 
          class procedure DecHide( ShowHiddenCounter: boolean = true ); 

          (* füge dem Client ein Trace-Menü hinzu: m=MainMenu ODER m=PopupMenu.    Falls m=nil: füge ein Trace-Formular hinzu *)
          class procedure AddMenu;             
          class procedure AddMenu( m: TMenu );      // nur für VCL

          (* Ausgabe-Kanäle *)
          class property  ToServer: boolean;

          class var       FileName : string;
          class property  ToFile  : boolean;

          class procedure SetInternalView( v: TComponent );      // nur für Traces aus Main-Thread!
          class property  ToIntern: boolean;

          (* Filter setzen auf Client-Seite ( dadurch weniger Datenverkehr zum Server   *)
          class procedure SetFilter( const Filter: string );
          (* Trace nur, wenn diese Funktion "true" zurück gibt *)
          class procedure SetUserCondition( f: (function: boolean) );

          (* Trigger zum Starten und Stoppen der Trace-Weiterleitung                    *)
          class procedure SetTrigger     ( const start,stop: string );
          class procedure SetTriggerStart( const start     : string );
          class procedure SetTriggerStop ( const stop      : string ); 

          (* Compare-Funktion des Servers, hier alternativ per Code im Client gesteuert *)
          class procedure CompareStart( const TestName: string = '' );
          class procedure CompareEnd                                 ;

          type
            Messages  = class
                  { Nur für Aufrufe aus Delphi-Sourcen: }
                  class procedure Send( typ: TMessageType; Handle: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM ); 
                  (* Änderungen als internes Trace melden *)
                  class procedure DoLog       ( b: boolean );                                      
                  (* User-Messages können mehrdeutig sein. Über den Prefix (Case-sensitiv) wird ggf eine Auswahl getroffen *)
                  class procedure SetPrefix( const p: string );
                  (* Message-Parameter wParam und lParam enable / disable *)
                  class procedure ShowParams( t: TMessageType; b: boolean = true      );

                  (* Message-Typ enable / disable *)
                  class procedure Enable    ( t: TMessageType; b: boolean = true      );           
                  (* schneller Zugriff auf ALLE *)
                  class property  EnabledSet: tMessageSet;
                  (* Alle Einstellungen für alle Message-Typen auf einen Schlag *)
                  class procedure SetSelects( t: TMessageType; s: TMessageSelector    );           
                  (* Farbe *)
                  class procedure SetColor  ( t: TMessageType; c: tTraceColor         );           
                  (* Message(-Nummern)-Auswahl *)
                  class procedure SelectShow( t: TMessageType; a: TWinMessage         );  
                  class procedure SelectShow( t: TMessageType; a: TArray< TWinMessage>);
                  class procedure SelectHide( t: TMessageType; a: TWinMessage         );
                  class procedure SelectHide( t: TMessageType; a: TArray<TWinMessage> );

                  (* eigene Message(s) für Decodierung hinzufügen *)
                  class procedure Add   ( MessageCode: TWinMessage; const MessageText: string );

                  (* Windows-Messages: Alle Messages aus Control.WindowProc() *)
                  class procedure TraceWindowProc( c: TControl ); 

                  { Diese Messages sind ein Vorschlag für SaveAndSet()-Aufrufe vor Verify-Procs oder als Pre-Verify-Proc }
                  const cStandard: tMessageSet = [];  // [low(tMessageType)..high(tMessageType)];

                  (* Aktuellen Zustand der Message-Traces abspeichern und auf neue Zustände setzen.  *)
                  class procedure SaveAndSet( Msg: tMessageSet; Log: boolean = false ); 
                  (* gespeicherten Zustand wieder herstellen *)
                  class procedure Restore; 
                end;

          Events = class
                type
                  App  = class  (* Application-Events On... *)
                      { Um alle Events einzuschalten: }
                      const cAll     : tEventAppSet = [low(tEventApp)..high(tEventApp)];
                      { Diese Events sind ein Vorschlag für SaveAndSet()-Aufrufe vor Verify-Procs oder als Pre-Verify-Proc }
                      const cStandard: tEventAppSet = [low( tEventApp )..high( tEventApp )] - [evAppOnModalBegin, evAppOnModalEnd];  // kommen bei Verify-Ergebnis-Meldung per ShowMessage;
                      (* einzelnes Event für Trace aktivieren *)
                      class procedure Enable( e: tEventApp; b: boolean );
                      (* schneller Zugriff auf ALLE: *)
                      class property  EnabledSet: tEventAppSet;
                    end;

                  Scr  = class  (* Screen-Events On... *)
                      { Um alle Events einzuschalten: }
                      const cAll     : tEventScrSet = [low(tEventScr)..high(tEventScr)];
                      { Diese Events sind ein Vorschlag für SaveAndSet()-Aufrufe vor Verify-Procs oder als Pre-Verify-Proc }
                      const cStandard: tEventScrSet = [low( tEventScr )..high( tEventScr )] - [];
                      (* einzelnes Event für Trace aktivieren *)
                      class procedure Enable( e: tEventScr; b: boolean );
                      (* schneller Zugriff auf ALLE: *)
                      class property  EnabledSet: tEventScrSet;
                    end;

                  Frm  = class  (* Form-Events On... *)
                      type
                        tSubInfo    = record
                                          private
                                          (* Wird nur intern verwendet, an der Schnittstelle einfach die Liste der Objekte als Array übergeben *)
                                          type TExcludeList = array of TObject;
                                          public
                                          (* Änderungen als internes Trace melden on/off, ggf mit FormName *)
                                          procedure DoLog( LogChanges: boolean; ShowFormName: boolean = false );
                                          (* Liste der vom OnClick()-Trace ausgenommenen Objekte *)
                                          property ExcludeList: TExcludeList;
                                          (* SubControl-OnClick an/aus *)
                                          property Enabled: boolean;
                                      end;

                        tFrmInfo    = record
                                          var SubCtrls  : tSubInfo;
                                          (* Im Event FormKeyDown/-Up: Diese Modifier-Keys (Shift,Ctrl,Alt) anzeigen. Default = [] *)
                                          procedure ShowModifierKeys( k: tModifierKeys );
                                          (* einzelnes Event für Trace aktivieren *)
                                          procedure Enable( e: tEventFrm; b: boolean );
                                          (* schneller Zugriff auf ALLE: *)
                                          property EnabledSet: tEventFrmSet;
                                      end;
                        pFrmInfo    = ^tFrmInfo;

                      { Um alle Events einzuschalten: }
                      const cAll     : tEventFrmSet = [low(tEventFrm)..high(tEventFrm)];
                      { Diese Events sind ein Vorschlag für SaveAndSet()-Aufrufe vor Verify-Procs oder als Pre-Verify-Proc }
                      const cStandard: tEventFrmSet = [low( tEventFrm )..high( tEventFrm )] - [evFrmOnMouseMove, evFrmOnMouseEnter, evFrmOnMouseLeave,
                                                                                               evFrmOnPaint];
                      (* TForm für Event-Auswahl zum Menü hinzufügen *)
                      class procedure Add( f: TForm );            // FMX: TCommonCustomForm
                    end;

                (* Änderungen als internes Trace melden *)
                class procedure DoLog( b: boolean );
                (* Aktuellen Zustand der Event-Traces abspeichern und auf neue Zustände setzen.  *)
                class procedure SaveAndSet( pApp: tEventAppSet; pScr: tEventScrSet; pFrm: tEventFrmSet; SubControls: boolean; Log: boolean = false );
                (* gespeicherten Zustand wieder herstellen *)
                class procedure Restore;

                (* Zugriff auf TForm-spezifische Eigenschaften und Funktionen *)
                class property Forms[f: TForm]: Frm.pFrmInfo;     // FMX: TCommonCustomForm
              end;  (* Events *)

{ ---------- Send( Method ) ------------------------------------------------------------------------------------ }

          class procedure Send     (                 const Method: string                                 );  
          class procedure Send     (                 const Method: string;  const s    : string           );  
          class procedure Send     (                 const Method: string;  const s1,s2: string           );  
          class procedure Send     (                 const Method: string;  const i    : integer          );  
          class procedure Send     (                 const Method: string;  const i1,i2: integer          );  
          class procedure Send     (                 const Method: string;  const i    : int64            );  
          class procedure Send     (                 const Method: string;  const c    : cardinal         );  
          class procedure Send     (                 const Method: string;  const c1,c2: cardinal         );  
          class procedure Send     (                 const Method: string;  const b    : boolean          );  
          class procedure Send     (                 const Method: string;  const b1,b2: boolean          );  
          class procedure Send     (                 const Method: string;  const f    : single           );  
          class procedure Send     (                 const Method: string;  const f    : double           );  
          class procedure Send     (                 const Method: string;  const f1,f2: double           );  
          class procedure Send     (                 const Method: string;  const p    : pointer          );  
          class procedure Send     (                 const Method: string;  const p1,p2: pointer          );  
          class procedure Send     (                 const Method: string;  const p    : TPoint           );  
          class procedure Send     (                 const Method: string;  const p1,p2: TPoint           );  
          class procedure Send     (                 const Method: string;  const p    : TPointF          );  
          class procedure Send     (                 const Method: string;  const p1,p2: TPointF          );  
          class procedure Send     (                 const Method: string;  const r    : TRect            );  
          class procedure Send     (                 const Method: string;  const r    : TRectF           );  
          class procedure Send     (                 const Method: string;  const m    : TMessage;
                                                                            const W    : tMsgParam = paNul;
                                                                            const L    : tMsgParam = paNul);  
          class procedure Send     (                 const Method: string;  const c    : TClass           );  
          class procedure Send     (                 const Method: string;  const i    : ITraceDx         );  
          class procedure Send     (                 const Method: string;  const o    : TObject          );  
          class procedure Send     (                 const Method: string;  const o1,o2: TObject          );  
          class procedure SendE<T> (                 const Method: string;  const enum : T;
                                                                            Scoped     : boolean = false  );  
          class procedure SendS<T> (                 const Method: string;  const &set : T                );  
          class procedure Send<T>  (                 const Method: string;  const v    : T;
                                                                            ToString   : TFunc<T,string>  );  
          class procedure Send<T>  (                 const Method: string;  const v1,v2: T;
                                                                            ToString   : TFunc<T,string>  );  
          class procedure Send     (                 const Method: string;  const a    : array of const   );  
          class procedure Send<T>  (                 const Method: string;  const a    : array of T;
                                                                            const cnt  : integer;
                                                                            ToString   : TFunc<T,string>  );  
          class procedure Send     (                 const Method: string;  const b    : TBytes;
                                                                            cnt        : integer          );  
          class procedure Send     (                 const Method: string;  const sl   : TStringList;
                                                                            const cnt  : integer          );  
          class procedure Send     (                 const Method: string;  const sl   : TStringList;
                                                                            const cnt  : integer;
                                                                            ObjToString: TFunc<NativeInt,string>
                                                                                                          );  
          class procedure Send<T>  (                 const Method: string;  const l    : TList;
                                                                            const cnt  : integer;
                                                                            ToString   : TFunc<T,string>  );  
          class procedure Send<T>  (                 const Method: string;  const l    : TList<T>;
                                                                            const cnt  : integer;
                                                                            ToString   : TFunc<T,string>  );  
          class procedure Send<K,V>(                 const Method: string;  const d    : TDictionary<K,V>;
                                                                            const cnt  : integer;
                                                                            ToString   : TFunc<K,V,string>);  

{ ----------- Send( TClass/TObject, Method ) ----------------------------------------------------------------------------------- }

          class procedure Send       ( Scope: TClass;  const Method: string);  
          class procedure Send       ( Scope: TObject; const Method: string);  
          // weitere overloads analog Send( Method ), siehe oben

{ ----------- Call( TClass/TObject, Method ) ----------------------------------------------------------------------------------- }

          class procedure  Call      (                 const Method: string);  
          class procedure  Call      ( Scope: TClass;  const Method: string);  
          class procedure  Call      ( Scope: TObject; const Method: string);  
          // weitere overloads analog Send( Method ), siehe oben

{ ----------- CallRet( TClass/TObject, Method ) ohne Result-Wert ------------------------------------------------------------------------------- }

          class procedure CallRet    (                 const Method: string);  
          class procedure CallRet    ( Scope: TClass;  const Method: string);  
          class procedure CallRet    ( Scope: TObject; const Method: string);  
          // weitere overloads analog Send( Method ), siehe oben

{ ----------- CallRet( TClass/TObject, Method ) mit Result-Wert ------------------------------------------------------------------- }

          class procedure CallRet    (                 const Method: string; rt: tResultType; var rp; const rs: string = '');  
          class procedure CallRet    ( Scope: TClass;  const Method: string; rt: tResultType; var rp; const rs: string = '');  
          class procedure CallRet    ( Scope: TObject; const Method: string; rt: tResultType; var rp; const rs: string = '');  
          // weitere overloads analog Send( Method ), siehe oben

{ ----------- CallRetTime( TClass/TObject, Method ) ohne Result-Wert ------------------------------------------------------------------- }

          class procedure CallRetTime(                 const Method: string);  
          class procedure CallRetTime( Scope: TClass;  const Method: string);  
          class procedure CallRetTime( Scope: TObject; const Method: string);  
          // weitere overloads analog Send( Method ), siehe oben

{ ----------- CallRetTime( TClass/TObject, Method ) mit Result-Wert ------------------------------------------------------------------- }

          class procedure CallRetTime(                 const Method: string; rt: tResultType; var rp; const rs: string = '');  
          class procedure CallRetTime( Scope: TClass;  const Method: string; rt: tResultType; var rp; const rs: string = '');  
          class procedure CallRetTime( Scope: TObject; const Method: string; rt: tResultType; var rp; const rs: string = '');  
          // weitere overloads analog Send( Method ), siehe oben

{ ------------------- Add --------------------------------------------------------------------------- }

          class procedure Add( const Comment: string );  
          // weitere overloads analog Send( Method ), siehe oben

{ -------------------- ToString -------------------------------------------------------------------------- }

          { Für Parameter "ToString()" im Send für Arrays: Exakter Typ wird gebraucht, KEIN Auto-casting hier }
          class function ToStringChar    ( const c: char     ): string; 
          class function ToStringString  ( const s: string   ): string; 
          class function ToStringInteger ( const i: integer  ): string; 
          class function ToStringInt64   ( const i: int64    ): string; 
          class function ToStringByte    ( const b: byte     ): string; 
          class function ToStringWord    ( const w: word     ): string; 
          class function ToStringCardinal( const c: cardinal ): string; 
          class function ToStringBoolean ( const b: boolean  ): string; 
          class function ToStringSingle  ( const f: single   ): string; 
          class function ToStringDouble  ( const f: double   ): string; 
          class function ToStringPointer ( const p: pointer  ): string; 
          class function ToStringPoint   ( const p: TPoint   ): string; 
          class function ToStringPointF  ( const p: TPointF  ): string; 
          class function ToStringRect    ( const r: TRect    ): string; 
          class function ToStringRectF   ( const r: TRectF   ): string; 
          class function ToStringObject  ( const o: TObject  ): string; 
        end;

end.

