FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Problème de math
par papydall Aujourd'hui à 1:53

» A propos des attributs de fichier
par papydall Hier à 14:33

» Problème de math
par Marc37 Sam 21 Oct 2017 - 23:04

» I Love You
par papydall Sam 21 Oct 2017 - 19:22

» Un petit "coucou" à tous les Panoramiciens !
par mindstorm Sam 21 Oct 2017 - 17:06

» MARK_ON déclenche un événement ON_CLICK à la place de ...
par Jean Claude Mer 18 Oct 2017 - 18:08

» mise a jour calculatrice
par joeeee2017 Mer 18 Oct 2017 - 15:57

» [solved] 3D_LINE How to ?
par Jicehel Mer 18 Oct 2017 - 11:01

» Convertisseur de base 10 de 2 à 36
par gigi75 Mar 17 Oct 2017 - 18:49

» calculatrice avec touches movibles
par joeeee2017 Dim 15 Oct 2017 - 1:11

» CORTANA
par gigi75 Sam 14 Oct 2017 - 16:32

» Calculatrice
par Jean Claude Sam 14 Oct 2017 - 12:30

» Compilateur FBPano
par jean_debord Jeu 12 Oct 2017 - 9:53

» KGF_dll - nouvelles versions
par Klaus Mar 10 Oct 2017 - 18:49

» à propos de Panoramic_Editor [Résolu]
par Klaus Mar 10 Oct 2017 - 3:19

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Octobre 2017
LunMarMerJeuVenSamDim
      1
2345678
9101112131415
16171819202122
23242526272829
3031     
CalendrierCalendrier

Partagez | 
 

 Projets sur format A4

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
JL35



Nombre de messages : 5953
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Projets sur format A4   Dim 13 Déc 2015 - 21:02

Pour créer une affichette, des dépliants, menus, cartes diverses, jaquettes de dvd, pochettes de Cd-Rom., etc.
L'intéressant ce sont les trois Subs utilitaires de travail sur un picture donné:
- Texte() insertion de texte formaté
- Dessin() création de dessins divers, formes géométriques, fonction gomme, ...
- Imagin() insertion d'images
Dans le cas de texte et d'image, on peut ensuite déplacer l'élément inséré pixel par pixel dans les quatre directions pour positionnement précis, le pivoter par angles de 90°, avant validation.
Il n'est pas fait appel à des ressources externes, sauf l'incontournable KGF.dll pour l'impression du résultat.

En fait le travail se fait sur une image grandeur nature de la page A4, aussi c'est mieux d'avoir un grand écran, sinon ça dépasse. Pour moi, sur mon 1920x1200 24" ( Very Happy ), ça tient tout juste en vertical.
Le résultat imprimé sera une impression de l'image du picture de travail.

Il faut ajuster quelques paramètres en tête du programme:
- le chemin de KGF.dll
- le chemin du répertoire des fichiers temporaires
- le rapport pixels par mm, fonction de l'écran de travail. C'est ce rapport (variable rec) qu'il faut réduire si on veut que l'image de la feuille tienne en entier dans l'écran.

Le programme fait près de 1100 lignes:
Code:

' Dépliants, affichettes, pochettes cd et dvd, etc. sur format A4
LABEL Quit,Typfig,Desfond,Ouvrir,Sauver,Insert,Imprime,Aide
DIM rec,rim,wA4%,hA4%,x0%,y0%,hj%,wj%,wd%,x%,y%,i%,a$,b$,typ%,scx%,scy%
DIM fsv$,kgf$,rtmp$,subact%,forsub%
Windows_Ver(): ' -> win$ = version de Windows
forsub% = 950: ' arbitraire, pour les Form des subs
scx% = SCREEN_X: scy% = SCREEN_Y

' #######################     A PERSONNALISER     ##############################
kgf$ = "C:\PANORAMIC\KGF\KGF.dll": ' <<<<=== à ajuster                         #
' rtmp$ = "Z:": '                                                             #
rtmp$ = "C:\TEMP": ' <<<<================== à ajuster (fichiers temporaires)  #
rec = 3.70656: ' <<<<======= A l'écran: 1 mm = 3,70656 pixels (à ajuster)      #
' ##############################################################################

hA4% = scy%-100: wA4% = hA4%*210/297: ' image de la page A4, en pixels
rec = hA4%/297: ' pixels/mm
WIDTH 0,hA4%+30: HEIGHT 0,wA4%+70: COLOR 0,180,255,255: BORDER_SMALL 0
  FONT_NAME 0,"Arial": FONT_BOLD 0: FONT_SIZE 0,10: CAPTION 0,win$
  ON_CLOSE 0,Quit
  CAPTION 0,win$+"     -   PAGE   A4   Paysage   -"

MAIN_MENU 50
  SUB_MENU 51: PARENT 51,50: CAPTION 51,"Fichier"
    SUB_MENU 52: PARENT 52,51: CAPTION 52,"Nouveau"
    SUB_MENU 53: PARENT 53,51: CAPTION 53,"Ouvrir...": ON_CLICK 53,Ouvrir
    SUB_MENU 54: PARENT 54,51: CAPTION 54,"Enregistrer": ON_CLICK 54,Sauver
    SUB_MENU 55: PARENT 55,51: CAPTION 55,"Enregistrer sous...": ON_CLICK 55,Sauver
    SUB_MENU 56: PARENT 56,51: CAPTION 56,"Imprimer": ON_CLICK 56,Imprime
    SUB_MENU 57: PARENT 57,51: CAPTION 57,"Quitter": ON_CLICK 57,Quit
  SUB_MENU 61: PARENT 61,50: CAPTION 61,"Type de projet"
    SUB_MENU 62: PARENT 62,61: CAPTION 62,"Feuille A4, Portrait"
    SUB_MENU 63: PARENT 63,61: CAPTION 63,"Feuille A4, Paysage"
    SUB_MENU 64: PARENT 64,61: CAPTION 64,"Pochette CD-ROM"
    SUB_MENU 65: PARENT 65,61: CAPTION 65,"Jaquette DVD, dos 14 mm"
    SUB_MENU 66: PARENT 66,61: CAPTION 66,"Jaquette DVD, dos  7 mm"
    SUB_MENU 67: PARENT 67,61: CAPTION 67,"Menu (A4/2 = A5)"
    SUB_MENU 68: PARENT 68,61: CAPTION 68,"Dépliant (A4/4 = A6)"
    FOR x% = 62 TO 68: ON_CLICK x%,Typfig: NEXT x%
  SUB_MENU 71: PARENT 71,50: CAPTION 71,"Insérer": ' outil à utiliser
    SUB_MENU 72: PARENT 72,71: CAPTION 72,"Texte"
    SUB_MENU 73: PARENT 73,71: CAPTION 73,"Dessin"
    SUB_MENU 74: PARENT 74,71: CAPTION 74,"Image"
    FOR x% = 72 TO 74: ON_CLICK x%,Insert: NEXT x%
  SUB_MENU 81: PARENT 81,50: CAPTION 81,"Aide": ON_CLICK 81,Aide

PICTURE 8: TOP 8,0: LEFT 8,0: WIDTH 8,hA4%+10: HEIGHT 8,wA4%+10
  COLOR 8,0,0,0: ' pour encadrer en noir l'image de la feuille A4 (Picture 1)
PICTURE 1: TOP 1,TOP(8)+5: LEFT 1,LEFT(8)+5: WIDTH 1,hA4%: HEIGHT 1,wA4%
  2D_TARGET_IS 1: COLOR 1,255,255,255: ' Picture principal: image de la feuille A4
BUTTON 2: TOP 2,0: LEFT 2,x0%+215: WIDTH 2,50: HEIGHT 2,16: CAPTION 2,"Verso"
BUTTON 3: TOP 3,TOP(2): LEFT 3,x0%+480: WIDTH 3,40: HEIGHT 3,HEIGHT(2)
  CAPTION 3,"Dos"
BUTTON 4: TOP 4,TOP(2): LEFT 4,LEFT(3)+240: WIDTH 4,WIDTH(2): HEIGHT 4,HEIGHT(2)
  CAPTION 4,"Recto"
  FOR x% = 2 TO 4: HIDE x%: NEXT x%
  
OPEN_DIALOG 90
SAVE_DIALOG 91
fsv$ = ""
typ% = 2: GOSUB Desfond
' ==============================================================================
END: ' =========================================================================
' ==============================================================================
Quit:
DLL_ON kgf$ : ' correction Klaus du bug de Terminate
x% = DLL_CALL1("KillProcessByHandle",handle(0))
TERMINATE
' ==============================================================================
Typfig:
x% = NUMBER_CLICK
SELECT x%
    CASE 62: typ% = 1
    CASE 63: typ% = 2
    CASE 64: typ% = 3
    CASE 65: typ% = 4
    CASE 66: typ% = 5
    CASE 67: typ% = 6
    CASE 68: typ% = 7
END_SELECT
GOSUB Desfond
IF subact% = 1 THEN TO_FOREGROUND forsub%
RETURN
' ==============================================================================
Desfond:
CLS
FOR x% = 2 TO 4: HIDE x%: NEXT x%
b$ = CHR$(10)
x0% = 16: y0% = 16: ' pour sauter les marges non imprimables gauche et haut (pixels écran)
IF typ% = 1 OR typ% = 7: ' A4 Portrait
    hA4% = scy%-100: wA4% = hA4%*210/297: ' image de la page A4, en pixels
    rec = hA4%/297: ' pixels/mm
    WIDTH 0,wA4%+30: HEIGHT 0,hA4%+70
    WIDTH 8,wA4%+10: HEIGHT 8,hA4%+10: COLOR 8,0,0,0
    WIDTH 1,wA4%: HEIGHT 1,hA4%
    CAPTION 0,win$+"     -   PAGE   A4   Portrait   -"
    IF typ% = 7
        2D_LINE wA4%/2,0,wA4%/2,hA4%: 2D_LINE 0,hA4%/2,wA4%,hA4%/2
    END_IF
