Mosaic Effect - Party Tool

[dige]

Small tool that I have used for a child's birthday. Who first recognizes the image.. we had a lot of fun

Code: Select all

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

OpenWindow(0, 0, 0, 100, 100, "", #PB_Window_BorderLess|#PB_Window_Maximize|#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("Bilder Verzeichnis auswählen", "")
  
  If Directory = "" Or FileSize(Directory) <> -2
    ProcedureReturn
  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 ; breiter als hoch -> Höhe voll, Breite anpassen
          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

[electrochrisso]

Hey dige this is an interesting bit of code, it can also be used for a basis of a colour palette creator of an image, good for stuff like page and web design, thanks for sharing.

[PB]

Nice, but you need a way to quit. Pressing Esc or Alt+F4 does nothing here.
I had to go into the Task Manager to kill the executable. Same when trying
to cancel the initial browse for folder prompt: I wanted to hit Esc to cancel
but the prompt just kept coming back.

[VB6_to_PBx]

Nice, but you need a way to quit. Pressing Esc or Alt+F4 does nothing here.
I had to go into the Task Manager to kill the executable. Same when trying
to cancel the initial browse for folder prompt: I wanted to hit Esc to cancel
but the prompt just kept coming back.

i just changed Source Code in these 2 locations to :

Code: Select all

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

and

Code: Select all

  If Directory = "" Or FileSize(Directory) <> -2
    End 
  EndIf

and you can END program with either method .

[PB]

I know how to fix it. I was merely telling the author he missed said fixes.

[VB6_to_PBx]

I know how to fix it. I was merely telling the author he missed said fixes.

i figured it was simply overlooked , and both of you definetly know how to fix it !

dige ,
great program idea , thanks for posting !

[applePi]

very amusing and interesting , thank you

[Little John]

Nice idea, thanks.

[electrochrisso]

Nice, but you need a way to quit. Pressing Esc or Alt+F4 does nothing here.
I had to go into the Task Manager to kill the executable. Same when trying
to cancel the initial browse for folder prompt: I wanted to hit Esc to cancel
but the prompt just kept coming back.

I am surprised Alt+F4 does not work for you PB, this is a standard windows feature and it works for me.

[PB]

> I am surprised Alt+F4 does not work for you PB

All I get is a Windows error sound when I try it.

[Edit] My bad; I had another app running that was conflicting with it.