Italian community of Lazarus and Free Pascal

Programmazione => Generale => Topic aperto da: alexarmato66 - Aprile 18, 2021, 03:48:50 pm

Titolo: problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Aprile 18, 2021, 03:48:50 pm
come potrei tradurre il seguente codice Visual Basic

ReDim Preserve MomentiRottura.polix(NP).X(1 To MomentiRottura.polix(NP).numv)

in Lazarus ?

grazie!
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Aprile 18, 2021, 04:21:25 pm
Sbaglierò, ma quello non è un codice nativo di VB.
Appartiene a qualche libreria o algoritmo di ingeneria e dovrebbe essere legato al calcolo su strutture 3D del dominio di rottura su una sezione.

Su questo, ritengo che un ingegnere civile del forum possa darti una mano.

In generale "REDIM" in VB è equivalente a "SetLength" in Pascal.
La scrittura "1 To MomentiRottura.polix(NP).numv" equivale alla definizione di un array. Però senza una definizione del contenuto dell'array non è possibile definire l'array stesso.

Come dato generico, la scrittura potrebbe essere equivalente a:

// ATTTENZIONE CHE IN PASCAL GLI ARRAY DINAMICI (CHE SONO GLI UNICI CHE POSSONO ESSERE RIDIMENSIONATI) INIZIANO CON INDICE 0 E NON 1.
// QUINDI L'ARRAY sotto indicato avà un indice in più, ossia lo zero.

Codice: [Seleziona]
SetLength(MomentiRottura.polix[NP].X, MomentiRottura.polix[NP].numv+1);
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: Stilgar - Aprile 19, 2021, 12:59:34 am
come potrei tradurre il seguente codice Visual Basic

ReDim Preserve MomentiRottura.polix(NP).X(1 To MomentiRottura.polix(NP).numv)

in Lazarus ?

grazie!


Ciao.
Cosa dovrebbe fare di preciso questa istruzione? Magari Drago ti ha già risposto, ma sono curioso lo stesso :)
Stilgar
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Aprile 19, 2021, 02:09:27 pm
Sto traducendo in Pascal per Lazarus un codice scritto in VB per il calcolo delle sezioni in c.a. .
Avevo usato Redim Preserve per non perdere i dati iniziali della matrice .In VB usando REDIM azzero la matrice.
Volevo sapere se in Pascal con SetLength preservavo i dati gia memorizzati nella matrice aggiungendo dei nuovi dinamicamente.
Grazie.
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Aprile 19, 2021, 02:21:33 pm
Il contenuto degli elementi esistenti vengono preservati.

Quando fai un SetLegnth, internamente il vecchio array viene copiato in una nuova posizione di memoria.

Ricordati che l'indice in Pascal parte da zero per gli array dinamici.

Saluti
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: Stilgar - Aprile 19, 2021, 03:08:24 pm
Avendo sempre messo dati nativi dentro gli array, o oggetti che dovevo passare ad altri pezzi di software, non mi sono mai posto la questione se :
Viene invocato il "finalize" degli elementi se rimpicciolisco l'array?


Se allarghi l'array non hai problemi di questo tipo. Ti prepara degli spazi "vuoti" da assegnare come preferisci.


[0..Length-1] sono gli indici validi.


In alternativa puoi usare Low(tuoArray) e High(tuoArray) per avere gli indici minori e superiori validi.


Se vuoi ancora meno sbattimenti puoi usare gli enumeratori automatici.


Dichiari una variabile del tipo che ti interessa e la usi nel ciclo for che diventa


Codice: [Seleziona]


for variabileDelTipoCheTiInteressa in ilTuoArray do
begin
end;




Spero di essere stato d'aiuto.


Stilgar


Stilgar
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Aprile 19, 2021, 03:28:09 pm
Negli array dinamici, il contenuto andrebbe distrutto prima di liberare gli indici interessati (quindi distruggerlo o rimpicciolirlo).

Questo comunque andrebbe fatto (o sarebbe meglio fare), in quanto i distruttori PASCAL e VB (ma anche C)non è detto che siano coerenti (ammesso e non concesso che gli oggetti contenuti non siano "Pascal").

Per default le nuove posizioni sono a 0 o nil.

Ciò sopra vale per il concorrente di Lazarus, ma ritengo sia allineato anche Lazarus stesso.

Ricordati anche che gli array dinamici multidimensione (come il tuo) hanno l'accesso contiguo solo per "riga". Ma ogni riga potrebbe non essere contigua all'altra (anzi sicuramente non lo è).
Esempio:

NP := 1 (Elementi contigui tra loro)
MomentiRottura.polix(NP).X[0], MomentiRottura.polix(NP).X[1],  MomentiRottura.polix(NP).X[2] .....

NP := 2 (Elementi contigui tra loro)
MomentiRottura.polix(NP).X[0], MomentiRottura.polix(NP).X[1],  MomentiRottura.polix(NP).X[2] .....

Ma tra l'array con NP:=1 e l'array con NP:=2 non c'è alcun tipo di associazione, sono in memorie non contigue. I due array potrebbero avere anche lunghezza diversa.

Questo affinchè tu faccia attenzione a lavorare con i puntatori o funzioni che scrivono blocchi di memoria.

Ciao
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: doc - Aprile 21, 2021, 10:34:35 am
@ alexarmato66

Ma ti occupi di calcolo strutturale?
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Aprile 22, 2021, 01:48:33 pm
Si
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Aprile 23, 2021, 09:10:07 am


Purtroppo SetLength(MomentiRottura.polix[np].x, MomentiRottura.polix[np].numv+1); 

mi da il seguente errore: Type mismatch.


è all'interno della seguente procedura:
Procedure calcola_MomentiRottura_A(dom : Dominio_Rottura; soll : soll_esterne; MomentiRottura : momenti_rottura;flag_convergenza : Boolean; flag_circa : Boolean; index : Integer);
.......
......
.....


Di seguito riporto le strutture che ho utilizzato per le dichiarazioni:




// Struttura dati che contiene i valore dei momenti di rottura della sezione  //
// -------------------------------------------------------------------------- //
    momenti_rottura = record
    mrx : Double;                        // Momento di rottura con asse momento x
    mry : Double;                        // Momento di rottura con asse momento y
    ang : Double;                        // Rotazione dell//asse neutro rispetto all//asse x, antioraria positiva
    polix : Array of poligono_sezione;   // Poligono che definisce la porzione di cls compressa della sezione
    sigma_so: Array of Double;               // ' Array contenente le tensioni nelle barre di armatura a rottura
    sigma_sp: Array of Double;              // ' Array contenente le tensioni nei trefoli a rottura
    def_rottura : deform_sezione;        // configutrazione deformativa a rottura
    etac_max : Double;                   // distanza tra l//asse neutro e la fibra maggiormente compressa a rottura
    etas_min : Double;                   // distanza tra l//asse neutro e la fibra maggiormente tesa a rottura
    curv_rottura : Double;               // curvatura della sezione a rottura
    End ;                                                                                   
 

/ Struttura dati in cui sono definiti i dati dei singoli poligoni che com-   //
// pongono la sezione                                                         //
// -------------------------------------------------------------------------- //
   poligono_sezione = record
   x:array[1..100] of Double ;          // coordinata x del vertice
   y:array[1..100] of Double ;          // coordinata y del vertice
   numv : Integer;                      // numero di vertici del poligono
   fck : Double;                        //' fck
   fd : Double ;                        // Resistenza massima di calcolo (per verifiche SLU)
   omog : Double ;                      // coefficiente di omogeneizzazione (per verifiche SLE)
   traz : Integer ;                     // 0=non reagente a trazione; 1=reagente a trazione
   epsc0 : Double;                      // Deformazione in corrispondenza della fine della parte parabola/lineare del dominio
   epscu : Double;                      // Deformazione ultima del dominio
   sigma:array[1..100] of Double ;
   end ;
// -------------------------------------------------------------------------- //             
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Aprile 23, 2021, 09:26:44 am
x:array[1..100] of Double ;          // coordinata x del vertice

Gli array statici non possono essere ridimensionati.

Devi ridefinire l'array X come dinamico (ma ovviamente l'indice partirà da ZERO) e rivedere il codice corrispondente.

Poi devi rivedere anche gli altri array se è il caso.

Ciao
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: Stilgar - Aprile 23, 2021, 09:33:58 pm
Gli array statici se li definisci come "puntatori", diventano magicamente super dinamici :)
Ma devi sbatterti a gestirli bene.
:)


Stilgar
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Aprile 24, 2021, 08:11:23 pm
Grazie ai vostri importanti aiuti sto imparando tante cose.GRAZIE!!!!!
Altra tra questione (Enum Type):

posso scrivere:
Type
 FaseGetto = (Foro = 0 , Trave = 1, Getto = 2);

dichiarando:
tipogetto:array of  FaseGetto ;        //1 = Trave, 2 = Getto2aFase, 0 = Foro   

?
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Aprile 24, 2021, 08:19:12 pm
//'carica geometria 1  *********************************************************
tipo1 := Form1.CB1.Text;

               case (tipo1) of

     'Trave': begin


        tipogetto[1] := Trave ;
        nv[1]:= StrToInt(Form1.EVertici1.Text);

   

        For k := 1 To nv[1] do
          begin
            X1[k]:=  StrToFloat(Form1.StringGrid1.Cells[1,k]);
            Y1[k]:=  StrToFloat(Form1.StringGrid1.Cells[2,k]);
          end;


        fck := StrToInt(Form1.CBcls1.Text);

     end;

    'Getto2aFase': begin
        tipogetto[1] := Getto;
        nv[1] := StrToInt(Form1.EVertici1.Text);
     
        For k := 1 To nv[1] do
          begin
            X1[k] :=  StrToFloat(Form1.StringGrid1.Cells[1,k]);
            Y1[k] :=  StrToFloat(Form1.StringGrid1.Cells[2,k]);
          end;

         fck := StrToInt(Form1.CBcls1.Text);

    end;

    'Foro': begin
        tipogetto[1] := Foro ;
        nv[1] := StrToInt(Form1.EVertici1.Text);
   
        For k := 1 To nv[1] do
          begin
            X1[k] :=  StrToFloat(Form1.StringGrid1.Cells[1,k]);
            Y1[k] :=  StrToFloat(Form1.StringGrid1.Cells[2,k]);
          end;

        fck := StrToInt(Form1.CBcls1.Text);

    end;

end ;
//******************************************************************************     
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Aprile 24, 2021, 11:34:07 pm
tipoogetto[1] := .......      //ricordati nel codice un SetLength(tipooggeto, 2);

Case (tipo1) of                // tipo1 è una stringa, il case non può essere usato su stringhe, deve essere usato con
                                       // tipi integrali (integer, boolean, char) o altri tipi con un limite (HIGH e LOW) finiti,
                                       // in quanto il case viene risolto in compilazione.

Ciao

Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: nomorelogic - Aprile 25, 2021, 02:39:43 am
alexarmato66, quando posti del codice usa i blocchi "code", quelli col cancelletto

grazie ;)
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Aprile 25, 2021, 08:12:46 am
qui avevo visto che sono permesse le stringhe.Mi sbaglio?
https://wiki.freepascal.org/Case#structure

The data type of selector has to be an ordinal type. FreePascal additionally allows strings.
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Aprile 25, 2021, 11:46:34 am
qui avevo visto che sono permesse le stringhe.Mi sbaglio?
https://wiki.freepascal.org/Case#structure

The data type of selector has to be an ordinal type. FreePascal additionally allows strings.

Confermo quandto dici, e non ne ero a conoscenza. Funziona solo con {$MODE ObjFPC)

Pur però potendolo fare, io sconsiglio vivamente ciò. Questo per varie motivazioni: intanto la codifca dei caratteri, la compatibilità, l'ottimizzazione, etc ...
Non sò il compilatore come si comporti visto che in termini generici questo dovrebbe essere risolto a livello di compilazione. Immagino usino l'HASH delle stringhe.

In genere usate i tipi, anche nei database. E se proprio non potete, alla lettura del database traformate la stringa letta in un "tipo" e usate questo tipo nel programma.

Non ve ne pentirete.

Saluti

Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: Stilgar - Aprile 26, 2021, 09:03:54 pm
Ciao
Solo qualche piccolo accorgimento nel codice.
Codice: [Seleziona]
type
  TNumeroValoriMassimo = 0..100; //<-- Dichiari solo una volta l'insieme, se hai bisogno di ridimensionare l'insieme, tocchi qui e ricompili.

type
  // Struttura dati che contiene i valore dei momenti di rottura della sezione  //
  // -------------------------------------------------------------------------- //
  TMomentiRottura = record
    mrx: double;                        // Momento di rottura con asse momento x
    mry: double;                        // Momento di rottura con asse momento y
    ang: double;                        // Rotazione dell//asse neutro rispetto all//asse x, antioraria positiva
    polix: array of poligono_sezione;   // Poligono che definisce la porzione di cls compressa della sezione
    sigmaSo: array of double;          // ' Array contenente le tensioni nelle barre di armatura a rottura
    sigmaPp: array of double;          // ' Array contenente le tensioni nei trefoli a rottura
    def_rottura: deform_sezione;        // configutrazione deformativa a rottura
    etacMax: double;                   // distanza tra l//asse neutro e la fibra maggiormente compressa a rottura
    etasMin: double;                   // distanza tra l//asse neutro e la fibra maggiormente tesa a rottura
    curvRottura: double;               // curvatura della sezione a rottura
  end;
  // Struttura dati in cui sono definiti i dati dei singoli poligoni che com-   //
  // pongono la sezione                                                         //
  // -------------------------------------------------------------------------- //
  TPoligonoSezione = record
    x: array[TNumeroValoriMassimo] of double;          // coordinata x del vertice
    y: array[TNumeroValoriMassimo] of double;          // coordinata y del vertice
    numv: integer;                      // numero di vertici del poligono
    fck: double;                        //' fck
    fd: double;                        // Resistenza massima di calcolo (per verifiche SLU)
    omog: double;                      // coefficiente di omogeneizzazione (per verifiche SLE)
    traz: boolean;                     // 0=non reagente a trazione; 1=reagente a trazione
    epsc0: double;                      // Deformazione in corrispondenza della fine della parte parabola/lineare del dominio
    epscu: double;                      // Deformazione ultima del dominio
    sigma: array[TNumeroValoriMassimo] of double;
  end;
 