ELSE: ' A4 Paysage
    wA4% = 778: ' page A4 grandeur nature
    IF wA4% > (scy%-100) THEN wA4% = scy%-100
    hA4% = 297*wA4%/210: ' Page A4 en pixels
    rec = hA4%/297: ' pixels/mm
    IF typ% = 2 OR typ% = 6
        ' A4 Paysage simple
        WIDTH 0,hA4%+30: HEIGHT 0,wA4%+70
        WIDTH 8,hA4%+10: HEIGHT 8,wA4%+10: COLOR 8,0,0,0
        WIDTH 1,hA4%: HEIGHT 1,wA4%
        CAPTION 0,win$+"     -   PAGE   A4   Paysage   -"
        IF typ% = 6
            2D_LINE hA4%/2,0,hA4%/2,wA4%
        END_IF
    ELSE
        IF typ% = 3
            ' Pochette CD-ROM
            WIDTH 0,hA4%+30: HEIGHT 0,wA4%+70
            WIDTH 8,hA4%+10: HEIGHT 8,wA4%+10: COLOR 8,0,0,0
            WIDTH 1,hA4%: HEIGHT 1,wA4%
            wj% = rec*123: hj% = rec*123
            wd% = rec*12: ' largeur des languettes à encoller (12 mm)
            2D_LINE x0%,y0%+wd%,x0%+2*wj%,y0%+wd%: 2D_POLY_TO x0%+2*wj%,y0%+wd%+hj%
            2D_POLY_TO x0%,y0%+wd%+hj%: 2D_POLY_TO x0%,y0%+wd%
            2D_LINE x0%+wj%,y0%+wd%,x0%+wj%,y0%+wd%+hj%
            2D_LINE x0%,y0%+wd%,x0%+20,y0%: 2D_POLY_TO x0%+wj%-20,y0%: 2D_POLY_TO x0%+wj%,y0%+wd%
            2D_LINE x0%,y0%+wd%+hj%,x0%+20,y0%+2*wd%+hj%: 2D_POLY_TO x0%+wj%-20,y0%+2*wd%+hj%
            2D_POLY_TO x0%+wj%,y0%+wd%+hj%
            2D_LINE x0%,y0%+wd%,x0%+wj%-20,y0%: 2D_LINE x0%+20,y0%,x0%+wj%,y0%+wd%
            2D_LINE x0%,y0%+wd%+hj%,x0%+wj%-20,y0%+2*wd%+hj%
            2D_LINE x0%+20,y0%+2*wd%+hj%,x0%+wj%,y0%+wd%+hj%
            PRINT_TARGET_IS 1: FONT_SIZE 1,12
            PRINT_LOCATE x0%+wj%/2-70,y0%+10: PRINT " replier et encoller "
            PRINT_LOCATE x0%+wj%/2-70,y0%+wd%+hj%+10: PRINT " replier et encoller "
            CAPTION 0,win$+"     -   POCHETTE   DE   CD-ROM   -"
            SHOW 2: SHOW 4
        ELSE
            IF typ% = 4 OR typ% = 5
                ' Jaquette DVD
                WIDTH 0,hA4%+30: HEIGHT 0,wA4%+70
                WIDTH 8,hA4%+10: HEIGHT 8,wA4%+10: COLOR 8,0,0,0
                WIDTH 1,hA4%: HEIGHT 1,wA4%
                wj% = rec*130: hj% = rec*183: wd% = rec*14: ' dos de 14 mm
                IF typ% = 5 THEN wd% = rec*7: ' dos de 7 mm
                2D_LINE x0%,y0%,x0%+2*wj%+wd%,y0%: 2D_POLY_TO x0%+2*wj%+wd%,y0%+hj%
                2D_POLY_TO x0%,y0%+hj%: 2D_POLY_TO x0%,y0%
                2D_LINE x0%+wj%,y0%,x0%+wj%,y0%+hj%
                2D_LINE x0%+wj%+wd%,y0%,x0%+wj%+wd%,y0%+hj%
                LEFT 2,x0%+wj%/2-25: LEFT 3,x0%+wj%+wd%/2-20: LEFT 4,x0%+wj%+wd%+wj%/2-25
                CAPTION 0,win$+"     -   JAQUETTE   DVD   -"
                SHOW 2: SHOW 3: SHOW 4
            END_IF
        END_IF
    END_IF
END_IF
' message str$(width(0))+" x "+str$(height(0))+b$+str$(width(1))+" x "+str$(height(1))
RETURN
' ==============================================================================
Ouvrir:
FILTER 90,"*.bmp;*.jpg"
a$ = FILE_NAME$(90): IF LEN(a$)<5 THEN RETURN
b$ = UPPER$(FILE_EXTRACT_EXTENSION$(a$))
IF b$<>".BMP" AND b$<>".JPG"
    MESSAGE "Fichier "+a$+CHR$(10)+"type incorrect (doit être .BMP ou .JPG)": RETURN
END_IF
Dimima(a$): b$ = CLIPBOARD_STRING_PASTE$: i% = INSTR(b$,"x")
x% = VAL(LEFT$(b$,i%-1)): y% = VAL(RIGHT_POS$(b$,i%+1))
IF x%>y% AND WIDTH(1)<HEIGHT(1) THEN typ% = 2: GOSUB Desfond
IF x%<y% AND WIDTH(1)>HEIGHT(1) THEN typ% = 1: GOSUB Desfond
FILE_LOAD 1,a$
fsv$ = a$
CAPTION 0,CAPTION$(0)+"   "+fsv$
RETURN
' ==============================================================================
Sauver:
IF fsv$ = ""  OR CLICKED(55) = 1
    FILTER 91,"*.bmp"
    a$ = FILE_NAME$(91): IF LEN(a$)<5 THEN RETURN
    b$ = UPPER$(FILE_EXTRACT_EXTENSION$(a$))
    IF b$<>".BMP"
        MESSAGE "Fichier "+a$+CHR$(10)+"type incorrect (doit être .BMP)": RETURN
    END_IF
    fsv$ = a$
END_IF
FILE_SAVE 1,fsv$
CAPTION 0,CAPTION$(0)+"   "+fsv$
RETURN
' ==============================================================================
Insert:
IF subact% = 1
    TO_FOREGROUND forsub%
    MESSAGE "Fermez d'abord l'outil en cours !"
    RETURN: ' une sub déjà active, remise au 1er plan
END_IF
x% = NUMBER_CLICK
SELECT x%
    CASE 72: Texte(100,100,1)
    CASE 73: Dessin(100,100,1,0)
    CASE 74: Imagin(100,100,1)
END_SELECT
RETURN
' ==============================================================================
Imprime:
IF MESSAGE_CONFIRMATION_YES_NO("Imprimante prête ?") = 0 THEN RETURN
FILE_SAVE 1,rtmp$+"Img.bmp": ' image du picture de travail
DLL_ON kgf$
  i% = 1: ' orientation paysage
  IF typ% = 1 OR typ% = 7 THEN i% = 0: ' orientation portrait
  Pr_Init(i%,""): ' format paysage
  Pr_Image(rtmp$+"Img.bmp",0,0,Pr_lt%,Pr_ht%,0)
  Pr_Impr()
DLL_OFF
FILE_DELETE rtmp$+"Img.bmp"
RETURN
' ==============================================================================
Aide:
b$ = CHR$(10)
SELECT typ%
    CASE 1: a$ = "Page A4 orientation Portrait, remplissage libre."
    CASE 2: a$ = "Page A4 orientation Paysage, remplissage libre."
    CASE 3: a$ = "Fabrication d'une pochette pour CD-ROM:"+b$
            a$=a$+"A imprimer sur papier fort ou bristol, découper,"+b$
            a$=a$+"replier les languettes vers l'arrière,les encoller,"+b$
            a$=a$+"puis replier la partie droite pour l'appliquer sur"+b$
            a$=a$+"les languettes."+b$
            a$=a$+"La partie à droite est le recto (Titre)."
    CASE 4: a$ = "Fabrication d'une jaquette pour boîtier de DVD:"+b$
            a$=a$+"A imprimer, puis découper, puis marquer les plis."+b$
            a$=a$+"Glisser sous le plastique transparent du coffret dvd."+b$+b$
            a$=a$+"Les dimensions implicites sont standards (panneaux de 130x183 mm),"+b$
            a$=a$+"le dos a une épaisseur de 14 mm (boîtier normal)."
    CASE 5: a$ = "Fabrication d'une jaquette pour boîtier de DVD:"+b$
            a$=a$+"A imprimer, puis découper, puis marquer les plis."+b$
            a$=a$+"Glisser sous le plastique transparent du coffret dvd."+b$+b$
            a$=a$+"Les dimensions implicites sont standards (panneaux de 130x183 mm),"+b$
            a$=a$+"le dos a une épaisseur de 7 mm (boîtier mince)."
    CASE 6: a$ = "Carte imprimée au format A5, la partie droite étant le recto."+b$
            a$=a$+"L'impression se fait sur papier fort ou bristol. On peut"+b$
            a$=a$+"également créer la partie interne et l'imprimer sur le même"+b$
            a$=a$+"support en retournant la feuille (page 2 à gauche) ou sur une"+b$
            a$=a$+"feuille séparée qui sera encartée."
    CASE 7: a$="Carte à imprimer sur bristol et replier, d'abord le"+b$
            a$=a$+"le bas vers le haut, puis la droite sur la gauche."+b$
            a$=a$+"Les pages sont sur sur la feuille dans l'ordre suivant:"+b$+b$
            a$=a$+" Page 4    Page 1"+b$+" Page 3    Page 2"+b$+b$
            a$=a$+"N.B.: La moitié inférieure de la feuille comprend les deux"+b$
            a$=a$+"futures pages intérieures (2 et 3) de la carte.
            a$=a$+"Aussi, les textes de ces pages 2 et 3 sont à pivoter de"+b$
            a$=a$+"180° (deux fois 90°) pour être dans le bon sens à la"+b$
            a$=a$+"lecture, après pliage."
END_SELECT
MESSAGE a$
RETURN
' ==============================================================================
SUB Windows_Ver()
' Version de Windows, -> win$ (papydall)
    DIM_LOCAL v$,v2$,w$,n
    IF VARIABLE("win$") = 0 THEN DIM win$
    EXECUTE_WAIT "cmd /c ver | clip"
    v$ = CLIPBOARD_STRING_PASTE$
    n = INSTR(v$,"version"): v2$ = MID$(v$,n+8,3)
    if v2$ ="10." then win$ = "Windows 10"
    if v2$ ="6.3" then win$ = "Windows 8.1"
    if v2$ ="6.2" then win$ = "Windows 8"
    if v2$ ="6.1" then win$ = "Windows 7"
    if v2$ ="6.0" then win$ = "Windows Vista"
    if v2$ ="5.1" then win$ = "Windows XP"
    if v2$ ="4.9" then win$ = "Windows ME"
    if v2$ ="5.0" then win$ = "Windows 2000"
    if v2$ ="4.1" then win$ = "Windows 98"
    if v2$ ="4.0" then win$ = "Windows 95"
