Code-Formatting
This commit is contained in:
Michael Schimmel
+15
-15
@@ -1,23 +1,23 @@
|
||||
program AuraTrader;
|
||||
|
||||
uses
|
||||
FastMM5,
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
MainForm in 'MainForm.pas' {Form1},
|
||||
Myc.Trade.Core.DataPoint in '..\Src\Myc.Trade.Core.DataPoint.pas',
|
||||
Myc.Aura.Module in '..\Src\Myc.Aura.Module.pas',
|
||||
Myc.Aura.Parameter in '..\Src\Myc.Aura.Parameter.pas',
|
||||
TestModule in 'TestModule.pas',
|
||||
DynamicFMXControl in 'DynamicFMXControl.pas',
|
||||
FirstStrategy in 'FirstStrategy.pas',
|
||||
Myc.Fmx.Chart in 'Myc.Fmx.Chart.pas',
|
||||
Myc.Trade.DataArray in '..\Src\Myc.Trade.DataArray.pas';
|
||||
FastMM5,
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
MainForm in 'MainForm.pas' {Form1},
|
||||
Myc.Trade.Core.DataPoint in '..\Src\Myc.Trade.Core.DataPoint.pas',
|
||||
Myc.Aura.Module in '..\Src\Myc.Aura.Module.pas',
|
||||
Myc.Aura.Parameter in '..\Src\Myc.Aura.Parameter.pas',
|
||||
TestModule in 'TestModule.pas',
|
||||
DynamicFMXControl in 'DynamicFMXControl.pas',
|
||||
FirstStrategy in 'FirstStrategy.pas',
|
||||
Myc.Fmx.Chart in 'Myc.Fmx.Chart.pas',
|
||||
Myc.Trade.DataArray in '..\Src\Myc.Trade.DataArray.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
+242
-234
@@ -3,135 +3,143 @@ unit DynamicFMXControl;
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
FMX.Controls, FMX.Graphics, FMX.Forms, FMX.StdCtrls, FMX.Types;
|
||||
System.SysUtils,
|
||||
System.Types,
|
||||
System.UITypes,
|
||||
System.Classes,
|
||||
FMX.Controls,
|
||||
FMX.Graphics,
|
||||
FMX.Forms,
|
||||
FMX.StdCtrls,
|
||||
FMX.Types;
|
||||
|
||||
type
|
||||
// Dezidierte Event-Typen für virtuelle Methoden von TControl
|
||||
TControlPaintEvent = reference to procedure;
|
||||
TControlMouseEvent = reference to procedure(Button: TMouseButton; 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);
|
||||
TControlKeyEvent = reference to procedure(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
TControlDragEvent = reference to procedure(const Data: TDragObject; const Point: TPointF);
|
||||
TControlDragOverEvent = reference to procedure(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||
TControlNotifyEvent = reference to procedure;
|
||||
TControlCanFocusEvent = reference to function: Boolean;
|
||||
TControlShowContextMenuEvent = reference to function(const ScreenPosition: TPointF): Boolean;
|
||||
TControlSetHintEvent = reference to procedure(const AHint: string);
|
||||
TControlGetHintStringEvent = reference to function: string;
|
||||
TControlHasHintEvent = reference to function: Boolean;
|
||||
TControlCanShowHintEvent = reference to function: Boolean;
|
||||
TControlGetDefaultSizeEvent = reference to function: TSizeF;
|
||||
TControlSetVisibleEvent = reference to procedure(const Value: Boolean);
|
||||
TControlSetEnabledEvent = reference to procedure(const Value: Boolean);
|
||||
TControlDoAbsoluteChangedEvent = reference to procedure;
|
||||
// Dezidierte Event-Typen für virtuelle Methoden von TControl
|
||||
TControlPaintEvent = reference to procedure;
|
||||
TControlMouseEvent = reference to procedure(Button: TMouseButton; 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);
|
||||
TControlKeyEvent = reference to procedure(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
TControlDragEvent = reference to procedure(const Data: TDragObject; const Point: TPointF);
|
||||
TControlDragOverEvent = reference to procedure(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||
TControlNotifyEvent = reference to procedure;
|
||||
TControlCanFocusEvent = reference to function: Boolean;
|
||||
TControlShowContextMenuEvent = reference to function(const ScreenPosition: TPointF): Boolean;
|
||||
TControlSetHintEvent = reference to procedure(const AHint: string);
|
||||
TControlGetHintStringEvent = reference to function: string;
|
||||
TControlHasHintEvent = reference to function: Boolean;
|
||||
TControlCanShowHintEvent = reference to function: Boolean;
|
||||
TControlGetDefaultSizeEvent = reference to function: TSizeF;
|
||||
TControlSetVisibleEvent = reference to procedure(const Value: Boolean);
|
||||
TControlSetEnabledEvent = reference to procedure(const Value: Boolean);
|
||||
TControlDoAbsoluteChangedEvent = reference to procedure;
|
||||
|
||||
TDynamicControl = class(TControl)
|
||||
private
|
||||
// Private Felder für die Event-Handler
|
||||
FPaintEvent: TControlPaintEvent;
|
||||
FMouseDownEvent: TControlMouseEvent;
|
||||
FMouseUpEvent: TControlMouseEvent;
|
||||
FMouseMoveEvent: TControlMouseMoveEvent;
|
||||
FMouseWheelEvent: TControlMouseWheelEvent;
|
||||
FKeyDownEvent: TControlKeyEvent;
|
||||
FKeyUpEvent: TControlKeyEvent;
|
||||
FClickEvent: TControlNotifyEvent;
|
||||
FDblClickEvent: TControlNotifyEvent;
|
||||
FDragEnterEvent: TControlDragEvent;
|
||||
FDragOverEvent: TControlDragOverEvent;
|
||||
FDragDropEvent: TControlDragEvent;
|
||||
FDragLeaveEvent: TControlNotifyEvent;
|
||||
FDragEndEvent: TControlNotifyEvent;
|
||||
FEnterEvent: TControlNotifyEvent;
|
||||
FExitEvent: TControlNotifyEvent;
|
||||
FMouseEnterEvent: TControlNotifyEvent;
|
||||
FMouseLeaveEvent: TControlNotifyEvent;
|
||||
FResizeEvent: TControlNotifyEvent;
|
||||
FResizedEvent: TControlNotifyEvent;
|
||||
FCanFocusEvent: TControlCanFocusEvent;
|
||||
FShowContextMenuEvent: TControlShowContextMenuEvent;
|
||||
FSetHintEvent: TControlSetHintEvent;
|
||||
FGetHintStringEvent: TControlGetHintStringEvent;
|
||||
FHasHintEvent: TControlHasHintEvent;
|
||||
FCanShowHintEvent: TControlCanShowHintEvent;
|
||||
FGetDefaultSizeEvent: TControlGetDefaultSizeEvent;
|
||||
FRecalculateAbsoluteMatricesEvent: TControlNotifyEvent;
|
||||
FSetVisibleEvent: TControlSetVisibleEvent;
|
||||
FSetEnabledEvent: TControlSetEnabledEvent;
|
||||
FDoAbsoluteChangedEvent: TControlDoAbsoluteChangedEvent;
|
||||
TDynamicControl = class(TControl)
|
||||
private
|
||||
// Private Felder für die Event-Handler
|
||||
FPaintEvent: TControlPaintEvent;
|
||||
FMouseDownEvent: TControlMouseEvent;
|
||||
FMouseUpEvent: TControlMouseEvent;
|
||||
FMouseMoveEvent: TControlMouseMoveEvent;
|
||||
FMouseWheelEvent: TControlMouseWheelEvent;
|
||||
FKeyDownEvent: TControlKeyEvent;
|
||||
FKeyUpEvent: TControlKeyEvent;
|
||||
FClickEvent: TControlNotifyEvent;
|
||||
FDblClickEvent: TControlNotifyEvent;
|
||||
FDragEnterEvent: TControlDragEvent;
|
||||
FDragOverEvent: TControlDragOverEvent;
|
||||
FDragDropEvent: TControlDragEvent;
|
||||
FDragLeaveEvent: TControlNotifyEvent;
|
||||
FDragEndEvent: TControlNotifyEvent;
|
||||
FEnterEvent: TControlNotifyEvent;
|
||||
FExitEvent: TControlNotifyEvent;
|
||||
FMouseEnterEvent: TControlNotifyEvent;
|
||||
FMouseLeaveEvent: TControlNotifyEvent;
|
||||
FResizeEvent: TControlNotifyEvent;
|
||||
FResizedEvent: TControlNotifyEvent;
|
||||
FCanFocusEvent: TControlCanFocusEvent;
|
||||
FShowContextMenuEvent: TControlShowContextMenuEvent;
|
||||
FSetHintEvent: TControlSetHintEvent;
|
||||
FGetHintStringEvent: TControlGetHintStringEvent;
|
||||
FHasHintEvent: TControlHasHintEvent;
|
||||
FCanShowHintEvent: TControlCanShowHintEvent;
|
||||
FGetDefaultSizeEvent: TControlGetDefaultSizeEvent;
|
||||
FRecalculateAbsoluteMatricesEvent: TControlNotifyEvent;
|
||||
FSetVisibleEvent: TControlSetVisibleEvent;
|
||||
FSetEnabledEvent: TControlSetEnabledEvent;
|
||||
FDoAbsoluteChangedEvent: TControlDoAbsoluteChangedEvent;
|
||||
|
||||
protected
|
||||
// Überschriebene virtuelle Methoden, die die Events auslösen
|
||||
procedure Paint; override;
|
||||
procedure MouseDown(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 MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
|
||||
procedure Click; override;
|
||||
procedure DblClick; override;
|
||||
procedure KeyDown(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 DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override;
|
||||
procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
|
||||
procedure DragLeave; override;
|
||||
procedure DragEnd; override;
|
||||
procedure DoEnter; override;
|
||||
procedure DoExit; override;
|
||||
procedure DoMouseEnter; override;
|
||||
procedure DoMouseLeave; override;
|
||||
procedure Resize; override;
|
||||
procedure DoResized; override;
|
||||
function GetCanFocus: Boolean; override;
|
||||
function ShowContextMenu(const ScreenPosition: TPointF): Boolean; override;
|
||||
procedure SetHint(const AHint: string); override;
|
||||
function GetHintString: string; override;
|
||||
function HasHint: Boolean; override;
|
||||
function CanShowHint: Boolean; override;
|
||||
function GetDefaultSize: TSizeF; override;
|
||||
procedure RecalculateAbsoluteMatrices; override;
|
||||
procedure SetVisible(const Value: Boolean); override;
|
||||
procedure SetEnabled(const Value: Boolean); override;
|
||||
procedure DoAbsoluteChanged; override;
|
||||
protected
|
||||
// Überschriebene virtuelle Methoden, die die Events auslösen
|
||||
procedure Paint; override;
|
||||
procedure MouseDown(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 MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
|
||||
procedure Click; override;
|
||||
procedure DblClick; override;
|
||||
procedure KeyDown(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 DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override;
|
||||
procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
|
||||
procedure DragLeave; override;
|
||||
procedure DragEnd; override;
|
||||
procedure DoEnter; override;
|
||||
procedure DoExit; override;
|
||||
procedure DoMouseEnter; override;
|
||||
procedure DoMouseLeave; override;
|
||||
procedure Resize; override;
|
||||
procedure DoResized; override;
|
||||
function GetCanFocus: Boolean; override;
|
||||
function ShowContextMenu(const ScreenPosition: TPointF): Boolean; override;
|
||||
procedure SetHint(const AHint: string); override;
|
||||
function GetHintString: string; override;
|
||||
function HasHint: Boolean; override;
|
||||
function CanShowHint: Boolean; override;
|
||||
function GetDefaultSize: TSizeF; override;
|
||||
procedure RecalculateAbsoluteMatrices; override;
|
||||
procedure SetVisible(const Value: Boolean); override;
|
||||
procedure SetEnabled(const Value: Boolean); override;
|
||||
procedure DoAbsoluteChanged; override;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
|
||||
// Public Properties, die die Events exponieren
|
||||
property OnPaint: TControlPaintEvent read FPaintEvent write FPaintEvent;
|
||||
property OnMouseDown: TControlMouseEvent read FMouseDownEvent write FMouseDownEvent;
|
||||
property OnMouseUp: TControlMouseEvent read FMouseUpEvent write FMouseUpEvent;
|
||||
property OnMouseMove: TControlMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent;
|
||||
property OnMouseWheel: TControlMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent;
|
||||
property OnClick: TControlNotifyEvent read FClickEvent write FClickEvent;
|
||||
property OnDblClick: TControlNotifyEvent read FDblClickEvent write FDblClickEvent;
|
||||
property OnKeyDown: TControlKeyEvent read FKeyDownEvent write FKeyDownEvent;
|
||||
property OnKeyUp: TControlKeyEvent read FKeyUpEvent write FKeyUpEvent;
|
||||
property OnDragEnter: TControlDragEvent read FDragEnterEvent write FDragEnterEvent;
|
||||
property OnDragOver: TControlDragOverEvent read FDragOverEvent write FDragOverEvent;
|
||||
property OnDragDrop: TControlDragEvent read FDragDropEvent write FDragDropEvent;
|
||||
property OnDragLeave: TControlNotifyEvent read FDragLeaveEvent write FDragLeaveEvent;
|
||||
property OnDragEnd: TControlNotifyEvent read FDragEndEvent write FDragEndEvent;
|
||||
property OnEnter: TControlNotifyEvent read FEnterEvent write FEnterEvent;
|
||||
property OnExit: TControlNotifyEvent read FExitEvent write FExitEvent;
|
||||
property OnMouseEnter: TControlNotifyEvent read FMouseEnterEvent write FMouseEnterEvent;
|
||||
property OnMouseLeave: TControlNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent;
|
||||
property OnResize: TControlNotifyEvent read FResizeEvent write FResizeEvent;
|
||||
property OnResized: TControlNotifyEvent read FResizedEvent write FResizedEvent;
|
||||
property OnCanFocus: TControlCanFocusEvent read FCanFocusEvent write FCanFocusEvent;
|
||||
property OnShowContextMenu: TControlShowContextMenuEvent read FShowContextMenuEvent write FShowContextMenuEvent;
|
||||
property OnSetHint: TControlSetHintEvent read FSetHintEvent write FSetHintEvent;
|
||||
property OnGetHintString: TControlGetHintStringEvent read FGetHintStringEvent write FGetHintStringEvent;
|
||||
property OnHasHint: TControlHasHintEvent read FHasHintEvent write FHasHintEvent;
|
||||
property OnCanShowHint: TControlCanShowHintEvent read FCanShowHintEvent write FCanShowHintEvent;
|
||||
property OnGetDefaultSize: TControlGetDefaultSizeEvent read FGetDefaultSizeEvent write FGetDefaultSizeEvent;
|
||||
property OnRecalculateAbsoluteMatrices: TControlNotifyEvent read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent;
|
||||
property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent;
|
||||
property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent;
|
||||
property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent;
|
||||
end;
|
||||
// Public Properties, die die Events exponieren
|
||||
property OnPaint: TControlPaintEvent read FPaintEvent write FPaintEvent;
|
||||
property OnMouseDown: TControlMouseEvent read FMouseDownEvent write FMouseDownEvent;
|
||||
property OnMouseUp: TControlMouseEvent read FMouseUpEvent write FMouseUpEvent;
|
||||
property OnMouseMove: TControlMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent;
|
||||
property OnMouseWheel: TControlMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent;
|
||||
property OnClick: TControlNotifyEvent read FClickEvent write FClickEvent;
|
||||
property OnDblClick: TControlNotifyEvent read FDblClickEvent write FDblClickEvent;
|
||||
property OnKeyDown: TControlKeyEvent read FKeyDownEvent write FKeyDownEvent;
|
||||
property OnKeyUp: TControlKeyEvent read FKeyUpEvent write FKeyUpEvent;
|
||||
property OnDragEnter: TControlDragEvent read FDragEnterEvent write FDragEnterEvent;
|
||||
property OnDragOver: TControlDragOverEvent read FDragOverEvent write FDragOverEvent;
|
||||
property OnDragDrop: TControlDragEvent read FDragDropEvent write FDragDropEvent;
|
||||
property OnDragLeave: TControlNotifyEvent read FDragLeaveEvent write FDragLeaveEvent;
|
||||
property OnDragEnd: TControlNotifyEvent read FDragEndEvent write FDragEndEvent;
|
||||
property OnEnter: TControlNotifyEvent read FEnterEvent write FEnterEvent;
|
||||
property OnExit: TControlNotifyEvent read FExitEvent write FExitEvent;
|
||||
property OnMouseEnter: TControlNotifyEvent read FMouseEnterEvent write FMouseEnterEvent;
|
||||
property OnMouseLeave: TControlNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent;
|
||||
property OnResize: TControlNotifyEvent read FResizeEvent write FResizeEvent;
|
||||
property OnResized: TControlNotifyEvent read FResizedEvent write FResizedEvent;
|
||||
property OnCanFocus: TControlCanFocusEvent read FCanFocusEvent write FCanFocusEvent;
|
||||
property OnShowContextMenu: TControlShowContextMenuEvent read FShowContextMenuEvent write FShowContextMenuEvent;
|
||||
property OnSetHint: TControlSetHintEvent read FSetHintEvent write FSetHintEvent;
|
||||
property OnGetHintString: TControlGetHintStringEvent read FGetHintStringEvent write FGetHintStringEvent;
|
||||
property OnHasHint: TControlHasHintEvent read FHasHintEvent write FHasHintEvent;
|
||||
property OnCanShowHint: TControlCanShowHintEvent read FCanShowHintEvent write FCanShowHintEvent;
|
||||
property OnGetDefaultSize: TControlGetDefaultSizeEvent read FGetDefaultSizeEvent write FGetDefaultSizeEvent;
|
||||
property OnRecalculateAbsoluteMatrices: TControlNotifyEvent
|
||||
read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent;
|
||||
property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent;
|
||||
property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent;
|
||||
property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
@@ -139,241 +147,241 @@ implementation
|
||||
|
||||
constructor TDynamicControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Width := 150;
|
||||
Height := 100;
|
||||
HitTest := True;
|
||||
inherited Create(AOwner);
|
||||
Width := 150;
|
||||
Height := 100;
|
||||
HitTest := True;
|
||||
end;
|
||||
|
||||
function TDynamicControl.CanShowHint: Boolean;
|
||||
begin
|
||||
if Assigned(FCanShowHintEvent) then
|
||||
Result := FCanShowHintEvent
|
||||
else
|
||||
Result := inherited CanShowHint;
|
||||
if Assigned(FCanShowHintEvent) then
|
||||
Result := FCanShowHintEvent
|
||||
else
|
||||
Result := inherited CanShowHint;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Click;
|
||||
begin
|
||||
inherited Click;
|
||||
if Assigned(FClickEvent) then
|
||||
FClickEvent;
|
||||
inherited Click;
|
||||
if Assigned(FClickEvent) then
|
||||
FClickEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DblClick;
|
||||
begin
|
||||
inherited DblClick;
|
||||
if Assigned(FDblClickEvent) then
|
||||
FDblClickEvent;
|
||||
inherited DblClick;
|
||||
if Assigned(FDblClickEvent) then
|
||||
FDblClickEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoAbsoluteChanged;
|
||||
begin
|
||||
inherited DoAbsoluteChanged;
|
||||
if Assigned(FDoAbsoluteChangedEvent) then
|
||||
FDoAbsoluteChangedEvent;
|
||||
inherited DoAbsoluteChanged;
|
||||
if Assigned(FDoAbsoluteChangedEvent) then
|
||||
FDoAbsoluteChangedEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragDrop(const Data: TDragObject; const Point: TPointF);
|
||||
begin
|
||||
inherited DragDrop(Data, Point);
|
||||
if Assigned(FDragDropEvent) then
|
||||
FDragDropEvent(Data, Point);
|
||||
inherited DragDrop(Data, Point);
|
||||
if Assigned(FDragDropEvent) then
|
||||
FDragDropEvent(Data, Point);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragEnd;
|
||||
begin
|
||||
inherited DragEnd;
|
||||
if Assigned(FDragEndEvent) then
|
||||
FDragEndEvent;
|
||||
inherited DragEnd;
|
||||
if Assigned(FDragEndEvent) then
|
||||
FDragEndEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragEnter(const Data: TDragObject; const Point: TPointF);
|
||||
begin
|
||||
inherited DragEnter(Data, Point);
|
||||
if Assigned(FDragEnterEvent) then
|
||||
FDragEnterEvent(Data, Point);
|
||||
inherited DragEnter(Data, Point);
|
||||
if Assigned(FDragEnterEvent) then
|
||||
FDragEnterEvent(Data, Point);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragLeave;
|
||||
begin
|
||||
inherited DragLeave;
|
||||
if Assigned(FDragLeaveEvent) then
|
||||
FDragLeaveEvent;
|
||||
inherited DragLeave;
|
||||
if Assigned(FDragLeaveEvent) then
|
||||
FDragLeaveEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||
begin
|
||||
inherited DragOver(Data, Point, Operation);
|
||||
if Assigned(FDragOverEvent) then
|
||||
FDragOverEvent(Data, Point, Operation);
|
||||
inherited DragOver(Data, Point, Operation);
|
||||
if Assigned(FDragOverEvent) then
|
||||
FDragOverEvent(Data, Point, Operation);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoEnter;
|
||||
begin
|
||||
inherited DoEnter;
|
||||
if Assigned(FEnterEvent) then
|
||||
FEnterEvent;
|
||||
inherited DoEnter;
|
||||
if Assigned(FEnterEvent) then
|
||||
FEnterEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoExit;
|
||||
begin
|
||||
inherited DoExit;
|
||||
if Assigned(FExitEvent) then
|
||||
FExitEvent;
|
||||
inherited DoExit;
|
||||
if Assigned(FExitEvent) then
|
||||
FExitEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoMouseEnter;
|
||||
begin
|
||||
inherited DoMouseEnter;
|
||||
if Assigned(FMouseEnterEvent) then
|
||||
FMouseEnterEvent;
|
||||
inherited DoMouseEnter;
|
||||
if Assigned(FMouseEnterEvent) then
|
||||
FMouseEnterEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoMouseLeave;
|
||||
begin
|
||||
inherited DoMouseLeave;
|
||||
if Assigned(FMouseLeaveEvent) then
|
||||
FMouseLeaveEvent;
|
||||
inherited DoMouseLeave;
|
||||
if Assigned(FMouseLeaveEvent) then
|
||||
FMouseLeaveEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoResized;
|
||||
begin
|
||||
inherited DoResized;
|
||||
if Assigned(FResizedEvent) then
|
||||
FResizedEvent;
|
||||
inherited DoResized;
|
||||
if Assigned(FResizedEvent) then
|
||||
FResizedEvent;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetCanFocus: Boolean;
|
||||
begin
|
||||
if Assigned(FCanFocusEvent) then
|
||||
Result := FCanFocusEvent
|
||||
else
|
||||
Result := inherited GetCanFocus;
|
||||
if Assigned(FCanFocusEvent) then
|
||||
Result := FCanFocusEvent
|
||||
else
|
||||
Result := inherited GetCanFocus;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetDefaultSize: TSizeF;
|
||||
begin
|
||||
if Assigned(FGetDefaultSizeEvent) then
|
||||
Result := FGetDefaultSizeEvent
|
||||
else
|
||||
Result := inherited GetDefaultSize;
|
||||
if Assigned(FGetDefaultSizeEvent) then
|
||||
Result := FGetDefaultSizeEvent
|
||||
else
|
||||
Result := inherited GetDefaultSize;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetHintString: string;
|
||||
begin
|
||||
if Assigned(FGetHintStringEvent) then
|
||||
Result := FGetHintStringEvent
|
||||
else
|
||||
Result := inherited GetHintString;
|
||||
if Assigned(FGetHintStringEvent) then
|
||||
Result := FGetHintStringEvent
|
||||
else
|
||||
Result := inherited GetHintString;
|
||||
end;
|
||||
|
||||
function TDynamicControl.HasHint: Boolean;
|
||||
begin
|
||||
if Assigned(FHasHintEvent) then
|
||||
Result := FHasHintEvent
|
||||
else
|
||||
Result := inherited HasHint;
|
||||
if Assigned(FHasHintEvent) then
|
||||
Result := FHasHintEvent
|
||||
else
|
||||
Result := inherited HasHint;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyDownEvent) then
|
||||
FKeyDownEvent(Key, KeyChar, Shift);
|
||||
inherited KeyDown(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyDownEvent) then
|
||||
FKeyDownEvent(Key, KeyChar, Shift);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyUp(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyUpEvent) then
|
||||
FKeyUpEvent(Key, KeyChar, Shift);
|
||||
inherited KeyUp(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyUpEvent) then
|
||||
FKeyUpEvent(Key, KeyChar, Shift);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if Assigned(FMouseDownEvent) then
|
||||
FMouseDownEvent(Button, Shift, X, Y);
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if Assigned(FMouseDownEvent) then
|
||||
FMouseDownEvent(Button, Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
if Assigned(FMouseMoveEvent) then
|
||||
FMouseMoveEvent(Shift, X, Y);
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
if Assigned(FMouseMoveEvent) then
|
||||
FMouseMoveEvent(Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseUp(Button, Shift, X, Y);
|
||||
if Assigned(FMouseUpEvent) then
|
||||
FMouseUpEvent(Button, Shift, X, Y);
|
||||
inherited MouseUp(Button, Shift, X, Y);
|
||||
if Assigned(FMouseUpEvent) then
|
||||
FMouseUpEvent(Button, Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||
begin
|
||||
inherited MouseWheel(Shift, WheelDelta, Handled);
|
||||
if Assigned(FMouseWheelEvent) then
|
||||
FMouseWheelEvent(Shift, WheelDelta, Handled);
|
||||
inherited MouseWheel(Shift, WheelDelta, Handled);
|
||||
if Assigned(FMouseWheelEvent) then
|
||||
FMouseWheelEvent(Shift, WheelDelta, Handled);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Paint;
|
||||
begin
|
||||
inherited Paint;
|
||||
if Assigned(FPaintEvent) then
|
||||
FPaintEvent
|
||||
else
|
||||
begin
|
||||
Canvas.Fill.Color := TAlphaColors.LightSteelBlue;
|
||||
Canvas.FillRect(LocalRect, 0, 0, [], 1);
|
||||
Canvas.Stroke.Color := TAlphaColors.Gray;
|
||||
Canvas.Stroke.Thickness := 1;
|
||||
Canvas.DrawRect(LocalRect, 0, 0, [], 1);
|
||||
end;
|
||||
inherited Paint;
|
||||
if Assigned(FPaintEvent) then
|
||||
FPaintEvent
|
||||
else
|
||||
begin
|
||||
Canvas.Fill.Color := TAlphaColors.LightSteelBlue;
|
||||
Canvas.FillRect(LocalRect, 0, 0, [], 1);
|
||||
Canvas.Stroke.Color := TAlphaColors.Gray;
|
||||
Canvas.Stroke.Thickness := 1;
|
||||
Canvas.DrawRect(LocalRect, 0, 0, [], 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.RecalculateAbsoluteMatrices;
|
||||
begin
|
||||
inherited RecalculateAbsoluteMatrices;
|
||||
if Assigned(FRecalculateAbsoluteMatricesEvent) then
|
||||
FRecalculateAbsoluteMatricesEvent;
|
||||
inherited RecalculateAbsoluteMatrices;
|
||||
if Assigned(FRecalculateAbsoluteMatricesEvent) then
|
||||
FRecalculateAbsoluteMatricesEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Resize;
|
||||
begin
|
||||
inherited Resize;
|
||||
if Assigned(FResizeEvent) then
|
||||
FResizeEvent;
|
||||
inherited Resize;
|
||||
if Assigned(FResizeEvent) then
|
||||
FResizeEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetEnabled(const Value: Boolean);
|
||||
begin
|
||||
inherited SetEnabled(Value);
|
||||
if Assigned(FSetEnabledEvent) then
|
||||
FSetEnabledEvent(Value);
|
||||
inherited SetEnabled(Value);
|
||||
if Assigned(FSetEnabledEvent) then
|
||||
FSetEnabledEvent(Value);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetHint(const AHint: string);
|
||||
begin
|
||||
inherited SetHint(AHint);
|
||||
if Assigned(FSetHintEvent) then
|
||||
FSetHintEvent(AHint);
|
||||
inherited SetHint(AHint);
|
||||
if Assigned(FSetHintEvent) then
|
||||
FSetHintEvent(AHint);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetVisible(const Value: Boolean);
|
||||
begin
|
||||
inherited SetVisible(Value);
|
||||
if Assigned(FSetVisibleEvent) then
|
||||
FSetVisibleEvent(Value);
|
||||
inherited SetVisible(Value);
|
||||
if Assigned(FSetVisibleEvent) then
|
||||
FSetVisibleEvent(Value);
|
||||
end;
|
||||
|
||||
function TDynamicControl.ShowContextMenu(const ScreenPosition: TPointF): Boolean;
|
||||
begin
|
||||
if Assigned(FShowContextMenuEvent) then
|
||||
Result := FShowContextMenuEvent(ScreenPosition)
|
||||
else
|
||||
Result := inherited ShowContextMenu(ScreenPosition);
|
||||
if Assigned(FShowContextMenuEvent) then
|
||||
Result := FShowContextMenuEvent(ScreenPosition)
|
||||
else
|
||||
Result := inherited ShowContextMenu(ScreenPosition);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
+33
-41
@@ -158,55 +158,45 @@ begin
|
||||
|
||||
var stateText := TWriteable<String>.CreateWriteable.Protect;
|
||||
var stateLabel := TLabel.Create(Self);
|
||||
AlignControl( stateLabel );
|
||||
AlignControl(stateLabel);
|
||||
|
||||
stateLabel.Text := 'Initializing...';
|
||||
|
||||
var chart := TMycChart.Create(Self);
|
||||
AlignControl( chart );
|
||||
chart.Height := Layout.ChildrenRect.Width*9/16;
|
||||
AlignControl(chart);
|
||||
chart.Height := Layout.ChildrenRect.Width * 9 / 16;
|
||||
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(
|
||||
function( const Ohlc: TDataPoint<TOhlcItem> ): TOhlcItem
|
||||
begin
|
||||
Result := Ohlc.Data;
|
||||
end );
|
||||
var Ohlc: IMycConverter<TDataPoint<TOhlcItem>, TOhlcItem> :=
|
||||
TMycGenericConverter<TDataPoint<TOhlcItem>, TOhlcItem>
|
||||
.Create(function(const Ohlc: TDataPoint<TOhlcItem>): TOhlcItem begin Result := Ohlc.Data; end);
|
||||
|
||||
OhlcPoint.Sender.Link(Ohlc);
|
||||
|
||||
var Closes: IMycConverter<TOhlcItem, Double> := TMycGenericConverter<TOhlcItem, Double>.Create(
|
||||
function( const Ohlc: TOhlcItem ): Double
|
||||
begin
|
||||
Result := Ohlc.Close;
|
||||
end );
|
||||
var Closes: IMycConverter<TOhlcItem, Double> :=
|
||||
TMycGenericConverter<TOhlcItem, Double>.Create(function(const Ohlc: TOhlcItem): Double 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(
|
||||
stateText.Changed, done,
|
||||
procedure
|
||||
begin
|
||||
stateLabel.Text := stateText.Value;
|
||||
end );
|
||||
stateLabel.ProcessSignal(stateText.Changed, done, procedure begin stateLabel.Text := stateText.Value; end);
|
||||
|
||||
FProcessDone := TState.All([FProcessDone, done]);
|
||||
|
||||
chart.AddOhlcSeries( OhlcPoint.Sender );
|
||||
chart.AddOhlcSeries(OhlcPoint.Sender);
|
||||
end;
|
||||
|
||||
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]
|
||||
FServer := TAuraTABFileServer.Create('\\COFFEE\TickData\Pepperstone');
|
||||
|
||||
|
||||
SymbolsComboBox.Enabled := false;
|
||||
ChartButton.Enabled := false;
|
||||
LoadButton.Enabled := false;
|
||||
@@ -418,7 +407,7 @@ begin
|
||||
|
||||
Control.Parent := Layout;
|
||||
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.Align := TAlignLayout.Top;
|
||||
end;
|
||||
@@ -471,7 +460,8 @@ begin
|
||||
PathData.ClosePath;
|
||||
|
||||
currPathData.Value := TObjectRef<TPathData>.Create(PathData);
|
||||
end )
|
||||
end
|
||||
)
|
||||
);
|
||||
end
|
||||
);
|
||||
@@ -520,21 +510,23 @@ var
|
||||
begin
|
||||
var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
|
||||
|
||||
dataProvider := TMycGenericConverter<TArray<TDataPoint<TAuraAskBidFileItem>>, TArray<TDataPoint<TAskBidItem>>>.Create(
|
||||
function( const Values: TArray<TDataPoint<TAuraAskBidFileItem>> ): TArray<TDataPoint<TAskBidItem>>
|
||||
begin
|
||||
SetLength( Result, Length( Values ) );
|
||||
for var i:=0 to High(Result) do
|
||||
dataProvider :=
|
||||
TMycGenericConverter<TArray<TDataPoint<TAuraAskBidFileItem>>, TArray<TDataPoint<TAskBidItem>>>.Create(
|
||||
function(const Values: TArray<TDataPoint<TAuraAskBidFileItem>>): TArray<TDataPoint<TAskBidItem>>
|
||||
begin
|
||||
Result[i].Time := Values[i].Time;
|
||||
Result[i].Data.Ask := Values[i].Data.Ask;
|
||||
Result[i].Data.Bid := Values[i].Data.Bid;
|
||||
end;
|
||||
end );
|
||||
SetLength(Result, Length(Values));
|
||||
for var i := 0 to High(Result) do
|
||||
begin
|
||||
Result[i].Time := Values[i].Time;
|
||||
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;
|
||||
|
||||
function TForm1.SelectedSymbol: String;
|
||||
|
||||
@@ -6,7 +6,7 @@ uses
|
||||
Myc.Aura.Module;
|
||||
|
||||
type
|
||||
TTestModule = class( TMycAuraNode, IAuraModule )
|
||||
TTestModule = class(TMycAuraNode, IAuraModule)
|
||||
private
|
||||
FId: Integer;
|
||||
public
|
||||
|
||||
@@ -1,15 +1,15 @@
|
||||
program BlocklyTest;
|
||||
|
||||
uses
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
MainUnit in 'MainUnit.pas' {MainForm},
|
||||
LLVM.Runner in 'LLVM.Runner.pas';
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
MainUnit in 'MainUnit.pas' {MainForm},
|
||||
LLVM.Runner in 'LLVM.Runner.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
@@ -3,37 +3,40 @@ unit LLVM.Runner;
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, Winapi.Windows, System.Classes;
|
||||
System.SysUtils,
|
||||
Winapi.Windows,
|
||||
System.Classes;
|
||||
|
||||
type
|
||||
// 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
|
||||
THostAddIntegersCallback = function( ANum1: Integer; ANum2: Integer ): Integer; stdcall;
|
||||
THostAddIntegersCallback = function(ANum1: Integer; ANum2: Integer): Integer; stdcall;
|
||||
|
||||
// NEUE, VEREINFACHTE Signatur der exportierten DLL-Funktion
|
||||
// Jetzt nur noch der Log-Callback und der neue Integer-Input-Parameter
|
||||
TStarteLogikProc = procedure(
|
||||
ALogIntProc: TLogIntegerCallback;
|
||||
AHostInputInteger: Integer;
|
||||
AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter
|
||||
); stdcall;
|
||||
TStarteLogikProc =
|
||||
procedure(
|
||||
ALogIntProc: TLogIntegerCallback;
|
||||
AHostInputInteger: Integer;
|
||||
AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter
|
||||
); stdcall;
|
||||
|
||||
type
|
||||
TLLVMRunner = class
|
||||
private
|
||||
FModule: HMODULE;
|
||||
FStarteLogik: TStarteLogikProc;
|
||||
class var
|
||||
FLog: TStrings;
|
||||
class procedure LogInteger( AValue: Integer ); static; stdcall;
|
||||
class var
|
||||
FLog: TStrings;
|
||||
class procedure LogInteger(AValue: Integer); static; stdcall;
|
||||
// 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
|
||||
constructor Create(const ADLLPath: string);
|
||||
destructor Destroy; override;
|
||||
procedure Execute( AInputInteger: Integer );
|
||||
procedure Execute(AInputInteger: Integer);
|
||||
class property Log: TStrings read FLog write FLog;
|
||||
end;
|
||||
|
||||
@@ -44,24 +47,24 @@ implementation
|
||||
constructor TLLVMRunner.Create(const ADLLPath: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FModule := LoadLibrary( PChar( ADLLPath ) );
|
||||
FModule := LoadLibrary(PChar(ADLLPath));
|
||||
if FModule = 0 then
|
||||
raise Exception.Create( 'Failed to load DLL.' );
|
||||
raise Exception.Create('Failed to load DLL.');
|
||||
|
||||
FStarteLogik := GetProcAddress( FModule, 'StarteLogik' );
|
||||
if not Assigned( FStarteLogik ) then
|
||||
raise Exception.Create( 'Procedure "StarteLogik" not found in DLL.' );
|
||||
FStarteLogik := GetProcAddress(FModule, 'StarteLogik');
|
||||
if not Assigned(FStarteLogik) then
|
||||
raise Exception.Create('Procedure "StarteLogik" not found in DLL.');
|
||||
end;
|
||||
|
||||
destructor TLLVMRunner.Destroy;
|
||||
begin
|
||||
if FModule <> 0 then
|
||||
FreeLibrary( FModule );
|
||||
FreeLibrary(FModule);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
// NEUE Implementierung der Host-Funktion
|
||||
class function TLLVMRunner.HostAddIntegers( ANum1: Integer; ANum2: Integer ): Integer;
|
||||
class function TLLVMRunner.HostAddIntegers(ANum1: Integer; ANum2: Integer): Integer;
|
||||
begin
|
||||
Result := ANum1 + ANum2; // Die eigentliche Logik
|
||||
if Assigned(FLog) then
|
||||
@@ -69,9 +72,9 @@ begin
|
||||
end;
|
||||
|
||||
// Die Execute-Methode muss angepasst werden, um den neuen Funktionszeiger zu übergeben
|
||||
procedure TLLVMRunner.Execute( AInputInteger: Integer );
|
||||
procedure TLLVMRunner.Execute(AInputInteger: Integer);
|
||||
begin
|
||||
if Assigned( FStarteLogik ) then
|
||||
if Assigned(FStarteLogik) then
|
||||
FStarteLogik(
|
||||
LogInteger,
|
||||
AInputInteger,
|
||||
@@ -80,10 +83,10 @@ begin
|
||||
end;
|
||||
|
||||
// Dies ist die Methode, die die DLL für LogInteger aufruft.
|
||||
class procedure TLLVMRunner.LogInteger( AValue: Integer );
|
||||
class procedure TLLVMRunner.LogInteger(AValue: Integer);
|
||||
begin
|
||||
if Assigned( FLog ) then
|
||||
FLog.Add( Format( 'DLL logged integer: %d', [AValue] ) );
|
||||
if Assigned(FLog) then
|
||||
FLog.Add(Format('DLL logged integer: %d', [AValue]));
|
||||
end;
|
||||
|
||||
// Die Implementierungen von GetCurrentDateTimeUTCHost und GetComponentInZoneHost
|
||||
|
||||
+119
-140
@@ -3,12 +3,32 @@ unit MainUnit;
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, 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,
|
||||
System.SysUtils,
|
||||
System.Types,
|
||||
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
|
||||
// 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
|
||||
// Pfad zur HTML-Datei (BITTE HIER ANPASSEN!)
|
||||
@@ -19,27 +39,27 @@ const
|
||||
LLD_PATH = 'lld-link.exe'; // <--- PRÜFEN UND ANPASSEN!
|
||||
|
||||
type
|
||||
TMainForm = class( TForm )
|
||||
TMainForm = class(TForm)
|
||||
WebBrowser1: TWebBrowser;
|
||||
SaveWorkspaceButton: TSpeedButton;
|
||||
GenerateCodeButton: TSpeedButton;
|
||||
Memo: TMemo;
|
||||
InputEdit: TEdit; // <--- Hinzugefügt (Optional für Beschriftung des InputEdit)
|
||||
procedure FormCreate( Sender: TObject );
|
||||
procedure FormDestroy( Sender: TObject );
|
||||
procedure RefreshButtonClick( Sender: TObject );
|
||||
procedure SaveWorkspaceButtonClick( Sender: TObject );
|
||||
procedure GenerateCodeButtonClick( Sender: TObject );
|
||||
procedure WebBrowser1DidFinishLoad( ASender: TObject );
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure RefreshButtonClick(Sender: TObject);
|
||||
procedure SaveWorkspaceButtonClick(Sender: TObject);
|
||||
procedure GenerateCodeButtonClick(Sender: TObject);
|
||||
procedure WebBrowser1DidFinishLoad(ASender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
FWebView: ICoreWebView2;
|
||||
FWebMessageReceiver: ICoreWebView2WebMessageReceivedEventHandler;
|
||||
FWebMessageReceivedToken: EventRegistrationToken;
|
||||
procedure HandleWebMessage( const AMessage: string );
|
||||
function ExecuteProcess( const ACommand: string; const AParameters: string ): string;
|
||||
procedure HandleWebMessage(const AMessage: string);
|
||||
function ExecuteProcess(const ACommand: string; const AParameters: string): string;
|
||||
public
|
||||
{ Public declarations }
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
@@ -49,55 +69,50 @@ implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
|
||||
type
|
||||
TWebMessageReceiver = class( TInterfacedObject, ICoreWebView2WebMessageReceivedEventHandler )
|
||||
TWebMessageReceiver = class(TInterfacedObject, ICoreWebView2WebMessageReceivedEventHandler)
|
||||
private
|
||||
FOwner: TMainForm;
|
||||
public
|
||||
constructor Create( AOwner: TMainForm );
|
||||
function Invoke( const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs ): HResult; stdcall;
|
||||
constructor Create(AOwner: TMainForm);
|
||||
function Invoke(const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs): HResult; stdcall;
|
||||
end;
|
||||
|
||||
constructor TWebMessageReceiver.Create( AOwner: TMainForm );
|
||||
constructor TWebMessageReceiver.Create(AOwner: TMainForm);
|
||||
begin
|
||||
inherited Create;
|
||||
FOwner := AOwner;
|
||||
end;
|
||||
|
||||
function TWebMessageReceiver.Invoke( const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs ): HResult;
|
||||
function TWebMessageReceiver.Invoke(const Sender: ICoreWebView2; const args: ICoreWebView2WebMessageReceivedEventArgs): HResult;
|
||||
var
|
||||
message: PWideChar;
|
||||
begin
|
||||
Result := args.TryGetWebMessageAsString( message );
|
||||
if Succeeded( Result ) then
|
||||
Result := args.TryGetWebMessageAsString(message);
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
FOwner.HandleWebMessage( string( message ) );
|
||||
end );
|
||||
TThread.Queue(nil, procedure begin FOwner.HandleWebMessage(string(message)); end);
|
||||
end;
|
||||
Result := S_OK;
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormCreate( Sender: TObject );
|
||||
procedure TMainForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
TLLVMRunner.Log := Memo.Lines;
|
||||
// Optional: Standardwert für InputEdit
|
||||
InputEdit.Text := '123';
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormDestroy( Sender: TObject );
|
||||
procedure TMainForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
TLLVMRunner.Log := nil;
|
||||
if ( FWebView <> nil ) and ( FWebMessageReceivedToken.value <> 0 ) then
|
||||
if (FWebView <> nil) and (FWebMessageReceivedToken.value <> 0) then
|
||||
begin
|
||||
FWebView.remove_WebMessageReceived( FWebMessageReceivedToken );
|
||||
FWebView.remove_WebMessageReceived(FWebMessageReceivedToken);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainForm.ExecuteProcess( const ACommand: string; const AParameters: string ): string;
|
||||
function TMainForm.ExecuteProcess(const ACommand: string; const AParameters: string): string;
|
||||
var
|
||||
sa: TSecurityAttributes;
|
||||
si: TStartupInfo;
|
||||
@@ -110,63 +125,52 @@ var
|
||||
output, errors: string;
|
||||
begin
|
||||
// Pipe für StdOut und StdErr erstellen
|
||||
sa.nLength := SizeOf( TSecurityAttributes );
|
||||
sa.nLength := SizeOf(TSecurityAttributes);
|
||||
sa.lpSecurityDescriptor := nil;
|
||||
sa.bInheritHandle := True;
|
||||
|
||||
// Für stdout und stderr wird dieselbe Pipe verwendet, da clang Fehler auf stdout ausgibt
|
||||
if not CreatePipe( stdOutRead, stdOutWrite, @sa, 0 ) then
|
||||
Exit( 'Error creating pipe.' );
|
||||
if not CreatePipe(stdOutRead, stdOutWrite, @sa, 0) then
|
||||
Exit('Error creating pipe.');
|
||||
|
||||
try
|
||||
// StartupInfo vorbereiten
|
||||
FillChar( si, SizeOf( TStartupInfo ), 0 );
|
||||
si.cb := SizeOf( TStartupInfo );
|
||||
FillChar(si, SizeOf(TStartupInfo), 0);
|
||||
si.cb := SizeOf(TStartupInfo);
|
||||
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
|
||||
si.wShowWindow := SW_HIDE; // Fenster explizit verstecken
|
||||
si.hStdInput := GetStdHandle( STD_INPUT_HANDLE );
|
||||
si.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
|
||||
si.hStdOutput := stdOutWrite;
|
||||
si.hStdError := stdOutWrite; // Leite stderr auf dieselbe Pipe wie stdout
|
||||
|
||||
cmdLine := Format( '"%s" %s', [ACommand, AParameters] );
|
||||
cmdLine := Format('"%s" %s', [ACommand, AParameters]);
|
||||
|
||||
success := CreateProcess(
|
||||
nil,
|
||||
PChar( cmdLine ),
|
||||
nil,
|
||||
nil,
|
||||
True,
|
||||
CREATE_NO_WINDOW,
|
||||
nil,
|
||||
nil,
|
||||
si,
|
||||
pi
|
||||
);
|
||||
success := CreateProcess(nil, PChar(cmdLine), nil, nil, True, CREATE_NO_WINDOW, nil, nil, si, pi);
|
||||
|
||||
// Schreib-Handle der Pipe sofort schließen
|
||||
CloseHandle( stdOutWrite );
|
||||
CloseHandle(stdOutWrite);
|
||||
|
||||
if not success then
|
||||
Exit( Format( 'CreateProcess failed. Code: %d', [GetLastError] ) );
|
||||
Exit(Format('CreateProcess failed. Code: %d', [GetLastError]));
|
||||
|
||||
try
|
||||
output := '';
|
||||
// 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
|
||||
TerminateProcess( pi.hProcess, 1 );
|
||||
Exit( 'Process timed out.' );
|
||||
TerminateProcess(pi.hProcess, 1);
|
||||
Exit('Process timed out.');
|
||||
end;
|
||||
|
||||
// Bytes aus der Pipe lesen
|
||||
repeat
|
||||
SetLength( buffer, 1024 );
|
||||
SetLength(buffer, 1024);
|
||||
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
|
||||
SetLength( buffer, bytesRead );
|
||||
SetLength(buffer, bytesRead);
|
||||
// Gelesene Bytes mit dem Default-System-Encoding in einen String umwandeln
|
||||
output := output + TEncoding.Default.GetString( buffer );
|
||||
output := output + TEncoding.Default.GetString(buffer);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@@ -175,33 +179,33 @@ begin
|
||||
until False;
|
||||
|
||||
finally
|
||||
CloseHandle( pi.hProcess );
|
||||
CloseHandle( pi.hThread );
|
||||
CloseHandle(pi.hProcess);
|
||||
CloseHandle(pi.hThread);
|
||||
end;
|
||||
|
||||
Result := output;
|
||||
|
||||
finally
|
||||
CloseHandle( stdOutRead );
|
||||
CloseHandle(stdOutRead);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.RefreshButtonClick( Sender: TObject );
|
||||
procedure TMainForm.RefreshButtonClick(Sender: TObject);
|
||||
begin
|
||||
WebBrowser1.Navigate( PATH_BLOCKLY );
|
||||
WebBrowser1.Navigate(PATH_BLOCKLY);
|
||||
end;
|
||||
|
||||
procedure TMainForm.SaveWorkspaceButtonClick( Sender: TObject );
|
||||
procedure TMainForm.SaveWorkspaceButtonClick(Sender: TObject);
|
||||
begin
|
||||
WebBrowser1.EvaluateJavaScript( 'saveWorkspace()' );
|
||||
WebBrowser1.EvaluateJavaScript('saveWorkspace()');
|
||||
end;
|
||||
|
||||
procedure TMainForm.GenerateCodeButtonClick( Sender: TObject );
|
||||
procedure TMainForm.GenerateCodeButtonClick(Sender: TObject);
|
||||
begin
|
||||
WebBrowser1.EvaluateJavaScript( 'generateAndPostCode()' );
|
||||
WebBrowser1.EvaluateJavaScript('generateAndPostCode()');
|
||||
end;
|
||||
|
||||
procedure TMainForm.HandleWebMessage( const AMessage: string );
|
||||
procedure TMainForm.HandleWebMessage(const AMessage: string);
|
||||
var
|
||||
llFile, objFile, dllFile: string;
|
||||
compilerOutput: string;
|
||||
@@ -209,16 +213,16 @@ var
|
||||
InputInteger: Integer; // <--- Hinzugefügt
|
||||
begin
|
||||
Memo.Lines.Clear;
|
||||
Memo.Lines.Add( 'LLVM-Code empfangen. Starte Kompilierung...' );
|
||||
Memo.Lines.Add( AMessage );
|
||||
Memo.Lines.Add( '--------------------' );
|
||||
Memo.Lines.Add('LLVM-Code empfangen. Starte Kompilierung...');
|
||||
Memo.Lines.Add(AMessage);
|
||||
Memo.Lines.Add('--------------------');
|
||||
|
||||
// Wert aus dem InputEdit-Feld holen
|
||||
try
|
||||
InputInteger := StrToIntDef( InputEdit.Text, 0 ); // Standardwert 0, falls ungültig
|
||||
InputInteger := StrToIntDef(InputEdit.Text, 0); // Standardwert 0, falls ungültig
|
||||
except
|
||||
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;
|
||||
|
||||
TTask.Run(
|
||||
@@ -228,107 +232,82 @@ begin
|
||||
compilerOutputLocal: string;
|
||||
successLocal: Boolean;
|
||||
begin
|
||||
llFileLocal := TPath.Combine( TPath.GetTempPath, 'poc.ll' );
|
||||
objFileLocal := TPath.ChangeExtension( llFileLocal, '.obj' );
|
||||
dllFileLocal := TPath.ChangeExtension( llFileLocal, '.dll' );
|
||||
llFileLocal := TPath.Combine(TPath.GetTempPath, 'poc.ll');
|
||||
objFileLocal := TPath.ChangeExtension(llFileLocal, '.obj');
|
||||
dllFileLocal := TPath.ChangeExtension(llFileLocal, '.dll');
|
||||
successLocal := False;
|
||||
|
||||
try
|
||||
TFile.WriteAllText( llFileLocal, AMessage );
|
||||
TFile.WriteAllText(llFileLocal, AMessage);
|
||||
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
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 );
|
||||
TThread.Queue(nil, procedure begin 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
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( 'FEHLER: Kompilierung fehlgeschlagen. .obj-Datei nicht erstellt.' );
|
||||
end );
|
||||
TThread
|
||||
.Queue(nil, procedure begin Memo.Lines.Add('FEHLER: Kompilierung fehlgeschlagen. .obj-Datei nicht erstellt.'); end);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
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 );
|
||||
TThread.Queue(nil, procedure begin 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
|
||||
successLocal := True;
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( Format( 'ERFOLG: DLL wurde erstellt: %s', [dllFileLocal] ) );
|
||||
end );
|
||||
TThread.Queue(nil, procedure begin Memo.Lines.Add(Format('ERFOLG: DLL wurde erstellt: %s', [dllFileLocal])); end);
|
||||
end
|
||||
else
|
||||
begin
|
||||
TThread.Queue( nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( 'FEHLER: Linken fehlgeschlagen. .dll-Datei nicht erstellt.' );
|
||||
end );
|
||||
TThread.Queue(nil, procedure begin Memo.Lines.Add('FEHLER: Linken fehlgeschlagen. .dll-Datei nicht erstellt.'); end);
|
||||
end;
|
||||
|
||||
finally
|
||||
if TFile.Exists( llFileLocal ) then
|
||||
TFile.Delete( llFileLocal );
|
||||
if TFile.Exists( objFileLocal ) then
|
||||
TFile.Delete( objFileLocal );
|
||||
if not successLocal and TFile.Exists( dllFileLocal ) then
|
||||
TFile.Delete( dllFileLocal );
|
||||
if TFile.Exists(llFileLocal) then
|
||||
TFile.Delete(llFileLocal);
|
||||
if TFile.Exists(objFileLocal) then
|
||||
TFile.Delete(objFileLocal);
|
||||
if not successLocal and TFile.Exists(dllFileLocal) then
|
||||
TFile.Delete(dllFileLocal);
|
||||
end;
|
||||
|
||||
TThread.Queue( nil,
|
||||
TThread.Queue(
|
||||
nil,
|
||||
procedure
|
||||
begin
|
||||
Memo.Lines.Add( '---------------------------------------------------------' );
|
||||
Memo.Lines.Add( 'DLL wird aufgerufen:' );
|
||||
Memo.Lines.Add('---------------------------------------------------------');
|
||||
Memo.Lines.Add('DLL wird aufgerufen:');
|
||||
|
||||
if TFile.Exists( dllFileLocal ) then
|
||||
if TFile.Exists(dllFileLocal) then
|
||||
begin
|
||||
var
|
||||
Runner := TLLVMRunner.Create( dllFileLocal );
|
||||
var Runner := TLLVMRunner.Create(dllFileLocal);
|
||||
try
|
||||
Runner.Execute( InputInteger ); // <--- HIER DEN INPUT-PARAMETER ÜBERGEBEN
|
||||
Runner.Execute(InputInteger); // <--- HIER DEN INPUT-PARAMETER ÜBERGEBEN
|
||||
finally
|
||||
Runner.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Memo.Lines.Add( 'DLL beendet.' );
|
||||
Memo.CaretPosition := TCaretPosition.Create( Memo.Lines.Count-1, 1 );
|
||||
end );
|
||||
end );
|
||||
Memo.Lines.Add('DLL beendet.');
|
||||
Memo.CaretPosition := TCaretPosition.Create(Memo.Lines.Count - 1, 1);
|
||||
end
|
||||
);
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TMainForm.WebBrowser1DidFinishLoad( ASender: TObject );
|
||||
procedure TMainForm.WebBrowser1DidFinishLoad(ASender: TObject);
|
||||
begin
|
||||
if Assigned( FWebMessageReceiver ) then
|
||||
if Assigned(FWebMessageReceiver) then
|
||||
Exit;
|
||||
|
||||
if Supports( WebBrowser1, ICoreWebView2, FWebView ) then
|
||||
if Supports(WebBrowser1, ICoreWebView2, FWebView) then
|
||||
begin
|
||||
FWebMessageReceiver := TWebMessageReceiver.Create( Self );
|
||||
FWebView.add_WebMessageReceived( FWebMessageReceiver, FWebMessageReceivedToken );
|
||||
FWebMessageReceiver := TWebMessageReceiver.Create(Self);
|
||||
FWebView.add_WebMessageReceived(FWebMessageReceiver, FWebMessageReceivedToken);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@@ -2,7 +2,8 @@ unit ApiKey;
|
||||
|
||||
interface
|
||||
|
||||
const Value = 'AIzaSyALccoMxn0_wcHswavhu5rzdglLeH6gVlI';
|
||||
const
|
||||
Value = 'AIzaSyALccoMxn0_wcHswavhu5rzdglLeH6gVlI';
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@@ -1,16 +1,16 @@
|
||||
program GeminiAccess;
|
||||
|
||||
uses
|
||||
FastMM5,
|
||||
Vcl.Forms,
|
||||
MainUnit in 'MainUnit.pas' {Form1},
|
||||
ApiKey in 'ApiKey.pas';
|
||||
FastMM5,
|
||||
Vcl.Forms,
|
||||
MainUnit in 'MainUnit.pas' {Form1},
|
||||
ApiKey in 'ApiKey.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
+100
-76
@@ -3,10 +3,24 @@ unit MainUnit;
|
||||
interface
|
||||
|
||||
uses
|
||||
Winapi.Windows, Winapi.Messages, System.SysUtils, 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;
|
||||
Winapi.Windows,
|
||||
Winapi.Messages,
|
||||
System.SysUtils,
|
||||
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
|
||||
// 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
|
||||
procedure SendPrompt;
|
||||
public
|
||||
{ Public declarations }
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
@@ -127,78 +141,88 @@ begin
|
||||
AnswerMemo.Lines.Add(userPrompt);
|
||||
AnswerMemo.Lines.Add('... sende Anfrage an Gemini ...');
|
||||
|
||||
FAnswer := TFuture<string>.Construct(
|
||||
function: string
|
||||
var
|
||||
jsonRequest: TJSONObject;
|
||||
jsonContents: TJSONArray;
|
||||
requestBody: TStringStream;
|
||||
response: IHTTPResponse;
|
||||
responseJson: TJSONValue;
|
||||
apiUrl: string;
|
||||
turn: TChatTurn;
|
||||
begin
|
||||
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
|
||||
FAnswer :=
|
||||
TFuture<string>.Construct(
|
||||
function: string
|
||||
var
|
||||
jsonRequest: TJSONObject;
|
||||
jsonContents: TJSONArray;
|
||||
requestBody: TStringStream;
|
||||
response: IHTTPResponse;
|
||||
responseJson: TJSONValue;
|
||||
apiUrl: string;
|
||||
turn: TChatTurn;
|
||||
begin
|
||||
Result := '--- FEHLER IM TASK ---' + sLineBreak + E.Message;
|
||||
end;
|
||||
end;
|
||||
end);
|
||||
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
|
||||
Result := '--- FEHLER IM TASK ---' + sLineBreak + E.Message;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@@ -87,7 +87,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TUnitInfo implementation }
|
||||
constructor TUnitInfo.Create(const AFilePath: string);
|
||||
begin
|
||||
@@ -141,7 +140,7 @@ begin
|
||||
if (currentChar = #13) or (currentChar = #10) then
|
||||
begin
|
||||
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(' ');
|
||||
end;
|
||||
Inc(i);
|
||||
@@ -189,7 +188,7 @@ begin
|
||||
end;
|
||||
if (currentChar = #13) or (currentChar = #10) or (currentChar = #9) then
|
||||
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(' ');
|
||||
Inc(i);
|
||||
end
|
||||
@@ -588,7 +587,13 @@ begin
|
||||
outputFileName := ParamStr(currentParamIndex + 1);
|
||||
Inc(currentParamIndex, 2);
|
||||
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
|
||||
else if SameText(currentParam, '-dirs') then
|
||||
begin
|
||||
@@ -610,12 +615,23 @@ begin
|
||||
WriteLn('Warning: File specified with -dirs not found: ' + dirsFileName);
|
||||
Inc(currentParamIndex, 2);
|
||||
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
|
||||
else if SameText(currentParam, '-f') or SameText(currentParam, '-fx') then
|
||||
begin
|
||||
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
|
||||
begin
|
||||
@@ -626,12 +642,18 @@ begin
|
||||
filesToExcludeFromOutput.Text := initialFocusFiles.Text;
|
||||
Inc(currentParamIndex, 2);
|
||||
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
|
||||
else
|
||||
begin
|
||||
sourceDirectories.Add(currentParam);
|
||||
inc( currentParamIndex );
|
||||
inc(currentParamIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
@@ -650,12 +672,11 @@ begin
|
||||
Dec(i);
|
||||
end;
|
||||
|
||||
|
||||
if writeToClipboard and (outputFileName <> '') then
|
||||
begin
|
||||
WriteLn('Error: -o (output to file) and -c (output to clipboard) cannot be used together.');
|
||||
exitcode := 1;
|
||||
exit;
|
||||
WriteLn('Error: -o (output to file) and -c (output to clipboard) cannot be used together.');
|
||||
exitcode := 1;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if sourceDirectories.Count = 0 then
|
||||
@@ -687,14 +708,20 @@ begin
|
||||
for var focusFile in initialFocusFiles do
|
||||
begin
|
||||
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
|
||||
allFoundPasFilesList.Add(focusFile);
|
||||
end;
|
||||
end;
|
||||
|
||||
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);
|
||||
sortedUnits := TList<TUnitInfo>.Create;
|
||||
@@ -719,14 +746,23 @@ begin
|
||||
end;
|
||||
end
|
||||
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
|
||||
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;
|
||||
|
||||
if allUnits.Count = 0 then
|
||||
begin WriteLn('No units successfully parsed.'); exit; end;
|
||||
begin
|
||||
WriteLn('No units successfully parsed.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
if focusMode then
|
||||
begin
|
||||
@@ -929,12 +965,15 @@ begin
|
||||
|
||||
if item.InterfaceSection.Count > 0 then
|
||||
begin
|
||||
outputContent.Add('//==================================================================================================');
|
||||
outputContent
|
||||
.Add('//==================================================================================================');
|
||||
outputContent.Add('//== UNIT START: ' + item.Name + ' (from ' + ExtractFileName(item.FilePath) + ')');
|
||||
outputContent.Add('//==================================================================================================');
|
||||
outputContent
|
||||
.Add('//==================================================================================================');
|
||||
outputContent.AddStrings(item.InterfaceSection);
|
||||
outputContent.Add('//== UNIT END: ' + item.Name);
|
||||
outputContent.Add('//==================================================================================================');
|
||||
outputContent
|
||||
.Add('//==================================================================================================');
|
||||
outputContent.Add('');
|
||||
end;
|
||||
end;
|
||||
|
||||
@@ -30,7 +30,6 @@ uses
|
||||
Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas',
|
||||
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.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.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas',
|
||||
Myc.Trade.DataPoint in '..\Src\Myc.Trade.DataPoint.pas',
|
||||
|
||||
@@ -130,7 +130,6 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<DCCReference Include="..\Src\Myc.Test.Core.Lazy.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Test.Lazy.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.Dirty.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Trade.DataPoint.pas"/>
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user