Leaderboard

you should have a flag which describes if the message are coming from the mouse or from the window proc of the other splitter and if it's not the mouse, skip the feedback

Playing with ReturnAddress I discovered that it will be pretty easy to implement retrieval of name of an object's method without any RTTI or debug info. Could be useful for logging. Alas, it relies on class layout internals but that's the only way to do. Code bases on TObject.MethodAddress // Get address of currently executed code function GetCurrentAddress: Pointer; begin Result := ReturnAddress; end; // Get name of class method that contains the given address. // Note that it has to utilize some internals function GetMethodName(AClass: TClass; Address: Pointer): string; overload; type // copy declaration from System's impl section PMethRec = ^MethRec; MethRec = packed record recSize: Word; methAddr: Pointer; nameLen: Byte; { nameChars[nameLen]: AnsiChar } end; var LMethTablePtr: Pointer; LMethCount: Word; LMethEntry, LResultMethEntry: PMethRec; begin Result := ''; { Obtain the method table and count } LMethTablePtr := PPointer(PByte(AClass) + vmtMethodTable)^; if LMethTablePtr = nil then // no methods... Exit; LMethCount := PWord(LMethTablePtr)^; if LMethCount = 0 then // no methods... Exit; Inc(PWord(LMethTablePtr)); // Get all method entries and find max method entry addr that is less (or equal - very unlikely tho) than Address LMethEntry := LMethTablePtr; LResultMethEntry := nil; while LMethCount > 0 do begin // Only consider methods starting before the Address if PByte(LMethEntry.methAddr) <= PByte(Address) then begin // Not assigned yet if (LResultMethEntry = nil) or // Current entry is closer to Address, reassign the variable (PByte(LMethEntry.methAddr) > PByte(LResultMethEntry.methAddr)) then LResultMethEntry := LMethEntry; end; Dec(LMethCount); LMethEntry := Pointer(PByte(LMethEntry) + LMethEntry.recSize); // get next end; if LResultMethEntry <> nil then Result := string(PShortString(@LResultMethEntry.nameLen)^); end; // Get name of object's method that contains the given address function GetMethodName(AObject: TObject; Address: Pointer): string; overload; begin Result := GetMethodName(AObject.ClassType, Address); end; Test cases: program Project2; {$APPTYPE CONSOLE} {$R *.res} type TBaseClass = class procedure method; virtual; end; TTestClass = class(TBaseClass) procedure foo; procedure method; override; procedure method1; inline; procedure bar; class procedure classMethod; end; procedure TBaseClass.method; begin end; procedure TTestClass.method; var s: string; begin Assert(GetMethodName(Self, GetCurrentAddress) = 'method', 'override'); // do some stuff to get another address str(123, s); Assert(GetMethodName(Self, GetCurrentAddress) = 'method', 'override'); end; procedure TTestClass.foo; begin Assert(GetMethodName(Self, GetCurrentAddress) = 'foo', 'usual - 1st'); end; procedure TTestClass.bar; begin Assert(GetMethodName(Self, GetCurrentAddress) = 'bar', 'usual - last'); end; procedure TTestClass.method1; begin Assert(GetMethodName(Self, GetCurrentAddress) <> 'method1', 'inline'); end; class procedure TTestClass.classMethod; begin Assert(GetMethodName(Self, GetCurrentAddress) = 'classMethod', 'class method'); end; var cl: TTestClass; begin cl := TTestClass.Create; cl.foo; cl.method; cl.method1; // ! inlined methods won't be detected ! cl.bar; cl.classMethod; TTestClass.classMethod; Writeln('All tests OK'); readln; end.

Delphi 11.1 MMX 15.1.3 build 2530 See the text keeps overwriting the old text:

Simply move the logic into another procedure that you can pass the Sender into, eg: procedure TForm1.MoveOtherSplitterImpl(Sender: TSplitter; var aMsg: TMessage); begin if (fMovingControl = nil) or (fMovingControl = Sender) then case aMsg.Msg of WM_MOUSEFIRST..WM_MOUSELAST: begin fMovingControl := Sender; try if Sender = Splitter1 then Splitter2.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam) else if Sender = Splitter2 then Splitter1.Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam); finally fMovingControl := nil; end; end; end; end; end; procedure TForm1.MoveOtherSplitter(var aMsg: TMessage); begin MoveOtherSplitterImpl(Splitter1, aMsg); fOriginalWindowProc(aMsg); end; procedure TForm1.MoveOtherSplitter2(var aMsg: TMessage); begin MoveOtherSplitterImpl(Splitter2, aMsg); fOriginalWindowProc2(aMsg); end; If you really want something more generic, then you should link the two Splitters together, such as by their Tag properties, eg: procedure TForm1.FormCreate(Sender: TObject); begin Splitter1.Tag := NativeInt(Splitter2); fOriginalWindowProc := Splitter1.WindowProc; Splitter1.WindowProc := MoveOtherSplitter; Splitter2.Tag := NativeInt(Splitter1); fOriginalWindowProc2 := Splitter2.WindowProc; Splitter2.WindowProc := MoveOtherSplitter2; end; procedure TForm1.MoveOtherSplitterImpl(Sender: TSplitter; var aMsg: TMessage); begin if (fMovingControl = nil) or (fMovingControl = Sender) then case aMsg.Msg of WM_MOUSEFIRST..WM_MOUSELAST: begin fMovingControl := Sender; try TSplitter(Sender.Tag).Perform(aMsg.Msg, aMsg.WParam, aMsg.LParam); finally fMovingControl := nil; end; end; end; end; end; procedure TForm1.MoveOtherSplitter(var aMsg: TMessage); begin MoveOtherSplitterImpl(Splitter1, aMsg); fOriginalWindowProc(aMsg); end; procedure TForm1.MoveOtherSplitter2(var aMsg: TMessage); begin MoveOtherSplitterImpl(Splitter2, aMsg); fOriginalWindowProc2(aMsg); end;

You're right for sure, that's why I recently implemented MAP file reading and extracting all the info available for any given address. Besides some tricky aspects, that wasn't too hard. I merged that with built-in stack traces and now I have fully detailed traces with module, function name and LOC. Alas, the code requires some other my routines which are not fully ready for publishing yet (translate & add comments etc). But in case someone is interested I could try to switch to built-in routines

Let me guess. Your code looks something like this: if TryStrToDate(Edit1, theDate) then But it should be if TryStrToDate(Edit1.Text, theDate) then