FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Logiciel de soutien scolaire en langues.
par Pedro Alvarez Aujourd'hui à 16:52

» KGF_dll - nouvelles versions
par Klaus Aujourd'hui à 14:16

» Compilateur FBPano
par Ouf_ca_passe Aujourd'hui à 12:25

» mise a jour calculatrice
par papydall Aujourd'hui à 2:01

» double guillemets "" dans un EDIT
par Marc Hier à 23:43

» Documentation de KGF
par Klaus Lun 20 Nov 2017 - 22:52

» Zoom sur une portion d'écran
par JL35 Lun 20 Nov 2017 - 21:51

» Recherche d'une expression dans un source
par Marc Lun 20 Nov 2017 - 13:08

» Tracer une grille n'importe où sur l'écran
par JL35 Dim 19 Nov 2017 - 22:14

» TourD Version 2
par Klaus Sam 18 Nov 2017 - 23:58

» La métamatière et le peuple
par JL35 Ven 17 Nov 2017 - 21:18

» Capture d'une zone de l'écran total
par JL35 Ven 17 Nov 2017 - 18:41

» qui peut résoudre mon prb
par pascal10000 Jeu 16 Nov 2017 - 17:30

» évènements et objets système : listage automatique
par Jean Claude Jeu 16 Nov 2017 - 11:15

» Panoramic et la reconnaissance vocale.
par papydall Jeu 16 Nov 2017 - 3:45

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Novembre 2017
LunMarMerJeuVenSamDim
  12345
6789101112
13141516171819
20212223242526
27282930   
CalendrierCalendrier

Partagez | 
 

 Un bug avec USER_EVENT ?

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Un bug avec USER_EVENT ?   Sam 4 Mar 2017 - 4:59

J'ai récemment crééun pseudo_objet ObjectMover permettant de déplacer n'importe quel objet fenêtré avec la souris, en injectant cet objet ObjectMover dans l'objet cible (une form, un panel, ...) et en l'accrochant avec la souris. cela marche parfaitement.

Maintenant, je veux utiliser ON_USER_EVENT pour signaler le début et la fon du déplacement. Le début est signalé sur l'évènement OnMouseDown de cet objet, et la fin sur l'évènement ONMouseUp. Logique. Je transmets chaque fois, dans WParam, le Sender qui est l'objet ObjectMover, et dans LParam, l'identifiant du type de l'évènement dans le mot de poids faible (valeur 1 pour signaler ObjectMover), et dans le mot de poids fort, l'indication du type d'évènement (1 pour MouseDown et 2 pour MouseUp). LParam a donc 2 valeurs possibles, en hexa: $10001 pour MouseDown et $20001 pour MouseUp.

Or, je constate qu'au tout premier évènement (MouseDown), en Panoramic, le ON_USER_EVENT est  bien déclenché, mais WParam et LParam sont à zéro. Au deuxième évènement (MouseUp), on reçoit dans WParam et LParam les valeurs correspondant à MouseDown ! A l'évènement suivant (à nouveau MouseDown), on reçoit les valeurs de MouseUp, soit l'évènement réel précédent, et ainsi de suite. Il y a toujours un décalage d'un évènement pour la transmission de ces deux valeurs.

Pour le mettre en évidence, l'ai transmis à l'objet ObjectMover l'adresse d'un tableau de 4 entiers. Pour chacun de ces deux évènements, je remplis le tableau comme suit:
indice 0 : coordonnée X (LEFT) de l'objet hébergeant l'ObjectMover)
indice 1 : coordonnée Y (TOP) de l'objet hébergeant l'ObjectMover)
indice 2 : valeur réelle de LParam (donc $10001ou $1002)
indice 3 : valeur réelle de WParam (le Sender)

J'ai fait un petit programme de démo qui affiche 2 forms Panoramic. La première, l'objet 1, contient un petit ObjectMover en son centre, et on peut déplacer cette fenêtre en tirant cet ObjectMover, exactement comme par la barre de titre. La première est une form avec BORDER_HIDE et un ObjectMover violet simulate une barre de titre. On peut déplacer cette fenêtre en tirant cet ObjectMover.

L'évènement ON_USER_EVENT est activé. Et lorsqu'il arrive, j'utiliser WParam pour détecter quel objet envoie l'évènement. Or, au premier évènement (MouseDown sur un des deux ObjectMover), USER_EVENT_WPARAM étant à zéro, l'évènement n'est pas identifiable, et j'affiche "Oups..." dans le EDIT en bas de page. Lors des évènement suivants, j'affiche USER_EVENT_WPARAM et USER_EVENT_LPARAM ainsi que le contenu des 4 cellules du tableau. Et on voit immédiatement le décalage.

Jack, je sais bien que cette introduction est longue, mais c'est indispensable pour bien poser le problème. Voici les sources:
Code:
' demo_ObjectMover.bas

label clic1, clic21, user
dim res%, OM1%, OM20%, type%, EventData%(3)

dll_on "KGF_test.dll"

' Valable pour tout ce qui a un handle et peut recevoir un clic:
form 1 : top 1,60 : left 1,200 : on_click 1,clic1
' edit 1 : top 1,100 : left 1,200 : on_click 1,clic1
' spin 1 : top 1,100 : left 1,200 : on_click 1,clic1
' container 1 : top 1,100 : left 1,200 : on_click 1,clic1
' panel 1 : top 1,100 : left 1,200 : on_click 1,clic1
' ...

button 2 : caption 2,"Créer" : on_click 2,clic1
picture 3 : top 3,40 : left 3,10 : width 3,30 : height 3,30 : color 3,0,255,255


form 20 : border_hide 20 : top 20,300 : left 20,500
clipboard_copy 3
OM20% = dll_call6("CreateObjectMover",handle(20),1,0,0,width_client(20),22)
res% = dll_call3("SetObjectMoverImage",OM20%,0,0)
res% = dll_call2("SetObjectMoverUserEvent",OM20%,adr(EventData%))
button 21 : height 21,20 : top 21,1 : left 21,10 : caption 21,"Cliquez-moi" : on_click 21,clic21
parent 21,20

color 3,255,0,0
alpha 4 : top 4,90 : left 4,10 : caption 4,"Icône interne:"
spin 5 : top 5,110 : left 5,10 : width 5,50 : min 5,0 : max 5,362 : position 5,362

alpha 6 : top 6,150 : left 6,10 : caption 6,"Largeur:"
spin 7 : top 7,170 : left 7,10 : width 7,50 : min 7,0 : max 7,width_client(1) : position 7,0
alpha 8 : top 8,200 : left 8,10 : caption 8,"Hauteur:"
spin 9 : top 9,220 : left 9,10 : width 9,50 : min 9,0 : max 9,height_client(1) : position 9,0

alpha 10 : top 10,260 : left 10,10 : caption 10,"User event:"
edit 11 : top 11,280 : left 11,10 : width 11,600

on_user_event user
gosub clic1

end

clic1:
  if OM1%=0
    OM1% = dll_call6("CreateObjectMover",handle(1),type%,int(width_client(1)/2)-15,int(height_client(1)/2)-15,position(7),position(9))
    res% = dll_call2("SetObjectMoverUserEvent",OM1%,adr(EventData%))
    type% = type% + 1
    if type%=5 then type% = 0
    if object_type(1)=7 then to_foreground 1
    if position(5)=0
      clipboard_copy 3
      res% = dll_call3("SetObjectMoverImage",OM1%,0,0)
    else
      res% = dll_call3("SetObjectMoverImage",OM1%,1,position(5))
    end_if
    caption 2,"Supprimer"
  else
    OM1% = dll_call1("DeleteObjectMover",OM1%)
    caption 2,"Créer"
    if object_type(1)=7 then to_foreground 1
  end_if
  return
  
clic21:
  message "Je sais - vous avez voulu essayer..."
  return
  
user:
  if OM1%<>0
    if user_event_WParam=OM1%
      text 11,"Objet="+hex$(OM1%)+": wparam="+hex$(user_event_wparam)+"  lparam="+hex$(user_event_lparam)+"        EventData: x="+str$(EventData%(0))+" y="+str$(EventData%(1)) + " lparam="+hex$(EventData%(2))+" objet="+hex$(EventData%(3))
      return
    end_if
  end_if
  if OM20%<>0
    if user_event_WParam=OM20%
      text 11,"Objet="+hex$(OM20%)+": wparam="+hex$(user_event_wparam)+"  lparam="+hex$(user_event_lparam)+"        EventData: x="+str$(EventData%(0))+" y="+str$(EventData%(1)) + " lparam="+hex$(EventData%(2))+" objet="+hex$(EventData%(3))
      return
    end_if
  end_if
  text 11,"Oups..."
  return

Il faut prendre KGF_test.dll sur mon WebDav, dossier DLLs.

Pour rapidement montrer le code important des routines dans la DLL, voici les deux routines évènement de l'objet ObjectMover:
Code:
class procedure TObjectMover.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ind, i: integer;
  r: TRect;
  s: string;
begin
  with (Sender as TObjectMover) do begin
    FMoving := true;
    FDownX := X;
    FDownY := Y;
    GetWindowRect((Sender as TObjectMover).ParentWindow,r);
    fDragOrigin.X := r.Left;
    fDragOrigin.Y := r.Top;
    FWinWidth := r.Right - r.Left + 1;
    FWinHeight := r.Bottom - r.Top + 1;
    if FUserEventData<>0 then begin
      pinteger(FUserEventData)^ := fDragOrigin.X;
      pinteger(FUserEventData+4)^ := fDragOrigin.Y;
      pinteger(FUserEventData+8)^ := $10001;
      pinteger(FUserEventData+12)^ := integer(Sender);
      SendMessage(MainFormHandle,WM_USER+3000,$10001,integer(Sender));
      // *** les deux lignes suivantes sont juste pour les tests
      s := 'objet '+inttohex(integer(Sender),8)+'  $10001  '+inttohex(fDragOrigin.X+(fDragOrigin.Y shl 16),8);
      SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s)));
    end;
  end;
end;

class procedure TObjectMover.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ind, stk, i: integer;
  s: string;
begin
  with (Sender as TObjectMover) do begin
    FMoving := false;
    if FUserEventData<>0 then begin
      pinteger(FUserEventData)^ := fDragOrigin.X;
      pinteger(FUserEventData+4)^ := fDragOrigin.Y;
      pinteger(FUserEventData+8)^ := $20001;
      pinteger(FUserEventData+12)^ := integer(Sender);
      SendMessage(MainFormHandle,WM_USER+3000,$20001,integer(Sender));
      // *** les deux lignes suivantes sont juste pour les tests
      s := 'objet '+inttohex(integer(Sender),8)+'  $20001  '+inttohex(fDragOrigin.X+(fDragOrigin.Y shl 16),8);
      SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s)));
    end;
  end;
end;

La variable FUserEventData contient l'adresse du tableau de 4 éléments passé en paramètre dans la fonction SetObjectMoverUserEvent, appelée dans le programme Panoramic à la ligne 48 pour l'objet 1 et à la ligne 24 pour l'objet 20. La variable MainFormHandle est globale et chargée une fois pour toutes lors du chargement de la DLL par DLL_ON et contient le handle de la form 0.

Jack, est-ce que j'ai mal compris quelque chose, ou est-ce qu'il y a un problème dans ce cas particulier avec OnMouseDown et OnMouseUp ?

Juste pour être complet: le code complet de l'objet ObjectMover est dans mon WebDav, dossier Sources, sous-dossier KGF, fichier KGF_unit_ObjectMover.pas.

EDIT

J'oubliais de dire que pour pouvoir vérifier ce que j'envoie avec WM_USER+3000, j'envoie également un texte formatté dans la caption de la form 0, par WM_SETTEXT. Ainsi, on a la caption qui indique WParam et LParam, envoyéé déjà de la DLL, puis le contenu du EDIT affichant les deux variables système corresponantes ainsi que le contenu du tableau de 4 éléments, dont les indices 3 et 4 sont une copie du WParam et LParam.

EDIT

Je mets ici en spoiler le code complet de l'unité implémentant l'objet ObjectMover:
Spoiler:
 

EDIT
D'ailleurs, j'ai repmplacé le message WM_USER+3000 par un WM_SETTEXT en passant le handle de l'objet 11 (un EDIT). Et là, le vois bien les bonnes informations dès le premier évènement (MouseDown) et ensuite les autres (MouseUp, MouseDown ...).

Mon diagnostic: l'évènement UserEvent est bien déclenché. Mais dans le cas du MouseDown sur mon objet généré dans la DLL, les variables USER_EVENT_WPARAM et USER_EVENT_LPARAM sont chargées APRES le déclenchement de l'évènement Panoramic. ll est évident qu'il y a un décalage.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
silverman

avatar

Nombre de messages : 471
Age : 45
Localisation : Picardie
Date d'inscription : 19/03/2015

MessageSujet: Re: Un bug avec USER_EVENT ?   Dim 5 Mar 2017 - 17:19

