From 418f1fc10f026f217b924e52b9b6a16e720279b5 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Mon, 6 Jul 2026 21:20:33 +0200 Subject: [PATCH 01/13] Add IToolsApiDebugger: source breakpoints, run/step/pause/terminate, evaluate (deferred-aware) and call stack via IOTADebuggerServices --- GDK.ToolsAPI.Debugger.Interfaces.pas | 60 ++++++ GDK.ToolsAPI.Debugger.pas | 289 +++++++++++++++++++++++++++ GDK.ToolsAPI.Helper.Interfaces.pas | 4 +- GDK.ToolsAPI.Helper.pas | 7 + 4 files changed, 359 insertions(+), 1 deletion(-) create mode 100644 GDK.ToolsAPI.Debugger.Interfaces.pas create mode 100644 GDK.ToolsAPI.Debugger.pas diff --git a/GDK.ToolsAPI.Debugger.Interfaces.pas b/GDK.ToolsAPI.Debugger.Interfaces.pas new file mode 100644 index 0000000..46162fd --- /dev/null +++ b/GDK.ToolsAPI.Debugger.Interfaces.pas @@ -0,0 +1,60 @@ +unit GDK.ToolsAPI.Debugger.Interfaces; + +interface + +uses + System.SysUtils; + +type + EToolsApiNoDebuggerServices = class(Exception); + EToolsApiEvaluateFailed = class(Exception); + + TToolsApiProcessState = (Nothing, Running, Stopping, Stopped, Fault, + ResFault, Terminated, Exception_, NoProcess); + + TToolsApiStepMode = (StepOver, StepInto, RunUntilReturn); + + TToolsApiBreakpointInfo = record + FileName: string; + LineNumber: Integer; + Enabled: Boolean; + Expression: string; + Valid: Boolean; + end; + + TToolsApiStackFrame = record + Index: Integer; + Header: string; + FileName: string; + LineNumber: Integer; + end; + + IToolsApiDebugger = interface + ['{A6A8EF47-CEC7-43BB-8F88-A0A6A12F4E47}'] + + // Breakpoints (design-time; blijven bewaard tussen debugsessies). + procedure AddBreakpoint(const FileName: string; const LineNumber: Integer); + function RemoveBreakpoint(const FileName: string; const LineNumber: Integer): Boolean; + function RemoveAllBreakpoints: Integer; + function ListBreakpoints: TArray; + + // Procesbeheer (vereist een actief debugproces). + function State: TToolsApiProcessState; + function HasProcess: Boolean; + procedure Continue; + procedure Step(const Mode: TToolsApiStepMode); + procedure Pause; + procedure Terminate; + + // Inspectie (proces moet gestopt zijn). + function Evaluate(const Expression: string): string; + function CallStack: TArray; + function CurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; + + // Verwerkt in de wachtlus openstaande debug-events (voor deferred evaluate). + procedure ProcessDebugEvents; + end; + +implementation + +end. diff --git a/GDK.ToolsAPI.Debugger.pas b/GDK.ToolsAPI.Debugger.pas new file mode 100644 index 0000000..4b6f44c --- /dev/null +++ b/GDK.ToolsAPI.Debugger.pas @@ -0,0 +1,289 @@ +unit GDK.ToolsAPI.Debugger; + +interface + +uses + ToolsAPI, + GDK.ToolsAPI.Debugger.Interfaces; + +type + TToolsApiDebugger = class(TInterfacedObject, IToolsApiDebugger) + private + const EvaluateBufferSize = 8192; + const DeferredPollCount = 200; + + function DebuggerServices: IOTADebuggerServices; + function TryDebuggerServices(out Services: IOTADebuggerServices): Boolean; + function CurrentProcess: IOTAProcess; + function CurrentThread: IOTAThread; + function FindSourceBreakpoint(const FileName: string; const LineNumber: Integer): IOTASourceBreakpoint; + function MapState(const State: TOTAProcessState): TToolsApiProcessState; + procedure RunProcess(const Mode: TOTARunMode); + public + procedure AddBreakpoint(const FileName: string; const LineNumber: Integer); + function RemoveBreakpoint(const FileName: string; const LineNumber: Integer): Boolean; + function RemoveAllBreakpoints: Integer; + function ListBreakpoints: TArray; + + function State: TToolsApiProcessState; + function HasProcess: Boolean; + procedure Continue; + procedure Step(const Mode: TToolsApiStepMode); + procedure Pause; + procedure Terminate; + + function Evaluate(const Expression: string): string; + function CallStack: TArray; + function CurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; + + procedure ProcessDebugEvents; + end; + +implementation + +uses + System.SysUtils; + +function TToolsApiDebugger.TryDebuggerServices(out Services: IOTADebuggerServices): Boolean; +begin + Result := Assigned(BorlandIDEServices) and + Supports(BorlandIDEServices, IOTADebuggerServices, Services); +end; + +function TToolsApiDebugger.DebuggerServices: IOTADebuggerServices; +begin + if not TryDebuggerServices(Result) then + raise EToolsApiNoDebuggerServices.Create('Debugger services unavailable'); +end; + +function TToolsApiDebugger.CurrentProcess: IOTAProcess; +begin + Result := DebuggerServices.CurrentProcess; +end; + +function TToolsApiDebugger.CurrentThread: IOTAThread; +begin + const Process = CurrentProcess; + if Assigned(Process) then + Result := Process.CurrentThread + else + Result := nil; +end; + +function TToolsApiDebugger.FindSourceBreakpoint(const FileName: string; const LineNumber: Integer): IOTASourceBreakpoint; +begin + Result := nil; + + const Services = DebuggerServices; + for var Index := 0 to Services.SourceBkptCount - 1 do + begin + const Breakpoint = Services.SourceBkpts[Index]; + const Matches = SameFileName(Breakpoint.FileName, FileName) and (Breakpoint.LineNumber = LineNumber); + if Matches then + Exit(Breakpoint); + end; +end; + +procedure TToolsApiDebugger.AddBreakpoint(const FileName: string; const LineNumber: Integer); +begin + const Existing = FindSourceBreakpoint(FileName, LineNumber); + if Assigned(Existing) then + Exit; + + DebuggerServices.NewSourceBreakpoint(FileName, LineNumber, nil); +end; + +function TToolsApiDebugger.RemoveBreakpoint(const FileName: string; const LineNumber: Integer): Boolean; +begin + const Existing = FindSourceBreakpoint(FileName, LineNumber); + Result := Assigned(Existing); + if Result then + DebuggerServices.RemoveBreakpoint(Existing); +end; + +function TToolsApiDebugger.RemoveAllBreakpoints: Integer; +begin + const Services = DebuggerServices; + + // Achterwaarts verwijderen: de lijst schuift op bij elke RemoveBreakpoint. + Result := Services.SourceBkptCount; + for var Index := Services.SourceBkptCount - 1 downto 0 do + Services.RemoveBreakpoint(Services.SourceBkpts[Index]); +end; + +function TToolsApiDebugger.ListBreakpoints: TArray; +begin + const Services = DebuggerServices; + + SetLength(Result, Services.SourceBkptCount); + for var Index := 0 to Services.SourceBkptCount - 1 do + begin + const Breakpoint = Services.SourceBkpts[Index]; + Result[Index].FileName := Breakpoint.FileName; + Result[Index].LineNumber := Breakpoint.LineNumber; + Result[Index].Enabled := Breakpoint.Enabled; + Result[Index].Expression := Breakpoint.Expression; + Result[Index].Valid := Breakpoint.ValidInCurrentProcess; + end; +end; + +function TToolsApiDebugger.MapState(const State: TOTAProcessState): TToolsApiProcessState; +begin + case State of + psNothing: Result := TToolsApiProcessState.Nothing; + psRunning: Result := TToolsApiProcessState.Running; + psStopping: Result := TToolsApiProcessState.Stopping; + psStopped: Result := TToolsApiProcessState.Stopped; + psFault: Result := TToolsApiProcessState.Fault; + psResFault: Result := TToolsApiProcessState.ResFault; + psTerminated: Result := TToolsApiProcessState.Terminated; + psException: Result := TToolsApiProcessState.Exception_; + else + Result := TToolsApiProcessState.NoProcess; + end; +end; + +function TToolsApiDebugger.State: TToolsApiProcessState; +var + Services: IOTADebuggerServices; +begin + if not TryDebuggerServices(Services) then + Exit(TToolsApiProcessState.NoProcess); + + const Process = Services.CurrentProcess; + if not Assigned(Process) then + Exit(TToolsApiProcessState.NoProcess); + + Result := MapState(Process.ProcessState); +end; + +function TToolsApiDebugger.HasProcess: Boolean; +var + Services: IOTADebuggerServices; +begin + Result := TryDebuggerServices(Services) and Assigned(Services.CurrentProcess); +end; + +procedure TToolsApiDebugger.RunProcess(const Mode: TOTARunMode); +begin + const Process = CurrentProcess; + if not Assigned(Process) then + Exit; + + Process.Run(Mode); +end; + +procedure TToolsApiDebugger.Continue; +begin + RunProcess(ormRun); +end; + +procedure TToolsApiDebugger.Step(const Mode: TToolsApiStepMode); +begin + case Mode of + TToolsApiStepMode.StepInto: RunProcess(ormStmtStepInto); + TToolsApiStepMode.RunUntilReturn: RunProcess(ormRunUntilReturn); + else + RunProcess(ormStmtStepOver); + end; +end; + +procedure TToolsApiDebugger.Pause; +begin + const Process = CurrentProcess; + if Assigned(Process) then + Process.Pause; +end; + +procedure TToolsApiDebugger.Terminate; +begin + const Process = CurrentProcess; + if Assigned(Process) then + Process.Terminate; +end; + +function TToolsApiDebugger.Evaluate(const Expression: string): string; +var + ResultBuffer: array[0..EvaluateBufferSize - 1] of Char; + CanModify: Boolean; + ResultAddr: LongWord; + ResultSize: LongWord; + ResultVal: LongWord; +begin + const Thread = CurrentThread; + if not Assigned(Thread) then + raise EToolsApiEvaluateFailed.Create('No stopped process to evaluate in'); + + FillChar(ResultBuffer, SizeOf(ResultBuffer), 0); + + var EvalResult := Thread.Evaluate(Expression, @ResultBuffer[0], EvaluateBufferSize, + CanModify, True, nil, ResultAddr, ResultSize, ResultVal); + + // Deferred: het evaluator moest een functie aanroepen in het proces; verwerk + // debug-events tot het resultaat binnen is (of de poging opgeeft). + var Polls := 0; + while (EvalResult = erDeferred) and (Polls < DeferredPollCount) do + begin + DebuggerServices.ProcessDebugEvents; + Inc(Polls); + + FillChar(ResultBuffer, SizeOf(ResultBuffer), 0); + EvalResult := Thread.Evaluate(Expression, @ResultBuffer[0], EvaluateBufferSize, + CanModify, True, nil, ResultAddr, ResultSize, ResultVal); + end; + + case EvalResult of + erOK: Result := ResultBuffer; + erBusy: raise EToolsApiEvaluateFailed.Create('Evaluator is busy, try again'); + erDeferred: raise EToolsApiEvaluateFailed.Create('Evaluation did not complete in time'); + else + // erError: ResultBuffer bevat de foutmelding van de evaluator. + raise EToolsApiEvaluateFailed.Create(string(ResultBuffer)); + end; +end; + +function TToolsApiDebugger.CallStack: TArray; +begin + Result := nil; + + const Thread = CurrentThread; + if not Assigned(Thread) then + Exit; + + // GetCallCount moet vóór GetCallHeader/GetCallPos; frames zijn 1-based. + const Count = Thread.GetCallCount; + SetLength(Result, Count); + + for var Index := 1 to Count do + begin + var FrameFile := ''; + var FrameLine := 0; + Thread.GetCallPos(Index, FrameFile, FrameLine); + + Result[Index - 1].Index := Index; + Result[Index - 1].Header := Thread.GetCallHeader(Index); + Result[Index - 1].FileName := FrameFile; + Result[Index - 1].LineNumber := FrameLine; + end; +end; + +function TToolsApiDebugger.CurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; +begin + FileName := ''; + LineNumber := 0; + + const Thread = CurrentThread; + if not Assigned(Thread) then + Exit(False); + + FileName := Thread.GetCurrentFile; + LineNumber := Integer(Thread.GetCurrentLine); + Result := (FileName <> ''); +end; + +procedure TToolsApiDebugger.ProcessDebugEvents; +begin + DebuggerServices.ProcessDebugEvents; +end; + +end. diff --git a/GDK.ToolsAPI.Helper.Interfaces.pas b/GDK.ToolsAPI.Helper.Interfaces.pas index 324e78e..3f848af 100644 --- a/GDK.ToolsAPI.Helper.Interfaces.pas +++ b/GDK.ToolsAPI.Helper.Interfaces.pas @@ -6,7 +6,8 @@ interface ToolsAPI, System.Classes, System.SysUtils, - GDK.ToolsAPI.CustomMessage; + GDK.ToolsAPI.CustomMessage, + GDK.ToolsAPI.Debugger.Interfaces; type IToolsApiHelper = interface; @@ -63,6 +64,7 @@ EToolsApiModuleOutOfSync = class(Exception); function BuildConfigurations: IToolsApiBuildConfigurations; function EnvironmentOptions: IToolsApiEnvironmentOptions; + function Debugger: IToolsApiDebugger; function EditView: IToolsApiEditView; end; diff --git a/GDK.ToolsAPI.Helper.pas b/GDK.ToolsAPI.Helper.pas index caafdb9..144c623 100644 --- a/GDK.ToolsAPI.Helper.pas +++ b/GDK.ToolsAPI.Helper.pas @@ -25,6 +25,7 @@ TToolsApiHelper = class(TInterfacedObject, IToolsApiHelper) function BuildConfigurations: IToolsApiBuildConfigurations; function EnvironmentOptions: IToolsApiEnvironmentOptions; + function Debugger: IToolsApiDebugger; function ModuleCount: Integer; function Module: IToolsApiModule; overload; @@ -200,6 +201,7 @@ implementation System.Classes, System.IOUtils, DCCStrs, + GDK.ToolsAPI.Debugger, GDK.ToolsAPI.FormCreator, GDK.ToolsAPI.FormEditor, GDK.ToolsAPI.ProjectManagerContextMenu, @@ -284,6 +286,11 @@ function TToolsApiHelper.EnvironmentOptions: IToolsApiEnvironmentOptions; Result := TToolsApiEnvironmentOptions.Create; end; +function TToolsApiHelper.Debugger: IToolsApiDebugger; +begin + Result := TToolsApiDebugger.Create; +end; + function TToolsApiHelper.EditorReader: IToolsApiEditReader; begin Result := Self.SourceEditor.Reader; From dcab94eacbc24cb89e3abf667287e95849a45c5b Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Mon, 6 Jul 2026 21:26:30 +0200 Subject: [PATCH 02/13] Helper: expose Debugger.Interfaces in the interface uses so IToolsApiDebugger resolves --- GDK.ToolsAPI.Helper.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/GDK.ToolsAPI.Helper.pas b/GDK.ToolsAPI.Helper.pas index 144c623..af27b68 100644 --- a/GDK.ToolsAPI.Helper.pas +++ b/GDK.ToolsAPI.Helper.pas @@ -5,6 +5,7 @@ interface uses ToolsAPI, GDK.ToolsAPI.Helper.Interfaces, + GDK.ToolsAPI.Debugger.Interfaces, System.SysUtils, GDK.ToolsAPI.CustomMessage; From 90246f81083c43c49ee5a49772e5d7b0dc941f96 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Mon, 6 Jul 2026 22:01:35 +0200 Subject: [PATCH 03/13] FormEditor: capture native container before create (stable parent for tabs/pages), reject non-TWinControl containers, and CaptureImage (PNG via TCustomForm.GetFormImage) --- GDK.ToolsAPI.FormEditor.pas | 54 ++++++++++++++++++++++++++---- GDK.ToolsAPI.Helper.Interfaces.pas | 3 ++ 2 files changed, 51 insertions(+), 6 deletions(-) diff --git a/GDK.ToolsAPI.FormEditor.pas b/GDK.ToolsAPI.FormEditor.pas index f30b628..b0ab6a9 100644 --- a/GDK.ToolsAPI.FormEditor.pas +++ b/GDK.ToolsAPI.FormEditor.pas @@ -4,6 +4,7 @@ interface uses System.Classes, + System.SysUtils, System.TypInfo, ToolsAPI, GDK.ToolsAPI.Helper.Interfaces; @@ -36,6 +37,8 @@ TToolsApiFormEditor = class(TInterfacedObject, IToolsApiFormEditor) const PropertyPath: string; const Value: string); + function CaptureImage: TBytes; + procedure ShowDesigner; procedure MarkModified; end; @@ -45,7 +48,9 @@ implementation uses System.SysUtils, Vcl.Controls, + Vcl.Forms, Vcl.Graphics, + Vcl.Imaging.pngimage, DesignIntf; constructor TToolsApiFormEditor.Create(const Editor: IOTAFormEditor); @@ -111,6 +116,17 @@ function TToolsApiFormEditor.AddComponent(const TypeName: string; raise EToolsApiComponentNotFound.CreateFmt('Container "%s" not found', [ContainerName]); end; + // Capture the native container BEFORE creating: the ToolsAPI warns that an + // IOTAComponent handle may become invalid after the form is mutated, so + // resolving it afterwards can yield a stale/wrong parent (RSP-quirk that + // lands controls on the active page instead of the requested container). + const NativeContainer = NativeComponent(Container); + const RequestedNamedContainer = not ContainerName.IsEmpty; + if RequestedNamedContainer and (not (NativeContainer is TWinControl)) then + raise EToolsApiComponentNotFound.CreateFmt( + 'Container "%s" (%s) cannot host controls; a parent must be a TWinControl (form, panel, tab sheet, group box)', + [ContainerName, NativeContainer.ClassName]); + const Created = FEditor.CreateComponent(Container, TypeName, Left, Top, Width, Height); if not Assigned(Created) then raise EToolsApiComponentNotCreated.CreateFmt( @@ -122,12 +138,11 @@ function TToolsApiFormEditor.AddComponent(const TypeName: string; begin const Control = TControl(Result); - // CreateComponent parents a new control to the active page of a - // PageControl (or another active container) instead of the requested one; - // force the parent so the control lands on exactly the named container. - const ContainerControl = NativeComponent(Container); - if (ContainerControl is TWinControl) and (Control.Parent <> ContainerControl) then - Control.Parent := TWinControl(ContainerControl); + // Force the parent to the exact named container (using the reference we + // captured before creating), so the control lands on the right tab/page + // rather than the currently active one. + if (NativeContainer is TWinControl) and (Control.Parent <> NativeContainer) then + Control.Parent := TWinControl(NativeContainer); // Setting Parent resets the position, so apply the bounds afterwards. Control.Left := Left; @@ -277,6 +292,33 @@ function TToolsApiFormEditor.AssignedEvents(const Component: TComponent): TArray end; end; +function TToolsApiFormEditor.CaptureImage: TBytes; +begin + const RootComponent = Root; + if not (RootComponent is TCustomForm) then + raise EToolsApiComponentNotFound.CreateFmt('%s is not a form and cannot be captured', [RootComponent.ClassName]); + + const Bitmap = TCustomForm(RootComponent).GetFormImage; + try + const Png = TPngImage.Create; + try + Png.Assign(Bitmap); + + const Stream = TBytesStream.Create; + try + Png.SaveToStream(Stream); + Result := Copy(Stream.Bytes, 0, Stream.Size); + finally + Stream.Free; + end; + finally + Png.Free; + end; + finally + Bitmap.Free; + end; +end; + procedure TToolsApiFormEditor.ShowDesigner; begin FEditor.Show; diff --git a/GDK.ToolsAPI.Helper.Interfaces.pas b/GDK.ToolsAPI.Helper.Interfaces.pas index 3f848af..aa818e3 100644 --- a/GDK.ToolsAPI.Helper.Interfaces.pas +++ b/GDK.ToolsAPI.Helper.Interfaces.pas @@ -204,6 +204,9 @@ EToolsApiModuleOutOfSync = class(Exception); const PropertyPath: string; const Value: string); + // Renders the designed form to a PNG (TCustomForm.GetFormImage). + function CaptureImage: TBytes; + procedure ShowDesigner; procedure MarkModified; end; From bc824069f33c02b7f955b7d96345d71be61e5920 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Mon, 6 Jul 2026 22:23:10 +0200 Subject: [PATCH 04/13] FormEditor: remove duplicate System.SysUtils from implementation uses (now in interface) --- GDK.ToolsAPI.FormEditor.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/GDK.ToolsAPI.FormEditor.pas b/GDK.ToolsAPI.FormEditor.pas index b0ab6a9..be73557 100644 --- a/GDK.ToolsAPI.FormEditor.pas +++ b/GDK.ToolsAPI.FormEditor.pas @@ -46,7 +46,6 @@ TToolsApiFormEditor = class(TInterfacedObject, IToolsApiFormEditor) implementation uses - System.SysUtils, Vcl.Controls, Vcl.Forms, Vcl.Graphics, From 39e8aec9d6439c0a5d7b77a14bdc7e80cc27624b Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Mon, 6 Jul 2026 22:37:04 +0200 Subject: [PATCH 05/13] Add IToolsApiUiAutomation: drive a running app via MS UI Automation (find window, list/find elements by AutomationId or Name, click via InvokePattern, set/get text via ValuePattern) --- GDK.ToolsAPI.Helper.Interfaces.pas | 4 +- GDK.ToolsAPI.Helper.pas | 8 + GDK.ToolsAPI.UiAutomation.Interfaces.pas | 43 ++++ GDK.ToolsAPI.UiAutomation.pas | 280 +++++++++++++++++++++++ 4 files changed, 334 insertions(+), 1 deletion(-) create mode 100644 GDK.ToolsAPI.UiAutomation.Interfaces.pas create mode 100644 GDK.ToolsAPI.UiAutomation.pas diff --git a/GDK.ToolsAPI.Helper.Interfaces.pas b/GDK.ToolsAPI.Helper.Interfaces.pas index aa818e3..b0e709f 100644 --- a/GDK.ToolsAPI.Helper.Interfaces.pas +++ b/GDK.ToolsAPI.Helper.Interfaces.pas @@ -7,7 +7,8 @@ interface System.Classes, System.SysUtils, GDK.ToolsAPI.CustomMessage, - GDK.ToolsAPI.Debugger.Interfaces; + GDK.ToolsAPI.Debugger.Interfaces, + GDK.ToolsAPI.UiAutomation.Interfaces; type IToolsApiHelper = interface; @@ -65,6 +66,7 @@ EToolsApiModuleOutOfSync = class(Exception); function BuildConfigurations: IToolsApiBuildConfigurations; function EnvironmentOptions: IToolsApiEnvironmentOptions; function Debugger: IToolsApiDebugger; + function UiAutomation: IToolsApiUiAutomation; function EditView: IToolsApiEditView; end; diff --git a/GDK.ToolsAPI.Helper.pas b/GDK.ToolsAPI.Helper.pas index af27b68..b572852 100644 --- a/GDK.ToolsAPI.Helper.pas +++ b/GDK.ToolsAPI.Helper.pas @@ -6,6 +6,7 @@ interface ToolsAPI, GDK.ToolsAPI.Helper.Interfaces, GDK.ToolsAPI.Debugger.Interfaces, + GDK.ToolsAPI.UiAutomation.Interfaces, System.SysUtils, GDK.ToolsAPI.CustomMessage; @@ -27,6 +28,7 @@ TToolsApiHelper = class(TInterfacedObject, IToolsApiHelper) function BuildConfigurations: IToolsApiBuildConfigurations; function EnvironmentOptions: IToolsApiEnvironmentOptions; function Debugger: IToolsApiDebugger; + function UiAutomation: IToolsApiUiAutomation; function ModuleCount: Integer; function Module: IToolsApiModule; overload; @@ -203,6 +205,7 @@ implementation System.IOUtils, DCCStrs, GDK.ToolsAPI.Debugger, + GDK.ToolsAPI.UiAutomation, GDK.ToolsAPI.FormCreator, GDK.ToolsAPI.FormEditor, GDK.ToolsAPI.ProjectManagerContextMenu, @@ -292,6 +295,11 @@ function TToolsApiHelper.Debugger: IToolsApiDebugger; Result := TToolsApiDebugger.Create; end; +function TToolsApiHelper.UiAutomation: IToolsApiUiAutomation; +begin + Result := TToolsApiUiAutomation.Create; +end; + function TToolsApiHelper.EditorReader: IToolsApiEditReader; begin Result := Self.SourceEditor.Reader; diff --git a/GDK.ToolsAPI.UiAutomation.Interfaces.pas b/GDK.ToolsAPI.UiAutomation.Interfaces.pas new file mode 100644 index 0000000..994c9a4 --- /dev/null +++ b/GDK.ToolsAPI.UiAutomation.Interfaces.pas @@ -0,0 +1,43 @@ +unit GDK.ToolsAPI.UiAutomation.Interfaces; + +interface + +uses + Winapi.Windows, + System.SysUtils; + +type + EToolsApiUiAutomation = class(Exception); + EToolsApiWindowNotFound = class(EToolsApiUiAutomation); + EToolsApiElementNotFound = class(EToolsApiUiAutomation); + EToolsApiPatternNotSupported = class(EToolsApiUiAutomation); + + TToolsApiUiElement = record + Name: string; + AutomationId: string; + ControlType: string; + ClassName: string; + Value: string; + HasValue: Boolean; + end; + + // Drives a running VCL application from the outside through Microsoft UI + // Automation. Elements are addressed by AutomationId (the VCL control Name in + // RAD Studio 13+) with a fallback to the Name/caption. + IToolsApiUiAutomation = interface + ['{AE8FF869-528F-4DCA-BC49-05982D6B0973}'] + + // Top-level window whose title contains WindowTitle; raises when absent. + function FindWindow(const WindowTitle: string): HWND; + + function ListElements(const Window: HWND): TArray; + function GetElement(const Window: HWND; const Identifier: string): TToolsApiUiElement; + + procedure Click(const Window: HWND; const Identifier: string); + procedure SetText(const Window: HWND; const Identifier: string; const Text: string); + function GetText(const Window: HWND; const Identifier: string): string; + end; + +implementation + +end. diff --git a/GDK.ToolsAPI.UiAutomation.pas b/GDK.ToolsAPI.UiAutomation.pas new file mode 100644 index 0000000..6a24c57 --- /dev/null +++ b/GDK.ToolsAPI.UiAutomation.pas @@ -0,0 +1,280 @@ +unit GDK.ToolsAPI.UiAutomation; + +interface + +uses + Winapi.Windows, + Winapi.UIAutomation, + GDK.ToolsAPI.UiAutomation.Interfaces; + +type + TToolsApiUiAutomation = class(TInterfacedObject, IToolsApiUiAutomation) + private + FAutomation: IUIAutomation; + + function Automation: IUIAutomation; + function RootElement(const Window: HWND): IUIAutomationElement; + function DescribeElement(const Element: IUIAutomationElement): TToolsApiUiElement; + function FindByIdentifier(const Window: HWND; const Identifier: string): IUIAutomationElement; + function StringProperty(const Element: IUIAutomationElement; const PropertyId: Integer): string; + function ControlTypeName(const ControlTypeId: Integer): string; + function TryValuePattern(const Element: IUIAutomationElement; out Pattern: IUIAutomationValuePattern): Boolean; + function TryInvokePattern(const Element: IUIAutomationElement; out Pattern: IUIAutomationInvokePattern): Boolean; + public + function FindWindow(const WindowTitle: string): HWND; + function ListElements(const Window: HWND): TArray; + function GetElement(const Window: HWND; const Identifier: string): TToolsApiUiElement; + procedure Click(const Window: HWND; const Identifier: string); + procedure SetText(const Window: HWND; const Identifier: string; const Text: string); + function GetText(const Window: HWND; const Identifier: string): string; + end; + +implementation + +uses + System.SysUtils, + System.Variants, + Winapi.ActiveX; + +type + TWindowSearch = record + TitlePart: string; + Found: HWND; + end; + PWindowSearch = ^TWindowSearch; + +function EnumWindowsProc(Handle: HWND; Param: LPARAM): BOOL; stdcall; +var + Search: PWindowSearch; + Buffer: array[0..511] of Char; + Title: string; +begin + Result := True; + + if not IsWindowVisible(Handle) then + Exit; + + const Length = GetWindowText(Handle, Buffer, System.Length(Buffer)); + if Length <= 0 then + Exit; + + SetString(Title, Buffer, Length); + + Search := PWindowSearch(Param); + if Title.ToLower.Contains(Search.TitlePart.ToLower) then + begin + Search.Found := Handle; + Result := False; + end; +end; + +function TToolsApiUiAutomation.Automation: IUIAutomation; +begin + if not Assigned(FAutomation) then + begin + const HResult = CoCreateInstance(CLSID_CUIAutomation, nil, CLSCTX_INPROC_SERVER, + IUIAutomation, FAutomation); + if Failed(HResult) then + raise EToolsApiUiAutomation.CreateFmt('Could not create the UI Automation client (0x%x)', [HResult]); + end; + + Result := FAutomation; +end; + +function TToolsApiUiAutomation.FindWindow(const WindowTitle: string): HWND; +var + Search: TWindowSearch; +begin + Search.TitlePart := WindowTitle; + Search.Found := 0; + + EnumWindows(@EnumWindowsProc, LPARAM(@Search)); + + if Search.Found = 0 then + raise EToolsApiWindowNotFound.CreateFmt('No visible window with a title containing "%s"', [WindowTitle]); + + Result := Search.Found; +end; + +function TToolsApiUiAutomation.RootElement(const Window: HWND): IUIAutomationElement; +begin + const HResult = Automation.ElementFromHandle(Window, Result); + if Failed(HResult) or (not Assigned(Result)) then + raise EToolsApiWindowNotFound.Create('The window is not accessible through UI Automation'); +end; + +function TToolsApiUiAutomation.StringProperty(const Element: IUIAutomationElement; const PropertyId: Integer): string; +var + Value: OleVariant; +begin + Result := ''; + if Succeeded(Element.GetCurrentPropertyValue(PropertyId, Value)) and (not VarIsNull(Value)) and (not VarIsEmpty(Value)) then + Result := VarToStr(Value); +end; + +function TToolsApiUiAutomation.ControlTypeName(const ControlTypeId: Integer): string; +begin + // Alleen de gangbare typen; overige worden als het numerieke id getoond. + case ControlTypeId of + UIA_ButtonControlTypeId: Result := 'Button'; + UIA_EditControlTypeId: Result := 'Edit'; + UIA_TextControlTypeId: Result := 'Text'; + UIA_CheckBoxControlTypeId: Result := 'CheckBox'; + UIA_ComboBoxControlTypeId: Result := 'ComboBox'; + UIA_ListControlTypeId: Result := 'List'; + UIA_ListItemControlTypeId: Result := 'ListItem'; + UIA_TabControlTypeId: Result := 'Tab'; + UIA_TabItemControlTypeId: Result := 'TabItem'; + UIA_TreeControlTypeId: Result := 'Tree'; + UIA_DataGridControlTypeId: Result := 'DataGrid'; + UIA_TableControlTypeId: Result := 'Table'; + UIA_PaneControlTypeId: Result := 'Pane'; + UIA_WindowControlTypeId: Result := 'Window'; + UIA_GroupControlTypeId: Result := 'Group'; + UIA_MenuItemControlTypeId: Result := 'MenuItem'; + UIA_RadioButtonControlTypeId: Result := 'RadioButton'; + else + Result := IntToStr(ControlTypeId); + end; +end; + +function TToolsApiUiAutomation.TryValuePattern(const Element: IUIAutomationElement; out Pattern: IUIAutomationValuePattern): Boolean; +var + Unknown: IInterface; +begin + Pattern := nil; + Result := Succeeded(Element.GetCurrentPattern(UIA_ValuePatternId, Unknown)) and + Assigned(Unknown) and Supports(Unknown, IUIAutomationValuePattern, Pattern); +end; + +function TToolsApiUiAutomation.TryInvokePattern(const Element: IUIAutomationElement; out Pattern: IUIAutomationInvokePattern): Boolean; +var + Unknown: IInterface; +begin + Pattern := nil; + Result := Succeeded(Element.GetCurrentPattern(UIA_InvokePatternId, Unknown)) and + Assigned(Unknown) and Supports(Unknown, IUIAutomationInvokePattern, Pattern); +end; + +function TToolsApiUiAutomation.DescribeElement(const Element: IUIAutomationElement): TToolsApiUiElement; +var + ControlType: OleVariant; + ValuePattern: IUIAutomationValuePattern; + CurrentValue: PChar; +begin + Result := Default(TToolsApiUiElement); + Result.Name := StringProperty(Element, UIA_NamePropertyId); + Result.AutomationId := StringProperty(Element, UIA_AutomationIdPropertyId); + Result.ClassName := StringProperty(Element, UIA_ClassNamePropertyId); + + if Succeeded(Element.GetCurrentPropertyValue(UIA_ControlTypePropertyId, ControlType)) and (not VarIsNull(ControlType)) then + Result.ControlType := ControlTypeName(ControlType); + + if TryValuePattern(Element, ValuePattern) and Succeeded(ValuePattern.get_CurrentValue(CurrentValue)) then + begin + Result.Value := CurrentValue; + Result.HasValue := True; + end; +end; + +function TToolsApiUiAutomation.ListElements(const Window: HWND): TArray; +var + Condition: IUIAutomationCondition; + Elements: IUIAutomationElementArray; + Element: IUIAutomationElement; + Count: Integer; +begin + Result := nil; + + const Root = RootElement(Window); + + if Failed(Automation.CreateTrueCondition(Condition)) then + Exit; + + if Failed(Root.FindAll(TreeScope_Descendants, Condition, Elements)) or (not Assigned(Elements)) then + Exit; + + if Failed(Elements.get_Length(Count)) then + Exit; + + for var Index := 0 to Count - 1 do + begin + if Failed(Elements.GetElement(Index, Element)) or (not Assigned(Element)) then + Continue; + + const Described = DescribeElement(Element); + + // Elementen zonder naam en zonder automation-id zijn voor besturing + // onbruikbaar; laat ze weg om de lijst leesbaar te houden. + const IsAddressable = (Described.AutomationId <> '') or (Described.Name <> ''); + if IsAddressable then + Result := Result + [Described]; + end; +end; + +function TToolsApiUiAutomation.FindByIdentifier(const Window: HWND; const Identifier: string): IUIAutomationElement; +var + Condition: IUIAutomationCondition; +begin + const Root = RootElement(Window); + + // Eerst op AutomationId (de VCL-control-Name), dan op Name/caption. + if Succeeded(Automation.CreatePropertyCondition(UIA_AutomationIdPropertyId, Identifier, Condition)) and + Succeeded(Root.FindFirst(TreeScope_Descendants, Condition, Result)) and Assigned(Result) then + Exit; + + if Succeeded(Automation.CreatePropertyCondition(UIA_NamePropertyId, Identifier, Condition)) and + Succeeded(Root.FindFirst(TreeScope_Descendants, Condition, Result)) and Assigned(Result) then + Exit; + + raise EToolsApiElementNotFound.CreateFmt('No control with AutomationId or Name "%s" in the window', [Identifier]); +end; + +function TToolsApiUiAutomation.GetElement(const Window: HWND; const Identifier: string): TToolsApiUiElement; +begin + Result := DescribeElement(FindByIdentifier(Window, Identifier)); +end; + +procedure TToolsApiUiAutomation.Click(const Window: HWND; const Identifier: string); +var + InvokePattern: IUIAutomationInvokePattern; +begin + const Element = FindByIdentifier(Window, Identifier); + + if not TryInvokePattern(Element, InvokePattern) then + raise EToolsApiPatternNotSupported.CreateFmt('"%s" cannot be invoked (no Invoke pattern)', [Identifier]); + + Element.SetFocus; + if Failed(InvokePattern.Invoke) then + raise EToolsApiUiAutomation.CreateFmt('Invoke on "%s" failed', [Identifier]); +end; + +procedure TToolsApiUiAutomation.SetText(const Window: HWND; const Identifier: string; const Text: string); +var + ValuePattern: IUIAutomationValuePattern; +begin + const Element = FindByIdentifier(Window, Identifier); + + if not TryValuePattern(Element, ValuePattern) then + raise EToolsApiPatternNotSupported.CreateFmt('"%s" does not support text input (no Value pattern)', [Identifier]); + + Element.SetFocus; + if Failed(ValuePattern.SetValue(PChar(Text))) then + raise EToolsApiUiAutomation.CreateFmt('Setting the value of "%s" failed', [Identifier]); +end; + +function TToolsApiUiAutomation.GetText(const Window: HWND; const Identifier: string): string; +var + ValuePattern: IUIAutomationValuePattern; + CurrentValue: PChar; +begin + const Element = FindByIdentifier(Window, Identifier); + + if TryValuePattern(Element, ValuePattern) and Succeeded(ValuePattern.get_CurrentValue(CurrentValue)) then + Exit(CurrentValue); + + // Geen Value-pattern: val terug op de Name/caption (bv. voor labels/knoppen). + Result := StringProperty(Element, UIA_NamePropertyId); +end; + +end. From 44a8495e6889afc0d9effa2a0a06af5cd862d194 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Tue, 7 Jul 2026 09:20:41 +0200 Subject: [PATCH 06/13] FormEditor.SetComponentProperty: support component-reference (tkClass) properties like ActivePage/DataSource/Images by referenced component Name --- GDK.ToolsAPI.FormEditor.pas | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/GDK.ToolsAPI.FormEditor.pas b/GDK.ToolsAPI.FormEditor.pas index be73557..908d5c0 100644 --- a/GDK.ToolsAPI.FormEditor.pas +++ b/GDK.ToolsAPI.FormEditor.pas @@ -17,6 +17,7 @@ TToolsApiFormEditor = class(TInterfacedObject, IToolsApiFormEditor) function NativeComponent(const Component: IOTAComponent): TComponent; procedure SetPropertyValue(const Instance: TObject; const PropertyPath: string; const Value: string); procedure SetEventHandler(const Instance: TObject; const Info: PPropInfo; const MethodName: string); + procedure SetComponentReference(const Instance: TObject; const Info: PPropInfo; const ComponentName: string); public constructor Create(const Editor: IOTAFormEditor); @@ -212,11 +213,32 @@ procedure TToolsApiFormEditor.SetPropertyValue(const Instance: TObject; SetSetProp(Current, Info, Value); tkMethod: SetEventHandler(Current, Info, Value); + tkClass: + SetComponentReference(Current, Info, Value); else raise EToolsApiPropertyNotSupported.CreateFmt('Property "%s" has an unsupported type', [PropertyName]); end; end; +procedure TToolsApiFormEditor.SetComponentReference(const Instance: TObject; + const Info: PPropInfo; + const ComponentName: string); +begin + // Component-referentie-properties (ActivePage, DataSource, Images, PopupMenu, + // ...) worden gezet met de NAAM van het component; leeg betekent nil. + if ComponentName.IsEmpty then + begin + SetObjectProp(Instance, Info, nil); + Exit; + end; + + const Referenced = NativeComponent(FEditor.FindComponent(ComponentName)); + if not Assigned(Referenced) then + raise EToolsApiComponentNotFound.CreateFmt('Referenced component "%s" not found on the form', [ComponentName]); + + SetObjectProp(Instance, Info, Referenced); +end; + procedure TToolsApiFormEditor.SetEventHandler(const Instance: TObject; const Info: PPropInfo; const MethodName: string); From 0a4b83d8e81c92b1002508543609775273561f41 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Tue, 7 Jul 2026 09:27:38 +0200 Subject: [PATCH 07/13] Move UI Automation out of the helper: it wraps Winapi.UIAutomation (driving external apps), not the RAD Studio OTA, so it belongs in the consumer, not this OTA helper --- GDK.ToolsAPI.Helper.Interfaces.pas | 4 +- GDK.ToolsAPI.Helper.pas | 8 - GDK.ToolsAPI.UiAutomation.Interfaces.pas | 43 ---- GDK.ToolsAPI.UiAutomation.pas | 280 ----------------------- 4 files changed, 1 insertion(+), 334 deletions(-) delete mode 100644 GDK.ToolsAPI.UiAutomation.Interfaces.pas delete mode 100644 GDK.ToolsAPI.UiAutomation.pas diff --git a/GDK.ToolsAPI.Helper.Interfaces.pas b/GDK.ToolsAPI.Helper.Interfaces.pas index b0e709f..aa818e3 100644 --- a/GDK.ToolsAPI.Helper.Interfaces.pas +++ b/GDK.ToolsAPI.Helper.Interfaces.pas @@ -7,8 +7,7 @@ interface System.Classes, System.SysUtils, GDK.ToolsAPI.CustomMessage, - GDK.ToolsAPI.Debugger.Interfaces, - GDK.ToolsAPI.UiAutomation.Interfaces; + GDK.ToolsAPI.Debugger.Interfaces; type IToolsApiHelper = interface; @@ -66,7 +65,6 @@ EToolsApiModuleOutOfSync = class(Exception); function BuildConfigurations: IToolsApiBuildConfigurations; function EnvironmentOptions: IToolsApiEnvironmentOptions; function Debugger: IToolsApiDebugger; - function UiAutomation: IToolsApiUiAutomation; function EditView: IToolsApiEditView; end; diff --git a/GDK.ToolsAPI.Helper.pas b/GDK.ToolsAPI.Helper.pas index b572852..af27b68 100644 --- a/GDK.ToolsAPI.Helper.pas +++ b/GDK.ToolsAPI.Helper.pas @@ -6,7 +6,6 @@ interface ToolsAPI, GDK.ToolsAPI.Helper.Interfaces, GDK.ToolsAPI.Debugger.Interfaces, - GDK.ToolsAPI.UiAutomation.Interfaces, System.SysUtils, GDK.ToolsAPI.CustomMessage; @@ -28,7 +27,6 @@ TToolsApiHelper = class(TInterfacedObject, IToolsApiHelper) function BuildConfigurations: IToolsApiBuildConfigurations; function EnvironmentOptions: IToolsApiEnvironmentOptions; function Debugger: IToolsApiDebugger; - function UiAutomation: IToolsApiUiAutomation; function ModuleCount: Integer; function Module: IToolsApiModule; overload; @@ -205,7 +203,6 @@ implementation System.IOUtils, DCCStrs, GDK.ToolsAPI.Debugger, - GDK.ToolsAPI.UiAutomation, GDK.ToolsAPI.FormCreator, GDK.ToolsAPI.FormEditor, GDK.ToolsAPI.ProjectManagerContextMenu, @@ -295,11 +292,6 @@ function TToolsApiHelper.Debugger: IToolsApiDebugger; Result := TToolsApiDebugger.Create; end; -function TToolsApiHelper.UiAutomation: IToolsApiUiAutomation; -begin - Result := TToolsApiUiAutomation.Create; -end; - function TToolsApiHelper.EditorReader: IToolsApiEditReader; begin Result := Self.SourceEditor.Reader; diff --git a/GDK.ToolsAPI.UiAutomation.Interfaces.pas b/GDK.ToolsAPI.UiAutomation.Interfaces.pas deleted file mode 100644 index 994c9a4..0000000 --- a/GDK.ToolsAPI.UiAutomation.Interfaces.pas +++ /dev/null @@ -1,43 +0,0 @@ -unit GDK.ToolsAPI.UiAutomation.Interfaces; - -interface - -uses - Winapi.Windows, - System.SysUtils; - -type - EToolsApiUiAutomation = class(Exception); - EToolsApiWindowNotFound = class(EToolsApiUiAutomation); - EToolsApiElementNotFound = class(EToolsApiUiAutomation); - EToolsApiPatternNotSupported = class(EToolsApiUiAutomation); - - TToolsApiUiElement = record - Name: string; - AutomationId: string; - ControlType: string; - ClassName: string; - Value: string; - HasValue: Boolean; - end; - - // Drives a running VCL application from the outside through Microsoft UI - // Automation. Elements are addressed by AutomationId (the VCL control Name in - // RAD Studio 13+) with a fallback to the Name/caption. - IToolsApiUiAutomation = interface - ['{AE8FF869-528F-4DCA-BC49-05982D6B0973}'] - - // Top-level window whose title contains WindowTitle; raises when absent. - function FindWindow(const WindowTitle: string): HWND; - - function ListElements(const Window: HWND): TArray; - function GetElement(const Window: HWND; const Identifier: string): TToolsApiUiElement; - - procedure Click(const Window: HWND; const Identifier: string); - procedure SetText(const Window: HWND; const Identifier: string; const Text: string); - function GetText(const Window: HWND; const Identifier: string): string; - end; - -implementation - -end. diff --git a/GDK.ToolsAPI.UiAutomation.pas b/GDK.ToolsAPI.UiAutomation.pas deleted file mode 100644 index 6a24c57..0000000 --- a/GDK.ToolsAPI.UiAutomation.pas +++ /dev/null @@ -1,280 +0,0 @@ -unit GDK.ToolsAPI.UiAutomation; - -interface - -uses - Winapi.Windows, - Winapi.UIAutomation, - GDK.ToolsAPI.UiAutomation.Interfaces; - -type - TToolsApiUiAutomation = class(TInterfacedObject, IToolsApiUiAutomation) - private - FAutomation: IUIAutomation; - - function Automation: IUIAutomation; - function RootElement(const Window: HWND): IUIAutomationElement; - function DescribeElement(const Element: IUIAutomationElement): TToolsApiUiElement; - function FindByIdentifier(const Window: HWND; const Identifier: string): IUIAutomationElement; - function StringProperty(const Element: IUIAutomationElement; const PropertyId: Integer): string; - function ControlTypeName(const ControlTypeId: Integer): string; - function TryValuePattern(const Element: IUIAutomationElement; out Pattern: IUIAutomationValuePattern): Boolean; - function TryInvokePattern(const Element: IUIAutomationElement; out Pattern: IUIAutomationInvokePattern): Boolean; - public - function FindWindow(const WindowTitle: string): HWND; - function ListElements(const Window: HWND): TArray; - function GetElement(const Window: HWND; const Identifier: string): TToolsApiUiElement; - procedure Click(const Window: HWND; const Identifier: string); - procedure SetText(const Window: HWND; const Identifier: string; const Text: string); - function GetText(const Window: HWND; const Identifier: string): string; - end; - -implementation - -uses - System.SysUtils, - System.Variants, - Winapi.ActiveX; - -type - TWindowSearch = record - TitlePart: string; - Found: HWND; - end; - PWindowSearch = ^TWindowSearch; - -function EnumWindowsProc(Handle: HWND; Param: LPARAM): BOOL; stdcall; -var - Search: PWindowSearch; - Buffer: array[0..511] of Char; - Title: string; -begin - Result := True; - - if not IsWindowVisible(Handle) then - Exit; - - const Length = GetWindowText(Handle, Buffer, System.Length(Buffer)); - if Length <= 0 then - Exit; - - SetString(Title, Buffer, Length); - - Search := PWindowSearch(Param); - if Title.ToLower.Contains(Search.TitlePart.ToLower) then - begin - Search.Found := Handle; - Result := False; - end; -end; - -function TToolsApiUiAutomation.Automation: IUIAutomation; -begin - if not Assigned(FAutomation) then - begin - const HResult = CoCreateInstance(CLSID_CUIAutomation, nil, CLSCTX_INPROC_SERVER, - IUIAutomation, FAutomation); - if Failed(HResult) then - raise EToolsApiUiAutomation.CreateFmt('Could not create the UI Automation client (0x%x)', [HResult]); - end; - - Result := FAutomation; -end; - -function TToolsApiUiAutomation.FindWindow(const WindowTitle: string): HWND; -var - Search: TWindowSearch; -begin - Search.TitlePart := WindowTitle; - Search.Found := 0; - - EnumWindows(@EnumWindowsProc, LPARAM(@Search)); - - if Search.Found = 0 then - raise EToolsApiWindowNotFound.CreateFmt('No visible window with a title containing "%s"', [WindowTitle]); - - Result := Search.Found; -end; - -function TToolsApiUiAutomation.RootElement(const Window: HWND): IUIAutomationElement; -begin - const HResult = Automation.ElementFromHandle(Window, Result); - if Failed(HResult) or (not Assigned(Result)) then - raise EToolsApiWindowNotFound.Create('The window is not accessible through UI Automation'); -end; - -function TToolsApiUiAutomation.StringProperty(const Element: IUIAutomationElement; const PropertyId: Integer): string; -var - Value: OleVariant; -begin - Result := ''; - if Succeeded(Element.GetCurrentPropertyValue(PropertyId, Value)) and (not VarIsNull(Value)) and (not VarIsEmpty(Value)) then - Result := VarToStr(Value); -end; - -function TToolsApiUiAutomation.ControlTypeName(const ControlTypeId: Integer): string; -begin - // Alleen de gangbare typen; overige worden als het numerieke id getoond. - case ControlTypeId of - UIA_ButtonControlTypeId: Result := 'Button'; - UIA_EditControlTypeId: Result := 'Edit'; - UIA_TextControlTypeId: Result := 'Text'; - UIA_CheckBoxControlTypeId: Result := 'CheckBox'; - UIA_ComboBoxControlTypeId: Result := 'ComboBox'; - UIA_ListControlTypeId: Result := 'List'; - UIA_ListItemControlTypeId: Result := 'ListItem'; - UIA_TabControlTypeId: Result := 'Tab'; - UIA_TabItemControlTypeId: Result := 'TabItem'; - UIA_TreeControlTypeId: Result := 'Tree'; - UIA_DataGridControlTypeId: Result := 'DataGrid'; - UIA_TableControlTypeId: Result := 'Table'; - UIA_PaneControlTypeId: Result := 'Pane'; - UIA_WindowControlTypeId: Result := 'Window'; - UIA_GroupControlTypeId: Result := 'Group'; - UIA_MenuItemControlTypeId: Result := 'MenuItem'; - UIA_RadioButtonControlTypeId: Result := 'RadioButton'; - else - Result := IntToStr(ControlTypeId); - end; -end; - -function TToolsApiUiAutomation.TryValuePattern(const Element: IUIAutomationElement; out Pattern: IUIAutomationValuePattern): Boolean; -var - Unknown: IInterface; -begin - Pattern := nil; - Result := Succeeded(Element.GetCurrentPattern(UIA_ValuePatternId, Unknown)) and - Assigned(Unknown) and Supports(Unknown, IUIAutomationValuePattern, Pattern); -end; - -function TToolsApiUiAutomation.TryInvokePattern(const Element: IUIAutomationElement; out Pattern: IUIAutomationInvokePattern): Boolean; -var - Unknown: IInterface; -begin - Pattern := nil; - Result := Succeeded(Element.GetCurrentPattern(UIA_InvokePatternId, Unknown)) and - Assigned(Unknown) and Supports(Unknown, IUIAutomationInvokePattern, Pattern); -end; - -function TToolsApiUiAutomation.DescribeElement(const Element: IUIAutomationElement): TToolsApiUiElement; -var - ControlType: OleVariant; - ValuePattern: IUIAutomationValuePattern; - CurrentValue: PChar; -begin - Result := Default(TToolsApiUiElement); - Result.Name := StringProperty(Element, UIA_NamePropertyId); - Result.AutomationId := StringProperty(Element, UIA_AutomationIdPropertyId); - Result.ClassName := StringProperty(Element, UIA_ClassNamePropertyId); - - if Succeeded(Element.GetCurrentPropertyValue(UIA_ControlTypePropertyId, ControlType)) and (not VarIsNull(ControlType)) then - Result.ControlType := ControlTypeName(ControlType); - - if TryValuePattern(Element, ValuePattern) and Succeeded(ValuePattern.get_CurrentValue(CurrentValue)) then - begin - Result.Value := CurrentValue; - Result.HasValue := True; - end; -end; - -function TToolsApiUiAutomation.ListElements(const Window: HWND): TArray; -var - Condition: IUIAutomationCondition; - Elements: IUIAutomationElementArray; - Element: IUIAutomationElement; - Count: Integer; -begin - Result := nil; - - const Root = RootElement(Window); - - if Failed(Automation.CreateTrueCondition(Condition)) then - Exit; - - if Failed(Root.FindAll(TreeScope_Descendants, Condition, Elements)) or (not Assigned(Elements)) then - Exit; - - if Failed(Elements.get_Length(Count)) then - Exit; - - for var Index := 0 to Count - 1 do - begin - if Failed(Elements.GetElement(Index, Element)) or (not Assigned(Element)) then - Continue; - - const Described = DescribeElement(Element); - - // Elementen zonder naam en zonder automation-id zijn voor besturing - // onbruikbaar; laat ze weg om de lijst leesbaar te houden. - const IsAddressable = (Described.AutomationId <> '') or (Described.Name <> ''); - if IsAddressable then - Result := Result + [Described]; - end; -end; - -function TToolsApiUiAutomation.FindByIdentifier(const Window: HWND; const Identifier: string): IUIAutomationElement; -var - Condition: IUIAutomationCondition; -begin - const Root = RootElement(Window); - - // Eerst op AutomationId (de VCL-control-Name), dan op Name/caption. - if Succeeded(Automation.CreatePropertyCondition(UIA_AutomationIdPropertyId, Identifier, Condition)) and - Succeeded(Root.FindFirst(TreeScope_Descendants, Condition, Result)) and Assigned(Result) then - Exit; - - if Succeeded(Automation.CreatePropertyCondition(UIA_NamePropertyId, Identifier, Condition)) and - Succeeded(Root.FindFirst(TreeScope_Descendants, Condition, Result)) and Assigned(Result) then - Exit; - - raise EToolsApiElementNotFound.CreateFmt('No control with AutomationId or Name "%s" in the window', [Identifier]); -end; - -function TToolsApiUiAutomation.GetElement(const Window: HWND; const Identifier: string): TToolsApiUiElement; -begin - Result := DescribeElement(FindByIdentifier(Window, Identifier)); -end; - -procedure TToolsApiUiAutomation.Click(const Window: HWND; const Identifier: string); -var - InvokePattern: IUIAutomationInvokePattern; -begin - const Element = FindByIdentifier(Window, Identifier); - - if not TryInvokePattern(Element, InvokePattern) then - raise EToolsApiPatternNotSupported.CreateFmt('"%s" cannot be invoked (no Invoke pattern)', [Identifier]); - - Element.SetFocus; - if Failed(InvokePattern.Invoke) then - raise EToolsApiUiAutomation.CreateFmt('Invoke on "%s" failed', [Identifier]); -end; - -procedure TToolsApiUiAutomation.SetText(const Window: HWND; const Identifier: string; const Text: string); -var - ValuePattern: IUIAutomationValuePattern; -begin - const Element = FindByIdentifier(Window, Identifier); - - if not TryValuePattern(Element, ValuePattern) then - raise EToolsApiPatternNotSupported.CreateFmt('"%s" does not support text input (no Value pattern)', [Identifier]); - - Element.SetFocus; - if Failed(ValuePattern.SetValue(PChar(Text))) then - raise EToolsApiUiAutomation.CreateFmt('Setting the value of "%s" failed', [Identifier]); -end; - -function TToolsApiUiAutomation.GetText(const Window: HWND; const Identifier: string): string; -var - ValuePattern: IUIAutomationValuePattern; - CurrentValue: PChar; -begin - const Element = FindByIdentifier(Window, Identifier); - - if TryValuePattern(Element, ValuePattern) and Succeeded(ValuePattern.get_CurrentValue(CurrentValue)) then - Exit(CurrentValue); - - // Geen Value-pattern: val terug op de Name/caption (bv. voor labels/knoppen). - Result := StringProperty(Element, UIA_NamePropertyId); -end; - -end. From e4cc207774fe699293aad455d734ca867465bea1 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Tue, 7 Jul 2026 10:18:58 +0200 Subject: [PATCH 08/13] diag: temporary FormCreator logging to diagnose createForm name mangling (to be removed) --- GDK.ToolsAPI.FormCreator.pas | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/GDK.ToolsAPI.FormCreator.pas b/GDK.ToolsAPI.FormCreator.pas index 059c6fb..4018833 100644 --- a/GDK.ToolsAPI.FormCreator.pas +++ b/GDK.ToolsAPI.FormCreator.pas @@ -15,6 +15,8 @@ TToolsApiFormCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator FUnitFileName: string; FFormName: string; FAncestorName: string; + private + procedure DiagLog(const Text: string); public constructor Create(const Owner: IOTAProject; const UnitFileName: string; @@ -45,7 +47,18 @@ TToolsApiFormCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator implementation uses - System.SysUtils; + System.SysUtils, + System.IOUtils; + +procedure TToolsApiFormCreator.DiagLog(const Text: string); +begin + // Tijdelijke diagnose voor de createForm-naamverminking; verwijderen na fix. + try + TFile.AppendAllText(TPath.Combine(TPath.GetTempPath, 'claude4d-formcreator.log'), + Text + sLineBreak, TEncoding.UTF8); + except + end; +end; constructor TToolsApiFormCreator.Create(const Owner: IOTAProject; const UnitFileName: string; @@ -57,6 +70,9 @@ constructor TToolsApiFormCreator.Create(const Owner: IOTAProject; FUnitFileName := UnitFileName; FFormName := FormName; FAncestorName := AncestorName; + + DiagLog(Format('--- createForm: UnitFileName="%s" FormName="%s" AncestorName="%s"', + [UnitFileName, FormName, AncestorName])); end; function TToolsApiFormCreator.GetCreatorType: string; @@ -92,11 +108,13 @@ function TToolsApiFormCreator.GetAncestorName: string; Result := Result.Substring(1); if Result.IsEmpty then Result := 'Form'; + DiagLog(Format('GetAncestorName -> "%s"', [Result])); end; function TToolsApiFormCreator.GetImplFileName: string; begin Result := FUnitFileName; + DiagLog(Format('GetImplFileName -> "%s"', [Result])); end; function TToolsApiFormCreator.GetIntfFileName: string; @@ -107,6 +125,7 @@ function TToolsApiFormCreator.GetIntfFileName: string; function TToolsApiFormCreator.GetFormName: string; begin Result := FFormName; + DiagLog(Format('GetFormName -> "%s"', [Result])); end; function TToolsApiFormCreator.GetMainForm: Boolean; @@ -126,6 +145,8 @@ function TToolsApiFormCreator.GetShowSource: Boolean; function TToolsApiFormCreator.NewFormFile(const FormIdent: string; const AncestorIdent: string): IOTAFile; begin + DiagLog(Format('NewFormFile: FormIdent="%s" AncestorIdent="%s"', [FormIdent, AncestorIdent])); + // nil: the IDE generates the default .dfm for the ancestor. Result := nil; end; @@ -134,6 +155,9 @@ function TToolsApiFormCreator.NewImplSource(const ModuleIdent: string; const FormIdent: string; const AncestorIdent: string): IOTAFile; begin + DiagLog(Format('NewImplSource: ModuleIdent="%s" FormIdent="%s" AncestorIdent="%s"', + [ModuleIdent, FormIdent, AncestorIdent])); + // nil: the IDE generates the default form unit source. Result := nil; end; From 5aa12ff341b4a16caebcb9d520b6a699ad3eef86 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Tue, 7 Jul 2026 10:45:16 +0200 Subject: [PATCH 09/13] fix: FormCreator generates the unit and .dfm source itself (matching T class) instead of leaving it to the IDE default template, which mangled the class name; removes diagnostic logging --- GDK.ToolsAPI.FormCreator.pas | 109 +++++++++++++++++++++++++---------- 1 file changed, 78 insertions(+), 31 deletions(-) diff --git a/GDK.ToolsAPI.FormCreator.pas b/GDK.ToolsAPI.FormCreator.pas index 4018833..89c3f50 100644 --- a/GDK.ToolsAPI.FormCreator.pas +++ b/GDK.ToolsAPI.FormCreator.pas @@ -6,17 +6,26 @@ interface ToolsAPI; type - // Creates a new form unit through IOTAModuleServices.CreateModule: the IDE - // generates the default unit source and .dfm, adds the unit to the owning - // project and opens the designer. + // A file supplied to the IDE for a newly created module (source verbatim). + TToolsApiSourceFile = class(TInterfacedObject, IOTAFile) + private + FSource: string; + public + constructor Create(const Source: string); + function GetSource: string; + function GetAge: TDateTime; + end; + + // Creates a new form unit through IOTAModuleServices.CreateModule and adds it + // to the owning project. The unit and .dfm source are generated here (not left + // to the IDE default template, which mangles the class name), so the form class + // is exactly T. TToolsApiFormCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator) private FOwner: IOTAProject; FUnitFileName: string; FFormName: string; FAncestorName: string; - private - procedure DiagLog(const Text: string); public constructor Create(const Owner: IOTAProject; const UnitFileName: string; @@ -47,17 +56,22 @@ TToolsApiFormCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator implementation uses - System.SysUtils, - System.IOUtils; + System.SysUtils; -procedure TToolsApiFormCreator.DiagLog(const Text: string); +constructor TToolsApiSourceFile.Create(const Source: string); begin - // Tijdelijke diagnose voor de createForm-naamverminking; verwijderen na fix. - try - TFile.AppendAllText(TPath.Combine(TPath.GetTempPath, 'claude4d-formcreator.log'), - Text + sLineBreak, TEncoding.UTF8); - except - end; + inherited Create; + FSource := Source; +end; + +function TToolsApiSourceFile.GetSource: string; +begin + Result := FSource; +end; + +function TToolsApiSourceFile.GetAge: TDateTime; +begin + Result := -1; end; constructor TToolsApiFormCreator.Create(const Owner: IOTAProject; @@ -70,9 +84,6 @@ constructor TToolsApiFormCreator.Create(const Owner: IOTAProject; FUnitFileName := UnitFileName; FFormName := FormName; FAncestorName := AncestorName; - - DiagLog(Format('--- createForm: UnitFileName="%s" FormName="%s" AncestorName="%s"', - [UnitFileName, FormName, AncestorName])); end; function TToolsApiFormCreator.GetCreatorType: string; @@ -108,13 +119,11 @@ function TToolsApiFormCreator.GetAncestorName: string; Result := Result.Substring(1); if Result.IsEmpty then Result := 'Form'; - DiagLog(Format('GetAncestorName -> "%s"', [Result])); end; function TToolsApiFormCreator.GetImplFileName: string; begin Result := FUnitFileName; - DiagLog(Format('GetImplFileName -> "%s"', [Result])); end; function TToolsApiFormCreator.GetIntfFileName: string; @@ -125,7 +134,6 @@ function TToolsApiFormCreator.GetIntfFileName: string; function TToolsApiFormCreator.GetFormName: string; begin Result := FFormName; - DiagLog(Format('GetFormName -> "%s"', [Result])); end; function TToolsApiFormCreator.GetMainForm: Boolean; @@ -144,22 +152,61 @@ function TToolsApiFormCreator.GetShowSource: Boolean; end; function TToolsApiFormCreator.NewFormFile(const FormIdent: string; const AncestorIdent: string): IOTAFile; -begin - DiagLog(Format('NewFormFile: FormIdent="%s" AncestorIdent="%s"', [FormIdent, AncestorIdent])); - - // nil: the IDE generates the default .dfm for the ancestor. - Result := nil; +const + DfmTemplate = + 'object %0:s: T%0:s'#13#10 + + ' Left = 0'#13#10 + + ' Top = 0'#13#10 + + ' Caption = ''%0:s'''#13#10 + + ' ClientHeight = 300'#13#10 + + ' ClientWidth = 480'#13#10 + + ' Color = clBtnFace'#13#10 + + ' Font.Charset = DEFAULT_CHARSET'#13#10 + + ' Font.Color = clWindowText'#13#10 + + ' Font.Height = -12'#13#10 + + ' Font.Name = ''Segoe UI'''#13#10 + + ' Font.Style = []'#13#10 + + ' TextHeight = 15'#13#10 + + 'end'#13#10; +begin + // Generate the .dfm ourselves so its class (T) matches the unit; + // the IDE default template mangles the class name. + Result := TToolsApiSourceFile.Create(Format(DfmTemplate, [FormIdent])); end; function TToolsApiFormCreator.NewImplSource(const ModuleIdent: string; const FormIdent: string; const AncestorIdent: string): IOTAFile; -begin - DiagLog(Format('NewImplSource: ModuleIdent="%s" FormIdent="%s" AncestorIdent="%s"', - [ModuleIdent, FormIdent, AncestorIdent])); - - // nil: the IDE generates the default form unit source. - Result := nil; +const + UnitTemplate = + 'unit %0:s;'#13#10 + + ''#13#10 + + 'interface'#13#10 + + ''#13#10 + + 'uses'#13#10 + + ' Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,'#13#10 + + ' Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;'#13#10 + + ''#13#10 + + 'type'#13#10 + + ' T%1:s = class(T%2:s)'#13#10 + + ' private'#13#10 + + ' { Private declarations }'#13#10 + + ' public'#13#10 + + ' { Public declarations }'#13#10 + + ' end;'#13#10 + + ''#13#10 + + 'var'#13#10 + + ' %1:s: T%1:s;'#13#10 + + ''#13#10 + + 'implementation'#13#10 + + ''#13#10 + + '{$R *.dfm}'#13#10 + + ''#13#10 + + 'end.'#13#10; +begin + // Generate the unit ourselves with class T = class(T), + // so the class name is exact and matches the .dfm. + Result := TToolsApiSourceFile.Create(Format(UnitTemplate, [ModuleIdent, FormIdent, AncestorIdent])); end; function TToolsApiFormCreator.NewIntfSource(const ModuleIdent: string; From 2e630f8cb83473472b26a1757c10b222c9cbfbb9 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Tue, 7 Jul 2026 10:51:18 +0200 Subject: [PATCH 10/13] FormCreator: larger default form (640x480) to match a standard new VCL form --- GDK.ToolsAPI.FormCreator.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GDK.ToolsAPI.FormCreator.pas b/GDK.ToolsAPI.FormCreator.pas index 89c3f50..5f2efb7 100644 --- a/GDK.ToolsAPI.FormCreator.pas +++ b/GDK.ToolsAPI.FormCreator.pas @@ -158,8 +158,8 @@ function TToolsApiFormCreator.NewFormFile(const FormIdent: string; const Ancesto ' Left = 0'#13#10 + ' Top = 0'#13#10 + ' Caption = ''%0:s'''#13#10 + - ' ClientHeight = 300'#13#10 + - ' ClientWidth = 480'#13#10 + + ' ClientHeight = 480'#13#10 + + ' ClientWidth = 640'#13#10 + ' Color = clBtnFace'#13#10 + ' Font.Charset = DEFAULT_CHARSET'#13#10 + ' Font.Color = clWindowText'#13#10 + From 57e8d896ecde27f1eda1c95a112e2bda9b0b1af5 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Tue, 7 Jul 2026 10:56:07 +0200 Subject: [PATCH 11/13] docs: document module buffer/disk sync, form creation and designer (createForm, FormDesigner, CaptureImage) and the debugger --- README.md | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 68 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index a3934fd..83acfa3 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,11 @@ With this library we will contribute to the Delphi community and make it more si ## Content [Logging / Messages](#Logger) -[Project group and projects](#Projects) +[Project group and projects](#Projects) (incl. build, environment options, module sync) + +[Form creation and designer](#form-creation-and-designer) + +[Debugger](#debugger) [Uses manager](#uses-manager) @@ -132,6 +136,69 @@ begin end; ``` +#### Module buffer/disk sync +A file open in the IDE can be newer in memory than on disk (or vice versa when an external tool edits it). **IToolsApiModule** exposes `IsDirty`, `MatchesDisk` and `SyncWithDisk` to reason about this. `SyncWithDisk` reloads the module from disk when the buffer is unmodified, and raises `EToolsApiModuleOutOfSync` when both sides changed (a real conflict). + +```Pascal +var Module: IToolsApiModule := THelper.Module; +if not Module.MatchesDisk then + Module.SyncWithDisk; // reloads if safe, raises on conflict +``` + +## Form creation and designer + +### Creating a form unit +`IToolsApiProject.CreateFormUnit` creates a new form unit through `IOTAModuleServices.CreateModule`, adds it to the project and opens the designer. The unit and `.dfm` source are generated by the library (not left to the IDE default template, which mangles the class name), so the class is exactly `T`. `AncestorName` is without the leading `T` (empty means `TForm`). + +```Pascal +var Helper: IToolsApiHelper := TToolsApiHelper.Create; +Helper.Project.CreateFormUnit('C:\proj\FMain.pas', 'MainForm', 'TForm'); +``` + +### Editing components on a form +`IToolsApiModule.FormDesigner` returns an **IToolsApiFormEditor** for component-level access to an open form designer, like the palette and Object Inspector: + +```Pascal +var Designer := THelper.Module.FormDesigner; + +// Inspect +for var Component in Designer.Components do + ; // Component.Name, .ClassName, ... +var Events := Designer.AssignedEvents(Designer.Root); // ['OnClick=Button1Click', ...] + +// Add a control to a named container (forced to the exact parent, e.g. a TabSheet) +var Edit := Designer.AddComponent('TEdit', 'pnlDetail', 8, 8, 200, 23); + +// Set published properties by text, including nested paths, sets, events and +// component references: +Designer.SetComponentProperty('Edit1', 'Text', 'hello'); +Designer.SetComponentProperty('Edit1', 'Font.Size', '12'); +Designer.SetComponentProperty('Button1', 'OnClick', 'Button1Click'); // binds/creates handler +Designer.SetComponentProperty('PageControl1', 'ActivePage', 'TabSheet1'); // component reference +``` + +`AddComponent` captures the native container before creating and forces the new control's `Parent`, so it lands on exactly the requested tab/page (not the active one). Any installed component class works (VCL, TMS, DevExpress, ...). + +### Rendering a form to an image +`IToolsApiFormEditor.CaptureImage` renders the designed form to a PNG (via `TCustomForm.GetFormImage`), returned as `TBytes`. + +## Debugger + +`IToolsApiHelper.Debugger` returns an **IToolsApiDebugger** around `IOTADebuggerServices`: source breakpoints, process control (continue/step/pause/terminate), expression evaluation (deferred-aware) and the call stack. + +```Pascal +var Debugger := THelper.Debugger; + +Debugger.AddBreakpoint('C:\proj\FMain.pas', 42); +// ... run the project ... +if Debugger.State = TToolsApiProcessState.Stopped then +begin + var Value := Debugger.Evaluate('Customer.Name'); + for var Frame in Debugger.CallStack do + ; // Frame.Header, .FileName, .LineNumber +end; +``` + ## Uses manager The **TToolsApiUsesManager** class is located in `GDK.ToolsAPI.UsesManager.pas` and provides the following methods: From 369519879136798b82760d2f1a37238649b5fa00 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Tue, 7 Jul 2026 11:09:54 +0200 Subject: [PATCH 12/13] fix: event binding calls IDesigner.ShowMethod for a new handler so the method stub is written to the unit (mirrors Object Inspector); without it the source stub and DFM binding were lost --- GDK.ToolsAPI.FormEditor.pas | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/GDK.ToolsAPI.FormEditor.pas b/GDK.ToolsAPI.FormEditor.pas index 908d5c0..a3a162e 100644 --- a/GDK.ToolsAPI.FormEditor.pas +++ b/GDK.ToolsAPI.FormEditor.pas @@ -271,14 +271,23 @@ procedure TToolsApiFormEditor.SetEventHandler(const Instance: TObject; (not FormDesigner.MethodFromAncestor(CurrentMethod)); if CanRename then - FormDesigner.RenameMethod(CurrentName, MethodName) - else begin - const Handler = FormDesigner.CreateMethod(MethodName, GetTypeData(Info^.PropType^)); - SetMethodProp(Instance, Info, Handler); + FormDesigner.RenameMethod(CurrentName, MethodName); + FormDesigner.Modified; + Exit; end; + const IsNewMethod = not FormDesigner.MethodExists(MethodName); + const Handler = FormDesigner.CreateMethod(MethodName, GetTypeData(Info^.PropType^)); + SetMethodProp(Instance, Info, Handler); FormDesigner.Modified; + + // CreateMethod only registers the handler; ShowMethod materialises the empty + // method body in the source unit (exactly what the Object Inspector does for a + // new event handler). Without it the stub is never written and the binding is + // lost on save. + if IsNewMethod then + FormDesigner.ShowMethod(MethodName); end; function TToolsApiFormEditor.AssignedEvents(const Component: TComponent): TArray; From 82356d28019738a5c83816b4b1ac25023a747991 Mon Sep 17 00:00:00 2001 From: Marco Geuze Date: Tue, 7 Jul 2026 14:15:01 +0200 Subject: [PATCH 13/13] refactor: review fixes - scoped enums for TToolsApiProcessState/TToolsApiStepMode (Exception_ becomes Exception), rename CurrentLocation to TryGetCurrentLocation, extract TToolsApiSourceFile to its own unit, split Evaluate into EvaluateOnce, begin/end on loops, inline vars, boolean parentheses and English evergreen comments --- GDK.ToolsAPI.Debugger.Interfaces.pas | 11 +++-- GDK.ToolsAPI.Debugger.pas | 64 ++++++++++++++++------------ GDK.ToolsAPI.FormCreator.pas | 38 ++--------------- GDK.ToolsAPI.FormEditor.pas | 14 +++--- GDK.ToolsAPI.SourceFile.pas | 37 ++++++++++++++++ 5 files changed, 88 insertions(+), 76 deletions(-) create mode 100644 GDK.ToolsAPI.SourceFile.pas diff --git a/GDK.ToolsAPI.Debugger.Interfaces.pas b/GDK.ToolsAPI.Debugger.Interfaces.pas index 46162fd..6cd4e12 100644 --- a/GDK.ToolsAPI.Debugger.Interfaces.pas +++ b/GDK.ToolsAPI.Debugger.Interfaces.pas @@ -9,10 +9,12 @@ interface EToolsApiNoDebuggerServices = class(Exception); EToolsApiEvaluateFailed = class(Exception); + {$SCOPEDENUMS ON} TToolsApiProcessState = (Nothing, Running, Stopping, Stopped, Fault, - ResFault, Terminated, Exception_, NoProcess); + ResFault, Terminated, Exception, NoProcess); TToolsApiStepMode = (StepOver, StepInto, RunUntilReturn); + {$SCOPEDENUMS OFF} TToolsApiBreakpointInfo = record FileName: string; @@ -32,13 +34,11 @@ TToolsApiStackFrame = record IToolsApiDebugger = interface ['{A6A8EF47-CEC7-43BB-8F88-A0A6A12F4E47}'] - // Breakpoints (design-time; blijven bewaard tussen debugsessies). procedure AddBreakpoint(const FileName: string; const LineNumber: Integer); function RemoveBreakpoint(const FileName: string; const LineNumber: Integer): Boolean; function RemoveAllBreakpoints: Integer; function ListBreakpoints: TArray; - // Procesbeheer (vereist een actief debugproces). function State: TToolsApiProcessState; function HasProcess: Boolean; procedure Continue; @@ -46,12 +46,11 @@ TToolsApiStackFrame = record procedure Pause; procedure Terminate; - // Inspectie (proces moet gestopt zijn). function Evaluate(const Expression: string): string; function CallStack: TArray; - function CurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; + function TryGetCurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; - // Verwerkt in de wachtlus openstaande debug-events (voor deferred evaluate). + // Pumps pending debug events; required while waiting for a deferred evaluate. procedure ProcessDebugEvents; end; diff --git a/GDK.ToolsAPI.Debugger.pas b/GDK.ToolsAPI.Debugger.pas index 4b6f44c..d23dbd7 100644 --- a/GDK.ToolsAPI.Debugger.pas +++ b/GDK.ToolsAPI.Debugger.pas @@ -12,6 +12,8 @@ TToolsApiDebugger = class(TInterfacedObject, IToolsApiDebugger) const EvaluateBufferSize = 8192; const DeferredPollCount = 200; + type TEvaluateBuffer = array[0..EvaluateBufferSize - 1] of Char; + function DebuggerServices: IOTADebuggerServices; function TryDebuggerServices(out Services: IOTADebuggerServices): Boolean; function CurrentProcess: IOTAProcess; @@ -19,6 +21,7 @@ TToolsApiDebugger = class(TInterfacedObject, IToolsApiDebugger) function FindSourceBreakpoint(const FileName: string; const LineNumber: Integer): IOTASourceBreakpoint; function MapState(const State: TOTAProcessState): TToolsApiProcessState; procedure RunProcess(const Mode: TOTARunMode); + function EvaluateOnce(const Thread: IOTAThread; const Expression: string; out Value: string): TOTAEvaluateResult; public procedure AddBreakpoint(const FileName: string; const LineNumber: Integer); function RemoveBreakpoint(const FileName: string; const LineNumber: Integer): Boolean; @@ -34,7 +37,7 @@ TToolsApiDebugger = class(TInterfacedObject, IToolsApiDebugger) function Evaluate(const Expression: string): string; function CallStack: TArray; - function CurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; + function TryGetCurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; procedure ProcessDebugEvents; end; @@ -105,10 +108,12 @@ function TToolsApiDebugger.RemoveAllBreakpoints: Integer; begin const Services = DebuggerServices; - // Achterwaarts verwijderen: de lijst schuift op bij elke RemoveBreakpoint. + // Removing shifts the breakpoint list, so iterate backwards. Result := Services.SourceBkptCount; for var Index := Services.SourceBkptCount - 1 downto 0 do + begin Services.RemoveBreakpoint(Services.SourceBkpts[Index]); + end; end; function TToolsApiDebugger.ListBreakpoints: TArray; @@ -137,16 +142,15 @@ function TToolsApiDebugger.MapState(const State: TOTAProcessState): TToolsApiPro psFault: Result := TToolsApiProcessState.Fault; psResFault: Result := TToolsApiProcessState.ResFault; psTerminated: Result := TToolsApiProcessState.Terminated; - psException: Result := TToolsApiProcessState.Exception_; + psException: Result := TToolsApiProcessState.Exception; else Result := TToolsApiProcessState.NoProcess; end; end; function TToolsApiDebugger.State: TToolsApiProcessState; -var - Services: IOTADebuggerServices; begin + var Services: IOTADebuggerServices; if not TryDebuggerServices(Services) then Exit(TToolsApiProcessState.NoProcess); @@ -158,9 +162,8 @@ function TToolsApiDebugger.State: TToolsApiProcessState; end; function TToolsApiDebugger.HasProcess: Boolean; -var - Services: IOTADebuggerServices; begin + var Services: IOTADebuggerServices; Result := TryDebuggerServices(Services) and Assigned(Services.CurrentProcess); end; @@ -203,45 +206,50 @@ procedure TToolsApiDebugger.Terminate; end; function TToolsApiDebugger.Evaluate(const Expression: string): string; -var - ResultBuffer: array[0..EvaluateBufferSize - 1] of Char; - CanModify: Boolean; - ResultAddr: LongWord; - ResultSize: LongWord; - ResultVal: LongWord; begin const Thread = CurrentThread; if not Assigned(Thread) then raise EToolsApiEvaluateFailed.Create('No stopped process to evaluate in'); - FillChar(ResultBuffer, SizeOf(ResultBuffer), 0); + var Value := ''; + var EvalResult := EvaluateOnce(Thread, Expression, Value); - var EvalResult := Thread.Evaluate(Expression, @ResultBuffer[0], EvaluateBufferSize, - CanModify, True, nil, ResultAddr, ResultSize, ResultVal); - - // Deferred: het evaluator moest een functie aanroepen in het proces; verwerk - // debug-events tot het resultaat binnen is (of de poging opgeeft). + // Deferred means the evaluator has to call a function inside the debuggee; + // pump debug events until the result arrives or the attempt is abandoned. var Polls := 0; while (EvalResult = erDeferred) and (Polls < DeferredPollCount) do begin DebuggerServices.ProcessDebugEvents; Inc(Polls); - - FillChar(ResultBuffer, SizeOf(ResultBuffer), 0); - EvalResult := Thread.Evaluate(Expression, @ResultBuffer[0], EvaluateBufferSize, - CanModify, True, nil, ResultAddr, ResultSize, ResultVal); + EvalResult := EvaluateOnce(Thread, Expression, Value); end; case EvalResult of - erOK: Result := ResultBuffer; + erOK: Result := Value; erBusy: raise EToolsApiEvaluateFailed.Create('Evaluator is busy, try again'); erDeferred: raise EToolsApiEvaluateFailed.Create('Evaluation did not complete in time'); else - // erError: ResultBuffer bevat de foutmelding van de evaluator. - raise EToolsApiEvaluateFailed.Create(string(ResultBuffer)); + // On erError the evaluator message is what came back in the buffer. + raise EToolsApiEvaluateFailed.Create(Value); end; end; +function TToolsApiDebugger.EvaluateOnce(const Thread: IOTAThread; const Expression: string; out Value: string): TOTAEvaluateResult; +begin + var Buffer: TEvaluateBuffer; + FillChar(Buffer, SizeOf(Buffer), 0); + + var CanModify := False; + var ResultAddr: LongWord := 0; + var ResultSize: LongWord := 0; + var ResultVal: LongWord := 0; + + Result := Thread.Evaluate(Expression, @Buffer[0], EvaluateBufferSize, + CanModify, True, nil, ResultAddr, ResultSize, ResultVal); + + Value := Buffer; +end; + function TToolsApiDebugger.CallStack: TArray; begin Result := nil; @@ -250,7 +258,7 @@ function TToolsApiDebugger.CallStack: TArray; if not Assigned(Thread) then Exit; - // GetCallCount moet vóór GetCallHeader/GetCallPos; frames zijn 1-based. + // GetCallCount must precede GetCallHeader/GetCallPos; frames are 1-based. const Count = Thread.GetCallCount; SetLength(Result, Count); @@ -267,7 +275,7 @@ function TToolsApiDebugger.CallStack: TArray; end; end; -function TToolsApiDebugger.CurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; +function TToolsApiDebugger.TryGetCurrentLocation(out FileName: string; out LineNumber: Integer): Boolean; begin FileName := ''; LineNumber := 0; diff --git a/GDK.ToolsAPI.FormCreator.pas b/GDK.ToolsAPI.FormCreator.pas index 5f2efb7..dc8ddd9 100644 --- a/GDK.ToolsAPI.FormCreator.pas +++ b/GDK.ToolsAPI.FormCreator.pas @@ -6,20 +6,9 @@ interface ToolsAPI; type - // A file supplied to the IDE for a newly created module (source verbatim). - TToolsApiSourceFile = class(TInterfacedObject, IOTAFile) - private - FSource: string; - public - constructor Create(const Source: string); - function GetSource: string; - function GetAge: TDateTime; - end; - // Creates a new form unit through IOTAModuleServices.CreateModule and adds it - // to the owning project. The unit and .dfm source are generated here (not left - // to the IDE default template, which mangles the class name), so the form class - // is exactly T. + // to the owning project. The unit and .dfm source are generated here so the + // form class is exactly T. TToolsApiFormCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator) private FOwner: IOTAProject; @@ -56,23 +45,8 @@ TToolsApiFormCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator implementation uses - System.SysUtils; - -constructor TToolsApiSourceFile.Create(const Source: string); -begin - inherited Create; - FSource := Source; -end; - -function TToolsApiSourceFile.GetSource: string; -begin - Result := FSource; -end; - -function TToolsApiSourceFile.GetAge: TDateTime; -begin - Result := -1; -end; + System.SysUtils, + GDK.ToolsAPI.SourceFile; constructor TToolsApiFormCreator.Create(const Owner: IOTAProject; const UnitFileName: string; @@ -169,8 +143,6 @@ function TToolsApiFormCreator.NewFormFile(const FormIdent: string; const Ancesto ' TextHeight = 15'#13#10 + 'end'#13#10; begin - // Generate the .dfm ourselves so its class (T) matches the unit; - // the IDE default template mangles the class name. Result := TToolsApiSourceFile.Create(Format(DfmTemplate, [FormIdent])); end; @@ -204,8 +176,6 @@ ' T%1:s = class(T%2:s)'#13#10 + ''#13#10 + 'end.'#13#10; begin - // Generate the unit ourselves with class T = class(T), - // so the class name is exact and matches the .dfm. Result := TToolsApiSourceFile.Create(Format(UnitTemplate, [ModuleIdent, FormIdent, AncestorIdent])); end; diff --git a/GDK.ToolsAPI.FormEditor.pas b/GDK.ToolsAPI.FormEditor.pas index a3a162e..59f1315 100644 --- a/GDK.ToolsAPI.FormEditor.pas +++ b/GDK.ToolsAPI.FormEditor.pas @@ -121,7 +121,7 @@ function TToolsApiFormEditor.AddComponent(const TypeName: string; // resolving it afterwards can yield a stale/wrong parent (RSP-quirk that // lands controls on the active page instead of the requested container). const NativeContainer = NativeComponent(Container); - const RequestedNamedContainer = not ContainerName.IsEmpty; + const RequestedNamedContainer = (not ContainerName.IsEmpty); if RequestedNamedContainer and (not (NativeContainer is TWinControl)) then raise EToolsApiComponentNotFound.CreateFmt( 'Container "%s" (%s) cannot host controls; a parent must be a TWinControl (form, panel, tab sheet, group box)', @@ -224,8 +224,8 @@ procedure TToolsApiFormEditor.SetComponentReference(const Instance: TObject; const Info: PPropInfo; const ComponentName: string); begin - // Component-referentie-properties (ActivePage, DataSource, Images, PopupMenu, - // ...) worden gezet met de NAAM van het component; leeg betekent nil. + // Component-reference properties (ActivePage, DataSource, Images, PopupMenu, + // ...) are set by the referenced component NAME; empty means nil. if ComponentName.IsEmpty then begin SetObjectProp(Instance, Info, nil); @@ -277,15 +277,13 @@ procedure TToolsApiFormEditor.SetEventHandler(const Instance: TObject; Exit; end; - const IsNewMethod = not FormDesigner.MethodExists(MethodName); + const IsNewMethod = (not FormDesigner.MethodExists(MethodName)); const Handler = FormDesigner.CreateMethod(MethodName, GetTypeData(Info^.PropType^)); SetMethodProp(Instance, Info, Handler); FormDesigner.Modified; - // CreateMethod only registers the handler; ShowMethod materialises the empty - // method body in the source unit (exactly what the Object Inspector does for a - // new event handler). Without it the stub is never written and the binding is - // lost on save. + // CreateMethod only registers the handler; ShowMethod writes the empty method + // body to the source unit, as the Object Inspector does for a new event handler. if IsNewMethod then FormDesigner.ShowMethod(MethodName); end; diff --git a/GDK.ToolsAPI.SourceFile.pas b/GDK.ToolsAPI.SourceFile.pas new file mode 100644 index 0000000..f47de03 --- /dev/null +++ b/GDK.ToolsAPI.SourceFile.pas @@ -0,0 +1,37 @@ +unit GDK.ToolsAPI.SourceFile; + +interface + +uses + ToolsAPI; + +type + // A file supplied to the IDE for a newly created module (source verbatim). + TToolsApiSourceFile = class(TInterfacedObject, IOTAFile) + private + FSource: string; + public + constructor Create(const Source: string); + function GetSource: string; + function GetAge: TDateTime; + end; + +implementation + +constructor TToolsApiSourceFile.Create(const Source: string); +begin + inherited Create; + FSource := Source; +end; + +function TToolsApiSourceFile.GetSource: string; +begin + Result := FSource; +end; + +function TToolsApiSourceFile.GetAge: TDateTime; +begin + Result := -1; +end; + +end.