FabGrilleForImage.bas

Sujet: FabGrilleForImage.bas Lun 22 Jan 2018 - 13:49

Pour commencer un grand merci à JL35 qui m'a permis de fabriquer ce programme.
voir => ici

Comme quoi partager ses codes permet à d'autres d'adapter et de partager à nouveau !

Avertissement: Si vous voulez éviter de créer un paquet de fichiers n'import'où: créez un dossier et enregistrez le code (FabGrilleForImage.bas) à l'intérieur.
Vous êtes avertis. Razz

Avant de lancer déposez l'image à travailler à l'intérieur du dossier.

Comme son nom l'indique ce code permet de tracer une grille sur une image et de créer un nouveau fichier bmp de cette image avec sa grille.
A la fin, vous disposez de l'image final et de tout les fragments de l'image initiale.

Ce programme comprend 2 sous-programmes SUB(s) qui font le travail:
1) la SUB DecoupeImgOrigine
2) la SUB ReconstitueImgOrigine
Vous pouvez, sans problème utiliser les 2 en simultanée.
Pour la mise en place, vous devez adapter les paramètres de ces 2 SUB(s) à votre image.
Cela implique de lire tous les commentaires fournis dans le code.

Code:: ' FabGrilleForImage.bas JC Janvier 2018
' Adaptation de la SUB Crop(f1$,f2$,x%,y%,w%,h%) de JL35
rem voir ici => http://panoramic.1fr1.net/t3506-decouper-un-rectangle-dans-une-image?highlight=d%E9couper

' OBJECTIF: tracer une grille sur une image et créer un nouveau fichier bmp de cette image avec sa grille.

rem ============================================================================ Mise en place
rem Mise en place de la SUB "DecoupeImgOrigine(,,,,,,,)"
' ATTENTION: la création d'un dossier est nécéssaire pour éviter de créer un paquet de fichiers n'import'où
' Contenu du dossier: l'image à découper et éventuellement le code

' les variables globales nécessaires
dim no%,ImgOrigine$,nblig%,nbcol%,ep%,Wimg1%,Himg1%
' indiquer le nom de l'image à découper et ses dimensions
ImgOrigine$="risk700500.bmp" : Wimg1%=700 : Himg1%=500
' indiquer le nombre de lignes et colonnes
nblig%=10 : nbcol%=10
' définir une épaisseur pour les traits de la grille de reconstitution (Si 0 pas de grille)
ep%=1
' se caler dans le dossier (répertoire) contenant l'image d'origine pour y insérer les images résultantes
dir_change dir_current$

' Détail des paramètres de la SUB DecoupeImgOrigine
rem DecoupeImgOrigine(ImgOr$,NomImg$,nbl%,nbc%,Wimg1%,Himg1%,ep%)
' ImgOr$ = nom de l'image à découper (bmp)
' NomImg$ = début du nom des images résultantes (Exemple: NomImg$="img" => résultats: img001.bmp à img100.bmp)
' nbl%,nbc% = nombre de lignes et colonnes pour le découpage (maximum 100 images résultantes)
' if (nbl%*nbc%)>100 ça ne marche pas (Si besoin de plus il faut modifier la SUB)
' Wimg1%,Himg1% = taille de l'image à découper (Ex: 700x500)
' exemple de calcul: wi2%=wi1%/nbl% : hi2%=hi1%/nbc% soit 70:50 pour notre exemple
' ep% = épaisseur souhaitée des traits de la grille de reconstitution
' Attention: les images résultantes auront une taille réduite (wi2%=wi2%-ep% ET hi2%=hi2%-ep%)

rem Notez que vous pouvez lancer plusieurs fois les 2 SUB(s) les images résultantes remplaceront les anciennes.
rem Notez que tous les objets crées dans les SUB(s) sont supprimés après usage.