C'est vraiment pas logique scratch  scratch  scratch
Tu ne pourrais pas reproduire ce bug avec un code minimaliste, juste avec des forms? Je suis juste parvenu à l'émuler, mais pas à le reproduire:
Code:

    ' cré la commande qui permet de déclencher un évènement
    dim event_index%,user32%
    event_index%=4024 : user32%=2   :' event_index% doit toujours avoir la valeur 4024
    LIBRARY user32%,"user32.dll"
    command "call_user_event","SendMessageA",user32%,"IIII","stdcall"
    ' ex.: call_user_event handle(0), event_index%, my_value1%, my_value2%



    label Traite_User_Event
    label clic1,mdown
    dim wparam,lparam

    left 0,600

    form 1 : left 1,700 : top 1,100 : caption 1,"Cliquez moi..."
    on_click 1,clic1
    on_mouse_down 1,mdown

    ' nouvelle commande utilisateur
    On_User_Event Traite_User_Event
    
    caption 0,"Objet="+hex$(1)+": user_event_wparam="+str$(user_event_wparam)+"  wparam="+str$(wparam)

    END



 Traite_User_Event:
     Off_User_Event
     '
       caption 0,"Objet="+hex$(1)+": user_event_wparam="+str$(user_event_wparam)+"  wparam="+str$(wparam)
     '
     On_User_Event Traite_User_Event
    return


 clic1:
       ' déclenche l'évènement(Attention, c'est toujours et uniquement le form 0 qui active la commande 'on_user_event'!)
       lparam=2
       call_user_event handle(0),event_index%,wparam,lparam
       '
       wparam=2
    return


 mdown:
       ' déclenche l'évènement(Attention, c'est toujours et uniquement le form 0 qui active la commande 'on_user_event'!)
       lparam=1
       call_user_event handle(0),event_index%,wparam,lparam
       '
       wparam=1
    return


Je viens d'en découvrir un qui va surement t'intéresser : les données reçus par les commandes 'USER_EVENT_WPARAM' et 'USER_EVENT_LPARAM' sont inversées!
Code:
   label Traite_User_Event

    dim wparam,lparam
    dim event_index%,user32%,null%
    event_index%=4024 : user32%=2   :' event_index% doit toujours avoir la valeur 4024
    '

    dll_on "user32"
    
    ' nouvelle commande utilisateur
    On_User_Event Traite_User_Event

    ' déclenche l'évènement(Attention, c'est toujours et uniquement le form 0 qui active la commande 'on_user_event'!)
    wparam=12
    lparam=34
    null%=dll_call4("SendMessageA",handle(0),event_index%,wparam,lparam)

    END
    Traite_User_Event:
     Off_User_Event
     '
     '
       select USER_EVENT_WPARAM
'          case 12 : message "USER_EVENT_WPARAM="+str$(USER_EVENT_WPARAM)+chr$(13)+chr$(10)+"wparam="+str$(wparam)+chr$(13)+chr$(10)+"USER_EVENT_LPARAM="+str$(USER_EVENT_LPARAM)+chr$(13)+chr$(10)+"lparam="+str$(lparam)

          case 34 : message "USER_EVENT_WPARAM="+str$(USER_EVENT_WPARAM)+chr$(13)+chr$(10)+"wparam="+str$(wparam)+chr$(13)+chr$(10)+"USER_EVENT_LPARAM="+str$(USER_EVENT_LPARAM)+chr$(13)+chr$(10)+"lparam="+str$(lparam)
       end_select
     '
     '
     On_User_Event Traite_User_Event
    return
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Dim 5 Mar 2017 - 20:32

Merci d'avoir fait des essais sur mon problème, Silverman !

Et l'inversion de WParam et LParam m'avait échappé, et ce parce que l'avais fait moi-même l'inversion dans mon code Delphi - je mettais l'ordre des paramètres avec LParam d'abord et WParam ensuite. J'avais tort, et à cause de l'nversion dans Panoramic, cela semblait correct.

Il y a donc un double problème. Je n'ai pas réussi à mettre mon problème initial en évidence, juste avec un code Panoramic et des objets Panoramic. Ce décalage des valeurs d'une fois sur l'autre ne survient que si le message WM_USER+3000 est envoyé par la DLL, pas par le programme Panoramic.

Il y a donc bien deux problèmes:
1. lors du premier WM_USER+3000, WParam et LParam sont transmis comme zéro (0). Lors du deuxième WM_USER+3000, on reçoit les valeurs WParam et LParam du premier appel, lors du troisième WM_USER+3000, on reçoit celles du deuxième, et ainsi de suite.
2. WParam et LParam sont bien inversées.

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Lun 13 Mar 2017 - 1:19

@Jack:
Est-ce que tu as eu l'occasion de prendre connaissance su bug signalé dans mon post initial (et résumé juste ci-dessus) ?
Je n'ai pas encore de solution pour cela...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jack
Admin
avatar

Nombre de messages : 1768
Date d'inscription : 28/05/2007

MessageSujet: Re: Un bug avec USER_EVENT ?   Lun 13 Mar 2017 - 19:11

J'ai lu ton exposé, mais je n'ai pas encore eu le temps de tester et de corriger s'il y a un problème. C'est dans la file d'attente ...

_________________
username : panoramic@jack-panoramic password : panoramic123
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://panoramic.free-boards.net
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Lun 13 Mar 2017 - 19:51

Merci, Jack. Pas de problème - prends ton temps. Pour moi, il est satisfaisant de savoir que tu en as pris note.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Mar 14 Mar 2017 - 21:51

Une information complémentaire:
si je fais un objet Panoramic avec ON_MOUSE_DOWN en ON_MOUSE_UP,
et si dans les routines évènement correspondantes j'utilise l'API SendMessage
avec WM_USER+3000 et des valeurs spécifiques pour WPARAM et LPARAM, je constate:
1. j'ai bien les bonnes valeurs dans les variables système correspondantes (abstraction faite de l'inversion)
2. les valeurs ne sont pas décalées d'un évènement, contrairement aux évènements correspondants
en provenance de mon objet ObjectMover.

En fait, j'ai l'impression qu'il s'agit d'un problème de timing.
C'est comme si, venant de la DLL, l'évènement Panoramic USER_EVENTserait déclenché avant d'avoir pu
charger les deux variables système, alors qu'un cas d'évènement sur un objet Panoramic, le traitement
semble prendre plus de temps, donnant ainsi le temps aux variables système d'être chargées avant
le déclenchement du USER_EVENT.

Enfin, c'est juste l'impression que cela me donne. En réalité, je n'en sais rien, bien sûr.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
silverman

avatar

Nombre de messages : 471
Age : 45
Localisation : Picardie
Date d'inscription : 19/03/2015

MessageSujet: Re: Un bug avec USER_EVENT ?   Mar 14 Mar 2017 - 22:57

En freebasic, j'ai déclenché l'évènement ' USER_EVENT' directement à partir d'un constructor dans une mini dl; juste le minimum technique; Je n'ai toujours pas réussi à reproduire ce bug. Il y a peut-être une spécificité dû à l'OS? Qu'est ce que ça donne si tu fais de même?
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Mer 15 Mar 2017 - 1:57

J'ai fais l'essai, avec un SENDMESSAGE dans le constructor de mon objet.
Résultat: les deux valeurs sont bien transmis, quoique inversés (WPARAM <-> LPARAM).

Mais par la suite, le problème persiste:
- le message envoyé dans l'évènement MOUSEDOWN ne transmet pas WPARAM et LPARAM, dont les valeurs dans les variables système ne changent pas.
- le message envoyé dans l'évènement MOUSEUP transmet les valeurs WPARAM et LPARAM envoyées en fait lors du MOUSEDOWN

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Mer 15 Mar 2017 - 3:47

@Jack:
J'ai continué à faire évoluer mon objet ObjectMover. Le fichier KGF_test.dll sur mon WebDav contient la version actuelle, modifiée par rapport à mon post initial. Mais le comportement et le problème est rigoureusement identique. Cependant, certaines fonctions ont subi un changement de paramètres, et c'est pourquoi je poste ici le code Panoramic du programme pour mettre le problème en évidence:
Spoiler:
 

Et ici, l'unité complète implémentant l'objet ObjectMover:
Spoiler:
 

L'essentiel des modification concerne la structure interne de l'objet: déinition propre des propriétés et méthodes etc, ajout de commentaires. La seule unité personnelle dans les clauses USES est KGF_unit_data, mais uniquement à cause des références à une seule variable:
MainFormHandle: HWND;
qui contient le handle de la form 0 (chargée directement par la DllProc lors de la commande DLL_ON). Si tuveux tester mon module KGF_unit_ObjectMover.pas, il suffit de retirer KGF_unit_data de la liste des USES, et d'y inclure cette variable et d'y charger le handle de la form 0, par exemple ainsi:
Code:

var
  MainFormHandle: HWND;
function LoadMainFormHandle(hnd: HWND):integer; stdcall; export;
begin
  result := -1;
  try
    MainFormHandle := hnd;
    result := 0;
  except
  end;
end;

C'est comme ça que j'avais fait la mise au point.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jack
Admin
avatar

Nombre de messages : 1768
Date d'inscription : 28/05/2007

MessageSujet: Re: Un bug avec USER_EVENT ?   Dim 19 Mar 2017 - 18:12

@Klaus:
Je n'ai pas testé les sources que tu as proposés.
J'ai juste regardé le code de USER_EVENT dans Panoramic et j'ai trouvé une anomalie qui pourrait expliquer ce que tu observes. je l'ai corrigée et j'ai aussi corrigé l'inversion entre les paramètres WParam et LParam.

J'ai fait un exécutable provisoire (panoramic.exe) qui charge un source et l'exécute pour que tu puisses tester si le problème est corrigé ou pas.

http://panoramic-language.pagesperso-orange.fr/PANORAMIC.exe
Si c'est résolu, je crée une version instantanée qui va présenter quelques surprises (il y a 8 nouveaux objets). Sinon, je regarderai ton exemple en détail.

_________________
username : panoramic@jack-panoramic password : panoramic123
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://panoramic.free-boards.net
Yannick

avatar

Nombre de messages : 7997
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: Re   Dim 19 Mar 2017 - 23:11

Humm....ça sent bon çà...
Laughing

Je sens que mes interfaces vont aimer... Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Dim 19 Mar 2017 - 23:58

Merci, Jack. J'ai téléchargé et je vais tester.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Lun 20 Mar 2017 - 0:11

Bon, les nouvelles sont mitigées.

1. L'inversion de WParam et LParam est corrigée.

2. Aussi bien l'évènement MouseDown que MouseUp envoient un USER_EVENT qui se déclenche bien.

Mais:

3. au premier USER_EVENT (MouseDown), WParam et LPARAM sont zéro. Au deuxième (MouseUp), WParam et LParam ont les valeurs postées pour le MouseDown.

4. par la suite, USER_EVENT est bien déclenché à chaque MOUSE_DOWN, mais en gardant inchangées les valeurs de WParam et LParam. Le MOUSE_UP suivant déclenche également un USER_EVENT, mais en mettant en place les valeurs WParam et LParam du MouseDown précédent.

Donc, pour moi, mis à part l'inversion des WParam et LParam, il n'y a pas de changement.


Je vais reprendre mon code à fond - on ne sait jamais.

EDIT

J'ai apporté une correction dans mon code - en effet, il y avait un bug issu d'un copier/collé non adapté. Donc, résultat corrigé:

1...3 restent valides.

4. Par la suite, WParam et LParam changent chaque fois, mais reprennent les valeurs de l'évènement précédent, en réalité. Je le vois car dans ma DLL, en même temps de la transmission par SEND_MESSAGE avec WM_USER+3000, je les place également dans un tableau d'entiers unidimensionnel et je l'affiche dans le titre de la form 0, par un SEND_MESSAGE WM_SETTEXT. Et là, je vois bien que les valeurs transmises dans le tableau et affichées dans le titre sont décalées d'un évènement par rapport aux valeurs retournées par les variables système USER_EVENT_WPARAM et USER_EVENT_LPARAM.

Je continue à chercher, on ne sait jamais... Mais ce qui est certain, c'est que ces deux variables système sont à zéro au premier évènement, ce qui n'est pas normal. Et je précise que ce comportement est le même avec le Panoramic_Editor V0.9.27i10 et le Panoramic.exe dont tu viens de donner le lien.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jack
Admin
avatar

Nombre de messages : 1768
Date d'inscription : 28/05/2007

MessageSujet: Re: Un bug avec USER_EVENT ?   Lun 20 Mar 2017 - 12:58

J'ai commencé à regarder ton code, mais je ne l'ai pas exécuté.

Je cherche pourquoi les valeurs de USER_EVENT_WPARAM et de USER_EVENT_LPARAM sont nulles au premier déclenchement. Je n'arrive pas à le reproduire en faisant des tests simples.

Dans la procedure TObjectMover.ControlMouseDown, es-tu absolument sûr que MainFormHandle est le handle de FORM0 (handle(0) en Panoramic) ?
D'autre part, ID_MouseDown est définie comme une constante. Es-tu sûr que c'est bien la valeur de $00010001 qui est utilisée dans WParam (WParam est un integer de 4 octets) ?

Deux choses me chiffonnent:

1 - Je trouve:
SendMessage(MainFormHandle,USER_EVENT_Message,ID_MouseDown,integer(Sender)); dans la procedure TObjectMover.ControlMouseUp ce qui n'est pas cohérent.

2 - Quand tu fais :
with (Sender as TObjectMover) do begin
en fait tu "forces" Sender à être utilisé comme un objet TObjectMover.
Mais s'il ne l'étais pas ?
Est-ce que c'est simplement un "cast" pour le compilateur, c'est à dire pour tout appel, on considère que Sender vient d'un TObjectMover (il peut y avoir des problèmes si elle est appelée par un objet d'un autre type), ou est-ce qu'il y a un test que Sender vient effectivement d'un TObjectMover ? (dans ce cas, c'est bon).

Mes tests simples sont ceux que je présentais sur ce forum lors de la création de ON_USER_EVENT :

La bibliothèque qui ne contient qu'une seule fonction :
Code:
library MaDLL;
uses
Windows,
Messages;
const
Message_DLL = WM_USER + 3000;
function USER_EVENT(Nb1 : integer) : integer; stdcall; // Nb1 est un handle
var
WP, LP : integer;
begin
WP := 10; // par exemple
LP := 20; // par exemple
Result := SendMessage(Nb1, Message_DLL, WP, LP);
end;
exports
USER_EVENT;
end.

Et l'utilisation avec Panoramic :
Code:
label traite_event
On_User_Event traite_event
dll_on "MaDLL.dll"
print dll_call1("USER_EVENT",handle(0))
dll_off
end
traite_event:
message "événement déclenché par DLL"+chr$(13)+chr$(10)+str$(USER_EVENT_WPARAM)+chr$(13)+chr$(10)+str$(USER_EVENT_LPARAM)
return

WParam et LParam sont des entiers de 4 octets.

_________________
username : panoramic@jack-panoramic password : panoramic123
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://panoramic.free-boards.net
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Lun 20 Mar 2017 - 17:41

Merci, Jack d'avoir regardé mon code.

Tu dis:
Citation :
Dans la procedure TObjectMover.ControlMouseDown, es-tu absolument sûr que MainFormHandle est le handle de FORM0 (handle(0) en Panoramic) ?
Oui. C'est une variable globale qui est chargée dès le chargement de la DLL par DLL_ON. J'en ai vérifié le contenu en l'affichant et en affichant str$(handle(0)) - c'est identique. Cette variable n'esu modifiée nulle part dans la DLL.

Citation :
D'autre part, ID_MouseDown est définie comme une constante. Es-tu sûr que c'est bien la valeur de $00010001 qui est utilisée dans WParam (WParam est un integer de 4 octets) ?
Oui. $00010001 est utilisé pour signaler "MouseDown" (highword) dans ObjectMover (lowword). Et $00020001 est utilisée pour signamer "MouseUp" (highword) dans ObjectMover (lowword).

Citation :
SendMessage(MainFormHandle,USER_EVENT_Message,ID_MouseDown,integer(Sender)); dans la procedure TObjectMover.ControlMouseUp ce qui n'est pas cohérent.
Exact. Ceci est l'anomalie de copier/coller que j'ai signalée dans mon post précédent et qui est corrigée depuis. Mais elle ne change rien sur le fond: au lieu de transmettre une valeur, le SendMessage transmettait une autre valeur. Cependant, au premier appel, les variables système sont bien à zéro, et non à l'une ou l'autre de ces valeurs.

Citation :
Quand tu fais :
with (Sender as TObjectMover) do begin
en fait tu "forces" Sender à être utilisé comme un objet TObjectMover.
Mais s'il ne l'étais pas ?
Exact. C'est bien le but. Cette séquence est utilisée dans une procédure qui est une routine évènement spécifique à ObjectMover, locale à l'unité spéciale contenant ObjectMover et appelée nulle part ailleurs. Donc, il n'y a aucun risque de confusion.

Citation :
Mes tests simples sont ceux que je présentais sur ce forum lors de la création de ON_USER_EVENT
Je les ai fait aussi. Et comme toi, j'obtiens le bon résultat. C'est bien pourquoi je me pose des questions car je ne comprends pas.

Et fait, la question se résume en un seul point:
Pourquoi, lors du premier évènement (un MouseDown sur l'objet ObjectMover), alors que les paramètres WParam et LParam de SendMessage sont réellement diférents de zéro, les variables systèmre correspondantes en Panoramic ont la valeur zéro ? Peu importe les valeurs que le transmets - j'ai essayé avec des valeurs quelmconques comme 17 et 23, mais n'importe quelle valeur produit le même résultat.

Exemple:
dans l'évènement MouseDown, je fais
Code:
SendMessage(MainFormHandle,WM_USER+3000,17,23);
L'évènement USER_EVENT se déclenche bien, mais USER_EVENT_WPARAM et USER_EVENT_LPARAM ont la valeur zéro. D'ailleurs, ceci prouve que MainFormHandle contient la bonne valeur, sinon USER_EVENT ne pourrait pas se déclencher...
Puis, dans l'évènement MouseUp, je fais
Code:
SendMessage(MainFormHandle,WM_USER+3000,39,47);
L'évènement USER_EVENT se déclenche bien, mais USER_EVENT_WPARAM contient 17 et USER_EVENT_LPARAM contient 23.
Ensuite, au prochain MouseDown, USER_EVENT_WPARAM contient 39 et USER_EVENT_LPARAM contient 47, et ainsi de suitge.

Et ce phénomène de "décalage" est systématique avec ObjectMover; mais je n'arrive pas à le reproduire avec des ON_MOUSE_DOWN et ON_MOUSE_UP sur un objet Panoramic. C'est assez perturbant. Et je suis sûr des valeurs transmises, car, comme du peux le voir, je les copie également dans un tableau uni-dimensionnel d'entiers ainsi que sous forme de texte dans la barre de titre de la form 0. Et chaque fois, ces valeurs sont bonnes et en décalage avec le contenu des deux variables système. C'est ce qui m'a fait penser à un problème de timing ou de synchronisation, mais c'est juste une supposition.

Voici la version actuelle de KGF_unit_ObjectMover.pas:
Code:
{
  Cette unité crée l'objet ObjectMover. Il peut être injecté dans n'importe quel objet fenêtré. Il réagit alors
  comme une barre de titre d'un ojtt FORM permettant de déplacer l'objet qui l'héberge, en le tirant par la souris.
  Par défaut, sa taille est de 16x16 pixels, mais elle est paramétrable.

  Cet objet a deux états distincts: normal et actif. L'état est actif si l'objet est accroché par la souris pour effectuer un
  déplacement  et redevient normal en relâchant l'objet. L'image par défaut de l'état noirmal est un carré rouge, et celle
  de l'état actif est un carr" jaune, mais on peut lui charger une icône interne à KGF.dll ou une bitmap externe, ou encore
  une mage du presse-papier. L'icône interne 362 est bien adaptée à cet usage. L'image sera automatiquement ajustée aux
  dimensions réelles de l'ObjectMover, mais attention aux déformations !

  On peut dimensionner cet objet de sorte à obtenir une barre le long d'un des 4 côtés de l'objet hébergeant, créant ainsi
  un semblant de barre de titre ou d'outils, réagissante aux manipulation par la souris. On peut bien entendu placer des objets
  visuels par-dessus.

  Lors d'un début et d'une fin de déplacement, un USER_EVENT est déclenché.
  Ceci est fait par l'envoi d'un message WM_USER+3000 à la form 0, avec les informations suivantes:
    LParam:  LowWord(LParam)  = 1 signifie ObjectMoverEvent
            HighWord(LParam) = 1 signifie Start moving
            HighWord(LParam) = 2 signifie Stop moving
    Wparam:  LowWord(WParam)  = x contient l'abscisse
            HighWord(WParam) = y contient l'ordonnée

  ATTENTION ! A cause d'une inversion de USER_EVENT_LPARAM et USER_EVENT_WPARAM dans Panoramic, il faudra inverser
              ces valeurs dans ma présente unité lorsque ce bug sera corrigé !             
}
unit KGF_unit_ObjectMover;

interface
  uses
    Windows, Messages, Forms, Classes, Clipbrd, ImgList, SysUtils, Graphics, Controls, Dialogs,
    KGF_unit_data      // unité contenant la variable globale MainFormHandle: HWND;  <= handle de la form 0
    ;

// définition de l'objet ObjectMover - dérive de TForm
type
  TObjectMover = class(TForm)
    // déclaration des procédures internes de gestion de la souris
    class procedure ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    class procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    class procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  private
    // variables internes pour les propriétés
    FMoving: Boolean;                                    // flag "déplacement en cours"
    fDragOrigin: TPoint;                                  // coordonnées du coin en haut à gauche de l'objet contenant ObjectMover
    FDownX, FDownY: integer;                              // coordonnées du MouseDown sur ObjectMover
    FWinWidth, FWinHeight: integer;                      // dimensions de l'objet contenant ObjectMover
    FUserEventData: Integer;                              // adresse d'un tableau de 4 entiers à remplir sur MoseDown et MouseUp
    FNormalBMP: TBitMap;                                  // image état normal
    FActiveBMP: TBitMap;                                  // image état actif
    // procédures appelées par les propriétées et méthodes
    procedure SetNormalBMPFromClipboard();
    procedure SetActiveBMPFromClipboard();
    procedure SetNormalImageFromIcon(index: integer);
    procedure SetActiveImageFromIcon(index: integer);
    procedure SetNormalImageFromFile(bmpfile: integer);
    procedure SetActiveImageFromFile(bmpfile: integer);
//  protected
  public
    constructor CreateNew(AOwner: TComponent; ADestination: HWND; ALocation, ADimension: TPoint); //override;
    destructor Destroy; override;
  published
    // propriétés et méthodes
    property NormalBMP: TBitMap read FNormalBMP;
    property ActiveBMP: TBitMap read FActiveBMP;
    property UserEventData: Integer read FUserEventData write FUserEventData;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

const
  USER_EVENT_Message              = WM_USER + 3000;
  UserEventOrigin_ObjectMover      = $00000001;
  UserEventAction_ObjectMover_Down = $00010000;
  UserEventAction_ObjectMover_Up  = $00020000;
  ID_MouseDown                    = UserEventOrigin_ObjectMover or UserEventAction_ObjectMover_Down;  // $00010001
  ID_MouseUp                      = UserEventOrigin_ObjectMover or UserEventAction_ObjectMover_Up;    // $00020001

implementation

// création de l'objet ObjectMover
// act: 0=(tp,lft)  1=top left  2=top right  3=bottom right  4=bottom left
function CreateObjectMover(hdest: HWND; act,lft,tp,w,h: integer):integer; stdcall; export;
var
  FM: TObjectMover;
  r: TRect;
  t, l, w0, h0: integer;
begin
  result := 0;                          // initialement: objet non créé
  Windows.GetClientRect(hdest,r);        // dimensions de l'objet recevant ObjectMover
  if w=0 then w0 := 16 else w0 := w;    // largeur imposée ou 16 pixels si non spécifiée
  if h=0 then h0 := 16 else h0 := h;    // hauteur imposée ou 16 pixels si non spécifiée
  // définir top et left en fonction du code action
  case act of
    0: begin            // (x,y)
        t := tp;
        l := lft;
      end;
    1: begin            // top left
        t := 0;
        l := 0;
      end;
    2: begin            // top right
        t := 0;
        l := r.Right-w0;
      end;
    3: begin            // bottom right
        t := r.Bottom-h0;
        l := r.Right-w0;
      end;
    4: begin            // bottom left
        t := r.Bottom-h0;
        l := 0;
      end;
  end;
  // création effective de l'objet
  FM := TObjectMover.CreateNew(nil,hdest,point(l,t),point(w0,h0));
  with FM do begin
    show;
    // créer l'image par défaut de l'état normal - un carré rouge
    FNormalBMP := TBitMap.Create;
    With FNormalBMP do begin
      width := 16;
      height := 16;
      Canvas.Brush.Color := clRed;
      Canvas.FillRect(Rect(0,0,16,16));
    end;
    // créer l'image par défaut de l'état activé - un carré jaune
    FActiveBMP := TBitMap.Create;
    With FActiveBMP do begin
      width := 16;
      height := 16;
      Canvas.Brush.Color := clYellow;
      Canvas.FillRect(Rect(0,0,16,16));
    end;
    Canvas.StretchDraw(Rect(0,0,w,h),NormalBMP);          // dessiner l'image de l'état normal
    UserEventData := 0;                                  // initialement, pas de lien vers le tableau de 4 mots
    paint;
    OnMouseDown := TObjectMover.ControlMouseDown;        // imposer les routines évènement de gestion de la souris
    onMouseMove := TObjectMover.ControlMouseMove;
    OnMouseUp := TObjectMover.ControlMouseUp;
  end;
  result := integer(FM);                                  // et retourner l'objet ObjectMover en cas de réussite
end;

// supprimer un objet ObjectMover
function DeleteObjectMover(OM: TObjectMover):integer; stdcall; export;
begin
  result := 0;
  if not assigned(OM) then exit;      // cet objet n'exise pas ? abandon !
  OM.FNormalBMP.Free;                  // supprimer les images d'abord, par sécurité
  OM.FActiveBMP.Free;
  OM.Free;                            // et supprimer ObjectMover
end;

// routine interne de service, pour récupérer la bitmap associée à une icône interne à KGF.dll
function GetInternalIcon(i: integer):TBitMap;
var
  imglist: TImageList;

  procedure ExtractResToFile(ResType, ResName, ResNewName : String);
  var
    Res : TResourceStream;
  begin
    Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
    Res.SavetoFile(ResNewName);
    Res.Free;
  end;

begin
  ExtractResToFile('DATAFILE','TOOLBAR_ICONS','.\KGF_temp.ilb');  // récupérer le fichier ilb
  imglist := TImageList.Create(nil);      // créer une imagelist temporaire
  imglist.DrawingStyle := dsTransparent;
  imglist.BkColor := clBtnFace;
  imglist.Height := 16;
  imglist.Width := 16;
  result := TBitMap.Create;
  result.Width := 16;
  result.Height := 16;
  ReadComponentResFile('.\KGF_temp.ilb', imglist) ;  // charger le fichier ilb dans cette liste
  if (i<1) or (i>imglist.Count) then begin
    imglist.Free;
    deletefile('.\KGF_temp.ilb');
    exit;
  end;
  imglist.GetBitmap(i-1,result);
  imglist.Free;
  deletefile('.\KGF_temp.ilb');
end;

// charger les deux images possibles (état normal et actif)
function SetObjectMoverImage(OM: TObjectMover; NormalTyp, NormalImg, ActiveTyp, ActiveImg: integer):integer; stdcall; export;
var
  w, h: integer;
begin
  result := -1;                                                        // supposer échec
  try
    if not assigned(OM) then exit;                                    // ObjectMover non créé ?
    w := OM.Width - 1;                                                // récupérer ses dimensions
    h := OM.Height - 1;
    // charger l'image de l'état normal (laisser inchangé si zéro !), et dessiner de suite
    case NormalTyp of
      1: begin            // presse-papier
            OM.SetNormalBMPFromClipboard();
            OM.Canvas.StretchDraw(Rect(0,0,w,h),OM.NormalBMP);
          end;
      2: begin            // icône interne
            OM.SetNormalImageFromIcon(NormalImg);
            OM.Canvas.StretchDraw(Rect(0,0,w,h),OM.NormalBMP);
          end;
      3: begin            // fichier image externe
            if NormalImg<>0 then begin
              OM.SetNormalImageFromFile(NormalImg);
              OM.Canvas.StretchDraw(Rect(0,0,w,h),OM.NormalBMP);
            end;
          end;
    else exit;
    end;
    // charger l'image de l'état actif (laisser inchangé si zéro !), ne pas dessiner
    case ActiveTyp of
      1: begin            // presse-papier
            OM.SetActiveBMPFromClipboard();
          end;
      2: begin            // icône interne
            OM.SetActiveImageFromIcon(ActiveImg);
          end;
      3: begin            // fichier image externe
            if ActiveImg<>0 then begin
              OM.SetActiveImageFromFile(ActiveImg);
            end;
          end;
    else exit;
    end;
    result := 0;              // résultat ok
  except
  end;
end;

// mémoriser l'adresse de début d'un tableau de 4 entiers, pour retourner des informations sur MouseDown et MouseUp
function SetObjectMoverUserEvent(OM: TObjectMover; ptr: integer):integer; stdcall; export;
begin
  result := -1;
  try
    if not assigned(OM) then exit;      // ObjectMover non créé ?
    OM.UserEventData := ptr;
    result := 0;
  except
  end;
end;

// constructeur privé de ObjectMover
constructor TObjectMover.CreateNew(AOwner: TComponent; ADestination: HWND; ALocation, ADimension: TPoint);
begin
  inherited CreateNew(AOwner);                    // créer une form normalement
  BorderStyle := bsNone;                          // pas de bords
  SetBounds(0,0,ADimension.X,ADimension.Y);      // dimensions imposées
  Top := ALocation.Y;                            // position imposée
  Left := ALocation.X;
  color := clSilver;                              // couleur imposée
  Paint;
  ParentWindow := ADestination;                  // injecter O bjectMover dans l'objet ciblé
//SendMessage(MainFormHandle,WM_USER+3000,$234,$345);
end;

// suppression privée de ObjectMover
destructor TObjectMover.Destroy;
begin
  inherited Destroy;                              // supprimer la TForm, en réalité
end;


// charger l'image de l'état normal du presse-papier
procedure TObjectMover.SetNormalBMPFromClipboard();
begin
  FNormalBMP.Assign(Clipboard);
end;

// charger l'image de l'état actif du presse-papier
procedure TObjectMover.SetActiveBMPFromClipboard();
begin
  FActiveBMP.Assign(Clipboard);
end;

// charger l'image de l'état normal à partir d'une icône de KGF.dll
procedure TObjectMover.SetNormalImageFromIcon(index: integer);
begin
  FNormalBMP.Assign(GetInternalIcon(index));
end;

// charger l'image de l'état actif à partir d'une icône de KGF.dll
procedure TObjectMover.SetActiveImageFromIcon(index: integer);
begin
  FActiveBMP.Assign(GetInternalIcon(index));
end;

// charger l'image de l'état normal à partir d'un fichier BMP
procedure TObjectMover.SetNormalImageFromFile(bmpfile: integer);
var
  s: string;
begin
  if bmpfile<>0 then begin
    s := pstring(bmpfile)^;
    if s='' then exit;
    if not FileExists(s) then exit;
    FNormalBMP.LoadFromFile(s);
  end;
end;

// charger l'image de l'état actif à partir d'un fichier BMP
procedure TObjectMover.SetActiveImageFromFile(bmpfile: integer);
var
  s: string;
begin
  if bmpfile<>0 then begin
    s := pstring(bmpfile)^;
    if s='' then exit;
    if not FileExists(s) then exit;
    FActiveBMP.LoadFromFile(s);
  end;
end;


// procédure privé pour l'évènement MouseDown - accrocher et activer ObjectMover
class procedure TObjectMover.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ind, i, w, h: integer;
  r: TRect;
  s: string;
begin
  with (Sender as TObjectMover) do begin
    w := Width;                                              // prendre les dimensions de ObjectMover
    h := Height;
    FMoving := true;                                          // marquer "en mouvement" (actif)
    FDownX := X;                                              // mémoriser les coordonnées du clic d'accroche dans ObjectMover
    FDownY := Y;
    GetWindowRect((Sender as TObjectMover).ParentWindow,r);  // prendre les coordonnées de l'objet hébergeant ObjectMover
    Canvas.StretchDraw(Rect(0,0,w,h),ActiveBMP);              // dessiner l'image de l'état actif
    fDragOrigin.X := r.Left;                                  // mémoriser le point de départ du déplacement de l'objet hébergeur
    fDragOrigin.Y := r.Top;
    FWinWidth := r.Right - r.Left + 1;                        // calculer les dimensions de ObjectMover
    FWinHeight := r.Bottom - r.Top + 1;
    if UserEventData<>0 then begin                            // l'adresse d'un tableau de 4 mots a été indiquée ?
      pinteger(UserEventData)^ := fDragOrigin.X;              // indice 0: abscisse du hébergeur
      pinteger(UserEventData+4)^ := fDragOrigin.Y;            // indice 1: ordonnée du hébergeur
      pinteger(UserEventData+8)^ := ID_MouseDown;            // indice 2: signaler action "down" pour "ObjectMover"
      pinteger(UserEventData+12)^ := integer(Sender);        // ObjectMover lui-même
      SendMessage(MainFormHandle,USER_EVENT_Message,ID_MouseDown,integer(Sender));      // créer le USER_EVENT dans Panoramic
      // *** les deux lignes suivantes sont juste pour les tests
      s := 'objet '+inttohex(integer(Sender),8)+'  '+inttohex(ID_MouseDown,8);
      SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s)));
    end;
  end;
