Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Code-Formatting

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-12 17:10:01 +02:00
parent ce915e503a
commit 45ff69fd92
14 changed files with 638 additions and 594 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AuraTrader/AuraTrader.dpr
+15 -15
View File
@@ -1,23 +1,23 @@
program AuraTrader; program AuraTrader;
uses uses
FastMM5, FastMM5,
System.StartUpCopy, System.StartUpCopy,
FMX.Forms, FMX.Forms,
MainForm in 'MainForm.pas' {Form1}, MainForm in 'MainForm.pas' {Form1},
Myc.Trade.Core.DataPoint in '..\Src\Myc.Trade.Core.DataPoint.pas', Myc.Trade.Core.DataPoint in '..\Src\Myc.Trade.Core.DataPoint.pas',
Myc.Aura.Module in '..\Src\Myc.Aura.Module.pas', Myc.Aura.Module in '..\Src\Myc.Aura.Module.pas',
Myc.Aura.Parameter in '..\Src\Myc.Aura.Parameter.pas', Myc.Aura.Parameter in '..\Src\Myc.Aura.Parameter.pas',
TestModule in 'TestModule.pas', TestModule in 'TestModule.pas',
DynamicFMXControl in 'DynamicFMXControl.pas', DynamicFMXControl in 'DynamicFMXControl.pas',
FirstStrategy in 'FirstStrategy.pas', FirstStrategy in 'FirstStrategy.pas',
Myc.Fmx.Chart in 'Myc.Fmx.Chart.pas', Myc.Fmx.Chart in 'Myc.Fmx.Chart.pas',
Myc.Trade.DataArray in '..\Src\Myc.Trade.DataArray.pas'; Myc.Trade.DataArray in '..\Src\Myc.Trade.DataArray.pas';
{$R *.res} {$R *.res}
begin begin
Application.Initialize; Application.Initialize;
Application.CreateForm(TForm1, Form1); Application.CreateForm(TForm1, Form1);
Application.Run; Application.Run;
end. end.
AuraTrader/DynamicFMXControl.pas
+242 -234
View File
@@ -3,135 +3,143 @@ unit DynamicFMXControl;
interface interface
uses uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.SysUtils,
FMX.Controls, FMX.Graphics, FMX.Forms, FMX.StdCtrls, FMX.Types; System.Types,
System.UITypes,
System.Classes,
FMX.Controls,
FMX.Graphics,
FMX.Forms,
FMX.StdCtrls,
FMX.Types;
type type
// Dezidierte Event-Typen für virtuelle Methoden von TControl // Dezidierte Event-Typen für virtuelle Methoden von TControl
TControlPaintEvent = reference to procedure; TControlPaintEvent = reference to procedure;
TControlMouseEvent = reference to procedure(Button: TMouseButton; Shift: TShiftState; X, Y: Single); TControlMouseEvent = reference to procedure(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
TControlMouseMoveEvent = reference to procedure(Shift: TShiftState; X, Y: Single); TControlMouseMoveEvent = reference to procedure(Shift: TShiftState; X, Y: Single);
TControlMouseWheelEvent = reference to procedure(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); TControlMouseWheelEvent = reference to procedure(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
TControlKeyEvent = reference to procedure(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); TControlKeyEvent = reference to procedure(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
TControlDragEvent = reference to procedure(const Data: TDragObject; const Point: TPointF); TControlDragEvent = reference to procedure(const Data: TDragObject; const Point: TPointF);
TControlDragOverEvent = reference to procedure(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); TControlDragOverEvent = reference to procedure(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
TControlNotifyEvent = reference to procedure; TControlNotifyEvent = reference to procedure;
TControlCanFocusEvent = reference to function: Boolean; TControlCanFocusEvent = reference to function: Boolean;
TControlShowContextMenuEvent = reference to function(const ScreenPosition: TPointF): Boolean; TControlShowContextMenuEvent = reference to function(const ScreenPosition: TPointF): Boolean;
TControlSetHintEvent = reference to procedure(const AHint: string); TControlSetHintEvent = reference to procedure(const AHint: string);
TControlGetHintStringEvent = reference to function: string; TControlGetHintStringEvent = reference to function: string;
TControlHasHintEvent = reference to function: Boolean; TControlHasHintEvent = reference to function: Boolean;
TControlCanShowHintEvent = reference to function: Boolean; TControlCanShowHintEvent = reference to function: Boolean;
TControlGetDefaultSizeEvent = reference to function: TSizeF; TControlGetDefaultSizeEvent = reference to function: TSizeF;
TControlSetVisibleEvent = reference to procedure(const Value: Boolean); TControlSetVisibleEvent = reference to procedure(const Value: Boolean);
TControlSetEnabledEvent = reference to procedure(const Value: Boolean); TControlSetEnabledEvent = reference to procedure(const Value: Boolean);
TControlDoAbsoluteChangedEvent = reference to procedure; TControlDoAbsoluteChangedEvent = reference to procedure;
TDynamicControl = class(TControl) TDynamicControl = class(TControl)
private private
// Private Felder für die Event-Handler // Private Felder für die Event-Handler
FPaintEvent: TControlPaintEvent; FPaintEvent: TControlPaintEvent;
FMouseDownEvent: TControlMouseEvent; FMouseDownEvent: TControlMouseEvent;
FMouseUpEvent: TControlMouseEvent; FMouseUpEvent: TControlMouseEvent;
FMouseMoveEvent: TControlMouseMoveEvent; FMouseMoveEvent: TControlMouseMoveEvent;
FMouseWheelEvent: TControlMouseWheelEvent; FMouseWheelEvent: TControlMouseWheelEvent;
FKeyDownEvent: TControlKeyEvent; FKeyDownEvent: TControlKeyEvent;
FKeyUpEvent: TControlKeyEvent; FKeyUpEvent: TControlKeyEvent;
FClickEvent: TControlNotifyEvent; FClickEvent: TControlNotifyEvent;
FDblClickEvent: TControlNotifyEvent; FDblClickEvent: TControlNotifyEvent;
FDragEnterEvent: TControlDragEvent; FDragEnterEvent: TControlDragEvent;
FDragOverEvent: TControlDragOverEvent; FDragOverEvent: TControlDragOverEvent;
FDragDropEvent: TControlDragEvent; FDragDropEvent: TControlDragEvent;
FDragLeaveEvent: TControlNotifyEvent; FDragLeaveEvent: TControlNotifyEvent;
FDragEndEvent: TControlNotifyEvent; FDragEndEvent: TControlNotifyEvent;
FEnterEvent: TControlNotifyEvent; FEnterEvent: TControlNotifyEvent;
FExitEvent: TControlNotifyEvent; FExitEvent: TControlNotifyEvent;
FMouseEnterEvent: TControlNotifyEvent; FMouseEnterEvent: TControlNotifyEvent;
FMouseLeaveEvent: TControlNotifyEvent; FMouseLeaveEvent: TControlNotifyEvent;
FResizeEvent: TControlNotifyEvent; FResizeEvent: TControlNotifyEvent;
FResizedEvent: TControlNotifyEvent; FResizedEvent: TControlNotifyEvent;
FCanFocusEvent: TControlCanFocusEvent; FCanFocusEvent: TControlCanFocusEvent;
FShowContextMenuEvent: TControlShowContextMenuEvent; FShowContextMenuEvent: TControlShowContextMenuEvent;
FSetHintEvent: TControlSetHintEvent; FSetHintEvent: TControlSetHintEvent;
FGetHintStringEvent: TControlGetHintStringEvent; FGetHintStringEvent: TControlGetHintStringEvent;
FHasHintEvent: TControlHasHintEvent; FHasHintEvent: TControlHasHintEvent;
FCanShowHintEvent: TControlCanShowHintEvent; FCanShowHintEvent: TControlCanShowHintEvent;
FGetDefaultSizeEvent: TControlGetDefaultSizeEvent; FGetDefaultSizeEvent: TControlGetDefaultSizeEvent;
FRecalculateAbsoluteMatricesEvent: TControlNotifyEvent; FRecalculateAbsoluteMatricesEvent: TControlNotifyEvent;
FSetVisibleEvent: TControlSetVisibleEvent; FSetVisibleEvent: TControlSetVisibleEvent;
FSetEnabledEvent: TControlSetEnabledEvent; FSetEnabledEvent: TControlSetEnabledEvent;
FDoAbsoluteChangedEvent: TControlDoAbsoluteChangedEvent; FDoAbsoluteChangedEvent: TControlDoAbsoluteChangedEvent;
protected protected
// Überschriebene virtuelle Methoden, die die Events auslösen // Überschriebene virtuelle Methoden, die die Events auslösen
procedure Paint; override; procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure MouseMove(Shift: TShiftState; X, Y: Single); override; procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override; procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
procedure Click; override; procedure Click; override;
procedure DblClick; override; procedure DblClick; override;
procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override; procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override; procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
procedure DragEnter(const Data: TDragObject; const Point: TPointF); override; procedure DragEnter(const Data: TDragObject; const Point: TPointF); override;
procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override; procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override;
procedure DragDrop(const Data: TDragObject; const Point: TPointF); override; procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
procedure DragLeave; override; procedure DragLeave; override;
procedure DragEnd; override; procedure DragEnd; override;
procedure DoEnter; override; procedure DoEnter; override;
procedure DoExit; override; procedure DoExit; override;
procedure DoMouseEnter; override; procedure DoMouseEnter; override;
procedure DoMouseLeave; override; procedure DoMouseLeave; override;
procedure Resize; override; procedure Resize; override;
procedure DoResized; override; procedure DoResized; override;
function GetCanFocus: Boolean; override; function GetCanFocus: Boolean; override;
function ShowContextMenu(const ScreenPosition: TPointF): Boolean; override; function ShowContextMenu(const ScreenPosition: TPointF): Boolean; override;
procedure SetHint(const AHint: string); override; procedure SetHint(const AHint: string); override;
function GetHintString: string; override; function GetHintString: string; override;
function HasHint: Boolean; override; function HasHint: Boolean; override;
function CanShowHint: Boolean; override; function CanShowHint: Boolean; override;
function GetDefaultSize: TSizeF; override; function GetDefaultSize: TSizeF; override;
procedure RecalculateAbsoluteMatrices; override; procedure RecalculateAbsoluteMatrices; override;
procedure SetVisible(const Value: Boolean); override; procedure SetVisible(const Value: Boolean); override;
procedure SetEnabled(const Value: Boolean); override; procedure SetEnabled(const Value: Boolean); override;
procedure DoAbsoluteChanged; override; procedure DoAbsoluteChanged; override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
// Public Properties, die die Events exponieren // Public Properties, die die Events exponieren
property OnPaint: TControlPaintEvent read FPaintEvent write FPaintEvent; property OnPaint: TControlPaintEvent read FPaintEvent write FPaintEvent;
property OnMouseDown: TControlMouseEvent read FMouseDownEvent write FMouseDownEvent; property OnMouseDown: TControlMouseEvent read FMouseDownEvent write FMouseDownEvent;
property OnMouseUp: TControlMouseEvent read FMouseUpEvent write FMouseUpEvent; property OnMouseUp: TControlMouseEvent read FMouseUpEvent write FMouseUpEvent;
property OnMouseMove: TControlMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent; property OnMouseMove: TControlMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent;
property OnMouseWheel: TControlMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent; property OnMouseWheel: TControlMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent;
property OnClick: TControlNotifyEvent read FClickEvent write FClickEvent; property OnClick: TControlNotifyEvent read FClickEvent write FClickEvent;
property OnDblClick: TControlNotifyEvent read FDblClickEvent write FDblClickEvent; property OnDblClick: TControlNotifyEvent read FDblClickEvent write FDblClickEvent;
property OnKeyDown: TControlKeyEvent read FKeyDownEvent write FKeyDownEvent; property OnKeyDown: TControlKeyEvent read FKeyDownEvent write FKeyDownEvent;
property OnKeyUp: TControlKeyEvent read FKeyUpEvent write FKeyUpEvent; property OnKeyUp: TControlKeyEvent read FKeyUpEvent write FKeyUpEvent;
property OnDragEnter: TControlDragEvent read FDragEnterEvent write FDragEnterEvent; property OnDragEnter: TControlDragEvent read FDragEnterEvent write FDragEnterEvent;
property OnDragOver: TControlDragOverEvent read FDragOverEvent write FDragOverEvent; property OnDragOver: TControlDragOverEvent read FDragOverEvent write FDragOverEvent;
property OnDragDrop: TControlDragEvent read FDragDropEvent write FDragDropEvent; property OnDragDrop: TControlDragEvent read FDragDropEvent write FDragDropEvent;
property OnDragLeave: TControlNotifyEvent read FDragLeaveEvent write FDragLeaveEvent; property OnDragLeave: TControlNotifyEvent read FDragLeaveEvent write FDragLeaveEvent;
property OnDragEnd: TControlNotifyEvent read FDragEndEvent write FDragEndEvent; property OnDragEnd: TControlNotifyEvent read FDragEndEvent write FDragEndEvent;
property OnEnter: TControlNotifyEvent read FEnterEvent write FEnterEvent; property OnEnter: TControlNotifyEvent read FEnterEvent write FEnterEvent;
property OnExit: TControlNotifyEvent read FExitEvent write FExitEvent; property OnExit: TControlNotifyEvent read FExitEvent write FExitEvent;
property OnMouseEnter: TControlNotifyEvent read FMouseEnterEvent write FMouseEnterEvent; property OnMouseEnter: TControlNotifyEvent read FMouseEnterEvent write FMouseEnterEvent;
property OnMouseLeave: TControlNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent; property OnMouseLeave: TControlNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent;
property OnResize: TControlNotifyEvent read FResizeEvent write FResizeEvent; property OnResize: TControlNotifyEvent read FResizeEvent write FResizeEvent;
property OnResized: TControlNotifyEvent read FResizedEvent write FResizedEvent; property OnResized: TControlNotifyEvent read FResizedEvent write FResizedEvent;
property OnCanFocus: TControlCanFocusEvent read FCanFocusEvent write FCanFocusEvent; property OnCanFocus: TControlCanFocusEvent read FCanFocusEvent write FCanFocusEvent;
property OnShowContextMenu: TControlShowContextMenuEvent read FShowContextMenuEvent write FShowContextMenuEvent; property OnShowContextMenu: TControlShowContextMenuEvent read FShowContextMenuEvent write FShowContextMenuEvent;
property OnSetHint: TControlSetHintEvent read FSetHintEvent write FSetHintEvent; property OnSetHint: TControlSetHintEvent read FSetHintEvent write FSetHintEvent;
property OnGetHintString: TControlGetHintStringEvent read FGetHintStringEvent write FGetHintStringEvent; property OnGetHintString: TControlGetHintStringEvent read FGetHintStringEvent write FGetHintStringEvent;
property OnHasHint: TControlHasHintEvent read FHasHintEvent write FHasHintEvent; property OnHasHint: TControlHasHintEvent read FHasHintEvent write FHasHintEvent;
property OnCanShowHint: TControlCanShowHintEvent read FCanShowHintEvent write FCanShowHintEvent; property OnCanShowHint: TControlCanShowHintEvent read FCanShowHintEvent write FCanShowHintEvent;
property OnGetDefaultSize: TControlGetDefaultSizeEvent read FGetDefaultSizeEvent write FGetDefaultSizeEvent; property OnGetDefaultSize: TControlGetDefaultSizeEvent read FGetDefaultSizeEvent write FGetDefaultSizeEvent;
property OnRecalculateAbsoluteMatrices: TControlNotifyEvent read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent; property OnRecalculateAbsoluteMatrices: TControlNotifyEvent
property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent; read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent;
property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent; property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent;
property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent; property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent;
end; property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent;
end;
implementation implementation
@@ -139,241 +147,241 @@ implementation
constructor TDynamicControl.Create(AOwner: TComponent); constructor TDynamicControl.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
Width := 150; Width := 150;
Height := 100; Height := 100;
HitTest := True; HitTest := True;
end; end;
function TDynamicControl.CanShowHint: Boolean; function TDynamicControl.CanShowHint: Boolean;
begin begin
if Assigned(FCanShowHintEvent) then if Assigned(FCanShowHintEvent) then
Result := FCanShowHintEvent Result := FCanShowHintEvent
else else
Result := inherited CanShowHint; Result := inherited CanShowHint;
end; end;
procedure TDynamicControl.Click; procedure TDynamicControl.Click;
begin begin
inherited Click; inherited Click;
if Assigned(FClickEvent) then if Assigned(FClickEvent) then
FClickEvent; FClickEvent;
end; end;
procedure TDynamicControl.DblClick; procedure TDynamicControl.DblClick;
begin begin
inherited DblClick; inherited DblClick;
if Assigned(FDblClickEvent) then if Assigned(FDblClickEvent) then
FDblClickEvent; FDblClickEvent;
end; end;
procedure TDynamicControl.DoAbsoluteChanged; procedure TDynamicControl.DoAbsoluteChanged;
begin begin
inherited DoAbsoluteChanged; inherited DoAbsoluteChanged;
if Assigned(FDoAbsoluteChangedEvent) then if Assigned(FDoAbsoluteChangedEvent) then
FDoAbsoluteChangedEvent; FDoAbsoluteChangedEvent;
end; end;
procedure TDynamicControl.DragDrop(const Data: TDragObject; const Point: TPointF); procedure TDynamicControl.DragDrop(const Data: TDragObject; const Point: TPointF);
begin begin
inherited DragDrop(Data, Point); inherited DragDrop(Data, Point);
if Assigned(FDragDropEvent) then if Assigned(FDragDropEvent) then
FDragDropEvent(Data, Point); FDragDropEvent(Data, Point);
end; end;
procedure TDynamicControl.DragEnd; procedure TDynamicControl.DragEnd;
begin begin
inherited DragEnd; inherited DragEnd;
if Assigned(FDragEndEvent) then if Assigned(FDragEndEvent) then
FDragEndEvent; FDragEndEvent;
end; end;
procedure TDynamicControl.DragEnter(const Data: TDragObject; const Point: TPointF); procedure TDynamicControl.DragEnter(const Data: TDragObject; const Point: TPointF);
begin begin
inherited DragEnter(Data, Point); inherited DragEnter(Data, Point);
if Assigned(FDragEnterEvent) then if Assigned(FDragEnterEvent) then
FDragEnterEvent(Data, Point); FDragEnterEvent(Data, Point);
end; end;
procedure TDynamicControl.DragLeave; procedure TDynamicControl.DragLeave;
begin begin
inherited DragLeave; inherited DragLeave;
if Assigned(FDragLeaveEvent) then if Assigned(FDragLeaveEvent) then
FDragLeaveEvent; FDragLeaveEvent;
end; end;
procedure TDynamicControl.DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); procedure TDynamicControl.DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
begin begin
inherited DragOver(Data, Point, Operation); inherited DragOver(Data, Point, Operation);
if Assigned(FDragOverEvent) then if Assigned(FDragOverEvent) then
FDragOverEvent(Data, Point, Operation); FDragOverEvent(Data, Point, Operation);
end; end;
procedure TDynamicControl.DoEnter; procedure TDynamicControl.DoEnter;
begin begin
inherited DoEnter; inherited DoEnter;
if Assigned(FEnterEvent) then if Assigned(FEnterEvent) then
FEnterEvent; FEnterEvent;
end; end;
procedure TDynamicControl.DoExit; procedure TDynamicControl.DoExit;
begin begin
inherited DoExit; inherited DoExit;
if Assigned(FExitEvent) then if Assigned(FExitEvent) then
FExitEvent; FExitEvent;
end; end;
procedure TDynamicControl.DoMouseEnter; procedure TDynamicControl.DoMouseEnter;
begin begin
inherited DoMouseEnter; inherited DoMouseEnter;
if Assigned(FMouseEnterEvent) then if Assigned(FMouseEnterEvent) then
FMouseEnterEvent; FMouseEnterEvent;
end; end;
procedure TDynamicControl.DoMouseLeave; procedure TDynamicControl.DoMouseLeave;
begin begin
inherited DoMouseLeave; inherited DoMouseLeave;
if Assigned(FMouseLeaveEvent) then if Assigned(FMouseLeaveEvent) then
FMouseLeaveEvent; FMouseLeaveEvent;
end; end;
procedure TDynamicControl.DoResized; procedure TDynamicControl.DoResized;
begin begin
inherited DoResized; inherited DoResized;
if Assigned(FResizedEvent) then if Assigned(FResizedEvent) then
FResizedEvent; FResizedEvent;
end; end;
function TDynamicControl.GetCanFocus: Boolean; function TDynamicControl.GetCanFocus: Boolean;
begin begin
if Assigned(FCanFocusEvent) then if Assigned(FCanFocusEvent) then
Result := FCanFocusEvent Result := FCanFocusEvent
else else
Result := inherited GetCanFocus; Result := inherited GetCanFocus;
end; end;
function TDynamicControl.GetDefaultSize: TSizeF; function TDynamicControl.GetDefaultSize: TSizeF;
begin begin
if Assigned(FGetDefaultSizeEvent) then if Assigned(FGetDefaultSizeEvent) then
Result := FGetDefaultSizeEvent Result := FGetDefaultSizeEvent
else else
Result := inherited GetDefaultSize; Result := inherited GetDefaultSize;
end; end;
function TDynamicControl.GetHintString: string; function TDynamicControl.GetHintString: string;
begin begin
if Assigned(FGetHintStringEvent) then if Assigned(FGetHintStringEvent) then
Result := FGetHintStringEvent Result := FGetHintStringEvent
else else
Result := inherited GetHintString; Result := inherited GetHintString;
end; end;
function TDynamicControl.HasHint: Boolean; function TDynamicControl.HasHint: Boolean;
begin begin
if Assigned(FHasHintEvent) then if Assigned(FHasHintEvent) then
Result := FHasHintEvent Result := FHasHintEvent
else else
Result := inherited HasHint; Result := inherited HasHint;
end; end;
procedure TDynamicControl.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); procedure TDynamicControl.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
begin begin
inherited KeyDown(Key, KeyChar, Shift); inherited KeyDown(Key, KeyChar, Shift);
if Assigned(FKeyDownEvent) then if Assigned(FKeyDownEvent) then
FKeyDownEvent(Key, KeyChar, Shift); FKeyDownEvent(Key, KeyChar, Shift);
end; end;
procedure TDynamicControl.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); procedure TDynamicControl.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
begin begin
inherited KeyUp(Key, KeyChar, Shift); inherited KeyUp(Key, KeyChar, Shift);
if Assigned(FKeyUpEvent) then if Assigned(FKeyUpEvent) then
FKeyUpEvent(Key, KeyChar, Shift); FKeyUpEvent(Key, KeyChar, Shift);
end; end;
procedure TDynamicControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure TDynamicControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin begin
inherited MouseDown(Button, Shift, X, Y); inherited MouseDown(Button, Shift, X, Y);
if Assigned(FMouseDownEvent) then if Assigned(FMouseDownEvent) then
FMouseDownEvent(Button, Shift, X, Y); FMouseDownEvent(Button, Shift, X, Y);
end; end;
procedure TDynamicControl.MouseMove(Shift: TShiftState; X, Y: Single); procedure TDynamicControl.MouseMove(Shift: TShiftState; X, Y: Single);
begin begin
inherited MouseMove(Shift, X, Y); inherited MouseMove(Shift, X, Y);
if Assigned(FMouseMoveEvent) then if Assigned(FMouseMoveEvent) then
FMouseMoveEvent(Shift, X, Y); FMouseMoveEvent(Shift, X, Y);
end; end;
procedure TDynamicControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure TDynamicControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin begin
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
if Assigned(FMouseUpEvent) then if Assigned(FMouseUpEvent) then
FMouseUpEvent(Button, Shift, X, Y); FMouseUpEvent(Button, Shift, X, Y);
end; end;
procedure TDynamicControl.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); procedure TDynamicControl.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
begin begin
inherited MouseWheel(Shift, WheelDelta, Handled); inherited MouseWheel(Shift, WheelDelta, Handled);
if Assigned(FMouseWheelEvent) then if Assigned(FMouseWheelEvent) then
FMouseWheelEvent(Shift, WheelDelta, Handled); FMouseWheelEvent(Shift, WheelDelta, Handled);
end; end;
procedure TDynamicControl.Paint; procedure TDynamicControl.Paint;
begin begin
inherited Paint; inherited Paint;
if Assigned(FPaintEvent) then if Assigned(FPaintEvent) then
FPaintEvent FPaintEvent
else else
begin begin
Canvas.Fill.Color := TAlphaColors.LightSteelBlue; Canvas.Fill.Color := TAlphaColors.LightSteelBlue;
Canvas.FillRect(LocalRect, 0, 0, [], 1); Canvas.FillRect(LocalRect, 0, 0, [], 1);
Canvas.Stroke.Color := TAlphaColors.Gray; Canvas.Stroke.Color := TAlphaColors.Gray;
Canvas.Stroke.Thickness := 1; Canvas.Stroke.Thickness := 1;
Canvas.DrawRect(LocalRect, 0, 0, [], 1); Canvas.DrawRect(LocalRect, 0, 0, [], 1);
end; end;
end; end;
procedure TDynamicControl.RecalculateAbsoluteMatrices; procedure TDynamicControl.RecalculateAbsoluteMatrices;
begin begin
inherited RecalculateAbsoluteMatrices; inherited RecalculateAbsoluteMatrices;
if Assigned(FRecalculateAbsoluteMatricesEvent) then if Assigned(FRecalculateAbsoluteMatricesEvent) then
FRecalculateAbsoluteMatricesEvent; FRecalculateAbsoluteMatricesEvent;
end; end;
procedure TDynamicControl.Resize; procedure TDynamicControl.Resize;
begin begin
inherited Resize; inherited Resize;
if Assigned(FResizeEvent) then if Assigned(FResizeEvent) then
FResizeEvent; FResizeEvent;
end; end;
procedure TDynamicControl.SetEnabled(const Value: Boolean); procedure TDynamicControl.SetEnabled(const Value: Boolean);
begin begin
inherited SetEnabled(Value); inherited SetEnabled(Value);
if Assigned(FSetEnabledEvent) then if Assigned(FSetEnabledEvent) then
FSetEnabledEvent(Value); FSetEnabledEvent(Value);
end; end;
procedure TDynamicControl.SetHint(const AHint: string); procedure TDynamicControl.SetHint(const AHint: string);
begin begin
inherited SetHint(AHint); inherited SetHint(AHint);
if Assigned(FSetHintEvent) then if Assigned(FSetHintEvent) then
FSetHintEvent(AHint); FSetHintEvent(AHint);
end; end;
procedure TDynamicControl.SetVisible(const Value: Boolean); procedure TDynamicControl.SetVisible(const Value: Boolean);
begin begin
inherited SetVisible(Value); inherited SetVisible(Value);
if Assigned(FSetVisibleEvent) then if Assigned(FSetVisibleEvent) then
FSetVisibleEvent(Value); FSetVisibleEvent(Value);
end; end;
function TDynamicControl.ShowContextMenu(const ScreenPosition: TPointF): Boolean; function TDynamicControl.ShowContextMenu(const ScreenPosition: TPointF): Boolean;
begin begin
if Assigned(FShowContextMenuEvent) then if Assigned(FShowContextMenuEvent) then
Result := FShowContextMenuEvent(ScreenPosition) Result := FShowContextMenuEvent(ScreenPosition)
else else
Result := inherited ShowContextMenu(ScreenPosition); Result := inherited ShowContextMenu(ScreenPosition);
end; end;
end. end.
AuraTrader/MainForm.pas
+33 -41
View File
@@ -158,55 +158,45 @@ begin
var stateText := TWriteable<String>.CreateWriteable.Protect; var stateText := TWriteable<String>.CreateWriteable.Protect;
var stateLabel := TLabel.Create(Self); var stateLabel := TLabel.Create(Self);
AlignControl( stateLabel ); AlignControl(stateLabel);
stateLabel.Text := 'Initializing...'; stateLabel.Text := 'Initializing...';
var chart := TMycChart.Create(Self); var chart := TMycChart.Create(Self);
AlignControl( chart ); AlignControl(chart);
chart.Height := Layout.ChildrenRect.Width*9/16; chart.Height := Layout.ChildrenRect.Width * 9 / 16;
chart.Lookback.Value := 50000; chart.Lookback.Value := 50000;
///// /////
var OhlcPoint: ITicksToTimeframe := TTicksToTimeframe.Create( H1, stateText ); var OhlcPoint: ITicksToTimeframe := TTicksToTimeframe.Create(H1, stateText);
var Ohlc: IMycConverter<TDataPoint<TOhlcItem>, TOhlcItem> := TMycGenericConverter<TDataPoint<TOhlcItem>, TOhlcItem>.Create( var Ohlc: IMycConverter<TDataPoint<TOhlcItem>, TOhlcItem> :=
function( const Ohlc: TDataPoint<TOhlcItem> ): TOhlcItem TMycGenericConverter<TDataPoint<TOhlcItem>, TOhlcItem>
begin .Create(function(const Ohlc: TDataPoint<TOhlcItem>): TOhlcItem begin Result := Ohlc.Data; end);
Result := Ohlc.Data;
end );
OhlcPoint.Sender.Link(Ohlc); OhlcPoint.Sender.Link(Ohlc);
var Closes: IMycConverter<TOhlcItem, Double> := TMycGenericConverter<TOhlcItem, Double>.Create( var Closes: IMycConverter<TOhlcItem, Double> :=
function( const Ohlc: TOhlcItem ): Double TMycGenericConverter<TOhlcItem, Double>.Create(function(const Ohlc: TOhlcItem): Double begin Result := Ohlc.Close; end);
begin
Result := Ohlc.Close;
end );
Ohlc.Sender.Link( Closes ); Ohlc.Sender.Link(Closes);
var Hull: IMycConverter<Double, Double> := THullMovingAverage.Create( 250 ); var Hull: IMycConverter<Double, Double> := THullMovingAverage.Create(250);
Closes.Sender.Link( Hull ); Closes.Sender.Link(Hull);
chart.AddDoubleSeries( Hull.Sender ); chart.AddDoubleSeries(Hull.Sender);
var done := ExecuteStrategy( Symbol, OhlcPoint ); var done := ExecuteStrategy(Symbol, OhlcPoint);
///// /////
stateLabel.ProcessSignal( stateLabel.ProcessSignal(stateText.Changed, done, procedure begin stateLabel.Text := stateText.Value; end);
stateText.Changed, done,
procedure
begin
stateLabel.Text := stateText.Value;
end );
FProcessDone := TState.All([FProcessDone, done]); FProcessDone := TState.All([FProcessDone, done]);
chart.AddOhlcSeries( OhlcPoint.Sender ); chart.AddOhlcSeries(OhlcPoint.Sender);
end; end;
procedure TForm1.TreeViewDblClick(Sender: TObject); procedure TForm1.TreeViewDblClick(Sender: TObject);
@@ -272,7 +262,6 @@ begin
// Create an instance of the TAuraTABFileServer. The server can be reused for multiple stream creations. [364] // Create an instance of the TAuraTABFileServer. The server can be reused for multiple stream creations. [364]
FServer := TAuraTABFileServer.Create('\\COFFEE\TickData\Pepperstone'); FServer := TAuraTABFileServer.Create('\\COFFEE\TickData\Pepperstone');
SymbolsComboBox.Enabled := false; SymbolsComboBox.Enabled := false;
ChartButton.Enabled := false; ChartButton.Enabled := false;
LoadButton.Enabled := false; LoadButton.Enabled := false;
@@ -418,7 +407,7 @@ begin
Control.Parent := Layout; Control.Parent := Layout;
Control.Width := Layout.Width; Control.Width := Layout.Width;
Control.Position.Y := Layout.ChildrenRect.Bottom+1; Control.Position.Y := Layout.ChildrenRect.Bottom + 1;
Control.Anchors := [TAnchorKind.akLeft, TAnchorKind.akRight]; Control.Anchors := [TAnchorKind.akLeft, TAnchorKind.akRight];
Control.Align := TAlignLayout.Top; Control.Align := TAlignLayout.Top;
end; end;
@@ -471,7 +460,8 @@ begin
PathData.ClosePath; PathData.ClosePath;
currPathData.Value := TObjectRef<TPathData>.Create(PathData); currPathData.Value := TObjectRef<TPathData>.Create(PathData);
end ) end
)
); );
end end
); );
@@ -520,21 +510,23 @@ var
begin begin
var terminated := TFlag.CreateObserver(FTerminate.Signal).State; var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
dataProvider := TMycGenericConverter<TArray<TDataPoint<TAuraAskBidFileItem>>, TArray<TDataPoint<TAskBidItem>>>.Create( dataProvider :=
function( const Values: TArray<TDataPoint<TAuraAskBidFileItem>> ): TArray<TDataPoint<TAskBidItem>> TMycGenericConverter<TArray<TDataPoint<TAuraAskBidFileItem>>, TArray<TDataPoint<TAskBidItem>>>.Create(
begin function(const Values: TArray<TDataPoint<TAuraAskBidFileItem>>): TArray<TDataPoint<TAskBidItem>>
SetLength( Result, Length( Values ) );
for var i:=0 to High(Result) do
begin begin
Result[i].Time := Values[i].Time; SetLength(Result, Length(Values));
Result[i].Data.Ask := Values[i].Data.Ask; for var i := 0 to High(Result) do
Result[i].Data.Bid := Values[i].Data.Bid; begin
end; Result[i].Time := Values[i].Time;
end ); Result[i].Data.Ask := Values[i].Data.Ask;
Result[i].Data.Bid := Values[i].Data.Bid;
end;
end
);
dataProvider.Sender.Link( Processor ); dataProvider.Sender.Link(Processor);
Result := FServer.ProcessData( Symbol, terminated, dataProvider ); Result := FServer.ProcessData(Symbol, terminated, dataProvider);
end; end;
function TForm1.SelectedSymbol: String; function TForm1.SelectedSymbol: String;
AuraTrader/TestModule.pas
+1 -1
View File
@@ -6,7 +6,7 @@ uses
Myc.Aura.Module; Myc.Aura.Module;
type type
TTestModule = class( TMycAuraNode, IAuraModule ) TTestModule = class(TMycAuraNode, IAuraModule)
private private
FId: Integer; FId: Integer;
public public
Blockly/Delphi/BlocklyTest.dpr
+7 -7
View File
@@ -1,15 +1,15 @@
program BlocklyTest; program BlocklyTest;
uses uses
System.StartUpCopy, System.StartUpCopy,
FMX.Forms, FMX.Forms,
MainUnit in 'MainUnit.pas' {MainForm}, MainUnit in 'MainUnit.pas' {MainForm},
LLVM.Runner in 'LLVM.Runner.pas'; LLVM.Runner in 'LLVM.Runner.pas';
{$R *.res} {$R *.res}
begin begin
Application.Initialize; Application.Initialize;
Application.CreateForm(TMainForm, MainForm); Application.CreateForm(TMainForm, MainForm);
Application.Run; Application.Run;
end. end.
Blockly/Delphi/LLVM.Runner.pas
+28 -25
View File
@@ -3,37 +3,40 @@ unit LLVM.Runner;
interface interface
uses uses
System.SysUtils, Winapi.Windows, System.Classes; System.SysUtils,
Winapi.Windows,
System.Classes;
type type
// Callback-Prozedur, die von der DLL aufgerufen wird // Callback-Prozedur, die von der DLL aufgerufen wird
TLogIntegerCallback = procedure( AValue: Integer ); stdcall; TLogIntegerCallback = procedure(AValue: Integer); stdcall;
// NEU: Typ für die Host-Additionsfunktion // NEU: Typ für die Host-Additionsfunktion
THostAddIntegersCallback = function( ANum1: Integer; ANum2: Integer ): Integer; stdcall; THostAddIntegersCallback = function(ANum1: Integer; ANum2: Integer): Integer; stdcall;
// NEUE, VEREINFACHTE Signatur der exportierten DLL-Funktion // NEUE, VEREINFACHTE Signatur der exportierten DLL-Funktion
// Jetzt nur noch der Log-Callback und der neue Integer-Input-Parameter // Jetzt nur noch der Log-Callback und der neue Integer-Input-Parameter
TStarteLogikProc = procedure( TStarteLogikProc =
ALogIntProc: TLogIntegerCallback; procedure(
AHostInputInteger: Integer; ALogIntProc: TLogIntegerCallback;
AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter AHostInputInteger: Integer;
); stdcall; AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter
); stdcall;
type type
TLLVMRunner = class TLLVMRunner = class
private private
FModule: HMODULE; FModule: HMODULE;
FStarteLogik: TStarteLogikProc; FStarteLogik: TStarteLogikProc;
class var class var
FLog: TStrings; FLog: TStrings;
class procedure LogInteger( AValue: Integer ); static; stdcall; class procedure LogInteger(AValue: Integer); static; stdcall;
// NEU: Host-Unterprogramm-Implementierung // NEU: Host-Unterprogramm-Implementierung
class function HostAddIntegers( ANum1: Integer; ANum2: Integer ): Integer; static; stdcall; class function HostAddIntegers(ANum1: Integer; ANum2: Integer): Integer; static; stdcall;
public public
constructor Create(const ADLLPath: string); constructor Create(const ADLLPath: string);
destructor Destroy; override; destructor Destroy; override;
procedure Execute( AInputInteger: Integer ); procedure Execute(AInputInteger: Integer);
class property Log: TStrings read FLog write FLog; class property Log: TStrings read FLog write FLog;
end; end;
@@ -44,24 +47,24 @@ implementation
constructor TLLVMRunner.Create(const ADLLPath: string); constructor TLLVMRunner.Create(const ADLLPath: string);
begin begin
inherited Create; inherited Create;
FModule := LoadLibrary( PChar( ADLLPath ) ); FModule := LoadLibrary(PChar(ADLLPath));
if FModule = 0 then if FModule = 0 then
raise Exception.Create( 'Failed to load DLL.' ); raise Exception.Create('Failed to load DLL.');
FStarteLogik := GetProcAddress( FModule, 'StarteLogik' ); FStarteLogik := GetProcAddress(FModule, 'StarteLogik');
if not Assigned( FStarteLogik ) then if not Assigned(FStarteLogik) then
raise Exception.Create( 'Procedure "StarteLogik" not found in DLL.' ); raise Exception.Create('Procedure "StarteLogik" not found in DLL.');
end; end;
destructor TLLVMRunner.Destroy; destructor TLLVMRunner.Destroy;
begin begin
if FModule <> 0 then if FModule <> 0 then
FreeLibrary( FModule ); FreeLibrary(FModule);
inherited; inherited;
end; end;
// NEUE Implementierung der Host-Funktion // NEUE Implementierung der Host-Funktion
class function TLLVMRunner.HostAddIntegers( ANum1: Integer; ANum2: Integer ): Integer; class function TLLVMRunner.HostAddIntegers(ANum1: Integer; ANum2: Integer): Integer;
begin begin
Result := ANum1 + ANum2; // Die eigentliche Logik Result := ANum1 + ANum2; // Die eigentliche Logik
if Assigned(FLog) then if Assigned(FLog) then
@@ -69,9 +72,9 @@ begin
end; end;
// Die Execute-Methode muss angepasst werden, um den neuen Funktionszeiger zu übergeben // Die Execute-Methode muss angepasst werden, um den neuen Funktionszeiger zu übergeben
procedure TLLVMRunner.Execute( AInputInteger: Integer ); procedure TLLVMRunner.Execute(AInputInteger: Integer);
begin begin
if Assigned( FStarteLogik ) then if Assigned(FStarteLogik) then
FStarteLogik( FStarteLogik(
LogInteger, LogInteger,
AInputInteger, AInputInteger,
@@ -80,10 +83,10 @@ begin
end; end;
// Dies ist die Methode, die die DLL für LogInteger aufruft. // Dies ist die Methode, die die DLL für LogInteger aufruft.
class procedure TLLVMRunner.LogInteger( AValue: Integer ); class procedure TLLVMRunner.LogInteger(AValue: Integer);
begin begin
if Assigned( FLog ) then if Assigned(FLog) then
FLog.Add( Format( 'DLL logged integer: %d', [AValue] ) ); FLog.Add(Format('DLL logged integer: %d', [AValue]));
end; end;
// Die Implementierungen von GetCurrentDateTimeUTCHost und GetComponentInZoneHost // Die Implementierungen von GetCurrentDateTimeUTCHost und GetComponentInZoneHost
Blockly/Delphi/MainUnit.pas
+119 -140
View File
@@ -3,12 +3,32 @@ unit MainUnit;
interface interface
uses uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.SysUtils,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.WebBrowser, System.Types,
Winapi.WebView2, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Edit, FMX.StdActns, System.UITypes,
System.Classes,
System.Variants,
FMX.Types,
FMX.Controls,
FMX.Forms,
FMX.Graphics,
FMX.Dialogs,
FMX.Controls.Presentation,
FMX.StdCtrls,
FMX.WebBrowser,
Winapi.WebView2,
FMX.Memo.Types,
FMX.ScrollBox,
FMX.Memo,
FMX.Edit,
FMX.StdActns,
// FMX.Edit für TEdit, FMX.StdActns oft für Standardaktionen // FMX.Edit für TEdit, FMX.StdActns oft für Standardaktionen
// Korrekte und vollständige Units // Korrekte und vollständige Units
System.IOUtils, System.Threading, System.Diagnostics, Winapi.Windows, LLVM.Runner; System.IOUtils,
System.Threading,
System.Diagnostics,
Winapi.Windows,
LLVM.Runner;
const const
// Pfad zur HTML-Datei (BITTE HIER ANPASSEN!) // Pfad zur HTML-Datei (BITTE HIER ANPASSEN!)
@@ -19,27 +39,27 @@ const
LLD_PATH = 'lld-link.exe'; // <--- PRÜFEN UND ANPASSEN! LLD_PATH = 'lld-link.exe'; // <--- PRÜFEN UND ANPASSEN!
type type
TMainForm = class( TForm ) TMainForm = class(TForm)
WebBrowser1: TWebBrowser; WebBrowser1: TWebBrowser;
SaveWorkspaceButton: TSpeedButton; SaveWorkspaceButton: TSpeedButton;
GenerateCodeButton: TSpeedButton; GenerateCodeButton: TSpeedButton;
Memo: TMemo; Memo: TMemo;
InputEdit: TEdit; // <--- Hinzugefügt (Optional für Beschriftung des InputEdit) InputEdit: TEdit; // <--- Hinzugefügt (Optional für Beschriftung des InputEdit)
procedure FormCreate( Sender: TObject ); procedure FormCreate(Sender: TObject);
procedure FormDestroy( Sender: TObject ); procedure FormDestroy(Sender: TObject);
procedure RefreshButtonClick( Sender: TObject ); procedure RefreshButtonClick(Sender: TObject);
procedure SaveWorkspaceButtonClick( Sender: TObject ); procedure SaveWorkspaceButtonClick(Sender: TObject);
procedure GenerateCodeButtonClick( Sender: TObject ); procedure GenerateCodeButtonClick(Sender: TObject);
procedure WebBrowser1DidFinishLoad( ASender: TObject ); procedure WebBrowser1DidFinishLoad(ASender: TObject);
private private
{ Private declarations } { Private declarations }
FWebView: ICoreWebView2; FWebView: ICoreWebView2;
FWebMessageReceiver: ICoreWebView2WebMessageReceivedEventHandler; FWebMessageReceiver: ICoreWebView2WebMessageReceivedEventHandler;
FWebMessageReceivedToken: EventRegistrationToken; FWebMessageReceivedToken: EventRegistrationToken;
procedure HandleWebMessage( const AMessage: string ); procedure HandleWebMessage(const AMessage: string);
function ExecuteProcess( const ACommand: string; const AParameters: string ): string; function ExecuteProcess(const ACommand: string; const AParameters: string): string;
public public
{ Public declarations } { Public declarations }
end; end;
var var
@@ -49,55 +69,50 @@ implementation
{$R *.fmx} {$R *.fmx}
type type
TWebMessageReceiver = class( TInterfacedObject, ICoreWebView2WebMessageReceivedEventHandler ) TWebMessageReceiver = class(TInterfacedObject, ICoreWebView2WebMessageReceivedEventHandler)
private private
FOwner: TMainForm; FOwner: TMainForm;
public public
constructor Create( AOwner: TMainForm ); constructor Create(AOwner: TMainForm);
function Invoke( const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs ): HResult; stdcall; function Invoke(const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs): HResult; stdcall;
end; end;
constructor TWebMessageReceiver.Create( AOwner: TMainForm ); constructor TWebMessageReceiver.Create(AOwner: TMainForm);
begin begin
inherited Create; inherited Create;
FOwner := AOwner; FOwner := AOwner;
end; end;
function TWebMessageReceiver.Invoke( const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs ): HResult; function TWebMessageReceiver.Invoke(const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs): HResult;
var var
message: PWideChar; message: PWideChar;
begin begin
Result := args.TryGetWebMessageAsString( message ); Result := args.TryGetWebMessageAsString(message);
if Succeeded( Result ) then if Succeeded(Result) then
begin begin
TThread.Queue( nil, TThread.Queue(nil, procedure begin FOwner.HandleWebMessage(string(message)); end);
procedure
begin
FOwner.HandleWebMessage( string( message ) );
end );
end; end;
Result := S_OK; Result := S_OK;
end; end;
procedure TMainForm.FormCreate( Sender: TObject ); procedure TMainForm.FormCreate(Sender: TObject);
begin begin
TLLVMRunner.Log := Memo.Lines; TLLVMRunner.Log := Memo.Lines;
// Optional: Standardwert für InputEdit // Optional: Standardwert für InputEdit
InputEdit.Text := '123'; InputEdit.Text := '123';
end; end;
procedure TMainForm.FormDestroy( Sender: TObject ); procedure TMainForm.FormDestroy(Sender: TObject);
begin begin
TLLVMRunner.Log := nil; TLLVMRunner.Log := nil;
if ( FWebView <> nil ) and ( FWebMessageReceivedToken.value <> 0 ) then if (FWebView <> nil) and (FWebMessageReceivedToken.value <> 0) then
begin begin
FWebView.remove_WebMessageReceived( FWebMessageReceivedToken ); FWebView.remove_WebMessageReceived(FWebMessageReceivedToken);
end; end;
end; end;
function TMainForm.ExecuteProcess( const ACommand: string; const AParameters: string ): string; function TMainForm.ExecuteProcess(const ACommand: string; const AParameters: string): string;
var var
sa: TSecurityAttributes; sa: TSecurityAttributes;
si: TStartupInfo; si: TStartupInfo;
@@ -110,63 +125,52 @@ var
output, errors: string; output, errors: string;
begin begin
// Pipe für StdOut und StdErr erstellen // Pipe für StdOut und StdErr erstellen
sa.nLength := SizeOf( TSecurityAttributes ); sa.nLength := SizeOf(TSecurityAttributes);
sa.lpSecurityDescriptor := nil; sa.lpSecurityDescriptor := nil;
sa.bInheritHandle := True; sa.bInheritHandle := True;
// Für stdout und stderr wird dieselbe Pipe verwendet, da clang Fehler auf stdout ausgibt // Für stdout und stderr wird dieselbe Pipe verwendet, da clang Fehler auf stdout ausgibt
if not CreatePipe( stdOutRead, stdOutWrite, @sa, 0 ) then if not CreatePipe(stdOutRead, stdOutWrite, @sa, 0) then
Exit( 'Error creating pipe.' ); Exit('Error creating pipe.');
try try
// StartupInfo vorbereiten // StartupInfo vorbereiten
FillChar( si, SizeOf( TStartupInfo ), 0 ); FillChar(si, SizeOf(TStartupInfo), 0);
si.cb := SizeOf( TStartupInfo ); si.cb := SizeOf(TStartupInfo);
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE; // Fenster explizit verstecken si.wShowWindow := SW_HIDE; // Fenster explizit verstecken
si.hStdInput := GetStdHandle( STD_INPUT_HANDLE ); si.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
si.hStdOutput := stdOutWrite; si.hStdOutput := stdOutWrite;
si.hStdError := stdOutWrite; // Leite stderr auf dieselbe Pipe wie stdout si.hStdError := stdOutWrite; // Leite stderr auf dieselbe Pipe wie stdout
cmdLine := Format( '"%s" %s', [ACommand, AParameters] ); cmdLine := Format('"%s" %s', [ACommand, AParameters]);
success := CreateProcess( success := CreateProcess(nil, PChar(cmdLine), nil, nil, True, CREATE_NO_WINDOW, nil, nil, si, pi);
nil,
PChar( cmdLine ),
nil,
nil,
True,
CREATE_NO_WINDOW,
nil,
nil,
si,
pi
);
// Schreib-Handle der Pipe sofort schließen // Schreib-Handle der Pipe sofort schließen
CloseHandle( stdOutWrite ); CloseHandle(stdOutWrite);
if not success then if not success then
Exit( Format( 'CreateProcess failed. Code: %d', [GetLastError] ) ); Exit(Format('CreateProcess failed. Code: %d', [GetLastError]));
try try
output := ''; output := '';
// Warten, bis der Prozess fertig ist und alle Daten in die Pipe geschrieben hat // Warten, bis der Prozess fertig ist und alle Daten in die Pipe geschrieben hat
if WaitForSingleObject( pi.hProcess, 5000 ) = WAIT_TIMEOUT then // 5s Timeout if WaitForSingleObject(pi.hProcess, 5000) = WAIT_TIMEOUT then // 5s Timeout
begin begin
TerminateProcess( pi.hProcess, 1 ); TerminateProcess(pi.hProcess, 1);
Exit( 'Process timed out.' ); Exit('Process timed out.');
end; end;
// Bytes aus der Pipe lesen // Bytes aus der Pipe lesen
repeat repeat
SetLength( buffer, 1024 ); SetLength(buffer, 1024);
bytesRead := 0; bytesRead := 0;
if ReadFile( stdOutRead, buffer[0], Length( buffer ), bytesRead, nil ) and ( bytesRead > 0 ) then if ReadFile(stdOutRead, buffer[0], Length(buffer), bytesRead, nil) and (bytesRead > 0) then
begin begin
SetLength( buffer, bytesRead ); SetLength(buffer, bytesRead);
// Gelesene Bytes mit dem Default-System-Encoding in einen String umwandeln // Gelesene Bytes mit dem Default-System-Encoding in einen String umwandeln
output := output + TEncoding.Default.GetString( buffer ); output := output + TEncoding.Default.GetString(buffer);
end end
else else
begin begin
@@ -175,33 +179,33 @@ begin
until False; until False;
finally finally
CloseHandle( pi.hProcess ); CloseHandle(pi.hProcess);
CloseHandle( pi.hThread ); CloseHandle(pi.hThread);
end; end;
Result := output; Result := output;
finally finally
CloseHandle( stdOutRead ); CloseHandle(stdOutRead);
end; end;
end; end;
procedure TMainForm.RefreshButtonClick( Sender: TObject ); procedure TMainForm.RefreshButtonClick(Sender: TObject);
begin begin
WebBrowser1.Navigate( PATH_BLOCKLY ); WebBrowser1.Navigate(PATH_BLOCKLY);
end; end;
procedure TMainForm.SaveWorkspaceButtonClick( Sender: TObject ); procedure TMainForm.SaveWorkspaceButtonClick(Sender: TObject);
begin begin
WebBrowser1.EvaluateJavaScript( 'saveWorkspace()' ); WebBrowser1.EvaluateJavaScript('saveWorkspace()');
end; end;
procedure TMainForm.GenerateCodeButtonClick( Sender: TObject ); procedure TMainForm.GenerateCodeButtonClick(Sender: TObject);
begin begin
WebBrowser1.EvaluateJavaScript( 'generateAndPostCode()' ); WebBrowser1.EvaluateJavaScript('generateAndPostCode()');
end; end;
procedure TMainForm.HandleWebMessage( const AMessage: string ); procedure TMainForm.HandleWebMessage(const AMessage: string);
var var
llFile, objFile, dllFile: string; llFile, objFile, dllFile: string;
compilerOutput: string; compilerOutput: string;
@@ -209,16 +213,16 @@ var
InputInteger: Integer; // <--- Hinzugefügt InputInteger: Integer; // <--- Hinzugefügt
begin begin
Memo.Lines.Clear; Memo.Lines.Clear;
Memo.Lines.Add( 'LLVM-Code empfangen. Starte Kompilierung...' ); Memo.Lines.Add('LLVM-Code empfangen. Starte Kompilierung...');
Memo.Lines.Add( AMessage ); Memo.Lines.Add(AMessage);
Memo.Lines.Add( '--------------------' ); Memo.Lines.Add('--------------------');
// Wert aus dem InputEdit-Feld holen // Wert aus dem InputEdit-Feld holen
try try
InputInteger := StrToIntDef( InputEdit.Text, 0 ); // Standardwert 0, falls ungültig InputInteger := StrToIntDef(InputEdit.Text, 0); // Standardwert 0, falls ungültig
except except
InputInteger := 0; InputInteger := 0;
Memo.Lines.Add( 'WARNUNG: Ungültige Eingabe im InputEdit-Feld. Verwende 0.' ); Memo.Lines.Add('WARNUNG: Ungültige Eingabe im InputEdit-Feld. Verwende 0.');
end; end;
TTask.Run( TTask.Run(
@@ -228,107 +232,82 @@ begin
compilerOutputLocal: string; compilerOutputLocal: string;
successLocal: Boolean; successLocal: Boolean;
begin begin
llFileLocal := TPath.Combine( TPath.GetTempPath, 'poc.ll' ); llFileLocal := TPath.Combine(TPath.GetTempPath, 'poc.ll');
objFileLocal := TPath.ChangeExtension( llFileLocal, '.obj' ); objFileLocal := TPath.ChangeExtension(llFileLocal, '.obj');
dllFileLocal := TPath.ChangeExtension( llFileLocal, '.dll' ); dllFileLocal := TPath.ChangeExtension(llFileLocal, '.dll');
successLocal := False; successLocal := False;
try try
TFile.WriteAllText( llFileLocal, AMessage ); TFile.WriteAllText(llFileLocal, AMessage);
TThread.Queue( nil, TThread.Queue(nil, procedure begin Memo.Lines.Add('Kompiliere zu Objektdatei...'); end);
procedure compilerOutputLocal := ExecuteProcess(CLANG_PATH, Format('-c "%s" -o "%s"', [llFileLocal, objFileLocal]));
begin TThread.Queue(nil, procedure begin Memo.Lines.Add(compilerOutputLocal); end);
Memo.Lines.Add( 'Kompiliere zu Objektdatei...' );
end );
compilerOutputLocal := ExecuteProcess( CLANG_PATH, Format( '-c "%s" -o "%s"', [llFileLocal, objFileLocal] ) );
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( compilerOutputLocal );
end );
if not TFile.Exists( objFileLocal ) then if not TFile.Exists(objFileLocal) then
begin begin
TThread.Queue( nil, TThread
procedure .Queue(nil, procedure begin Memo.Lines.Add('FEHLER: Kompilierung fehlgeschlagen. .obj-Datei nicht erstellt.'); end);
begin
Memo.Lines.Add( 'FEHLER: Kompilierung fehlgeschlagen. .obj-Datei nicht erstellt.' );
end );
Exit; Exit;
end; end;
TThread.Queue( nil, TThread.Queue(nil, procedure begin Memo.Lines.Add('Linke zu DLL...'); end);
procedure compilerOutputLocal := ExecuteProcess(LLD_PATH, Format('/dll /noentry "%s" /out:"%s"', [objFileLocal, dllFileLocal]));
begin TThread.Queue(nil, procedure begin Memo.Lines.Add(compilerOutputLocal); end);
Memo.Lines.Add( 'Linke zu DLL...' );
end );
compilerOutputLocal := ExecuteProcess( LLD_PATH, Format( '/dll /noentry "%s" /out:"%s"', [objFileLocal, dllFileLocal] ) );
TThread.Queue( nil,
procedure
begin
Memo.Lines.Add( compilerOutputLocal );
end );
if TFile.Exists( dllFileLocal ) then if TFile.Exists(dllFileLocal) then
begin begin
successLocal := True; successLocal := True;
TThread.Queue( nil, TThread.Queue(nil, procedure begin Memo.Lines.Add(Format('ERFOLG: DLL wurde erstellt: %s', [dllFileLocal])); end);
procedure
begin
Memo.Lines.Add( Format( 'ERFOLG: DLL wurde erstellt: %s', [dllFileLocal] ) );
end );
end end
else else
begin begin
TThread.Queue( nil, TThread.Queue(nil, procedure begin Memo.Lines.Add('FEHLER: Linken fehlgeschlagen. .dll-Datei nicht erstellt.'); end);
procedure
begin
Memo.Lines.Add( 'FEHLER: Linken fehlgeschlagen. .dll-Datei nicht erstellt.' );
end );
end; end;
finally finally
if TFile.Exists( llFileLocal ) then if TFile.Exists(llFileLocal) then
TFile.Delete( llFileLocal ); TFile.Delete(llFileLocal);
if TFile.Exists( objFileLocal ) then if TFile.Exists(objFileLocal) then
TFile.Delete( objFileLocal ); TFile.Delete(objFileLocal);
if not successLocal and TFile.Exists( dllFileLocal ) then if not successLocal and TFile.Exists(dllFileLocal) then
TFile.Delete( dllFileLocal ); TFile.Delete(dllFileLocal);
end; end;
TThread.Queue( nil, TThread.Queue(
nil,
procedure procedure
begin begin
Memo.Lines.Add( '---------------------------------------------------------' ); Memo.Lines.Add('---------------------------------------------------------');
Memo.Lines.Add( 'DLL wird aufgerufen:' ); Memo.Lines.Add('DLL wird aufgerufen:');
if TFile.Exists( dllFileLocal ) then if TFile.Exists(dllFileLocal) then
begin begin
var var Runner := TLLVMRunner.Create(dllFileLocal);
Runner := TLLVMRunner.Create( dllFileLocal );
try try
Runner.Execute( InputInteger ); // <--- HIER DEN INPUT-PARAMETER ÜBERGEBEN Runner.Execute(InputInteger); // <--- HIER DEN INPUT-PARAMETER ÜBERGEBEN
finally finally
Runner.Free; Runner.Free;
end; end;
end; end;
Memo.Lines.Add( 'DLL beendet.' ); Memo.Lines.Add('DLL beendet.');
Memo.CaretPosition := TCaretPosition.Create( Memo.Lines.Count-1, 1 ); Memo.CaretPosition := TCaretPosition.Create(Memo.Lines.Count - 1, 1);
end ); end
end ); );
end
);
end; end;
procedure TMainForm.WebBrowser1DidFinishLoad( ASender: TObject ); procedure TMainForm.WebBrowser1DidFinishLoad(ASender: TObject);
begin begin
if Assigned( FWebMessageReceiver ) then if Assigned(FWebMessageReceiver) then
Exit; Exit;
if Supports( WebBrowser1, ICoreWebView2, FWebView ) then if Supports(WebBrowser1, ICoreWebView2, FWebView) then
begin begin
FWebMessageReceiver := TWebMessageReceiver.Create( Self ); FWebMessageReceiver := TWebMessageReceiver.Create(Self);
FWebView.add_WebMessageReceived( FWebMessageReceiver, FWebMessageReceivedToken ); FWebView.add_WebMessageReceived(FWebMessageReceiver, FWebMessageReceivedToken);
end; end;
end; end;
GoogleGeminiAccess/ApiKey.pas
+2 -1
View File
@@ -2,7 +2,8 @@ unit ApiKey;
interface interface
const Value = 'AIzaSyALccoMxn0_wcHswavhu5rzdglLeH6gVlI'; const
Value = 'AIzaSyALccoMxn0_wcHswavhu5rzdglLeH6gVlI';
implementation implementation
GoogleGeminiAccess/GeminiAccess.dpr
+8 -8
View File
@@ -1,16 +1,16 @@
program GeminiAccess; program GeminiAccess;
uses uses
FastMM5, FastMM5,
Vcl.Forms, Vcl.Forms,
MainUnit in 'MainUnit.pas' {Form1}, MainUnit in 'MainUnit.pas' {Form1},
ApiKey in 'ApiKey.pas'; ApiKey in 'ApiKey.pas';
{$R *.res} {$R *.res}
begin begin
Application.Initialize; Application.Initialize;
Application.MainFormOnTaskbar := True; Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1); Application.CreateForm(TForm1, Form1);
Application.Run; Application.Run;
end. end.
GoogleGeminiAccess/MainUnit.pas
+100 -76
View File
@@ -3,10 +3,24 @@ unit MainUnit;
interface interface
uses uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Winapi.Windows,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.Messages,
System.Net.HttpClient, System.Net.HttpClientComponent, System.JSON, System.Net.Mime, Vcl.AppEvnts, System.SysUtils,
Myc.Futures, System.Generics.Collections, ApiKey; System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
System.Net.HttpClient,
System.Net.HttpClientComponent,
System.JSON,
System.Net.Mime,
Vcl.AppEvnts,
Myc.Futures,
System.Generics.Collections,
ApiKey;
type type
// NEU: Ein Record, um einen einzelnen Redebeitrag in der Konversation zu speichern // NEU: Ein Record, um einen einzelnen Redebeitrag in der Konversation zu speichern
@@ -31,7 +45,7 @@ type
FChatHistory: TList<TChatTurn>; // NEU: Liste für den Konversationsverlauf FChatHistory: TList<TChatTurn>; // NEU: Liste für den Konversationsverlauf
procedure SendPrompt; procedure SendPrompt;
public public
{ Public declarations } { Public declarations }
end; end;
var var
@@ -127,78 +141,88 @@ begin
AnswerMemo.Lines.Add(userPrompt); AnswerMemo.Lines.Add(userPrompt);
AnswerMemo.Lines.Add('... sende Anfrage an Gemini ...'); AnswerMemo.Lines.Add('... sende Anfrage an Gemini ...');
FAnswer := TFuture<string>.Construct( FAnswer :=
function: string TFuture<string>.Construct(
var function: string
jsonRequest: TJSONObject; var
jsonContents: TJSONArray; jsonRequest: TJSONObject;
requestBody: TStringStream; jsonContents: TJSONArray;
response: IHTTPResponse; requestBody: TStringStream;
responseJson: TJSONValue; response: IHTTPResponse;
apiUrl: string; responseJson: TJSONValue;
turn: TChatTurn; apiUrl: string;
begin turn: TChatTurn;
try
// 1. JSON-Body aus dem gesamten Konversationsverlauf erstellen
jsonRequest := TJSONObject.Create;
try
jsonContents := TJSONArray.Create;
jsonRequest.AddPair('contents', jsonContents);
// NEU: Iteriere durch den Verlauf und baue die JSON-Struktur auf
for turn in FChatHistory do
begin
var jsonTurn := TJSONObject.Create;
jsonTurn.AddPair('role', TJSONString.Create(turn.Role));
var jsonParts := TJSONArray.Create;
jsonTurn.AddPair('parts', jsonParts);
var jsonText := TJSONObject.Create;
jsonText.AddPair('text', TJSONString.Create(turn.Text));
jsonParts.Add(jsonText);
jsonContents.Add(jsonTurn);
end;
// 2. Request senden
requestBody := TStringStream.Create(jsonRequest.ToString, TEncoding.UTF8);
try
apiUrl := API_BASE_URL + GEMINI_MODEL + ':generateContent?key=' + FMyApiKey;
response := FHttpClient.Post(apiUrl, requestBody, nil);
// 3. Antwort verarbeiten
if (response.StatusCode = 200) then
begin
responseJson := TJSONObject.ParseJSONValue(response.ContentAsString(TEncoding.UTF8));
try
Result := responseJson.GetValue<TJSONArray>('candidates')
.Items[0].GetValue<TJSONObject>('content')
.GetValue<TJSONArray>('parts')
.Items[0].GetValue<string>('text');
finally
responseJson.Free;
end;
end
else
begin
Result := 'Fehler! Status: ' + response.StatusCode.ToString + ' - ' + response.StatusText +
sLineBreak + response.ContentAsString;
end;
finally
requestBody.Free;
end;
finally
jsonRequest.Free;
end;
except
on E: Exception do
begin begin
Result := '--- FEHLER IM TASK ---' + sLineBreak + E.Message; try
end; // 1. JSON-Body aus dem gesamten Konversationsverlauf erstellen
end; jsonRequest := TJSONObject.Create;
end); try
jsonContents := TJSONArray.Create;
jsonRequest.AddPair('contents', jsonContents);
// NEU: Iteriere durch den Verlauf und baue die JSON-Struktur auf
for turn in FChatHistory do
begin
var jsonTurn := TJSONObject.Create;
jsonTurn.AddPair('role', TJSONString.Create(turn.Role));
var jsonParts := TJSONArray.Create;
jsonTurn.AddPair('parts', jsonParts);
var jsonText := TJSONObject.Create;
jsonText.AddPair('text', TJSONString.Create(turn.Text));
jsonParts.Add(jsonText);
jsonContents.Add(jsonTurn);
end;
// 2. Request senden
requestBody := TStringStream.Create(jsonRequest.ToString, TEncoding.UTF8);
try
apiUrl := API_BASE_URL + GEMINI_MODEL + ':generateContent?key=' + FMyApiKey;
response := FHttpClient.Post(apiUrl, requestBody, nil);
// 3. Antwort verarbeiten
if (response.StatusCode = 200) then
begin
responseJson := TJSONObject.ParseJSONValue(response.ContentAsString(TEncoding.UTF8));
try
Result :=
responseJson
.GetValue<TJSONArray>('candidates')
.Items[0]
.GetValue<TJSONObject>('content')
.GetValue<TJSONArray>('parts')
.Items[0]
.GetValue<string>('text');
finally
responseJson.Free;
end;
end
else
begin
Result :=
'Fehler! Status: '
+ response.StatusCode.ToString
+ ' - '
+ response.StatusText
+ sLineBreak
+ response.ContentAsString;
end;
finally
requestBody.Free;
end;
finally
jsonRequest.Free;
end;
except
on E: Exception do
begin
Result := '--- FEHLER IM TASK ---' + sLineBreak + E.Message;
end;
end;
end
);
end; end;
end. end.
IntfExtract/ExtractPascalInterfaces.dpr
+59 -20
View File
@@ -87,7 +87,6 @@ begin
end; end;
end; end;
{ TUnitInfo implementation } { TUnitInfo implementation }
constructor TUnitInfo.Create(const AFilePath: string); constructor TUnitInfo.Create(const AFilePath: string);
begin begin
@@ -141,7 +140,7 @@ begin
if (currentChar = #13) or (currentChar = #10) then if (currentChar = #13) or (currentChar = #10) then
begin begin
inLineComment := False; inLineComment := False;
if (Builder.Length > 0) and (Builder[Builder.Length-1] <> ' ') and (Builder[Builder.Length-1] <> ',') then if (Builder.Length > 0) and (Builder[Builder.Length - 1] <> ' ') and (Builder[Builder.Length - 1] <> ',') then
Builder.Append(' '); Builder.Append(' ');
end; end;
Inc(i); Inc(i);
@@ -189,7 +188,7 @@ begin
end; end;
if (currentChar = #13) or (currentChar = #10) or (currentChar = #9) then if (currentChar = #13) or (currentChar = #10) or (currentChar = #9) then
begin begin
if (Builder.Length = 0) or ((Builder.Length > 0) and (Builder[Builder.Length-1] <> ' ')) then if (Builder.Length = 0) or ((Builder.Length > 0) and (Builder[Builder.Length - 1] <> ' ')) then
Builder.Append(' '); Builder.Append(' ');
Inc(i); Inc(i);
end end
@@ -588,7 +587,13 @@ begin
outputFileName := ParamStr(currentParamIndex + 1); outputFileName := ParamStr(currentParamIndex + 1);
Inc(currentParamIndex, 2); Inc(currentParamIndex, 2);
end end
else begin WriteLn('Error: Missing filename after -o option.'); WriteLn(usageStr); exitcode := 1; exit; end; else
begin
WriteLn('Error: Missing filename after -o option.');
WriteLn(usageStr);
exitcode := 1;
exit;
end;
end end
else if SameText(currentParam, '-dirs') then else if SameText(currentParam, '-dirs') then
begin begin
@@ -610,12 +615,23 @@ begin
WriteLn('Warning: File specified with -dirs not found: ' + dirsFileName); WriteLn('Warning: File specified with -dirs not found: ' + dirsFileName);
Inc(currentParamIndex, 2); Inc(currentParamIndex, 2);
end end
else begin WriteLn('Error: Missing filename after -dirs option.'); WriteLn(usageStr); exitcode := 1; exit; end; else
begin
WriteLn('Error: Missing filename after -dirs option.');
WriteLn(usageStr);
exitcode := 1;
exit;
end;
end end
else if SameText(currentParam, '-f') or SameText(currentParam, '-fx') then else if SameText(currentParam, '-f') or SameText(currentParam, '-fx') then
begin begin
if focusMode then if focusMode then
begin WriteLn('Error: -f and -fx options cannot be used together.'); WriteLn(usageStr); exitcode := 1; exit; end; begin
WriteLn('Error: -f and -fx options cannot be used together.');
WriteLn(usageStr);
exitcode := 1;
exit;
end;
if currentParamIndex + 1 <= ParamCount then if currentParamIndex + 1 <= ParamCount then
begin begin
@@ -626,12 +642,18 @@ begin
filesToExcludeFromOutput.Text := initialFocusFiles.Text; filesToExcludeFromOutput.Text := initialFocusFiles.Text;
Inc(currentParamIndex, 2); Inc(currentParamIndex, 2);
end end
else begin WriteLn('Error: Missing file list after ' + currentParam + ' option.'); WriteLn(usageStr); exitcode := 1; exit; end; else
begin
WriteLn('Error: Missing file list after ' + currentParam + ' option.');
WriteLn(usageStr);
exitcode := 1;
exit;
end;
end end
else else
begin begin
sourceDirectories.Add(currentParam); sourceDirectories.Add(currentParam);
inc( currentParamIndex ); inc(currentParamIndex);
end; end;
end; end;
@@ -650,12 +672,11 @@ begin
Dec(i); Dec(i);
end; end;
if writeToClipboard and (outputFileName <> '') then if writeToClipboard and (outputFileName <> '') then
begin begin
WriteLn('Error: -o (output to file) and -c (output to clipboard) cannot be used together.'); WriteLn('Error: -o (output to file) and -c (output to clipboard) cannot be used together.');
exitcode := 1; exitcode := 1;
exit; exit;
end; end;
if sourceDirectories.Count = 0 then if sourceDirectories.Count = 0 then
@@ -687,14 +708,20 @@ begin
for var focusFile in initialFocusFiles do for var focusFile in initialFocusFiles do
begin begin
if not TFile.Exists(focusFile) then if not TFile.Exists(focusFile) then
begin WriteLn('Warning: Focus file not found, skipping: ' + focusFile); Continue; end; begin
WriteLn('Warning: Focus file not found, skipping: ' + focusFile);
Continue;
end;
if allFoundPasFilesList.IndexOf(focusFile) = -1 then if allFoundPasFilesList.IndexOf(focusFile) = -1 then
allFoundPasFilesList.Add(focusFile); allFoundPasFilesList.Add(focusFile);
end; end;
end; end;
if allFoundPasFilesList.Count = 0 then if allFoundPasFilesList.Count = 0 then
begin WriteLn('No .pas files found in any specified directory (respecting exclusions).'); exit; end; begin
WriteLn('No .pas files found in any specified directory (respecting exclusions).');
exit;
end;
allUnits := TDictionary<string, TUnitInfo>.Create(TStringComparer.Ordinal); allUnits := TDictionary<string, TUnitInfo>.Create(TStringComparer.Ordinal);
sortedUnits := TList<TUnitInfo>.Create; sortedUnits := TList<TUnitInfo>.Create;
@@ -719,14 +746,23 @@ begin
end; end;
end end
else else
begin WriteLn('Warning: Could not determine unit name for file: ' + filePathKey + '. Skipping.'); unitInfo.Free; end; begin
WriteLn('Warning: Could not determine unit name for file: ' + filePathKey + '. Skipping.');
unitInfo.Free;
end;
end end
else else
begin WriteLn('Warning: Failed to parse unit: ' + filePathKey + '. Skipping.'); unitInfo.Free; end; begin
WriteLn('Warning: Failed to parse unit: ' + filePathKey + '. Skipping.');
unitInfo.Free;
end;
end; end;
if allUnits.Count = 0 then if allUnits.Count = 0 then
begin WriteLn('No units successfully parsed.'); exit; end; begin
WriteLn('No units successfully parsed.');
exit;
end;
if focusMode then if focusMode then
begin begin
@@ -929,12 +965,15 @@ begin
if item.InterfaceSection.Count > 0 then if item.InterfaceSection.Count > 0 then
begin begin
outputContent.Add('//=================================================================================================='); outputContent
.Add('//==================================================================================================');
outputContent.Add('//== UNIT START: ' + item.Name + ' (from ' + ExtractFileName(item.FilePath) + ')'); outputContent.Add('//== UNIT START: ' + item.Name + ' (from ' + ExtractFileName(item.FilePath) + ')');
outputContent.Add('//=================================================================================================='); outputContent
.Add('//==================================================================================================');
outputContent.AddStrings(item.InterfaceSection); outputContent.AddStrings(item.InterfaceSection);
outputContent.Add('//== UNIT END: ' + item.Name); outputContent.Add('//== UNIT END: ' + item.Name);
outputContent.Add('//=================================================================================================='); outputContent
.Add('//==================================================================================================');
outputContent.Add(''); outputContent.Add('');
end; end;
end; end;
Test/MycTests.dpr
-1
View File
@@ -30,7 +30,6 @@ uses
Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas', Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas',
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas', Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas',
Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas', Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas',
Myc.Trade.Ticker in '..\Src\Myc.Trade.Ticker.pas',
Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas', Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas',
Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas', Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas',
Myc.Trade.DataPoint in '..\Src\Myc.Trade.DataPoint.pas', Myc.Trade.DataPoint in '..\Src\Myc.Trade.DataPoint.pas',
Test/MycTests.dproj
-1
View File
@@ -130,7 +130,6 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="..\Src\Myc.Test.Core.Lazy.pas"/> <DCCReference Include="..\Src\Myc.Test.Core.Lazy.pas"/>
<DCCReference Include="..\Src\Myc.Test.Lazy.pas"/> <DCCReference Include="..\Src\Myc.Test.Lazy.pas"/>
<DCCReference Include="..\Src\Myc.Test.Core.Atomic.pas"/> <DCCReference Include="..\Src\Myc.Test.Core.Atomic.pas"/>
<DCCReference Include="..\Src\Myc.Trade.Ticker.pas"/>
<DCCReference Include="..\Src\Myc.Test.Signals.Latch.pas"/> <DCCReference Include="..\Src\Myc.Test.Signals.Latch.pas"/>
<DCCReference Include="..\Src\Myc.Test.Signals.Dirty.pas"/> <DCCReference Include="..\Src\Myc.Test.Signals.Dirty.pas"/>
<DCCReference Include="..\Src\Myc.Trade.DataPoint.pas"/> <DCCReference Include="..\Src\Myc.Trade.DataPoint.pas"/>
Test/MycTests.res
BIN
View File
Binary file not shown.