rem =================================================================' Programme
' Découper l'image
DecoupeImgOrigine(ImgOrigine$,"img",nblig%,nbcol%,Wimg1%,Himg1%,ep%): ' le paramètre 2 est à adapter selon vos besoins
' Reconstituer l'image pour l'afficher dans un PICTURE
' Création du PICTURE pour visualiser
dim Picture1% : no%=no%+1 : Picture1%=no% : PICTURE Picture1%
' Adaptation taille du PICTURE suivant la taille de l'image d'origine et la valeur de ep%
' et définir la couleur de la grille
width Picture1%,Wimg1%+ep% : height Picture1%,Himg1%+ep% : color Picture1%,155,155,155
left Picture1%,2 : top Picture1%,2
' adapter la taille de form 0
width 0,width(Picture1%)+20 : height 0,height(Picture1%)+44
' Cibler l'affichage
2D_TARGET_IS Picture1%
' Reconstituer l'image et l'afficher dans le PICTURE
ReconstitueImgOrigine("img",nblig%,nbcol%,ep%)
' Créer et sauver une nouvelle image résultante comprenant la grille
' A noter: cette image aura une dimension augmentée de ep% (ici => 700x501)
file_save Picture1%,"New_"+ImgOrigine$
END
rem =====================================================' SUB ReconstitueImgOrigine
SUB ReconstitueImgOrigine(NomImg$,nbl%,nbc%,pw%)
dim_local nx%,ny%,ni%,numi$,Limg$,px%,py%,wi2%,hi2%
wi2%=Wimg1%/nbc% : hi2%=Himg1%/nbl%
px%=0-wi2%
for ny%=1 to nbl%
for nx%=1 to nbc%
ni%=ni%+1
if ni%<10 then numi$="00"+str$(ni%)
if ni%<100 and ni%>9 then numi$="0"+str$(ni%)
if ni%>99 then numi$=str$(ni%)
Limg$=NomImg$+numi$+".bmp"
no%=no%+1 : IMAGE no% : FILE_LOAD no%,Limg$
px%=px%+wi2% : 2D_IMAGE_PASTE no%,px%+pw%,py%+pw% : DELETE no%
next nx%
px%=0-wi2% : py%=py%+hi2%
next ny%
END_SUB
rem =====================================================' SUB DecoupeImgOrigine
SUB DecoupeImgOrigine(ImgOr$,NomImg$,nbl%,nbc%,wi1%,hi1%,pw%)
if (nbl%*nbc%)>100 then message "Nombre d'images résultantes: maximum autorisé = 100" : stop : terminate
dim_local px%,py%,nx%,ny%,ni%,numi$,Img2$,wi2%,hi2%
wi2%=Wimg1%/nbc% : hi2%=Himg1%/nbl%
px%=0-wi2%
for ny%=1 to nbl%
for nx%=1 to nbc%
ni%=ni%+1
if ni%<10 then numi$="00"+str$(ni%)
if ni%<100 and ni%>9 then numi$="0"+str$(ni%)
if ni%>99 then numi$=str$(ni%)
Img2$=NomImg$+numi$+".bmp" : px%=px%+wi2% : Crop(ImgOr$,Img2$,px%,py%,wi2%,hi2%,pw%)
next nx%
px%=0-wi2% : py%=py%+hi2%
next ny%
END_SUB
SUB Crop(f1$,f2$,x%,y%,w%,h%,pw%)
' JL35 modifiée JC
DIM_LOCAL s2d%,p%,i%
s2d% = NUMBER_2D_TARGET
p%=1000: WHILE OBJECT_EXISTS(p%)=1: p%=p%+1: END_WHILE
i%=p%+1: WHILE OBJECT_EXISTS(i%)=1: i%=i%+1: END_WHILE
PICTURE p%: HIDE p%: IMAGE i% : FILE_LOAD p%,f1$: 2D_TARGET_IS p%: 2D_IMAGE_COPY i%,x%,y%,x%+w%-pw%,y%+h%-pw%
WIDTH p%,w%-pw%: HEIGHT p%,h%-pw% : 2D_IMAGE_PASTE i%,0,0: FILE_SAVE p%,f2$ :2D_TARGET_IS s2d% : DELETE i%: DELETE p%
END_SUB
rem ============================================================================

A+

Code modifié: édition du 23/01/2018 à 8h30

Sujet: Re: FabGrilleForImage.bas Lun 22 Jan 2018 - 14:33

Testé et approuvé !

Sujet: Re: FabGrilleForImage.bas Lun 22 Jan 2018 - 15:46

Bonjour Jean Claude,
et merci pour les référence à ma (très modeste) contribution !

Quelques remarques concernant ton programme:
Apparemment l'image d'origine doit être obligatoirement au format bmp,
Si c'est une jpg, tu pourrais la convertir en bmp provisoire qui servira pour la suite, quitte à la supprimer à la fin:

