KGF_dll - nouvelles versions

' démo_toolbar_avec_bouton_de_sortie.bas

' Ce petit programme montre l'utilisation de la toolbar dans un programme Panoramic.
' La toolbar est un objet externe à Panoramic, créé par une fonction de KGF.dll
' et injecté dans une fenêtre du programme Panoramic.
'
' Chaque bouton de la toolbar est visualisé par une icône carrée, dont les
' dimensions en pixels sont précisées lors de la création de la toolbar.
' Toutes les icônes ont les mêmes dimensions. Les icônes peuvent être chargées
' à partir d'un fichier icône (*.ico), à partir de la bibliothèque interne ou
' à partir d'une bibliothèque fournie par l'utilisateur (*.ilb). Elles peuvent
' être également un séparateur (un espace vide non cliquable de la taille d'une icône)
' ou un diviseur (une barre verticale étroite non cliquable) pour les toolbar horizontales
'
' Lors de la création de la toolbar, on indique la fenêtre (form) dans laquelle
' elle devra apparaître, et un objet EDIT invisible qui recevra l'identifiant
' de chaque bouton cliqué, et dont l'évènement ON_CHANGE servira pour signaler
' un clic sur un des boutons de la toolbar.
'
' Chaque bouton est associé à un identifiant. C'est uune valeur entière 1, 2, ...
' qui servira à identifier le bouton cliqué, dans la routine ON_CHANGE du EDIT
' associé à la toolbar. C'est dans cette routine qu'il faut placer les traitements
' spécifiques pour chaque bouton.
'
' Pour pouvoir arrêter le programme Panoramic, il faut supprimer la toolbar avant
' de sortir. Sinon, on obtient en général des crashs (violation de mémoire ou autre).
' Ceci doit être fait dans une routine ON_CLOSE 0.
'
' Un cas particulier est à traiter d'une façon spéciale. Si l'on veut placer un
' bouton dans la toolbar dont l'action sera l'arrêt du programme. En effet, si
' l'on arrête simplement le programme par "termnate", on a alors un conflit: la
' routine ON_CLOSE de la form 0 sera appelée pour supprimer la toolbar, mais la
' routine évènement déclenchant det évènement est toujours en cours. Ceci provoque
' inévitablement un crash.
'
' Alors, la solution consiste à déclencher un autre évènement, avec un délai
' suffisamment long pour laisser la routine évènement du clic se terminer.
' Un timer Panoramic est parfaitement adapté à cela. On le programme pour un
' délai de 500 ms dans la routine ON_CHANGE de l'objet EDIT, puis cette routine
' se termine normalement. Lorsque le timer se déclenche, on stoppe le timer
' tout de suite, on supprime le timer, et maintenant, on peut supprimer la
' toolbar sans risque, puis décharger KGF.dll.
'
' Le programme suivant illustre ces techniques.

' les labels utilisés:
label click_toolbar  : ' routine évènement pour le clic des boutons
label close0         : ' appelé lors de la fermeture de form 0
label sortir         : ' appelé par le timer activé par le 3ème bouton

' variables diverses
dim res%, icon$, after%, hint$, yy%

' ouverture de KGF.dll
dll_on "KGF.dll"

' un objet EDIT caché par lequel la toolbar signale
' l'identification du bouton cliqué. Chaque clic charge
' l'identifiant du bouton dans cet objet EDIT, et son
' évènement ON_CHANGE déclenche alors la routone click_toolbar
' dans laquelle on va traiter le bouton cliqué.
edit 1 : hide 1
on_change 1,click_toolbar

' assurer une fermeture propre en supprimant la toolbar
on_close 0,close0

' création de la toolbar (horizontale en haut de la fenêtre)
' Les paramètres passés sont:
'   handle(0) = fenêtre dans laquelle la toolbar apparaîtra
'   handle(1) = objet EDIT recevant l'identification du bouton cliqué
'   0         = paramètre non utilisé pour le moment (extension future)
'   0         = position de la toolbar
'                 0=bord haut  1=bord gauche  2=bord bas  3=bord droit
res% = dll_call4("CreateToolbar",handle(0),handle(1),0,0)

' changement de la couleur de fond de la toolbar (jaune dans ce cas)
res% = dll_call4("ModifyToolbar",1,255,255,0)

' définition de la taille des icônes en pixels (défaut: 16)
res% = dll_call4("ModifyToolbar",7,16,0,0)

