KGF_dll - nouvelles versions

Houston...on a un problème...

J' ai placé la fonction 32 juste derrière la 1 en autorisant la saisi direct.
Dans la fonction 32, j' ai déclaré le handle d' un Edit dédié à cette fonction.

rien ne s' affiche dedans et si je sors par un clic sur une autre cellule, j' ai un petit message

KGF_dll - nouvelles versions - Page 28 Captur32

Recharge simplement la DLL - tu as dû la prendre entre 2 mises à jour de la part.

J' ai repris la dll sur ton webdav, Idem.

KGF_dll - nouvelles versions - Page 28 Captur33

Ps : Lors de la sortie (fermeture de l' appli), je retrouve le message : contrôle " sans fenêtre parente.

KGF_dll - nouvelles versions - Page 28 Captur34

mais pas tout le temps.
seulement si je valide la saisi direct par la touche entrée ou retour-chariot (entrée)

Edit :

Tu disais plus haut qu' il y avait des tas de façon de quitter une cellule en saisi direct.
Chez moi, les seules touches qui valident la saisi direct,
dans l' état des autorisations que l' on peut donner actuellement,
sont les deux touches "Entrée" du clavier.
Là et seulement là, les données entrées sont validées car, là et seulement là, je retrouve mon formatage couleur des cellules
et sélectionner une autre cellule sans le premier message.
Par contre, je n' ai toujours rien dans l' "Edit".

J'ai dû me planter avec les copies. J'ai tout remis à jour: WebDav et les deux sites. Chez moi, avec le programme de démo ci-après:

Code:: ' test_GridFunction_code_12.bas

' Ce programme teste le code 12 de GridFunction.
' Ce code permet de définir des rectangles dans un GRID
' pour lesquels la sélection est interdite.

label clic, sortir

GridConstants() : ' définir des constantes pour le code fonction de GridFunction

dim res%, l%, c%, RGB%, s$, x%, y%, status%, SG%, SG2%, SGclic%
dim M1% : M1% = 0 - 1
dim stat$(3)
stat$(0) = "Normal"
stat$(1) = "Libre"
stat$(2) = "Sélectionnable"
stat$(3) = "Bloqué"

dll_on "KGF.dll"

width 0,690 : height 0,310

edit 97 : ' hide 97
top 97,300 : width 97,180 : left 97,250
edit 98 : ' hide 98
top 98,300 : width 98,130 : on_change 98,clic
height 0,380

memo 99 : hide 99
item_add 99,"Width=660"
item_add 99,"Height=260"
item_add 99,"Rows=10"
item_add 99,"Columns=10"
item_add 99,"FixedRows=1"
item_add 99,"FixedColumns=1"
SG% = dll_call3("CreateStringGrid",handle(0),handle(99),handle(98))
s$ = string$(255," ")
res% = dll_call6("GridFunction",SG%,GF_GetVersion,adr(s$),0,0,0)
caption 0,"Objet StringGrid "+trim$(s$)

for l%=1 to 10
for c%=1 to 10
s$ = str$(c%)+","+str$(l%)
res% = dll_call4("WriteGridCell",SG%,c%,l%,adr(s$))
next c%
next l%
s$ = "ABCD"
res% = dll_call4("WriteGridCell",SG%,9,4,adr(s$))
' passer la colonne 9 en gras, italique et cadrée à droite
res% = dll_call6("GridFunction",SG%,GF_TextAttributes,9*65536,GF_Bold%+GF_Italic%+GF_Right%,0,0)
' passer la colonne 6 en cadrage centré
res% = dll_call6("GridFunction",SG%,GF_TextAttributes,6*65536,GF_Center%,0,0)
res% = dll_call6("GridFunction",SG%,GF_TextAttributes,0,0,0,0)

s$ = "10"
res% = dll_call4("WriteGridCell",SG%,6,10,adr(s$))
s$ = "80"
res% = dll_call4("WriteGridCell",SG%,7,10,adr(s$))

width 0,920
memo 2 : width 2,200 : left 2,660+20 : ' width(1)+20
height 2,260 : ' height(1)
font_name 2,"Courier"
display

button 3 : top 3,300 : left 3,150 : caption 3,"Sortir" : on_click 3,sortir

' première zone interdite totalement
res% = dll_call6("GridFunction",SG%,GF_SetNonSelRect,3,2,5,3)

' seconde zone interdite en saisie uniquement
res% = dll_call6("GridFunction",SG%,GF_SetNonModRect,7,4,8,5)

' troisième zone CheckBox à gauche
res% = dll_call6("GridFunction",SG%,GF_SetLeftCB,4,6,4,9)

' quatrième zone CheckBox à droite
res% = dll_call6("GridFunction",SG%,GF_SetRightCB,6,7,9,8)

' Cinquième zone CheckBox à gauche dans zone interdite
res% = dll_call6("GridFunction",SG%,GF_SetLeftCB,4,2,4,3)

' Sixième zone CheckBox à droite dans zone protégée
res% = dll_call6("GridFunction",SG%,GF_SetLeftCB,7,4,7,5)

' taille et couleur des ProgressBars
res% = dll_call6("GridFunction",SG%,GF_SetProgressBarAttrib,12,255,0,0)
' Septième zone ProgressBar
res% = dll_call6("GridFunction",SG%,GF_SetProgressBar,6,10,7,10)

' huitième zone "cellules formatées" comme date
s$ = date$
for l%=4 to 7
for c%=2 to 3
res% = dll_call4("WriteGridCell",SG%,c%,l%,adr(s$))
next c%
next l%
s$ = "dd mmmm yyyy"
res% = dll_call6("GridFunction",SG%,GF_SetFormat,2*65536+4,3*65536+7,2,adr(s$))

' activer les couleurs personnalisées
res% = dll_call6("GridFunction",SG%,GF_ActivateResetColor,1,0,0,0)

RGB(255,200,200)
for l%=2 to 3
for c%=3 to 3 : ' 5
' couleur de la première zone interdite
res% = dll_call6("GridFunction",SG%,GF_CellColor,c%,l%,RGB%,0)
next c%
next l%

RGB(200,200,255)
for l%=4 to 5
for c%=7 to 8
' couleur de la seconde zone interdite
res% = dll_call6("GridFunction",SG%,GF_CellColor,c%,l%,RGB%,0)
next c%
next l%

' utiliser la ImageList interne
res% = dll_call6("GridFunction",SG%,GF_SetIconLib,2,0,0,0)

' icône 3 sur colonne 5, à gauche
res% = dll_call6("GridFunction",SG%,GF_SetIconID,5,0,1,3)
' icône 4 sur cellule 5,3, à droite
res% = dll_call6("GridFunction",SG%,GF_SetIconID,5,3,2,4)

' chercher la map du grid
s$ = string$(3000," ")
res% = dll_call2("GetGridCellMap",SG%,adr(s$))
text 2,trim$(s$)

' autoriser la saisie
res% = dll_call6("GridFunction",SG%,GF_Edit,1,0,0,0)

' sauvegarder l'objet
s$ = "Sauvegarde_StringGrid.txt"
res% = dll_call3("SaveGridToFile",SG%,0,adr(s$))
' créer une autre form avec un autre grid
form 300 : width 300,690 : height 300,310 : caption 300,"Grille restaurée"
top 300,200 : left 300,450
clear 99
item_add 99,"Width=100"
item_add 99,"Height=100"
item_add 99,"Rows=2"
item_add 99,"Columns=2"
item_add 99,"FixedRows=1"
item_add 99,"FixedColumns=1"
SG2% = dll_call3("CreateStringGrid",handle(300),handle(99),handle(98))

' restaurer l'objet dans un autre grid
s$ = "Sauvegarde_StringGrid.txt"
res% = dll_call3("LoadGridFromFile",SG2%,0,adr(s$))

' effacer le grid d'origine
res% = dll_call6("GridFunction",SG%,GF_Clear,0,0,0,0)

' effacer le grid copié
res% = dll_call6("GridFunction",SG2%,GF_Clear,0,0,0,0)

' charger juste les données dans le grid copié (la structure est restée intacte)
s$ = "Sauvegarde_StringGrid.txt"
res% = dll_call3("LoadGridFromFile",SG2%,1,adr(s$))

' déclarer le EDIT pour le changement de cellules
res% = dll_call6("GridFunction",SG2%,CellChangeEditHandle,handle(97),0,0,0)

end

sub RGB(R%,G%,B%) : ' produire une valeur RGB valide
RGB% = (B%*256+R%)*256+G%
end_sub

sortir:
message "sauvegarde"
s$ = "Sauvegarde_StringGrid2.txt"
res% = dll_call3("SaveGridToFile",SG2%,0,adr(s$))
message "fini"
res% = dll_call1("KillProcessByHandle",handle(0))

clic:
' caption 0,text$(98) : ' ici, on a déjà le numéro de ligne et de colonne dans Edit 98 !
s$ = text$(98)
s$ = mid$(s$,3,len(s$))
SGclic% = val(left$(s$,instr(s$,"click=")-1))

res% = dll_call6("GridFunction",SGclic%,GF_GetActiveCell,adr(x%),adr(y%),adr(status%),0)
s$ = string$(255," ")
res% = dll_call4("GetGridCellText",SGclic%,x%,y%,adr(s$))
caption 0, "click colonne "+str$(x%) +" ligne "+str$(y%)+" "+stat$(status%+1)+" = "+trim$(s$)
s$ = string$(255," ")
res% = dll_call3("GetGridRowText",SGclic%,y%,adr(s$))
message "Ligne="+trim$(s$)
s$ = string$(255," ")
res% = dll_call3("GetGridColumnText",SGclic%,x%,adr(s$))
message "Colonne="+trim$(s$)
return

' définition de constantes pour le code fonction de GridFunction
sub GridConstants()
if variable("GF_Edit")=1 then exit_sub
dim GF_Edit : GF_Edit = 1 : ' saisie directe dans le GRID
dim GF_CellColor : GF_CellColor = 2 : ' couleur d'une cellule
dim GF_RowColor : GF_RowColor = 3 : ' couleur d'une ligne
dim GF_ColColor : GF_ColColor = 4 : ' couleur d'une colonne
dim GF_ActivateColor : GF_ActivateColor = 5 : ' activer les couleurs personnalisées
dim GF_NormalRowColor : GF_NormalRowColor = 6 : ' couleur d'une ligne (sans parties fixes)
dim GF_NormalColColor : GF_NormalColColor = 7 : ' couleur d'une colonne (sans parties fixes)
dim GF_ActivateResetColor : GF_ActivateResetColor = 8 : ' activer les couleurs personnalisées (effacer liste existante)
dim GF_TextAttributes : GF_TextAttributes = 9 : ' attributs du texte
dim GF_ClearTextAttrib : GF_ClearTextAttrib = 10 : ' effacer tous les attributs pour le GRID
dim GF_GetDimensions : GF_GetDimensions = 11 : ' retourner les dimensions du GRID
dim GF_SetNonSelRect : GF_SetNonSelRect = 12 : ' définir un rectangle intouchable
dim GF_SetNonModRect : GF_SetNonModRect = 13 : ' définir un rectangle non modifiable
dim GF_GetActiveCell : GF_GetActiveCell = 14 : ' retourner les infos de la cellule active
dim GF_SetLeftCB : GF_SetLeftCB = 15 : ' définir un rectangle de CheckBox gauches
dim GF_SetRightCB : GF_SetRightCB = 16 : ' définir un rectangle de CheckBox droites
dim GF_SetRowHeight : GF_SetRowHeight = 17 : ' définit la hauteur de lignes
dim GF_SetColWidth : GF_SetColWidth = 18 : ' définir la largeur de colonnes
dim GF_InsertRow : GF_InsertRow = 19 : ' insérer une ligne
dim GF_InsertCol : GF_InsertCol = 20 : ' insérer une colonne
dim GF_RemoveRow : GF_RemoveRow = 21 : ' supprimer une ligne
dim GF_RemoveCol : GF_RemoveCol = 22 : ' supprimer une colonne
dim GF_Clear : GF_Clear = 23 : ' effacer toutes les données
dim GF_GetVersion : GF_GetVersion = 24 : ' retourner la version dans un string
dim GF_SetProgressBar : GF_SetProgressBar = 25 : ' définir un rectangle de ProgressBar
dim GF_SetProgressBarAttrib : GF_SetProgressBarAttrib = 26 : ' définir hauteur et couleur des ProgrssBars
dim GF_SetIconLib : GF_SetIconLib = 27 : ' définir la ImageList des icones
dim GF_SetIconID : GF_SetIconID = 28 : ' définir un numéro d'icône pour une zone
dim GF_SetFormat : GF_SetFormat = 29 : ' définir un rectabngle de cellules avec n format
dim GF_Scroll : GF_Scroll = 30 : ' scroller jusqu'à une ligne donnée
dim GF_ScrollBars : GF_ScrollBars = 31 : ' autoriser les scrollbars ou non
dim CellChangeEditHandle : CellChangeEditHandle = 32 : ' handle d'un EDIT recevant les messages de changement de cellule

dim GF_Bold% : GF_Bold% = 256 : ' texte en gras
dim GF_Italic% : GF_Italic% = 512 : ' texte en italique
dim GF_Underline% : GF_Underline% = 1024 : ' texte souligné
dim GF_Strikeout% : GF_Strikeout% = 2048 : ' texte barré
dim GF_Left% : GF_Left% = 0 : ' cadré à gauche
dim GF_Center% : GF_Center% = 4096 : ' centré
dim GF_Right% : GF_Right% = 8192 : ' cadré à droite

dim GF_No : GF_No = 0 : ' pour différentes options
dim GF_Yes : GF_Yes = 1 : ' pour différentes options
end_sub

je produis ceci:

KGF_dll - nouvelles versions - Page 28 Aa129

en cliquant d'abord dans la cellule (10, Cool

(pas de réaction bien sûr dans le EDIT en bas à droite, puis dans la cellule (10,7) ==> réaction dans le EDIT en bas à droite signalant qu'on vient de quitter la (10, Cool

, avec ses données.

KGF.dll V6.75 du 25/05/2016

Nouveautés:
- GridFunction code 32: utilisation du paramètre par2%

Modules modifiés:
KGF.dll
KGF.chm

La doc et les sources sources sont à jour.

Ce paramètre, pas encore utilisé dans la version précédente, permet de définir dans quelles conditions le fait de quitter une cellule sera signalé:
0 = uniquement si les données de la cellule ont été changées
1 = à chaque sortie de cellule (valeur par défaut)

Dans le programme de démo suivant, on peut choisir l'une ou l'autre version, en activant ou désactivant une des lignes 173 ou 175 (elles sont commentées):

Code:: ' test_GridFunction_code_12.bas

' Ce programme teste le code 12 de GridFunction.
' Ce code permet de définir des rectangles dans un GRID
' pour lesquels la sélection est interdite.

label clic, sortir

GridConstants() : ' définir des constantes pour le code fonction de GridFunction

dim res%, l%, c%, RGB%, s$, x%, y%, status%, SG%, SG2%, SGclic%
dim M1% : M1% = 0 - 1
dim stat$(3)
  stat$(0) = "Normal"
  stat$(1) = "Libre"
  stat$(2) = "Sélectionnable"
  stat$(3) = "Bloqué"

dll_on "KGF.dll"

width 0,690 : height 0,310

edit 97 : ' hide 97
  top 97,300 : width 97,180 : left 97,250
edit 98 : ' hide 98
  top 98,300 : width 98,130 : on_change 98,clic
height 0,380

memo 99 : hide 99
  item_add 99,"Width=660"
  item_add 99,"Height=260"
  item_add 99,"Rows=10"
  item_add 99,"Columns=10"
  item_add 99,"FixedRows=1"
  item_add 99,"FixedColumns=1"
SG% = dll_call3("CreateStringGrid",handle(0),handle(99),handle(98))
s$ = string$(255," ")
res% = dll_call6("GridFunction",SG%,GF_GetVersion,adr(s$),0,0,0)
caption 0,"Objet StringGrid "+trim$(s$)

for l%=1 to 10
  for c%=1 to 10
   s$ = str$(c%)+","+str$(l%)
   res% = dll_call4("WriteGridCell",SG%,c%,l%,adr(s$))
  next c%
next l%
s$ = "ABCD"
res% = dll_call4("WriteGridCell",SG%,9,4,adr(s$))
' passer la colonne 9 en gras, italique et cadrée à droite
res% = dll_call6("GridFunction",SG%,GF_TextAttributes,9*65536,GF_Bold%+GF_Italic%+GF_Right%,0,0)
' passer la colonne 6 en cadrage centré
res% = dll_call6("GridFunction",SG%,GF_TextAttributes,6*65536,GF_Center%,0,0)
res% = dll_call6("GridFunction",SG%,GF_TextAttributes,0,0,0,0)

s$ = "10"
res% = dll_call4("WriteGridCell",SG%,6,10,adr(s$))
s$ = "80"
res% = dll_call4("WriteGridCell",SG%,7,10,adr(s$))

width 0,920
memo 2 : width 2,200 : left 2,660+20 : ' width(1)+20
height 2,260 : ' height(1)
font_name 2,"Courier"
display

button 3 : top 3,300 : left 3,150 : caption 3,"Sortir" : on_click 3,sortir

' première zone interdite totalement
res% = dll_call6("GridFunction",SG%,GF_SetNonSelRect,3,2,5,3)

' seconde zone interdite en saisie uniquement
res% = dll_call6("GridFunction",SG%,GF_SetNonModRect,7,4,8,5)

' troisième zone CheckBox à gauche
res% = dll_call6("GridFunction",SG%,GF_SetLeftCB,4,6,4,9)

' quatrième zone CheckBox à droite
res% = dll_call6("GridFunction",SG%,GF_SetRightCB,6,7,9,8)

' Cinquième zone CheckBox à gauche dans zone interdite
res% = dll_call6("GridFunction",SG%,GF_SetLeftCB,4,2,4,3)

' Sixième zone CheckBox à droite dans zone protégée
res% = dll_call6("GridFunction",SG%,GF_SetLeftCB,7,4,7,5)

' taille et couleur des ProgressBars
res% = dll_call6("GridFunction",SG%,GF_SetProgressBarAttrib,12,255,0,0)
' Septième zone ProgressBar
res% = dll_call6("GridFunction",SG%,GF_SetProgressBar,6,10,7,10)

' huitième zone "cellules formatées" comme date
s$ = date$
for l%=4 to 7
  for c%=2 to 3
   res% = dll_call4("WriteGridCell",SG%,c%,l%,adr(s$))
  next c%
next l%
s$ = "dd mmmm yyyy"
res% = dll_call6("GridFunction",SG%,GF_SetFormat,2*65536+4,3*65536+7,2,adr(s$))

' activer les couleurs personnalisées
res% = dll_call6("GridFunction",SG%,GF_ActivateResetColor,1,0,0,0)

RGB(255,200,200)
for l%=2 to 3
  for c%=3 to 3 : ' 5
   ' couleur de la première zone interdite
   res% = dll_call6("GridFunction",SG%,GF_CellColor,c%,l%,RGB%,0)
  next c%
next l%

RGB(200,200,255)
for l%=4 to 5
  for c%=7 to 8
   ' couleur de la seconde zone interdite
   res% = dll_call6("GridFunction",SG%,GF_CellColor,c%,l%,RGB%,0)
  next c%
next l%

' utiliser la ImageList interne
res% = dll_call6("GridFunction",SG%,GF_SetIconLib,2,0,0,0)

' icône 3 sur colonne 5, à gauche
res% = dll_call6("GridFunction",SG%,GF_SetIconID,5,0,1,3)
' icône 4 sur cellule 5,3, à droite
res% = dll_call6("GridFunction",SG%,GF_SetIconID,5,3,2,4)

' chercher la map du grid
s$ = string$(3000," ")
res% = dll_call2("GetGridCellMap",SG%,adr(s$))
text 2,trim$(s$)

' autoriser la saisie
res% = dll_call6("GridFunction",SG%,GF_Edit,1,0,0,0)

' sauvegarder l'objet
s$ = "Sauvegarde_StringGrid.txt"
res% = dll_call3("SaveGridToFile",SG%,0,adr(s$))
' créer une autre form avec un autre grid
form 300 : width 300,690 : height 300,310 : caption 300,"Grille restaurée"
  top 300,200 : left 300,450
  clear 99
  item_add 99,"Width=100"
  item_add 99,"Height=100"
  item_add 99,"Rows=2"
  item_add 99,"Columns=2"
  item_add 99,"FixedRows=1"
  item_add 99,"FixedColumns=1"
SG2% = dll_call3("CreateStringGrid",handle(300),handle(99),handle(98))

' restaurer l'objet dans un autre grid
s$ = "Sauvegarde_StringGrid.txt"
res% = dll_call3("LoadGridFromFile",SG2%,0,adr(s$))

' effacer le grid d'origine
res% = dll_call6("GridFunction",SG%,GF_Clear,0,0,0,0)

' effacer le grid copié
res% = dll_call6("GridFunction",SG2%,GF_Clear,0,0,0,0)

' charger juste les données dans le grid copié (la structure est restée intacte)
s$ = "Sauvegarde_StringGrid.txt"
res% = dll_call3("LoadGridFromFile",SG2%,1,adr(s$))

' déclarer le EDIT pour le changement de cellules
' choisir une des deux solutions suivantes:
  ' avec par2%=1 pour signaler toutes les sorties d'une cellule
   res% = dll_call6("GridFunction",SG2%,CellChangeEditHandle,handle(97),GF_Yes,0,0)
  ' avec par2%=0 pour signaler uniquement les sorties d'une cellule modifiée
   ' res% = dll_call6("GridFunction",SG2%,CellChangeEditHandle,handle(97),GF_No,0,0)

end

sub RGB(R%,G%,B%) : ' produire une valeur RGB valide
RGB% = (B%*256+R%)*256+G%
end_sub

sortir:
  message "sauvegarde"
  s$ = "Sauvegarde_StringGrid2.txt"
  res% = dll_call3("SaveGridToFile",SG2%,0,adr(s$))
  message "fini"
  res% = dll_call1("KillProcessByHandle",handle(0))

clic:
' caption 0,text$(98) : ' ici, on a déjà le numéro de ligne et de colonne dans Edit 98 !
  s$ = text$(98)
  s$ = mid$(s$,3,len(s$))
  SGclic% = val(left$(s$,instr(s$,"click=")-1))

  res% = dll_call6("GridFunction",SGclic%,GF_GetActiveCell,adr(x%),adr(y%),adr(status%),0)
  s$ = string$(255," ")
  res% = dll_call4("GetGridCellText",SGclic%,x%,y%,adr(s$))
  caption 0, "click colonne "+str$(x%) +" ligne "+str$(y%)+" "+stat$(status%+1)+" = "+trim$(s$)
  s$ = string$(255," ")
  res% = dll_call3("GetGridRowText",SGclic%,y%,adr(s$))
  message "Ligne="+trim$(s$)
  s$ = string$(255," ")
  res% = dll_call3("GetGridColumnText",SGclic%,x%,adr(s$))
  message "Colonne="+trim$(s$)
  return


' définition de constantes pour le code fonction de GridFunction
sub GridConstants()
  if variable("GF_Edit")=1 then exit_sub
  dim GF_Edit : GF_Edit = 1 : ' saisie directe dans le GRID
  dim GF_CellColor : GF_CellColor = 2 : ' couleur d'une cellule
  dim GF_RowColor : GF_RowColor = 3 : ' couleur d'une ligne
  dim GF_ColColor : GF_ColColor = 4 : ' couleur d'une colonne
  dim GF_ActivateColor : GF_ActivateColor = 5 : ' activer les couleurs personnalisées
  dim GF_NormalRowColor : GF_NormalRowColor = 6 : ' couleur d'une ligne (sans parties fixes)
  dim GF_NormalColColor : GF_NormalColColor = 7 : ' couleur d'une colonne (sans parties fixes)
  dim GF_ActivateResetColor : GF_ActivateResetColor = 8 : ' activer les couleurs personnalisées (effacer liste existante)
  dim GF_TextAttributes : GF_TextAttributes = 9 : ' attributs du texte
  dim GF_ClearTextAttrib : GF_ClearTextAttrib = 10 : ' effacer tous les attributs pour le GRID
  dim GF_GetDimensions : GF_GetDimensions = 11 : ' retourner les dimensions du GRID
  dim GF_SetNonSelRect : GF_SetNonSelRect = 12 : ' définir un rectangle intouchable
  dim GF_SetNonModRect : GF_SetNonModRect = 13 : ' définir un rectangle non modifiable
  dim GF_GetActiveCell : GF_GetActiveCell = 14 : ' retourner les infos de la cellule active
  dim GF_SetLeftCB : GF_SetLeftCB = 15 : ' définir un rectangle de CheckBox gauches
  dim GF_SetRightCB : GF_SetRightCB = 16 : ' définir un rectangle de CheckBox droites
  dim GF_SetRowHeight : GF_SetRowHeight = 17 : ' définit la hauteur de lignes
  dim GF_SetColWidth : GF_SetColWidth = 18 : ' définir la largeur de colonnes
  dim GF_InsertRow : GF_InsertRow = 19 : ' insérer une ligne
  dim GF_InsertCol : GF_InsertCol = 20 : ' insérer une colonne
  dim GF_RemoveRow : GF_RemoveRow = 21 : ' supprimer une ligne
  dim GF_RemoveCol : GF_RemoveCol = 22 : ' supprimer une colonne
  dim GF_Clear : GF_Clear = 23 : ' effacer toutes les données
  dim GF_GetVersion : GF_GetVersion = 24 : ' retourner la version dans un string
  dim GF_SetProgressBar : GF_SetProgressBar = 25 : ' définir un rectangle de ProgressBar
  dim GF_SetProgressBarAttrib : GF_SetProgressBarAttrib = 26 : ' définir hauteur et couleur des ProgrssBars
  dim GF_SetIconLib : GF_SetIconLib = 27 : ' définir la ImageList des icones
  dim GF_SetIconID : GF_SetIconID = 28 : ' définir un numéro d'icône pour une zone
  dim GF_SetFormat : GF_SetFormat = 29 : ' définir un rectabngle de cellules avec n format
  dim GF_Scroll : GF_Scroll = 30 : ' scroller jusqu'à une ligne donnée
  dim GF_ScrollBars : GF_ScrollBars = 31 : ' autoriser les scrollbars ou non
  dim CellChangeEditHandle : CellChangeEditHandle = 32 : ' handle d'un EDIT recevant les messages de changement de cellule

  dim GF_Bold% : GF_Bold% = 256 : ' texte en gras
  dim GF_Italic% : GF_Italic% = 512 : ' texte en italique
  dim GF_Underline% : GF_Underline% = 1024 : ' texte souligné
  dim GF_Strikeout% : GF_Strikeout% = 2048 : ' texte barré
  dim GF_Left% : GF_Left% = 0 : ' cadré à gauche
  dim GF_Center% : GF_Center% = 4096 : ' centré
  dim GF_Right% : GF_Right% = 8192 : ' cadré à droite

  dim GF_No : GF_No = 0 : ' pour différentes options
  dim GF_Yes : GF_Yes = 1 : ' pour différentes options
end_sub

Cette option permet d'être averti lorsque le contenu d'une cellule a été changé par saisie directe, et ce au moment de la sortie de la cellule, quelque soit le moyen de sortie de cette cellule. Même si l'utilisateur, après avoir saisi du texte, clique dans un autre objet de la form, ou même s'il clique dans un tout autre programme, l'évènement de changement de données sera activé, et on peut alors intervenir de façon ciblée. Aucun évènement n'a lieu si les données de la cellule n'ont pas été modifiées et si GridFunction code 32 a été appelée avec par2%=0.

J' ai téléchargé la nouvelle version mais les essais seront pour demain.
Sleep

La page de l'objet StringGrid a été complétée pour mieux documenter les deux types d'évènement gérés maintenant par cet objet: ON_CLICK et ON_CELL_EXIT.

J' ai encore le message en sorti mais pas tout le temps.
Je vais te faire un source avec un petit fichier contenant la procédure pour avoir ce message.
Pas tout de suite, il faut que je sorte avant la prochaine douche céleste.
Laughing

Je viens de mettre PanoBudget sur mon webdav.
Ce n' est pas court mais il faut que tu vois le comportement dans son contexte.

Lances l' appli, charge "Save.txt", puis essaies d' entrée une valeur numérique
dans une des cellules colorée (aïe, je ne sais pas ce que cela donnera pour tes yeux
enfin tu verras bien là où on est sensé rentrée une valeur).

j' ai laissé visibles les edit liés au StringGrid
et la fonction 32 est à 1.

la validation d' une des cellules entre la ligne fixe et la dernière ligne lance le calcul
automatique de la somme de la colonne et mets à jour la différence entre les totaux
des colonnes dans la statut bar.

Essais de valider par les deux touches Entrées
Puis en cliquant sur une autre cellule et sort par la croix.

J' ai régulièrement le message du contrôle " sans fenêtre parente.
scratch

J'ai téléchargé, et je vais essayer de voir ça.

EDIT

Effectivement, j'ai réussi à produire ce message d'erreur. Je vais maintenant pouvoir traquer la bête (le cafard, ou bug en anglais...).

J'ai trouvé l'endroit où se trouve le bug, mais je n'ai pas encore pu le corriger. Tu as bien constaté que cela se produit uniquement si l'on a effectué une saisie directe, puis on quitte. Or, dans ce cas, le focus reste dans l'EDITde saisie du Grid, EDITqui est automatiquement créé. Si tu places un bouton dans ta barre à-côté des 2 zones EDIT avec un on_click pour fermer la form, ça marche bien, parce que le focus a quitté le Grid et est passé sur le bouton. Le problème technique vient du fait qu'un clic sur la croix rouge, comme d'ailleurs un clic sur une ligne de menu, ne change pas le focus.

Bien entendu, je continue à chercher une solution technique propre.

Cependant, j'ai trouvé une façon de le contourner pour pouvoir sortir proprement du programme. Voici ce que j'ai fait:
1. Dans l'initialisation de la form 0, j'ai désactivé la croix rouge (par précaution)
2. J'ai créé un bouton placé à-côté des 2 zones EDIT avec on on_click pour fermer l'application, et j'ai caché ce bouton
3. dans le traitement du menu "Quitter", je rends ce bouton visible et je clique dessus par programme
4. dans le traitement on_click de ce bouton, j'appelle Close0 (pour supprimer le Grid), puis je tue le prcessus par le handle de la form 0.

Résultat: une sortie propre.

Voici le code (à adapter à tes besoins):

Code:: ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Main
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

hide 0
variables()
constantes()
labels()
init()
gui()
show 0
end

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub variables()
   dim no%
' couleurs pour le grid
   dim CouleurColNorm%
   dim CouleurColCred%
   dim CouleurColDeb%
   dim CouleurLineRub%
   dim CouleurPol1%
   dim CouleurPol2%
' police des grid
   dim PolGrid$
' selection dans StringGrid
   dim selectedGrid%
   dim selectedRow%
   dim selectedCol%
   dim selectedtxt$
   dim selectedtxt2$
   dim ExCol%
   dim ExRow%
' dimension de la zone du grid
   dim w0%
   dim h0%
' nombre de lignes
   dim NbreRows%
' etat du logiciel
   dim EtatLog% : ' 0 rien ouvert - 1 fichier ouvert enregistré - 2 fichier ouvert modifié
' variables de calcul
   dim TotalDep
   dim TotalRec
   dim ResteAV
end_sub

' ------------------------------------------------------------------------------

sub constantes()
   dim_local i%
' dossier source
   dim path$: path$=dir_current$
   if right$(path$,1)="" : path$=left$(path$,len(path$)-1) : end_if
   path$ = path$+""
' dossiers
   dim Dir_inf$ : Dir_inf$ = Path$+"inf"
   dim Dir_dll$ : Dir_dll$ = Path$+"dll"
   dim Dir_Temp$: Dir_Temp$ = "C:\Temp\Pbudeget_temp"
' fichiers
   dim kgf$ : kgf$ = Path$+"KGF.dll"
   dim lib$ : lib$ = Path$+"LIB.ilb"
   dim RubDepFile$ : RubDepFile$ = Dir_inf$+"ListeDep.inf"
   dim RubRecFile$ : RubRecFile$ = Dir_inf$+"ListeRec.inf"
   dim TempDepFile$: TempDepFile$ = Dir_Temp$+"NewBudgetDep_temp.inf"
   dim TempRecFile$: TempRecFile$ = Dir_Temp$+"NewBudgetRec_temp.inf"
' objets panoramic
' fichier en ouverture
   dim F_OR% : no%=no%+1 : F_OR%=no%
' form 0
   dim menu% : no%=no%+1 : menu%=no%
   dim sm%(7) : for i% =1 to 7 : no%=no%+1 : sm%(i%) =no% : next i%
   dim frame%(3): for i% =0 to 3 : no%=no%+1 : frame%(i%)=no% : next i%
   dim SGscroll%: no%=no%+1 : SGscroll% =no%
   dim DlDeb% : no%=no%+1 : DlDeb% =no%
   dim DlRec% : no%=no%+1 : DlRec% =no%
   dim DlBudgetFile% : no%=no%+1 : DlBudgetFile% =no%
   dim SBalpha1% : no%=no%+1 : SBalpha1% =no%
   dim SBalpha2% : no%=no%+1 : SBalpha2% =no%
' boite de dialogue
   dim OpenDial%: no%=no%+1 : OpenDial% =no%
   dim SaveDial%: no%=no%+1 : SaveDial% =no%
' form select rubrique
   dim Fen_SelectRubrique% : no%=no%+1 : Fen_SelectRubrique% =no%
   dim SelectRubriqueCont%(2) : for i% =1 to 2 : no%=no%+1 : SelectRubriqueCont%(i%) =no% : next i%
   dim SelectRubriqueAlpha%(4) : for i% =1 to 4 : no%=no%+1 : SelectRubriqueAlpha%(i%) =no% : next i%
   dim SelectRubriqueList%(4) : for i% =1 to 4 : no%=no%+1 : SelectRubriqueList%(i%) =no% : next i%
   dim SelectRubriqueButton%(5): for i% =1 to 5 : no%=no%+1 : SelectRubriqueButton%(i%)=no% : next i%
' objets panoramic pour objets kgf
' form 0
   dim TVedit%(2) : for i% =1 to 2 : no%=no%+1 : TVedit%(i%)=no% : next i%
   dim SGedit% : no%=no%+1 : SGedit% =no%
   dim SGeditEvent% : no%=no%+1 : SGeditEvent% =no%
   dim SGmemo% : no%=no%+1 : SGmemo% =no%
   dim Exit% : no%=no%+1 : Exit% =no%
' objet kgf
   dim SG%
   dim TV1%
   dim TV2%
end_sub

' ------------------------------------------------------------------------------

sub labels()
   label clic,change,dclic,close0 : ' ,fin
end_sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' INITIALISATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub init()
' activation de la dll
   if file_exists(kgf$)=1
   dll_on kgf$
   end_if
' définition des couleurs pour les StringGrid
' définition des couleurs de colonne
   DefineKgfColor(255,255,255)
   CouleurColNorm% = Ret_KgfColor%
   DefineKgfColor(253,213,187)
   CouleurColCred% = Ret_KgfColor%
   DefineKgfColor(217,248,174)
   CouleurColDeb% = Ret_KgfColor%
' définition des couleurs de police
   DefineKgfColor(0,0,0)
   CouleurPol1% = Ret_KgfColor%
   DefineKgfColor(0,0,170)
   CouleurPol2% = Ret_KgfColor%
' définition de la couleur d' une ligne de rubrique
   DefineKgfColor(230,230,230)
   CouleurLineRub% = Ret_KgfColor%
' définition de la police des grid
   PolGrid$ = "Courier New"
' création du dossier temporaire
   if dir_exists("C:\Temp")=0 then dir_make "C:\Temp"
   if dir_exists(Dir_Temp$)=0 then dir_make Dir_Temp$
end_sub

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

sub gui()
   dim_local h%,w%

   height 0,600
   width 0,1000
   top 0,(screen_y-height(0))/2
   left 0,(screen_x-width(0))/2
   caption 0,"PanoBudget"
   color 0,254,234,185
' on_close 0,close0

   main_menu menu%
   sub_menu sm%(1) : parent sm%(1),menu% : caption sm%(1),"Fichiers"
   sub_menu sm%(2) : parent sm%(2),sm%(1) : caption sm%(2),"Nouveau" : on_click sm%(2),clic
   sub_menu sm%(3) : parent sm%(3),sm%(1) : caption sm%(3),"Ouvrir" : on_click sm%(3),clic
   sub_menu sm%(4) : parent sm%(4),sm%(1) : caption sm%(4),"-"
   sub_menu sm%(5) : parent sm%(5),sm%(1) : caption sm%(5),"Enregistrer" : on_click sm%(5),clic
   sub_menu sm%(6) : parent sm%(6),sm%(1) : caption sm%(6),"-"
   sub_menu sm%(7) : parent sm%(7),sm%(1) : caption sm%(7),"Quitter" : on_click sm%(7),clic

   DefineDimForm(0,frame%(0))
   h% = Ret_height%
   w% = Ret_width%

   panel frame%(1)
   height frame%(1),26
   width frame%(1),w%
   top frame%(1),0
   left frame%(1),0
   color frame%(1),254,211,110

   edit SGedit%
   parent SGedit%,frame%(1)
   width SGedit%,250
   top SGedit%,2
   left SGedit%,2
   on_change SGedit%,change

   edit SGeditEvent%
   parent SGeditEvent%,frame%(1)
   width SGeditEvent%,250
   top SGeditEvent%,2
   left SGeditEvent%,width(SGedit%)+2+5
   on_change SGeditEvent%,change

   button Exit% : hide Exit%
   parent Exit%,frame%(1)
   caption Exit%,"Sortir"
   top Exit%,2
   left Exit%,width(SGedit%)+2+5+width(SGeditEvent%)+5
   on_click Exit%,clic

   Create_hide

   edit TVedit%(1)
   on_change TVedit%(1),change

   edit TVedit%(2)
   on_change TVedit%(2),change

   panel frame%(2)
   height frame%(2),h%-52
   width frame%(2),w%
   top frame%(2),26
   left frame%(2),0

   h0%=h%-52
   w0%=w%

   memo SGmemo%
   parent SGmemo%,frame%(2)
   height SGmemo%,height(frame%(2))-(height(SGedit%)+6)
   width SGmemo%,(width(frame%(2))-6)/2
   top SGmemo%,height(SGedit%)+4
   left SGmemo%,2

   scroll_bar SGscroll%
   vertical SGscroll%
   top SGscroll%,32
   left SGscroll%,(w0%-28)+5
   height SGscroll%,(h0%-6)
   on_change SGscroll%,change

   create_show

   panel frame%(3)
   height frame%(3),26
   width frame%(3),w%
   top frame%(3),h%-26
   left frame%(3),0
   color frame%(3),254,211,110

   alpha SBalpha1%
   parent SBalpha1%,frame%(3)
   top SBalpha1%,5
   left SBalpha1%,10
   font_name SBalpha1%,"Arial"
   font_size SBalpha1%,10
   font_bold SBalpha1%
   caption SBalpha1%,"Reste à vivre en € : "

   alpha SBalpha2%
   parent SBalpha2%,frame%(3)
   top SBalpha2%,5
   left SBalpha2%,15+width(SBalpha1%)
   font_name SBalpha2%,"Courier New"
   font_size SBalpha2%,10
   font_bold SBalpha2%

   dlist DlDeb%
   dlist DlRec%
   dlist DlBudgetFile%
end_sub

' ------------------------------------------------------------------------------

sub Form_SelectRubriques()
   dim_local h%,w%,i%,res%,Htv%,Wtv%,Ttv%,Ltv%,null%,txt$
   null% =0-1

   if object_exists(Fen_SelectRubrique%)=1
   show Fen_SelectRubrique%
   else
   form Fen_SelectRubrique%
   height Fen_SelectRubrique%,500
   width Fen_SelectRubrique%,650
   top Fen_SelectRubrique%,(screen_y-height(Fen_SelectRubrique%))/2
   left Fen_SelectRubrique%,(screen_x-width(Fen_SelectRubrique%))/2
   color Fen_SelectRubrique%,254,211,110
   font_name Fen_SelectRubrique%,"Arial"
   caption Fen_SelectRubrique%,"Sélectionnez vos rubriques..."

   DefineDimForm(Fen_SelectRubrique%,frame%(0))
   h% = Ret_height%
   w% = Ret_width%

   container SelectRubriqueCont%(1)
   parent SelectRubriqueCont%(1),Fen_SelectRubrique%
   height SelectRubriqueCont%(1),(h%-15-30)/2
   width SelectRubriqueCont%(1),w%-4
   top SelectRubriqueCont%(1),5
   left SelectRubriqueCont%(1),2

   alpha SelectRubriqueAlpha%(1)
   parent SelectRubriqueAlpha%(1),SelectRubriqueCont%(1)
   top SelectRubriqueAlpha%(1),17
   left SelectRubriqueAlpha%(1),5
   caption SelectRubriqueAlpha%(1),"Base :"

   TV1% = dll_call3("CreateTreeViewEx",handle(SelectRubriqueCont%(1)),1,adr(lib$))
   res% = dll_call3("SetTreeViewEventReceiver",TV1%,1,handle(TVedit%(1)))
   Htv% = height(SelectRubriqueCont%(1))-40
   Wtv% = (width(SelectRubriqueCont%(1))-40)/2
   Ttv% = 35
   Ltv% = 5
   res% = dll_call5("ResizeTreeView",TV1%,Ttv%,Ltv%,Wtv%,Htv%)
   txt$ = "DEPENSES"
   res% = dll_call4("AddTreeViewRootNode",TV1%,adr(txt$),1,1)
   RempTreeView(TV1%,RubDepFile$)

   alpha SelectRubriqueAlpha%(2)
   parent SelectRubriqueAlpha%(2),SelectRubriqueCont%(1)
   top SelectRubriqueAlpha%(2),17
   left SelectRubriqueAlpha%(2),((width(SelectRubriqueCont%(1))-40)/2)+10
   caption SelectRubriqueAlpha%(2),"Sélection :"

   list SelectRubriqueList%(2)
   parent SelectRubriqueList%(2),SelectRubriqueCont%(1)
   height SelectRubriqueList%(2),height(SelectRubriqueCont%(1))-40
   width SelectRubriqueList%(2),(width(SelectRubriqueCont%(1))-40)/2
   top SelectRubriqueList%(2),35
   left SelectRubriqueList%(2),((width(SelectRubriqueCont%(1))-40)/2)+10
   font_size SelectRubriqueList%(2),10
   cursor_point SelectRubriqueList%(2)
   on_double_click SelectRubriqueList%(2),dclic

   button SelectRubriqueButton%(1)
   parent SelectRubriqueButton%(1),SelectRubriqueCont%(1)
   height SelectRubriqueButton%(1),20
   width SelectRubriqueButton%(1),20
   top SelectRubriqueButton%(1),top(SelectRubriqueList%(2))
   left SelectRubriqueButton%(1),width(SelectRubriqueCont%(1))-25
   font_name SelectRubriqueButton%(1),"Webdings"
   caption SelectRubriqueButton%(1),"5"
   cursor_point SelectRubriqueButton%(1)
   on_click SelectRubriqueButton%(1),clic

   button SelectRubriqueButton%(2)
   parent SelectRubriqueButton%(2),SelectRubriqueCont%(1)
   height SelectRubriqueButton%(2),20
   width SelectRubriqueButton%(2),20
   top SelectRubriqueButton%(2),top(SelectRubriqueButton%(1))+25
   left SelectRubriqueButton%(2),width(SelectRubriqueCont%(1))-25
   font_name SelectRubriqueButton%(2),"Webdings"
   caption SelectRubriqueButton%(2),"6"
   cursor_point SelectRubriqueButton%(2)
   on_click SelectRubriqueButton%(2),clic

   container SelectRubriqueCont%(2)
   parent SelectRubriqueCont%(2),Fen_SelectRubrique%
   height SelectRubriqueCont%(2),(h%-15-30)/2
   width SelectRubriqueCont%(2),w%-4
   top SelectRubriqueCont%(2),height(SelectRubriqueCont%(1))+10
   left SelectRubriqueCont%(2),2

   alpha SelectRubriqueAlpha%(3)
   parent SelectRubriqueAlpha%(3),SelectRubriqueCont%(2)
   top SelectRubriqueAlpha%(3),17
   left SelectRubriqueAlpha%(3),5
   caption SelectRubriqueAlpha%(3),"Base :"

   TV2% = dll_call3("CreateTreeViewEx",handle(SelectRubriqueCont%(2)),2,adr(lib$))
   res% = dll_call3("SetTreeViewEventReceiver",TV2%,1,handle(TVedit%(2)))
   Htv% = height(SelectRubriqueCont%(2))-40
   Wtv% = (width(SelectRubriqueCont%(2))-40)/2
   Ttv% = 35
   Ltv% = 5
   res% = dll_call5("ResizeTreeView",TV2%,Ttv%,Ltv%,Wtv%,Htv%)
   txt$ = "RECETTES"
   res% = dll_call4("AddTreeViewRootNode",TV2%,adr(txt$),1,1)
   RempTreeView(TV2%,RubRecFile$)

   alpha SelectRubriqueAlpha%(4)
   parent SelectRubriqueAlpha%(4),SelectRubriqueCont%(2)
   top SelectRubriqueAlpha%(4),17
   left SelectRubriqueAlpha%(4),((width(SelectRubriqueCont%(2))-40)/2)+10
   caption SelectRubriqueAlpha%(4),"Sélection :"

   list SelectRubriqueList%(4)
   parent SelectRubriqueList%(4),SelectRubriqueCont%(2)
   height SelectRubriqueList%(4),height(SelectRubriqueCont%(2))-40
   width SelectRubriqueList%(4),(width(SelectRubriqueCont%(2))-40)/2
   top SelectRubriqueList%(4),35
   left SelectRubriqueList%(4),((width(SelectRubriqueCont%(2))-40)/2)+10
   font_size SelectRubriqueList%(4),10
   cursor_point SelectRubriqueList%(4)
   on_double_click SelectRubriqueList%(4),dclic

   button SelectRubriqueButton%(3)
   parent SelectRubriqueButton%(3),SelectRubriqueCont%(2)
   height SelectRubriqueButton%(3),20
   width SelectRubriqueButton%(3),20
   top SelectRubriqueButton%(3),top(SelectRubriqueList%(4))
   left SelectRubriqueButton%(3),width(SelectRubriqueCont%(2))-25
   font_name SelectRubriqueButton%(3),"Webdings"
   caption SelectRubriqueButton%(3),"5"
   cursor_point SelectRubriqueButton%(3)
   on_click SelectRubriqueButton%(3),clic

   button SelectRubriqueButton%(4)
   parent SelectRubriqueButton%(4),SelectRubriqueCont%(2)
   height SelectRubriqueButton%(4),20
   width SelectRubriqueButton%(4),20
   top SelectRubriqueButton%(4),top(SelectRubriqueButton%(3))+25
   left SelectRubriqueButton%(4),width(SelectRubriqueCont%(2))-25
   font_name SelectRubriqueButton%(4),"Webdings"
   caption SelectRubriqueButton%(4),"6"
   cursor_point SelectRubriqueButton%(4)
   on_click SelectRubriqueButton%(4),clic

   button SelectRubriqueButton%(5)
   parent SelectRubriqueButton%(5),Fen_SelectRubrique%
   top SelectRubriqueButton%(5),h%-(height(SelectRubriqueButton%(5))+5)
   left SelectRubriqueButton%(5),w%-(width(SelectRubriqueButton%(5))+5)
   caption SelectRubriqueButton%(5),"Créer"
   cursor_point SelectRubriqueButton%(5)
   on_click SelectRubriqueButton%(5),clic
   end_if

   clear SelectRubriqueList%(2)
   clear SelectRubriqueList%(4)
   res% = DLL_call2("WindowTopMost",handle(Fen_SelectRubrique%),1)
end_sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MENUS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

clic:
   if number_click = sm%(2)
   if SG%<>0
   if EtatLog%=2
   if message_warning_yes_no("Un Budget est en cours !"+chr$(13)+"Etes vous sûr de vouloir en créer un nouveau ?...")=1
   DeleteSringGrid()
   Form_SelectRubriques()
   end_if
   else
   if EtatLog%=1
   DeleteSringGrid()
   Form_SelectRubriques()
   end_if
   end_if
   else
   Form_SelectRubriques()
   end_if
   return
   end_if

' ***********************

   if number_click =sm%(3)
   if SG%<>0
   if EtatLog%=2
   if message_warning_yes_no("Un Budget est en cours !"+chr$(13)+"Etes vous sûr de vouloir en créer un nouveau ?...")=1
   DeleteSringGrid()
   OpenBudgetFile()
   end_if
   else
   if EtatLog%=1
   DeleteSringGrid()
   OpenBudgetFile()
   end_if
   end_if
   else
   OpenBudgetFile()
   end_if
   return
   end_if

' ***********************

   if number_click =sm%(5)
   if SG%<>0
   SaveBudgetFile()
   EtatLog% = 1
   end_if
   return
   end_if

' ***********************

   if number_click =sm%(7)
   show Exit%
   if variable("res%")=0 then dim res%
   res% = dll_call2("MouseLeftClick",left(Exit%)+5,top(Exit%)+5)
   return
   gosub Close0
   if variable("res%")=0 then dim res%
   res% = dll_call1("KillProcessByHandle",handle(0))
' message "Menu inactif, sortie par la croix"
' return
   end_if

   if number_click =exit%
   gosub Close0
   if variable("res%")=0 then dim res%
   res% = dll_call1("KillProcessByHandle",handle(0))
' message "Menu inactif, sortie par la croix"
' return
   end_if

' ***********************

   if object_exists(Fen_SelectRubrique%)=1
   if number_click = SelectRubriqueButton%(1)
   ItemListMoveUp(SelectRubriqueList%(2))
   return
   end_if
   ' ***********************
   if number_click = SelectRubriqueButton%(2)
   ItemListMoveDown(SelectRubriqueList%(2))
   return
   end_if
   ' ***********************
   if number_click = SelectRubriqueButton%(3)
   ItemListMoveUp(SelectRubriqueList%(4))
   return
   end_if
   ' ***********************
   if number_click = SelectRubriqueButton%(4)
   ItemListMoveDown(SelectRubriqueList%(4))
   return
   end_if
   ' ***********************
   if number_click = SelectRubriqueButton%(5)
   file_save SelectRubriqueList%(2),TempDepFile$
   file_save SelectRubriqueList%(4),TempRecFile$
   hide Fen_SelectRubrique%
   LoadTemporyFiles()
   CreateNewStringGrid()
   ImportRubriqueFromTempFiles()
   EtatLog% = 0
   return
   end_if
   end_if
return

' ------------------------------------------------------------------------------

change:
   if number_change = SGscroll%
   ScrollBarMvt()
   return
   end_if

' ***********************

   if number_change = SGedit%
   off_change SGedit%
   RecupInfoFromStringGrid()
   return
   end_if

' ***********************

   if number_change = SGeditEvent%
   off_change SGeditEvent%
   DetectCellChange()
   MajAffichResteAV()
   return
   end_if

' ***********************

   if number_change = TVedit%(1)
   DetectEventOnTreeView(TVedit%(1))
   if Ret_EventTV%=2
   AddItemToSelectionList(TV1%,SelectRubriqueList%(2))
   end_if
   return
   end_if

' ***********************

   if number_change = TVedit%(2)
   DetectEventOnTreeView(TVedit%(2))
   if Ret_EventTV%=2
   AddItemToSelectionList(TV2%,SelectRubriqueList%(4))
   end_if
   return
   end_if
return

' ------------------------------------------------------------------------------

dclic:
   if object_exists(Fen_SelectRubrique%)=1
   ' ***********************
   if number_double_click = SelectRubriqueList%(2)
   DeleteItemFromList(item_index(SelectRubriqueList%(2)),SelectRubriqueList%(2))
   return
   end_if
   ' ***********************
   if number_double_click = SelectRubriqueList%(4)
   DeleteItemFromList(item_index(SelectRubriqueList%(4)),SelectRubriqueList%(4))
   return
   end_if
   end_if
return

' ------------------------------------------------------------------------------

close0:
  DeleteSringGrid()
  if variable("res%")=0 then dim res%
  res% = dll_call1("KillProcessByHandle",handle(0))
  message "a"
' return

' ------------------------------------------------------------------------------

' fin:
' DeleteSringGrid()
' return

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' PROCEDURES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub RempTreeView(obj%,file$)
   dim_local txt$,ind%,res%

   file_open_read F_OR%,file$
   while file_eof(F_OR%)<>1
   file_readln F_OR%,txt$
   if left$(txt$,1)="#"
   txt$ = right$(txt$,len(txt$)-1)
   txt$ = upper$(txt$)
   res% = dll_call3("SelectTreeViewNode",obj%,0,1)
   res% = dll_call4("AddTreeViewChildNode",obj%,adr(txt$),2,3)
   ind% = ind%+1
   else
   if ind%>0
   res% = dll_call4("AddTreeViewChildNode",obj%,adr(txt$),4,5)
   ind% = 0
   else
   res% = dll_call5("InsertTreeViewNode",obj%,1,adr(txt$),4,5)
   end_if
   end_if
   end_while
   file_close F_OR%
end_sub

' ------------------------------------------------------------------------------

sub DeleteItemFromList(line%,obj%)
   dim_local m%,lav%,lap%,cas%
   if line%>0
   lav% = line%-1
   if line%<>count(obj%)
   lap% = line%+1
   else
   lap% = 0
   end_if

   if left$(item_read$(obj%,line%),1)<>"#"
   m% = message_warning_yes_no("Vous allez supprimer la rubrique '"+item_read$(obj%,line%)+"de votre sélection !"+chr$(13)+"Etes vous sûr de vouloir supprimer cette rubrique ?...")
   if m%=1
   if lap% > 0
   if lav% > 0
   if left$(item_read$(obj%,lav%),1)="#"
   if left$(item_read$(obj%,lap%),1)="#"
   item_delete obj%,line%
   item_delete obj%,lav%
   else
   item_delete obj%,line%
   end_if
   else
   item_delete obj%,line%
   end_if
   end_if
   else
   if lav%>0
   if left$(item_read$(obj%,lav%),1)="#"
   item_delete obj%,line%
   item_delete obj%,lav%
   else
   item_delete obj%,line%
   end_if
   end_if
   end_if
   end_if
   end_if
   end_if
end_sub

' ------------------------------------------------------------------------------

sub AddItemToSelectionList(obj%,dest%)
   dim_local i%,a$,l$,cat$,inslin%,pres%,line%,res%,par1$,par2$,ind%,niv%

   par1$ = string$(200," ")
   niv% = dll_call3("GetTreeViewInformation",obj%,5,adr(par1$))
   par1$ =trim$(par1$)

   par1$ = string$(200," ")
   res% = dll_call3("GetTreeViewInformation",obj%,3,adr(par1$))
   par1$ =trim$(par1$)

   par2$ = string$(200," ")
   ind% = dll_call3("GetTreeViewInformation",obj%,2,adr(par2$))
   par2$ =trim$(par2$)

   if niv% =2
   l$ = par2$
   cat$ = "#"+par1$
   if count(dest%)>0
   for i%=1 to count(dest%)
   a$=item_read$(dest%,i%)
   if a$=cat$
   pres%=1
   else
   if pres%=1 and left$(a$,1)="#"
   inslin% = i%
   exit_for
   end_if
   end_if
   next i%
   end_if

   if inslin%=0 : inslin%=count(dest%)+1 : end_if

   if pres%=0
   item_add dest%,cat$
   item_add dest%,l$
   else
   if inslin% < count(dest%) or inslin% = count(dest%)
   item_insert dest%,inslin%,l$
   else
   item_add dest%,l$
   end_if
   end_if
   end_if
end_sub

' ------------------------------------------------------------------------------

sub ItemListMoveUp(obj%)
   dim_local ii%,lav%,a$
   ii%= item_index(obj%)
   if ii%>1 : lav%=ii%-1 : else : lav%=0 : end_if

   if count(obj%)>0
   if ii% >0
   if left$(item_read$(obj%,ii%),1)<>"#"

   if lav%>0
   if left$(item_read$(obj%,lav%),1)<>"#"
   a$=item_read$(obj%,ii%)
   item_delete obj%,ii%
   item_insert obj%,lav%,a$
   end_if
   end_if

   end_if
   end_if
   end_if
end_sub

' ------------------------------------------------------------------------------

sub ItemListMoveDown(obj%)
   dim_local ii%,lap%,a$
   ii%= item_index(obj%)
   if ii%<count(obj%) : lap%=ii%+1 : else : lav%=0 : end_if

   if count(obj%)>0
   if ii% >0
   if left$(item_read$(obj%,ii%),1)<>"#"

   if lap%>0 and lap%<count(obj%)
   if left$(item_read$(obj%,lap%),1)<>"#"
   a$=item_read$(obj%,ii%)
   item_delete obj%,ii%
   item_insert obj%,lap%,a$
   end_if
   else
   if lap%=count(obj%)
   if left$(item_read$(obj%,lap%),1)<>"#"
   a$=item_read$(obj%,ii%)
   item_delete obj%,ii%
   item_add obj%,a$
   end_if
   end_if
   end_if

   end_if
   end_if
   end_if
end_sub

' ------------------------------------------------------------------------------

sub LoadTemporyFiles()
   clear DlDeb%
   clear DLRec%
   file_load DlDeb%,TempDepFile$
   file_load DlRec%,TempRecFile$
   if count(DlDeb%)>count(DlRec%) : NbreRows%=count(DlDeb%)+3 : else : NbreRows%=count(DlRec%)+3 : end_if
end_sub

' ------------------------------------------------------------------------------

sub OpenBudgetFile()
   dim_local res%,f$,txt$

   open_dialog OpenDial%
   Dir_dialog OpenDial%,path$
   filter OpenDial%,"*.txt|*.txt"
   f$=file_name$(OpenDial%)
   delete OpenDial%
   if f$<>"_"
   clear DlBudgetFile%
   file_load DlBudgetFile%,f$
   NbreRows% = val(trim$(item_read$(DlBudgetFile%,3)))
   CreateNewStringGrid()
   res% = dll_call3("LoadGridFromFile",SG%,0,adr(f$))
   txt$ = string$(255," ")
   res% = DLL_call4("GetGridCellText",SG%,2,NbreRows%,adr(txt$))
   txt$ = trim$(txt$)
   if txt$<>""
   TotalDep = val(txt$)
   end_if
   txt$ = string$(255," ")
   res% = DLL_call4("GetGridCellText",SG%,4,NbreRows%,adr(txt$))
   txt$ = trim$(txt$)
   if txt$<>""
   TotalRec = val(txt$)
   end_if
   EtatLog% = 1

   ResteAV = TotalRec - TotalDep
   MajAffichResteAV()
   end_if
end_sub

' ------------------------------------------------------------------------------

sub SaveBudgetFile()
   dim_local res%,f$

   save_dialog SaveDial%
   Dir_dialog SaveDial%,path$
   filter SaveDial%,"*.txt|*.txt"
   f$=file_name$(SaveDial%)
   delete SaveDial%
   if f$<>"_"
   if right$(f$,4)<> ".txt"
   f$=f$+".txt"
   if file_exists(f$)=1 : file_delete f$ : end_if
   end_if
   res% = dll_call3("SaveGridToFile",SG%,0,adr(f$))
   EtatLog% = 1
   end_if
end_sub

' ------------------------------------------------------------------------------

sub CreateNewStringGrid()
   dim_local res%,l1%,l2%,sepcel$,seplin$,null%,i%,txt$

' définition du nombre de lignes minimum
   if NbreRows%=0
   NbreRows%=2
   end_if

' paramétrage de la scroll_bar perso
   min SGscroll%,1 : max SGscroll%,NbreRows% : position SGscroll%,1

   l1% = (w0%-30-200)/2
   l2% = 98
   null% = 0-1

' déclaration des paramètres de création du StringGrid
   clear SGmemo%
   item_add SGmemo%,"Left=5"
   item_add SGmemo%,"Top=31"
   item_add SGmemo%,"Width="+str$(w0%-28)
   item_add SGmemo%,"Height="+str$(h0%-5)
   item_add SGmemo%,"Rows="+str$(NbreRows%)
   item_add SGmemo%,"Columns=4"
   item_add SGmemo%,"FixedRows=1"
   item_add SGmemo%,"FixedColumns=0"

' création de l' objet StringGrid
   SG% = dll_call3("CreateStringGrid",handle(0),handle(SGmemo%),handle(SGedit%))

' définition des séparateurs cellules/lignes
   sepcel$ = ";"
   seplin$ = chr$(13)+chr$(10)
   res% = dll_call2("SetGridSeparators",adr(sepcel$),adr(seplin$))

' interdiction de saisi direct
   res% = DLL_call6("GridFunction",SG%,1,1,0,0,0)

' recup d' un changement de cellule
   res% = DLL_call6("GridFunction",SG%,32,handle(SGeditEvent%),1,0,0)

' scroll_bar du grid invisible, ligne montrée 1
   res% = DLL_call6("GridFunction",SG%,31,0,0,0,0)
   res% = DLL_call6("GridFunction",SG%,30,1,0,0,0)

' dimensionnement
' hauteur des lignes
   res% = DLL_call6("GridFunction",SG%,17,0,20,0,0)
' largeur des colonnes
   res% = DLL_call6("GridFunction",SG%,18,1,l1%,0,0)
   res% = DLL_call6("GridFunction",SG%,18,2,l2%,0,0)
   res% = DLL_call6("GridFunction",SG%,18,3,l1%,0,0)
   res% = DLL_call6("GridFunction",SG%,18,4,l2%,0,0)

' formatage texte de la ligne 1 (ligne des entêtes)
   res% = DLL_call6("GridFunction",SG%,9,0*65536+1,4362,adr(PolGrid$),CouleurPol2%)

' écriture des entêtes
   txt$="DEPENSES"
   res% = DLL_call4("WriteGridCell",SG%,1,1,adr(txt$))
   txt$="MONTANT"
   res% = DLL_call4("WriteGridCell",SG%,2,1,adr(txt$))
   txt$="RECETTES"
   res% = DLL_call4("WriteGridCell",SG%,3,1,adr(txt$))
   txt$="MONTANT"
   res% = DLL_call4("WriteGridCell",SG%,4,1,adr(txt$))

' activation du formatage perso
   res% = DLL_call6("GridFunction",SG%,8,1,0,0,0)

   show SGscroll%
end_sub

' ------------------------------------------------------------------------------

sub DeleteSringGrid()
   dim_local res%
   res% = dll_call1("DeleteStringGrid",SG%)
end_sub

' ------------------------------------------------------------------------------

sub ImportRubriqueFromTempFiles()
   dim_local i%,a$,res%,txt$

   if count(DlDeb%)>0
   for i%= 1 to count(DlDeb%)
   a$=item_read$(DlDeb%,i%)
   res% = DLL_call6("GridFunction",SG%,9,1*65536+(i%+1),10,adr(PolGrid$),CouleurPol1%)
   if left$(a$,1)="#"
   a$=upper$(right$(a$,len(a$)-1))
   res% = DLL_call6("GridFunction",SG%,2,1,i%+1,CouleurLineRub%,CouleurPol1%)
   res% = DLL_call6("GridFunction",SG%,2,2,i%+1,CouleurLineRub%,CouleurPol1%)
   else
   a$=string$(5," ")+a$
   res% = DLL_call6("GridFunction",SG%,9,2*65536+(i%+1),8202,adr(PolGrid$),CouleurPol1%)
   res% = DLL_call6("GridFunction",SG%,2,2,i%+1,CouleurColDeb%,CouleurPol1%)
   end_if
   txt$=a$
   res% = DLL_call4("WriteGridCell",SG%,1,i%+1,adr(txt$))
   next i%
   end_if
   txt$ = "Total des dépenses : "
   res% = DLL_call6("GridFunction",SG%,9,1*65536+NbreRows%,8202,adr(PolGrid$),CouleurPol2%)
   res% = DLL_call4("WriteGridCell",SG%,1,NbreRows%,adr(txt$))
   txt$ = "0.00"
   res% = DLL_call6("GridFunction",SG%,9,2*65536+NbreRows%,8202,adr(PolGrid$),CouleurPol1%)
   res% = DLL_call6("GridFunction",SG%,2,2,NbreRows%,CouleurColDeb%,CouleurPol1%)
   res% = DLL_call4("WriteGridCell",SG%,2,NbreRows%,adr(txt$))

   if count(DlRec%)>0
   for i%= 1 to count(DlRec%)
   a$=item_read$(DlRec%,i%)
   res% = DLL_call6("GridFunction",SG%,9,3*65536+(i%+1),10,adr(PolGrid$),CouleurPol1%)
   if left$(a$,1)="#"
   a$=upper$(right$(a$,len(a$)-1))
   res% = DLL_call6("GridFunction",SG%,2,3,i%+1,CouleurLineRub%,CouleurPol1%)
   res% = DLL_call6("GridFunction",SG%,2,4,i%+1,CouleurLineRub%,CouleurPol1%)
   else
   a$=string$(5," ")+a$
   res% = DLL_call6("GridFunction",SG%,9,4*65536+(i%+1),8202,adr(PolGrid$),CouleurPol1%)
   res% = DLL_call6("GridFunction",SG%,2,4,i%+1,CouleurColCred%,CouleurPol1%)
   end_if
   txt$=a$
   res% = DLL_call4("WriteGridCell",SG%,3,i%+1,adr(txt$))
   next i%
   end_if
   txt$ = "Total des recettes : "
   res% = DLL_call6("GridFunction",SG%,9,3*65536+NbreRows%,8202,adr(PolGrid$),CouleurPol2%)
   res% = DLL_call4("WriteGridCell",SG%,3,NbreRows%,adr(txt$))
   txt$ = "0.00"
   res% = DLL_call6("GridFunction",SG%,9,4*65536+NbreRows%,8202,adr(PolGrid$),CouleurPol1%)
   res% = DLL_call6("GridFunction",SG%,2,4,NbreRows%,CouleurColCred%,CouleurPol1%)
   res% = DLL_call4("WriteGridCell",SG%,4,NbreRows%,adr(txt$))

   ResteAV = 0
   MajAffichResteAV()
end_sub

' ------------------------------------------------------------------------------

sub ScrollBarMvt()
   dim_local i%,res%
   i%=position(SGscroll%)
   res% = DLL_call6("GridFunction",SG%,30,i%,0,0,0)
end_sub

' ------------------------------------------------------------------------------

sub RecupInfoFromStringGrid()
   dim_local info$,sep%,res%,txt$,v$,i%

   info$ = trim$(text$(SGedit%))
   info$ = right$(info$,len(info$)-2)
   sep% = instr(info$,"click")
   selectedGrid% = val(left$(info$,sep%-1))

   sep% = instr(info$,"=")
   info$ = right$(info$,len(info$)-sep%)
   sep% = instr(info$,",")
   selectedCol% = val(left$(info$,sep%-1))
   selectedRow% = val(right$(info$,len(info$)-sep%))

   txt$ = string$(255," ")
   res% = DLL_call4("GetGridCellText",SG%,selectedCol%,selectedRow%,adr(txt$))
   selectedtxt$ = Trim$(txt$)
end_sub

' ------------------------------------------------------------------------------

sub DetectCellChange()
   dim_local t$,sep%,o$,cel$,value$,col%,row%,value%
   t$ = text$(SGeditEvent%)
   if right$(t$,1)<>"="
   if selectedCol%=2 or selectedCol%=4
   sep% = instr(t$,"=")
   o$ = left$(t$,sep%-1)
   t$ = right$(t$,len(t$)-sep%)

   sep% = instr(t$,"=")
   cel$ = left$(t$,sep%-1)
   t$ = right$(t$,len(t$)-sep%)

   value% = val(t$)

   sep% = instr(cel$,",")
   col% = val(left$(cel$,sep%-1))
   row% = val(right$(cel$,len(cel$)-sep%))

   if col% = 2
   CalculDep()
   else
   if col% = 4
   CalculRec()
   end_if
   end_if
   end_if
   end_if
end_sub

' ------------------------------------------------------------------------------

sub MajAffichResteAV()
   dim_local t$
   t$ = str$(ResteAV)
   FormatNombre(t$)
   caption SBalpha2%,RetFormat$
   if ResteAV<0
   font_color SBalpha2%,255,0,0
   else
   font_color SBalpha2%,0,0,200
   end_if
end_sub
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' FONCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub DefineDimForm(f%,DimPan%)
   dim_local res%
   if variable("Ret_Height%")=0 then dim Ret_Height%
   if variable("Ret_Width%")=0 then dim Ret_Width%
   panel DimPan%
   if f%<>0 : parent DimPan%,f% : end_if
   if f%=0 then res% = DLL_call2("SetCloseBox",handle(0),0)
   full_space DimPan%
   Ret_Height% = height(DimPan%)
   Ret_Width% = width(DimPan%)
   delete DimPan%
end_sub

' ------------------------------------------------------------------------------

sub CleanCaptionText(t$)
   if variable("Ret_CleanCaptionText$")=0 then dim Ret_CleanCaptionText$
   dim_local i%,l$
   for i%=1 to len(t$)
   if mid$(t$,i%,1)<>"&"
   l$=l$+mid$(t$,i%,1)
   end_if
   next i%
   Ret_CleanCaptionText$ = l$
end_sub

' ------------------------------------------------------------------------------

sub DefineKgfColor(R%,G%,B%)
   if variable("Ret_KgfColor%")=0 then dim Ret_KgfColor%
   Ret_KgfColor% = (B%*256+G%)*256+R%
end_sub

' ------------------------------------------------------------------------------

sub FormatNombre(T$)
   if variable("RetFormat$")=0 then dim RetFormat$
   dim_local sep%
   sep%=instr(T$,".")
   if sep%=0
   RetFormat$=T$+".00"
   else
   if sep%=len(T$)-2
   RetFormat$=T$
   else
   if len(T$)=1 and sep%=0
   RetFormat$=T$+".00"
   else
   if sep%=len(T$)-1
   RetFormat$=T$+"0"
   end_if
   end_if
   end_if
   end_if
end_sub

' ------------------------------------------------------------------------------

sub DetectEventOnTreeView(Obj%)
   if variable("Ret_EventTV%")=0 then dim Ret_EventTV%
   dim_local t$,sep%,event$

   t$ = text$(obj%)
   sep% = instr(t$,",")
   event$ = left$(t$,sep%-1)

   if event$="click"
   Ret_EventTV% =1
   end_if

   if event$="double_click"
   Ret_EventTV% =2
   end_if
end_sub

' ------------------------------------------------------------------------------

sub CalculDep()
   dim_local i%,res%,v$,txt$
   TotalDep = 0

   for i%=2 to NbreRows%-1
   v$ = string$(255," ")
   res% = DLL_call4("GetGridCellText",SG%,2,i%,adr(v$))
   v$ = trim$(v$)
   if v$<>""
   TotalDep = TotalDep + val(v$)
   end_if
   next i%
   txt$ = str$(TotalDep)
   FormatNombre(txt$)
   txt$ = RetFormat$
   res% = DLL_call4("WriteGridCell",SG%,2,NbreRows%,adr(txt$))

   ResteAV = TotalRec - TotalDep
end_sub

' ------------------------------------------------------------------------------

sub CalculRec()
   dim_local i%,res%,v$,txt$
   TotalRec = 0

   for i%=2 to NbreRows%-1
   v$ = string$(255," ")
   res% = DLL_call4("GetGridCellText",SG%,4,i%,adr(v$))
   v$ = trim$(v$)
   if v$<>""
   TotalRec = TotalRec + val(v$)
   end_if
   next i%
   txt$ = str$(TotalRec)
   FormatNombre(txt$)
   txt$ = RetFormat$
   res% = DLL_call4("WriteGridCell",SG%,4,NbreRows%,adr(txt$))

   ResteAV = TotalRec - TotalDep
end_sub

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

data "DEPENSES"

data "#Habitation","Loyer","Charges locatives","Loyer + Charges","Emprunt immobilier"
data "Electricité","Gaz","Electricité + Gaz","Fuel","Eau","Téléphone","Internet","TV"
data "Téléphone / Internet","Téléphone / Internet / Tv","Assurance habitation"
data "#Frais financiers","Frais de gestion de compte","Epargne contractée","Assurances"
data "#Enfants","Cantine","Garderie","Transports scolaires","Voyage d' étude","Assurance scolaire"
data "#Sante / Loisirs","Vacances","Abonnements","Disques / DVD","Cinéma / Theâtre","Concerts","Autres"
data "#Transports","Entretien","Carburant","Réparations","Assurance","Bus","Train","Avion"
data "#Impôts","Impôt sur le revenu","Taxe foncière","Taxe d' habitation","Taxe Tv","Taxe ordures ménagères"

data "RECETTES"

data "#Salaires","Salaire","ASSEDIC"
data "#Pensions","Retraite","Alimentaire","Invalidité"
data "#Allocations","RSA","Logement","Familiales","Complément familiale","Jeune Enfant","Autres"
data "#Revenus du capital","Loyers","Intérêts de placements","Autres"
data "#Autres"

data "FIN"

KGF.dll V6.76 du 27/05/2016

Nouveautés:
- DeleteStringGrid: correction d'un bug si la saisie directe était active

Modules modifiés:
KGF.dll

La doc est inchangée. Les sources sources sont à jour.

Ceci rend obsolète mon post précédent, bien que la technique employée puisse servir pour déclencher un évènement Panoramic par programme...

Plus de message ! ouf...

Bravo Klaus.

Je pense que l' on a déjà du te demander si c' était possible mais je n' en suis pas sûr.
Crois tu pouvoir suspendre la fermeture par la croix.

J' ai une procédure placé sur un label pour on_close 0.

Code:: sub VerifEtatLog()
   dim_local m%
   if EtatLog% = 2
   m% = message_warning_yes_no("Le Budget a été modifié ! "+"Voulez vous enregistrer vos modifications ?...")
   if m% = 1
   SaveBudgetFile()
   end_if
   end_if
   DeleteSringGrid()
   hide SGscroll%
   if file_exists(TempDepFile$)=1 : file_delete TempDepFile$ : end_if
   if file_exists(TempRecFile$)=1 : file_delete TempRecFile$ : end_if
end_sub

Mais, le processus de fermeture se poursuit malgrès tout.
Le StringGrid est détruit avant que je puisse valider le message.
J' ai essayé avec une imbrication de if...else...end_if, rien à faire, le StringGrid est détruit
avant même que le message apparaisse.

Effectivement, ce n'est pas possible. L'évènement ON_CLOSE dans Panoramic n'est déclenché qu'après la suppression de tous les objets de la form, et en plus, il est inconditionnel. Il est juste prévu pour éventuellement sauvegarder des données, avant la sortie définitive. Mais l'action de fermeture est impossible à arrêter.

Par contre, tu regardes le code avec mon "astuce" que j'avais publié plus haut, juste avant d'avoir trouvé la vraie solution du bug. J'ai carrément désactivé la croix rouge (dans la sub de configuration de la form 0), et j'ai activé la ligne "Quitter" du menu. Là, tu peux demander une confirmation. Et comme la croix rouge ne peut plus rien casser, tu es tranquille.

Je vais regarder de plus près et bidouiller quelque chose.
Laughing

Voici le coeur du dispositif:

Code:: sub DefineDimForm(f%,DimPan%)
dim_local res%
if variable("Ret_Height%")=0 then dim Ret_Height%
if variable("Ret_Width%")=0 then dim Ret_Width%
panel DimPan%
if f%<>0 : parent DimPan%,f% : end_if
if f%=0 then res% = DLL_call2("SetCloseBox"handle(0),0) : ' <<<<<<< désactiver la croix rouge
full_space DimPan%
Ret_Height% = height(DimPan%)
Ret_Width% = width(DimPan%)
delete DimPan%
end_sub

et

Code:: sub labels()
label clic,change,dclic : ' <<<<<<<<<<< le on_close n'est plus nécessaire
end_sub
...
sub_menu sm%(7) : parent sm%(7),sm%(1) : caption sm%(7),"Quitter" : on_click sm%(7),clic
...
clic:
...
if number_click =sm%(7) : ' <<<<<<<< menu "Quitter"
DeleteSringGrid() : ' <<<<<<<< supprimer le Grid
if variable("res%")=0 then dim res% : ' variable à définir éventuellement ailleurs
res% = dll_call1("KillProcessByHandle",handle(0)) : ' remplacer TERMINATE
end_if

Et voilà. C'est tout.

Nombre de messages : 812 Localisation : Troyes Date d'inscription : 05/02/2011

Klaus
J'ai un très gros prb avec kgf! en l'utilisant
il ralenti bcp windows
en effet auparavant a mon projet j'utilisai "form.dll" de nardo
pour gérer les boutons d'agrandissement a mes fenêtre et tout
fonctionnait normalement
depuis que j'ai décider d'utilisé "kgf.dll" plus rien ne fonctionne
normalement même pour windows et également avec la commande <terminate>
qui fait un plantage alors qu'avec form.dll pas de plantage
et depuis que j'ai remis "form.dll" tout est redevenu normal

voila je voulais te prévenir
ps:
Je ne peux pas t'informer de quelle version il s'agit mais je l'ai télécharger
lundi 23 mai
bon week_end a tous

@Pascal10000:
Je suis très intéressé par tout ce qui peut mettre un bug en évidence. Peux-tu poster un petit code qui produit le genre de problèmes dont tu parles ? Dans ce cas, je pourrais l'analyser et trouver une solution, comme je viens de le faire pour Ygeronimi avec l'objet StringGrid géré par KGF.dll.

Nombre de messages : 812 Localisation : Troyes Date d'inscription : 05/02/2011

extrait du code

Code:: form 1300
width 1300,525:height 1300,150
left 1300,(screen_x-left(1300))/4:top 1300,(screen_y-height(1300))/3
caption 1300,"Nouvelle Opération"
label abandon: on_close 1300,abandon
res% = DLL_call2("SetMinimizeMaximize",handle(1300),0)

je pense que c'est générale de kgf

J'ai complété le code pour avoir un ensemble fonctionnel:

Code:: dim res%

  dll_on "KGF.dll"

  form 1300
  width 1300,525:height 1300,150
  left 1300,(screen_x-left(1300))/4:top 1300,(screen_y-height(1300))/3
  caption 1300,"Nouvelle Opération"
  label abandon: on_close 1300,abandon
  res% = DLL_call2("SetMinimizeMaximize",handle(1300),0)

  end

abandon:
  message "abandon"
  return

Et alors, quel est le problème ? Le programme fonctionne...

Mes sources sont libres et publiques. Voici les sources de cette fonction:

Code:: function SetMinimizeMaximize(const hnd,mode: integer): integer; stdcall; export
var
l: DWord;
begin
try
if mode>0 then begin
l := GetWindowLong(hnd, GWL_STYLE);
l := l or (WS_MINIMIZEBOX);
l := l or (WS_MAXIMIZEBOX);
SetWindowLong(hnd, GWL_STYLE, l);
end else begin
l := GetWindowLong(hnd, GWL_STYLE);
l := l and not (WS_MINIMIZEBOX);
l := l and not (WS_MAXIMIZEBOX);
SetWindowLong(hnd, GWL_STYLE, l);
end;
RepaintWindow(hnd);
finally
end;
result := 0;
end;

Ultra-simple. Et, à l'évidence, aucun problème de performance, puisque les quelques instructions se déroulent une seule fois, c'est tout.

KGF.dll V6.77 du 28/05/2016

Nouveautés:
- nouvelle fonction: SetTaskBar

Modules modifiés:
KGF.dll
KGF.chm

La doc et les sources sources sont à jour.*

L'appel est très simple:

Code:: res% = dll_call1("SetTaskBar",act%)

act%=0 - cacher la barre des tâches
act%=1 - montrer la barre des tâches
act%=2 - bloquer la barre des tâches
act%=3 - cacher automatiquement la barre des tâches

Voici une petite démo:

Code:: ' test_SetTaskBar.bas

label montrer, cacher, autohide, bloquer
dim res%

button 1 : top 1,10 : left 1, 10 : caption 1,"Montrer" : on_click 1,montrer
button 2 : top 2,10 : left 2,110 : caption 2,"Cacher" : on_click 2,cacher
button 3 : top 3,10 : left 3,210 : caption 3,"AutoHide" : on_click 3,autohide
button 4 : top 4,10 : left 4,310 : caption 4,"Bloquer" : on_click 4,bloquer

dll_on "KGF.dll"

end

montrer:
res% = dll_call1("SetTaskBar",1)
return

cacher:
res% = dll_call1("SetTaskBar",0)
return

autohide:
res% = dll_call1("SetTaskBar",3)
return

bloquer:
res% = dll_call1("SetTaskBar",2)
return

Et voici le code Delphi de cette fonction:

Code:: function SetTaskBar(act: integer):integer; stdcall; export;
// ce code a été fourni par Papydall !
begin
  result := -1;
  try
   case act of
   0: ShowWindow(FindWindow('Shell_TrayWnd',nil),SW_HIDE);
   1: ShowWindow(FindWindow('Shell_TrayWnd',nil),SW_RESTORE);
   end;
   result := 0;
  except
  end;
end;

Ça fonctionne, bravo!

Il est même possible de cacher le bouton Démarrer, en plus de la barre de tâche : voir ici

J'ai même ajouté les actions 2 et 3 pour bloquer ou cacher automatiquement la barre des tâches. La DLL et la doc sont à jour, et le programme de démo a été étendu.

Dans KGF.dll – Aide en ligne
Fonctions de gestion des fenêtres
Apparences des fenêtres
SetTaskBar
Il est écrit « Cette fonction gère la présence de la croix rouge d'une form. L'appel a le format suivant: »
De même in English « This function manages the presence of the red cross close box of a form. Call format: »

C’est certainement la faute à un "copier-coller"

» Nouvelles versions
» KGF_dll - nouvelles versions
» Synedit_Editor - nouvelles versions
» KGF_dll - nouvelles versions
» KGF_dll - nouvelles versions