Browse Source

Initial release on http://luaforge.net

Jean-Francois Goulet 19 years ago
parent
commit
2c714be7f0

BIN
LuaEdit/Bin/RunTimeDebug.exe


+ 58 - 0
LuaEdit/RunTimeDebug/Lua_Assert.pas

@@ -0,0 +1,58 @@
+//******************************************************************************
+//***                     LUA SCRIPT FUNCTIONS                               ***
+//***                                                                        ***
+//***        (c) Massimo Magnano 2005                                        ***
+//***                                                                        ***
+//***                                                                        ***
+//******************************************************************************
+//  File        : Lua_Assert.pas
+//
+//  Description : Access from Lua scripts to RunTime Debug.
+//
+//******************************************************************************
+
+unit Lua_Assert;
+
+interface
+
+uses Lua, Classes;
+
+procedure RegisterFunctions(L: Plua_State);
+
+
+implementation
+
+uses LuaUtils, RTDebug, SysUtils;
+
+function LuaRTAssert(L: Plua_State): Integer; cdecl;
+Var
+   Condition   :Boolean;
+   TrueStr,
+   FalseStr    :String;
+   NParams     :Integer;
+
+begin
+     Result := 0;
+
+     NParams := lua_gettop(L);
+     if (NParams=3)
+     then begin
+               try
+                  Condition := LuaToBoolean(L, 1);
+                  TrueStr   := LuaToString(L, 2);
+                  FalseStr  := LuaToString(L, 3);
+                  RTAssert(0, Condition, 'Lua : '+TrueStr, 'Lua : '+FalseStr, 0);
+               except
+                  On E:Exception do Result :=0;
+               end;
+          end;
+end;
+
+
+procedure RegisterFunctions(L: Plua_State);
+begin
+     LuaRegister(L, 'RTAssert', LuaRTAssert);
+end;
+
+
+end.

+ 454 - 0
LuaEdit/RunTimeDebug/MGRegistry.pas

@@ -0,0 +1,454 @@
+//******************************************************************************
+//***                   COMMON DELPHI FUNCTIONS                              ***
+//***                                                                        ***
+//***        (c) Massimo Magnano, Beppe Grimaldi 2004-2005                   ***
+//***                                                                        ***
+//***                                                                        ***
+//******************************************************************************
+//  File        : MGRegistry.pas
+//
+//  Description : Extensions on TRegistry class
+//                    Support for Read\Write Components,
+//                    TFont,
+//                    MultiLine Text
+//
+//******************************************************************************
+
+unit MGRegistry;
+
+interface
+
+{$define TYPE_INFO_1}
+
+Uses Windows, Registry, SysUtils, Classes, Graphics, TypInfo;
+
+Type
+    TRegFont = packed record
+       Name    :ShortString;
+       Size    :Byte;
+       Style   :Byte;
+       Charset :Byte;
+       Color   :TColor;
+    end;
+
+    TPersistentClasses = class of TPersistent;
+
+    TMGRegistry =class(TRegistry)
+    protected
+       function ReadWriteClass(Read :Boolean; AClass :TPersistent) :Boolean; virtual;
+    public
+       function ReadBool(Default :Boolean; const Name: string): Boolean; overload;
+       function ReadCurrency(Default :Currency; const Name: string): Currency; overload;
+       function ReadDate(Default :TDateTime; const Name: string): TDateTime; overload;
+       function ReadDateTime(Default :TDateTime; const Name: string): TDateTime; overload;
+       function ReadFloat(Default :Double; const Name: string): Double; overload;
+       function ReadInteger(Default :Integer; const Name: string): Integer; overload;
+       function ReadString(Default :string; AcceptEmpty :Boolean;  const Name: string): string; overload;
+       function ReadTime(Default :TDateTime; const Name: string): TDateTime; overload;
+       procedure ReadBinaryDataFromFile(FileName :String; var Buffer :Pointer; var BufSize :Integer);
+       procedure ReadBinaryDataFromString(theString :String; var Buffer :Pointer; var BufSize :Integer);
+       function ReadFont(const Name: string; var AFont :TFont): Boolean;
+       procedure WriteFont(const Name: string; Value :TFont);
+       function ReadClass(var AClass :TPersistent; AClasses :TPersistentClasses): Boolean;
+       function WriteClass(AClass :TPersistent): Boolean;
+       function ReadDFMClass(Name :String; AClass :TPersistent): Boolean;
+       function WriteDFMClass(Name :String; AClass :TPersistent): Boolean;
+       procedure WriteMultiLineString(Name, Value: String);
+       function ReadMultiLineString(const Name: string): string;
+    end;
+
+implementation
+
+
+type
+    TReadWritePersist = class (TComponent)
+    private
+      rData :TPersistent;
+    published
+      property Data :TPersistent read rData write rData;
+    end;
+
+function TMGRegistry.ReadBool(Default :Boolean; const Name: string): Boolean;
+begin
+     try
+        Result :=ReadBool(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadCurrency(Default :Currency; const Name: string): Currency;
+begin
+     try
+        Result :=ReadCurrency(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadDate(Default :TDateTime; const Name: string): TDateTime;
+begin
+     try
+        Result :=ReadDate(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadDateTime(Default :TDateTime; const Name: string): TDateTime;
+begin
+     try
+        Result :=ReadDateTime(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadFloat(Default :Double; const Name: string): Double;
+begin
+     try
+        Result :=ReadFloat(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadInteger(Default :Integer; const Name: string): Integer;
+begin
+     try
+        Result :=ReadInteger(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadString(Default :string; AcceptEmpty :Boolean; const Name: string): string;
+begin
+     try
+        if (ValueExists(Name))
+          then begin
+                  Result := ReadString(Name);
+                  if ((Result = '') and not AcceptEmpty)
+                    then Result := Default;
+               end
+          else Result := Default;
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+function TMGRegistry.ReadTime(Default :TDateTime; const Name: string): TDateTime;
+begin
+     try
+        Result :=ReadTime(Name);
+     except
+        On E:Exception do Result :=Default;
+     end;
+end;
+
+procedure TMGRegistry.ReadBinaryDataFromFile(FileName :String; var Buffer :Pointer; var BufSize :Integer);
+Var
+   theFile :TFileStream;
+
+begin
+     BufSize :=0;
+     Buffer :=Nil;
+     theFile :=Nil;
+     try
+        theFile :=TFileStream.Create(FileName, fmOpenRead);
+        BufSize :=theFile.Size;
+        GetMem(Buffer, BufSize);
+        theFile.Read(Buffer, BufSize);
+        theFile.Free; theFile :=Nil;
+     except
+        On E:Exception do
+        begin
+             if Buffer<>Nil then FreeMem(Buffer);
+             if theFile<>Nil then theFile.Free;
+             Buffer :=Nil;
+             BufSize :=0;
+        end;
+     end;
+end;
+
+procedure TMGRegistry.ReadBinaryDataFromString(theString :String; var Buffer :Pointer; var BufSize :Integer);
+Var
+   indexStr,
+   indexPtr :Integer;
+
+begin
+     BufSize :=Length(theString) div 2;
+     SetLength(theString, BufSize*2); //la stringa deve essere di lunghezza pari
+     GetMem(Buffer, BufSize);
+     indexStr :=1;
+     for indexPtr :=0 to BufSize-1 do
+     begin
+          PChar(Buffer)[indexPtr] :=Char(StrToInt('$'+Copy(theString, indexStr, 2)));
+          inc(indexStr, 2);
+     end;
+end;
+
+function TMGRegistry.ReadFont(const Name: string; var AFont :TFont) :Boolean;
+var
+   regFont :TRegFont;
+begin
+     Result := False;
+     try
+        if (not assigned(AFont))
+          then AFont := TFont.Create;
+        if (ValueExists(Name))
+          then if (GetDataSize(Name) = sizeOf(TRegFont))
+                 then begin
+                         ReadBinaryData(Name, regFont, sizeOf(TRegFont));
+                         AFont.Name := regFont.Name;
+                         AFont.Size := regFont.Size;
+                         AFont.Style := TFontStyles(regFont.Style);
+                         AFont.Charset := regFont.Charset;
+                         AFont.Color := regFont.Color;
+                         Result := True;
+                      end;
+     except
+        On E:Exception do begin end;
+     end;
+end;
+
+procedure TMGRegistry.WriteFont(const Name: string; Value :TFont);
+var
+   regFont :TRegFont;
+begin
+     try
+        if (Value <> Nil)
+          then begin
+                  regFont.Name := Value.Name;
+                  regFont.Size := Value.Size;
+                  regFont.Style := Byte(Value.Style);
+                  regFont.Charset := Value.Charset;
+                  regFont.Color := Value.Color;
+                  WriteBinaryData(Name, regFont, sizeOf(TRegFont));
+               end;
+     except
+        On E:Exception do begin end;
+     end;
+end;
+
+function TMGRegistry.ReadWriteClass(Read :Boolean; AClass :TPersistent) :Boolean;
+Var
+   rPropList :TPropList;
+   PropName  :String;
+   PropValue :Variant;
+   IsClass   :Boolean;
+   i         :Integer;
+
+begin
+     Result := True;
+     try
+          fillchar(rPropList, sizeof(TPropList), 0);
+          TypInfo.GetPropList(AClass.ClassInfo, tkProperties,
+                              PPropList(@rPropList));
+          i := 0;
+          while (rPropList[i] <> Nil) do
+          begin
+             try
+               {$ifdef TYPE_INFO_1}
+                 IsClass :=(rPropList[i]^.PropType^.Kind=tkClass);
+               {$else}
+                 IsClass :=(rPropList[i]^.PropType^^.Kind=tkClass);
+               {$endif}
+               PropName :=rPropList[i]^.Name;
+
+               if not(IsClass) then
+               begin
+                    if Read
+                    then begin
+                              PropValue :=Self.ReadString('', True, PropName);
+                              SetPropValue(AClass, PropName, PropValue);
+                         end
+                    else begin
+                              PropValue :=GetPropValue(AClass, PropName, True);
+                              Self.WriteString(PropName, PropValue);
+                         end;
+               end;
+             except
+                   On E:Exception do Result :=False;
+             end;
+             Inc(i);
+          end;
+     except
+        On E:Exception do Result :=False;
+     end;
+end;
+
+function TMGRegistry.ReadClass(var AClass :TPersistent; AClasses :TPersistentClasses): Boolean;
+begin
+     Result :=False;
+     try
+        if (not assigned(AClass))
+        then begin
+                  AClass := TPersistent(AClasses.Create);
+             end;
+
+        if (AClass<>Nil)
+        then Result :=ReadWriteClass(True, AClass);
+     except
+       On E:Exception do Result :=False;
+     end;
+end;
+
+function TMGRegistry.WriteClass(AClass :TPersistent):Boolean;
+begin
+     Result :=False;
+     if (AClass<>Nil)
+     then Result :=ReadWriteClass(False, AClass);
+end;
+
+function TMGRegistry.ReadDFMClass(Name :String; AClass :TPersistent): Boolean;
+Var
+   MStream,
+   MStreamTXT  :TMemoryStream;
+   xList       :TStringList;
+   toRead      :TComponent;
+
+
+begin
+  Result :=False;
+  try
+     if (AClass is TPersistent)
+     then begin
+               toRead :=TReadWritePersist.Create(Nil);
+               TReadWritePersist(toRead).Data :=AClass;
+          end
+     else toRead :=TComponent(AClass);
+
+     MStream    :=TMemoryStream.Create;
+     MStreamTXT :=TMemoryStream.Create;
+     xList   :=TStringList.Create;
+     try
+        xList.Text :=Self.ReadMultiLineString(Name);
+        xList.SaveToStream(MStreamTXT);
+        MStreamTXT.Position :=0;
+
+        ObjectTextToBinary(MStreamTXT, MStream);
+        MStream.Position :=0;
+        MStream.ReadComponent(toRead);
+        Result :=True;
+     finally
+        MStream.Free;
+        MStreamTXT.Free;
+        xList.Free;
+
+        if (toRead<>AClass)
+        then toRead.Free;
+     end;
+  except
+     On E:Exception do begin end;
+  end;
+end;
+
+function TMGRegistry.WriteDFMClass(Name :String; AClass :TPersistent): Boolean;
+Var
+   MStream,
+   MStreamTXT  :TMemoryStream;
+   xList       :TStringList;
+   toWrite     :TComponent;
+
+begin
+  Result :=False;
+  try
+     if (AClass is TPersistent)
+     then begin
+               toWrite :=TReadWritePersist.Create(Nil);
+
+               TReadWritePersist(toWrite).Data :=AClass;
+          end
+     else toWrite :=TComponent(AClass);
+
+     MStream    :=TMemoryStream.Create;
+     MStreamTXT :=TMemoryStream.Create;
+     xList   :=TStringList.Create;
+     try
+        MStream.WriteComponent(toWrite);
+        MStream.Position :=0;
+
+        ObjectBinaryToText(MStream, MStreamTXT);
+        MStreamTXT.Position :=0;
+        xList.LoadFromStream(MStreamTXT);
+        Self.WriteMultiLineString(Name, xList.Text);
+        Result :=True;
+     finally
+        MStream.Free;
+        MStreamTXT.Free;
+        xList.Free;
+
+        if (toWrite<>AClass)
+        then toWrite.Free;
+     end;
+  except
+    On E:Exception do begin end;
+  end;
+end;
+
+procedure TMGRegistry.WriteMultiLineString(Name, Value: String);
+Var
+   Buffer :PChar;
+   ch     :Char;
+   i, k   :Integer;
+
+begin
+    Buffer :=Nil;
+    try
+       GetMem(Buffer, Length(Value)+1);
+       k :=0;
+       for i :=1 to Length(Value) do
+       begin
+            ch :=Value[i];
+            case ch of
+            #13 : ch :=#0;
+            #10 : Continue;
+            end;
+            Buffer[k] :=ch;
+            inc(k);
+        end;
+
+       Buffer[k+1] :=#0;
+
+       RegSetValueEx(CurrentKey, PChar(Name), 0, REG_MULTI_SZ, Buffer, k);
+    finally
+       if (Buffer<>Nil)
+       then Freemem(Buffer);
+    end;
+end;
+
+function TMGRegistry.ReadMultiLineString(const Name: string): string;
+Var
+   Buffer  :PChar;
+   ch      :Char;
+   i       :Integer;
+   bufSize :DWord;
+   bufType :DWord;
+
+begin
+    if (RegQueryValueEx(CurrentKey, PChar(Name), Nil, @bufType, Nil, @bufSize)
+       =ERROR_SUCCESS) and (bufType=REG_MULTI_SZ)
+    then begin
+              Buffer :=Nil;
+              try
+                 GetMem(Buffer, bufSize);
+                 RegQueryValueEx(CurrentKey, PChar(Name), Nil, @bufType, PByte(Buffer), @bufSize);
+
+                 for i :=0 to bufSize-2 do
+                 begin
+                      ch :=Buffer[i];
+                      if ch=#0
+                      then Result :=Result+#13#10
+                      else Result :=Result+ch;
+                 end;
+              finally
+                 if (Buffer<>Nil)
+                 then Freemem(Buffer);
+              end;
+         end;
+end;
+
+end.
+
+

+ 135 - 0
LuaEdit/RunTimeDebug/RTDebug.pas

@@ -0,0 +1,135 @@
+
+unit RTDebug;
+
+interface
+Uses Windows, Messages, SysUtils, Classes, MGRegistry;
+
+Const
+     MG_RTD_AddReference  =WM_USER+12123;
+     MG_RTD_DelReference  =MG_RTD_AddReference+1;
+     MG_RTD_GetListHandle =MG_RTD_AddReference+2;
+
+     REG_KEY              ='\Software\MaxM_BeppeG\RTDebug\';
+     REG_LOGFILE          ='Log File';
+     REG_LOGONFILE        ='Log File Enabled';
+
+type
+    TRTDebugParameters =record
+                       processID,
+                       threadID  :DWord;
+                       Level     :Byte;
+                       theString :ShortString;
+                       StrColor  :DWord;
+                 end;
+var
+   LogFileName :String  ='';
+   LogOnFile   :Boolean =False;
+
+function RTAssert(Level :Byte; Condition :Boolean; TrueStr, FalseStr :ShortString;
+                  StrColor :DWord) :Boolean;
+
+function RTFileAssert(Filename :ShortString; Condition :Boolean; TrueStr, FalseStr :ShortString) :Boolean;
+function RTFileEmpty(Filename :ShortString) :Boolean;
+function GetLogFileName :String;
+
+implementation
+
+procedure AddLineToList(Level :Byte; theString :ShortString; StrColor :DWord);
+Var
+   pCopyData  :TCopyDataStruct;
+   WinHandle  :HWnd;
+
+begin
+     WinHandle :=FindWindow('TRTDebugMainWin', Nil);
+     if IsWindow(WinHandle) then
+     begin
+          pCopyData.cbData :=SizeOf(TRTDebugParameters);
+          GetMem(pCopyData.lpData, SizeOf(TRTDebugParameters));
+
+          TRTDebugParameters(pCopyData.lpData^).processID :=GetCurrentProcessID;
+          TRTDebugParameters(pCopyData.lpData^).ThreadID :=GetCurrentThreadID;
+          TRTDebugParameters(pCopyData.lpData^).Level :=Level;
+          TRTDebugParameters(pCopyData.lpData^).theString :=theString;
+          TRTDebugParameters(pCopyData.lpData^).StrColor :=StrColor;
+
+          SendMessage(WinHandle, WM_COPYDATA, 0, Integer(@pCopyData));
+          FreeMem(pCopyData.lpData);
+     end;
+
+end;
+
+function RTAssert(Level :Byte; Condition :Boolean; TrueStr, FalseStr :ShortString;
+                  StrColor :DWord) :Boolean;
+begin
+     Result :=Condition;
+     if Result then AddLineToList(Level, TrueStr, StrColor)
+               else AddLineToList(Level, FalseStr, StrColor);
+
+     if (LogOnFile) and (LogFilename <> '')
+     then RTFileAssert(LogFilename, Condition, TrueStr, FalseStr);
+end;
+
+function RTFileAssert(Filename :ShortString; Condition :Boolean; TrueStr, FalseStr :ShortString) :Boolean;
+Var
+   ToWrite :PChar;
+   theFile :TFileStream;
+
+begin
+     if FileExists(FileName) then theFile :=TFileStream.Create(FileName, fmOpenWrite)
+                             else theFile :=TFileStream.Create(FileName, fmCreate);
+     try
+        Result :=False;
+        theFile.Seek(0, soFromEnd);
+        if Condition
+        then ToWrite :=PChar(IntToHex(GetCurrentProcessID,8)+' '+
+                             IntToHex(GetCurrentThreadID,8)+' '+
+                             TrueStr+#13#10)
+        else ToWrite :=PChar(IntToHex(GetCurrentProcessID,8)+' '+
+                             IntToHex(GetCurrentThreadID,8)+' '+
+                             FalseStr+#13#10);
+        theFile.Write(ToWrite^, Length(ToWrite));
+        Result :=True;
+     finally
+        theFile.Free;
+     end;
+end;
+
+
+function RTFileEmpty(Filename :ShortString) :Boolean;
+Var
+   theFile :TFileStream;
+
+begin
+     theFile :=TFileStream.Create(FileName, fmCreate);
+     try
+        Result :=False;
+        theFile.Size :=0;
+        Result :=True;
+     finally
+        theFile.Free;
+     end;
+end;
+
+function GetLogFileName :String;
+Var
+   xReg :TMGRegistry;
+
+begin
+     xReg :=TMGRegistry.Create;
+     if xReg.OpenKeyReadOnly(REG_KEY)
+     then begin
+               Result :=xReg.ReadString('', true, REG_LOGFILE);
+               LogOnFile :=xReg.ReadBool(False, REG_LOGONFILE);
+          end
+
+     else begin
+               Result :='';
+               LogOnFile :=False;
+          end;
+     xReg.Free;
+end;
+
+initialization
+   LogFileName :=GetLogFileName;
+
+end.

+ 68 - 0
LuaEdit/RunTimeDebug/RTDebugOptions.dfm

@@ -0,0 +1,68 @@
+object FormOptions: TFormOptions
+  Left = 309
+  Top = 232
+  Width = 312
+  Height = 206
+  Caption = 'Run Time Debug Options...'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  OnShow = FormShow
+  PixelsPerInch = 96
+  TextHeight = 13
+  object btBrowseFile: TSpeedButton
+    Left = 264
+    Top = 56
+    Width = 23
+    Height = 22
+    Caption = '...'
+    OnClick = btBrowseFileClick
+  end
+  object edLogFilename: TLabeledEdit
+    Left = 32
+    Top = 56
+    Width = 225
+    Height = 21
+    EditLabel.Width = 88
+    EditLabel.Height = 13
+    EditLabel.Caption = 'Save Log On File :'
+    TabOrder = 0
+  end
+  object Button1: TButton
+    Left = 80
+    Top = 136
+    Width = 75
+    Height = 25
+    Caption = '&Ok'
+    ModalResult = 1
+    TabOrder = 1
+    OnClick = Button1Click
+  end
+  object Button2: TButton
+    Left = 168
+    Top = 136
+    Width = 75
+    Height = 25
+    Caption = '&Cancel'
+    ModalResult = 2
+    TabOrder = 2
+  end
+  object cbLogOnFile: TCheckBox
+    Left = 16
+    Top = 16
+    Width = 97
+    Height = 17
+    Caption = 'Log On File'
+    TabOrder = 3
+    OnClick = cbLogOnFileClick
+  end
+  object dlgSaveLog: TSaveDialog
+    Title = 'Select Log File'
+    Left = 272
+    Top = 24
+  end
+end

+ 98 - 0
LuaEdit/RunTimeDebug/RTDebugOptions.pas

@@ -0,0 +1,98 @@
+unit RTDebugOptions;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, Buttons, ExtCtrls, MGRegistry;
+
+type
+  TFormOptions = class(TForm)
+    edLogFilename: TLabeledEdit;
+    btBrowseFile: TSpeedButton;
+    Button1: TButton;
+    Button2: TButton;
+    dlgSaveLog: TSaveDialog;
+    cbLogOnFile: TCheckBox;
+    procedure btBrowseFileClick(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure cbLogOnFileClick(Sender: TObject);
+  private
+    { Private declarations }
+    procedure SaveOptions;
+    procedure LoadOptions;
+  public
+    { Public declarations }
+  end;
+
+var
+  FormOptions: TFormOptions;
+
+implementation
+
+{$R *.dfm}
+
+uses RTDebug;
+
+procedure TFormOptions.SaveOptions;
+Var
+   xReg :TMGRegistry;
+
+begin
+     xReg :=TMGRegistry.Create;
+     if xReg.OpenKey(REG_KEY, true)
+     then begin
+               xReg.WriteBool(REG_LOGONFILE, Self.cbLogOnFile.Checked);
+               xReg.WriteString(REG_LOGFILE, Self.edLogFilename.Text);
+          end;
+     xReg.Free;
+end;
+
+procedure TFormOptions.LoadOptions;
+Var
+   xReg :TMGRegistry;
+
+begin
+     xReg :=TMGRegistry.Create;
+     if xReg.OpenKeyReadOnly(REG_KEY)
+     then begin
+               Self.cbLogOnFile.Checked :=xReg.ReadBool(False, REG_LOGONFILE);
+               Self.edLogFilename.Text :=xReg.ReadString('', true, REG_LOGFILE);
+          end
+     else begin
+               Self.cbLogOnFile.Checked := False;
+               Self.edLogFilename.Text :='';
+          end;
+     cbLogOnFileClick(nil);
+     xReg.Free;
+end;
+
+procedure TFormOptions.btBrowseFileClick(Sender: TObject);
+begin
+     if dlgSaveLog.Execute then
+     begin
+          Self.edLogFilename.Text := dlgSaveLog.FileName;
+     end;
+end;
+
+procedure TFormOptions.Button1Click(Sender: TObject);
+begin
+     SaveOptions;
+end;
+
+procedure TFormOptions.FormShow(Sender: TObject);
+begin
+     LoadOptions;
+end;
+
+procedure TFormOptions.cbLogOnFileClick(Sender: TObject);
+begin
+     edLogFileName.Enabled :=cbLogOnFile.Checked;
+     btBrowseFile.Enabled :=cbLogOnFile.Checked;
+     if (edLogFileName.Enabled)
+     then edLogFileName.Color :=clWindow
+     else edLogFileName.Color :=clBtnFace;
+end;
+
+end.

BIN
LuaEdit/RunTimeDebug/RTDebugWin.dfm


+ 106 - 0
LuaEdit/RunTimeDebug/RTDebugWin.pas

@@ -0,0 +1,106 @@
+unit RTDebugWin;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  Buttons, StdCtrls, ComCtrls, ExtCtrls, RTDebug, ImgList, ToolWin;
+
+type
+  TRTDebugMainWin = class(TForm)
+    lvAssert: TListView;
+    ToolBar1: TToolBar;
+    tbLock: TToolButton;
+    tbClear: TToolButton;
+    tbOnTop: TToolButton;
+    ImageList1: TImageList;
+    ToolButton1: TToolButton;
+    tbOptions: TToolButton;
+    procedure btClearClick(Sender: TObject);
+    procedure tbLockClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure tbOnTopClick(Sender: TObject);
+    procedure tbOptionsClick(Sender: TObject);
+  protected
+    { Private declarations }
+    AcceptMsg :Boolean;
+
+    procedure MGGetListHandle(Var Msg :TMessage); message MG_RTD_GetListHandle;
+    procedure WMCopyData(var M : TMessage); message WM_COPYDATA;
+  public
+    { Public declarations }
+  end;
+
+var
+  RTDebugMainWin: TRTDebugMainWin;
+
+implementation
+
+uses RTDebugOptions;
+
+{$R *.DFM}
+
+procedure TRTDebugMainWin.btClearClick(Sender: TObject);
+begin
+     lvAssert.Clear;
+end;
+
+procedure TRTDebugMainWin.MGGetListHandle(Var Msg :TMessage);
+begin
+     Msg.Result :=lvAssert.Handle;
+end;
+
+procedure TRTDebugMainWin.WMCopyData(var M : TMessage);
+Var
+   Parametri :^TRTDebugParameters;
+   lvItem    :TListItem;
+   Spaces    :ShortString;
+
+begin
+     if AcceptMsg then
+     begin
+          Parametri :=PcopyDataStruct(M.lParam)^.lpData;
+
+          FillChar(Spaces, 255, '*');
+          Spaces[0] :=Char(Parametri.Level);
+          lvItem :=lvAssert.Items.Add;
+          lvItem.Caption :=Parametri.theString;
+          lvItem.SubItems.Add(IntToHex(Parametri.processID, 8));
+          lvItem.SubItems.Add(IntToHex(Parametri.ThreadID, 8));
+      end;
+     M.Result :=Integer(AcceptMsg);
+end;
+
+
+
+procedure TRTDebugMainWin.tbLockClick(Sender: TObject);
+begin
+     AcceptMsg :=Not(AcceptMsg);
+     if AcceptMsg then tbLock.ImageIndex :=0
+                  else tbLock.ImageIndex :=1;
+end;
+
+procedure TRTDebugMainWin.FormCreate(Sender: TObject);
+begin
+     AcceptMsg :=True;
+end;
+
+procedure TRTDebugMainWin.tbOnTopClick(Sender: TObject);
+begin
+     if tbOnTop.ImageIndex=3
+     then begin
+               Self.FormStyle :=fsNormal;
+               tbOnTop.ImageIndex :=4;
+           end
+     else begin
+               Self.FormStyle :=fsStayOnTop;
+               tbOnTop.ImageIndex :=3;
+           end;
+end;
+
+procedure TRTDebugMainWin.tbOptionsClick(Sender: TObject);
+begin
+     FormOptions.ShowModal;
+end;
+
+end.

+ 15 - 0
LuaEdit/RunTimeDebug/RunTimeDebug.dpr

@@ -0,0 +1,15 @@
+program RunTimeDebug;
+
+uses
+  Forms,
+  RTDebugWin in 'RTDebugWin.pas' {RTDebugMainWin},
+  RTDebugOptions in 'RTDebugOptions.pas' {FormOptions};
+
+{$R *.RES}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TRTDebugMainWin, RTDebugMainWin);
+  Application.CreateForm(TFormOptions, FormOptions);
+  Application.Run;
+end.

BIN
LuaEdit/RunTimeDebug/RunTimeDebug.res