Compilateur FBPano

dim u%(50),v%(50),i%,num%,num1%

set_scheme "gtk+"
form 0, 100, 100, 650, 500, "Test"
list 200, 400, 60, 50, 350, "200"
list 210, 450, 60, 50, 350, "210"
list 220, 500, 60, 50, 350, "220"
list 230, 550, 60, 50, 350, "230"

button 102, 40, 380, 100, 25
Caption 102,"tirage"

button 103, 220, 380, 100, 25
Caption 103,"tirage"
on_click 102,tirage_nombres
on_click 103,tirage_nombres_2

for i%= 1 to 50
item_add 100,str$(i%)
next i%
for i%= 51 to 100
item_add 120,str$(i%)
next i%
nombres()
nombres2()
start 0
end

Sub tirage_nombres()
init()
dim l%,n%,a$,c%
for i%= 1to 5
c%= item_count(200)
print c%
for l%= 1 to c%
Randomize
n%= (int(c% * Rnd)+1)
next l%
a$=item_read(200,n%)
num%=n%
num%=val(a$)
item_delete 200,n%
' print num%
coul_nombres()
next i%
end sub

Sub tirage_nombres_2()
init2()
dim l%,n%,a$,c%
for i%= 1to 5
c%= item_count(220)
for l%= 1 to c%
Randomize
n%= (int(c% * Rnd)+1)
next l%
a$=item_read(220,n%)
num1%=n%
num1%=val(a$)
item_delete 220,n%
' print num1%
coul_nombres_2()
next i%
end sub

sub coul_nombres()
 dim x%,y%,w%,h%
hide 1  ' s'il n'y a pas d'action au préalable sur un objet get_xywh ne fonctionne pas
get_xywh num%, x%, y%, w%, h%
x%=x%-3
y%=y%-3
w%=30
h%=30
resize num%, x%, y%, w%, h%
font_caption num%,FL_TIMES_BOLD,20
color_fl num%, FL_Yellow
print num%
u%(num%)=num%
item_add 210,str$(num%)
show 1
end sub

sub coul_nombres_2()
 dim x%,y%,w%,h%
hide 51 ' s'il n'y a pas d'action au préalable sur un objet get_xywh ne fonctionne pas
get_xywh num1%, x%, y%, w%, h%
x%=x%-3
y%=y%-3
w%=30
h%=30
resize num1%, x%, y%, w%, h%
font_caption num1%,FL_TIMES_BOLD,20
color_fl num1%, FL_Yellow
print num1%
v%(num1%)=num1%
item_add 230,str$(num1%)
show 51
end sub

sub nombres() ' Construction par Matwidget

dim obj%,nfirst%,nlast%,i% ' schème ok comme défini au départ
dim x%,y%,w%,h%
nfirst = 1
nlast = matwidget(T_Button, 10, 5, 1, 20, 60, 25, 25, 5, 5, 2)
for obj% = nfirst to nlast
  caption obj, str(obj)
  set_box_type obj, 54
  color_fl obj%, FL_cyan
next obj
end sub

sub nombres2() ' construction plus conventionnelle

set_scheme "gtk+" ' pas de schème dans cette configuration
dim obj%,i%,x%,y%,w%,h%
x%=200:y%=60:w%=25:h%=25
for obj%=51 to 96 step 5
button obj%,x%,y%,25,25,str$(obj%-50)
color_fl obj%, FL_cyan
y%=y%+30
next obj%
x%=230:y%=60
for obj%=52 to 97 step 5
button obj%,x%,y%,25,25,str$(obj%-50)
color_fl obj%, FL_cyan
y%=y%+30
next obj%
x%=260:y%=60
for obj%=53 to 98 step 5
button obj%,x%,y%,25,25,str$(obj%-50)
color_fl obj%, FL_cyan
y%=y%+30
next obj%
x%=290:y%=60
for obj%=54 to 99 step 5
button obj%,x%,y%,25,25,str$(obj%-50)
color_fl obj%, FL_cyan
y%=y%+30
next obj%
x%=320:y%=60
for obj%=55 to 100 step 5
button obj%,x%,y%,25,25,str$(obj%-50)
color_fl obj%, FL_cyan
y%=y%+30
next obj%
end sub