end;

// procédure privée pour l'évènement MouseMove - déplacer l'hébergeur si ObjectMover est actif
class procedure TObjectMover.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  l, t: integer;
  s: string;
  r: TRect;
begin
  with (Sender as TObjectMover) do begin
    if fmoving then begin                            // ObjectMover est actif ?
      l := X - FDownX + fDragOrigin.X;                // calculer la nouvelle position de l'hébergeur
      t := Y - FDownY + fDragOrigin.Y;
      fDragOrigin.X := l;                            // mémoriser la nouvelle position
      fDragOrigin.Y := t;
      MoveWindow((Sender as TObjectMover).ParentWindow,l,t,FWinWidth,FWinHeight,true);  // déplacer l'hébergeur
    end;
  end;
end;

// procédure privée pour l'évènement MouseUp - décrocher ObjectMover et désactiver
class procedure TObjectMover.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ind, stk, i, w, h: integer;
  s: string;
begin
  with (Sender as TObjectMover) do begin
    FMoving := false;                                          // désactiver
    FDownX := X;                                              // mémoriser la position de MouseUp
    FDownY := Y;
    w := Width;                                                // prendre les dimensions de ObjectMover
    h := Height;
    Canvas.StretchDraw(Rect(0,0,w,h),NormalBMP);              // dessiner l'image de l'état normal
    if UserEventData<>0 then begin                            // l'adresse d'un tableau de 4 mots a été indiquée ?
      pinteger(UserEventData)^ := fDragOrigin.X;              // indice 0: abscisse du hébergeur
      pinteger(UserEventData+4)^ := fDragOrigin.Y;            // indice 1: ordonnée du hébergeur
      pinteger(UserEventData+8)^ := ID_MouseUp;                // indice 2: signaler action "up" pour "ObjectMover"
      pinteger(UserEventData+12)^ := integer(Sender);          // ObjectMover lui-même
      SendMessage(MainFormHandle,USER_EVENT_Message,ID_MouseUp,integer(Sender));      // créer le USER_EVENT dans Panoramic
      // *** les deux lignes suivantes sont juste pour les tests
      s := 'objet '+inttohex(integer(Sender),8)+'  '+inttohex(ID_MouseUp,8);
      SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s)));
    end;
  end;