Personalmente eviterei di utilizzare le stringhe nel case. Utilizzerei degli indici.
Utilizzando una combo box puoi ottenere l'indice dell'opzione selezionata attraverso
Codice: [Seleziona]
index
.  Restituisce -1 Se non è selezionato nulla.

Codice: [Seleziona]

procedure TForm1.calcoloGeometria1;
var
  tipo1: integer;
begin
  // -------------------------------------------------------------------------- //
  //'carica geometria 1  *********************************************************
  tipo1 := Form1.CB1.Index;// <-- Il cb mi fa supporre sia una combo box
  case (tipo1) of
    indiceTrave:
    begin
      tipogetto[1] := Trave;
      nv[1] := StrToInt(Form1.EVertici1.Text);
      for k := 1 to nv[1] do
      begin
        X1[k] := StrToFloat(Form1.StringGrid1.Cells[1, k]);
        Y1[k] := StrToFloat(Form1.StringGrid1.Cells[2, k]);
      end;
      fck := StrToInt(Form1.CBcls1.Text);
    end;
    indiceGetto2aFase:
    begin
      tipogetto[1] := Getto;
      nv[1] := StrToInt(Form1.EVertici1.Text);
      for k := 1 to nv[1] do
      begin
        X1[k] := StrToFloat(Form1.StringGrid1.Cells[1, k]);
        Y1[k] := StrToFloat(Form1.StringGrid1.Cells[2, k]);
      end;


      fck := StrToInt(Form1.CBcls1.Text);


    end;


    indiceForo:
    begin
      tipogetto[1] := Foro;
      nv[1] := StrToInt(Form1.EVertici1.Text);


      for k := 1 to nv[1] do
      begin
        X1[k] := StrToFloat(Form1.StringGrid1.Cells[1, k]);
        Y1[k] := StrToFloat(Form1.StringGrid1.Cells[2, k]);
      end;
      fck := StrToInt(Form1.CBcls1.Text);
    end;


  end;


end;
//******************************************************************************
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: doc - Aprile 27, 2021, 10:07:58 am
@alexarmato66

Ciao, ma quindi esaminando la riga
Codice: [Seleziona]
type
  TNumeroValoriMassimo = 0..100; //<-- Dichiari solo una volta l'insieme, se hai bisogno di ridimensionare l'insieme, tocchi qui e ricompili
il tuo programma è limitato a 101 campi..... :(
Non ti conviene usare oggetti/elementi dinamici (io, personalmente, uso solo array dinamici per le matrici usate nei calcoli) in modo da non avere questa limitazione? Anche perchè leggo "...se hai bisogno di ridimensionare l'insieme, tocchi qui e ricompili." il che ti costringe a nuove compilazioni ogni volta che devi ridimensionare questo insieme.
Era solo un suggerimento, per il resto ottimo lavoro.
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: Stilgar - Aprile 30, 2021, 10:18:49 am
hihihihiNovel aveva un'array per il numero degli utenti gestiti dal server di rete :)
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 06, 2021, 01:50:59 pm
Grazie a tutti.Sto cercando di utilizzare solo array dinamiche.Avevo però
un dubbio sulla traduzione da VB del seguente frammento( avete un suggerimento?):

ReDim dominio_slu.mrx(1 To NMaxDom)   
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 06, 2021, 10:37:18 pm
In modo simile a quanto già suggerito:

Codice: [Seleziona]
Type 
  TDominio_slu = record
      mrx: array of ???????????       <---- definire il tipo
  end;

//Nel codice
var dominio_slu: TDominio_slu;

SetLength(dominio_slu.mrx, NMaxDom+1);     //L'array parte de 0 non da 1
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 07, 2021, 02:33:10 pm
grazie.
E' possibile in Lazarus fare un wrapper?:

Function Punto_Interno_poligonoB(xP : Double; yP : Double; X:array of Double; Y:array of Double; nv : Integer) : Byte  ;
begin
    Inside (X, Y, nv, xP, yP, Punto_Interno_poligonoB );
End ;   
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 07, 2021, 09:28:51 pm
Per wrapper si intende una "transcodifca" normalmente con metodi che consenta di chiamare funzioni o altro costruiti con altri linguaggi.

Un esempio di wrapper sono le Api di Windows, codificate in Pascal.

grazie.
E' possibile in Lazarus fare un wrapper?:

Function Punto_Interno_poligonoB(xP : Double; yP : Double; X:array of Double; Y:array of Double; nv : Integer) : Byte  ;
begin
    Inside (X, Y, nv, xP, yP, Punto_Interno_poligonoB );
End ;   

Non ho compreso cosa richiedi.
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 09, 2021, 02:50:38 pm
esiste  STEP in Lazarus?:
esempio
    For Y = yn + dX / 2# To ymaxpe Step dX   
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 09, 2021, 03:13:50 pm
esiste  STEP in Lazarus?:
esempio
    For Y = yn + dX / 2# To ymaxpe Step dX   

No, non esiste. L'incremento della variabile di controllo è sempre di 1.
Si può ovviare con la funzione while o la funzione repeat.

Codice: [Seleziona]
Y := yn + dx /2;
while (Y <= ymaxpe) do
  begin
     //Inserisci qui il tuo codice

     //alla fine incrementa la variabile di controllo
     Y := Y + dx;
  end;
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: Stilgar - Maggio 10, 2021, 02:06:13 am
Alex.
Cosa intendi di preciso per wrapper? Io ho un'idea, magari non vorrei capire male quello che chiedi.


In Freepascal hai la possibilità di mettere dei metodi nei record.
Devi attivare i record "cazzuti" con alcune direttive del compilatore.


Forse non ti serve un wrapper.
Codice: [Seleziona]

{$ModeSwitch advancedrecords}
{$ModeSwitch typehelpers}     
type
  TPunto = record
  x, Y : Double;
  end;


  TPoligono = record
     punti : array of TPunto;
     class operator Initialize(var aRec: TPoligono );  //<- "costruttore" del record
     class operator Finalize(var aRec: TPoligono );   //<- "distruttore" del record
     procedure aggiungiPunto(const punto : TPunto);
     function isPuntoIncluso(const pt : TPunto) : boolean;
  end;
 
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 10, 2021, 02:07:28 pm
ByRef lo traduco con VAR ma ByVal?:


Public Sub Calcolo_precompressione(ByVal N_ As Double, ByVal Mx_ As Double, ByVal My_ As Double, _
                                    nd As Double, Mx As Double, My As Double)
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: Stilgar - Maggio 10, 2021, 03:17:15 pm

Se fa la copia dei valori nello stack così.
Codice: [Seleziona]
procedure Calcolo_precompressione(N_ As :Double; Mx_ As:Double; My_ : Double, _nd : Double; Mx : Double, My : Double);



se passa un "riferimento" senza copiare nello stack i valori, ma depositando i puntatori alle variabili:


Codice: [Seleziona]
procedure Calcolo_precompressione(var N_ As :Double; var Mx_ As:Double; var My_ : Double; var _nd : Double; Mx : Double, My : Double);






Stilgar

Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: nomorelogic - Maggio 10, 2021, 04:43:17 pm
ByVal, a senso, dovrebbe copiare i valori
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: Stilgar - Maggio 10, 2021, 05:15:42 pm
Si.
Ma ho dato una regola generale e non una risposa specifica, limitata alla domanda.  ;)
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 23, 2021, 01:38:22 pm
Ho proato a scrivere il seguente codice.Faccio una copia di una struttura dati polic[np] := poli[np] ( coordinate x,y .....numero di ertici numv..) in un'altra struttura per poi ruotarla di un angolo alfa calcolando le nuoe coordinate:

   c := Cos(alfa) ;
    s := Sin(alfa) ;

    For np := 1 To N_POLI do

    begin

      polic[np] := poli[np] ;

        For k :=1 To polic[np].numv do
          begin

            polic[np].x[k] := poli[np].x[k] * c + poli[np].y[k] * s  ;
            polic[np].y[k] := -poli[np].x[k] * s + poli[np].y[k] * c ;
          end;
    end;