' changer la taille de la fenêtre et adapter la position de la toolbar
width 0, width(0) + 200
height 0,screen_y-40
res% = dll_call4("ModifyToolbar",2,0,0,0)
res% = dll_call4("ModifyToolbar",4,0,1,1)     : ' toolbar visible avec bordures
' res% = dll_call4("ModifyToolbar",4,0,1,1)     : ' toolbar visible sans bordures

' créer un premier bouton. Paramètres:
'   1          = identifiant du bouton (chargé dans lobjet EDIT en cliquant)
'   0-1        = valeur -1 pour dire "placer l'icône après la dernière icône présente"
'   adr(hint$) = texte de la bulle d'information
'   adr(icon$) = nom de l'icône
'                Possibilités:
'                   - nom de fichier *.ico
'                   - "KGF_n" pour choisir l'icône numéro n de la bibliothèque iinterne
'                   - "USER_n" pour choisir l'icône numéro n de la bibliothèque utilisateur
'                   - " "  (un espace) pour créer un séparateur (espace vide de la taille d'une icône
'                   - "" (chaîne vide) pour créer un diviseur (uniquement toolbars horizontales)
hint$ = ""
icon$ = "KGF_266"
res% = dll_call4("ModifyToolbar",7,16,3,0)    : ' curseur en forme de grande croix
res% = dll_call4("AddButtonToToolbar",1,0-1,adr(hint$),adr(icon$))

' créer un deuxième bouton
hint$ = ""
icon$ = "KGF_66"
res% = dll_call4("ModifyToolbar",7,16,17,0)    : ' curseur en forme de sablier SQL
res% = dll_call4("AddButtonToToolbar",2,0-1,adr(hint$),adr(icon$))

' créer un troisième bouton
hint$ = ""
icon$ = "KGF_204"
res% = dll_call4("ModifyToolbar",7,16,21,0)    : ' curseur en forme de main pointeuse
res% = dll_call4("AddButtonToToolbar",3,0-1,adr(hint$),adr(icon$))

end


' routine évènement lancée lorqu'un des boutons est cliqué
click_toolbar:
  ' récupérer l'identifiant du bouton cliqué
  yy%=val(text$(1))
  ' effectuer le traitement approprié pour chaque identifiant
  select yy%
    case 1
      message "Click sur bouton 1"
    case 2
      message "Click sur bouton 2"
    case 3
      ' utiliser le 3ème bouton comme bouton de sortie
      if object_exists(17)=0 then timer 17  : ' créer un timer si nécessaire
      timer_interval 17,500  : ' fixer l'interval à 500 ms
      on_timer 17,sortir     : ' indiquer le label pour l'évènement timer
  end_select
  return
  
  
' ici, le timer activé par le 3ème bouton a été déclenché. On veut sortir.
sortir:
  timer_off 17      : ' désactiver le timer
  ' demander confirmation (on peut supprimer cette ligne pour une sortie directe)
  if message_confirmation_yes_no("Voulez-vous vraiment sortir ?")<>1 then return
  ' on a accepté la sortie, donc continuer directement avec ce qui suit.
  ' ici, la form 0 est en train de fermer.
  ' On va supprimer la toolbar et décharger KGF.dll.
  ' supprimer complètement la toolbar
  ' paramètres:
  '   1     = suppression des boutons ET de la toolbar
  res% = dll_call2("GetToolbarInfo",1,0)   : ' tester si la toolbar existe
  if res%=1 then res% = dll_call1("RemoveToolbar",1)
  ' décharger la DLL, par sécurité.
  ' De fait, dans ce programme exemple, dll_off n'est pas nécessaire,
  ' mais c'est une bonne pratique de programmation de décharger ce qu'on a chargé.
  dll_off
  message "On sort..."
  ' la ligne suivante pourrait être "return" si on ne considère que le
  ' passage par l'évènement ON_CLOSE qui appelle la rourine close0.
  ' Mais, comme ce code peut aussi être exécuté à partir de l'évènement timer
  ' en activant la routine "sortir", il faut mettre "terminate" pour forcer
  ' l'arrêt du programme. Dans le cas d'une sortie par la croix rouge (ce qui
  ' déclenche l'évènement ON_CLOSE 0, la commande "terminate" agit exactement
  ' comme la commande "return".
  terminate
  
' fermeture de la fenêtre, par TERMINATE et par la croix rouge
close0:
  ' supprimer la toolbar si ce n'est pas déjà fait
  res% = dll_call2("GetToolbarInfo",1,0)   : ' tester si la toolbar existe
  if res%=1 then res% = dll_call1("RemoveToolbar",1)
  return

