2.02 du 5/3/2013: types de données "entiers" 8 et 16 bits

' analyze_BMP.bas

' La structure d'un fichier bitmap est la suivante :
'
'    En-tête du fichier (en anglais file header) (14 octets)
'    En-tête du bitmap (en anglais bitmap information header,
'        appelé aussi information Header)  (40 octets fi Wondows)
'    Palette (optionnellement)
'    Corps de l'image
'
' Entête du fichier
'
' L'entête du fichier fournit des informations sur le type de fichier
'  (Bitmap), sa taille et indique où commencent les informations concernant
' l'image à proprement parler.
'
' L'entête est composé de quatre champs :
'
'    La signature (sur 2 octets), indiquant qu'il s'agit d'un fichier BMP à l'aide des deux caractères.
'        BM, 424D en hexadécimal, indique qu'il s'agit d'un Bitmap Windows.
'        BA indique qu'il s'agit d'un Bitmap OS/2.
'        CI indique qu'il s'agit d'une icone couleur OS/2.
'        CP indique qu'il s'agit d'un pointeur de couleur OS/2.
'        IC indique qu'il s'agit d'une icone OS/2.
'        PT indique qu'il s'agit d'un pointeur OS/2.
'    La taille totale du fichier en octets (codée sur 4 octets)
'    Un champ réservé (sur 4 octets)
'    L'offset de l'image (sur 4 octets), en français décalage,
'        c'est-à-dire l'adresse relative du début des informations
'        concernant l'image par rapport au début du fichier
'
' Entête de l'image
'
' L'entête de l'image fournit des informations sur l'image,
' notamment ses dimensions et ses couleurs.
'
' L'entête de l'image est composé de quatre champs :
'
'    E1: La taille de l'entête de l'image en octets (codée sur 4 octets).
'    Les valeurs hexadécimales suivantes sont possibles suivant le type
'    de format BMP :
'        28 pour Windows 3.1x, 95, NT, ...
'        0C pour OS/2 1.x
'        F0 pour OS/2 2.x
'    E2: La largeur de l'image (sur 4 octets), c'est-à-dire le nombre
'        de pixels horizontalement (en anglais width)
'    E3: La hauteur de l'image (sur 4 octets), c'est-à-dire le nombre
'        de pixels verticalement (en anglais height)
'    E4a: Le nombre de plans (sur 2 octets). Cette valeur vaut toujours 1
'    E4b: La profondeur de codage de la couleur(sur 2 octets), c'est-à-dire
'      le nombre de bits utilisés pour coder la couleur.
'      Cette valeur peut-être égale à 1, 4, 8, 16, 24 ou 32
'    E5: La méthode de compression (sur 4 octets). Cette valeur
'      vaut 0 lorsque l'image n'est pas compressée,
'      ou bien 1, 2 ou 3 suivant le type de compression utilisé  :
'        1 pour un codage RLE de 8 bits par pixel
'        2 pour un codage RLE de 4 bits par pixel
'        3 pour un codage bitfields, signifiant que la couleur est
'          codé par un triple masque représenté par la palette
'    E6: La taille totale de l'image en octets (sur 4 octets).
'    E7: La résolution horizontale (sur 4 octets), c'est-à-dire le nombre
'      de pixels par mètre horizontalement
'    E8: La résolution verticale (sur 4 octets), c'est-à-dire le nombre
'      de pixels par mètre verticalement
'    E9: Le nombre de couleurs de la palette (sur 4 octets)
'    E10: Le nombre de couleurs importantes de la palette (sur 4 octets).
'        Ce champ peut être égal à 0 lorsque chaque couleur a son importance.

label ouvrir

dim taille_totale%, bidon%, offset_image%
dim E1%, E2%, E3%, E4a%, E4b%, E5%, E6%, E7%, E8%, E9%, E10%
dim nom$, buf$

KGF_initialize("KGF.dll")

open_dialog 1 : filter 1,"Fichiers BMP|*.bmp"
button 100 : top 100,10 : left 100,10 : caption 100,"Ouvrir" : on_click 100,ouvrir
memo 101 : top 101,40 : left 101,10 : width 101,400 : height 101,400
  font_name 101,"Courier"

end

ouvrir:
  nom$ = file_name$(1)
  if nom$="_" then return
  clear 101

  item_add 101,nom$
  ReadBlockFromBinaryFileToString(nom$,2,1)
  buf$ = ReadBlockFromBinaryFileToString$
  if buf$="BM" then item_add 101,"  signature: BM = Bitmap Windows"
  if buf$="BA" then item_add 101,"  signature: BA = Bitmap OS/2.
  if buf$="CI" then item_add 101,"  signature: CI = icone couleur OS/2.
  if buf$="CP" then item_add 101,"  signature: CP = pointeur de couleur OS/2.
  if buf$="IC" then item_add 101,"  signature: IC = icone OS/2.
  if buf$="PT" then item_add 101,"  signature: PT = pointeur OS/2.
  if buf$<>"BM"
    item_add 101,"Terminé."
    return
  end_if
 
  item_add 101,""
  item_add 101,"Entête du fichier:"
  ReadBlockFromBinaryFileToString(nom$,12,3)
  buf$ = ReadBlockFromBinaryFileToString$
  define_record(3)
  add_integer_field(adr(taille_totale%))
  add_integer_field(adr(bidon%))
  add_integer_field(adr(offset_image%))
  build_record()
  CopyBinaryStringToRecord(buf$,record$)
  item_add 101,"  Taille totale: "+str$(taille_totale%)
  item_add 101,"  Offset image: "+str$(offset_image%)
 
  item_add 101,""
  item_add 101,"Entête de l'image:"
  ReadBlockFromBinaryFileToString(nom$,40,15)
  buf$ = ReadBlockFromBinaryFileToString$
  define_record(10)
  add_integer_field(adr(E1%))
  add_integer_field(adr(E2%))
  add_integer_field(adr(E3%))
  add_word_field(adr(E4a%))
  add_word_field(adr(E4b%))
  add_integer_field(adr(E5%))
  add_integer_field(adr(E6%))
  add_integer_field(adr(E7%))
  add_integer_field(adr(E8%))
  add_integer_field(adr(E9%))
  add_integer_field(adr(E10%))
  build_record()
  CopyBinaryStringToRecord(buf$,record$)
  item_add 101,"  Taille entête image: "+str$(E1%)
  item_add 101,"  Largeur image: "+str$(E2%)
  item_add 101,"  Hauteur image: "+str$(E3%)
  item_add 101,"  Nombre de plans: "+str$(E4a%)
  item_add 101,"  Profondeur de codage de couleur: "+str$(E4b%)
  item_add 101,"  Méthode de compression: "+str$(E5%)
  item_add 101,"  Taille totale image: "+str$(E6%)+" octets"
  item_add 101,"  Résolution horizontale: "+str$(E7%)+" pixels/mètre"
  item_add 101,"  Résolution verticale: "+str$(E8%)+" pixels/mètre"
  item_add 101,"  Nombre de couleurs de la palette: "+str$(E9%)
  item_add 101,"  Nombre de couleurs importantes: "+str$(E10%)
  item_add 101,"  Terminé."
 
  return

#INCLUDE "KGF_SUB.bas"

' demo_fichier_binaire.bas

label click_option, supprimer, ajouter, remplacer, generer, fichier

dim i1_1%,i1_2%,i1_3%,i1_4%,i1_5%,i1_6%,i1_7%,i1_8%,i1_9%,i1_10%
dim i2_1%,i2_2%,i2_3%,i2_4%,i2_5%,i2_6%,i2_7%,i2_8%,i2_9%,i2_10%
dim i4_1%,i4_2%,i4_3%,i4_4%,i4_5%,i4_6%,i4_7%,i4_8%,i4_9%,i4_10%
dim f1,f2,f3,f4,f5,f6,f7,f8,f9,f10
dim s1$,s2$,s3$,s4$,s5$,s6$,s7$,s8$,s9$,s10$
initialiser_valeurs()

' *** chois d'une des deux solutions pour l'éciture:
dim solution% : solution% = 2
dim i%, k%, n_champ%, ok%, n%, textes$(5), type%, s$, buf$, nom$, nc%, p%
  textes$(1) = "Byte"
  textes$(2) = "Word"
  textes$(3) = "Integer"
  textes$(4) = "String"
  textes$(5) = "Float"

