Photos&Images Viewer - Impression avec commentaires ajou

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Photos&Images Viewer - Impression avec commentaires ajou

Message par Jacobus »

Salut à tous, voici un petit code permettant de créer un exécutable léger de visionnage d'images avec possibilité d'imprimer ses photos en ajoutant un commentaire (format A4)

Cependant, certaines imprimantes ne rendent pas l'effet voulu (taille de l'image pas glop) donc avant de lancer une impression, réglez votre printer sur "Aperçu avant impression" ça évitera le gaspillage. Sinon ça rend bien, à essayer.

Alors comme d'hab, n'hésitez à améliorer le code et à nous en faire profiter.

@+ Jacobus :wink:

Code : Tout sélectionner

 ;Images viewer and printer with comments by Jacobus 07/2005
;
;Simple et à adapter en fonction des besoins de chacun
;Si vous pouvez apporter des améliorations n'hésitez pas à en faire profiter 
;tout le monde, merci
;
;- constantes;
Enumeration 
  #WindowWidth  = 795
  #WindowHeight = 550
  #Fenetre_principale = 0
  #btn_ChoixImage
  #Photo
  #PhotoVue
  #btn_Redim2:#btn_Redim4:#btn_RealImage
  #scrollimage
  #PrintImage
  #btn_Tailleimage
  #EditorPhoto
  #btn_CloseImage
  #string_image
  #pic
EndEnumeration 

UseJPEGImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()

Global RepImg$, NomImage$,DossierImages$
Global ResultImage

DossierImages$= "C:\Documents and Settings\JEAN-MARC\Mes documents\Mes images\";<----- A MODIFIER

Global FontID1
FontID1 = LoadFont(20, "Courier New", 10)

Procedure.s ApplicationDir()
  ; astuce publiée par le Soldat inconnu !!
  appdir$ = Space(255)
  GetCurrentDirectory_(255, @appdir$)
  If Right(appdir$, 1) <> "\" ; si l'adresse ne finit pas par "\"
    appdir$ = appdir$ + "\" ; on rajoute le "\"
  EndIf
  ProcedureReturn appdir$
EndProcedure
Global AppliDir$
AppliDir$=ApplicationDir()

