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

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