END_SUB
' ==============================================================================
SUB Texte(xa%,ya%,p%)
' boîte à outils affichée en xa%,ya% pour apposer du texte sur le picture p%
' Variables définies dans le programme principal:
'      subact% (témoin d'activité)
'      rtmp$ (répertoire des fichiers temporaires)
'      forsub% (Form utilisée par la sub)
subact% = 1
DIM_LOCAL f%,i%,j%,k%,x%,y%,tr%,tg%,tb%,a$,ret%,lp%,n2t%,n2p%,p1%,wt%,ht%,fpr$,co%
DIM_LOCAL r%,g%,b%,mm%,lc%,ld%,sh%,ps%,sx%,sy%,pal%,ap%,wi%,hi%,wp%,hp%,ima%,rtg%
DIM_LOCAL x1%,y1%,q$,ft1$,ft2$,scr$,rec
rec = 3.70656: ' A l'écran: 1 mm = 3,70656 pixels
fpr$ = rtmp$+"Savpre.bmp"
ft1$ = rtmp$+"temp.bmp"
ft2$ = rtmp$+"tempr.bmp": ' provisoires, pour la rotation
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
DATA "Pal16": ' palette 16 couleurs
DATA "000000","000080","0000FF","008000","008080","00FF00","00FFFF","800000"
DATA "800080","808000","808080","C0C0C0","FF0000","FF00FF","FFFF00","FFFFFF"
n2t% = NUMBER_2D_TARGET: n2p% = NUMBER_PRINT_TARGET
IF LABEL("Texfin")=0 THEN LABEL Texfin
IF LABEL("Texpol")=0 THEN LABEL Texpol
IF LABEL("Texpom")=0 THEN LABEL Texpom
IF LABEL("Texcou")=0 THEN LABEL Texcou
IF LABEL("Texenr")=0 THEN LABEL Texenr
IF LABEL("Texins")=0 THEN LABEL Texins
IF LABEL("Texanu")=0 THEN LABEL Texanu
IF LABEL("Texdim")=0 THEN LABEL Texdim
IF LABEL("Texrot")=0 THEN LABEL Texrot
IF LABEL("Texshi")=0 THEN LABEL Texshi
IF LABEL("Texinss")=0 THEN LABEL Texinss
IF LABEL("Texcen")=0 THEN LABEL Texcen

f% = forsub%: WHILE OBJECT_EXISTS(f%)=1: f%=f%+1: END_WHILE
FORM f%: TOP f%,ya%: LEFT f%,xa%: HEIGHT f%,540: WIDTH f%,352: BORDER_SMALL f%
         COLOR f%,180,255,255: FONT_BOLD f%: FONT_NAME f%,"Arial": ON_CLOSE f%,Texfin
         CAPTION f%,"- OUTILS  TEXTE -"
i%=f%+1: EDIT i%: PARENT i%,f%: TOP i%,0: LEFT i%,0: WIDTH i%,130
         TEXT i%,"Arial": ON_CLICK i%,Texpol: ' Police
i%=f%+2: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,WIDTH(i%-1)+2: WIDTH i%,45
         MIN i%,6: MAX i%,255: POSITION i%,12: ' Taille caractères
         ON_CHANGE f%+2,Texenr
i%=f%+3: PICTURE i%: PARENT i%,f%: TOP i%,1: LEFT i%,LEFT(f%+2)+47: WIDTH i%,25
         HEIGHT i%,20: COLOR i%,0,0,0: ' Témoin de couleur
i%=f%+4: CHECK i%: PARENT i%,f%: TOP i%,3: LEFT i%,LEFT(f%+3)+28: CAPTION i%,"G"
i%=f%+5: CHECK i%: PARENT i%,f%: TOP i%,3: WIDTH i%,25: LEFT i%,LEFT(f%+4)+25: CAPTION i%,"I"
i%=f%+6: CHECK i%: PARENT i%,f%: TOP i%,3: WIDTH i%,25: LEFT i%,LEFT(f%+5)+25: CAPTION i%,"S"
         FOR j%=f%+4 TO f%+6: ON_CLICK j%,Texenr: NEXT j%
i%=f%+7: CHECK i%: PARENT i%,f%: TOP i%,3: WIDTH i%,54: LEFT i%,LEFT(i%-1)+25: CAPTION i%,"Centré"
         ON_CLICK i%,Texcen
i%=i%+1: PICTURE i%: PARENT i%,f%: TOP i%,25: LEFT i%,0: WIDTH i%,WIDTH(f%)-17
         HEIGHT i%,16: 2D_TARGET_IS i%: ON_CLICK i%,Texcou: pal%=i%: ' palette de 16 couleurs
         RESTORE: READ a$: WHILE a$<>"Pal16": READ a$: END_WHILE
         FOR j% = 1 TO 16
             READ a$
             tr%=HEX(LEFT$(a$,2)): tg%=HEX(MID$(a$,3,2)): tb%=HEX(RIGHT$(a$,2))
             2D_FILL_COLOR tr%,tg%,tb%
             2D_RECTANGLE x%,y%,x%+20,y%+15: x%=x%+21
         NEXT j%
         tr% = 0: tg% = 0: tb% = 0: ' couleur de base (noir)
i%=i%+1: ALPHA i%: PARENT i%,f%: TOP i%,TOP(pal%)+30: LEFT i%,2: CAPTION i%,"Aperçu:"
i%=i%+1: EDIT i%: PARENT i%,f%: TOP i%,TOP(pal%)+20: LEFT i%,50: WIDTH i%,WIDTH(f%)-68
         HEIGHT i%,40: COLOR i%,255,255,190: ap%=i%
         FONT_SIZE i%,12: FONT_BOLD_OFF i%: TEXT i%,"ABC xyz 01234"

co%=i%+1: CONTAINER_OPTION co%: PARENT co%,f%: TOP co%,TOP(i%)+40
           LEFT co%,50: WIDTH co%,220: HEIGHT co%,30: COLOR co%,255,255,190
i%=co%+1: OPTION i%: PARENT i%,co%: TOP i%,10: LEFT i%,10: CAPTION i%,"Fond blanc"
          WIDTH i%,150: MARK_ON i%
i%=i%+1:  OPTION i%: PARENT i%,co%: TOP i%,TOP(i%-1): LEFT i%,105
          CAPTION i%,"Fond transparent"

mm%=i%+1: MEMO mm%: PARENT mm%,f%: TOP mm%,TOP(co%)+30: WIDTH mm%,WIDTH(f%)-16
          HEIGHT mm%,HEIGHT(f%)-240: FONT_BOLD_OFF mm%: ' memo de saisie du texte
          FONT_NAME mm%,"Arial": FONT_SIZE mm%,10
lp%=mm%+1: LIST lp%: PARENT lp%,f%: TOP lp%,TOP(f%+1)+20: WIDTH lp%,130: HEIGHT lp%,HEIGHT(f%)-130
           HIDE lp%: FONT_NAMES_LOAD lp%: COLOR lp%,255,255,190: ON_CLICK lp%,Texpom
           FOR j%=COUNT(lp%) TO 1 STEP -1: ' liste des polices
               IF LEFT$(ITEM_READ$(lp%,j%),1)="@" THEN ITEM_DELETE lp%,j%
           NEXT j%: ' Polices
p1%=lp%+1: PICTURE p1%: LEFT p1%,-2000: WIDTH p1%,WIDTH(p%): HEIGHT p1%,HEIGHT(p%)
i%=p1%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(mm%)+HEIGHT(mm%): LEFT i%,20: WIDTH i%,100
          CAPTION i%,"Dimensions ->": ON_CLICK i%,Texdim
i%=i%+1: EDIT i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+100: WIDTH i%,200: ' HEIGHT i%,25
         ld% = i%

i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-95: LEFT i%,0: WIDTH i%,80: CAPTION i%,"Rotation 90°G"
         ON_CLICK i%,Texrot: rtg%=i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,80: WIDTH i%,80: CAPTION i%,"Rotation 90°D"
         ON_CLICK i%,Texrot

i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-70: LEFT i%,10: WIDTH i%,25: CAPTION i%,CHR$(231): sh%=i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,35: WIDTH i%,25: CAPTION i%,CHR$(232)
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,60: WIDTH i%,25: CAPTION i%,CHR$(233)
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,85: WIDTH i%,25: CAPTION i%,CHR$(234)
         FOR j% = i%-3 TO i%: FONT_NAME j%,"Wingdings": ON_CLICK j%,Texshi: NEXT j%
i%=i%+1: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+30: WIDTH i%,40
         POSITION i%,5
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,WIDTH(f%)/2+10
          CAPTION i%,"Annuler": ON_CLICK i%,Texanu
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): WIDTH i%,50: LEFT i%,WIDTH(f%)-70
          CAPTION i%,"Quitter": ON_CLICK i%,Texfin
i%=i%+1: IMAGE i%: PARENT i%,f%: ima% = i%
ON_CLICK p%,Texins: ' clic sur le point d'insertion du texte (picture principal)
x% = -1: y% = -1
ret% = 0: WHILE ret% = 0: WAIT 100: END_WHILE
OFF_CLICK p%: 2D_TARGET_IS n2t%: PRINT_TARGET_IS n2p%
DELETE f%: DELETE ima%: DELETE p1%
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
IF FILE_EXISTS(ft1$) = 1 THEN FILE_DELETE ft1$
subact% = 0: EXIT_SUB
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texpol:
SHOW lp%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texpom:
TEXT f%+1,ITEM_INDEX$(lp%)
HIDE lp%
FONT_NAME mm%,TEXT$(f%+1)
FONT_NAME ap%,TEXT$(f%+1)
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texcou:
x%=MOUSE_X_LEFT_DOWN(pal%): y%=MOUSE_Y_LEFT_DOWN(pal%)
tr%=COLOR_PIXEL_RED(pal%,x%,y%): tg%=COLOR_PIXEL_GREEN(pal%,x%,y%)
tb%=COLOR_PIXEL_BLUE(pal%,x%,y%): COLOR f%+3,tr%,tg%,tb%
FONT_COLOR ap%,tr%,tg%,tb%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texenr:
FONT_BOLD_OFF ap%: FONT_ITALIC_OFF ap%: FONT_UNDERLINE_OFF ap%
IF CHECKED(f%+4) = 1 THEN FONT_BOLD ap%
IF CHECKED(f%+5)=1 THEN FONT_ITALIC ap%
IF CHECKED(f%+6)=1 THEN FONT_UNDERLINE ap%
FONT_SIZE ap%,POSITION(f%+2)
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texdim:
IF COUNT(mm%) = 0 THEN RETURN
FONT_NAME p1%,TEXT$(f%+1): FONT_SIZE p1%,POSITION(f%+2)
FONT_BOLD_OFF p1%: FONT_ITALIC_OFF p1%: FONT_UNDERLINE_OFF p1%: ' init
IF CHECKED(f%+4) = 1 THEN FONT_BOLD p1%
IF CHECKED(f%+5) = 1 THEN FONT_ITALIC p1%
IF CHECKED(f%+6) = 1 THEN FONT_UNDERLINE p1%
i% = 0
FOR j% = 1 TO COUNT(mm%)
    k% = TEXT_WIDTH(ITEM_READ$(mm%,j%),p1%): IF k%>i% THEN i%=k%