Procedure Viewer()
  If OpenWindow(0,0,0, #WindowWidth, #WindowHeight, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget |#PB_Window_TitleBar, "Photos & Images - Par Jacobus")And CreateGadgetList(WindowID(0)) 
    
    ButtonGadget(#btn_ChoixImage,5,0,60,20,"Ouvrir")
    GadgetToolTip(#btn_ChoixImage,"Choisir une photo et l'afficher")
    
    StringGadget(#string_image,65,0,200,20,"")
    ;SetGadgetColor(#string_image,RGB($0,$FF,$FF),RGB($0,$0,$0));<------lib de Denis nécessaire
    
    ButtonGadget(#btn_CloseImage,265,0,60,20,"Fermer")
    GadgetToolTip(#btn_CloseImage,"Fermer l'image en cours")
    DisableGadget(#btn_CloseImage, 1);<-------désactivé tant qu'il n'y a pas d'image 
    
    ButtonGadget(#PrintImage,325,0,60,20,"Imprimer")
    GadgetToolTip(#PrintImage,"Imprime l'image en cours et les commentaires éventuels")
    DisableGadget(#PrintImage, 1);<-------désactivé tant qu'il n'y a pas d'image 
    
    ButtonGadget(#btn_Tailleimage,400,0,80,20,"Taille de l'image")
    GadgetToolTip(#btn_Tailleimage,"Renvoie la taille en pixels de l'image affichée")
  DisableGadget(#btn_Tailleimage, 1);<-------désactivé tant qu'il n'y a pas d'image 
    
    ButtonGadget(#btn_Redim2,480,0,40,20,"Img/2")
    GadgetToolTip(#btn_Redim2,"Diviser par 2 la taille de l'image")
    DisableGadget(#btn_Redim2, 1);<-------désactivé tant qu'il n'y a pas d'image 
    
    ButtonGadget(#btn_Redim4,520,0,40,20,"Img/4")
    GadgetToolTip(#btn_Redim4,"Diviser par 4 la taille de l'image")
    DisableGadget(#btn_Redim4, 1);<-------désactivé tant qu'il n'y a pas d'image 
    
    ButtonGadget(#btn_RealImage,560,0,80,20,"Agrandir l'image")
    GadgetToolTip(#btn_RealImage,"Afficher à la taille réelle l'image en cours") 
    DisableGadget(#btn_RealImage, 1) ;<-------désactivé tant qu'il n'y a pas d'image 
    
  ScrollAreaGadget(#scrollimage, 0,20, 790,400, 780, 390, 30) ;<-------Taille de départ
    ImageGadget(#PhotoVue,0,0,0,0,0)                          ;<-------initialisé à zéro
    CloseGadgetList()                                         ;<-------clos la scrollarea
    
  EditorGadget(#EditorPhoto, 0, 420, 795, 95, #PB_Container_Raised);<-------Pour commenter la photo avant de l'imprimer
    SendMessage_(GadgetID(#EditorPhoto), #EM_SETTARGETDEVICE, #Null, 0)
    AddGadgetItem(#EditorPhoto, 0," COMMENTAIRES : ")
    
  EndIf  
EndProcedure

Viewer() 
Repeat 
  Event = WaitWindowEvent() 
  Select Event 
    Case #PB_EventGadget 
      Select EventGadgetID()
        
        Case #btn_ChoixImage
          NomImage$ = OpenFileRequester("Sélectionnez une image", DossierImages$, "Images bmp; jpeg; png; tif; tga|*.bmp;*.jpg;*.png;*.tif;*.tga", 0)
          If NomImage$ <> ""
            ResultImage = LoadImage(#Photo, NomImage$)
            SetGadgetAttribute(#scrollimage, #PB_ScrollArea_InnerWidth, ImageWidth());Modifie la largeur de la zone interne de la scrollarea en fonction de la largeur de l'image.
            SetGadgetAttribute(#scrollimage, #PB_ScrollArea_InnerHeight, ImageHeight());Modifie la hauteur de la zone interne de la scrollarea en fonction de la hauteur de l'image. 
            SetGadgetState(#PhotoVue, ResultImage)
            SetGadgetText(#EditorPhoto," COMMENTAIRES : ") 
            FichierImage$ = GetFilePart(NomImage$) 
            SetGadgetText(#string_image,FichierImage$)
            DisableGadget(#btn_Tailleimage, 0)
            DisableGadget(#btn_Redim2, 0)
            DisableGadget(#btn_Redim4, 0)
            DisableGadget(#btn_CloseImage, 0)
            DisableGadget(#PrintImage, 0)
            DisableGadget(#btn_RealImage, 1)
          EndIf 
          
          
        Case #PhotoVue 
          
          Select EventType()
            Case #PB_EventType_LeftClick
              ImageName$ = GetGadgetText(#string_image)
              Hauteur = ImageHeight() : ValeurH$ = Str(Hauteur)  
              Largeur = ImageWidth()  : ValeurL$ = Str(Largeur) 
              If ImageName$<>""
                MessageRequester(ImageName$,"Image en cours"+Chr(13)+"Largeur : "+ValeurL$+"  pixels"+Chr(13)+"Hauteur : "+ValeurH$+"  pixels" ,64)
              Else 
                MessageRequester("PAS D'IMAGE AFFICHÉE !","Vous n'avez ouvert aucune image !",#MB_ICONEXCLAMATION)
              EndIf 
          EndSelect
          
          
        Case #btn_CloseImage 
          ImgInit = IsImage(#Photo)
          If ImgInit <>0
          FreeImage(#Photo) : SetGadgetState(#PhotoVue, 0)
          SetGadgetText(#string_image,"")
          SetGadgetText(#EditorPhoto," COMMENTAIRES : ")
          DisableGadget(#btn_Tailleimage, 1)
          DisableGadget(#btn_Redim2, 1)
          DisableGadget(#btn_Redim4, 1)
          DisableGadget(#btn_RealImage, 1)
          DisableGadget(#btn_CloseImage, 1)
          DisableGadget(#PrintImage, 1)
        EndIf 
          
        Case #PrintImage ;Cette méthode d'impression image est de Paul Leischow, j'ai seulement ajouté l'impression des commentaires.
          ; pour tester sans gaspiller de papier et d'encre, régler l'imprimante sur aperçu avant impression. 
          ;#pic  = 1  
        If LoadImage(#pic,NomImage$)        ;<---Chargement de l'image en cours
          If PrintRequester() 
            ;fiximage.f=(ImageWidth()*8.39)/PrinterPageWidth()
            fiximage.f=ImageWidth()/PrinterPageWidth()
            
            imgx.f=ImageWidth()/fiximage
            imgy.f=ImageHeight()/fiximage
            ;ResizeImage(#pic,imgx,imgy)      ;<---this sizes image To print exact size  ( me donne pas satisfaction, y a un bean's mais je ne sais pas où...)
            
            fillx.f=imgx*(PrinterPageWidth()/imgx)
            filly.f=imgy*(PrinterPageWidth()/imgx)
          ResizeImage(#pic,fillx,filly)       ;<---this sizes image to fit full page     ( impression pleine page )
          
          If StartPrinting("Print Image")     
            If StartDrawing(PrinterOutput()) 
              DrawingFont(FontID1)
              For n=1 To CountGadgetItems(#EditorPhoto)
                Locate(20, 20 * n ) 
                DrawText(GetGadgetItemText(#EditorPhoto,n-1,0))
              Next 
              DrawImage(UseImage(#pic),0,150)
              StopDrawing()        
            EndIf 
            StopPrinting()          
          EndIf    
          ;MessageRequester("Impression","Les données ont été envoyées à l'imprimante",#MB_ICONINFORMATION) ; message casse couilles qui sert pas à grand chose, au choix de l'utilisateur. 
        EndIf
      EndIf
      
      
    Case #btn_Tailleimage
      ImageName$ = GetGadgetText(#string_image)
      Hauteur = ImageHeight() : ValeurH$ = Str(Hauteur)  ; récup des valeurs numérique
      Largeur = ImageWidth()  : ValeurL$ = Str(Largeur)  ; H et L
      If ImageName$<>""
        MessageRequester(ImageName$,"Image en cours"+Chr(13)+"Largeur : "+ValeurL$+"  pixels"+Chr(13)+"Hauteur : "+ValeurH$+"  pixels" ,64) ;affichage des dimensions en pixels
      Else 
        MessageRequester("PAS D'IMAGE AFFICHÉE !","Vous n'avez ouvert aucune image !",#MB_ICONEXCLAMATION)
      EndIf 
      
 ;Exemple de redimensionnement d'image et de scrollareagadget par boutons,
 ;mais on peut aussi le faire dans une comboboxgadget en nommant les items
 ;10% , 20% , 30% , etc... et en utilisant If et ElseIf, là j'ai la flemme....
      
    Case #btn_Redim2
      If LoadImage(#Photo,NomImage$); si une image est chargée 
        Timgx = ImageWidth()  : ValImgX$ = Str(Timgx/2); on divise la taille de l'image par deux
        Timgy = ImageHeight() : ValImgY$ = Str(Timgy/2)
        SetGadgetState(#PhotoVue, ResizeImage(#Photo,Val(ValImgX$) ,Val(ValImgY$))); puis on redimensionne l'image illico presto avec les nouvelles valeurs
        SetGadgetAttribute(#scrollimage, #PB_ScrollArea_InnerWidth, Val(ValImgX$));  on adapte la scrollarea en fonctions des nouvelles dimensions
        SetGadgetAttribute(#scrollimage, #PB_ScrollArea_InnerHeight, Val(ValImgY$))
      EndIf 
      DisableGadget(#btn_Redim2, 1)
      DisableGadget(#btn_Redim4, 0)
      DisableGadget(#btn_RealImage, 0)
      
    Case #btn_Redim4
      If LoadImage(#Photo,NomImage$)
        Timgx = ImageWidth()  : ValImgX$ = Str(Timgx/4); pareil mais on divise par 4...
        Timgy = ImageHeight() : ValImgY$ = Str(Timgy/4)
        SetGadgetState(#PhotoVue, ResizeImage(#Photo,Val(ValImgX$) ,Val(ValImgY$) ))
        SetGadgetAttribute(#scrollimage, #PB_ScrollArea_InnerWidth, Val(ValImgX$))
        SetGadgetAttribute(#scrollimage, #PB_ScrollArea_InnerHeight, Val(ValImgY$))
      EndIf 
      DisableGadget(#btn_Redim2, 0)
      DisableGadget(#btn_Redim4, 1)
      DisableGadget(#btn_RealImage, 0)
      
      
    Case #btn_RealImage
      If LoadImage(#Photo,NomImage$)
        Timgx = ImageWidth()  : ValX$ = Str(Timgx)
        Timgy = ImageHeight() : ValY$ = Str(Timgy)
        SetGadgetState(#PhotoVue, ResizeImage(#Photo,Val(ValX$) ,Val(ValY$))) ; on remet l'image à sa taille réelle et initiale
        SetGadgetAttribute(#scrollimage, #PB_ScrollArea_InnerWidth, ImageWidth())
        SetGadgetAttribute(#scrollimage, #PB_ScrollArea_InnerHeight, ImageHeight())
      EndIf 
      DisableGadget(#btn_Redim2, 0)
      DisableGadget(#btn_Redim4, 0)
      DisableGadget(#btn_RealImage, 1)
      
      
  EndSelect 
Case #PB_Event_CloseWindow 
  ImgInit = IsImage(#Photo)
  If ImgInit <>0 ; on vérifie si une image est chargée avant de quitter...
    FreeImage(#Photo); si c'est le cas on la désintègre au sabre laser, Quuuizzzz FFFuuuuzzzzzzzz ! et là on quitte cool.
  EndIf 
  Quitter = 1
  
EndSelect
;
Until Quitter 
End 
    
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message par Droopy »

Merci 8)
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

:) Petite astuce supplémentaire, pour enregistrer votre document Image +commentaires dans un fichier qui sera imprimable plus tard ou simplement consultable, vous pouvez, si vous possèdez PDF Writer, définir ce dernier comme imprimante par défaut le temps de créer vos photos commentées. Elles seront ainsi sauvegardées dans les bonnes dimensions et résolutions (c'est de cette manière que je procède avec mon portable)

@+ Jacobus
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

coool ! 8)
bernard13
Messages : 1221
Inscription : mer. 05/janv./2005 21:30

Message par bernard13 »

COOOOLLLLLLLLLLLLLLLLLLLLLLLLLLLL
Répondre