Effet mosaic image via Canvas

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
Ar-S
Messages : 9540
Inscription : dim. 09/oct./2005 16:51
Contact :

Effet mosaic image via Canvas

Message par Ar-S »

Petit code de Dige sur le fofo anglais faisant un effet mosaic sur les images (utiliser le slider pour reconnaître vos images).
http://www.purebasic.fr/english/viewtop ... 12&t=60961

Code : Tout sélectionner

; Images advise. Who first recognizes the image?
; Dige 11/2014

OpenWindow(0, 0, 0, 100, 100, "", #PB_Window_SystemMenu |#PB_Window_Maximize | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)

Enumeration
#CG_IMAGE
#TB_SLIDER
#B_Next
#B_Prev
EndEnumeration

Enumeration
  #IMG_ORIG
  #IMG_VIEW
EndEnumeration

UseJPEGImageDecoder()
UsePNGImageDecoder()

#IMGEXT = ".JPG.JPEG.PNG.BMP"

Global NewList Images.s(), merke.s

Procedure OpenMainWindow()

  CanvasGadget(#CG_IMAGE, 0, 0, WindowWidth(0), WindowHeight(0) - 50)
  ButtonGadget(#B_Prev, 0, WindowHeight(0) - 50, 50, 50, "<")
  TrackBarGadget(#TB_SLIDER, 50, WindowHeight(0) - 50, WindowWidth(0) -100, 50, 1, 50, #TBS_FIXEDLENGTH)
  SendMessage_(GadgetID(#TB_SLIDER), #TBM_SETTHUMBLENGTH, 50, 0)
  ButtonGadget(#B_Next, WindowWidth(0)-50, WindowHeight(0) - 50, 50, 50, ">")

EndProcedure

Procedure LoadImageList()
  Protected Directory.s
 
  Directory = PathRequester("Choisir un dossier image", "")
 
If Directory = "" Or FileSize(Directory) <> -2
    End
  EndIf
 
  ClearList( Images())
  If ExamineDirectory(0, Directory, "*.*") 
    While NextDirectoryEntry(0)
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        If FindString( #IMGEXT, UCase(GetExtensionPart(DirectoryEntryName(0))))
          AddElement(Images())
          Images() = Directory + DirectoryEntryName(0)
        EndIf
      EndIf
    Wend
    FinishDirectory(0)
  EndIf
 
  If ListSize(Images()) > 0
    FirstElement(Images())
  EndIf
EndProcedure
Procedure RenderImage()
  Protected w, h, f.f
 
  If StartDrawing(CanvasOutput(#CG_IMAGE))
     
    w = OutputWidth()
    h = OutputHeight()
     
    If IsImage(#IMG_ORIG) = 0
      If LoadImage(#IMG_ORIG, Images())
        f = ImageWidth(#IMG_ORIG) / ImageHeight(#IMG_ORIG)
        If f > 0 ; Régler la hauteur largeur - plus large que haut
          ResizeImage(#IMG_ORIG, h*f, h, #PB_Image_Smooth)
        Else
          ResizeImage(#IMG_ORIG, w, w/f, #PB_Image_Smooth)
        EndIf
      EndIf
      Box (0, 0, w, h, #White) 
    EndIf
 
    If IsImage(#IMG_ORIG)
      CopyImage(#IMG_ORIG, #IMG_VIEW)
     
      If GetGadgetState(#TB_SLIDER) < 50
     
        ResizeImage(#IMG_VIEW, ImageWidth(#IMG_ORIG) * GetGadgetState(#TB_SLIDER)/100, ImageHeight(#IMG_ORIG)*GetGadgetState(#TB_SLIDER)/100, #PB_Image_Smooth)
        ResizeImage(#IMG_VIEW, ImageWidth(#IMG_ORIG), ImageHeight(#IMG_ORIG), #PB_Image_Raw)
      EndIf
    EndIf
   
    DrawImage(ImageID(#IMG_VIEW), w/2- ImageWidth(#IMG_VIEW)/2, h/2-ImageHeight(#IMG_VIEW)/2)
   
    StopDrawing()
   
  EndIf
 
 
 
EndProcedure


OpenMainWindow()

Repeat
  Event = WaitWindowEvent()
 
  If Event = #PB_Event_Gadget
    If ListSize(Images()) <= 0
      Event = 0
      LoadImageList()
    Else
      Select EventGadget()
        Case #B_Prev : PreviousElement(Images())
        Case #B_Next : NextElement(Images())
        Case #TB_SLIDER : RenderImage() 
      EndSelect
    EndIf
  EndIf

  If ListIndex(Images()) >= 0 And merke <> Images()
    If IsImage(#IMG_ORIG)
      FreeImage(#IMG_ORIG)
    EndIf
    If IsImage(#IMG_VIEW)
      FreeImage(#IMG_VIEW)
    EndIf
   
    merke = Images()
    SetGadgetState(#TB_SLIDER, 1)
   
    RenderImage()
  EndIf
 
Until Event = #PB_Event_CloseWindow
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Micoute
Messages : 2584
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Effet mosaic image via Canvas

Message par Micoute »

Bonjour Ar-s, mais c'est très bon, ça !
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
majikeyric
Messages : 602
Inscription : dim. 08/déc./2013 23:19
Contact :

Re: Effet mosaic image via Canvas

Message par majikeyric »

sympa!
Répondre