Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut TBlockSerial : Stack Overflow à la connexion - Manque d'exemples

    Bjr à vous,

    J'utilise le composant TBlockSerial pour connecter et commander un lasermètre Bluetooth (TLazSerial est inadapté) offant un port série COMx.
    A la connexion, je rencontre une erreur 'Stack Overflow'.
    Voici le code de la fonction de connexion, sachant que TPilotageDistoX est un descendant de TBlockSerial.
    AfficherMessageErreur() et AfficherMessage() peuvent être remplacés par WriteLn() ou mockés (fonctions vides)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
     
    function TPilotageDistoX.OpenDistoXConnexion(const CommPort: string;
                                                 const Baudrate: integer;
                                                 const DataBits: integer;
                                                 const StopBits: integer;
                                                 const Parity  : char;
                                                 const TimeOutInSecs: integer): boolean;
    var
      EWE: Integer;
    begin
      Result:= false;
      try
        AfficherMessageErreur(Format('%s.OpenDistoXConnexion sur %s', [ClassName, CommPort]));
        // Variables pour éviter un doublon dans les mesures
        FOldMesureType := 0;
        FOldMesureX    := 0;
        FOldMesureY    := 0;
        FOldMesureZ    := 0;
        FTimeOutInMilliseconds := TimeOutInSecs * 1000;
        self.Config(Baudrate, DataBits, Parity, StopBits, false, false);
        AfficherMessageErreur(Format('Baudrate: %d, DataBits: %d, StopBits: %d, Parity: "%s", TimeOut: %d sec', [Baudrate, DataBits, StopBits, Parity, TimeOutInSecs]));
        self.OnStatus := OnChangeSerialStatus;
        self.TestDSR  := True;
        self.Connect(CommPort);
        EWE := self.LastError;
        if (0 <> EWE) then AfficherMessageErreur(self.LastErrorDesc);
        Result := (0 = EWE);
        AfficherMessageErreur(Format('Connexion %s - ErrCode: %d - ErrDesc: %s', [IIF(0 = EWE, 'OK', 'KO'), self.LastError, LastErrorDesc]));
     
      except
        on E: Exception do
        begin
          AfficherMessageErreur(Format('Connexion sur port "%s" impossible (%s)', [self.Device, E.Message]));
        end;
      end;
    end;
    Par ailleurs, existe-il des exemples simples d'utilisation de TBLockSerial ?

    Cdlt.

  2. #2
    Modérateur
    Avatar de tourlourou
    Homme Profil pro
    Biologiste ; Progr(amateur)
    Inscrit en
    mars 2005
    Messages
    3 237
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 56
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Biologiste ; Progr(amateur)

    Informations forums :
    Inscription : mars 2005
    Messages : 3 237
    Points : 9 317
    Points
    9 317
    Billets dans le blog
    5

    Par défaut

    Bonjour,

    je lis ici :
    procedure Config(baud, bits: integer; parity: char; stop: integer; softflow, hardflow: boolean); virtual;

    Reconfigure communication parameters on the fly. You must be connected to port before!
    Cela peut-il être en cause ?
    Delphi 5 Pro - Delphi 10.2 Tokyo Community Edition - CodeTyphon 6.50 sous Windows 10 ; CT 6.40 sous Ubuntu 18.04 (VM)
    . Ignorer la FAQ Delphi et les Cours et Tutoriels Delphi nuit gravement à notre code !

  3. #3
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut OK pour la connexion mais d'autres gros problèmes ensuite

    Citation Envoyé par tourlourou Voir le message
    Bonjour,

    je lis ici :

    Cela peut-il être en cause ?
    Ceci est corrigé. C'était bien en cause.

    Maintenant, l'appareil que je dois piloter est lourdement propriétaire: format binaire, Bluetooth, fonctionnant sur requête-réponse, aucun exemple de programmation, ... et surtout une même commande 56 pour lire une zone mémoire à partir d'une adresse (voir documentation jointe)
    Images attachées Images attachées

  4. #4
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut TBlockSerial: Cà commence à me gonfler grave

    Bjr à tous,

    Bon, j'arrive à me connecter à l'appareil.

    Soit un buffer de 8 octets: type TBuffer8Bytes = array[0..7] of Byte;
    que j'initialise avec des zéros.

    J'envoie des commandes par:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
     
    procedure TPilotageDistoX.SendReadCommandAtAddress(const QCmd: byte; const QAddress: word);
    var
      MyBuffer: TBuffer8Bytes;
    begin
      MyBuffer := MakeBuffer8BytesVierge();
      AfficherMessageErreur('Passe dans SendReadCommandAtAddress()');
      MyBuffer[0] := QCmd;           // envoi de la commande
      MyBuffer[2] := Lo(QAddress);   // QAddress and $FF         // envoi de la première partie de l'adresse   //  Address & 0xFF
      MyBuffer[3] := Hi(QAddress);   // (QAddress shr 8) and $FF //   envoi de la première partie de l'adresse // (Address >> 8) & 0xFF
      // Stack overflow
      AfficherMessageErreur('001');
      AfficherMessageErreur(Format('SendBuffer: %d', [SendBuffer(@MyBuffer, 3)]));
     
      AfficherMessageErreur('002');       
    end;
    Lors de l'envoi de ces trois octets (un opcode + les deux parties d'une adresse) --> crash ou StackOverflow. Toujours en erreur: Stack overflow, crash, gel définitif.

    La fonction qui bloque est TBlockSerial.SendBuffer()
    J'ai essayé:
    self.RTS := true;
    self.TestCTS := True;
    self.TestDSR := True;

    Rien à faire



    Comment peut-on travailler avec ces bugs inconstants ??? C'est insupportable !!!

    Plus sérieusement, y a-t-il des composants tout faits pour la gestion du port série en binaire ?



    Je songe à sous-traiter ce développement parce que là, çà me GONFLE SERIEUSEMENT.


    ==========================
    JP CASSOU
    Spéléologue
    Athéiste militant (ultra-laïciste)

  5. #5
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut Nouvelle version avec TLazSerial: KO - A voir avec l'auteur de TLazSerial

    Ce code bloque dans la fonction ReadAnPacket():
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
     
    unit unitDistoX2;
    // By JP CASSOU under Licence GPL
    {$INCLUDE CompilationParameters.inc}
     
    interface
     
    uses
      Classes, SysUtils, Math, dateutils,
      StructuresDonnees,
      Common
      {$IFDEF USE_GENERIC_TYPES}
      ,UnitListesSimplesWithGeneriques
      {$ELSE}
      UnitListesSimplesWithoutGeneriques
      {$ENDIF}
      , LazSerial, LazSynaSer, LazSerialPort
      ;
     
    const
      // axes
      mrX_AXIS = 1;
      mrY_AXIS = 2;
      mrZ_AXIS = 3;
      // mappage de la mémoire du DistoX
      //ADDR_START_SECTION_CONFIGURATION   = $B000; // calibration coefficients, Ox00B000 -> Ox00B3FF
      //ADDR_START_SECTION_DATA_STORE      = $B400; // data segment            , Ox00B400 -> Ox00FFFF
      // commandes DistoX
      DISTOX_COMMAND_EXTINCTION             =  52;  // $34: extinction du Disto
      DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS =  56;  // $38: b111000 ; conflict with measure trigging command
      DISTOX_COMMAND_CALIBRATION_ON         =  49;  // $31: b110001: Calibration ON
      DISTOX_COMMAND_CALIBRATION_OFF        =  48;  // $30: b110000: Calibration OFF
      DISTOX_COMMAND_LASER_ON               =  54;  // $36: b110110: Laser ON
      DISTOX_COMMAND_LASER_OFF              =  55;  // $37: b110111: Laser OFF
      //DISTOX_COMMAND_BEEP_ON                = $33;  // $33: Silent ON  = à ne pas utiliser
      //DISTOX_COMMAND_BEEP_OFF               = $32;  // $33: Silent OFF
      DISTOX_COMMAND_READ_DATA_SHOT         =  56;  // $38: lecture d'une visée
      DISTOX_COMMAND_BOOTLOADER_READ_DATA_AT_ADDRESS =  58;  // $38: b111010 ; conflict with measure trigging command
     
      ERR_MSG_NO_CONNEXION                  = '** No Connexion **';
     
    type TBuffer8BytesOfData = array[0..7] of Byte;
     
     
     
    type
     
    { TPilotageDistoX2 }
     
     TPilotageDistoX2 = class(TLazSerial)
      private
        // Mode d'attente des données
        FOnOffAttenteDonneesRX: boolean;
        // Infos sur le matos: Tout à -1
        FDistoXSerialNumber     : integer;
        FDistoXVersionFirmware  : integer;
        FDistoXVersionHardware  : Integer;
        procedure EvenementSerialRxData(Sender: TObject);
        procedure EvenementSerialStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
     
     
        function ReadAnPacket(const QAddr: word; var QBuffer: TBuffer8BytesOfData): boolean;
     
        // fonctions d'écriture/lecture
        function  ReadBufferAtAddress(const QAddr: integer;
                                      var MyBuffer: TBuffer8BytesOfData): boolean;
        function  ReadBuffer8bytes(var MyBuffer: TBuffer8BytesOfData;
                                   out LastSerialError: integer;
                                   out QTypeData: byte;
                                   out QOp      : byte): TProtoSerialError;
        procedure SendReadCommandAtAddress(var MyBuffer: TBuffer8BytesOfData; const QCmd: word; const QAddress: word);
     
      public
        function  Initialiser(): boolean;
        procedure Finaliser();
        function  OpenDistoX(const CommPort: string): boolean;
        procedure CloseDistoX();
        // Infos sur le matériel
        function ExtractNumSerieFromDistoX(): integer;
        function ExtractVersionFirmWareFromDistoX(): integer;
        function ExtractVersionHardwareFromDistoX(): integer;
     
        // événements
     
     
    end;
     
    implementation
    uses
      Forms;   // pour Application
     
    { TPilotageDistoX2 }
    ////////////////////////////////////////////////////////////////////////////////
    function MakeBufferVierge(): TBuffer8BytesOfData;
    var
      q: Integer;
    begin
      for q := 0 to High(Result) do Result[q] := $0;
    end;
     
    function TPilotageDistoX2.Initialiser(): boolean;
    begin
      Result := false;
      AfficherMessage(Format('%s.Initialiser',[self.ClassName]));
      result := False;
      FOnOffAttenteDonneesRX := false;
      FDistoXSerialNumber    := -1;
      FDistoXVersionFirmware := -1;
      FDistoXVersionHardware := -1;
      try
        Result := True;
      finally
      end;
    end;
     
    procedure TPilotageDistoX2.Finaliser();
    begin
      try
        AfficherMessage(Format('%s.Finaliser',[self.ClassName]));
      finally
      end;
    end;
     
    function TPilotageDistoX2.OpenDistoX(const CommPort: string): boolean;
    begin
      Result := False;
      ClearConsole();
      ClearConsoleErreur();
      AfficherMessage(Format('%s.OpenDistoX sur %s',[self.ClassName, CommPort]));
      try
        self.Device        := CommPort;       
        self.Open;
        self.OnRxData      := EvenementSerialRxData;
        self.OnStatus      := EvenementSerialStatus;
     
        Result := True;
        AfficherMessageErreur('DistoX connecté sur ' + CommPort);
     
        ExtractVersionFirmWareFromDistoX();
        ExtractVersionHardwareFromDistoX();
        ExtractNumSerieFromDistoX();
     
      except
        on E: Exception do AfficherMessageErreur(Format('Connexion sur port "%s" impossible' + #13#10 + 'Message: %s', [self.Device, E.Message]));
      end;
    end;
     
    procedure TPilotageDistoX2.CloseDistoX();
    begin
      AfficherMessage(Format('%s.CloseDistoX',[self.ClassName]));
      try
        self.Close;
      finally
      end;
    end;
    ////////////////////////////////////////////////////////////////////////////////
    // Evenements
    procedure TPilotageDistoX2.EvenementSerialRxData(Sender: TObject);
    begin
      //if (FOnOffAttenteDonneesRX) then LireEtDepilerTrameDe8OctetsData();
    end;
     
     
     
    procedure TPilotageDistoX2.EvenementSerialStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
    begin
      AfficherMessageErreur(Self.SynSer.Device);
      begin
        case Reason of
          HR_SerialClose : AfficherMessage('Port ' + Value + ' closed');
          HR_Connect     : AfficherMessage('Port ' + Value + ' connected');
          //HR_CanRead     : AfficherMessage('CanRead : ' + Value);
          //HR_CanWrite    : AfficherMessage('CanWrite : ' + Value);
          //HR_ReadCount   : AfficherMessage('ReadCount : ' + Value);
          //HR_WriteCount  : AfficherMessage('WriteCount : ' + Value);
          HR_Wait        : AfficherMessage('Wait : ' + Value);
     
        end ;
      end;
    end;
    ////////////////////////////////////////////////////////////////////////////////
    // Infos sur le matériel
    // numéro de série du DistoX
    function TPilotageDistoX2.ExtractNumSerieFromDistoX(): integer;
    var
      MyBuffer: TBuffer8BytesOfData;
    begin
      Application.ProcessMessages;
      if (FDistoXSerialNumber = -1) then          // si FDistoXSerialNumber = - 1, on fait une tentative d'extraction;
      begin
        if (ReadBufferAtAddress($8008, MyBuffer)) then  FDistoXSerialNumber := MyBuffer[3] + MyBuffer[4] shl 8; // retourne 2395 ou 2329 pour les DistoX de JPC
      end;
      Result := FDistoXSerialNumber;
    end;
    // version de firmware
    function TPilotageDistoX2.ExtractVersionFirmWareFromDistoX(): integer;
    var
      MyBuffer: TBuffer8BytesOfData;
    begin
      Application.ProcessMessages;
      if (FDistoXVersionFirmware = -1) then     // si FDistoXVersionFirmware = - 1, on fait une tentative d'extraction;
      begin
        if (ReadBufferAtAddress($E000, MyBuffer)) then FDistoXVersionFirmware := 100 * MyBuffer[3] + MyBuffer[4];
      end;
      Result := FDistoXVersionFirmware;
    end;
    // version de hardware
    function TPilotageDistoX2.ExtractVersionHardwareFromDistoX(): integer;
    var
      MyBuffer: TBuffer8BytesOfData;
    begin
      Application.ProcessMessages;
      if (FDistoXVersionHardware = -1) then
      begin
        if (ReadBufferAtAddress($E004, MyBuffer)) then FDistoXVersionHardware := 10 * MyBuffer[3] + MyBuffer[4];     // byte 3 = major; byte 4 = minor, bytes 5 et 6 = 0
      end;
      Result := FDistoXVersionHardware;
    end;
    //********************************************************************************
    // lecture-écriture
    procedure TPilotageDistoX2.SendReadCommandAtAddress(var MyBuffer: TBuffer8BytesOfData;const QCmd: word; const QAddress: word);
    begin
      MyBuffer[0] :=  QCmd;                        //DISTOX_COMMAND_READ_DATA = 56; // 00111000
      MyBuffer[1] :=  QAddress and $FF;           //  Address & 0xFF
      MyBuffer[2] := (QAddress shr 8) and $FF;    // (Address >> 8) & 0xFF
      self.WriteBuffer(MyBuffer, 3); //1 + High(MyBuffer));  // WriteBuffer() command
    end;
    function TPilotageDistoX2.ReadAnPacket(const QAddr: word; var QBuffer: TBuffer8BytesOfData): boolean;
    var
       reply_addr, QLastSerialError: Integer;
       QTypeData, QOp: byte;
    begin
      Result   := false;
      if (not self.Active) then Exit;
      QBuffer := MakeBufferVierge();
      SendReadCommandAtAddress(QBuffer, DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS, QAddr);
      if (PROTO_OK = ReadBuffer8bytes(QBuffer, QLastSerialError, QTypeData, QOp)) then
      begin
        if (QBuffer[0] = DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS) then
        begin
          // contrôle de l'adresse lue
          reply_addr := (QBuffer[2] shl 8) OR QBuffer[1];
          Result := (reply_addr = QAddr);
          Result := True;
        end;
      end;
      //Application.ProcessMessages();
    end;
     
    function TPilotageDistoX2.ReadBufferAtAddress(const QAddr: integer; var MyBuffer: TBuffer8BytesOfData): boolean;
    begin
      result := False;
      try
        // on boucle tant que la lecture des paquets n'a pas réussi
        while (not ReadAnPacket(QAddr, MyBuffer)) do // AfficherMessageErreur(Format('%s.ReadBufferAtAddress: %s: %s', [self.ClassName, {$I %FILE%}, {$I %LINE%}]));
          ;
        Result := True;
      except
        //FDistoXSerialNumber := -1;
      end;
     
    end;
     
    function TPilotageDistoX2.ReadBuffer8bytes(var MyBuffer: TBuffer8BytesOfData; out LastSerialError: integer; out QTypeData: byte; out QOp: byte): TProtoSerialError;
    begin
     
    end;
     
    end.
    Cdlt

    =====================================================
    JP CASSOU
    Spéléologue

  6. #6
    Expert confirmé
    Avatar de anapurna
    Homme Profil pro
    Développeur informatique
    Inscrit en
    mai 2002
    Messages
    2 806
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Arts - Culture

    Informations forums :
    Inscription : mai 2002
    Messages : 2 806
    Points : 4 580
    Points
    4 580

    Par défaut

    Salut

    Ta boucle while
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    while (not ReadAnPacket(QAddr, MyBuffer)) do // AfficherMessageErreur(Format('%s.ReadBufferAtAddress: %s: %s', [self.ClassName, {$I %FILE%}, {$I %LINE%}]));
          ;
    ne sert à rien sinon à planter ta machine... En regardant le code de tblock... tu as un waitingdata qui le fait pour toi.

    Regarde ce bout de code, je le trouve assez parlant.
    Tu testes le lasterror, tu demandes si tu peux lire et ensuite tu lis :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    program serialcollex;
     
    {$APPTYPE CONSOLE}
     
     uses
      synaser,
      sysutils;
     
    var
       ser:TBlockSerial;
       LCMD:String;
     begin
       ser:=TBlockserial.Create;
       try
         ser.RaiseExcept:=true;
         ser.Connect('COM1');
         ser.Config(9600,8,'N',0,false,false);
     
         while not (ser.LastError <> 0) do 
         begin
             if ser.lastError<>0 then 
               break;
               if ser.canread(1000) then  
               begin
                  LCMD := ser.Recvstring(1000);
                  writeLn(LCMD);
               end;
         end;
     
       finally
         ser.Free;
       end;
     end.
    Nous souhaitons la vérité et nous trouvons qu'incertitude. [...]
    Nous sommes incapables de ne pas souhaiter la vérité et le bonheur, et sommes incapables ni de certitude ni de bonheur.
    Blaise Pascal
    PS : n'oubliez pas le tag

  7. #7
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut TBlockSerial: Cà avance pas mal grâce à Annapurna

    Bjr à vous,

    Avec un conseil de Annapurna, j'ai pu débloquer pas mal de pbs pour mon projet de terminal de terrain utilisant un DistoX.
    Le code ci-dessous fonctionne bien

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
     
    program TestCOM;
     
    {$APPTYPE CONSOLE}
     
    uses
    synaser,
    sysutils,
    UnitMinimalCOM
    ;
     
    var
    MyMesureVisee: TMesureViseeDistoX;
    MyDistoX2Connexion: TDistoX2Connexion;
    begin
      MyDistoX2Connexion := TDistoX2Connexion.Create;
      try
        if (MyDistoX2Connexion.Initialiser('COM10', 5)) then
        begin
          WriteLn(MyDistoX2Connexion.GetDescriptionDevice());
          while not (MyDistoX2Connexion.GetLastError() <> 0) do
          begin
            if (0 <> MyDistoX2Connexion.GetLastError()) then break;
            if (MyDistoX2Connexion.LireEtDecoderBuffer8Bytes(MyMesureVisee)) then
            begin
              WriteLn(Format('L = %.3f m; Az = %.2f; P = %.2f - EWE = %s',
                                             [myMesureVisee.Longueur,
                                              myMesureVisee.Azimut,
                                              myMesureVisee.Pente,
                                              myMesureVisee.HexaData
                                              ]));
     
            end;
            // quitter avec une visée courte et verticale
            if ((MyMesureVisee.Longueur < 0.20) and (Abs(MyMesureVisee.Pente) > 85)) then
            begin
              WriteLn('Visee de signalisation d''arret');
              break;
            end;
          end;
     
        end;
        MyDistoX2Connexion.Finaliser();
      finally
        FreeAndNil(MyDistoX2Connexion);
      end;
    end.
    L'unité encapsulant la connexion DistoX
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
     
    unit UnitMinimalCOM;
     
    {$mode objfpc}{$H+}
     
    interface
     
    uses
      Classes, SysUtils, math,
      synaser;
    const
      FV = 24000.00;
      FM = 16384.00;
     
      MAX_IT = 500;
      EPS    = 1E-8;
      HEX_TO_RAD = 2 * PI / 65536;
     
      INVALID_HANDLE_VALUE = THandle(-1);
     
      DISTOX_COMMAND_EXTINCTION             =  52;  // $34: extinction du Disto
      DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS =  56;  // $38: b111000 ; conflict with measure trigging command
      DISTOX_COMMAND_CALIBRATION_ON         =  49;  // $31: b110001: Calibration ON
      DISTOX_COMMAND_CALIBRATION_OFF        =  48;  // $30: b110000: Calibration OFF
      DISTOX_COMMAND_LASER_ON               =  54;  // $36: b110110: Laser ON
      DISTOX_COMMAND_LASER_OFF              =  55;  // $37: b110111: Laser OFF
      //DISTOX_COMMAND_BEEP_ON                = $33;  // $33: Silent ON  = à ne pas utiliser
      //DISTOX_COMMAND_BEEP_OFF               = $32;  // $33: Silent OFF
      DISTOX_COMMAND_READ_DATA_SHOT         =  56;  // $38: lecture d'une visée
      DISTOX_COMMAND_BOOTLOADER_READ_DATA_AT_ADDRESS =  58;  // $38: b111010 ; conflict with measure trigging command
     
     
    // pour le DistoX
    type TNumeroSerie = integer;
    type TTypeMesureDistoX = (tmdxUNKNOWN, tmdxCHEMINEMENT, tmdxLRUD, tmdxANTENNE, tmdxSIGNALISATION);
    type TPoint3Df = record x, y, z : double; end;
     
    type TMesureViseeDistoX = record
      TypeMesure : TTypeMesureDistoX;
      DistoXSerialNumber: integer;
      SerieCourante  : TNumeroSerie;
      StationCourante: integer;
      Block      : integer;
      Segment    : integer;
      Longueur   : double;
      Azimut     : double;
      Pente      : double;
      IsMarked   : boolean;
      HexaData   : string;
      TimeStamp  : TDateTime; // horodatage de la visée
    end;
    type TBuffer8Bytes = array[0..7] of byte;
     
     
     
    type
     
    { TDistoX2Connexion }
     
     TDistoX2Connexion = class(TBlockSerial)
      private
        FDistoXSerialNumber     : integer;
        FDistoXVersionFirmware  : integer;
        FDistoXVersionHardware  : integer;
     
        FOldType: integer;
        FOldX   : integer;
        FOldY   : integer;
        FOldZ   : Integer;
        FTimeOutInMilliseconds: integer;
        function Acknowledge(const QTypeData: byte): boolean;
        function ExtractNumSerieFromDistoX(): integer;
        function ExtractVersionFirmWareFromDistoX(): integer;
        function ExtractVersionHardwareFromDistoX(): integer;
        function SendReadCommandAtAddress(const QCmd: byte; const QAddress: word): boolean;
        function ReadBuffer8BytesAtAddress(const QAddress: word; out MyBuffer: TBuffer8Bytes): boolean;
      public
        function  Initialiser(const DeviceCom: string; const TimeOutInSecondes: integer): boolean;
        procedure Finaliser();
        function LireEtDecoderBuffer8Bytes(out MyMesureVisee: TMesureViseeDistoX): boolean;
        function GetLastError(): integer;
        function GetDescriptionDevice(): string;
     
     
     
    end;
     
     
     
    implementation
    function MakeEmptyTBuffer8Bytes(): TBuffer8Bytes;
    var
      i: Integer;
    begin
      for i := 0 to High(Result) do Result[i] := 0;
    end;
     
    { TDistoX2Connexion }
     
    function TDistoX2Connexion.Acknowledge(const QTypeData: byte): boolean;
    var
      MyByte: Byte;
    begin
      result := false;
      if (self.CanWrite(FTimeOutInMilliseconds)) then
      begin
        MyByte := (QTypeData and $80) or $55;
        self.SendByte(MyByte);
        Result := (0 = self.LastError);
      end;
    end;
     
    function TDistoX2Connexion.Initialiser(const DeviceCom: string; const TimeOutInSecondes: integer): boolean;
     
    begin
      result := false;
      WriteLn(Format('%s.Initialiser(): Port "%s" - TimeOut: %d secondes)', [self.ClassName, DeviceCom, TimeOutInSecondes]));
      FTimeOutInMilliseconds := 1000 * TimeOutInSecondes;
     
      FDistoXSerialNumber    := -1;
      FDistoXVersionFirmware := -1;
      FDistoXVersionHardware := -1;
      FOldType := 0;
      FOldX    := 0;
      FOldY    := 0;
      FOldZ    := 0;
     
     
     
     
      Self.RaiseExcept:=true;
      Self.Connect(DeviceCom);
      self.Config(9600, 8, 'N', 0, false, false);
      WriteLn('Connexion OK');
      Result := (0 = self.LastError);
     
    end;
     
    procedure TDistoX2Connexion.Finaliser();
    begin
      WriteLn(Format('%s.Finaliser("%s")', [self.ClassName, self.GetDescriptionDevice()]));
      try
        self.CloseSocket;
      finally
      end;
    end;
    // Dans cette fonction, on extrait une trame de 8 octets
    // S'il s'agit de données de mesures topo, on acquitte.
    // En cas de succès de l'acquittement, on décode
    // En cas de succès du décodage, l'appelant peut utiliser la visée
    function TDistoX2Connexion.LireEtDecoderBuffer8Bytes(out MyMesureVisee: TMesureViseeDistoX): boolean;
    var
      EWE: String;
      i: Integer;
      MyBuffer : TBuffer8Bytes;
      QTypeData, QOp: Byte;
      QX, QY, QZ, Dist: integer;
      P: float;
    begin
      Result := false;
      if (self.CanRead(FTimeOutInMilliseconds)) then
      begin
        try
          self.RecvBuffer(@MyBuffer, 8);
     
          MyMesureVisee.TypeMesure := tmdxUNKNOWN;
          MyMesureVisee.Longueur := 0.00;
          MyMesureVisee.Azimut   := 0.00;
          MyMesureVisee.Pente    := 0.00;
          MyMesureVisee.IsMarked := false;
          MyMesureVisee.HexaData := '';
          EWE := '';
          for i := 0 to 7 do EWE += Format('%.2X', [MyBuffer[i]]);
          QTypeData := MyBuffer[0];
          QOp       := (QTypeData and $3F);
          // Ce sont des données ?
          if (QOp < $20) then
          begin
            if (Acknowledge(QTypeData)) then   // Indispensable juste après le test (QOp < $20), sinon, KO
            begin
              QX := MyBuffer[1] + (MyBuffer[2] shl 8);
              QY := MyBuffer[3] + (MyBuffer[4] shl 8);
              QZ := MyBuffer[5] + (MyBuffer[6] shl 8);
     
              if ((Foldtype <> QTypeData) and (FoldX    <> QX) and (FoldY    <> QY) and (FoldZ <> QZ)) then
              begin
                case QOp of
                  1: // données topo
                  begin
                   // distances exprimées en mm si < 100 m, sinon en cm
                   Dist := QX + ((QTypeData and $40) shr 10);     // OK
                   //myMesureVisee.TypeMesure := op;
                   myMesureVisee.TypeMesure := tmdxUNKNOWN;
                   myMesureVisee.Longueur := Dist * 0.001; // TODO: Cas où Dist > 100 m
                   myMesureVisee.Azimut   := radtodeg(QY * HEX_TO_RAD);                   // OK
                   P  := radtodeg(QZ * HEX_TO_RAD);
                   // if (Not InRange(P, -0.001, (90.001)) then P := P - 360.00;
                   if (Not InRange(P, -0.001, 0.25 * 360.00 + 0.001)) then P := P - 360.00;
                   myMesureVisee.Pente := P;
                   myMesureVisee.HexaData := EWE;
                   myMesureVisee.TimeStamp:= Now();
     
                   Result := True;
                  end;
                  2, 3: ; // G et M, ne fonctionne pas
                  4: ;
                else
                  ;
                end;
                Foldtype := QTypeData;
                FoldX    := QX;
                FoldY    := QY;
                FoldZ    := QZ;
              end; // if ((Foldtype <> QTypeData) and (FoldX ...
            end; //  if (Acknowledge(qtype) = PROTO_OK)) then
          end; // if (QOp < $20) then
        except
        end;
      end;
    end;
     
    function TDistoX2Connexion.GetLastError(): integer;
    begin
      result := self.LastError;
    end;
     
    function TDistoX2Connexion.GetDescriptionDevice(): string;
    begin
      Result := Format('Device: %d - Hardware: %d - Firmware: %d',
                       [ExtractNumSerieFromDistoX(),
                        ExtractVersionHardwareFromDistoX(),
                        ExtractVersionFirmWareFromDistoX()
                       ]);
    end;
    // Fonctions bas niveau de lecture/écriture
    function TDistoX2Connexion.SendReadCommandAtAddress(const QCmd: byte; const QAddress: word): boolean;
    var
      MyBuffer: TBuffer8Bytes;
    begin
      MyBuffer := MakeEmptyTBuffer8Bytes();
      MyBuffer[0] :=  QCmd;                        //DISTOX_COMMAND_READ_DATA = 56; // 00111000
      MyBuffer[1] :=  QAddress and $FF;           //  Address & 0xFF
      MyBuffer[2] := (QAddress shr 8) and $FF;    // (Address >> 8) & 0xFF
      self.SendBuffer(@MyBuffer, 3);
      result := (0 = self.LastError);
    end;
     
    function TDistoX2Connexion.ReadBuffer8BytesAtAddress(const QAddress: word; out MyBuffer: TBuffer8Bytes): boolean;
    begin
      result := false;
      MyBuffer := MakeEmptyTBuffer8Bytes();
      if (SendReadCommandAtAddress(DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS, QAddress)) then
      begin
        self.RecvBuffer(@MyBuffer, 8);
        Result := (0 = self.LastError);
      end;
    end;
     
    // numéro de série du DistoX
    function TDistoX2Connexion.ExtractNumSerieFromDistoX(): integer;
    var
      MyBuffer: TBuffer8Bytes;
    begin
      if (FDistoXSerialNumber = -1) then          // si FDistoXSerialNumber = - 1, on fait une tentative d'extraction;
      begin
        MyBuffer := MakeEmptyTBuffer8Bytes();
        if (ReadBuffer8BytesAtAddress($8008, MyBuffer)) then  FDistoXSerialNumber := MyBuffer[3] + MyBuffer[4] shl 8; // retourne 2395 ou 2329 pour les DistoX de JPC
      end;
      Result := FDistoXSerialNumber;
    end;
    // version de firmware
    function TDistoX2Connexion.ExtractVersionFirmWareFromDistoX(): integer;
    var
      MyBuffer: TBuffer8Bytes;
    begin
      if (FDistoXVersionFirmware = -1) then     // si FDistoXVersionFirmware = - 1, on fait une tentative d'extraction;
      begin
        MyBuffer := MakeEmptyTBuffer8Bytes();
        if (ReadBuffer8BytesAtAddress($E000, MyBuffer)) then FDistoXVersionFirmware := 100 * MyBuffer[3] + MyBuffer[4];
      end;
      Result := FDistoXVersionFirmware;
    end;
    // version de hardware
    function TDistoX2Connexion.ExtractVersionHardwareFromDistoX(): integer;
    var
      MyBuffer: TBuffer8Bytes;
    begin
      if (FDistoXVersionHardware = -1) then
      begin
        MyBuffer := MakeEmptyTBuffer8Bytes();
        if (ReadBuffer8BytesAtAddress($E004, MyBuffer)) then FDistoXVersionHardware := 10 * MyBuffer[3] + MyBuffer[4];     // byte 3 = major; byte 4 = minor, bytes 5 et 6 = 0
      end;
      Result := FDistoXVersionHardware;
    end;
    end.
    Et un exemple de sortie:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
     
    TDistoX2Connexion.Initialiser(): Port "COM10" - TimeOut: 5 secondes)
    Connexion OK
    Device: 2395 - Hardware: 1248 - Firmware: 205
    L = 1,077 m; Az = 180,62; P = -17,07 - EWE = 0135047080DDF3F9
    L = 1,166 m; Az = 180,01; P = -16,23 - EWE = 018E04028076F4FA
    L = 1,132 m; Az = 153,73; P = -39,18 - EWE = 016C04516D23E4EA
    L = 1,206 m; Az = 126,88; P = -36,55 - EWE = 01B604395A03E6D6
    L = 1,167 m; Az = 314,48; P = -1,13 - EWE = 018F04A1DF33FF20
    L = 1,214 m; Az = 323,47; P = 4,10 - EWE = 01BE0406E6EA021D
    L = 1,333 m; Az = 336,37; P = 3,19 - EWE = 01350532EF440219
    L = 1,564 m; Az = 349,66; P = 3,01 - EWE = 011C06A6F8240215
    L = 1,895 m; Az = 0,16; P = 3,01 - EWE = 0167071E00240213
    L = 1,199 m; Az = 325,00; P = -0,26 - EWE = 01AF041DE7D0FF2D
    L = 1,439 m; Az = 268,80; P = -2,48 - EWE = 019F0525BF3CFE4B
    L = 1,650 m; Az = 261,03; P = 2,09 - EWE = 0172069FB97D014B
    L = 1,152 m; Az = 300,47; P = -6,82 - EWE = 018004AAD526FB25
    L = 1,084 m; Az = 310,97; P = 7,72 - EWE = 013C0423DD7E0508
    L = 1,103 m; Az = 320,42; P = 3,89 - EWE = 014F04DBE3C40208
    L = 1,446 m; Az = 351,56; P = 7,92 - EWE = 01A605FFF9A105FE
    L = 0,127 m; Az = 202,70; P = -83,69 - EWE = 017F0024907CC429
    L = 0,610 m; Az = 47,59; P = -68,81 - EWE = 016202D72112CFF7
    L = 0,129 m; Az = 47,53; P = -89,24 - EWE = 018100CC218AC0C3
    Visee de signalisation d'arret
    TDistoX2Connexion.Finaliser("Device: 2395 - Hardware: 1248 - Firmware: 205")

  8. #8
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut TBlockSerial: Comment utiliser OnStatus ?

    Bjr

    Cà avance bien avec TBlockserial mais j'ai encore des problèmes avec OnStatus, que je n'arrive pas à utiliser (documentation difficile à trouver = doc inexistante en pratique)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
     
    procedure TMainFormPilote.ProcHookStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
    begin
      AfficherMessage('ProcStatus');
    end;
    ...
    function TMainFormPilote.Initialiser(): boolean;
    var
      Reason: THookSerialReason;
    begin
      Result := false;
      FConnexionDistoX := TDistoX2Connexion.Create;
      FConnexionDistoX.OnStatus := ProcHookStatus;       // <-- Error: Wrong parametees
    cdlt

    --------------------------------------------------------------------
    JP CASSOU
    Spéléologue
    Athéiste* militant - Christianophobe déclaré - Islamophobe

    *Un athéiste est un athée qui milite pour une politique publique d'interdiction totale et de répression des religions

  9. #9
    Expert confirmé
    Avatar de anapurna
    Homme Profil pro
    Développeur informatique
    Inscrit en
    mai 2002
    Messages
    2 806
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Arts - Culture

    Informations forums :
    Inscription : mai 2002
    Messages : 2 806
    Points : 4 580
    Points
    4 580

    Par défaut

    Salut

    Tu reprends bien pourtant la définition :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    {:Possible status event types for @link(THookSerialStatus)}
      THookSerialReason = (
        HR_SerialClose,
        HR_Connect,
        HR_CanRead,
        HR_CanWrite,
        HR_ReadCount,
        HR_WriteCount,
        HR_Wait
        );
     
      {:procedural prototype for status event hooking}
      THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason;
        const Value: string) of object;
    Ce serait peut être dû au fait que la propriété soit published et pas public dans les descendants, je ne sais pas l’impact que cela peut avoir.
    Nous souhaitons la vérité et nous trouvons qu'incertitude. [...]
    Nous sommes incapables de ne pas souhaiter la vérité et le bonheur, et sommes incapables ni de certitude ni de bonheur.
    Blaise Pascal
    PS : n'oubliez pas le tag

  10. #10
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut TLazSerial: Solutionnement en vue ?

    Bjr,

    Je reteste en dérivant mon TDistoX de TLazserial.
    Cà commence à bien marcher mais à la déconnexion, j'ai un message d'erreur 'Fonction incorrecte (code d'erreur -1)

    Le pilote:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
     
    unit PiloteDistoX2MainFrm;
     
    {$mode delphi}{$H+}
     
    interface
     
    uses
      UnitMinimalCOM,
      synaser, LazSerial,
      Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, curredit, SynEdit, LazSynaSer;
     
    type
     
      { TMainFormPilote }
     
      TMainFormPilote = class(TForm)
        Button1: TButton;
        Button2: TButton;
        Button3: TButton;
        editTimeOut: TCurrencyEdit;
        editPort: TEdit;
        Label1: TLabel;
        Label2: TLabel;
        Label3: TLabel;
        SynEdit1: TSynEdit;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Button3Click(Sender: TObject);
        procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
        procedure FormShow(Sender: TObject);
        procedure ProcHookStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
     
      private
        FConnexionDistoX: TDistoX2Connexion;
        procedure AfficherMessage(const Msg: string);
        procedure ProcOnRXData(Sender: TObject);
     
      public
        function Initialiser(): boolean;
        procedure Finaliser();
      end;
     
    var
      MainFormPilote: TMainFormPilote;
     
    implementation
     
    {$R *.lfm}
     
    { TMainFormPilote }
     
    //procedure(Sender: TObject; Reason: THookSerialReason; const Value: string) of object;
    procedure TMainFormPilote.ProcOnRXData(Sender: TObject);
    var
      MyMesureVisee: TMesureViseeDistoX;
    begin
      FConnexionDistoX.LireEtDecoderBuffer8Bytes(MyMesureVisee);
      // On vire les visées de longueur nulle (qui seront rejetées par GHTopo de toutes façons
      if (MyMesureVisee.Longueur > 0.001) then
      begin
        //... traitements
        AfficherMessage(Format('%d: %f, %f, %f', [MyMesureVisee.DistoXSerialNumber, MyMesureVisee.Longueur, MyMesureVisee.Azimut, MyMesureVisee.Pente]));
      end;
     
     
     
    end;
     
    procedure TMainFormPilote.ProcHookStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
    var
      MyMesureVisee: TMesureViseeDistoX;
    begin
      case Reason of
        HR_SerialClose:
          begin
            AfficherMessage('Connexion terminée');
          end;
        HR_Connect:
          begin
            AfficherMessage('Connexion en cours');
          end;
        HR_CanRead:
          begin
            //AfficherMessage('Lecture possible');
     
          end;
        HR_CanWrite:
          begin
            //AfficherMessage('Ecriture possible');
          end;
        HR_ReadCount:
          begin
            //AfficherMessage('Read count');
     
          end;
        HR_WriteCount:
          begin
            //AfficherMessage('Write count');
          end;
        HR_Wait:
          begin
            // AfficherMessage('En attente');
     
          end;
      end;
    end;
     
    function TMainFormPilote.Initialiser(): boolean;
    var
      Reason: THookSerialReason;
    begin
      Result := false;
      FConnexionDistoX := TDistoX2Connexion.Create(self);
      FConnexionDistoX.OnStatus := ProcHookStatus;
      FConnexionDistoX.OnRxData := ProcOnRXData;
      editPort.Text         := 'COM10';
      editTimeOut.AsInteger := 10;
      SynEdit1.Clear;
    end;
     
    procedure TMainFormPilote.Finaliser();
    begin
      try
      finally
        FreeAndNil(FConnexionDistoX);
      end;
    end;
     
    procedure TMainFormPilote.Button1Click(Sender: TObject);
    begin
      if (FConnexionDistoX.Initialiser(Trim(editPort.Text), editTimeOut.AsInteger)) then
      begin
        AfficherMessage(FConnexionDistoX.GetDescriptionDevice());
      end
      else
      begin
        AfficherMessage('Echec de connexion');
      end;
    end;
     
    procedure TMainFormPilote.Button2Click(Sender: TObject);
    begin
      //FConnexionDistoX.CloseSocket;
      FConnexionDistoX.Active:= false;
    end;
     
    procedure TMainFormPilote.Button3Click(Sender: TObject);
    begin
      FConnexionDistoX.DemanderUneMesure();
    end;
     
    procedure TMainFormPilote.FormClose(Sender: TObject; var CloseAction: TCloseAction);
    begin
      self.Finaliser();
    end;
     
    procedure TMainFormPilote.FormShow(Sender: TObject);
    begin
      self.Initialiser();
    end;
    procedure TMainFormPilote.AfficherMessage(const Msg: string);
    begin
      SynEdit1.Lines.add(Msg);
     
    end;
    end.
    L'unité:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
     
    unit UnitMinimalCOM;
     
    {$mode delphi}{$H+}
     
    interface
     
    uses
      Classes, SysUtils, math,
      LazSerial,
      synaser;
    const
      FV = 24000.00;
      FM = 16384.00;
     
      MAX_IT = 500;
      EPS    = 1E-8;
      HEX_TO_RAD = 2 * PI / 65536;
     
      INVALID_HANDLE_VALUE = THandle(-1);
     
      DISTOX_COMMAND_EXTINCTION             =  52;  // $34: extinction du Disto
      DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS =  56;  // $38: b111000 ; conflict with measure trigging command
      DISTOX_COMMAND_CALIBRATION_ON         =  49;  // $31: b110001: Calibration ON
      DISTOX_COMMAND_CALIBRATION_OFF        =  48;  // $30: b110000: Calibration OFF
      DISTOX_COMMAND_LASER_ON               =  54;  // $36: b110110: Laser ON
      DISTOX_COMMAND_LASER_OFF              =  55;  // $37: b110111: Laser OFF
      //DISTOX_COMMAND_BEEP_ON                = $33;  // $33: Silent ON  = à ne pas utiliser
      //DISTOX_COMMAND_BEEP_OFF               = $32;  // $33: Silent OFF
      DISTOX_COMMAND_TRIG_DATA_SHOT         =  56;  // $38: lecture d'une visée
      DISTOX_COMMAND_BOOTLOADER_READ_DATA_AT_ADDRESS =  58;  // $38: b111010 ; conflict with measure trigging command
     
     
    // pour le DistoX
    type TNumeroSerie = integer;
    type TTypeMesureDistoX = (tmdxUNKNOWN, tmdxCHEMINEMENT, tmdxLRUD, tmdxANTENNE, tmdxSIGNALISATION);
    type TPoint3Df = record x, y, z : double; end;
     
    type TMesureViseeDistoX = record
      TypeMesure : TTypeMesureDistoX;
      DistoXSerialNumber: integer;
      SerieCourante  : TNumeroSerie;
      StationCourante: integer;
      Block      : integer;
      Segment    : integer;
      Longueur   : double;
      Azimut     : double;
      Pente      : double;
      IsMarked   : boolean;
      HexaData   : string;
      TimeStamp  : TDateTime; // horodatage de la visée
    end;
    type TBuffer8Bytes = array[0..7] of byte;
     
     
     
    type
     
    { TDistoX2Connexion }
     
     //TDistoX2Connexion = class(TBlockSerial)
      TDistoX2Connexion = class(TLazSerial)
     
     
      private
        FCommPort               : string;
        FDistoXSerialNumber     : integer;
        FDistoXVersionFirmware  : integer;
        FDistoXVersionHardware  : integer;
     
        FOldType: integer;
        FOldX   : integer;
        FOldY   : integer;
        FOldZ   : Integer;
        FTimeOutInMilliseconds: integer;
     
     
        function Acknowledge(const QTypeData: byte): boolean;
        function ExtractNumSerieFromDistoX(): integer;
        function ExtractVersionFirmWareFromDistoX(): integer;
        function ExtractVersionHardwareFromDistoX(): integer;
        function SendReadCommandAtAddress(const QCmd: byte; const QAddress: word): boolean;
        function ReadBuffer8BytesAtAddress(const QAddress: word; out MyBuffer: TBuffer8Bytes): boolean;
      public
        function  Initialiser(const DeviceCom: string; const TimeOutInSecondes: integer): boolean;
        procedure Finaliser();
        function LireEtDecoderBuffer8Bytes(out MyMesureVisee: TMesureViseeDistoX): boolean;
        function GetLastError(): integer;
        function GetDescriptionDevice(): string;
        procedure DemanderUneMesure();
     
    end;
     
     
     
    implementation
    uses
      Dialogs;
    function MakeEmptyTBuffer8Bytes(): TBuffer8Bytes;
    var
      i: Integer;
    begin
      for i := 0 to High(Result) do Result[i] := 0;
    end;
     
    { TDistoX2Connexion }
     
    function TDistoX2Connexion.Acknowledge(const QTypeData: byte): boolean;
    var
      MyByte: Byte;
    begin
      result := false;
      if (self.SynSer.CanWrite(FTimeOutInMilliseconds)) then
      begin
        MyByte := (QTypeData and $80) or $55;
        self.SynSer.SendByte(MyByte);
        Result := (0 = self.synser.LastError);
      end;
    end;
     
    function TDistoX2Connexion.Initialiser(const DeviceCom: string; const TimeOutInSecondes: integer): boolean;
     
    begin
      ShowMessage(Format('Device: %s - Timeout: %d', [DeviceCom, TimeOutInSecondes]));
      result := false;
      // fermeture
      //self.CloseSocket;
      //WriteLn(Format('%s.Initialiser(): Port "%s" - TimeOut: %d secondes)', [self.ClassName, DeviceCom, TimeOutInSecondes]));
      FTimeOutInMilliseconds := 1000 * TimeOutInSecondes;
     
      FCommPort := DeviceCom;
      FDistoXSerialNumber    := -1;
      FDistoXVersionFirmware := -1;
      FDistoXVersionHardware := -1;
      FOldType := 0;
      FOldX    := 0;
      FOldY    := 0;
      FOldZ    := 0;
      Self.SynSer.RaiseExcept:=true;
      //Self.Connect(FCommPort);
      self.Device := FCommPort;
      self.BaudRate := br__9600;
      self.DataBits := db8bits;
      self.Parity   := pNone;
      self.StopBits := sbOne;
      ShowMessage('666');
      self.Open;
     
      //self..Config(9600, 8, 'N', 0, false, false);
     
     
      //WriteLn('Connexion OK');
      Result := (0 = self.SynSer.LastError);
     
    end;
     
    procedure TDistoX2Connexion.Finaliser();
    begin
      //WriteLn(Format('%s.Finaliser("%s")', [self.ClassName, self.GetDescriptionDevice()]));
      try
        //self.CloseSocket;
        self.Close;
      finally
      end;
    end;
    // Dans cette fonction, on extrait une trame de 8 octets
    // S'il s'agit de données de mesures topo, on acquitte.
    // En cas de succès de l'acquittement, on décode
    // En cas de succès du décodage, l'appelant peut utiliser la visée
    function TDistoX2Connexion.LireEtDecoderBuffer8Bytes(out MyMesureVisee: TMesureViseeDistoX): boolean;
    var
      EWE: String;
      i: Integer;
      MyBuffer : TBuffer8Bytes;
      QTypeData, QOp: Byte;
      QX, QY, QZ, Dist: integer;
      P: float;
    begin
      Result := false;
      if (self.SynSer.CanRead(FTimeOutInMilliseconds)) then
      begin
        try
          self.SynSer.RecvBuffer(@MyBuffer, 8);
          MyMesureVisee.DistoXSerialNumber := FDistoXSerialNumber;
          MyMesureVisee.TypeMesure := tmdxUNKNOWN;
          MyMesureVisee.Longueur := 0.00;
          MyMesureVisee.Azimut   := 0.00;
          MyMesureVisee.Pente    := 0.00;
          MyMesureVisee.IsMarked := false;
          MyMesureVisee.HexaData := '';
          EWE := '';
          for i := 0 to 7 do EWE += Format('%.2X', [MyBuffer[i]]);
          QTypeData := MyBuffer[0];
          QOp       := (QTypeData and $3F);
          // Ce sont des données ?
          if (QOp < $20) then
          begin
            if (Acknowledge(QTypeData)) then   // Indispensable juste après le test (QOp < $20), sinon, KO
            begin
              QX := MyBuffer[1] + (MyBuffer[2] shl 8);
              QY := MyBuffer[3] + (MyBuffer[4] shl 8);
              QZ := MyBuffer[5] + (MyBuffer[6] shl 8);
     
              if ((Foldtype <> QTypeData) and (FoldX    <> QX) and (FoldY    <> QY) and (FoldZ <> QZ)) then
              begin
                case QOp of
                  1: // données topo
                  begin
                   // distances exprimées en mm si < 100 m, sinon en cm
                   Dist := QX + ((QTypeData and $40) shr 10);     // OK
                   //myMesureVisee.TypeMesure := op;
                   myMesureVisee.TypeMesure := tmdxUNKNOWN;
                   myMesureVisee.Longueur := Dist * 0.001; // TODO: Cas où Dist > 100 m
                   myMesureVisee.Azimut   := radtodeg(QY * HEX_TO_RAD);                   // OK
                   P  := radtodeg(QZ * HEX_TO_RAD);
                   // if (Not InRange(P, -0.001, (90.001)) then P := P - 360.00;
                   if (Not InRange(P, -0.001, 0.25 * 360.00 + 0.001)) then P := P - 360.00;
                   myMesureVisee.Pente := P;
                   myMesureVisee.HexaData := EWE;
                   myMesureVisee.TimeStamp:= Now();
     
                   Result := True;
                  end;
                  2, 3: ; // G et M, ne fonctionne pas
                  4: ;
                else
                  ;
                end;
                Foldtype := QTypeData;
                FoldX    := QX;
                FoldY    := QY;
                FoldZ    := QZ;
              end; // if ((Foldtype <> QTypeData) and (FoldX ...
            end; //  if (Acknowledge(qtype) = PROTO_OK)) then
          end; // if (QOp < $20) then
        except
        end;
      end;
    end;
     
    function TDistoX2Connexion.GetLastError(): integer;
    begin
      result := self.SynSer.LastError;
    end;
     
    function TDistoX2Connexion.GetDescriptionDevice(): string;
    begin
      Result := Format('Port: %s - Device: %d - Hardware: %d - Firmware: %d',
                       [FCommPort,
                        ExtractNumSerieFromDistoX(),
                        ExtractVersionHardwareFromDistoX(),
                        ExtractVersionFirmWareFromDistoX()
                       ]);
    end;
     
    procedure TDistoX2Connexion.DemanderUneMesure();
    begin
      self.SynSer.SendByte(DISTOX_COMMAND_TRIG_DATA_SHOT);
    end;
     
     
     
    // Fonctions bas niveau de lecture/écriture
    function TDistoX2Connexion.SendReadCommandAtAddress(const QCmd: byte; const QAddress: word): boolean;
    var
      MyBuffer: TBuffer8Bytes;
    begin
      MyBuffer := MakeEmptyTBuffer8Bytes();
      MyBuffer[0] :=  QCmd;                        //DISTOX_COMMAND_READ_DATA = 56; // 00111000
      MyBuffer[1] :=  QAddress and $FF;           //  Address & 0xFF
      MyBuffer[2] := (QAddress shr 8) and $FF;    // (Address >> 8) & 0xFF
      self.SynSer.SendBuffer(@MyBuffer, 3);
      result := (0 = self.SynSer.LastError);
    end;
     
    function TDistoX2Connexion.ReadBuffer8BytesAtAddress(const QAddress: word; out MyBuffer: TBuffer8Bytes): boolean;
    begin
      result := false;
      MyBuffer := MakeEmptyTBuffer8Bytes();
      if (SendReadCommandAtAddress(DISTOX_COMMAND_READ_MEMORY_AT_ADDRESS, QAddress)) then
      begin
        self.SynSer.RecvBuffer(@MyBuffer, 8);
        Result := (0 = self.SynSer.LastError);
      end;
    end;
     
    // numéro de série du DistoX
    function TDistoX2Connexion.ExtractNumSerieFromDistoX(): integer;
    var
      MyBuffer: TBuffer8Bytes;
    begin
      if (FDistoXSerialNumber = -1) then          // si FDistoXSerialNumber = - 1, on fait une tentative d'extraction;
      begin
        MyBuffer := MakeEmptyTBuffer8Bytes();
        if (ReadBuffer8BytesAtAddress($8008, MyBuffer)) then  FDistoXSerialNumber := MyBuffer[3] + MyBuffer[4] shl 8; // retourne 2395 ou 2329 pour les DistoX de JPC
      end;
      Result := FDistoXSerialNumber;
    end;
    // version de firmware
    function TDistoX2Connexion.ExtractVersionFirmWareFromDistoX(): integer;
    var
      MyBuffer: TBuffer8Bytes;
    begin
      if (FDistoXVersionFirmware = -1) then     // si FDistoXVersionFirmware = - 1, on fait une tentative d'extraction;
      begin
        MyBuffer := MakeEmptyTBuffer8Bytes();
        if (ReadBuffer8BytesAtAddress($E000, MyBuffer)) then FDistoXVersionFirmware := 100 * MyBuffer[3] + MyBuffer[4];
      end;
      Result := FDistoXVersionFirmware;
    end;
    // version de hardware
    function TDistoX2Connexion.ExtractVersionHardwareFromDistoX(): integer;
    var
      MyBuffer: TBuffer8Bytes;
    begin
      if (FDistoXVersionHardware = -1) then
      begin
        MyBuffer := MakeEmptyTBuffer8Bytes();
        if (ReadBuffer8BytesAtAddress($E004, MyBuffer)) then FDistoXVersionHardware := 10 * MyBuffer[3] + MyBuffer[4];     // byte 3 = major; byte 4 = minor, bytes 5 et 6 = 0
      end;
      Result := FDistoXVersionHardware;
    end;
    end.

  11. #11
    Expert confirmé
    Avatar de anapurna
    Homme Profil pro
    Développeur informatique
    Inscrit en
    mai 2002
    Messages
    2 806
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Arts - Culture

    Informations forums :
    Inscription : mai 2002
    Messages : 2 806
    Points : 4 580
    Points
    4 580

    Par défaut

    Salut

    Pour fermer ta communication je pense qu'il manque un .
    Nous souhaitons la vérité et nous trouvons qu'incertitude. [...]
    Nous sommes incapables de ne pas souhaiter la vérité et le bonheur, et sommes incapables ni de certitude ni de bonheur.
    Blaise Pascal
    PS : n'oubliez pas le tag

  12. #12
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut

    Citation Envoyé par anapurna Voir le message
    salut

    pour fermer ta communication

    je pense qu'il manque un
    Pour fermer ma connexion, j'utilise la fonction Close() de TLazSerial, qui bascule la valeur de TLazSerial.Active à False

    Le setter de TLazSerial.Active est:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
     
    procedure TLazSerial.SetActive(state: boolean);
    begin
      if state=FActive then exit;
     
      if state then DeviceOpen
      else DeviceClose;
     
      FActive:=state;
    end;
    et le code de DeviceClose est:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
     
    procedure TLazSerial.DeviceClose;
    begin
      // flush device
      if FSynSer.Handle<>INVALID_HANDLE_VALUE then
      begin
        FSynSer.Flush;
        FSynSer.CloseSocket;
     //   FSynSer.Purge;
      end;
     
      // stop capture thread
      if ReadThread<>nil then begin
        ReadThread.FreeOnTerminate:=false;
        ReadThread.MustDie:= true;
        while not ReadThread.Terminated do begin
          Application.ProcessMessages;
        end;
        ReadThread.Free;
        ReadThread:=nil;
      end;
     
      // close device
      if FSynSer.Handle<>INVALID_HANDLE_VALUE then begin
        FSynSer.Flush;
        FSynSer.CloseSocket;
      end;
    end;
    DeviceClose déclenche l'erreur -1 Fonction incorrecte je ne sais où

  13. #13
    Expert confirmé
    Avatar de anapurna
    Homme Profil pro
    Développeur informatique
    Inscrit en
    mai 2002
    Messages
    2 806
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Arts - Culture

    Informations forums :
    Inscription : mai 2002
    Messages : 2 806
    Points : 4 580
    Points
    4 580

    Par défaut

    Salut

    L'erreur est lorsque tu cliques sur le bouton ou lorsque tu fermes la forme ?
    Nous souhaitons la vérité et nous trouvons qu'incertitude. [...]
    Nous sommes incapables de ne pas souhaiter la vérité et le bonheur, et sommes incapables ni de certitude ni de bonheur.
    Blaise Pascal
    PS : n'oubliez pas le tag

  14. #14
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut

    Citation Envoyé par anapurna Voir le message
    salut

    l'erreur est lorsque tu clique sur le bouton ou lorsque tu ferme la forme ?
    Lors du click sur le bouton [Déconnecter]

    Ce bouton appelle la fonction TDistoX2Connexion.Deconnecter(); dont voici le code

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    procedure TDistoX2Connexion.Deconnecter();
    begin
      try
        self.Close;
      finally
      end;
    end;

  15. #15
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    101
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 101
    Points : 210
    Points
    210
    Billets dans le blog
    2

    Par défaut TLazSerial: Un truc franchement chiant (Résolu)

    Bjr,

    Soit le type
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    TStatusEvent = procedure(Sender: TObject; Reason: THookSerialReason; const Value: string) of object;
    et soit une de mes fonctions utilisateur incluses dans un TFrame
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
    procedure ProcHookStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);          
    procedure ProcOnRXData(Sender: TObject);
    J'accroche cette fonction utilisateur à mon objet instancié:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
    FConnexionDistoX.OnRxData := ProcOnRXData;         // OK
    FConnexionDistoX.OnStatus := ProcHookStatus;         // <- erreur
    et j'obtiens l'erreur suivante à la compilation:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
    cadredixtoxnew.pas(164,32) Error: Incompatible types: got "TCdrDistoX2New.ProcHookStatus(TObject;THookSerialReason;const AnsiString);" expected "<procedure variable type of procedure(TObject;THookSerialReason;const AnsiString) of object;Register>"
    RESOLU: Il faut ajouter l'unité LazSynaSer

  16. #16
    Membre émérite
    Avatar de BeanzMaster
    Homme Profil pro
    Amateur Passionné
    Inscrit en
    septembre 2015
    Messages
    944
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Suisse

    Informations professionnelles :
    Activité : Amateur Passionné
    Secteur : Tourisme - Loisirs

    Informations forums :
    Inscription : septembre 2015
    Messages : 944
    Points : 2 563
    Points
    2 563
    Billets dans le blog
    2

    Par défaut

    Salut pour ta dernière question

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    FConnexionDistoX.OnStatus := ProcHookStatus;
    devrait être

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    FConnexionDistoX.OnStatus := @ProcHookStatus;
    Avec FPC, il faut mettre le @

    Cela devrait fonctionner normalement.

    A+
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

Discussions similaires

  1. [GNU-Prolog][Mémoire] Local stack overflow
    Par Maxoo dans le forum Prolog
    Réponses: 15
    Dernier message: 04/06/2008, 23h15
  2. Stack OverFlow
    Par Goundy dans le forum Langage
    Réponses: 2
    Dernier message: 24/12/2005, 22h35
  3. Problème de stack overflow
    Par heider dans le forum Langage
    Réponses: 13
    Dernier message: 22/09/2005, 20h50
  4. Stack OverFlow ou Violation d'adresse - Orienté Objet
    Par JakeGrafton dans le forum Langage
    Réponses: 7
    Dernier message: 31/05/2005, 17h34
  5. Stack overflow
    Par portu dans le forum Langage
    Réponses: 3
    Dernier message: 26/11/2003, 16h16

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo