PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Party Tool - Mosaik Effekt

https://www.purebasic.fr/german/viewtopic.php?t=28510

Seite 1 von 1

Party Tool - Mosaik Effekt

Verfasst: 14.11.2014 13:59
von dige
Ein kleines Tools, dass ich eben für einen Kindergeburtstag gebraucht habe. Wir hatten viel Spaß, vielleicht kann es ja noch jemand gebrauchen..

Code: Alles auswählen

; 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

Re: Party Tool - Mosaik Effekt

Verfasst: 14.11.2014 14:08
von NicTheQuick
Ich hab einfach mal alles Windows-spezifische raus gelöscht. Aber irgendwie funktioniert's trotzdem nicht oder auch gerade deswegen. Ich bin soweit gekommen, dass oben in der linken Ecke die Bilder aus dem Verzeichnis durchzappen konnte, das ich geladen hatte. Aber weiter eben nicht.

Re: Party Tool - Mosaik Effekt

Verfasst: 15.11.2014 13:50
von Sicro
So funktioniert es bei mir unter Linux:

Code: Alles auswählen

; 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)
  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, RGB(255,255,255)) 
    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

Re: Party Tool - Mosaik Effekt

Verfasst: 15.11.2014 15:16
von NicTheQuick
Ach, jetzt verstehe ich. das 20x20-Pixel Bild oben links wird dann als Mosaik-Bild dargestellt. Ich dachte da kommt noch irgendwas im Fullscreen und oben links das soll nur die Auswahl sein.
Das Problem ist hier, dass beim Aufruf der Funktion "OpenMainWindow()" die Größe des Fenster laut 'WindowWidth()' und 'WindowHeight()' immer noch 100x100 ist. Und manchmal kommt auch der "OpenPathRequester()' nicht.

Re: Party Tool - Mosaik Effekt

Verfasst: 15.11.2014 18:19
von Sicro
NicTheQuick hat geschrieben:Ach, jetzt verstehe ich. das 20x20-Pixel Bild oben links wird dann als Mosaik-Bild dargestellt. Ich dachte da kommt noch irgendwas im Fullscreen und oben links das soll nur die Auswahl sein.
Also oben links ist bei mir nichts.
Bei mir wird das Fenster maximiert geöffnet und sieht so aus: http://s14.directupload.net/images/141115/89wtkodm.png
Schiebt man den Schieber der TrackBar nach rechts, wird die Verpixelung verringert.

Re: Party Tool - Mosaik Effekt

Verfasst: 16.11.2014 14:41
von NicTheQuick
Ja, ich weiß wie es aussehen soll. Bei mir sieht es allerdings so aus: https://dl.dropboxusercontent.com/u/283 ... Fehler.png
Könnte ein Bug von PB sein.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de