NEXT j%
j% = COUNT(mm%)*TEXT_HEIGHT("Abcxyz",p1%): ' hauteur totale
a$ = STR$(i%)+" x "+STR$(j%)+" pixels = "
TEXT ld%,a$
wt% = i%: ht% = j%
i% = wt%/rec: j% = ht%/rec: a$ = a$+STR$(i%)+" x "+STR$(j%)+" mm"
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texcen:
IF COUNT(mm%)=0 THEN RETURN
IF CHECKED(f%+7) = 1: ' Texte centré sur lui-même
    GOSUB Texdim: ' -> wt% = largeur maxi, ht% = hauteur
    i% = wt%: j% = ht%
    FOR j% = 1 TO COUNT(mm%)
        a$ = TRIM$(ITEM_READ$(mm%,j%))
        k%=TEXT_WIDTH(a$,p1%): message str$(j%)+": "+str$(k%)
        WHILE k%<i%: a$=" "+a$+" ": k%=TEXT_WIDTH(a$,p1%): END_WHILE
        message str$(j%)+": "+str$(k%)
        ITEM_DELETE mm%,j%: ITEM_INSERT mm%,j%,RTRIM$(a$)
    NEXT j%
ELSE: ' décentrage (alignement à gauche)
    FOR i% = 1 TO COUNT(mm%)
        a$ = TRIM$(ITEM_READ$(mm%,i%))
        ITEM_DELETE mm%,i%: ITEM_INSERT mm%,i%,a$
    NEXT i%
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texins:
' Insertion du texte au clic souris
IF COUNT(mm%) = 0 THEN RETURN: ' pas de texte
sx% = MOUSE_X_POSITION(p%): sy% = MOUSE_Y_POSITION(p%)
FILE_SAVE p%,fpr$: ' sauvegarde préalable
FONT_NAME p1%,TEXT$(f%+1): FONT_SIZE p1%,POSITION(f%+2)
FONT_BOLD_OFF p1%: FONT_ITALIC_OFF p1%: FONT_UNDERLINE_OFF p1%: ' init
IF CHECKED(f%+4) = 1 THEN FONT_BOLD p1%
IF CHECKED(f%+5) = 1 THEN FONT_ITALIC p1%
IF CHECKED(f%+6) = 1 THEN FONT_UNDERLINE p1%
PRINT_TARGET_IS p1%: FONT_COLOR p1%,tr%,tg%,tb%
2D_TARGET_IS p1%
2D_FILL_COLOR 255,255,255
IF CHECKED(co%+2)=1 THEN 2D_FILL_COLOR 254,254,254: COLOR p1%,254,254,254
ht%=TEXT_HEIGHT("ABCxyz",p1%): wt% = 0
x% = 0: y% = 0
FOR k% = 1 TO COUNT(mm%)
    a$ = ITEM_READ$(mm%,k%)
    IF a$ <> ""
        PRINT_LOCATE x%,y%: PRINT a$
        i% = TEXT_WIDTH(a$,p1%): IF i%>wt% THEN wt% = i%
    END_IF
    y% = y% + ht%
NEXT k%
ht% = y%
2D_IMAGE_COPY ima%,0,0,wt%,ht%: FILE_SAVE ima%,ft1$
TEXT ld%,STR$(wt%)+" x "+STR$(ht%)+" pixels."
a$ = STR$(wt%)+" x "+STR$(ht%)+" pixels = "
i% = wt%/rec: j% = ht%/rec: a$ = a$+STR$(i%)+" x "+STR$(j%)+" mm"
TEXT ld%,a$

Texinss:
x% = sx%: y% = sy%
FILE_LOAD ima%,ft1$
IF CHECKED(co%+1) = 1: ' impression directe (fond blanc opaque)
    2D_TARGET_IS p%: 2D_IMAGE_PASTE ima%,x%,y%
ELSE: ' texte fond transparent (pixel par pixel)
    2D_TARGET_IS p1%: 2D_IMAGE_PASTE ima%,0,0
    2D_TARGET_IS p%
    FOR j% = 0 TO ht%-1
        FOR i% = 0 TO wt%-1
            r% = COLOR_PIXEL_RED(p1%,i%,j%)
            IF r% <> 254
                g% = COLOR_PIXEL_GREEN(p1%,i%,j%)
                b% = COLOR_PIXEL_BLUE(p1%,i%,j%)
                2D_PEN_COLOR r%,g%,b%: 2D_POINT x%+i%,y%+j%
            END_IF
        NEXT i%
        DISPLAY
    NEXT j%
END_IF
TO_FOREGROUND f%
IF FILE_EXISTS(ft2$) = 1 THEN FILE_DELETE ft2$
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texrot:
IF x%=-1 OR y%=-1 OR COUNT(mm%)=0 THEN RETURN
CLIPBOARD_COPY p%: ' sauvegarde préalable
2D_TARGET_IS p%
x%=sx%: y%=sy%: ' point d'insertion (haut gauche)
IF FILE_EXISTS(ft2$) = 1 THEN FILE_DELETE ft2$
a$ = "270": ' rotation 90° à gauche
IF NUMBER_CLICK = rtg%+1 THEN a$ = "90": ' rotation 90° à droite
q$ = CHR$(34)
scr$ = rtmp$+"vbscr.vbs"
FILE_OPEN_WRITE 9,scr$
  FILE_WRITELN 9,"Dim Img 'As ImageFile"
  FILE_WRITELN 9,"Dim IP 'As ImageProcess"
  FILE_WRITELN 9,"Set Img = CreateObject("+q$+"WIA.ImageFile"+q$+")"
  FILE_WRITELN 9,"Set IP = CreateObject("+q$+"WIA.ImageProcess"+q$+")"
  FILE_WRITELN 9,"Img.LoadFile "+q$+ft1$+q$
  FILE_WRITELN 9,"IP.Filters.Add IP.FilterInfos("+q$+"RotateFlip"+q$+").FilterID"
  FILE_WRITELN 9,"IP.Filters(1).Properties("+q$+"RotationAngle"+q$+") = "+a$
  FILE_WRITELN 9,"Set Img = IP.Apply(Img)"
  FILE_WRITELN 9,"Img.SaveFile "+q$+ft2$+q$
  FILE_WRITELN 9,"WScript.Quit(0)"
FILE_CLOSE 9
EXECUTE_WAIT "Wscript.exe " + scr$: ' Exécution du script
FILE_DELETE scr$
FILE_LOAD ima%,ft2$: FILE_SAVE ima%,ft1$: FILE_DELETE ft2$
FILE_LOAD p%,fpr$
' la rotation s'effectue autour du centre du texte (?)
sx% = x%+wt%/2-ht%/2:sy% = y%-wt%/2+ht%/2
i% = wt%: wt% = ht%: ht% = i%
IF CHECKED(co%+1) = 1: ' fond opaque
    2D_IMAGE_PASTE ima%,sx%,sy%
ELSE
    2D_TARGET_IS p1%: 2D_IMAGE_PASTE ima%,0,0
    2D_TARGET_IS p%
    FOR j% = 0 TO ht%-1
        FOR i% = 0 TO wt%-1
            r% = COLOR_PIXEL_RED(p1%,i%,j%)
            IF r% <> 254
                g% = COLOR_PIXEL_GREEN(p1%,i%,j%)
                b% = COLOR_PIXEL_BLUE(p1%,i%,j%)
                2D_PEN_COLOR r%,g%,b%: 2D_POINT sx%+i%,sy%+j%
            END_IF
        NEXT i%
        DISPLAY
    NEXT j%
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texshi:
IF x%=-1 OR y%=-1 OR COUNT(mm%)=0 THEN RETURN
ps% = POSITION(sh%+4): ' pas du déplacement
CLIPBOARD_COPY p%
2D_TARGET_IS p%
i% = NUMBER_CLICK
IF i%=sh%: ' décalage vers la gauche
    sx% = sx%-ps%
ELSE
    IF i%=sh%+1: ' décalage vers la droite
        sx%=sx%+ps%
    ELSE
        IF i%=sh%+2: ' décalage vers le haut
            sy%=sy%-ps%
        ELSE: ' décalage vers le bas
            sy%=sy%+ps%
        END_IF
    END_IF
END_IF
FILE_LOAD p%,fpr$
GOSUB Texinss
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texanu:
IF FILE_EXISTS(fpr$) = 1 THEN FILE_LOAD p%,fpr$: CLIPBOARD_COPY p%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Texfin:
ret% = 1
RETURN
END_SUB
' ==============================================================================
SUB Dessin(xa%,ya%,p%,r)
' Boîte à outils affichée en xa%,ya% pour dessiner sur le picture p%
' r = facteur de correction des coordonnées
'     cas du stretch_on dans un picture: r = Largeur picture/Largeur réelle image
'     (r = 1 si picture = image)
' Variables définies dans le programme principal:
'      subact% (témoin d'activité)
'      rtmp$ (répertoire des fichiers temporaires)
'      forsub% (Form utilisée par la sub)
subact% = 1
IF r = 0 THEN r = 1: ' si paramètre absent
DIM_LOCAL f%,t%,i%,j%,k%,x%,y%,a$,tr%,tg%,tb%,n2t%,fig%,trac%,term%,ret%,an,cpt
DIM_LOCAL x1%,y1%,x2%,y2%,x3%,y3%,fpr$,btg%,cap$,rx%,ry%,pix
fpr$ = rtmp$+"Savpre.bmp"
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
IF LABEL("Desfin")=0 THEN LABEL Desfin
IF LABEL("Desopt")=0 THEN LABEL Desopt
IF LABEL("Desanu")=0 THEN LABEL Desanu
IF LABEL("Descou")=0 THEN LABEL Descou
IF LABEL("Destim")=0 THEN LABEL Destim
IF LABEL("Destra")=0 THEN LABEL Destra
IF LABEL("Deslib")=0 THEN LABEL Deslib
IF LABEL("Desrec")=0 THEN LABEL Desrec
IF LABEL("Desron")=0 THEN LABEL Desron
IF LABEL("Desrem")=0 THEN LABEL Desrem
DATA "Pal16": ' palette 16 couleurs
DATA "000000","000080","0000FF","008000","008080","00FF00","00FFFF","800000"
DATA "800080","808000","808080","C0C0C0","FF0000","FF00FF","FFFF00","FFFFFF"
n2t% = NUMBER_2D_TARGET
ON_CLICK p%,Desrem
f% = forsub%: WHILE OBJECT_EXISTS(f%)=1: f%=f%+1: END_WHILE
FORM f%: TOP f%,ya%: LEFT f%,xa%: HEIGHT f%,280: WIDTH f%,145: BORDER_SMALL f%
         COLOR f%,180,255,255: FONT_BOLD f%: FONT_NAME f%,"Arial": ON_CLOSE f%,Desfin
         CAPTION f%,"- OUTILS  DESSIN -"