full_space 0
save_dialog 1


grid 10 : top 10,10 : left 10,10 : width 10,170 : height 10,280
  grid_column 10,3 : grid_row 10,11
    grid_one_column_width 10,1,40
    grid_one_column_width 10,2,80
    grid_one_column_width 10,3,40
  grid_write 10,1,1,"Champ"
  grid_write 10,1,2,"Type"
  grid_write 10,1,3,"Octets"
  for i%=1 to 10
    grid_write 10,i%+1,1,str$(i%)
  next i%

container 12 : top 12,10 : left 12,200 : width 12,300 : height 12,280
  caption 12,"Champ:"
alpha 13 : parent 13,12 : top 13,20 : left 13,10 : caption 13,"Numéro:"
edit 14 : parent 14,12 : top 14,20 : left 14,60 : width 14,40
container_option 21 : parent 21,12 : top 21,50 : left 21,10
  caption 21,"Type" : width 21,80 : height 21,130
option 22 : parent 22,21 : top 22,20 : left 22,10 : caption 22,"Byte"
  width 22,50 : on_click 22,click_option
option 23 : parent 23,21 : top 23,40 : left 23,10 : caption 23,"Word"
  width 23,50 : on_click 23,click_option
option 24 : parent 24,21 : top 24,60 : left 24,10 : caption 24,"Integer"
  width 24,50 : on_click 24,click_option
option 25 : parent 25,21 : top 25,80 : left 25,10 : caption 25,"String"
  width 25,50 : on_click 25,click_option
option 26 : parent 26,21 : top 26,100 : left 26,10 : caption 26,"Float"
  width 26,50 : on_click 26,click_option
alpha 27 : parent 27,12 : top 27,50 : left 27,120 : caption 27,"Octets:"
edit 28 : parent 28,12 : top 28,50 : left 28,170 : width 28,40 : inactive 28

button 30 : parent 30,12 : top 30,20 : left 30,120 : caption 30,"Supprimer"
  on_click 30,supprimer
button 31 : parent 31,12 : top 31,90 : left 31,120 : caption 31,"Ajouter"
  on_click 31,ajouter
button 32 : parent 32,12 : top 32,90 : left 32,200 : caption 32,"Remplacer"
  on_click 32,remplacer

container 50 : top 50,300 : left 50,10 : width 50,490 : height 50,110
  caption 50,"Enregistrement"
button 51 : parent 51,50 : top 51,20 : left 51,10 : caption 51,"Générer"
  on_click 51,generer
edit 52 : parent 52,50 : top 52,50 : left 52,10 : width 52,470
button 53 : parent 53,50 : top 53,80 : left 53,10 : caption 53,"Fichier"
  on_click 53,fichier : inactive 53

KGF_initialize("KGF.dll")

n_champ% = 0

end

click_option:
  inactive 53
  select number_click
    case 22
      text 28,"1"
    case 23
      text 28,"2"
    case 24
      text 28,"4"
    case 25
      text 28,"30"
    case 26
      text 28,"8"
  end_select
  return

supprimer:
  inactive 53
  tester_numero()
  if ok%=0 then return
  if n%<n_champ%
    for i%=n% to n_champ%-1
      grid_write 10,i%+1,2,grid_read$(10,i%+2,2)
      grid_write 10,i%+1,3,grid_read$(10,i%+2,3)
    next i%
  end_if
  grid_write 10,n_champ%+1,2,""
  grid_write 10,n_champ%+1,3,""
  n_champ% = n_champ% - 1
  text 14,str$(n_champ%)
  return
 
ajouter:
  inactive 53
  if n_champ%=10
    message "Trop de champs."
    return
  end_if
  tester_longueur()
  if ok%=0 then return
  n_champ% = n_champ% + 1
  text 14,str$(n_champ%)
  n% = n_champ%
  for i%=22 to 26
    if checked(i%)=1 then type% = i% - 21
  next i%
  grid_write 10,n%+1,2,textes$(type%)
  grid_write 10,n%+1,3,text$(28)
  return
 
remplacer:
  inactive 53
  tester_numero()
  if ok%=0 then return
  tester_longueur()
  if ok%=0 then return
  for i%=22 to 26
    if checked(i%)=1 then type% = i% - 21
  next i%
  grid_write 10,n%+1,2,textes$(type%)
  grid_write 10,n%+1,3,text$(28)
  return
 
generer:
  inactive 53
  if n_champ%=0
    message "Aucun champ défini."
    return
  end_if
 
  define_record(n_champ%)
  for i%=1 to n_champ%
    s$ = grid_read$(10,i%+1,2)
    for k%=1 to 5
      if s$=textes$(k%)
        select k%
          case 1: byte(i%)
          case 2: word(i%)
          case 3: integer(i%)
          case 4: string(i%,val(grid_read$(10,i%+1,3)))
          case 5: float(i%)
        end_select
      end_if
    next k%
  next i%
  build_record()
  text 52,record$
  active 53
  return
 
fichier:
  nom$ = file_name$(1)
  if nom$="_" then return
 
  ' créer une chaîne de caractères de la longueur d'enregistrement nécessaire
  buf$ = string$(record%(0,1),".")
 
  ' créer un fichier avec la place pour 5 enregistrements
  WriteStringToBinaryFile(nom$,buf$)
  AppendStringToBinaryFile(nom$,buf$)
  AppendStringToBinaryFile(nom$,buf$)
  AppendStringToBinaryFile(nom$,buf$)
  AppendStringToBinaryFile(nom$,buf$)
 
if solution%=1
' 2 solutions pour écrire les données dans le fichier:
' 1ère solution:
' créer l'enregistrement en mémoire à partir des champs utilisés
  CopyRecordToBinaryString(buf$,record$)
' puis remplacer les 5 enregistrements bidons par les vrais,
' sous forme de chaîne de caractères binaires
  nc% = record%(0,1)
  for i%=1 to 5
    ReplaceStringInBinaryFile(nom$,buf$," ",nc%,(i%-1)*nc%+1,flag%)
  next i%
else
' 2ème solution:
' collecter les champs, construire l'enregistrement
' et l'écrire directement sur disque, en une seule opération
' en utilisant la notion d'enregistrement de longueur fixe
  WriteBinaryFileRecord(nom$,record$,1)
  WriteBinaryFileRecord(nom$,record$,2)
  WriteBinaryFileRecord(nom$,record$,3)
  WriteBinaryFileRecord(nom$,record$,4)
  WriteBinaryFileRecord(nom$,record$,5)
end_if

  return
 
 

sub tester_numero()
  ok% = 0
  if numeric(text$(14))=1
    n% = val(text$(14))
    if (n%>0) and (n%<=n_champ%) then ok% = 1
  end_if
  if ok%=0
    message "Numéro de champ invalide."
    exit_sub
  end_if
  ok% = 1
end_sub

sub tester_longueur()
  dim_local n%
  ok% = 0
  if numeric(text$(28))=1
    n% = val(text$(28))
    if n%>0 then ok% = 1
  end_if
  if ok%=0
    message "Longueur invalide."
    exit_sub
  end_if
  ok% = 1
end_sub

sub byte(x%)
  if x%=1 then add_byte_field(adr(i1_1%))
  if x%=2 then add_byte_field(adr(i1_2%))
  if x%=3 then add_byte_field(adr(i1_3%))
  if x%=4 then add_byte_field(adr(i1_4%))
  if x%=5 then add_byte_field(adr(i1_5%))
  if x%=6 then add_byte_field(adr(i1_6%))
  if x%=7 then add_byte_field(adr(i1_7%))
  if x%=8 then add_byte_field(adr(i1_8%))
  if x%=9 then add_byte_field(adr(i1_9%))
  if x%=10 then add_byte_field(adr(i1_10%))
 end_sub

sub word(x%)
  if x%=1 then add_word_field(adr(i2_1%))
  if x%=2 then add_word_field(adr(i2_2%))
  if x%=3 then add_word_field(adr(i2_3%))
  if x%=4 then add_word_field(adr(i2_4%))
  if x%=5 then add_word_field(adr(i2_5%))
  if x%=6 then add_word_field(adr(i2_6%))
  if x%=7 then add_word_field(adr(i2_7%))
  if x%=8 then add_word_field(adr(i2_8%))
  if x%=9 then add_word_field(adr(i2_9%))
  if x%=10 then add_word_field(adr(i2_10%))