end;




exports
  CreateObjectMover, DeleteObjectMover, SetObjectMoverImage, SetObjectMoverUserEvent
  ;

end.

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
silverman

avatar

Nombre de messages : 471
Age : 45
Localisation : Picardie
Date d'inscription : 19/03/2015

MessageSujet: Re: Un bug avec USER_EVENT ?   Dim 25 Juin 2017 - 18:32

Yannick a été confronté à ce phénomène de "décalage" en panoramic + api windows. J'ai nettoyé son code pour mettre ce bug(?) en évidence.
Voici 2 tout petits sources, pas besoin de compiler quoi que ce soit, copier/coller les sources dans panoramic editor, et lancer le "Recepteur" en premier, puis l'"Emetteur". Cliquez sur envoi pour voir ce qui ce passe.

Emetteur:
Code:
' Note : d'abord lancer le "Recepteur"
caption 0,"Emetteur"

width 0,200 : height 0,600

' DECLARATION DES LABELS
label envoi

' DECLARATION ET INITIALISATION DES VARIABLES
dim typ%,value%
dim Recepteur_Hnd%
dim event_index% : event_index%= 4024
dim user32% : user32%=2

' recevoir le handle du recepteur via le presse papier
while Recepteur_Hnd%=0
   Recepteur_Hnd%=val(clipboard_string_paste$)
end_while

' DECLARATION DE LIBRARY ET DE COMMAND
LIBRARY user32%,"user32.dll"
command "send_user_event","SendMessageA",user32%,"IIII","stdcall"

' bouton d'envoi
button 2
top 2,60 : left 2,100 : caption 2,"Envoi" : cursor_point 2

' assigne des valeurs aux variables à transmettre
typ%=1
value%=500
print
print "Prêt à envoyer:"
print typ%
print value%
print
  
  
on_click 2,envoi


END
envoi:
   ' envoyer
   send_user_event Recepteur_Hnd%,event_index%,typ%,value%
   '
   ' prépare l'envoi suivant
   typ% = typ% + 1
   value% = 500 + typ%
   print "Prêt à envoyer:"
   print typ%
   print value%
   print
return


Recepteur:
Code:
' Note: ce "Recepteur" est à lancer en premier
caption 0,"Recepteur"
Application_title "Recepteur"

width 0,200 : height 0,600 : left 0,200

' DECLARATION DES LABELS
label TraiteEvent

' envoyer à l'emetteur le handle du recepteur via le presse papier
clipboard_string_copy str$(handle_form("Recepteur"))
  
alpha 2 : caption 2, "En attente de reception..."
print


on_user_event TraiteEvent


END
TraiteEvent:
   print "Reçu:"
   print str$(USER_EVENT_LPARAM)
   print str$(USER_EVENT_WPARAM)
   print
return
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jack
Admin
avatar

Nombre de messages : 1768
Date d'inscription : 28/05/2007

MessageSujet: Re: Un bug avec USER_EVENT ?   Dim 25 Juin 2017 - 19:42

@silverman:
Je dois reconnaître qu'avec les sources que tu proposes, il y a bien un bug, un décalage entre l'émission et la réception.
Merci de l'avoir mis en évidence en simplifiant le source et ainsi d'avoir isolé ce bug que Klaus et yannick avaient rencontré.

_________________
username : panoramic@jack-panoramic password : panoramic123
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://panoramic.free-boards.net
Yannick

avatar

Nombre de messages : 7997
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Dim 25 Juin 2017 - 20:56

3 Panoramiciens pour un bug, çà c' est du travail d' équipe !
lol!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5062
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Un bug avec USER_EVENT ?   Dim 25 Juin 2017 - 21:04

Oui et pas des moindres, sur ce type de mots-clé nous ne sommes pas tous assez costauds. Very Happy

Une chose est certaine, une démonstration bien étayée aide Jack.

Bravo à tous les trois (heu... non quatre, Jack s'est aussi creusé la tête)

A+  cheers
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jack
Admin
avatar

Nombre de messages : 1768
Date d'inscription : 28/05/2007

MessageSujet: Re: Un bug avec USER_EVENT ?   Lun 26 Juin 2017 - 21:40

Le bug est corrigé.
La correction sera effective dans la prochaine version.

_________________
username : panoramic@jack-panoramic password : panoramic123
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://panoramic.free-boards.net
Yannick

avatar

Nombre de messages : 7997
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Lun 26 Juin 2017 - 23:16

cheers cheers Super !cheers cheers
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: Un bug avec USER_EVENT ?   

Revenir en haut Aller en bas
 
Un bug avec USER_EVENT ?
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» j ai des souci , je debute depuis ce jour avec linux fedora
» Lecture video interrompue avec mise en tampon
» probleme avec les cellules d'excel sur la mise en forme
» [Résolu]Mis a jour impossible avec Antivir
» [Résolu] Problème avec psg tv

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Un bug dans PANORAMIC?-
Sauter vers: