library project1;
{$mode objfpc}{$H+}
uses
Interfaces,
Classes,
SysUtils,
Windows,
FileUtil,
Forms,
Controls,
Graphics,
Dialogs,
ShellApi;
const
Inputs = 3; // quantita entrata
Outputs = 1; // quantita uscita
{INPUTS}// nome per numero di entrata
I0 = 0; // valore I0 = PInput[I0] ossia PInput[0]
I1 = 1; // valore I1 = PInput[I1] ossia PInput[1]
Leggi = 2;
// I3 = 3;
// ... I99 = 99;
{OUTPUTS}// nome per numero di uscita
Stampa = 0; // valore Q0 = POutput[Q0] ossia POutput[0]
//Q1 = 1; // valore Q1 = POutput[Q1] ossia POutput[1]
// Q3 = 3;
// ... Q99 = 99;
{USER}// nome per numero di variabile, I valori vengono memorizzati
U0 = 0; // valore U0 = PUser[U0] ossia PUser[0]
// U1 = 1;
// U2 = 2;
// U3 = 3;
// ... U99 = 99;
// I0,I1,I2,I3,Q0,Q1,Q2,Q3,U0,U1,U2,U3
// I nomi possono essere qualsiasi, sono case-insensitive
var
globalDialog: TFileDialog;
type
TDLLParams = array[0..100] of extended; //Type of ProfiLab DLL parameters
PDLLParams = ^TDLLParams; // Pointer to ProfiLab DLL parameters
TStringParams = array[0..100] of PChar; //Type of ProfiLab DLL parameters
PStringParams = ^TStringParams; // Pointer to ProfiLab DLL parameters
function ApriSaveDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TSaveDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function ApriOpenDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TOpenDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function NumInputs: byte;
begin
Result := Inputs; // trasferire quantita entrata
end;
function NumOutputs: byte;
begin
Result := Outputs; // trasferire quantita uscita
end;
function InputName(Channel: byte): ShortString; // trasferire nome di entrata
begin
case Channel of
I0: Result := 'I0'; // nome di pin I0
I1: Result := 'I1'; // nome di pin I1
Leggi: Result := '$Leggi';
end;
end;
function OutputName(Channel: byte): ShortString; // trasferire nome di uscita
begin
case Channel of
Stampa: Result := '$Stampa'; // nome di pin Q0
//Q1: Result := 'Q1'; // nome di pin Q1
end;
end;
procedure SimStart(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo al primo avvio
begin
end;
procedure SalvaArrayInFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
begin
sl := TStringList.Create;
try
for i := 2 to 3 do
// for i := low(PAParams^) to high(PAParams^) do
if PAParams^[i] <> 0 then
sl.Add(FloatToStr(PAParams^[i]));
sl.SaveToFile(FileName);
finally
sl.Free;
end;
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
s := sl.Values[IntToStr(i)];
e := StrToFloat(s);
PAParams^[i] := e;
end;
finally
sl.Free;
end;
end;
procedure CalculateEx(PInput, POutput, PUser: PDLLParams; PStrings: PStringParams);
// Routine è permanente
var
sl: TStringList;
s: string;
begin
if PInput^[I0] > 2.5 then
begin
if (PInput^[I0] > 2.5) and not (PUser^[U0] > 2.5) then
begin
s := ApriOpenDialog;
if s <> '' then
CaricaArrayDaFile(s, POutput);
end;
end;
PUser^[U0] := PInput^[I0];
if PInput^[I1] > 2.5 then
begin
if (PInput^[I1] > 2.5) and not (PUser^[I1] > 2.5) then
begin
s := ApriSaveDialog;
if s <> '' then
SalvaArrayInFile(s, PInput);
end;
end;
PUser^[I1] := PInput^[I1];
end;
procedure SimStop(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo in fase di chiusura
begin
end;
//export methods for ProfiLab
exports
SimStart,
SimStop,
NumInputs,
NumOutputs,
CalculateEx,
InputName,
OutputName,
ApriOpenDialog,
ApriSaveDialog;
begin
end.
Si è CaricaArrayDaFile, ma sembra non funzioni proprio, l'errore esce quando premo Apri sulla finestra di dialogo.
procedure CalculateEx(PInput, POutput, PUser: PDLLParams; PStrings: PStringParams);
// Routine è permanente
var
sl: TStringList;
s: string;
begin
if PInput^[I0] > 2.5 then
begin
if (PInput^[I0] > 2.5) and not (PUser^[U0] > 2.5) then
begin
s := ApriOpenDialog;
assignFile(Ouput, 'dll.txt.dove finisce il log');
rewrite (Output);
procedure log(msg :String);
begin
AssignFile(Output, 'Debug.txt');
if (FileExists('Debug.txt')) then
begin
Append(Output);
end
else
begin
Rewrite(Output);
end;
WriteLn(Output, msg);
Flush(Output);
CloseFile(Output);
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
sl.LoadFromFile(FileName);
//for i := 1 to 6 do
for i := low(PAParams^) to high(PAParams^) do
begin
s := sl.Values[IntToStr(i)];
e := StrToFloat(s);
PAParams^[i] := e;
end;
finally
sl.Free;
end;
end;
procedure log(msg: string);
begin
AssignFile(Output, 'Debug.txt');
if (FileExists('Debug.txt')) then
begin
Append(Output);
end
else
begin
Rewrite(Output);
end;
WriteLn(Output, msg);
Flush(Output);
CloseFile(Output);
end;
procedure log(msg: string);
begin
AssignFile(Output, 'Debug.txt');
if (FileExists('Debug.txt')) then
begin
Append(Output);
end
else
begin
Rewrite(Output);
end;
WriteLn(Output, msg);
Flush(Output);
CloseFile(Output);
end;
procedure CalculateEx(PInput, POutput, PUser: PDLLParams; PStrings: PStringParams); // Routine è permanente
var
sl: TStringList;
s: string;
begin
if PInput^[I0] > 2.5 then
begin
if (PInput^[I0] > 2.5) and not (PUser^[U0] > 2.5) then
begin
s := ApriOpenDialog;
log('Nome del file selezionato : ' + s);
if s <> '' then
begin
if assigned(POutput) then
log('POutput ok')
else
raise Exception.Create('Non ci siamo');
CaricaArrayDaFile(s, POutput);
end;
end;
end;
PUser^[U0] := PInput^[I0];
if PInput^[I1] > 2.5 then
begin
if (PInput^[I1] > 2.5) and not (PUser^[I1] > 2.5) then
begin
s := ApriSaveDialog;
if s <> '' then
SalvaArrayInFile(s, PInput);
end;
end;
PUser^[I1] := PInput^[I1];
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
s := sl.Values[IntToStr(i)];
e := StrToFloat(s);
PAParams^[i] := e;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
library project1;
{$mode objfpc}{$H+}
uses
Interfaces,
Classes,
SysUtils,
Windows,
FileUtil,
Forms,
Controls,
Graphics,
Dialogs,
ShellApi;
const
Inputs = 3; // quantita entrata
Outputs = 1; // quantita uscita
{INPUTS}// nome per numero di entrata
I0 = 0; // valore I0 = PInput[I0] ossia PInput[0]
I1 = 1; // valore I1 = PInput[I1] ossia PInput[1]
Leggi = 2;
// I3 = 3;
// ... I99 = 99;
{OUTPUTS}// nome per numero di uscita
Stampa = 0; // valore Q0 = POutput[Q0] ossia POutput[0]
//Q1 = 1; // valore Q1 = POutput[Q1] ossia POutput[1]
// Q3 = 3;
// ... Q99 = 99;
{USER}// nome per numero di variabile, I valori vengono memorizzati
U0 = 0; // valore U0 = PUser[U0] ossia PUser[0]
// U1 = 1;
// U2 = 2;
// U3 = 3;
// ... U99 = 99;
// I0,I1,I2,I3,Q0,Q1,Q2,Q3,U0,U1,U2,U3
// I nomi possono essere qualsiasi, sono case-insensitive
var
globalDialog: TFileDialog;
type
TDLLParams = array[0..100] of extended; //Type of ProfiLab DLL parameters
PDLLParams = ^TDLLParams; // Pointer to ProfiLab DLL parameters
TStringParams = array[0..100] of PChar; //Type of ProfiLab DLL parameters
PStringParams = ^TStringParams; // Pointer to ProfiLab DLL parameters
function ApriSaveDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TSaveDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function ApriOpenDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TOpenDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function NumInputs: byte;
begin
Result := Inputs; // trasferire quantita entrata
end;
function NumOutputs: byte;
begin
Result := Outputs; // trasferire quantita uscita
end;
function InputName(Channel: byte): ShortString; // trasferire nome di entrata
begin
case Channel of
I0: Result := 'I0'; // nome di pin I0
I1: Result := 'I1'; // nome di pin I1
Leggi: Result := '$Leggi';
end;
end;
function OutputName(Channel: byte): ShortString; // trasferire nome di uscita
begin
case Channel of
Stampa: Result := '$Stampa'; // nome di pin Q0
//Q1: Result := 'Q1'; // nome di pin Q1
end;
end;
procedure SimStart(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo al primo avvio
begin
end;
procedure SalvaArrayInFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
begin
sl := TStringList.Create;
try
for i := 2 to 3 do
// for i := low(PAParams^) to high(PAParams^) do
if PAParams^[i] <> 0 then
sl.Add(FloatToStr(PAParams^[i]));
sl.SaveToFile(FileName);
finally
sl.Free;
end;
end;
procedure log(msg: string);
begin
AssignFile(Output, 'Debug.txt');
if (FileExists('Debug.txt')) then
begin
Append(Output);
end
else
begin
Rewrite(Output);
end;
WriteLn(Output, msg);
Flush(Output);
CloseFile(Output);
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
s := sl.Values[IntToStr(i)];
e := StrToFloat(s);
PAParams^[i] := e;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
procedure CalculateEx(PInput, POutput, PUser: PDLLParams; PStrings: PStringParams);
// Routine è permanente
var
sl: TStringList;
s: string;
begin
if PInput^[I0] > 2.5 then
begin
if (PInput^[I0] > 2.5) and not (PUser^[U0] > 2.5) then
begin
s := ApriOpenDialog;
log('Nome del file selezionato : ' + s);
if s <> '' then
begin
if assigned(POutput) then
log('POutput ok')
else
raise Exception.Create('Non ci siamo');
CaricaArrayDaFile(s, POutput);
end;
end;
end;
PUser^[U0] := PInput^[I0];
if PInput^[I1] > 2.5 then
begin
if (PInput^[I1] > 2.5) and not (PUser^[I1] > 2.5) then
begin
s := ApriSaveDialog;
if s <> '' then
SalvaArrayInFile(s, PInput);
end;
end;
PUser^[I1] := PInput^[I1];
end;
procedure SimStop(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo in fase di chiusura
begin
end;
//export methods for ProfiLab
exports
SimStart,
SimStop,
NumInputs,
NumOutputs,
CalculateEx,
InputName,
OutputName,
ApriOpenDialog,
ApriSaveDialog;
begin
end.
for i := low(PAParams^) to high(PAParams^) do
begin
s := sl.Values[IntToStr(i)];
if s <> '' then
begin
e := StrToFloat(s);
PAParams^[i] := e;
end
else
begin
log(IntToStr(i)+' non caricato');
end
end;
library project1;
{$mode objfpc}{$H+}
uses
Interfaces,
Classes,
SysUtils,
Windows,
FileUtil,
Forms,
Controls,
Graphics,
Dialogs,
ShellApi;
const
Inputs = 3; // quantita entrata
Outputs = 1; // quantita uscita
{INPUTS}// nome per numero di entrata
I0 = 0; // valore I0 = PInput[I0] ossia PInput[0]
I1 = 1; // valore I1 = PInput[I1] ossia PInput[1]
Leggi = 2;
// I3 = 3;
// ... I99 = 99;
{OUTPUTS}// nome per numero di uscita
Stampa = 0; // valore Q0 = POutput[Q0] ossia POutput[0]
//Q1 = 1; // valore Q1 = POutput[Q1] ossia POutput[1]
// Q3 = 3;
// ... Q99 = 99;
{USER}// nome per numero di variabile, I valori vengono memorizzati
U0 = 0; // valore U0 = PUser[U0] ossia PUser[0]
// U1 = 1;
// U2 = 2;
// U3 = 3;
// ... U99 = 99;
// I0,I1,I2,I3,Q0,Q1,Q2,Q3,U0,U1,U2,U3
// I nomi possono essere qualsiasi, sono case-insensitive
var
globalDialog: TFileDialog;
type
TDLLParams = array[0..100] of extended; //Type of ProfiLab DLL parameters
PDLLParams = ^TDLLParams; // Pointer to ProfiLab DLL parameters
TStringParams = array[0..100] of PChar; //Type of ProfiLab DLL parameters
PStringParams = ^TStringParams; // Pointer to ProfiLab DLL parameters
function ApriSaveDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TSaveDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function ApriOpenDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TOpenDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function NumInputs: byte;
begin
Result := Inputs; // trasferire quantita entrata
end;
function NumOutputs: byte;
begin
Result := Outputs; // trasferire quantita uscita
end;
function InputName(Channel: byte): ShortString; // trasferire nome di entrata
begin
case Channel of
I0: Result := 'I0'; // nome di pin I0
I1: Result := 'I1'; // nome di pin I1
Leggi: Result := '$Leggi';
end;
end;
function OutputName(Channel: byte): ShortString; // trasferire nome di uscita
begin
case Channel of
Stampa: Result := '$Stampa'; // nome di pin Q0
//Q1: Result := 'Q1'; // nome di pin Q1
end;
end;
procedure SimStart(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo al primo avvio
begin
end;
procedure SalvaArrayInFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
begin
sl := TStringList.Create;
try
for i := 2 to 3 do
// for i := low(PAParams^) to high(PAParams^) do
if PAParams^[i] <> 0 then
sl.Add(FloatToStr(PAParams^[i]));
sl.SaveToFile(FileName);
finally
sl.Free;
end;
end;
procedure log(msg: string);
begin
AssignFile(Output, 'Debug.txt');
if (FileExists('Debug.txt')) then
begin
Append(Output);
end
else
begin
Rewrite(Output);
end;
WriteLn(Output, msg);
Flush(Output);
CloseFile(Output);
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
s := sl.Values[IntToStr(i)];
if s <> '' then
begin
e := StrToFloat(s);
PAParams^[i] := e;
end
else
begin
log(IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
procedure CalculateEx(PInput, POutput, PUser: PDLLParams; PStrings: PStringParams);
// Routine è permanente
var
sl: TStringList;
s: string;
begin
if PInput^[I0] > 2.5 then
begin
if (PInput^[I0] > 2.5) and not (PUser^[U0] > 2.5) then
begin
s := ApriOpenDialog;
log('Nome del file selezionato : ' + s);
if s <> '' then
begin
if assigned(POutput) then
log('POutput ok')
else
raise Exception.Create('Non ci siamo');
CaricaArrayDaFile(s, POutput);
end;
end;
end;
PUser^[U0] := PInput^[I0];
if PInput^[I1] > 2.5 then
begin
if (PInput^[I1] > 2.5) and not (PUser^[I1] > 2.5) then
begin
s := ApriSaveDialog;
if s <> '' then
SalvaArrayInFile(s, PInput);
end;
end;
PUser^[I1] := PInput^[I1];
end;
procedure SimStop(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo in fase di chiusura
begin
end;
//export methods for ProfiLab
exports
SimStart,
SimStop,
NumInputs,
NumOutputs,
CalculateEx,
InputName,
OutputName,
ApriOpenDialog,
ApriSaveDialog;
begin
end.
s := sl.Values[IntToStr(i)];
s := sl[I];
s := sl[I];for i := low(PAParams^) to high(PAParams^) do
begin
s := sl.Values[IntToStr(i)];
log(IntToStr(i)+': valore = <' + s + '>');
if s <> '' then begin
e := StrToFloat(s);
PAParams^[i] := e;
log(' + IntToStr(i)+' caricato');
end else begin
log(' ' + IntToStr(i)+' non caricato');
end;
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
s := sl.Values[IntToStr(i)];
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
e := StrToFloat(s);
PAParams^[i] := e;
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
s := sl.Values[IntToStr(i)];
Ma dici in questa riga?Codice: [Seleziona]s := sl.Values[IntToStr(i)];
s := sl[i];
s := sl[i];
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
if not (i in [0..sl.count-1]) then
break;
s := sl.Values[IntToStr(i)];
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
e := StrToFloat(s);
PAParams^[i] := e;
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
s := sl.Values[IntToStr(i)];
s := sl[i];
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
if not (i in [0..sl.Count - 1]) then
break;
s := sl[i];
// s := sl.Values[IntToStr(i)];
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
e := StrToFloat(s);
PAParams^[i] := e;
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
TStringParams = array[0..100] of PChar; //Type of ProfiLab DLL parameters
PStringParams = ^TStringParams; // Pointer to ProfiLab DLL parameters
library project1;
{$mode objfpc}{$H+}
uses
Interfaces,
Classes,
SysUtils,
Windows,
FileUtil,
Forms,
Controls,
Graphics,
Dialogs,
ShellApi;
const
Inputs = 3; // quantita entrata
Outputs = 1; // quantita uscita
{INPUTS}// nome per numero di entrata
I0 = 0; // valore I0 = PInput[I0] ossia PInput[0]
I1 = 1; // valore I1 = PInput[I1] ossia PInput[1]
Leggi = 2;
// I3 = 3;
// ... I99 = 99;
{OUTPUTS}// nome per numero di uscita
Stampa = 0; // valore Q0 = POutput[Q0] ossia POutput[0]
//Q1 = 1; // valore Q1 = POutput[Q1] ossia POutput[1]
// Q3 = 3;
// ... Q99 = 99;
{USER}// nome per numero di variabile, I valori vengono memorizzati
U0 = 0; // valore U0 = PUser[U0] ossia PUser[0]
// U1 = 1;
// U2 = 2;
// U3 = 3;
// ... U99 = 99;
// I0,I1,I2,I3,Q0,Q1,Q2,Q3,U0,U1,U2,U3
// I nomi possono essere qualsiasi, sono case-insensitive
var
globalDialog: TFileDialog;
type
TDLLParams = array[0..100] of extended; //Type of ProfiLab DLL parameters
PDLLParams = ^TDLLParams; // Pointer to ProfiLab DLL parameters
TStringParams = array[0..100] of PChar; //Type of ProfiLab DLL parameters
PStringParams = ^TStringParams; // Pointer to ProfiLab DLL parameters
function ApriSaveDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TSaveDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function ApriOpenDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TOpenDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function NumInputs: byte;
begin
Result := Inputs; // trasferire quantita entrata
end;
function NumOutputs: byte;
begin
Result := Outputs; // trasferire quantita uscita
end;
function InputName(Channel: byte): ShortString; // trasferire nome di entrata
begin
case Channel of
I0: Result := 'I0'; // nome di pin I0
I1: Result := 'I1'; // nome di pin I1
Leggi: Result := '$Leggi';
end;
end;
function OutputName(Channel: byte): ShortString; // trasferire nome di uscita
begin
case Channel of
Stampa: Result := '$Stampa'; // nome di pin Q0
//Q1: Result := 'Q1'; // nome di pin Q1
end;
end;
procedure SimStart(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo al primo avvio
begin
end;
procedure SalvaArrayInFile(FileName: string;
PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
begin
sl := TStringList.Create;
try
for i := 2 to 3 do
// for i := low(PAParams^) to high(PAParams^) do
if PAParams^[i] = 0 then
sl.Add(FloatToStr(PAParams^[i]));
sl.SaveToFile(FileName);
finally
sl.Free;
end;
end;
procedure log(msg: string);
begin
AssignFile(Output, 'Debug.txt');
if (FileExists('Debug.txt')) then
begin
Append(Output);
end
else
begin
Rewrite(Output);
end;
WriteLn(Output, msg);
Flush(Output);
CloseFile(Output);
end;
procedure CaricaArrayDaFile(FileName: string;
PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
if not (i in [0..sl.Count - 1]) then
break;
s := sl[i];
// s := sl.Values[IntToStr(i)];
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
e := StrToFloat(s);
PAParams^[i] := e;
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
procedure CalculateEx(PInput,POutput, PUser: PDLLParams; PStrings : PStringParams);
// Routine è permanente
var
sl: TStringList;
s: string;
begin
if PInput^[I0] > 2.5 then
begin
if (PInput^[I0] > 2.5) and not (PUser^[U0] > 2.5) then
begin
s := ApriOpenDialog;
log('Nome del file selezionato : ' + s);
if s <> '' then
begin
if assigned(POutput) then
log('POutput ok')
else
raise Exception.Create('Non ci siamo');
CaricaArrayDaFile(s,PStrings);
end;
end;
end;
PUser^[U0] := PInput^[I0];
if PInput^[I1] > 2.5 then
begin
if (PInput^[I1] > 2.5) and not (PUser^[I1] > 2.5) then
begin
s := ApriSaveDialog;
if s <> '' then
SalvaArrayInFile(s,PStrings);
end;
end;
PUser^[I1] := PInput^[I1];
end;
procedure SimStop(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo in fase di chiusura
begin
end;
//export methods for ProfiLab
exports
SimStart,
SimStop,
NumInputs,
NumOutputs,
CalculateEx,
InputName,
OutputName,
ApriOpenDialog,
ApriSaveDialog;
begin
end.
sl.Add(FloatToStr(PAParams^[i]));sl.Add( '<' + FloatToStr(PAParams^[i]) + ';' + FloatToStr("un altro numero") + '>' ); sl.Add( '<' + FloatToStr(PAParams^[i]) + ';' + FloatToStr(3434) + '>' );
procedure CaricaArrayDaFile(FileName: string;
PAParams: PDLLParams);
var
i: integer;
sl: TStringList;
// e: extended;
s: string;
sep: string;
p,idx: integer;
nr: array[1..3] of extended;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
if not (i in [0..sl.Count - 1]) then
break;
s := sl[i];
// s := sl.Values[IntToStr(i)];
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
sep := '';
p := pos('/', s);
if p > 0 then
sep := '/';
if p = 0 then begin
p := pos(';', s);
if p > 0 then
sep := ';';
end;
if sep = '' then
raise exception.create('impossibile determinare il tipo di tracciato record');
for idx := 1 to 3 do
nr[idx] := 0;
idx := 0;
repeat
inc(idx);
nr[idx] := StrToFloat(copy(s, 1, p-1));
s := copy(s, p+1, length(s));
p := pos(sep, s);
until (s = '') or (p = 0);
// e := StrToFloat(s); -> il primo numero è in nr[1]
// PAParams^[i] := e;
PAParams^[i] := nr[1];
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams; PStringParams:PStringParams);
var
i: integer;
sl: TStringList;
e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
//for i := 0 to 1 do
for i := low(PAParams^) to high(PAParams^) do
begin
if not (i in [0..sl.Count - 1]) then
break;
s := sl[i];
// s := sl.Values[IntToStr(i)];
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
e := strtofloat(s);
PAParams^[i] := e;
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
TStringParams = array[0..100] of PChar; //Type of ProfiLab DLL parameters
PStringParams = ^TStringParams; // Pointer to ProfiLab DLL parameters procedure CaricaArrayDaFile(FileName: string;
PAParams: PDLLParams; PStringParams: PStringParams);
var
i: integer;
sl: TStringList;
// e: extended;
s: string;
sep: string;
p,idx: integer;
nr: array[1..3] of extended;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := low(PAParams^) to high(PAParams^) do
begin
if not (i in [0..sl.Count - 1]) then
break;
s := sl[i];
//s := sl.Values[IntToStr(i)];
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
sep := '';
p := pos('/', s);
if p > 0 then
sep := '/';
if p = 0 then begin
p := pos(';', s);
if p > 0 then
sep := ';';
end;
if sep = '' then
raise exception.create('impossibile determinare il tipo di tracciato record');
for idx := 1 to 3 do
nr[idx] := 0;
idx := 0;
repeat
inc(idx);
nr[idx] := StrToFloat(copy(s, 1, p-1));
s := copy(s, p+1, length(s));
p := pos(sep, s);
until (s = '') or (p = 0);
// e := StrToFloat(s); -> il primo numero è in nr[1]
// PAParams^[i] := e;
PStringParams^[i] := nr[1];
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams; PStringParams:PStringParams);
var
i: integer;
sl: TStringList;
// e: extended;
s: string;
begin
sl := TStringList.Create; // istanzio l'oggetto
try
try
sl.LoadFromFile(FileName); // carico il file
for i := 0 to 0 do // cerco il file da caricare
//for i := low(PAParams^) to high(PAParams^) do
begin
if not (i in [0..sl.Count - 1]) then
break;
s := sl[i];
//s := sl.Values[IntToStr(i)];
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then // se cè qualcosa allora
begin
// e := strtofloat(s); // converto s da stinga float e l'assegno a extended
sl.Add(PStringParams^[i]);
//PAParams^[i] := e;
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
var
globalDialog: TFileDialog;
i: integer;
stringhe: array [0..100] of string;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams; PStringParams:PStringParams);
var
//i: integer;
sl: TStringList;
//e: extended;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := 0 to 1 do
//for i := low(PStringParams^) to high(PStringParams^) do
begin
if not (i in [0..sl.Count - 1]) then
break;
s := sl[i];
//s[LastDelimiter(';',s)]:=',';
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
stringhe[i]:=s;
PStringParams^[i] := PChar(stringhe[i]);
log(' ' + IntToStr(i) + ' caricato');
end
else
begin
log(' ' + IntToStr(i) + ' non caricato');
end;
end;
except
on e: Exception do
begin
log('porca miseria! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
library project1;
{$mode objfpc}{$H+}
uses
Interfaces,
Classes,
SysUtils,
Windows,
FileUtil,
Forms,
Controls,
Graphics,
Dialogs,
ShellApi;
const
Inputs = 3; // quantita entrata
Outputs = 1; // quantita uscita
{INPUTS}// nome per numero di entrata
I0 = 0; // valore I0 = PInput[I0] ossia PInput[0]
I1 = 1; // valore I1 = PInput[I1] ossia PInput[1]
Leggi = 2;
// I3 = 3;
// ... I99 = 99;
{OUTPUTS}// nome per numero di uscita
Stampa = 0; // valore Q0 = POutput[Q0] ossia POutput[0]
//Q1 = 1; // valore Q1 = POutput[Q1] ossia POutput[1]
// Q3 = 3;
// ... Q99 = 99;
{USER}// nome per numero di variabile, I valori vengono memorizzati
U0 = 0; // valore U0 = PUser[U0] ossia PUser[0]
// U1 = 1;
// U2 = 2;
// U3 = 3;
// ... U99 = 99;
// I0,I1,I2,I3,Q0,Q1,Q2,Q3,U0,U1,U2,U3
// I nomi possono essere qualsiasi, sono case-insensitive
var
globalDialog: TFileDialog;
i: integer;
stringhe: array [0..100] of ShortString;
type
TDLLParams = array[0..100] of extended; //Type of ProfiLab DLL parameters
PDLLParams = ^TDLLParams; // Pointer to ProfiLab DLL parameters
TStringParams = array[0..100] of PChar; //Type of ProfiLab DLL parameters
PStringParams = ^TStringParams; // Pointer to ProfiLab DLL parameters
function ApriSaveDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TSaveDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function ApriOpenDialog: ShortString;
begin
Result := '';
if not assigned(globalDialog) then
begin
globalDialog := TOpenDialog.Create(nil);
try
globalDialog.DefaultExt := 'txt';
globalDialog.Filter := '*.txt';
if globalDialog.Execute then
Result := globalDialog.FileName
else
Result := '';
finally
FreeAndNil(globalDialog);
end;
end;
end;
function NumInputs: byte;
begin
Result := Inputs; // trasferire quantita entrata
end;
function NumOutputs: byte;
begin
Result := Outputs; // trasferire quantita uscita
end;
function InputName(Channel: byte): ShortString; // trasferire nome di entrata
begin
case Channel of
I0: Result := 'I0'; // nome di pin I0
I1: Result := 'I1'; // nome di pin I1
Leggi: Result := '$Leggi';
end;
end;
function OutputName(Channel: byte): ShortString; // trasferire nome di uscita
begin
case Channel of
Stampa: Result := '$Stampa'; // nome di pin Q0
//Q1: Result := 'Q1'; // nome di pin Q1
end;
end;
procedure SimStart(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo al primo avvio
begin
end;
procedure SalvaArrayInFile(FileName: string; PAParams: PDLLParams;PStringParams:PStringParams);
var
i: integer;
sl: TStringList;
begin
sl := TStringList.Create;
try
for i := 2 to 3 do
if PAParams^[i] <> 0 then
sl.Add(PStringParams^[i]);
sl.SaveToFile(FileName);
finally
sl.Free;
end;
end;
procedure log(msg: string);
begin
AssignFile(Output, 'Debug.txt');
if (FileExists('Debug.txt')) then
begin
Append(Output);
end
else
begin
Rewrite(Output);
end;
WriteLn(Output, msg);
Flush(Output);
CloseFile(Output);
end;
procedure CaricaArrayDaFile(FileName: string; PAParams: PDLLParams; PStringParams:PStringParams);
var
sl: TStringList;
s: string;
begin
sl := TStringList.Create;
try
try
sl.LoadFromFile(FileName);
for i := 0 to 1 do
begin
if not (i in [0..sl.Count - 1]) then
break;
s:= sl[i];
stringhe[i]:=s;
log(IntToStr(i) + ': valore = <' + s + '>');
if s <> '' then
begin
PStringParams^[i] := @stringhe[i];
log(' ' + IntToStr(i) + ' loaded');
end
else
begin
log(' ' + IntToStr(i) + ' not loaded');
end;
end;
except
on e: Exception do
begin
log('Attention! "' + e.message + '"');
raise e;
end;
end;
finally
sl.Free;
end;
end;
procedure CalculateEx(PInput, POutput, PUser: PDLLParams; PStringParams:PStringParams);
// Routine è permanente
var
sl: TStringList;
s: string;
begin
if PInput^[I0] > 2.5 then
begin
if (PInput^[I0] > 2.5) and not (PUser^[U0] > 2.5) then
begin
s := ApriOpenDialog;
log('Nome del file selezionato : ' + s);
if s <> '' then
begin
if assigned(POutput) then
log('POutput ok')
else
raise Exception.Create('Non ci siamo');
CaricaArrayDaFile(s, POutput,PStringParams);
end;
end;
end;
PUser^[U0] := PInput^[I0];
if PInput^[I1] > 2.5 then
begin
if (PInput^[I1] > 2.5) and not (PUser^[I1] > 2.5) then
begin
s := ApriSaveDialog;
if s <> '' then
SalvaArrayInFile(s, PInput,PStringParams);
end;
end;
PUser^[I1] := PInput^[I1];
end;
procedure SimStop(PInput, POutput, PUser: PDLLParams);
// Routine viene eseguita solo in fase di chiusura
begin
end;
//export methods for ProfiLab
exports
SimStart,
SimStop,
NumInputs,
NumOutputs,
CalculateEx,
InputName,
OutputName,
ApriOpenDialog,
ApriSaveDialog;
begin
end.