sub init() ' récupération des nombres du précédent tirage et remise en forme du tableau
dim font
dim l%,a$,z%
dim x%,y%,w%,h%
font= num_font("arial")
list_clear 200
for i%= 1 to 50
item_add 200,str$(i%)
next i%
l%=item_count(210)
for i%= 1 to l%
a$=item_read (210,i%)
z%=val(a$)
get_xywh z%,x%, y%, w%, h%
x%=x%+3
y%=y%+3
w%=25
h%=25
resize z%, x%, y%, w%, h%
font_caption z%,font,12
color_fl z%, FL_cyan
next i%
list_clear 210
end sub

sub init2() ' récupération des nombres du précédent tirage et remise en forme du tableau
dim font
dim l%,a$,z%
dim x%,y%,w%,h%
font= num_font("arial")
list_clear 220
for i%= 51 to 100
item_add 220,str$(i%)
next i%
l%=item_count(230)
for i%= 1 to l%
a$=item_read (230,i%)
z%=val(a$)
get_xywh z%,x%, y%, w%, h%
x%=x%+3
y%=y%+3
w%=25
h%=25
resize z%, x%, y%, w%, h%
font_caption z%,font,12
color_fl z%, FL_cyan
next i%
list_clear 230
end sub

type myUDT = (a%, b, c$)

dim ts<myUDT>(100)  ' tableau statique (taille constante)

dim td<myUDT>()     ' tableau dynamique (taille variable)

dim n%

randomize timer
n = rnd * 100

redim td<myUDT>(n)  ' "redim preserve" pour garder le contenu précédent

td(n).a = 10
td(n).b = 3.14
td(n).c = "hello"

? n, ubound(td), td(n).a, td(n).b, td(n).c

sub coul_nombres()
dim x%,y%,w%,h%
get_xywh num%, x%, y%, w%, h%
x%=x%-3
y%=y%-3
w%=30
h%=30
resize num%, x%, y%, w%, h%
font_caption num%,FL_TIMES_BOLD,20
color_fl num%, FL_Yellow
print num%
u%(num%)=num%
item_add 210,str$(num%)
redraw
end sub

dim L1 <dlist>
dim L2 <dlist>

dim L <dlist> (10)

form fmPolice, 200, 200, 380, 420, "Liste des polices"

form_begin fmPolice
  list lsPolice,  5,  5, 280, 380
    dim nf%, i% , num%(), font$()     
    nf = font_list(lsPolice, font())
    for i = 0 to nf - 1
      list_item_add lsPolice, "@S20@F" & num(i) & font(i)
    next i
form_end fmPolice

nf = font_list(num(), font())

form fmPolice, 200, 200, 380, 420, "Liste des polices"

form_begin fmPolice
  list lsPolice,  5,  5, 280, 380
    dim nf%, i% , num%(), font$()   
    nf = font_list(num(), font())
    for i = 0 to nf - 1
      list_item_add lsPolice, "@S20@F" & num(i) & font(i)
    next i
form_end fmPolice

....................................................................
dim obj%                            ' Numéro d'objet
dim i%                              ' Variable de boucle
dim nf%                             ' Nombre de polices
dim num%()                          ' Numéros des polices
dim font$()                         ' Noms des polices

enum GUI
.....
  fmPolice
    lsPolice
end_enum

' Fenetre des polices

form fmPolice, 200, 200, 380, 420, "Liste des polices"

form_begin fmPolice
  list lsPolice,  5,  5, 280, 380
  nf = font_list(num(), font())
  for i = 0 to nf - 1
    list_item_add lsPolice, "@S20@F" & num(i) & font(i)
  next i
form_end fmPolice

dim frm <T_Form>
dim btn <T_Button>

' **********************************************************************
' Editeur FBPano, d'apres le programme de demonstration de FLTK :
' www.fltk.org/doc-1.3/editor.html
' **********************************************************************

const FORM_WIDTH  = 850           ' Largeur de la fenetre principale
const FORM_HEIGHT = 500           ' Hauteur de la fenetre principale
const FONT        = FL_COURIER    ' Police de caracteres
const FONT_SIZE   = 15            ' Taille des caracteres
const FONT_COLOR  = FL_BLACK      ' Couleur du texte
const BKG_COLOR   = FL_WHITE      ' Couleur du fond
const LNUM_COLOR  = FL_RED        ' Couleur des numeros de lignes
const LNUM_WIDTH  = 60            ' Largeur de la marge pour num. lignes

dim search$                       ' Chaine pour la recherche
dim find$, rep$                   ' Chaines pour le remplacement
dim obj%                            ' Numéro d'objet
dim i%                              ' Variable de boucle
dim nf%                             ' Nombre de polices
dim num%()                          ' Numéros des polices
dim font$()                         ' Noms des polices

enum GUI
  fmMain
    menu1, editor1, buffer1
  fmReplace
    edFind, edReplace, btRepAll, btRepNext, btCancel
  fmPolice
    lsPolice
end_enum

form fmMain, 100, 100, FORM_WIDTH, FORM_HEIGHT, "Editeur"

form_begin fmMain
  menu        menu1,    0,  0, FORM_WIDTH, 25
  text_editor editor1,  0, 25, FORM_WIDTH, FORM_HEIGHT - 25
  text_buffer buffer1
form_end fmMain

form fmReplace, 200, 200, 380, 110, "Remplacement"

form_begin fmReplace
  edit   edFind,    110, 10, 260, 25, "Chercher :"
  edit   edReplace, 110, 40, 260, 25, "Remplacer par :"
  button btRepAll,   10, 75, 110, 25, "Remplacer tout"
  button btRepNext, 130, 75, 170, 25, "Remplacer Suivant", , T_Button_Return
  button btCancel,  310, 75,  60, 25, "Fermer"
form_end fmReplace

on_click btRepAll, remplacer_tout
on_click btRepNext, remplacer_suivant
on_click btCancel, annuler_remplacer

form fmPolice, 200, 200, 380, 420, "Liste des polices"

form_begin fmPolice
  list lsPolice,  5,  5, 280, 380
    nf = font_list(num(), font())
    for i = 0 to nf - 1
      list_item_add lsPolice, "@S20@F" & num(i) & font(i)
    next i
form_end fmPolice

on_click lsPolice, choix_police

menu_item_add menu1, "&Fichier/&Nouveau  ", "Ctrl+N", , nouveau
menu_item_add menu1, "&Fichier/&Ouvrir  ", "Ctrl+O", , ouvrir
menu_item_add menu1, "&Fichier/&Enregistrer  ", "Ctrl+E", FL_MENU_DIVIDER, enregistrer
menu_item_add menu1, "&Fichier/&Quitter  ", "Ctrl+Q", , quitter

menu_item_add menu1, "&Edition/Co&uper  ", "Ctrl+X", , couper
menu_item_add menu1, "&Edition/&Copier  ", "Ctrl+C", , copier
menu_item_add menu1, "&Edition/C&oller  ", "Ctrl+V", , coller

menu_item_add menu1, "&Recherche/&Rechercher  ", "Ctrl+F", , rechercher
menu_item_add menu1, "&Recherche/Rechercher le &suivant  ", "F3", , rechercher_suivant
menu_item_add menu1, "&Recherche/R&emplacer  ", "Ctrl+R", , remplacer

menu_item_add menu1, "&Options/&Wrap  ", , FL_MENU_TOGGLE, wrap
menu_item_add menu1, "&Options/&Num. lignes  ", , FL_MENU_TOGGLE + FL_MENU_VALUE, numlines
menu_item_add menu1, "&Options/&Police  ", "Ctrl+P", , police

color_fl editor1, BKG_COLOR
font_text editor1, FONT, FONT_SIZE
color_text_fl editor1, FONT_COLOR
color_cursor_fl editor1, FONT_COLOR
color_numlines_fl editor1, LNUM_COLOR
editor_numlines editor1, LNUM_WIDTH, FONT, FONT_SIZE

editor_set_buffer editor1, buffer1

set_resizable fmMain

start fmMain

' ----------------------------------------------------------------------
' Sous-programmes utilitaires
' ----------------------------------------------------------------------

function trouve% (s$, p%, msg%)
' Recherche la chaine s à partir de la position du curseur
' La position de la chaine trouvee est retournee dans p
' msg = TRUE pour afficher le message d'erreur

  p = editor_get_insert_pos(editor1)
  if buffer_search_forward(buffer1, p, s, p) = 0 then
    if msg then message "Chaîne """ + s + """ non trouvée !"
    trouve = FALSE
  else
    trouve = TRUE
  end_if
end_function

sub update_editor (p%, s1$, s2$, rpl%)
' Met a jour l'editeur apres recherche ou remplacement
' p = position de la chaine recherchee
' s1 = chaine recherchee
' s2 = chaine de remplacement
' rpl = indique si remplacement

  dim p1%

  p1 = p + len(s1)
  buffer_select buffer1, p, p1

  if rpl then
    buffer_remove_select buffer1
    buffer_insert buffer1, p, s2
    p1 = p + len(s2)
    buffer_select buffer1, p, p1
    p = p1
  end_if

  editor_set_insert_pos editor1, p1
  editor_show_insert_pos editor1
end_sub

' ----------------------------------------------------------------------
' Sous-programmes associes aux evenements
' ----------------------------------------------------------------------

sub nouveau
  text buffer1, ""
  caption fmMain, "Editeur"
end_sub

sub ouvrir
  dim fname$
  fname = file_name("Ouvrir", "Fichier texte (*.txt)", curdir, 0)
  if fname = "" or file_exists(fname) = 0 then exit_sub
  buffer_file_load buffer1, fname
  caption fmMain, fname
end_sub

sub enregistrer
  dim fname$
  fname = file_name("Enregistrer", "Fichier texte (*.txt)", curdir, 0)
  if fname = "" then exit_sub
  buffer_file_save buffer1, fname
end_sub

sub quitter
  hide fmMain
end_sub

sub couper
  editor_cut editor1
end_sub

sub copier
  editor_copy editor1
end_sub

sub coller
  editor_paste editor1
end_sub

sub rechercher
  dim p%
  search = message_input("Rechercher", "Rechercher", search)
  if search <> "" then
    if trouve(search, p, TRUE) then update_editor p, search, "", FALSE
  end if
end_sub

sub rechercher_suivant
  dim p%
  if search = "" then
    search = message_input("Rechercher", "Rechercher", search)
  end_if
  if search <> "" then
    if trouve(search, p, TRUE) then update_editor p, search, "", FALSE
  end if
end_sub

sub remplacer
  show fmReplace
end_sub

sub remplacer_suivant
  dim p%
  find = get_text(edFind)
  if find = "" then exit_sub
  rep = get_text(edReplace)
  if trouve(find, p, TRUE) then update_editor p, find, rep, TRUE
end_sub

sub remplacer_tout
  dim p%, found%, n%
  find = get_text(edFind)
  if find = "" then exit_sub
  rep = get_text(edReplace)
  found = trouve(find, p, TRUE)
  if not found then exit_sub
  while found
    n = n + 1
    update_editor p, find, rep, TRUE
    found = trouve(find, p, FALSE)
  end_while
  message "Chaîne """ & find & """ remplacée " & n & " fois."
end_sub

sub annuler_remplacer
  hide fmReplace
end_sub

sub wrap
  editor_wrap editor1, menu_item_checked(menu1, 17)
end_sub

sub numlines
  dim n%
  if menu_item_checked(menu1, 18) then n = LNUM_WIDTH else n = 0
  editor_numlines editor1, n, , FONT_SIZE
end_sub

sub police
  show fmPolice
end_sub

sub choix_police
  ' Intégrer ici la routine de selection de la police
  hide fmPolice
end_sub