i%=f%+1: ALPHA i%: PARENT i%,f%: TOP i%,3: CAPTION i%,"Trait:"
i%=f%+2: PICTURE i%: PARENT i%,f%: TOP i%,0: LEFT i%,32: WIDTH i%,35: HEIGHT i%,23
         COLOR i%,0,0,0
i%=f%+3: PICTURE i%: PARENT i%,f%: TOP i%,3: LEFT i%,35: WIDTH i%,WIDTH(i%-1)-5
         HEIGHT i%,18: COLOR i%,255,0,0
i%=f%+4: SPIN i%: PARENT i%,f%: LEFT i%,75: WIDTH i%,40: font_size i%,9
         MIN i%,1: MAX i%,20: POSITION i%,1
i%=f%+5: PICTURE i%: PARENT i%,f%: TOP i%,25: LEFT i%,0: WIDTH i%,WIDTH(f%)-17
         HEIGHT i%,63: 2D_TARGET_IS i%: ON_CLICK i%,Descou
         RESTORE: READ a$: WHILE a$<>"Pal16": READ a$: END_WHILE
         FOR j% = 1 TO 4
             FOR i% = 1 TO 4
                 READ a$
                 tr%=HEX(LEFT$(a$,2)): tg%=HEX(MID$(a$,3,2)): tb%=HEX(RIGHT$(a$,2))
                 2D_FILL_COLOR tr%,tg%,tb%
                 2D_RECTANGLE x%,y%,x%+31,y%+15: x%=x%+32
             NEXT i%
             y%=y%+16: x% = 0
         NEXT j%
         tr% = 0: tg% = 0: tb% = 0: COLOR f%+3,tr%,tg%,tb%
i%=f%+6: CONTAINER_OPTION i%: PARENT i%,f%: TOP i%,TOP(i%-1)+65: WIDTH i%,WIDTH(f%)-17
         LEFT i%,0: HEIGHT i%,125: COLOR i%,255,255,180
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,10: LEFT i%,3: CAPTION i%,"Trait"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,25: LEFT i%,3: CAPTION i%,"Libre"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,40: LEFT i%,3: CAPTION i%,"Rectangle vide"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,55: LEFT i%,3: CAPTION i%,"Rectangle plein"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,70: LEFT i%,3: CAPTION i%,"Cercle/Ellipse vide"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,85: LEFT i%,3: CAPTION i%,"Cercle/Ellipse plein"
i%=i%+1:OPTION i%: PARENT i%,f%+6: TOP i%,100: LEFT i%,3: CAPTION i%,"Remplir"
         MARK_ON f%+7
    FOR j%=f%+7 TO f%+13: WIDTH j%,WIDTH(f%+6)-7: ON_CLICK j%,Desopt: NEXT j%

i%=f%+14: BUTTON i%: PARENT i%,f%: WIDTH i%,60: TOP i%,TOP(f%+6)+HEIGHT(f%+6)
          HEIGHT i%,20: CAPTION i%,"Annuler": ON_CLICK i%,Desanu
i%=f%+15:BUTTON i%: PARENT i%,f%: WIDTH i%,55:TOP i%,TOP(i%-1): LEFT i%,70
         HEIGHT i%,20: CAPTION i%,"Quitter": ON_CLICK i%,Desfin
2D_TARGET_IS p%: 2D_PEN_DOT
t%=f%+16: TIMER t%: PARENT t%,f%: TIMER_INTERVAL t%,40: ON_TIMER t%,Destim
trac% = 0: term% = 0: btg% = 0
fig% = 1: ret% = 0: cap$ = CAPTION$(0)
CLIPBOARD_COPY p%
WHILE 1 > 0: WAIT 100: END_WHILE: GOTO Desfin
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desopt:
fig% = 1: ' trait
IF CHECKED(f%+8) = 1
    fig% = 2: ' tracé libre
    FILE_SAVE p%,fpr$: ' sauvegarde préalable
ELSE
    IF CHECKED(f%+9) = 1 OR CHECKED(f%+10) = 1
        fig% = 3: ' rectangle vide ou plein
    ELSE
        IF CHECKED(f%+11) = 1 OR CHECKED(f%+12) = 1
            fig% = 4: ' cercle vide ou plein
        ELSE
            IF CHECKED(f%+13) = 1
                fig% = 5: ' remplissage
            END_IF
        END_IF
    END_IF
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Destim:
IF CHECKED(f%+13)=1 THEN RETURN: ' remplissage
cpt = cpt+1: IF cpt>1000 THEN cpt = 2
x% = MOUSE_X_POSITION(p%)/r: y% = MOUSE_Y_POSITION(p%)/r: ' position actuelle souris
a$ =  "X= "+STR$(x%)+" pixels  Y= "+STR$(y%)+" pixels"
CAPTION 0,a$
2D_PEN_COLOR tr%,tg%,tb%: 2D_PEN_WIDTH POSITION(f%+4)
IF MOUSE_LEFT_DOWN(p%) = 1: ' bouton gauche enfoncé
    x1% = x%: y1% = y%: ' origine
    trac% = 1
    IF fig% = 2 AND btg% = 0 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
    btg% = 1
END_IF
IF MOUSE_LEFT_UP(p%) = 1: ' relâche, tracé final
    btg% = 0
    IF x1% = -1 THEN RETURN
    TIMER_OFF t%
    ' clipboard_paste p%:
    term% = 1: 2D_PEN_SOLID
    SELECT fig%
        CASE 1: GOSUB Destra
        CASE 2: GOSUB Deslib
        CASE 3: GOSUB Desrec
        CASE 4: GOSUB Desron
        CASE 5: GOSUB Desrem
    END_SELECT
    ' x1% = sx1%: x2% = sx2%: y1% = sy1%: y2% = sy2%
    CLIPBOARD_COPY p%: term% = 0
    trac% = 0: 2D_PEN_DOT: 2D_PEN_COLOR 0,0,255
    TIMER_ON t%
END_IF
IF trac% = 1
    ' tracé provisoire, en continu
    if x1% = -1 then return
    x2% = x%: y2% = y%: ' position actuelle
    IF x2%=x3% AND y2%=y3% THEN RETURN: ' position inchangée
    2D_PEN_DOT: 2D_PEN_COLOR 0,0,255: 2D_PEN_WIDTH 1
    SELECT fig%
        CASE 1: GOSUB Destra
        CASE 2: GOSUB Deslib
        CASE 3: GOSUB Desrec
        CASE 4: GOSUB Desron
    END_SELECT
    x3% = x%: y3% = y%
END_IF
TO_FOREGROUND f%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Destra:
IF cpt = 1 THEN RETURN: ' init
CLIPBOARD_PASTE p%: IF term% = 1 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
2D_LINE x1%,y1%,x2%,y2%
IF term% = 1 THEN x1% = -1
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Deslib:
2D_PEN_SOLID: 2D_PEN_COLOR tr%,tg%,tb%: 2D_PEN_WIDTH POSITION(f%+4)
2D_LINE x1%,y1%,x2%,y2%: x1%=x2%: y1%=y2%
IF term% = 1 THEN x1% = -1
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desrec:
CLIPBOARD_PASTE p%: IF term% = 1 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
2D_LINE x1%,y1%,x2%,y1%:2D_POLY_TO x2%,y2%:2D_POLY_TO x1%,y2%:2D_POLY_TO x1%,y1%
IF term% = 1
    IF CHECKED(f%+10) = 1: ' rectangle plein
        2D_FILL_COLOR tr%,tg%,tb%: 2D_RECTANGLE x1%,y1%,x2%,y2%
    END_IF
    x1% = -1
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desron:
CLIPBOARD_PASTE p%: IF term% = 1 THEN FILE_SAVE p%,fpr$: ' sauvegarde préalable
rx% = (x2%-x1%)/2: ry% = (y2%-y1%)/2: ' rayons
IF SCANCODE = 160 THEN ry% = rx%: SCANCODE = 0: ' cercle: touche 'Maj' enfoncée
x3% = x1%+rx%: y3% = y1%+ry%: ' centre
pix = 4*ATN(1)
2D_POLY_FROM x3%+rx%,y3%
FOR an = 0 TO 2*pix STEP pix/180
    2D_POLY_TO x3%+rx%*COS(an),y3%+ry%*SIN(an)
NEXT an
IF term% = 1
    IF CHECKED(f%+12) = 1: ' cercle/ellipse plein
        2D_FLOOD x3%,y3%,tr%,tg%,tb%
    END_IF
    x1% = -1
END_IF
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desrem:
IF CHECKED(f%+13)=0 THEN RETURN
FILE_SAVE p%,fpr$: ' sauvegarde préalable
x% = MOUSE_X_LEFT_DOWN(p%)/r: y% = MOUSE_Y_LEFT_DOWN(p%)/r
2D_FLOOD x%,y%,tr%,tg%,tb%
x1% = -1
CLIPBOARD_COPY p%
TO_FOREGROUND f%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desanu:
IF FILE_EXISTS(fpr$) = 1 THEN FILE_LOAD p%,fpr$: CLIPBOARD_COPY p%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Descou:
x%=MOUSE_X_LEFT_DOWN(f%+5): y%=MOUSE_Y_LEFT_DOWN(f%+5)
tr%=COLOR_PIXEL_RED(f%+5,x%,y%): tg%=COLOR_PIXEL_GREEN(f%+5,x%,y%)
tb%=COLOR_PIXEL_BLUE(f%+5,x%,y%): COLOR f%+3,tr%,tg%,tb%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Desfin:
ret% = 1
TIMER_OFF t%: DELETE t%: OFF_CLICK p%: 2D_TARGET_IS n2t%
DELETE f%: CAPTION 0,cap$
WAIT 100
subact% = 0: EXIT_SUB
RETURN
END_SUB
' ==============================================================================
SUB Imagin(xa%,ya%,p%)
' boîte à outils, affichée en xa%,ya%, pour apposer une image sur le picture p%
' Variables définies dans le programme principal:
'      subact% (témoin d'activité)
'      rtmp$ (répertoire des fichiers temporaires)
'      forsub% (Form utilisée par la sub)
subact% = 1
DIM_LOCAL f%,i%,j%,k%,x%,y%,tr%,tg%,tb%,a$,b$,ret%,lp%,n2t%,p1%,wt%,ht%,fpr$,opn%
DIM_LOCAL img%,fcl$,fvb$,wi%,hi%,fi$,sh%,ps%,sx%,sy%,adi%,pic%,rc$,wp%,hp%,tra%
DIM_LOCAL t$,n$,rig%,iv$,fop%,ppr%,imi%,far$,bh%,bl%,ft1$,r$,q$,scr$
fi$ = rtmp$+"Ifxwz.txt"
fpr$ = rtmp$+"Savpre.bmp"
fcl$ = rtmp$+"Savcol.bmp"
fvb$ = rtmp$+"Script.vbs": ' calcul des dimensions de l'image
ft1$ = rtmp$+"temp.bmp"
far$ = rtmp$+"Img.bmp": ' provisoires, pour la rotation
wp% = WIDTH(p%): hp% = HEIGHT(p%)
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
rc$ = CHR$(13)+CHR$(10)
n2t% = NUMBER_2D_TARGET: 2D_TARGET_IS p%
IF LABEL("Imgfin")=0 THEN LABEL Imgfin
IF LABEL("Imgchx")=0 THEN LABEL Imgchx
IF LABEL("Imgins")=0 THEN LABEL Imgins
IF LABEL("Imginc")=0 THEN LABEL Imginc
IF LABEL("Imganu")=0 THEN LABEL Imganu
IF LABEL("Imgchw")=0 THEN LABEL Imgchw
IF LABEL("Imgchh")=0 THEN LABEL Imgchh
IF LABEL("Imgshi")=0 THEN LABEL Imgshi
IF LABEL("Imgrot")=0 THEN LABEL Imgrot
IF LABEL("Imginss")=0 THEN LABEL Imginss
f% = forsub%: WHILE OBJECT_EXISTS(f%)=1: f%=f%+1: END_WHILE
  PICTURE f%: FULL_SPACE f%: bl% = (WIDTH(0)-WIDTH(f%))/2: ' largeur bordures latérales
  bh% = HEIGHT(0)-HEIGHT(f%)-bl%: ' bordure haut (bordure bas = bordures latérales)
  DELETE f%
