Discussion forum about PANORAMIC language

Mac, Windows & Android application development with PANORAMIC language
 
HomeFAQSearchRegisterMemberlistUsergroupsLog in
Latest topics
» Hello world.
by Mon Jun 19, 2017 1:37 am

» Biomorphes de PICKOVER
by Sun Jun 18, 2017 2:33 am

» In less than 10 lines of code
by Fri Jun 16, 2017 5:03 am

» Effect Dopler
by Fri Jun 16, 2017 3:29 am

» SuperEllipse
by Wed Jun 14, 2017 4:01 am

» Plants
by Wed Jun 14, 2017 3:38 am

» Mira's attractor
by Wed Jun 14, 2017 3:30 am

» Triangle of Sierpinski
by Wed Jun 14, 2017 3:22 am

» Esthétique polaire
by Wed Jun 14, 2017 3:16 am

» Butterfly effect : Lorenz equations
by Wed Jun 14, 2017 3:08 am

» Collision detection
by Tue Jun 13, 2017 5:09 am

» The Bees Laline Paull Epub Books
by Mon Oct 10, 2016 8:58 pm

» PANORAMIC for Mac OSX 10 is available
by Tue Aug 09, 2016 6:08 pm

» ide
by Sat Jul 16, 2016 12:27 am

» Can I change the program icon/logo in my application ?
by Thu Jul 07, 2016 3:32 am

Navigation
 Portal
 Index
 Memberlist
 Profile
 FAQ
 Search

Share | 
 

 Coloramic vs 2.0

View previous topic View next topic Go down 
AuthorMessage
ygeronimi

avatar

Number of posts : 14
Age : 46
Localisation : France
Registration date : 2013-03-13

PostSubject: Coloramic vs 2.0   Wed Mar 13, 2013 4:04 am

Code:
' Data Image Creator V2 (Version tout panoramic )
' génère un fichier "Include_Image.bas" contenant les images sélectionnés
' sous forme de data et la fonction de recréation de ces images.
' La fonction déclare et libère la plupart de ses propres variables,
' seules les variable x% et y% sont à déclarer dans le source principale et seul la variable
' DI$ (adresse du dossier "auto-créé" où sont recréées les images ) est conservé.
' La fonction à appeler, et à déclarer dans les label,dans l'Init du source pour
' re-créer les images est:Create_File_Image

dim x%,list%,Menu%
dim er$,a$,f$,i%,wi%,hi%
dim v%(20), ii%, offs%, posit%, ad, sz
dim D$,file$,H%,L%,R%,G%,B%,res%,nom$,t%,DO$,y%
' ------------------------------------------------------------------------------
label Init
label Menu,Ajouter,Coder,Get_Size,Quitter
label Effacer
' ------------------------------------------------------------------------------
width 0,320:height 0,250
caption 0,"Data Image Créator Vs0.2":font_name 0,"arial"

main_menu 1
for x%=2 to 4 :sub_menu x% :parent x%,1:on_click x%,Menu:next x%
caption 2,"Ajouter":caption 3,"Coder":caption 4,"Quitter"

list 5:width 5,304:height 5,170:on_double_click 5,Effacer

alpha 6:top 6,172:left 6,20:caption 6,"Double cliquer sur un item pour l'effacer"
font_color 6,140,30,40

gosub Init
end
' ------------------------------------------------------------------------------
Init:
  D$=Dir_current$
  if dir_exists(D$+"\Output")=0 then dir_make D$+"\Output"
  DO$=D$+"\Output"
return
' ------------------------------------------------------------------------------
Menu:
  for x%=2 to 4
      if clicked(x%)=1 then Menu%=x%
  next x%
  select Menu%
  case 2
      gosub Ajouter
  case 3
      inactive 2:inactive 4
      gosub Coder
  case 4
      gosub Quitter
  end_select
return
' ------------------------------------------------------------------------------
Ajouter:
  open_dialog 7
  filter 7,"*.jpg;*.bmp|*.jpg;*.bmp"
  file$=file_name$(7)
  item_add 5,file$
  delete 7
return
' ------------------------------------------------------------------------------
Effacer:
  if count(5)>0 then item_delete 5,item_index(5)
return
' ------------------------------------------------------------------------------
Coder:
  ' ouverture du fichier en création
  file_open_write 8,DO$+"\include_image.bas"
      ' ecriture de la fonction de re-création des fichiers *.bmp
      file_writeln 8,"Create_File_Image:"
      file_writeln 8,"dim DI$,Titre$,haut%,large%,Nbre_lign%,R%,G%,B%,col%,lign%,db%"
      file_writeln 8,"if dir_exists(Dir_current$+"+chr$(34)+"\Picture"+chr$(34)+")=0 then dir_make dir_current$+"+chr$(34)+"\Picture"+chr$(34)
      file_writeln 8,"DI$=Dir_current$+"+chr$(34)+"\Picture"+chr$(34)
      file_writeln 8,"for db%=1 to "+str$(count(5))
      file_writeln 8,"  read Titre$ : read haut% : read large% :read Nbre_lign%"
      file_writeln 8,"  if object_exists(800)=0"
      file_writeln 8,"      form 800:hide 800"
      file_writeln 8,"      command_target_is 800"
      file_writeln 8,"      picture 801"
      file_writeln 8,"  end_if"
      file_writeln 8,"  width 801,large% :height 801,haut% :2d_target_is 801"
      file_writeln 8,"  for x%=1 to Nbre_Lign%"
      file_writeln 8,"      read col% :read lign% :read R% :read G% :read B%"
      file_writeln 8,"      2d_pen_color R%,G%,B%"
      file_writeln 8,"      2d_point col%,lign%"
      file_writeln 8,"  next x%"
      file_writeln 8,"file_save 801,DI$+"+chr$(34)+"\"+chr$(34)+"+titre$"
      file_writeln 8,"cls"
      file_writeln 8,"next db%"
      file_writeln 8,"command_target_is 0"
      file_writeln 8,"Delete 800"
      file_writeln 8,"free Titre$ :free haut% :free large% :free Nbre_lign% "
      file_writeln 8,"free R% :free G% :free B% :free col% :free lign% : free db%"
      file_writeln 8,"return"
      ' ajout des fichiers data à assembler
      while count(5)>0
        ' création du form invible de travail
        if object_exists(100)=0
            form 100:hide 100:command_target_is 100
            picture 101:width 101,L% :height 101,H%
        end_if
        ' placement de l'image chargé dans le picture 101
        file_load 101,item_read$(5,1)
        gosub Get_Size
        ' Ecriture des données
        nom$=file_extract_name$(item_read$(5,1))
        nom$=LEFT$(nom$,len(nom$)-3)+"bmp"
        file_writeln 8,"Data"+chr$(32)+nom$+","+str$(H%)+","+str$(L%)+","+str$(L%*H%)
        for x%=0 to L% -1
            for y%= 0 to H% -1
              R% =color_pixel_red(101,x%,y%)
              G% =color_pixel_green(101,x%,y%)
              B% =color_pixel_blue(101,x%,y%)
              file_writeln 8,"data"+chr$(32)+str$(x%)+","+str$(y%)+","+str$(R%)+","+str$(G%)+","+str$(B%)
            next y%
        next x%
      item_delete 5,1
      end_while
  file_close 8
  clear 5
  active 2:active 4
  command_target_is 0
  if object_exists(100)=1 then delete 100
return
' ------------------------------------------------------------------------------
Get_Size:
  f$=item_read$(5,1)
  er$ = "": a$ = UPPER$(FILE_EXTRACT_EXTENSION$(f$))
  IF a$ <>".JPG" AND a$ <> ".BMP" THEN er$ = "Format incorrect": RETURN

  FILEBIN_OPEN_READ 1, f$: sz = FILEBIN_SIZE(1)
  IF a$ = ".JPG"
      FOR ii% = 1 TO 2: FILEBIN_READ 1, v%(ii%): NEXT ii%
      IF v%(1) <> 255 OR v%(2) <> 216 THEN er$ = "en-tête non FFD8.": GOTO reter
      ad = 0: offs% = 0
      REPEAT
        REPEAT
            posit% = ad + 2 + offs%
            IF posit% >= sz THEN er$ = "FFCx non trouvé.": GOTO reter
            FILEBIN_POSITION 1, posit%
            FOR i% = 1 TO 4: FILEBIN_READ 1, v%(i%): NEXT i%
            IF v%(1) <> 255 THEN er$ = "Chaînage incorrect": GOTO reter
            offs% = 256*v%(3) + v%(4)
            ad = FILEBIN_POS(1) - 4
        UNTIL (v%(2) >= 192 AND v%(2) <= 195): ' # FFC0 à FFC3
        FOR ii% = 1 TO 5: FILEBIN_READ 1, v%(ii%): NEXT ii%
      UNTIL v%(1) = 8
      hi% = 256*v%(2) + v%(3): wi% = 256*v%(4) + v%(5)
      L%=wi%:H%=hi%
  ELSE
      FILEBIN_POSITION 1, 18
      FOR ii% = 1 TO 8: FILEBIN_READ 1, v%(ii%): NEXT ii%
      wi% = v%(1) + 256*v%(2) + 256*256*v%(3) + 256*256*256*v%(4)
      hi% = v%(5) + 256*v%(6) + 256*256*v%(7) + 256*256*256*v%(8)
      L%=wi%
      H%=hi%
  END_IF
  FILEBIN_CLOSE 1
return

Quitter:
terminate
Back to top Go down
View user profile
 
Coloramic vs 2.0
View previous topic View next topic Back to top 
Page 1 of 1

Permissions in this forum:You cannot reply to topics in this forum
Discussion forum about PANORAMIC language :: Panoramic for Windows :: Source code (snippets)-
Jump to: