Compilateur : version de travail disponible

on_click 99,stp

dim i,rep$ : rep$ = dir_current$ + "\"
full_space 0:scene3d 1:full_space 1:color 1,100,100,0
caption 0,"<CLICK> pour arrêter"
cam_position 0,0,5:point_position 0,0,0
3d_mesh 1:3d_load_object 1,rep$+"bird.3ds"
3d_position 1,-1,-2,-10:3d_y_rotate 1,90:3d_scale 1,.031,.031,.031 : 3d_x_rotate 1,90
while scancode=0
   3d_z_rotate 1,i:i=i+.25:if i=360 then i=0
end_while
terminate

 sub creer_bouton(param1%, param2%, param3$, param4%, param5%, param6%, param7%)
……
end_sub

dim x, y

x = 1.23456
y = frac(x)

print x
print y

end

' **********************************************************************
' Mandelbrot set : z(n) = z(n-1)^2 + c
' **********************************************************************

dim PicWidth%      : PicWidth%      = 640
dim PicHeight%     : PicHeight%     = 480
dim HalfPicWidth%  : HalfPicWidth%  = PicWidth% / 2
dim HalfPicHeight% : HalfPicHeight% = PicHeight% / 2

dim Ln2   : Ln2   = log(2)
dim Esc   : Esc   = 10000000000  : ' Escape radius
dim Esc2  : Esc2  = Esc * Esc
dim LnEsc : LnEsc = log(Esc)

dim H, S, V, R%, G%, B%          : ' Color parameters

dim x0, y0         : ' Center of picture
dim MaxIter%       : ' Maximum iteration number
dim ZoomFact       : ' Zoom factor
dim DistFact       : ' Conversion factor (Distance estimator --> V)
dim ColorFact      : ' Conversion factor (Continuous dwell --> H, S)
dim AbsColor       : ' abs(ColorFact)
dim ScaleFact      : ' Scale factor (distance between 2 pixels)

dim Nx%, Ny%       : ' Point coordinates (pixels)
dim xt, yt         : ' Point coordinates (algebraic)

dim Iter%          : ' Iteration number
dim zn_x, zn_y     : ' Complex number z(n)
dim dzn_x, dzn_y   : ' Derivative dz(n) / dc


' Variables used internally by the subprograms
dim II%, ZZ, FF, PP, QQ, TT, RR, GG, BB                             : ' HSVtoRGB
dim mod_zn , mod_dzn, ln_mod_zn, Dist, Dwell, D, Q, Angle, Radius   : ' MdbCol
dim x, y, x2, y2, xy, dx, dy, M2

label HSVtoRGB, MdbCol, Mandelbrot


' ----------------------------------------------------------------------
' Object description
' ----------------------------------------------------------------------

' Main window

left    0, 50
top     0, 50
width   0, PicWidth% + 70
height  0, PicHeight% + 120
caption 0, "Mandelbrot set : z(n) = z(n-1)^2 + c"

' Picture

picture 1
left    1, 30
top     1, 40
width   1, PicWidth%
height  1, PicHeight%

2d_target_is 1

' ----------------------------------------------------------------------
' Main program : Elephant valley picture
' ----------------------------------------------------------------------

x0        =  0.26502185290119
y0        =  0.00302941971904756
MaxIter%  =  10000
ZoomFact  =  4000000000
DistFact  = -1
ColorFact = -9

ColorFact = 0.01 * ColorFact
AbsColor  = abs(ColorFact)
ScaleFact = 4 / (PicHeight% * ZoomFact)

for Ny% = 0 to PicHeight% - 1
 yt = y0 - ScaleFact * (Ny% - HalfPicHeight%)
 for Nx% = 0 to PicWidth% - 1
   xt = x0 + ScaleFact * (Nx% - HalfPicWidth%)
   gosub Mandelbrot
   2d_pen_color R%, G%, B%
   2d_point Nx%, Ny%
 next Nx%
next Ny%

end

' ----------------------------------------------------------------------
' Subprograms
' ----------------------------------------------------------------------

HSVtoRGB:
' Conversion HSV --> RGB.
' Input : H, S, V. Output : R%, G%, B%

 if S = 0
   R% = int(V * 255)
   G% = R%
   B% = R%
   return
 end_if

 ZZ  = H / 60
 II% = int(ZZ)
 FF  = ZZ - int(ZZ)
 PP  = V * (1 - S)
 QQ  = V * (1 - S * FF)
 TT  = V * (1 - S * (1 - FF))

 select II%
   case 0
     RR = V  : GG = TT : BB = PP
   case 1
     RR = QQ : GG = V  : BB = PP
   case 2
     RR = PP : GG = V  : BB = TT
   case 3
     RR = PP : GG = QQ : BB = V
   case 4
     RR = TT : GG = PP : BB = V
   case 5
     RR = V  : GG = PP : BB = QQ
 end_select

 R% = int(RR * 255)
 G% = int(GG * 255)
 B% = int(BB * 255)
return

MdbCol:
' Determines the color of a point
' Input : Iter%, zn_x, zn_y, dzn_x, dzn_y
' Output: R%, G%, B%

 mod_zn  = sqr(zn_x * zn_x + zn_y * zn_y)
 mod_dzn = sqr(dzn_x * dzn_x + dzn_y * dzn_y)

 ln_mod_zn = log(mod_zn)

 Dist = 2 * mod_zn * ln_mod_zn / mod_dzn

' Determine Value (V) from Distance estimator (Dist)

 D = log(Dist / ScaleFact) / Ln2 + DistFact

 if D > 0
   V = 1
 else
   if D > -8
     V = 1 + D / 8
   else
     V = 0
   end_if
 end_if

' Determine Hue (H) and Saturation (S) from Continuous dwell

 Dwell = Iter% + log(LnEsc / ln_mod_zn) / Ln2
 Q = log(Dwell) * AbsColor

 if Q < 0.5
   Q = 1 - 1.5 * Q
   Angle = 1 - Q
 else
   Q = 1.5 * Q - 0.5
   Angle = Q
 end_if

 Radius = sqr(Q)

' If ColorFact > 0, darken every other stripe

 if (ColorFact > 0) and (Iter% mod 2 = 1)
   V = 0.85 * V
   Radius = 0.667 * Radius
 end_if

 H = Angle * 10
 H = H - int(H)
 H = H * 360
 
 S = Radius - int(Radius)
 
' Convert HSV to RGB  

 gosub HSVtoRGB
return

Mandelbrot:

 zn_x = 0
 zn_y = 0
 
 dzn_x = 0
 dzn_y = 0
 
 Iter% = 0
 M2 = 0

 while Iter% < MaxIter% and M2 < Esc2
 
   x = zn_x
   y = zn_y

   dx = dzn_x
   dy = dzn_y

   x2 = x * x
   y2 = y * y
   xy = x * y

   zn_x = x2 - y2 + xt
   zn_y = 2 * xy + yt

   dzn_x = 2 * (x * dx - y * dy) + 1
   dzn_y = 2 * (x * dy + y * dx)

   M2 = x2 + y2
   Iter% = Iter% + 1

 end_while
 
 if Iter% = MaxIter%
   R% = 255
   G% = 255
   B% = 255
   return
 end_if

 gosub MdbCol
return

 if (ColorFact > 0) and   (Iter% mod 2 = 1)

 if (ColorFact > 0) and (mod(iter%,2) = 1)

 if (ColorFact > 0) and (odd(iter%) > 0)

dim a,b,sx,sy,ba(1999),bv(1999),bx(1999),by(1999)
dim pi2 : pi2 = 2*acos(-1)
full_space 0 : color 0,0,0,0 : sx = screen_x : sy = screen_y
for b = 0 to 1500
    ba(b) = rnd(1)*pi2 : bv(b) = 5 + rnd(5): bx(b) = rnd(sx): by(b) = rnd(sy)