NOn capisco perchè ad ogni ciclo for (k :=1 To polic[np].numv )
il valore -poli[np].x[k] * s della seconda equazione sostituisce il valore appena calcolato polic[np].x[k] .
Come potrei riscrierla..o forse ho sbagliato da qualche parte nella dichiarazione delle ariabili?
Grazie.
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 23, 2021, 03:17:12 pm
Ho proato a scrivere il seguente codice.Faccio una copia di una struttura dati polic[np] := poli[np] ( coordinate x,y .....numero di ertici numv..) in un'altra struttura per poi ruotarla di un angolo alfa calcolando le nuoe coordinate:

   c := Cos(alfa) ;
    s := Sin(alfa) ;

    For np := 1 To N_POLI do

    begin

      polic[np] := poli[np] ;

        For k :=1 To polic[np].numv do
          begin

            polic[np].x[k] := poli[np].x[k] * c + poli[np].y[k] * s  ;
            polic[np].y[k] := -poli[np].x[k] * s + poli[np].y[k] * c ;
          end;
    end;


NOn capisco perchè ad ogni ciclo for (k :=1 To polic[np].numv )
il valore -poli[np].x[k] * s della seconda equazione sostituisce il valore appena calcolato polic[np].x[k] .
Come potrei riscrierla..o forse ho sbagliato da qualche parte nella dichiarazione delle ariabili?
Grazie.


Perchè a seconda della definizione delle strutture di dati, l'assegnazione "polic[np] := poli[np] " ha effetti differenti:

1) struttura statica, senza array dinamici => l'assegnazione viene effettuata per valore (ossia viene effettuata una copia dei valori, ma le locazioni delle due strutture sono distinte);
2) struttura con array dinamici => l'assegnazionie viene effettuata per riferimento, ossia le due strutture condividono lo stesso indirizzo di memoria dei dati.

(*Una operazione da effettuare, invece della assegnazione, se si vuole avere una copia dei valori è il "move":

move(poli[np] , polic[np], ______);

Al posto di ______ devi inserire la lunghzza in byte della tua struttura ... NON PUOI usare il sizeof  ...... effettivamente per calcolare le "lunghezza in byte" di una struttura dinamica in questo momento non mi sovviene nulla
  :-\ .....
*)

**** EDIT: ho detto una castronata, effettivamente non si può fare una copia con il move di una struttura dinamica .... le memorie non sono contigue .....

Intanto potresti ciclare con un for copiando i valori di X e Y tra le due strutture .... non è elegante nè pratico ma per adesso ottieni lo scopo.....

Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 23, 2021, 06:39:37 pm
ho proato ma non ci sono riuscito:
   For np := 1 To N_POLI do

    begin

// polic[np] := poli[np] ;
  polic[np].numv := poli[np].numv ;

 // copia coord di  poli in polic  ********

   for k:=1 to  polic[np].numv  do
         begin
             polic[np].x[k]:= poli[np].x[k] ; // si pianta qui forse scrive sullo stesso indirizzo di memoria.
             polic[np].y[k]:= poli[np].y[k] ;
        end;

//*****************************************

        For k :=1 To polic[np].numv do
          begin
            polic[np].x[k] := poli[np].x[k] * c + poli[np].y[k] * s  ;
            polic[np].y[k] := -poli[np].x[k] * s + poli[np].y[k] * c ;
          end;
    end;   
                                                 
Forse devo creare due strutture distinte?
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 23, 2021, 06:58:33 pm
Dovrebbe funzionare, verifica che l'estensione degli array x e Y siano [0..numv] o [1..numv], altrimenti si dovrebbe usare:

Codice: [Seleziona]
 for k:=1 to  polic[np].numv - 1  do


L'importante è che le variabili "polic" e "poli" non siano mai state assegnate direttamente se non tramite assegnazione tra i singoli membri.

***EDIT: effettua lo stesso controllo anche per "For np := 1 To N_POLI do"

N.B.: ricordati nei post di inserire il codice marcandolo con il tasto # (inserisce il tag code).
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 24, 2021, 02:05:47 pm
Ho provato così ma no riesco a copiare le coordinate dalla struttura poli a polic:
Codice: [Seleziona]
# setlength(polic,N_POLI+1);

 # c := Cos(alfa) ;
  #  s := Sin(alfa) ;

 #   For np := 1 To N_POLI do

#    begin


# polic[np].numv := poli[np].numv;


 #       For k := 1 To polic[np].numv do
   #       begin
    #        polic[np].x[k] := poli[np].x[k] * c + poli[np].y[k] * s  ; //SI PIANTA QUI
    #        polic[np].y[k] := -poli[np].x[k] * s + poli[np].y[k] * c ;
   #       end;
  #   end;



le strutture sono :
Codice: [Seleziona]
#// -------------------------------------------------------------------------- //
 #  poligono_sezione = record
#   x:array of Double ;          // coordinata x del vertice
#   y:array of Double ;          // coordinata y del vertice
#   numv : Integer;                      // numero di vertici del poligono
 #  fck : Double;                        //' fck
 #  fd : Double ;                       
#   omog : Double ;                     
#   traz : Integer ;                     
#   epsc0 : Double;           
#   epscu : Double;                      // Deformazione ultima del dominio
#   sigma:array of Double ;
#   end ;


#// -------------------------------------------------------------------------- //
#  poligono_sezione_c = record
#  x:array of Double ;          // coordinata x del vertice
#  y:array of Double ;          // coordinata y del vertice
#  numv : Integer;                      // numero di vertici del poligono
#  fck : Double;                        //' fck
#  fd : Double ;                        #  omog : Double ;                     
#  traz : Integer ;                     
#  epsc0 : Double;                     
#  epscu : Double;                      // Deformazione ultima del dominio
#  sigma:array of Double ;
#  end ;
#// -------------------------------------------------------------------------- //                       

 




Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 24, 2021, 02:07:52 pm
 :) SCUSATE PER GLI ASTERISCHI...NON LO FARO' PIU. :-[
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 24, 2021, 02:45:37 pm
:) SCUSATE PER GLI ASTERISCHI...NON LO FARO' PIU. :-[

 ;D ;D ;D ;D
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 24, 2021, 03:07:59 pm
Ho provato così ma no riesco a copiare le coordinate dalla struttura poli a polic:
Codice: [Seleziona]
# setlength(polic,N_POLI+1);

 # c := Cos(alfa) ;
  #  s := Sin(alfa) ;

 #   For np := 1 To N_POLI do

#    begin


# polic[np].numv := poli[np].numv;


 #       For k := 1 To polic[np].numv do
   #       begin
    #        polic[np].x[k] := poli[np].x[k] * c + poli[np].y[k] * s  ; //SI PIANTA QUI
    #        polic[np].y[k] := -poli[np].x[k] * s + poli[np].y[k] * c ;
   #       end;
  #   end;



le strutture sono :
Codice: [Seleziona]
#// -------------------------------------------------------------------------- //
 #  poligono_sezione = record
#   x:array of Double ;          // coordinata x del vertice
#   y:array of Double ;          // coordinata y del vertice
#   numv : Integer;                      // numero di vertici del poligono
 #  fck : Double;                        //' fck
 #  fd : Double ;                       
#   omog : Double ;                     
#   traz : Integer ;                     
#   epsc0 : Double;           
#   epscu : Double;                      // Deformazione ultima del dominio
#   sigma:array of Double ;
#   end ;


#// -------------------------------------------------------------------------- //
#  poligono_sezione_c = record
#  x:array of Double ;          // coordinata x del vertice
#  y:array of Double ;          // coordinata y del vertice
#  numv : Integer;                      // numero di vertici del poligono
#  fck : Double;                        //' fck
#  fd : Double ;                        #  omog : Double ;                     
#  traz : Integer ;                     
#  epsc0 : Double;                     
#  epscu : Double;                      // Deformazione ultima del dominio
#  sigma:array of Double ;
#  end ;
#// -------------------------------------------------------------------------- //                       

 

Non serve definire due record distinti, sono identici quindi basta definirne uno solo. La dichiarazione delle variabili può avvenire tranquillamente con lo stesso record.
N.B.: per ragioni di leggibilibiltà, conviene che i nuovi tipi (come i record da te definiti) abbiano il prefisso T iniziale, ad esempio TPoligono_Sezione, ma è solo uno stile di scrittura.
Codice: [Seleziona]
var
  polic, poli: poligono_sezione;

//da qualche parte devi effettuare il setlength dei singoli array:
setlength(polic,N_POLI+1); //questo lo fai già
//setlength(poli,N_POLI+1);   // <= già fatto ???           

//Questo blocco lo puoi eseguire ogni qualvolta ti serve ridimensionare gli array
For np := 0 To N_POLI do   // <= qui sarebbe meglio: For np:= low(polic) to high(polic) do
  begin
     //numv !!!!!!!!!!!! deve essere dichiarato e settato ovviamente PRIMA DI usarlo qui
     setlength(polic[np].X, numv+1);  //SERVE AD ALLOCARE LO SPAZIO PER GLI ARRAY DINAMICI  ..... DEVE ESSERE FATTO PRIMA DI USARLI
     setlength(polic[np].Y, numv+1);
     setlength(polic[np].Sigma, numv+1);   //Ci ho messo anche sigma !!! non sò se la lunghezza è sempre quella
     //setlength(poli[np].X, numv+1);                // <= già fatto ???           
     //setlength(poli[np].Y, numv+1);                 // <= già fatto ???           
     //setlength(poli[np].Sigma, numv+1);        // <= già fatto ???           
  end;

da qualche altra parte:

//Calcolo

For np := 1 To N_POLI do
  begin
      polic[np].numv := poli[np].numv;        // ATTENZIONE CHE poli[np].numv deve essere già impostato e poli[] e polic[] già con un setlength effettuato con gli array X e Y anche quelli con un setlength come da blocco sopra
      For k := 1 To polic[np].numv do
         begin
            polic[np].x[k] := poli[np].x[k] * c + poli[np].y[k] * s  ; //SI PIANTA QUI
            polic[np].y[k] := -poli[np].x[k] * s + poli[np].y[k] * c ;
         end;
  end;
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 24, 2021, 03:22:40 pm
I record in pascal, in realtà è una "ficture" introdotta da FPC e Delphi e non fà parte del Pascal standard, possono avere anche dei metodi usati normalmente per la "manutenzione" dei singoli membri .... ad esempio potresti avere un metodo che esegue il "setlength" di tutti i membri necessari senza dover chaimare a codice esplicito il "for" indicato nel post precedente:

...... (segue esempio) ......

Codice: [Seleziona]
type
  TProva = record
        X: array of integer;
        procedure NuovaLunghezza(Value: cardinal);
    end;

var
  Prova: TProva;

procedure TProva.NuovaLunghezza(Value: cardinal);
begin
  SetLength(X, Value);
end;

begin
  //Come usarla nel codice
  Prova.NuovaLunghezza(10);
end;
         
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 24, 2021, 03:30:33 pm
Grazie Drago Rosso!!!!Problema risolto.!!!!
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 24, 2021, 03:43:06 pm
 :D Sono felice che la community ti sia stata di aiuto.
Buon lavoro.

Ciao ciao
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 25, 2021, 12:08:19 pm
L'array sopra citato (polic) quando lo passerò ad una funzione tipo:
Codice: [Seleziona]
Function risult_compr(var polic:array of poligono_sezione; armco : armo_sezione;armcp:armp_sezione ; deform : deform_sezione; ymax : Double; yamin : Double; yn : Double) : risultante_n;
come lo dovrei passare. Poi all'interno della funzione devo sempre ridimensionare i vari array passati o dipende
da come li passo( var o valore)
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 25, 2021, 12:23:30 pm
Viene automaticamente passato come riferimento. Quindi ciò che fai nella tua funzione è come se lavorasse nel "polic" originale, questo indipendentemente dalla "var".

Ciò che la "var" fà (in questo caso specifico) è dire al compilatore che se assegni un valore nella tua funzione (quindi cerchi di alterare il valore originale) non deve generare allert o error (ma questo solo in compilazione !!!).

Ciao
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 25, 2021, 01:10:56 pm
Quindi all'interno della funzione a cui passo l'array dinamico polic non serve che lo ridimensioni nuovamente  con setlength o devo farlo sempre?
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 25, 2021, 02:25:55 pm
L'array dovrebbe venire ridimensionato in base all'uso che se ne fa.

Normalmente passare un array (o un suo sottoinsieme) a una funzione serve ad usare l'array (cioè riempirlo di dati, elaborali o leggerli), il ridimensianamento viene fatto solo se necessita.

Ciò che passi alla funzione è l'array stesso (o una struttura, una classe, etc ...) con le sue dimensioni originali. Il setlength non serve all'interno della funzione.

Ciao

P.S.: quando si passa qualcosa come riferimento lo si passa nella sua interezza, perchè si passa il riferimento. Ovviamente per interezza intendo il riferimento che si passa: se passo il riferimento di un membro di una classe mi ritrovo il membro nella funzione, non la classe.
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 28, 2021, 05:22:05 pm
In genere non si dovrebbe aprire, a meno che tu non abbia settato qualche breakpoint in giro per il codice. Nel caso prova ad attivare la funzione "heapcrt" nelle opzioni di progetto (in allegato vedi dove).
All'uscita del programma viene generato un report con eventuali segnalazioni di LEAK di memoria.