Code:: IF UPPER$(FILE_EXTRACT_EXTENSION$(ImgOrigine$)) = ".JPG"
   fx$ = "C:\TEMP\Image.bmp": ' exemple
   PICTURE 1099: HIDE 1099: FILE_LOAD 1099,ImgOrigine$: FILE_SAVE 1099,fx$: DELETE 1099
   ImgOrigine$ = fx$
END_IF

et tu aurais pu facilement automatiser le calcul des valeurs numériques (dimensions, découpes), par exemple:

Code:: FILEBIN_OPEN_READ 1,ImgOrigine$: ' dimensions de l'image -> wi1%, hi1%
FILEBIN_POSITION 1,18: wi1% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_POSITION 1,22: hi1% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_CLOSE 1: FILE_DELETE fm$
wi2% = wi1%/nbcol%: hi2% = hi1%/nblig%: ' <- à reporter éventuellement dans la sub

ce qui supprimerait les deux paramètres wi2% et hi2% de la sub DecoupeImgOrigine() (calculés dans la sub)

Sinon, c'est bien pour faire un puzzle !

PS Je n'ai toujours pas compris ta ligne

Code:: dir_change dir_current$

tu remplaces le répertoire actuel par le répertoire actuel... scratch

PS2 (rien à voir avec la console du même nom):
il me semble y avoir une petite confusion lignes/colonnes dans les deux subs Decoupe et Reconstitue.
il faut mettre:

Code:: for ny%=1 to nbl%
for nx%=1 to nbc%

à la place de:

Code:: for ny%=1 to nbc%
for nx%=1 to nbl%

Bon, j'arrête de polluer Smile

Sujet: Re: FabGrilleForImage.bas Lun 22 Jan 2018 - 20:49

Bonsoir à tous,
Je réponds avec un peu de retard, mais c'est pas de ma faute !
Il faut que je refasse ma salle de bain aux goûts de Madame, du coup j'ai passé l'après-midi à visiter les magasins concernés.

BREF !

@JL35,
Tu dis, j'arrête de polluer ????
1) tu dis "il me semble y avoir une petite confusion lignes/colonnes dans les deux subs Decoupe et Reconstitue."
Ben.. ça, pour moi, ce n'est pas de la pollution ! Je vais vérifier. Very Happy

2) "Je n'ai toujours pas compris ta ligne: dir_change dir_current$"
C'est pour forcer le programme à travailler dans le dossier ouvert.
Comme je l'ai déjà expliqué: si tu prends le code sur le forum et que la dernière fois que tu as fait un enregistrement avec Panoramic_Editor, tu risques d'enregistrer les fichiers dans le dernier répertoire utilisé avec Panoramic_Editor.
Le fait d'enregistrer le code dans un dossier permet à cette commande de se caler dessus.
Et si, pour une raison quelconque, tu décides de renommer le répertoire, DIR_CHANGE DIR_CURRENT$ assure d'être dans le bon dossier.
3) Pour l’extension des fichiers "images" (bmp ou jpg): je suis d'accord !
J' ai fait ce programme, pour un besoin personnel, mais c'est très facile de changer la donne dans les SUB(s)
4) tu aurais pu facilement automatiser le calcul des valeurs numériques (dimensions, découpes)
C'est volontaire ! je veux laisser la possibilité de choisir les dimensions des images résultantes.
5) "Sinon, c'est bien pour faire un puzzle !". Oui, mais ce n'est pas mon but. En fait, c'est pour générer une liste de fichier d'images qui peuvent, ensuite, être transformer en sprite(s) ou être modifiée avec les commandes Panoramic qui conviennent.

@Papydall,
Merci d'avoir testé.
Au passage, je vois que tu es fort devant l'adversité qu’entraîne la "vie".
Moi même, je suis menacé (pour ma mère et ma belle-mère) et j'espère que dieu retardera les échéances, mais je ne suis pas maître de la situation.
Je n'en fait pas état sur le forum, car c'est personnel, c'est mon choix. Je ne reproche rien à personne, c'est normal de dire pourquoi on est absent du forum (d'autant que ça inquiète). Et c'est aussi normal de répondre par des messages de soutient.
Tout ça pour te dire que si je ne réponds pas aux messages (justifiés) de soutiens, c'est dû à ma façon de voir les choses et que je ne sais pas quoi dire.
Mais sache que, pour toi comme pour tous, je compati.

A+

Sujet: Re: FabGrilleForImage.bas Lun 22 Jan 2018 - 21:12

Te fâches pas Jean Claude !
(bon, je dis ça parce que je sais bien que tu sais que je plaisante...)
Pour les valeurs 'en dur', tu aurais pu (à défaut de lire les dimensions réelles de l'image dans le fichier) mettre une fois en tête wi1% = 700 et hi1% = 500, avec nblig%=10 et nbcol%=10, et tout le reste en découle par calcul (en particulier wi2% et hi2%, dimensions des imagettes).
Mais bon je pinaille, d'accord.

A partir de ça je suis en train de faire un petit programme de puzzle, en remettant les imagettes au hasard, à charge pour le joueur de les remettre à leur place.

Bon courage pour ta salle de bains, là tu n'as pas droit à l'erreur !

Sujet: Re: FabGrilleForImage.bas Mar 23 Jan 2018 - 8:46

Bonjour à tous,

Je viens de remplacer le code au début du post.

1) Correction du bug signalé par JL35 concernant la confusion (lignes/colonnes).
Ce bug est passé inaperçu du fait que j'avais autant de colonnes que de lignes Embarassed

2) J'ai retiré 2 paramètres a chaque SUB(s): ils sont remplacés par 2 variables globales.
En conséquence: il faut indiquer la taille de l'image (Ex: Wimg1%=700 : Himg1%=500) et tout le reste suivra.
A force de pinailler JL35 m'a en partie convaincu Very Happy

(en fait, je l'avais dans ma première mouture, puis supprimé pour économiser 2 variables globales. Du coup, c'est moi qui pinaillais.)

3) La taille de Form 0 est devenue automatique.

A+

Sujet: Re: FabGrilleForImage.bas Mar 23 Jan 2018 - 10:43

@jean-claude
Je pense que tu confond 'dir_current$' et 'dir_application$'. Cette variable n'existe pas en panoramic, il faut la créer:

Code:: print dir_current$
'
dim dir_application$ : dir_application$=file_extract_path$(param_value$(0))
print dir_application$

'dir_change dir_current$' ne sert à rien(puisque dir_current$ pointe le répertoire courant), donc faire pointer sur le répertoire courant scratch

Il vaut mieux faire ceci : 'dir_change dir_application$'

Sujet: Re: FabGrilleForImage.bas Mar 23 Jan 2018 - 12:11

Merci pour ton intervention Silverman,

dim dir_application$ : dir_application$=file_extract_path$(param_value$(0)) me donne l'emplacement de Panoramic.exe dans un dossier temporaire dans AppData. Ce n'est pas ce que je recherche...

Mais tu m'as donné la solution, car j'ai consulté le manuel pour file_extract_path$ et j'ai trouvé en chargeant l'exemple.

Code:: no%=no%+1 : open_dialog no% : Rep$=file_extract_path$(file_name$(no%)) : delete no% : no%=no%-1 : dir_change Rep$

De cette façon, j'oblige l'utilisateur à choisir un répertoire, c'est à lui de faire attention que ce répertoire ne contienne que l'image à travailler (au départ, bien sur)

@Tous,
Voici une nouvelle version:
1) Créez un dossier et mettez-y une image.bmp
2) Renseignez les variables avant de lancer le code
3) Lancez le code
4) Un open_dialog s'ouvre. Choisissez l'image du dossier que vous venez de créer.

Code:: ' FabGrilleForImage.bas JC Janvier 2018
' Adaptation de la SUB Crop(f1$,f2$,x%,y%,w%,h%) de JL35
' OBJECTIF: tracer une grille sur une image et créer un nouveau fichier bmp de cette image avec sa grille.

rem ============================================================================ Mise en place
caption 0,"FabGrilleForImage.bas JC Janvier 2018"
dim no%,ImgOrigine$,NomFrag$,nblig%,nbcol%,ep%,Wimg1%,Himg1%,Rep$
' vérification répertoire
no%=no%+1 : open_dialog no% : Rep$=file_extract_path$(file_name$(no%)) : delete no% : no%=no%-1 : dir_change Rep$