next b
for a = 1 to 1000
   for b = 0 to 1999
       bx(b) = bx(b) + sin(ba(b)) * bv(b) : by(b) = by(b) + cos(ba(b)) * bv(b)
       2d_pen_color 255,255,255 : 2d_point sx/2 + bx(b)/80, sy/2 + by(b)/80
       2d_pen_color 255,255,0    : 2d_point sx/2 + bx(b)/50, sy/2 + by(b)/50
       2d_pen_color 255,0,0       : 2d_point sx/2 + bx(b)/25, sy/2 + by(b)/25
       2d_pen_color 0,255,0       : 2d_point sx/2 + bx(b)/15, sy/2 + by(b)/15
       2d_pen_color 0,0,255       : 2d_point sx/2 + bx(b)/10, sy/2 + by(b)/10
   next b
next a
caption 0,"Terminé"
rem ============================================================================

' Variables de la tool_bar
dim system$, position_toolbar%, icon_size%,ilb$,chg_hor%, chg_ver%,icon$, after%, hint$
' Variables de la dll
dim KGF$,res%
' Autres variables
dim bouton%,ii%
dim D$,x%,M%,sep%,Lig$,L%
dim s$,hnd%, hnd0%, titre$
' ##############################################################################

' Labels de la tool_bar
label click_toolbar,adapter_container
' Autres labels
label Init,init_list,Selection,Ajouter,Supprimer,Close0
label Init_F100,Couleur104,Enregistrer,Connection
' ##############################################################################

' Initialisation des variables
system$="W7"
position_toolbar%=0
icon_size%=16
chg_hor% =16
chg_ver% =(icon_size%-16)+76
ilb$="C:\Users\Yannick\Desktop\Panoramic\Projet1\MDC.ilb"
KGF$=dir_current$+"\KGF.dll"

' ##############################################################################

' Ouverture de la dll
dll_on KGF$

' ##############################################################################

' Interface

Width 0,250 :height 0,360:top 0,(screen_y-360)/2 :left 0,(screen_x-250)/2
caption 0,"Connect to Mydrive"

edit 1 : hide 1
on_change 1,click_toolbar

dlist 9

container 10

res% = dll_call4("CreateToolbar",handle(0),handle(1),handle(10),position_toolbar%)
res% = dll_call4("ModifyToolbar",7,icon_size%,0,0)
Width 0,250 :height 0,360
gosub adapter_container
res% = dll_call4("ModifyToolbar",8,1,0,0)
res% = dll_call4("ModifyToolbar",2,0,0,0)
hint$ = "Ajouter une adresse"
icon$ = "KGF_44"
res% = dll_call4("AddButtonToToolbar",1,0,adr(hint$),adr(icon$))
hint$ = "Supprimer une adresse"
icon$ = "KGF_62"
res% = dll_call4("AddButtonToToolbar",2,1,adr(hint$),adr(icon$))
hint$ = "Connection à l'adresse sélectionné"
icon$ = "KGF_252"
res% = dll_call4("AddButtonToToolbar",3,2,adr(hint$),adr(icon$))

List 11: Parent 11,10:top 11,5:height 11,(height(10)-7):width 11,width(10)
font_name 11,"arial":font_size 11,10:cursor_point 11
on_click 11,Selection

gosub init

end

' ##############################################################################

Init:
   D$=Dir_current$
   if file_exists(D$+"\Connect.Bdd")=1
      file_load 9,D$+"\Connect.Bdd"
   else
      file_open_write 100,D$+"\Connect.Bdd":file_close 100
      res% = dll_call4("ModifyToolbar",3,3,0,0)
   end_if
   if count(9)>0 :gosub init_list:end_if
return

Init_list:
   clear 11
   if count(9)>0
      for x%=1 to count(9)
         Lig$=item_read$(9,x%)
         sep%=instr(Lig$,";")
         item_add 11,left$(Lig$,sep%-1)
      next x%
      res% = dll_call4("ModifyToolbar",3,3,1,0)
   else
      res% = dll_call4("ModifyToolbar",3,3,0,0)
   end_if
return

Click_Toolbar:
  if text$(1)="-1"
    gosub adapter_container
  else
    bouton%=val(text$(1))
    select bouton%
    case 1
       gosub Ajouter
    case 2
       if ii%>0 :gosub Supprimer:else:message "Veuillez sélectionner un compte .":end_if
    case 3
       if ii%>0 :gosub Connection:else:message "Veuillez sélectionner un compte .":end_if
    end_select
  end_if
return

Adapter_Container:
  select position_toolbar%
    case 0
      top 10,icon_size%+10
      width 10,(width(0)-chg_hor%)
      height 10,(height(0)-chg_ver%)
    case 1
      left 10,icon_size%+12
      width 10,(width(0)-chg_hor%)
      height 10,(height(0)-chg_ver%)
    case 2
      width 10,(width(0)-chg_hor%)
      height 10,(height(0)-chg_ver%)
    case 3
      width 10,(width(0)-chg_hor%)
      height 10,(height(0)-chg_ver%)
  end_select
return

Selection:
   if count(11)>0
      ii%=item_index(11)
   end_if
return

Ajouter:
   if object_exists(100)=1
      Show 100
   else
      form 100:width 100,250:height 100,160
      Font_name 100,"Times new roman":font_size 100,10:caption 100,"Ajouter un compte"
      command_target_is 100
      alpha 101 :top 101,10:left 101,10:caption 101,"Login :"
      edit 103  :top 103,28:left 103,10:width 103,150
      alpha 102 :top 102,50:left 102,10:caption 102,"Mot de passe :"
      edit 104  :top 104,68:left 104,10:on_change 104,couleur104
      button 105:top 105,95:left 105,155:caption 105,"Enregistrer":cursor_point 105
      on_click 105,Enregistrer
   end_if
   gosub Init_F100
return

Init_F100:
   text 103,""
   text 104,"panoramic123":font_color 104,210,210,210
return

couleur104:
   font_color 104,0,0,0
return

Enregistrer:
   item_add 9,trim$(text$(103))+";"+trim$(text$(104))
   file_save 9,D$+"\Connect.Bdd"
   gosub Init_list
   gosub Init_F100
   hide 100
return

Supprimer:
   item_delete 9,ii%
   gosub init_list
return

Connection:
   hide 0
   Execute "http://www.mydrive.ch/login"
   pause 1000
   titre$ = string$(255," ")
   hnd% = dll_call1("GetActiveWindowTitle",adr(titre$))
   if instr(titre$, "Login |" )=0
      show 0
      message "Il faut d'abord cliquer sur [MyDrive] !"
      message "Le titre actuel est: ["+titre$+"]"
    return
   end_if
   s$ = item_index$(11)
   hnd% = dll_call0("GetActiveControl")
   res% = dll_call2("SendStringAsText",hnd%,adr(s$))
   s$ = chr$(9)
   res% = dll_call2("SendStringAsText",hnd%,adr(s$))
   pause 1000
   s$ = item_read$(9,item_index(11))
   sep%=instr(s$,";")
   s$=right$(s$,len(s$)-sep%)
   res% = dll_call2("SendStringAsText",hnd%,adr(s$))
   pause 1000
   s$ = chr$(9)
   res% = dll_call2("SendStringAsText",hnd%,adr(s$))
   res% = dll_call2("SendStringAsText",hnd%,adr(s$))
   res% = dll_call2("SendStringAsText",hnd%,adr(s$))
   s$ = chr$(13)
   res% = dll_call2("SendStringAsText",hnd%,adr(s$))
   pause 1000
   show 0
return

Close0:
   dll_off
return

 dim D$,x%,M%,sep%,L$,L%