' test_SetObjectCursor.bas

dim res%

dll_on "KGF.dll"

edit 1 : top 1,10 : left 1,10
res% = dll_call2("SetObjectCursor",object_internal(1),17)

button 2 : top 2,10 : left 2,210 : caption 2,"test"
res% = dll_call2("SetObjectCursor",object_internal(2),21)

memo 3 : top 3,40 : left 3,10 : width 3,200 : height 3,200
res% = dll_call2("SetObjectCursor",object_internal(3),3)

panel 10 : top 10,40 : left 10,230 : width 10,200 : height 10,200
res% = dll_call2("SetObjectCursor",object_internal(10),10)

alpha 11 : parent 11,10 : top 11,20 : left 11,20 : caption 11,"Essai curseur sur ALPHA"
res% = dll_call2("SetObjectCursor",object_internal(11),15)

check 12 : parent 12,10 : top 12,50 : left 12,20 : caption 12,"Autre essai"
res% = dll_call2("SetObjectCursor",object_internal(12),19)


end

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' INTERFACE UTILISATEUR
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Gui()
  dim_local h%,w%,res%,hint$,icon$,vID%

  height 0,330
  width 0,440
  top 0,(screen_y-height(0))/2
  left 0,(screen_x-width(0))/2
  font_name 0,"Arial"
  font_size 0,8
  caption 0,"My Phone Book"
  on_close 0,close
 
  main_menu mm%
  sub_menu sm%(0) : parent sm%(0),mm%  : caption sm%(0),"Mode"
  sub_menu sm% (1): parent sm%(1),sm%(0) : caption sm%(1),"Enregistrement" : on_click sm%(1),clic
  sub_menu sm% (2): parent sm%(2),sm%(0) : caption sm%(2),"Modification"  : on_click sm%(2),clic
  sub_menu sm% (3): parent sm%(3),sm%(0) : caption sm%(3),"Visualisation"  : on_click sm%(3),clic
  sub_menu sm% (4): parent sm%(4),sm%(0) : caption sm%(4),"Recherche"      : on_click sm%(4),clic
  sub_menu sm% (5): parent sm%(5),sm%(0) : caption sm%(5),"-"
  sub_menu sm% (6): parent sm%(6),sm%(0) : caption sm%(6),"Quitter"        : on_click sm%(6),clic
 
  Panel frame0%
  full_space frame0%
  h% = height(frame0%)
  w% = width(frame0%)
 
  Panel frame1%
  parent frame1%,frame0%
  height frame1%,26
  width frame1%,w%
 
  Panel frame2%
  parent frame2%,frame0%
  height frame2%,h%-52
  width frame2%,w%
  top frame2%,26
 
  Panel frame3%
  parent frame3%,frame0%
  height frame3%,26
  width frame3%,w%
  top frame3%,height(frame1%)+height(frame2%)
 
  edit tbedit%
  hide tbedit%
  on_change tbedit%,change
 
  res% = dll_call4("CreateToolbar",handle(frame1%),handle(tbedit%),handle(frame2%),0)
  res% = dll_call4("ModifyToolbar",7,16,0,0)
  res% = dll_call4("ModifyToolbar",2,0,0,0)
  res% = dll_call4("ModifyToolbar",4,0,1,2)
  hint$= "Nouveau"
  icon$= ico1$
  res% = dll_call4("ModifyToolbar",7,16,21,0)
  res% = dll_call4("AddButtonToToolbar",1,0,adr(hint$),adr(icon$))
  hint$= "Enregistrer"
  icon$= ico2$
  res% = dll_call4("ModifyToolbar",7,16,21,0)
  res% = dll_call4("AddButtonToToolbar",2,1,adr(hint$),adr(icon$))
  hint$= "Supprimer"
  icon$= ico3$
  res% = dll_call4("ModifyToolbar",7,16,21,0)
  res% = dll_call4("AddButtonToToolbar",3,2,adr(hint$),adr(icon$))
  hint$= "Precedent"
  icon$= ico4$
  res% = dll_call4("ModifyToolbar",7,16,21,0)
  res% = dll_call4("AddButtonToToolbar",4,3,adr(hint$),adr(icon$))
  hint$= "Suivant"
  icon$= ico5$
  res% = dll_call4("ModifyToolbar",7,16,21,0)
  res% = dll_call4("AddButtonToToolbar",5,4,adr(hint$),adr(icon$))
  hint$= "Rechercher"
  icon$= ico6$
  res% = dll_call4("ModifyToolbar",7,16,21,0)
  res% = dll_call4("AddButtonToToolbar",6,5,adr(hint$),adr(icon$))
 
  Group%  = dll_call0("CreateObjectGroup")

  alpha alph%(1)
  parent alph%(1),frame2%
  top alph%(1),15
  left alph%(1),5
  font_bold alph%(1)
  caption alph%(1),"Nom :"
 
  edit Nom%
  parent Nom%,frame2%
  width Nom%,200
  top Nom%,30
  left Nom%,5
 
  Button Butt%(1)
  parent Butt%(1),frame2%
  height Butt%(1),20
  width Butt%(1),20
  top Butt%(1),30
  left Butt%(1),210
  font_bold Butt%(1)
  caption Butt%(1),"<"
  cursor_point Butt%(1)
  on_click Butt%(1),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(1)))
 
  Button Butt%(2)
  parent Butt%(2),frame2%
  height Butt%(2),20
  width Butt%(2),20
  top Butt%(2),30
  left Butt%(2),230
  font_bold Butt%(2)
  caption Butt%(2),">"
  cursor_point Butt%(2)
  on_click Butt%(2),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(2)))
 
  alpha alph%(2)
  parent alph%(2),frame2%
  top alph%(2),55
  left alph%(2),5
  font_bold alph%(2)
  caption alph%(2),"Prénom :"
 
  edit Prenom%
  parent Prenom%,frame2%
  width Prenom%,200
  top Prenom%,70
  left Prenom%,5
 
  Button Butt%(3)
  parent Butt%(3),frame2%
  height Butt%(3),20
  width Butt%(3),20
  top Butt%(3),70
  left Butt%(3),210
  font_bold Butt%(3)
  caption Butt%(3),"<"
  cursor_point Butt%(3)
  on_click Butt%(3),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(3)))

  Button Butt%(4)
  parent Butt%(4),frame2%
  height Butt%(4),20
  width Butt%(4),20
  top Butt%(4),70
  left Butt%(4),230
  font_bold Butt%(4)
  caption Butt%(4),">"
  cursor_point Butt%(4)
  on_click Butt%(4),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(4)))
 
  alpha alph%(3)
  parent alph%(3),frame2%
  top alph%(3),95
  left alph%(3),5
  font_bold alph%(3)
  caption alph%(3),"Tel (domicile) :"
 
  edit Tel%
  parent Tel%,frame2%
  width Tel%,85
  top Tel%,110
  left Tel%,5
 
  Button Butt%(5)
  parent Butt%(5),frame2%
  height Butt%(5),20
  width Butt%(5),20
  top Butt%(5),110
  left Butt%(5),95
  font_bold Butt%(5)
  caption Butt%(5),"<"
  cursor_point Butt%(5)
  on_click Butt%(5),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(5)))

  Button Butt%(6)
  parent Butt%(6),frame2%
  height Butt%(6),20
  width Butt%(6),20
  top Butt%(6),110
  left Butt%(6),115
  font_bold Butt%(6)
  caption Butt%(6),">"
  cursor_point Butt%(6)
  on_click Butt%(6),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(6)))

  alpha alph%(4)
  parent alph%(4),frame2%
  top alph%(4),135
  left alph%(4),5
  font_bold alph%(4)
  caption alph%(4),"Tel (portable) :"
 
  edit Port%
  parent Port%,frame2%
  width Port%,85
  top Port%,150
  left Port%,5
 
  Button Butt%(7)
  parent Butt%(7),frame2%
  height Butt%(7),20
  width Butt%(7),20
  top Butt%(7),150
  left Butt%(7),95
  font_bold Butt%(7)
  caption Butt%(7),"<"
  cursor_point Butt%(7)
  on_click Butt%(7),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(7)))

  Button Butt%(8)
  parent Butt%(8),frame2%
  height Butt%(8),20
  width Butt%(8),20
  top Butt%(8),150
  left Butt%(8),115
  font_bold Butt%(8)
  caption Butt%(8),">"
  cursor_point Butt%(8)
  on_click Butt%(8),clic
  res% = dll_call2("AddObjectToObjectGroup",Group%,object_internal(Butt%(8)))
 
  alpha alph%(5)
  parent alph%(5),frame2%
  top alph%(5),175
  left alph%(5),5
  font_bold alph%(5)
  caption alph%(5),"Mail :"
 
  edit Mail%
  parent Mail%,frame2%
  width Mail%,350
  top Mail%,190
  left Mail%,5
 
  edit ID%
  hide ID%
  if text$(ID%)<>"" : vID%=val(text$(ID%)): else : vID%=0 : end_if
 
  picture carte%
  parent carte%,frame2%
  height carte%,200
  width carte%,210
  top carte%,5
  left carte%,210
  file_load carte%,carte$
  stretch_on carte%

 
  alpha alph%(6)
  parent alph%(6),frame3%
  top alph%(6),5
  font_bold alph%(6)
  caption alph%(6),"Enregistrement : "+str$(vID%)+" / "+str$(inbase%)
  left alph%(6),w%-(width(alph%(6))+5)

  SelectMode(mode%)
END_SUB

' test_SetObjectShape.bas

label clic

dim res%, etat%

memo 1 :top 1,10 : left 1,10                  : color 1,200,200,255
memo 2 :top 2,10 : left 2,210 : bar_both 2    : color 2,200,200,255
button 3 : top 3,100 : left 3,10 : caption 3,"Essai"  : on_click 3,clic
edit 4  : top 4,100 : left 4,110            : color 4,200,200,255
panel 5  : top 5,130 : left 5,10              : color 5,200,200,255



dll_on "KGF.dll"


end

clic:
  etat% = 1 - etat%  : ' 1=arrondi  0=rectangulaire
  res% = dll_call6("SetRoundObjectCorners",object_internal(1),etat%,0,0,0,0)
  res% = dll_call6("SetRoundObjectCorners",object_internal(2),etat%,0,0,20,20) : ' pour capter les barres
  res% = dll_call6("SetRoundObjectCorners",object_internal(3),etat%,2*etat%,2*etat%,(0-2)*etat%,(0-2)*etat%) : ' 2 pixels bords du bouton
  res% = dll_call6("SetRoundObjectCorners",object_internal(4),etat%,0,0,0,0)
  res% = dll_call6("SetRoundObjectCorners",object_internal(5),etat%,0,0,0,0)
  return

' test_SetObjectShape.bas

label clic, sel

dim res%, etat%, s$

memo 1 :top 1,10 : left 1,10                  : color 1,200,200,255
memo 2 :top 2,10 : left 2,210 : bar_both 2    : color 2,200,200,255
button 3 : top 3,100 : left 3,10 : caption 3,"Essai"  : on_click 3,clic
edit 4  : top 4,100 : left 4,110            : color 4,200,200,255
panel 5  : top 5,130 : left 5,10              : color 5,200,200,255

list 10 : top 10,250 : left 10,10 : width 10,500 : height 10,100 : on_click 10,sel
list 11 : top 11,360 : left 11,10 : width 11,500 : height 11,80



dll_on "KGF.dll"

res% = dll_call0("CheckIfThemeActive")
if res%=1
  message "Thème activé"
  ' res% = dll_call2("ActivateThemes",handle(0),0)
  res% = dll_call1("GetInstalledThemes",handle(10))
  res% = dll_call1("GetActualTheme",handle(11))
else
  message "pas de thème"
end_if
end

clic:
  etat% = 1 - etat%  : ' 1=arrondi  0=rectangulaire
  res% = dll_call6("SetRoundObjectCorners",object_internal(1),etat%,0,0,0,0)
  res% = dll_call6("SetRoundObjectCorners",object_internal(2),etat%,0,0,20,20) : ' pour capter les barres
  res% = dll_call6("SetRoundObjectCorners",object_internal(3),etat%,2*etat%,2*etat%,(0-2)*etat%,(0-2)*etat%) : ' 2 pixels bords du bouton
  res% = dll_call6("SetRoundObjectCorners",object_internal(4),etat%,0,0,0,0)
  res% = dll_call6("SetRoundObjectCorners",object_internal(5),etat%,0,0,0,0)
  return
 
sel:
  s$ = item_index$(10)
  if instr(s$,".theme")=0 then return
  if message_confirmation_yes_no("Voulez-vous vraiment activer le thème "+file_extract_name$(s$)+" ?")=1
    res% = dll_call1("SetGlobalWindowTheme",adr(s$))
'    s$ = "C:\windows\system32\control.exe desk.cpl,Themes,@Themes"
'    execute s$
  end_if
  return