' Paramètres à renseigner: Nom de l'image origine, son width, son height,
  ' nb colonnes, nb lignes, épaisseur du trait de la grille, nom des fragments
  ImgOrigine$="" : Wimg1%= : Himg1%= : nblig%= : nbcol%= : ep%=1
  NomFrag$="" :' Sert à nommer les images résultantes (fragments de l'image d'origine)
   ' (EX: "Img001.bmp","Img002.bmp", etc... )

rem ============================================================================ Programme
  caption 0,"Patientez SVP...."
  DecoupeImgOrigine(ImgOrigine$,NomFrag$,nblig%,nbcol%,Wimg1%,Himg1%,ep%)

  dim Picture1% : no%=no%+1 : Picture1%=no% : PICTURE Picture1%
  width Picture1%,Wimg1%+ep% : height Picture1%,Himg1%+ep% : color Picture1%,155,155,155
  left Picture1%,2 : top Picture1%,2 : width 0,width(Picture1%)+20 : height 0,height(Picture1%)+44
  2D_TARGET_IS Picture1%

  ReconstitueImgOrigine(NomFrag$,nblig%,nbcol%,ep%)
  file_save Picture1%,"New_"+ImgOrigine$
  caption 0,"New_"+ImgOrigine$
END
rem ============================================================================ SUB ReconstitueImgOrigine
SUB ReconstitueImgOrigine(NomImg$,nbl%,nbc%,pw%)
   dim_local nx%,ny%,ni%,numi$,Limg$,px%,py%,wi2%,hi2%
   wi2%=Wimg1%/nbc% : hi2%=Himg1%/nbl%
   px%=0-wi2%
   for ny%=1 to nbl%
   for nx%=1 to nbc%
   ni%=ni%+1
   if ni%<10 then numi$="00"+str$(ni%)
   if ni%<100 and ni%>9 then numi$="0"+str$(ni%)
   if ni%>99 then numi$=str$(ni%)
   Limg$=NomImg$+numi$+".bmp"
   no%=no%+1 : IMAGE no% : FILE_LOAD no%,Limg$
   px%=px%+wi2% : 2D_IMAGE_PASTE no%,px%+pw%,py%+pw% : DELETE no%
   next nx%
   px%=0-wi2% : py%=py%+hi2%
   next ny%
END_SUB
rem ============================================================================ SUB DecoupeImgOrigine
SUB DecoupeImgOrigine(ImgOr$,NomImg$,nbl%,nbc%,wi1%,hi1%,pw%)
' if (nbl%*nbc%)>100 then message "Nombre d'images résultantes: maximum autorisé = 100" : stop : terminate
   dim_local px%,py%,nx%,ny%,ni%,numi$,Img2$,wi2%,hi2%
   wi2%=Wimg1%/nbc% : hi2%=Himg1%/nbl%
   px%=0-wi2%
   for ny%=1 to nbl%
   for nx%=1 to nbc%
   ni%=ni%+1
   if ni%<10 then numi$="00"+str$(ni%)
   if ni%<100 and ni%>9 then numi$="0"+str$(ni%)
   if ni%>99 then numi$=str$(ni%)
   Img2$=NomImg$+numi$+".bmp" : px%=px%+wi2% : Crop(ImgOr$,Img2$,px%,py%,wi2%,hi2%,pw%)
   next nx%
   px%=0-wi2% : py%=py%+hi2%
   next ny%
END_SUB
SUB Crop(f1$,f2$,x%,y%,w%,h%,pw%)
   ' JL35 modifiée JC
   DIM_LOCAL s2d%,p%,i%
   s2d% = NUMBER_2D_TARGET
   p%=1000: WHILE OBJECT_EXISTS(p%)=1: p%=p%+1: END_WHILE
   i%=p%+1: WHILE OBJECT_EXISTS(i%)=1: i%=i%+1: END_WHILE
   PICTURE p%: HIDE p%: IMAGE i% : FILE_LOAD p%,f1$: 2D_TARGET_IS p%: 2D_IMAGE_COPY i%,x%,y%,x%+w%-pw%,y%+h%-pw%
   WIDTH p%,w%-pw%: HEIGHT p%,h%-pw% : 2D_IMAGE_PASTE i%,0,0: FILE_SAVE p%,f2$ :2D_TARGET_IS s2d% : DELETE i%: DELETE p%
END_SUB
rem ============================================================================

A+