Autore Topic: DLL Profilabexpert (Letto 22857 volte)

Simon75 · « **il:** Maggio 03, 2013, 12:05:41 pm »

Ciao a tutti, ho bisogno ancora di un vostro aiuto su come caricare nel display il file txt.
Attualmente grazie a Nomore.. Stilgar e Legolas sono riuscito a salvare su disco senza il numero 5 modificando L'array.
Ora ho difficoltà a caricare nel display il file txt e Profilab mi genera un errore (Violazione di accesso).

Vi ringrazio

Codice: [Seleziona]




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.

nomorelogic · « **Risposta #1 il:** Maggio 05, 2013, 11:30:28 am »

immagino che la funzione incriminata sia:
CaricaArrayDaFile

se si, dov'è che ti da l'access violation?

Simon75 · « **Risposta #2 il:** Maggio 06, 2013, 10:13:35 am »

Si è CaricaArrayDaFile, ma sembra non funzioni proprio, l'errore esce quando premo Apri sulla finestra di dialogo.

nomorelogic · « **Risposta #3 il:** Maggio 06, 2013, 01:23:53 pm »

Citazione da: Simon75 - Maggio 06, 2013, 10:13:35 am

Si è CaricaArrayDaFile, ma sembra non funzioni proprio, l'errore esce quando premo Apri sulla finestra di dialogo.

ho dato un'occhiata e potrebbe non essere così
il tutto dovrebbe partire da CalculateEx, questa a sua volta richiama ApriOpenDialog e successivamente CaricaArrayDaFile
se l'errore ti compare prima dell'OpenDialog, l'errore deve essere qua:

Codice: [Seleziona]

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;

si tratta di un accesso in memoria non valido e quindi dovresti controllare:
PInput^[I0]
PUser^[U0]
ApriOpenDialog

che ci siano valori validi nei puntatori

Stilgar · « **Risposta #4 il:** Maggio 06, 2013, 05:33:49 pm »

PInput, POutput e PUser sono allocati? Quanti elementi hanno?

Apri della finestra di dialogo ... c'è un file selezionato? Ovvero il componente restituisce veramente una stringa piena?
Mettere un file di log per tracciare cosa fa la dll non sarebbe un'idea barbina.

per create il file (vado a memoria):

Codice: [Seleziona]

  assignFile(Ouput, 'dll.txt.dove finisce il log');
  rewrite (Output);

per scrivere dentro il file, a questo punto, basta usare l'ustruzione "write".

Almeno puoi avere qualche info aggiuntiva nell'analisi dei problemi.

Stilgar

Simon75 · « **Risposta #5 il:** Maggio 07, 2013, 02:46:49 pm »

L'errore mi esce da qs punto, quando premo apri

dentro il file txt ci sono solo numeri

Stilgar · « **Risposta #6 il:** Maggio 08, 2013, 09:37:08 am »

L'errore che esce?

Stilgar · « **Risposta #7 il:** Maggio 08, 2013, 09:54:34 am »

Codice: [Seleziona]


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;

Ciao, usa questo pezzo di codice per verificare cosa succede, scrivendo le cosine su file

Stilgar

Simon75 · « **Risposta #8 il:** Maggio 08, 2013, 10:02:51 pm »

Mi esce qs errore :

Violazione di accesso......

l'ho inserita dopo CaricaArrayDaFile ma non capisco cosa dovrebbe fare, o meglio come si usa

Codice: [Seleziona]


  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;

Stilgar · « **Risposta #9 il:** Maggio 08, 2013, 10:56:48 pm »

mmmm inizio ad avere qualche idea ...

Codice: [Seleziona]

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;

Simon75 · « **Risposta #10 il:** Maggio 10, 2013, 01:44:00 pm »

Allora ho provato e nel file Debug.txt mi è uscito questo:

Nome del file selezionato : C:\Documents and Settings\Simone\Desktop\dll\Prova.txt
POutput ok
porca miseria! """ is an invalid float"

Codice: [Seleziona]




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.

Stilgar · « **Risposta #11 il:** Maggio 10, 2013, 02:20:32 pm »

E l'errore cosa ti dice?
Che il valore che stai leggendo non gli piace....

Il potere dei log sui file

Simon75 · « **Risposta #12 il:** Maggio 10, 2013, 02:49:25 pm »

Si...
ma dici che è un problema di tipo di dato? oppure non accetta il file.txt?

Stilgar · « **Risposta #13 il:** Maggio 10, 2013, 02:56:49 pm »

Stai convertendo una stringa vuota...

"" is an invalid float

Quindi ... o stai leggendo "porcheria" o stai facendo delle assunzioni che il codice non rispetta.
1) Controlla il file dati.
2) Verifica che sia veramente caricato il contenuto che ti aspetti.

il ciclo di lettura delle stringhe lo modificherei in:

Codice: [Seleziona]

 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;

Simon75 · « **Risposta #14 il:** Maggio 10, 2013, 04:09:20 pm »

Ho provato modificare come mi hai indicato e l'errore non esce più ma non carica niente nel dispaly.

Forse l'array è sbagliato?

E nel Debug.txt mi esce questo:

Nome del file selezionato : C:\Documents and Settings\Simone\Desktop\dll\Prova.txt
POutput ok
0 non caricato
1 non caricato
2 non caricato
3 non caricato
4 non caricato
5 non caricato
6 non caricato
7 non caricato
8 non caricato
9 non caricato
10 non caricato
11 non caricato
12 non caricato
13 non caricato
14 non caricato
15 non caricato
16 non caricato
17 non caricato
18 non caricato
19 non caricato
20 non caricato
21 non caricato
22 non caricato
23 non caricato
24 non caricato
25 non caricato
26 non caricato
27 non caricato
28 non caricato
29 non caricato
30 non caricato
31 non caricato
32 non caricato
33 non caricato
34 non caricato
35 non caricato
36 non caricato
37 non caricato
38 non caricato
39 non caricato
40 non caricato
41 non caricato
42 non caricato
43 non caricato
44 non caricato
45 non caricato
46 non caricato
47 non caricato
48 non caricato
49 non caricato
50 non caricato
51 non caricato
52 non caricato
53 non caricato
54 non caricato
55 non caricato
56 non caricato
57 non caricato
58 non caricato
59 non caricato
60 non caricato
61 non caricato
62 non caricato
63 non caricato
64 non caricato
65 non caricato
66 non caricato
67 non caricato
68 non caricato
69 non caricato
70 non caricato
71 non caricato
72 non caricato
73 non caricato
74 non caricato
75 non caricato
76 non caricato
77 non caricato
78 non caricato
79 non caricato
80 non caricato
81 non caricato
82 non caricato
83 non caricato
84 non caricato
85 non caricato
86 non caricato
87 non caricato
88 non caricato
89 non caricato
90 non caricato
91 non caricato
92 non caricato
93 non caricato
94 non caricato
95 non caricato
96 non caricato
97 non caricato
98 non caricato
99 non caricato
100 non caricato

Prova a verificare quanto ho fatto:

Codice: [Seleziona]





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.

News:

Privacy Policy

Blog italiano

Forum ufficiale

Lazarus 1.0

Progetti Lazarus

Free Pascal

Libri

Autore Topic: DLL Profilabexpert (Letto 22857 volte)

Recenti

How To

Free Pascal DS

Lazarus WEB

Disclaimer: