* * * *

Privacy Policy

Blog italiano

Clicca qui se vuoi andare al blog italiano su Lazarus e il pascal.

Forum ufficiale

Se non siete riusciti a reperire l'informazione che cercavate nei nostri articoli o sul nostro forum vi consiglio di visitare il
Forum ufficiale di Lazarus in lingua inglese.

Lazarus 1.0

Trascinare un file nel programma
DB concetti fondamentali e ZeosLib
Recuperare codice HTML da pagina web
Mandare mail con Lazarus
Stabilire il sistema operativo
Esempio lista in pascal
File INI
Codice di attivazione
Realizzare programmi multilingua
Lavorare con le directory
Utilizzare Unità esterne
TTreeView
TTreeview e Menu
Generare controlli RUN-TIME
LazReport, PDF ed immagini
Intercettare tasti premuti
Ampliare Lazarus
Lazarus e la crittografia
System Tray con Lazarus
UIB: Unified Interbase
Il file: questo sconosciuto
Conferma di chiusura di un applicazione
Liste e puntatori
Overload di funzioni
Funzioni a parametri variabili
Proprietà
Conversione numerica
TImage su Form e Panel
Indy gestiore server FTP lato Client
PopUpMenu sotto Pulsante (TSpeedButton)
Direttiva $macro
Toolbar
Evidenziare voci TreeView
Visualizzare un file Html esterno
StatusBar - aggirare l'errore variabile duplicata
Da DataSource a Excel
Le permutazioni
Brute force
Indy 10 - Invio email con allegati
La gestione degli errori in Lazarus
Pascal Script
Linux + Zeos + Firebird
Dataset virtuale
Overload di operatori
Lavorare con file in formato JSON con Lazarus
Zeos ... dietro le quinte (prima parte)
Disporre le finestre in un blocco unico (come Delphi)
Aspetto retrò (Cmd Line)
Lazarus 1.0
Come interfacciare periferica twain
Ubuntu - aggiornare free pascal e lazarus
fpcup: installazioni parallele di lazarus e fpc
Free Pascal e Lazarus sul Raspberry Pi
Cifratura: breve guida all'uso dell'algoritmo BlowFish con lazarus e free pascal.
Creare un server multithread
guida all'installazione di fpc trunk da subversion in linux gentoo
Indice
DB concetti fondamentali e connessioni standard
Advanced Record Syntax
DB concetti fondamentali e DBGrid
DB concetti fondamentali e TDBEdit, TDBMemo e TDBText
Advanced Record Syntax: un esempio pratico
Superclasse form base per programmi gestionali (e non)
Superclasse form base per programmi gestionali (e non) #2 - log, exception call stack, application toolbox
Superclasse form base per programmi gestionali (e non) #3 - traduzione delle form
Superclasse form base per programmi gestionali (e non) #4 - wait animation
Un dialog per la connessione al database:TfmSimpleDbConnectionDialog
Installare lazarus su mac osx sierra
immagine docker per lavorare con lazarus e free pascal
TDD o Test-Driven Development
Benvenuto! Effettua l'accesso oppure registrati.
Maggio 18, 2024, 12:32:43 am

Inserisci il nome utente, la password e la durata della sessione.

616 Visitatori, 0 Utenti

Autore Topic: DLL Profilabexpert  (Letto 21814 volte)

Simon75

  • Full Member
  • ***
  • Post: 139
  • Karma: +0/-0
Re:DLL Profilabexpert
« Risposta #45 il: Giugno 08, 2013, 03:09:01 pm »
Allora ho fatto il debug e vedo che carica correttamente, il problema è su procedure CalculateEx,

Questo è l'aiuto che mi è stato dato :

I see one basic big fault:

Note that $Inputs and $Output share the SAME(!)  PString-pointer.

- PString is filled with Input-Strings by PL before calculateEx is invoked.
- PStrings MUST be filled with output-strings BEFORE calculateEx is left - in ANY case (!!!) and not just under certain circumstances.

if no action is taken in calculateEx-> output$[index] returns input$[index] (which may be nothing as input[index] is numeric).


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;
  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.


A volte bisogna commettere errori per capire qual è la cosa giusta da fare...

Const
Errori=Esperienza

Simon75

  • Full Member
  • ***
  • Post: 139
  • Karma: +0/-0
Re:DLL Profilabexpert
« Risposta #46 il: Giugno 11, 2013, 04:01:17 pm »
Ringrazio tutti ho risolto
A volte bisogna commettere errori per capire qual è la cosa giusta da fare...

Const
Errori=Esperienza

nomorelogic

  • Global Moderator
  • Hero Member
  • *****
  • Post: 2877
  • Karma: +20/-4
Re:DLL Profilabexpert
« Risposta #47 il: Giugno 12, 2013, 03:20:54 pm »
questa è un'ottima notizia
ci dici dove stava l'inghippo? :)
Imagination is more important than knowledge (A.Einstein)

 

Recenti

How To

Utenti
  • Utenti in totale: 788
  • Latest: mastro
Stats
  • Post in totale: 18826
  • Topic in totale: 2242
  • Online Today: 631
  • Online Ever: 900
  • (Gennaio 21, 2020, 08:17:49 pm)
Utenti Online
Users: 0
Guests: 616
Total: 616

Disclaimer:

Questo blog non rappresenta una testata giornalistica poiché viene aggiornato senza alcuna periodicità. Non può pertanto considerarsi un prodotto editoriale ai sensi della legge n. 62/2001.