end_sub

sub integer(x%)
  if x%=1 then add_integer_field(adr(i4_1%))
  if x%=2 then add_integer_field(adr(i4_2%))
  if x%=3 then add_integer_field(adr(i4_3%))
  if x%=4 then add_integer_field(adr(i4_4%))
  if x%=5 then add_integer_field(adr(i4_5%))
  if x%=6 then add_integer_field(adr(i4_6%))
  if x%=7 then add_integer_field(adr(i4_7%))
  if x%=8 then add_integer_field(adr(i4_8%))
  if x%=9 then add_integer_field(adr(i4_9%))
  if x%=10 then add_integer_field(adr(i4_10%))
end_sub

sub string(x%, l%)
  if x%=1 then add_string_field(adr(s1$), l%)
  if x%=2 then add_string_field(adr(s2$), l%)
  if x%=3 then add_string_field(adr(s3$), l%)
  if x%=4 then add_string_field(adr(s4$), l%)
  if x%=5 then add_string_field(adr(s5$), l%)
  if x%=6 then add_string_field(adr(s6$), l%)
  if x%=7 then add_string_field(adr(s7$), l%)
  if x%=8 then add_string_field(adr(s8$), l%)
  if x%=9 then add_string_field(adr(s9$), l%)
  if x%=10 then add_string_field(adr(s10$), l%)
end_sub

sub float(x%)
  if x%=1 then add_float_field(adr(f1))
  if x%=2 then add_float_field(adr(f2))
  if x%=3 then add_float_field(adr(f3))
  if x%=4 then add_float_field(adr(f4))
  if x%=5 then add_float_field(adr(f5))
  if x%=6 then add_float_field(adr(f6))
  if x%=7 then add_float_field(adr(f7))
  if x%=8 then add_float_field(adr(f8))
  if x%=9 then add_float_field(adr(f9))
  if x%=10 then add_float_field(adr(f10))
end_sub

sub initialiser_valeurs()
i1_1% = 1
i1_2% = 2
i1_3% = 3
i1_4% = 4
i1_5% = 5
i1_6% = 6
i1_7% = 7
i1_8% = 8
i1_9% = 9
i1_10% = 10

i2_1% = 1
i2_2% = 2
i2_3% = 3
i2_4% = 4
i2_5% = 5
i2_6% = 6
i2_7% = 7
i2_8% = 8
i2_9% = 9
i2_10% = 10

i4_1% = 1
i4_2% = 2
i4_3% = 3
i4_4% = 4
i4_5% = 5
i4_6% = 6
i4_7% = 7
i4_8% = 8
i4_9% = 9
i4_10% = 10

f1 = 1
f2 = 2
f3 = 3
f4 = 4
f5 = 5
f6 = 6
f7 = 7
f8 = 8
f9 = 9
f10 = 10

s1$ = left$("chaîne 1"+string$(30," "),30)
s2$ = left$("chaîne 2"+string$(30," "),30)
s3$ = left$("chaîne 3"+string$(30," "),30)
s4$ = left$("chaîne 4"+string$(30," "),30)
s5$ = left$("chaîne 5"+string$(30," "),30)
s6$ = left$("chaîne 6"+string$(30," "),30)
s7$ = left$("chaîne 7"+string$(30," "),30)
s8$ = left$("chaîne 8"+string$(30," "),30)
s9$ = left$("chaîne 9"+string$(30," "),30)
s10$ = left$("chaîne 10"+string$(30," "),30)

end_sub


#INCLUDE "KGF_SUB.bas"

' fichier_contact_comme_fichier_binaire.bas

' Il faut voir ce code, non pas comme un programme complet
' fonctionnel, mais plutôt comme une suite de segments de
' code gérant chacun un aspect particulier de l'accès aux
' fichiers binaires.

' Dans le cas présent, je montre comment on peut utiliser
' les méthodes d'accès aux fichiers binaires pour gérer un
' fichier en texte pur, mais dont chaque enregistrement a la
' même longueur et est composé de champs texte de longueur fixe.
' Les CR LF en fin de ligne sont gérés eux-mêmes par un champ
' texte de 2 caractères.

' simple précaution - voir commentaires ci-dessus
message "Attention ! Ce programme n'est pas conçu pour être exécuté !"
terminate

' zones de données pour le fichier client
dim code$, nom$, prenom$, adresse1$, adresse2$
dim codpost$, ville$, tel$, mail$, crlf$

' variables du programme
dim fichier$ : fichier$ = ".\contact.dat"
dim n_contact% : ' nombre de contacts dans le fichier
dim enreg$ : ' servira pour créer des images mémoire d'un enregistrement
dim position%, nrec% : ' variables pour la recherche

' pour memoriser des informations dont le nombre est inconnu
dlist 1

' réserver l'espace pour les zones
'    (adapter les tailles selon les besoins)
code$ = string$(10," ")
nom$ = string$(40," ")
prenom$ = string$(40," ")
adresse1$ = string$(40," ")
adresse2$ = string$(40," ")
codpost$ = string$(5," ")
ville$ = string$(40," ")
tel$ = string$(20," ")
mail$ = string$(40," ")
crlf$ = chr$(13) + chr$(10)

' indispensable pour accéder aux fonctions
KGF_initialize("KGF.dll")

' préparer l'enregistrement de 10 champs
define_record(10)

' ajouter les champs - tous en format chaîne de caractères
add_string_field(adr(code$,10)
add_string_field(adr(nom$,40)
add_string_field(adr(prenom$,40)
add_string_field(adr(adresse1$,40)
add_string_field(adr(adresse2$,40)
add_string_field(adr(codpost$,5)
add_string_field(adr(ville$,40)
add_string_field(adr(tel$,20)
add_string_field(adr(mail$,40)
add_string_field(adr(crlf$,2)

' construire la définition de l'enregistrement
build_record()
' ==> record%(0,1) contient la longueur réelle de l'enregistrement !
enreg$ = string$(record%(0,1)," ")

' créer le fichier vide si inexistant
if file_exists(fichier$)=0
  file_open_write 1,fichier$
  file_close 1
end_if

' déterminer le nombre d'enregistrements actuel
GetBinaryFileSize(nom$)
n_contact% = GetBinaryFileSize/record%(0,1) : ' le CR LF fait partie !

' ouvrir le fichier de façon permanente pour accélérer les accès
OpenBinaryFile(nom$)

' lire l'enregistrement numéro 17
ReadBinaryFileRecord(nom$,record$,17)
' ==> toutes les variables de l'enregistrement sont chargées par
'    le contenu du fichier. On peut maintenant modifier librement
'    les variables (veiller à ce qu'elles gardent la bonne
'    longueur !), puis réécrire l'enregistrement dans le fichier.

' écrire l'nregistrement numéro 17
WriteBinaryFileRecord(nom$,record$,17)
'et oui, c'est aussi simple que ça...

' ajouter un nouvel enregistrement. Pour cela, on crée une chaîne
' de caractères contenant l'image de l'enregistrement:
CopyRecordToBinaryString(enreg$,record$)
' puis on ajoute cette chaîne de caractères à la fin du fichier
AppendStringToBinaryFile(nom$,enreg$)

' chercher tous les contactes dont le nom commence par "Dup", comme
' Dupont, Dupond, Dupain, ...
' effacer la liste des numéros d'enregistrements
clear 1
position% = 1 : ' commencer au premier caractère
while position%>0
  SearchPatternInBinaryFile(nom$,"Pat",position%)
  if position%>0 : ' on a trouvé un candidat ?
    ' déterminer le numéro d'enregistrement
    nrec% = int(position%/record%(0,1))
    ' mémoriser ce numéro
    item_add 1,str$(nrec%)
    ' soit: passer au début de l'enregistrement suivant
    position% = nrec%*record%(0,1) + 1
    ' soit: continuer la recherche à partir de la position trouvée
    position% = position% + 1
  end_if
end_while
message "On a trouvé "+str$(count(1))+" candidats"

' refermer le fichier pour libérer les ressources - IMPORTANT !
CloseBinaryFile(nom$)


end

' contient la définition de toutes les procédures utilisant KGF.dll
#INCLUDE "KGF_SUB.bas"