ALTRI UTENTI DEL FORUM POTREBBERO ESSERTI DI AIUTO CON INFO MAGGIORI.

Ciao
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 29, 2021, 11:17:05 am
Ho provato a scrivere la seguente procedura che chiama un'altra procedura.La cosa strana che alla fine
dell'esecuzione della seconda procedura c'è un ritorno alla prima procedura senza un apparente motivo:



1a procedura:
Codice: [Seleziona]
 Procedure calcola_MomentiRottura( dom : Dominio_Rottura; soll : soll_esterne; MomentiRottura : momenti_rottura;flag_convergenza : Boolean; flag_circa : Boolean; index : Integer);
    var
     tipo_conv : integer;
  begin

   tipo_conv := StrtoInt(Form1.CBconverg.Text);

               case (tipo_conv) of

    1: begin        // Approssimato

       calcola_MomentiRottura_A(dom, soll, MomentiRottura, flag_convergenza, flag_circa, index) ;
          end;


    2: begin   // Bisezione
        calcola_MomentiRottura_B(dom, soll, MomentiRottura, flag_convergenza, flag_circa, index) ;
          end;


end;

  end;   

2a procedura
Codice: [Seleziona]
 Procedure calcola_MomentiRottura_A(dom : Dominio_Rottura; soll : soll_esterne; MomentiRottura : momenti_rottura;flag_convergenza : Boolean; flag_circa : Boolean; index : Integer);  ...........

la seconda procedura esegue correttamente il calcolo ma poi ritornando alla prima procedura i valori si azzerano.
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: DragoRosso - Maggio 29, 2021, 02:10:33 pm
Posta una parte di codice un pò più consistente, così non si capisce cosa viene fatto.

1) Definizioni delle procedure usate;

2) Codice chiamante (non solo una riga) e codice chiamato.

Ciao
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 29, 2021, 02:31:54 pm
Le strutture sono:
Codice: [Seleziona]
 dominio_rottura = record
   nd : Double;                       // Sforzo normale con cui si determinano i vari momenti di rottura
   mrx:array of Double ;       // vettore con i valori dei momenti Mrx del dominio
   mry:array of Double ;       // vettore con i valori dei momenti Mry del dominio
   ang:array of Double ;       // vettore con i valori dell//inclinazione sull//orizzontale dell//asse neutro in radianti, rotazione antioraria positiva
   nrc:array of Double ;       // vettore con valori dello sfozo normale nella parte compressa della sezione a rottura
   nrt:array of Double ;       // vettore con valori dello sforzo normale nella parte in trazione della sezione a rottura
   xrc:array of Double ;       // posizione della risultante dello sforzo di compressione
   yrc:array of Double ;       // (nel sistema di riferimento cartesiano della sezione)
   xrt:array of Double ;       // posizione della risultante dello sforzo di trazione
   yrt:array of Double ;       // (nel sistema di riferimento cartesiano della sezione)
   epsc:array of Double ;      // vettore con le deformazioni limite della fibra più compressa
   epss:array of Double ;      // vettore con le deformazioni limite della barra di armatura più distante dall//asse neutro
   yn:array of Double ;        // posizione asse neutro (nel sistema ruotato di ogni singola verifica)
   curv:array of Double ;      // Curvatura della deformazione della sezione
   End ;                                                                                         

Codice: [Seleziona]
oll_esterne =record
   N : Double ;                         // Sforzo normale: positovo se di compressione
   Mx : Double ;                        // Momento flettente asse momento X: positivo se comprime fibra Y+
   My : Double ;                        // Momento flettente asse momento Y: positivo se comprime fibra X+
   End;                                                                                     

Codice: [Seleziona]
momenti_rottura = record
    mrx : Double;                        // Momento di rottura con asse momento x
    mry : Double;                        // Momento di rottura con asse momento y
    ang : Double;                        // Rotazione dell//asse neutro rispetto all//asse x, antioraria positiva
    polix : Array of poligono_sezione;   // Poligono che definisce la porzione di cls compressa della sezione
    sigma_so: Array of Double;               // ' Array contenente le tensioni nelle barre di armatura a rottura
    sigma_sp: Array of Double;              // ' Array contenente le tensioni nei trefoli a rottura
    def_rottura : deform_sezione;        // configutrazione deformativa a rottura
    etac_max : Double;                   // distanza tra l//asse neutro e la fibra maggiormente compressa a rottura
    etas_min : Double;                   // distanza tra l//asse neutro e la fibra maggiormente tesa a rottura
    curv_rottura : Double;               // curvatura della sezione a rottura
    End ;                                                                     
La chiamante :
Codice: [Seleziona]
Procedure calcola_MomentiRottura( dom : Dominio_Rottura; soll : soll_esterne; MomentiRottura : momenti_rottura;flag_convergenza : Boolean; flag_circa : Boolean; index : Integer);
    var
     tipo_conv : integer;
  begin

   tipo_conv := StrtoInt(Form1.CBconverg.Text);

               case (tipo_conv) of

    1: begin        // Approssimato

       calcola_MomentiRottura_A(dom, soll, MomentiRottura, flag_convergenza, flag_circa, index) ;
          end;


    2: begin   // Bisezione
        calcola_MomentiRottura_B(dom, soll, MomentiRottura, flag_convergenza, flag_circa, index) ;
          end;

     { 3: begin // Secante
       calcola_MomentiRottura_C(dom, soll_SLU, MomentiRottura, flag_convergenza, flag_circa, index) ;
          end;
            }//questa devo ancora implementarla


end;

  end; 

La chiamata :
Codice: [Seleziona]
Procedure calcola_MomentiRottura_A(dom : Dominio_Rottura; soll : soll_esterne; MomentiRottura : momenti_rottura;flag_convergenza : Boolean; flag_circa : Boolean; index : Integer);

{
'flag_convergenza --> se TRUE convergenza della funzione e restituzione risultati precisi, se FALSE la funzione non è andata a convergenza
'flag_circa --> se TRUE vuol dire che la funzione non è andata a convergenza ma restituisce comunque un risultato conservativo
'se il flag_convergenza = FALSE ed il flag_circa = FALSE significa che non vengono restituiti valori accettabili, la funzione è fallita completamente
'index --> indice del primo punto del segmento del dominio in cui vi è la intersezione con la retta passante per [O.x, O.y] ed [soll.Mx soll.My]
'utile nel caso di fallimento della convergenza per infittire eventualmente i punti del dominio localmente e ritentare il calcolo }
 var

 i : Integer ;                //   'contatore generico
 ip1 : Integer ;                //                  'i+1
 k : Integer;                //                     'contatore generico
 kp1 : Integer;                //                   'k+1
 O : TipoPunto ;                //                  'punto origine della retta di sollecitazione
 Mx_My : TipoPunto ;                //              'punto che definise la retta di sollecitazione
 D_R_1 : TipoPunto;                //               'punto iniziale del generico segmento del dominio
 D_R_2 : TipoPunto ;                //              'punto finale del generico segmento del dominio
 retta_soll : TipoSegmento;                //       'retta di sollecitazione
 seg_dom : TipoSegmento;                //          'generico segmento del dominio
 P_int : TipoPunto ;                //              'punto di intersezione tra retta di sollecitazione e dominio di rottura
 P_int0 : TipoPunto ;                //             'punto di intersezione tra retta di sollecitazione e dominio di rottura
 np : Integer ;                //                   'contatore poligoni
 polic: array of poligono_sezione;            //'poligono copia che viene ruotato e sottoposto ad elaborazione
//polic:array[0..3] of poligono_sezione ;
 armco : armo_sezione ;                //           'armature copia che vengono ruotate e sottoposte ad elaborazione
 armcp : armp_sezione ;                //           'armature copia che vengono ruotate e sottoposte ad elaborazione
 Nfin : risultante_n_finale ;                //     'risultante degli sforzi ad asse neutro individuato
 ymax : Double ;                //                  'ordinata massima dei vertici della sezione
 yamin : Double ;                //                 'ordinata minima delle armature
 deformazione : Double ;
 x_provv : Double ;                //               'ascissa provvisoria
 y_provv : Double ;                //               'ordinata provvisoria
 r0 : Double  ;
 alfa : Double  ;
 Mrx_alfa : Double ;
 Mry_alfa : Double  ;
 r_alfa : Double  ;
 alfa1 : Double   ;
 Mrx_alfa1 : Double  ;
 Mry_alfa1 : Double  ;
 r_alfa1 : Double  ;
 alfa2 : Double   ;
 Mrx_alfa2 : Double   ;
 Mry_alfa2 : Double  ;
 r_alfa2 : Double  ;
 c : Double;                //  'variabile temporanea
 s : Double;                //  'variabile temporanea
 D : Double  ;
 DeltaP_dom : Double  ;



                 D0 : Double ;
                 d1 : Double;
                 d2 : Double ;

 label
 continua;

 begin


    SetLength(polic, N_POLI+1); //ReDim polic(N_POLI)
       SetLength(MomentiRottura.polix, N_POLI+1);     //ReDim MomentiRottura.polix(N_POLI)
         SetLength(MomentiRottura.sigma_so, arm.numarm+1);   //ReDim MomentiRottura.sigma_so(arm.numarm)
            SetLength(MomentiRottura.sigma_sp, armp.numarm+1);   // ReDim MomentiRottura.sigma_sp(armp.numarm)


// imposto di default false (convergenza fallita)
flag_convergenza := False;
// imposto di default false (risultato corretto)
flag_circa := False;

// 'If Abs(soll.My) > Abs(soll.Mx) Then
//'    r0 = soll.Mx / soll.My
//'Else
//'    r0 = soll.My / soll.Mx
//'End If

//'If Not soll.Mx = 0# Then
//'    r0 = soll.My / soll.Mx
//'Else
//'    r0 = Sgn(soll.My) * 100000000#
//'End If

//controllo se O è interno al dominio, se sì esiste un unico punto di intersezione col dominio



If Punto_Interno_poligonoB(0, 0, dom.mrx, dom.mry, NMaxDom) = 4 Then
    begin
    O.X := 0 ;
    O.Y := 0;
    Mx_My.X := soll.Mx ;
    Mx_My.Y := soll.My ;
    retta_soll.start := O  ;
    retta_soll.ends := Mx_My ;

    For i := 1 To NMaxDom   do
      begin
        If i = NMaxDom Then
        begin
        ip1 := 1 ;
         end
    Else
         begin
        ip1 := i + 1 ;
         end;


        D_R_1.X := dom.mrx[i];
        D_R_1.Y := dom.mry[i];
        D_R_2.X := dom.mrx[ip1];
        D_R_2.Y := dom.mry[ip1];
        seg_dom.start := D_R_1 ;
        seg_dom.ends := D_R_2 ;

        If IntersezRettaSegmento(retta_soll, seg_dom, P_int) = True Then
        begin
            If (sign(P_int.x) = sign(soll.Mx)) And (sign(P_int.y) = sign(soll.My)) Then
                begin
               // 'alfa1 = dom.ang(i): alfa2 = dom.ang(ip1)
               // 'alfa = (alfa1 + alfa2) / 2
                index := i; //'indice del punto corrente del dominio
                GoTo continua ;
            end ;
        end;
     end;
end



Else
     begin

   // 'se il punto sollecitante è fuori dal dominio non è verificato
 If Punto_Interno_poligonoB(soll.Mx, soll.My, dom.mrx, dom.mry, NMaxDom) = 1 Then Exit;

    O.X := 0;
    O.Y := 0;
    Mx_My.X := soll.Mx ;
    Mx_My.Y := soll.My ;
    retta_soll.start := O  ;
    retta_soll.ends := Mx_My  ;


  For i:= 1 To NMaxDom   do
      begin

      If i = NMaxDom Then
        begin
        ip1 := 1 ;
        end
      Else
        begin
        ip1 := i + 1 ;
        end;


        D_R_1.X := dom.mrx[i] ;
        D_R_1.Y := dom.mry[i] ;
        D_R_2.X := dom.mrx[ip1] ;
        D_R_2.Y := dom.mry[ip1] ;
        seg_dom.start := D_R_1 ;
        seg_dom.ends := D_R_2 ;


        If IntersezRettaSegmento(retta_soll, seg_dom, P_int) = True Then
            begin
            If (sign(P_int.X) = sign(soll.Mx)) And (sign(P_int.Y) = sign(soll.My)) Then
                begin
                //'alfa1 = dom.ang(i): alfa2 = dom.ang(ip1)
               // 'alfa = (alfa1 + alfa2) / 2
                index := i; //'indice del punto corrente del dominio

                //'verifico se esiste anche un altro punto di intersezione col dominio
               // 'dallo stesso lato.
               // '(questo succede nel caso di domini scostati dall'origine degli assi,
              //  'capita quando ci si aprossima a +Nmax o -Nmax, oppure anche nel
              //  'caso di alcuni profili particolari)

                D0 := (sqr(soll.Mx) + sqr(soll.My)) ;
                d2 := (sqr(P_int.X) + sqr(P_int.Y)) ;

                For k := i To NMaxDom  do
                      begin

                    If k = NMaxDom Then
                        begin
                        kp1 := 1;
                        end
                    Else
                        begin
                        kp1 := k + 1 ;
                         end;

                    D_R_1.X := dom.mrx[k] ;
                    D_R_1.Y := dom.mry[k] ;
                    D_R_2.X := dom.mrx[kp1] ;
                    D_R_2.Y := dom.mry[kp1];
                    seg_dom.start := D_R_1 ;
                    seg_dom.ends := D_R_2 ;

                    If IntersezRettaSegmento(retta_soll, seg_dom, P_int0) = True Then
                        begin
                        If (sign(P_int0.X) = sign(soll.Mx)) And (sign(P_int0.Y) = sign(soll.My)) Then
                            begin
                            d1 := (sqr(P_int0.X) + sqr(P_int0.Y))  ;
                            //'memorizzo il punto più distante da O
                            If d1 > d2 Then
                                begin
                                P_int := P_int0 ;
                                //'alfa1 = dom.ang(k): alfa2 = dom.ang(kp1)
                                //'alfa = (alfa1 + alfa2) / 2
                                index := k; //'indice del punto corrente del dominio
                                End ;
                           End ;
                        End ;

                      end;

                GoTo continua ;
            End ;
        End ;
    end;  // fine for i:=1 to.....

    end;





//'non ci sono intersezioni valide col poligono del dominio
Exit;

continua:
//'indica soluzione aprossimata
flag_circa := True;

//'convergenza secca sempre possibile
flag_convergenza := True;

//'calcoliamo col metodo secco di GIARIA recupernando index
i := index ;
If i = NMaxDom Then
    begin
    ip1 := 1;
    end
Else
    begin
    ip1 := i + 1;
    end;

D_R_1.X := dom.mrx[i] ;
D_R_1.Y := dom.mry[i] ;
D_R_2.X := dom.mrx[ip1] ;
D_R_2.Y := dom.mry[ip1];
alfa1 := dom.ang[i];
alfa2 := dom.ang[ip1];


If alfa2 < alfa1 Then
    begin
    alfa2 := alfa2 + 2 * pi;
     end;

D := sqrt(sqr(P_int.x - D_R_1.x) + sqr(P_int.y - D_R_1.y)) ;
DeltaP_dom := sqrt(sqr(D_R_2.x - D_R_1.x)+ sqr(D_R_2.y - D_R_1.y));
alfa := alfa1 + (alfa2 - alfa1) * D / DeltaP_dom  ;

//'calcola momenti resistenti con alfa
Mr_alfa (dom, soll, alfa, polic , armco, armcp, Nfin, ymax, yamin, mrx_alfa, mry_alfa, r_alfa );

If alfa > (2 * pi) Then
    begin
    alfa := (alfa - 2)* pi;
    end;

MomentiRottura.ang := alfa;
MomentiRottura.mrx := Mrx_alfa;
MomentiRottura.mry := Mry_alfa ;
MomentiRottura.def_rottura.epsa := Nfin.epsc ;
MomentiRottura.def_rottura.epsb := Nfin.epss ;
MomentiRottura.curv_rottura := Nfin.epsc / (ymax - Nfin.yn)  ;
MomentiRottura.etac_max := ymax - Nfin.yn  ;
MomentiRottura.etas_min := yamin - Nfin.yn ;





// Calcola una sola volta cos(alfa) e sin(alfa) per evitare elaborazione ogni volta
c := Cos(alfa) ;
s := Sin(alfa) ;
//vengono calcolate le tensioni nelle barre di armatura a rottura


      // setlength( armco.y,arm.numarm+1);
    //   setlength( arm.fyd,arm.numarm+1);

For i := 1 To arm.numarm  do
begin
    deformazione := Nfin.epsc * (armco.y[i] - Nfin.yn) / (ymax - Nfin.yn) ;
    MomentiRottura.sigma_so[i] := elast_plast_indef(deformazione, arm.fyd[i], E_arm);
end;
For i := 1 To armp.numarm    do
   begin
    deformazione := Nfin.epsc * (armcp.y[i] - Nfin.yn) / (ymax - Nfin.yn);
    MomentiRottura.sigma_sp[i] := elast_plast_indefps(deformazione + armp.def_prec[i], armp.fyd[i], E_armp);
   end;

//'viene individuato il poligono che delimita la porzione compressa
//'Calcola una sola volta Cos(alfa) e Sin(alfa) per evitare elaborazione ogni volta
c := Cos(alfa) ;
s := Sin(alfa) ;



//'viene individuato il poligono che delimita la porzione compressa
For np := 1 To N_POLI   do
   begin

    MomentiRottura.polix[np].numv := 0   ;

    For i := 1 To polic[np].numv do
       begin
        If i = polic[np].numv Then
            begin
            ip1 := 1 ;
            end
        Else
             begin
            ip1 := i + 1;
             end;
        If (polic[np].y[i] >= Nfin.yn) Then
            begin
            MomentiRottura.polix[np].numv := MomentiRottura.polix[np].numv + 1 ;

           // ReDim Preserve MomentiRottura.polix(np).X(1 To MomentiRottura.polix(np).numv)
           SetLength(MomentiRottura.polix[np].x, MomentiRottura.polix[np].numv+1);
           // ReDim Preserve MomentiRottura.polix(np).Y(1 To MomentiRottura.polix(np).numv)
            SetLength(MomentiRottura.polix[np].y, MomentiRottura.polix[np].numv+1);
            //ReDim Preserve MomentiRottura.polix(np).sigma(1 To MomentiRottura.polix(np).numv)
             SetLength(MomentiRottura.polix[np].sigma, MomentiRottura.polix[np].numv+1);


            MomentiRottura.polix[np].x[MomentiRottura.polix[np].numv] := poli[np].x[i]  ;
            MomentiRottura.polix[np].y[MomentiRottura.polix[np].numv] := poli[np].y[i] ;
            deformazione := Nfin.epsc * (polic[np].y[i] - Nfin.yn) / (ymax - Nfin.yn) ;
            MomentiRottura.polix[np].sigma[MomentiRottura.polix[np].numv] := parabola_rett(deformazione, polic[np].epsc0, polic[np].fd) ;
            end;

        If (sign(polic[np].y[i] - Nfin.yn)) <> (sign(polic[np].y[ip1] - Nfin.yn)) Then
            begin
            MomentiRottura.polix[NP].numv := MomentiRottura.polix[np].numv + 1;
            //'vengono prima individuate le coordinate del poligono ruotato
            x_provv := polic[np].x[i] + (polic[np].x[ip1] - polic[np].x[i]) * (Nfin.yn - polic[np].y[i]) / (polic[np].y[ip1] - polic[np].y[i]) ;
            y_provv := Nfin.yn;
            //'le coordinate appena trovate vengono quindi ruotate e riportate rispetto al sistema di riferimento originario

            //ReDim Preserve MomentiRottura.polix(NP).X(1 To MomentiRottura.polix(NP).numv)
            //ReDim Preserve MomentiRottura.polix(NP).Y(1 To MomentiRottura.polix(NP).numv)
            //ReDim Preserve MomentiRottura.polix(NP).sigma(1 To MomentiRottura.polix(NP).numv)

           SetLength(MomentiRottura.polix[np].x, MomentiRottura.polix[np].numv+1);
            SetLength(MomentiRottura.polix[np].y, MomentiRottura.polix[np].numv+1);
             SetLength(MomentiRottura.polix[np].sigma, MomentiRottura.polix[np].numv+1);

            MomentiRottura.polix[np].x[MomentiRottura.polix[np].numv] := x_provv * c - y_provv * s ;
            MomentiRottura.polix[np].y[MomentiRottura.polix[np].numv] := x_provv * s + y_provv * c  ;
           End;
   end; //Next i
end;//Next NP









end;   
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 30, 2021, 07:32:30 am
HO fatto delle prove e sucede che quando la procedura 'Procedure calcola_MomentiRottura_A'  termina il calcolo i valori passati si annullano all'uscita dalla procedura stessa.
Titolo: Re:problema traduzione da Visual Basic a Lazarus
Inserito da: alexarmato66 - Maggio 30, 2021, 07:36:45 am
 :)RISOLTO!!!
Dovevo semplicemente passare certi valori come riferimento!!:
Codice: [Seleziona]
 Procedure calcola_MomentiRottura_A( dom : Dominio_Rottura; soll : soll_esterne;var MomentiRottura : momenti_rottura;flag_convergenza : Boolean; flag_circa : Boolean; index : Integer);