FORM f%: TOP f%,ya%: LEFT f%,xa%: HEIGHT f%,240: WIDTH f%,352: BORDER_SMALL f%
         COLOR f%,180,255,255: FONT_BOLD f%: FONT_NAME f%,"Arial": ON_CLOSE f%,Imgfin
         CAPTION f%,"- OUTILS  IMAGE -"
i%=f%+1: ALPHA i%: PARENT i%,f%: TOP i%,3: CAPTION i%,"Image:"
i%=f%+2: EDIT i%: PARENT i%,f%: TOP i%,0: LEFT i%,40: WIDTH i%,290: ON_CLICK i%,Imgchx: ' Image
         TEXT i%," (parcourir)": FONT_BOLD_OFF i%: FONT_ITALIC i%
i%=i%+1: PICTURE i%: PARENT i%,f%: TOP i%,TOP(i%-1)+28: LEFT i%,1: WIDTH i%,144: HEIGHT i%,108
         STRETCH_ON i%: pic%=i%
i%=i%+1: ALPHA i%: PARENT i%,f%: TOP i%,25: LEFT i%,155: CAPTION i%,"Dimensions:"
i%=i%+1: ALPHA i%: PARENT i%,f%: TOP i%,28: LEFT i%,LEFT(i%-1)+75: WIDTH i%,100
         COLOR i%,255,255,0: adi%=i%

i%=adi%+1: ALPHA i%: PARENT i%,f%: TOP i%,58: LEFT i%,155
           CAPTION i%,"Redim.: W=                  H="
i%=adi%+2: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1)-3: LEFT i%,LEFT(i%-1)+60: WIDTH i%,50
i%=adi%+3: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+70: WIDTH i%,50
           ON_CHANGE adi%+2,Imgchw: ON_CHANGE adi%+3,Imgchh
i%=adi%+4: ALPHA i%: PARENT i%,f%: TOP i%,TOP(i%-1)+25: LEFT i%,LEFT(adi%+2): COLOR i%,255,255,0

i%=i%+1: ALPHA i%: PARENT i%,f%: LEFT i%,165: TOP i%,TOP(i%-1)+20: CAPTION i%,"Luminosité (0 à 127):"
i%=i%+1: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1)-3: LEFT i%,LEFT(i%-1)+120: WIDTH i%,50: tra%=i%
         MIN i%,0: MAX i%,127: POSITION i%,0
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1)+20: LEFT i%,155: WIDTH i%,90: HEIGHT i%,18
         CAPTION i%,"Insérer en 0,0": ON_CLICK i%,Imginc
i%=i%+1: ALPHA i%: PARENT i%,f%: TOP i%,TOP(i%-1)+18: LEFT i%,LEFT(i%-1)+10
         CAPTION i%,"(sinon, insertion au clic souris)"

i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-98: LEFT i%,0: WIDTH i%,80
         CAPTION i%,"Rotation 90°G": ON_CLICK i%,Imgrot: rig% = i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+WIDTH(i%-1)
         WIDTH i%,80: CAPTION i%,"Rotation 90°D": ON_CLICK i%,Imgrot

i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-70: LEFT i%,10: WIDTH i%,25
         CAPTION i%,CHR$(231): sh%=i%
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,35: WIDTH i%,25: CAPTION i%,CHR$(232)
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,60: WIDTH i%,25: CAPTION i%,CHR$(233)
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,85: WIDTH i%,25: CAPTION i%,CHR$(234)
         FOR j% = i%-3 TO i%: FONT_NAME j%,"Wingdings": ON_CLICK j%,Imgshi: NEXT j%
i%=i%+1: SPIN i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+30: WIDTH i%,40
         POSITION i%,5

i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,HEIGHT(f%)-70: LEFT i%,WIDTH(f%)/2
          CAPTION i%,"Annuler": ON_CLICK i%,Imganu
i%=i%+1: BUTTON i%: PARENT i%,f%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+80
          CAPTION i%,"Quitter": ON_CLICK i%,Imgfin
i%=i%+1: OPEN_DIALOG i%: opn% = i%
i%=i%+1: IMAGE i%: img% = i%
i%=i%+1: fop% = i%
i%=i%+1: ppr% = i%
i%=i%+1: imi% = i%
ON_CLICK p%,Imgins: ' clic sur le point d'insertion de l'image (picture principal)
x%=-1: y%=-1
ret% = 0: WHILE ret% = 0: WAIT 100: END_WHILE
OFF_CLICK p%: 2D_TARGET_IS n2t%
DELETE f%: IF OBJECT_EXISTS(opn%)=1 THEN DELETE opn%
IF OBJECT_EXISTS(img%)=1 THEN DELETE img%
IF FILE_EXISTS(fpr$) = 1 THEN FILE_DELETE fpr$
IF FILE_EXISTS(fcl$) = 1 THEN FILE_DELETE fcl$
IF FILE_EXISTS(far$) = 1 THEN FILE_DELETE far$
subact% = 0
EXIT_SUB
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgchx:
FILTER opn%,"*.bmp;*.jpg"
a$ = FILE_NAME$(opn%): IF LEN(a$)<4 THEN RETURN
b$ = UPPER$(FILE_EXTRACT_EXTENSION$(a$))
IF b$<>".BMP" AND b$<>".JPG"
    MESSAGE "Fichier "+a$+CHR$(10)+"type incorrect (doit être .BMP ou .JPG)": RETURN
END_IF
TEXT f%+2,a$: far$ = a$: FONT_ITALIC_OFF f%+2: FONT_BOLD f%+2
r$ = FILE_EXTRACT_PATH$(a$): n$ = FILE_EXTRACT_NAME$(a$)
FILE_OPEN_WRITE 9,fvb$
    FILE_WRITELN 9,"Const DIMENSIONS = 31"
    FILE_WRITELN 9,"Set oShell  = CreateObject ("+CHR$(34)+"Shell.Application"+CHR$(34)+")"
    FILE_WRITELN 9,"Set oFolder = oShell.Namespace ("+CHR$(34)+r$+CHR$(34)+")"
    FILE_WRITELN 9,"Set oFile   = oFolder.ParseName("+CHR$(34)+n$+CHR$(34)+")"
    FILE_WRITELN 9,"strDimensions = oFolder.GetDetailsOf(oFile, DIMENSIONS)"
    FILE_WRITELN 9,"WScript.Echo strDimensions"
FILE_CLOSE 9
EXECUTE_WAIT "Cmd.exe /c Cscript.exe "+fvb$+" | clip"
FILE_DELETE fvb$
r$ = TRIM$(CLIPBOARD_STRING_PASTE$): r$ = MID$(r$,2,LEN(r$)-2)
wi% = VAL(LEFT$(r$,INSTR(r$," x ")-1)): hi% = VAL(MID$(r$,INSTR(r$," x ")+3,10))
i% = wi%/rec: j% = hi%/rec: ' en mm à l'écran
a$ = " "+STR$(wi%)+" x "+ STR$(hi%)+" pixels "
a$=a$+rc$+"= "+STR$(i%/10)+" x "+STR$(j%/10)+" cm"
CAPTION adi%,a$
POSITION adi%+2,wi%: POSITION adi%+3,hi%
IF wi%>hi%
    WIDTH pic%,120: HEIGHT pic%,120*hi%/wi%
ELSE
    HEIGHT pic%,90: WIDTH pic%,90*wi%/hi%
END_IF
FILE_LOAD pic%,TEXT$(f%+2): ' vignette
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgins:
IF TEXT$(f%+2) = "" OR LEFT$(TEXT$(f%+2),1)=" " THEN TO_FOREGROUND f%: RETURN: ' pas d'image
sx% = MOUSE_X_POSITION(p%): sy% = MOUSE_Y_POSITION(p%)
FILE_SAVE p%,fpr$: ' sauvegarde préalable
' insertion de l'image au clic souris (coin supérieur gauche)
Imginss:
x% = sx%: y% = sy%
a$ = far$: ' image à insérer
i% = POSITION(adi%+2): j% = POSITION(adi%+3): ' w,h redimensionnement éventuel
FORM fop%: TOP fop%,TOP(0): LEFT fop%,LEFT(0): WIDTH fop%,i%: HEIGHT fop%,j%: BORDER_HIDE fop%
PICTURE ppr%: PARENT ppr%,fop%: WIDTH ppr%,i%: HEIGHT ppr%,j%: STRETCH_ON ppr%
FILE_LOAD ppr%,a$
IF POSITION(tra%) > 0 THEN BRIGHTNESS ppr%,POSITION(tra%): ' luminosité
2D_TARGET_IS 0
IMAGE imi%
2D_IMAGE_COPY imi%,-1*bl%,-1*bh%,i%-bl%,j%-1*bh%: ' pour tenir compte des bordures de Form 0
CLIPBOARD_COPY imi%
DELETE fop%: DELETE imi%
CLIPBOARD_PASTE img%
2D_TARGET_IS p%: 2D_IMAGE_PASTE img%,x%,y%
TO_FOREGROUND f%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imginc:
' insertion en 0,0 du picture
sx% = 0: sy% = 0: FILE_SAVE p%,fpr$: ' sauvegarde préalable
GOSUB Imginss
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgchw:
' redimensionnement éventuel de l'image
POSITION adi%+3,POSITION(adi%+2)*hi%/wi%: ' largeur proportionnelle à la hauteur
i% = POSITION(adi%+2)/rec: j% = POSITION(adi%+3)/rec: ' en mm à l'écran
CAPTION adi%+4,"= "+STR$(i%/10)+" x "+STR$(j%/10)+" cm."
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgchh:
i% = POSITION(adi%+2)/rec: j% = POSITION(adi%+3)/rec: ' en mm à l'écran
CAPTION adi%+4,"= "+STR$(i%/10)+" x "+STR$(j%/10)+" cm."
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgshi:
IF x%=-1 OR y%=-1 THEN RETURN
ps% = POSITION(sh%+4): ' pas du déplacement
CLIPBOARD_COPY p%
2D_TARGET_IS p%
i% = NUMBER_CLICK
IF i%=sh%: ' décalage vers la gauche
    sx% = sx%-ps%
ELSE
    IF i%=sh%+1: ' décalage vers la droite
        sx%=sx%+ps%
    ELSE
        IF i%=sh%+2: ' décalage vers le haut
            sy%=sy%-ps%
        ELSE: ' décalage vers le bas
            sy%=sy%+ps%
        END_IF
    END_IF
END_IF
FILE_LOAD p%,fpr$
GOSUB Imginss
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgrot:
IF x%=-1 OR y%=-1 THEN RETURN
CLIPBOARD_COPY p%
2D_TARGET_IS p%
i% = POSITION(adi%+2): j% = POSITION(adi%+3): ' dimensions de l'image
x%=sx%: y%=sy%: ' point d'insertion (haut gauche)
2D_IMAGE_COPY img%,x%,y%,x%+i%,y%+j%

IF FILE_EXISTS(far$) = 1 THEN FILE_DELETE far$
FILE_SAVE img%,ft1$
a$ = "270": ' rotation 90° à gauche
IF NUMBER_CLICK = rig%+1 THEN a$ = "90": ' rotation 90° à droite
q$ = CHR$(34)
scr$ = rtmp$+"vbscr.vbs"
FILE_OPEN_WRITE 9,scr$
  FILE_WRITELN 9,"Dim Img 'As ImageFile"
  FILE_WRITELN 9,"Dim IP 'As ImageProcess"
  FILE_WRITELN 9,"Set Img = CreateObject("+q$+"WIA.ImageFile"+q$+")"
  FILE_WRITELN 9,"Set IP = CreateObject("+q$+"WIA.ImageProcess"+q$+")"
  FILE_WRITELN 9,"Img.LoadFile "+q$+ft1$+q$
  FILE_WRITELN 9,"IP.Filters.Add IP.FilterInfos("+q$+"RotateFlip"+q$+").FilterID"
  FILE_WRITELN 9,"IP.Filters(1).Properties("+q$+"RotationAngle"+q$+") = "+a$
  FILE_WRITELN 9,"Set Img = IP.Apply(Img)"
  FILE_WRITELN 9,"Img.SaveFile "+q$+far$+q$
  FILE_WRITELN 9,"WScript.Quit(0)"
FILE_CLOSE 9
EXECUTE_WAIT "Wscript.exe " + scr$: ' Exécution du script
FILE_DELETE scr$: FILE_DELETE ft1$
FILE_LOAD img%,far$: ' nouvelle image pivotée
FILE_LOAD p%,fpr$
' rotation autour du centre de l'image (?)
sx% = x%+i%/2-j%/2: sy% = y%+j%/2-i%/2: ' pour rotation de 90°
2D_IMAGE_PASTE img%,sx%,sy%
k% = POSITION(adi%+2): POSITION adi%+2,POSITION(adi%+3): POSITION adi%+3,k%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imganu:
IF FILE_EXISTS(fpr$) = 1 THEN FILE_LOAD p%,fpr$: CLIPBOARD_COPY p%
RETURN
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
Imgfin:
ret% = 1
RETURN
END_SUB
' ==============================================================================
SUB Dimima(f$)
' Dimensions d'une image Bmp ou Jpg -> clipboard, sous la forme: wwwxhhh
DIM_LOCAL pi%,vi%(8 )
pi%=970: WHILE OBJECT_EXISTS(pi%)=1: pi% = pi%+1: END_WHILE
PICTURE pi%: TOP pi%,-1000: LEFT pi%,-1000
FILE_LOAD pi%,f$: FILE_SAVE pi%,rtmp$+"Dima.bmp"
FILEBIN_OPEN_READ 9, rtmp$+"Dima.bmp"
    FILEBIN_POSITION 9,18: FILEBIN_BLOCK_READ 9,8,vi%(0)
FILEBIN_CLOSE 9: FILE_DELETE rtmp$+"Dima.bmp"
CLIPBOARD_STRING_COPY STR$(vi%(0)+256*vi%(1))+"x"+STR$(vi%(4)+256*vi%(5))
DELETE pi%
END_SUB
' ==============================================================================
SUB Pr_init(orient%,prn$)
' Initialisation imprimante ('début d'impression')
' orient% = 0 Portrait, = 1 Paysage
' prn$ = "": imprimante par défaut
'            sinon nom de l'imprimante (pour essais)
'            par exemple "Microsoft XPS Document Writer" impression virtuelle
'            dans un fichier .XPS
' Dans les paramètres des fonctions, le positionnement initial doit être fait en
' valeurs absolues: distances par rapport aux bords gauche et haut de la feuille
' A4, sans tenir compte des marges non imprimables.
' Les couleurs sont à exprimer au format BGR (en non pas RGB): B*256*256+G*256+R
IF VARIABLE("phnd%") = 0 THEN DIM phnd%
IF VARIABLE("chnd%") = 0 THEN DIM chnd%
IF VARIABLE("inip%") = 0 THEN DIM inip%
IF VARIABLE("Pr_res%") = 0 THEN DIM Pr_res%
IF VARIABLE("Pr_px%") = 0 THEN DIM Pr_px%: ' pixels par mm (600 dpi)
IF VARIABLE("Pr_lt%") = 0 THEN DIM Pr_lt%: ' largeur totale
IF VARIABLE("Pr_ht%") = 0 THEN DIM Pr_ht%: ' hauteur totale
IF VARIABLE("Pr_mg%") = 0 THEN DIM Pr_mg%: ' marge gauche
IF VARIABLE("Pr_mh%") = 0 THEN DIM Pr_mh%: ' marge haut
IF VARIABLE("Pr_lu%") = 0 THEN DIM Pr_lu%: ' largeur utile
IF VARIABLE("Pr_hu%") = 0 THEN DIM Pr_hu%: ' hauteur utile
IF prn$ <> "": ' pour essais sans impression réelle
    Pr_res%=DLL_CALL4("PrinterManager",10,ADR(phnd%),ADR(chnd%),ADR(prn$))
END_IF
' Orientation portrait (0) ou paysage (1)
Pr_res% = DLL_CALL4("PrinterManager",4,ADR(phnd%),ADR(chnd%),orient%): ' orientation
Pr_res% = DLL_CALL4("PrinterManager",1,ADR(phnd%),ADR(chnd%),0): ' init
' Dimensions sans les marges, en pixels:
' ==========
' ATTENTION: Les dimensions sont actualisées en fonction de l'option orientation !
' ==========
Pr_lt% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),3,0,0): ' largeur totale
Pr_ht% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),4,0,0): ' hauteur totale
IF orient% = 0
    Pr_px% = Pr_ht%/297: ' pixels par mm, à l'impression en 600 dpi
ELSE
    Pr_px% = Pr_lt%/297: ' idem (paysage)
END_IF
' Marges non imprimables: décalage en pixels à soustraire gauche et haut:
Pr_mg% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),1,0,0): ' marge gauche
Pr_mh% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),2,0,0): ' marge haut
' Dimensions utiles, en pixels:
IF Pr_mg% = 0 OR Pr_mh%= 0: ' cas imprimante virtuelle (PDFCreator)
    Pr_mg% = 75: Pr_mh% = 75: ' forçage comme imprimante réelle
    Pr_lu% = Pr_lt% - 2*Pr_mg%: Pr_hu% = Pr_ht% - 2*Pr_mh%
ELSE
    Pr_lu% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),7,0,0): ' largeur utile
    Pr_hu% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),8,0,0): ' hauteur utile
