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/DynamicFMXControl.pas
+11 -3
View File
@@ -3,8 +3,15 @@ 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
@@ -127,7 +134,8 @@ type
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
read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent;
property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent; property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent;
property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent; property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent;
property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent; property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent;
AuraTrader/MainForm.pas
+28 -36
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(
function(const Values: TArray<TDataPoint<TAuraAskBidFileItem>>): TArray<TDataPoint<TAskBidItem>>
begin begin
SetLength( Result, Length( Values ) ); SetLength(Result, Length(Values));
for var i:=0 to High(Result) do for var i := 0 to High(Result) do
begin begin
Result[i].Time := Values[i].Time; Result[i].Time := Values[i].Time;
Result[i].Data.Ask := Values[i].Data.Ask; Result[i].Data.Ask := Values[i].Data.Ask;
Result[i].Data.Bid := Values[i].Data.Bid; Result[i].Data.Bid := Values[i].Data.Bid;
end; end;
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/LLVM.Runner.pas
+22 -19
View File
@@ -3,18 +3,21 @@ 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 =
procedure(
ALogIntProc: TLogIntegerCallback; ALogIntProc: TLogIntegerCallback;
AHostInputInteger: Integer; AHostInputInteger: Integer;
AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter AHostAddIntegersProc: THostAddIntegersCallback // <--- Der neue Host-Unterprogramm-Parameter
@@ -27,13 +30,13 @@ type
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
+118 -139
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,25 +39,25 @@ 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;
@@ -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/MainUnit.pas
+36 -12
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
@@ -127,7 +141,8 @@ 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 :=
TFuture<string>.Construct(
function: string function: string
var var
jsonRequest: TJSONObject; jsonRequest: TJSONObject;
@@ -172,18 +187,27 @@ begin
begin begin
responseJson := TJSONObject.ParseJSONValue(response.ContentAsString(TEncoding.UTF8)); responseJson := TJSONObject.ParseJSONValue(response.ContentAsString(TEncoding.UTF8));
try try
Result := responseJson.GetValue<TJSONArray>('candidates') Result :=
.Items[0].GetValue<TJSONObject>('content') responseJson
.GetValue<TJSONArray>('candidates')
.Items[0]
.GetValue<TJSONObject>('content')
.GetValue<TJSONArray>('parts') .GetValue<TJSONArray>('parts')
.Items[0].GetValue<string>('text'); .Items[0]
.GetValue<string>('text');
finally finally
responseJson.Free; responseJson.Free;
end; end;
end end
else else
begin begin
Result := 'Fehler! Status: ' + response.StatusCode.ToString + ' - ' + response.StatusText + Result :=
sLineBreak + response.ContentAsString; 'Fehler! Status: '
+ response.StatusCode.ToString
+ ' - '
+ response.StatusText
+ sLineBreak
+ response.ContentAsString;
end; end;
finally finally
requestBody.Free; requestBody.Free;
@@ -197,8 +221,8 @@ begin
Result := '--- FEHLER IM TASK ---' + sLineBreak + E.Message; Result := '--- FEHLER IM TASK ---' + sLineBreak + E.Message;
end; end;
end; end;
end); end
);
end; end;
end. end.
IntfExtract/ExtractPascalInterfaces.dpr
+56 -17
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,7 +672,6 @@ 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.');
@@ -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.