END_IF
' Couleur trait noir, épaisseur = 1, arrière-plan transparent:
inip% = -2
Pr_res% = DLL_CALL6("PrinterFunction",6,ADR(phnd%),ADR(chnd%),0,inip%,1)
inip% = 1
END_SUB
' ==============================================================================
SUB Pr_Image(f$,x%,y%,w%,h%,u%)
' Impression de l'image f$ en x%,y%, dimensions w% x h% (sera redimensionnée pour
' tenir dans le cadre donné).
' u% = 0: unités pixels, u% = 1, unités millimètres
' ******** NB: coordonnées d'impression absolues (pixels): de 0,0 à 4962,7013 ********
' Attention aux marges non imprimables de 75 pixels haut/bas, gauche/droite
IF inip% = 0 THEN EXIT_SUB: ' imprimante non initialisée (Sub Pr_Init)
IF u% = 1: ' unités en mm, conversion en pixels
    x% = x%*Pr_mmpix: y% = y%*Pr_mmpix: w% = w%*Pr_mmpix: h% = h%*Pr_mmpix
END_IF
Pr_res% = DLL_call6("PrinterFunction",4,ADR(phnd%),ADR(chnd%),0,x%,y%): ' positionnement
Pr_res% = DLL_call6("PrinterFunction",7,ADR(phnd%),ADR(chnd%),ADR(f$),w%,h%)
END_SUB
' ==============================================================================
SUB Pr_Impr()
' Lancement de l'impression réelle ('fin d'impression')
IF inip% = 0 THEN EXIT_SUB: ' imprimante non initialisée (Sub Pr_Init)
Pr_res% = DLL_CALL4("PrinterManager",3,ADR(phnd%),ADR(chnd%),0)
inip% = 0
END_SUB
' ==============================================================================

J'ai toutefois un bémol: on peut faire tout ce qu'on veut dans le programme, mais au moment du Terminate j'ai systématiquement l'erreur suivante:


depuis que j'ai ajouté des menus. Je ne m'explique pas pourquoi, tout fonctionne pourtant correctement, je ne vois pas d'erreur dans les menus, et ça apparaît uniquement au moment de quitter le programme...
Si quelqu'un a une idée, je suis preneur !

C'est l'effet du bug Terminate, réparé provisoirement,  merci Klaus.

Edit 20h30: intégration de la parade Klaus avant le Terminate (contournement du bug qui cause le Sub-menu is not...)
23h15: rectification de quelques petites erreurs.
14/14 14h00: quelques modifs, notamment pour adapter à W10
        17H00: adaptation à toutes les tailles d'écran


Dernière édition par JL35 le Lun 14 Déc 2015 - 19:42, édité 6 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10075
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Projets sur format A4   Dim 13 Déc 2015 - 21:27

Tu tombes à nouveau sur le bug du TERMINATE. Il n'est pas corrigé encore, dans la version V0.9.27i3. J'ai ceci, en choisissant "Quitter" directement après le lancement:


J'ai donc modifié "brutalement" ta routine QUIT de la manière suivante:
Code:
Quit:
dll_on kgf$ : dim res%
res% = dll_call1("KillProcessByHandle",handle(0))
TERMINATE
et il n'y a plus de problème. Essaie comme ça... J'ai vérifié les menus et je n'ai rien trouvé d'anormal.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
JL35



Nombre de messages : 5953
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: Projets sur format A4   Dim 13 Déc 2015 - 22:22

En effet Klaus, j'avais bien vaguement pensé au bug de Terminate signalé par ailleurs (que je croyais corrigé), mais sans insister, et manifestement c'est bien ça, et d'un côté ça me rassure plutôt.

Et ta solution marche très bien, merci à toi, c'est brutal mais bien plus propre comme ça.
Je vais l'implémenter ci-dessus.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10075
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 1:23

Tu sais, dans les notes pour la version V0.9.27i3, Jack dit ceci:
Citation :
bugs ou problèmes connus (et pas encore corrigés faute de temps) :

- plantage avec TERMINATE
- OBJECT_PARENT() devrait se nommer PARENT()
- un objet TAB devrait pouvoir contenir un CONTAINER_TAB
- MOUSE_LEFT_DOWN() et MOUSE_RIGHT_DOWN() qui ne "fonctionnent qu'une fois" lorsque le bouton reste enfoncé
Donc, pas de panique - à chaque fois qu'il y a un problème avec TERMINATE, nous avons une solution "propre" qui pourra durer tant que ce bug n'est pas résolu.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
JL35



Nombre de messages : 5953
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 1:36

J'avais bien lu cette histoire de Terminate, mais je n'avais pas encore rencontré le problème, alors...
Et puis ici, je venais juste de rajouter les Menus (avant je faisais autrement), et paf ! 'Sub-menu is not in menu' !
alors je me sentais un peu coupable...

Dans tous les cas, merci encore à toi Klaus pour m'avoir donné une solution propre (sans parler de m'avoir rassuré...)
Et là-dessus... Sleep
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5040
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 9:10

Bonjour,

@Klaus, as-tu vu cette ligne "ON_CLOSE 0,Quit" dans le programme de JL35.
Tu m'as expliqué dans un autre poste que l'on ne doit pas mettre TERMINATE au label Quit, quand ce label est appelé par ON_CLOSE.

@JL35,
Ne serait-il pas mieux de faire "ON_CLICK 0,fin /fin: RETURN" et de conserver Quit pour les autres sorties.

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10075
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 11:41

@JL35:
Citation :
@Klaus, as-tu vu cette ligne "ON_CLOSE 0,Quit" dans le programme de JL35.
Tu m'as expliqué dans un autre poste que l'on ne doit pas mettre TERMINATE au label Quit, quand ce label est appelé par ON_CLOSE.
Je ne me rappelle plus le contexte dans lequel j'ai pu dire cela. J'ai essayé avec le présent programme, et ça ne pose aucun problème. En fait, la fonction KillProcessByHandle instruit Windows de terminer le processus immédiatement, sans autre forme de procès. C'est un peu ce que Process Manager fait. Et ça marche quelque soient les circonstances. Maintenant, il est certain qu'il n'y a pas de retour après l'appel à cette fonction, et il est inutile de placer du code après cela, car il ne sera jamais exécuté. Et en particulier, un appel à cette fonction ne déclenchera pas l'évènement ON_CLOSE...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
silverman

avatar

Nombre de messages : 466
Age : 45
Localisation : Picardie
Date d'inscription : 19/03/2015

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 14:07

Bonjour à tous,

@jl35
remplace le terminate par end, si le même message d'erreur apparait, c'est qu'il y a un pb dans ton code, sinon c'est bien le terminate qui est incriminé.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



Nombre de messages : 5953
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 16:07

@Klaus
C'est à Jean Claude que ton message s'adressait, pas à moi...

@Jean Claude
Tu dis de mettre ON_CLICK 0,fin ??? tu ne voulais pas dire ON_CLOSE ?
Sinon, sachant qu'il y a un bug dans le Terminate, je ne vais pas pinailler là-dessus, et puisqu'on a une solution de rechange j'attendrai sereinement que ce soit réparé.

@silverman
Bien sûr, si je remplace le Terminate par End je n'ai plus d'erreur, mais c'est juste pour voir.
Mais bon, c'est peut-être effectivement un moyen de lever le doute.
Sinon, d'une manière plus générale, une erreur qui n'apparaît qu'au moment du Terminate et pas avant, j'ai du mal à croire que ça puisse être une erreur dans le code, il me semble qu'elle aurait été détectée avant ?

Sinon j'ai fait de petites modifs dans le code là-haut, principalement pour éviter l'apparition des ascenseurs bien gênants sous Windows 10 quand on appelle les subs Texte, Dessin et Imagin (sinon je vais me faire enguirlander par Jean Claude, vous me direz c'est la saison des guirlandes, mais bon...).

Autre modif: adaptation à toutes les tailles d'écran, pour avoir toujours la totalité de l'image de la feuille à l'écran, mais il est bien évident que sur un petit écran le dessin sera aussi petit et on perdra de la qualité à l'impression (la définition sera d'autant moins bonne).
Et aussi un défaut d'orientation à l'impression dans certains cas (A4 portrait).
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5040
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 20:23

@Klaus,
J'ai trouvé le sujet pour ON_CLOSE et TERMINATE.
Cela commence à la fin de la page 2 du sujet.

=> http://panoramic.free-boards.net/t4453-le-terminate-recalcitrant

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10075
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 20:54

@Jean-Claude:
Effectivement, j'ai posté ceci:
Citation :
Ca, c'est plutôt normal. avec "on_close 0,fin", tu déclenches certainement une boucle infinie, ce qui est détecté par Windows. En effet, la commande TERMINATE provoque justement l'évènement ON_CLOSE. Alors, lorsque tu déclenches le même évènement par un clic sur la croix rouge... Il ne doit pas beaucoup aimer cela.
et je persiste et signe. En réalité, il faudrait faire comme ceci:
Code:

label sortie, fin
...
sub_menu 123 : parent 123,97 : caption 123,"Sortie" : on_click 123,sortie
on_close 0,fin
...
sortie:
  if message_confirmation_yes_no("Voulez-vous vraiment sortir ?")<>1 then return
  ... ici, faire éventuellement le ménage...
  terminate : ' <==== ceci déclenche le ON_CLOSE de la form 0
  ' ici; RETURN n'est plus utile, ni END d'ailleurs !

fin:
  ... ici, faire le ménage...
  ' la ligne suivante serait la façon correcte de terminer:
  return
  ' mais à cause du bug de TERMINATE, faire:
  res% = dll_call0("KillProcessByHandle",handle(0))
  ' <==== on n'arrivera jamais ici !

Voilà, je pense que c'est compréhensible, non ? Evidemment, si aucun "ménage" n'est à faire pour fermer le programme, les labels sortie et fin peuvent être confondus en un seul après lequel on trouvera uniquement l'appel de KillProcessByHandle. C'est ce que j'ai fait dans le code qui a causé cette discussion.

Un dernier point: dans mon petit code ci-dessus, pour la démo, j'ai mis une demande de confirmation de clôture. Il est bien évident que cela peut se faire lorsqu'on demande la sortie par un clic sur un objet quelconque, mais c'est totalement inopérant en cliquant sur la croix rouge. Dans ce dernier cas, l'évènement ON_CLOSE se déclenche bien, mais aucun dialogue n'est possible, et on ne peut pas annuler l'arrêt du programme.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jean Claude

avatar

Nombre de messages : 5040
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Projets sur format A4   Lun 14 Déc 2015 - 22:13

Klaus a écrit:
l'évènement ON_CLOSE se déclenche bien, mais aucun dialogue n'est possible, et on ne peut pas annuler l'arrêt du programme.

C'est peut-être vrai avec ta DLL, mais en pure Panoramic le dialogue est possible.

Un code simple pour voir les 2 façons de sortir en Panoramic.
Code:
label fin,sortie
  on_close 0,fin
button 1 : caption 1,"Quitter"
  on_click 1,sortie
end
rem ======================
fin:
  if message_confirmation_yes_no("Vos sauvegardes ne sont pas faite"+chr$(13)+"voulez-vous les faire ?")=1
    message "Sauvegardes éffectuées, à bientôt"
  else
    message "à bientôt"
    ' on ne fait rien
  end_if
return

sortie:
  message "Vos sauvegardes ont été effectuées automatiquement, à bientôt"
  TERMINATE
return


A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10075
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Projets sur format A4   Mar 15 Déc 2015 - 1:42

Citation :
Klaus a écrit:
   l'évènement ON_CLOSE se déclenche bien, mais aucun dialogue n'est possible, et on ne peut pas annuler l'arrêt du programme.
Bon, d'accord... ce que je voulais dire qu'on ne peut pas faire un dialogue pour annuler l'arrêt. C'est vrai, je n'ai pas été suffisamment clair.

Mais quelque soit le cas, la fonction KillProcessByHandle, qui n'est certes pas LA solution miracle, fait le boulot sans bavure, et remplace TERMINATE tant que le bug n'est pas résolu. La différence fondamentale, c'est que TERMINATE fait peut-être des choses dans Panoramic, puis déclenche le ON_CLOSE de la form 0 si cet évènement est déclare. KillProcessByHandle ne le fait pas - il termine immédiatement, de façon sèche.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Contenu sponsorisé




MessageSujet: Re: Projets sur format A4   

Revenir en haut Aller en bas
 
Projets sur format A4
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» [Résolu]Projets softwarezator, .Net framework pour tous?
» support du format svg en librairie
» [Résolu] Photoshop problème format images
» Produit Alberto gratuit (format régulier)
» format des BMP sur Garmin 3490 : pas d'affichage

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos sources, vos utilitaires à partager-
Sauter vers: