Rock Effect

Share your advanced PureBasic knowledge/code with the community.
Post Reply
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Rock Effect

Post by RASHAD »

Hi guys

Code: Select all

DisableDebugger

UseJPEG2000ImageDecoder()
UseJPEG2000ImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UseGIFImageDecoder()

Global Dim bits.a(0),Pitch,Count,Height,Value

Procedure Effect_ON(img)
  StartDrawing(ImageOutput(img))
  *Buffer     = DrawingBuffer() 
  Pitch       = DrawingBufferPitch()
  count       = Pitch*height
  ReDim bits.a(count)
  CopyMemory(*Buffer,@bits(),count)
  StopDrawing()
EndProcedure

Procedure Effect_OFF(img)
  StartDrawing(ImageOutput(img))
  *Buffer     = DrawingBuffer() 
  CopyMemory(@bits(),*Buffer,count)
  StopDrawing()
EndProcedure

Procedure.l LimitValues (x.l)
  If x < 0 
    x = 0
  EndIf
  If x > 255
    x = 255
  EndIf
  ProcedureReturn x
EndProcedure

Procedure Rock(img,Value)
  width = ImageWidth(img)
  height = ImageHeight(img)
  If ImageDepth(img) = 32
    trim = 4
  Else
    trim = 3
  EndIf
  
  Effect_ON(img)
  
  For  h = 1 To Height - 1
    For w = 1 To Width - 1
      j = h * Pitch + trim * w
      i = (h - 1) * Pitch + trim * (w - 1)
      Bits(i+2) = LimitValues (Bits(i+2) + (Value * (Bits(i+2) - Bits(j+2))))
      Bits(i+1) = LimitValues (Bits(i+1) + (Value * (Bits(i+1) - Bits(j+1))))
      Bits( i ) = LimitValues (Bits( i ) + (Value * (Bits( i ) - Bits( j ))))
    Next
  Next  
  
  Effect_OFF(img)
EndProcedure

Procedure gadtip()
  SetGadgetText(12,StrF(GetGadgetState(3)))
EndProcedure

Procedure sizeCB()
  ResizeGadget(10,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-60)
  ResizeGadget(12,WindowWidth(0)/2-40,WindowHeight(0)-85,80,20)
  ResizeGadget(20,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-60)
  ResizeGadget(0,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-60)
  ResizeGadget(30,#PB_Ignore,WindowHeight(0)-40,#PB_Ignore,#PB_Ignore)  
  If IsGadget(6)
    ResizeGadget(3,275,WindowHeight(0)-38 ,250,24)
    ResizeGadget(6,535,WindowHeight(0)-38,250,24)
  Else
    ResizeGadget(3,GadgetX(20)+265,WindowHeight(0)-38,WindowWidth(0)-278,24)
  EndIf
EndProcedure

Pattern$ = "All supported formats|*.*;*.bmp; *.gif; *.jpg; *.jpeg; *.png;*.tif;*.tiff;*.tga|TGA image (*.tga)|*.tga|"+
           "TIF image (*.tif)|*.tif|TIFF image (*.tiff)|*.tiff|PNG image (*.png)|*.png|BMP image (*.bmp)|*.bmp|"+
           "JPEG image (*.jpg;*.jpeg)|*.jpg;*.jpeg|GIF image (*.gif)|*.gif|"

LoadFont(0,"tahoma",10)
OpenWindow(0,0,0,800,600,"Rock 4 Image",#PB_Window_SystemMenu |#PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
WindowBounds(0,600,400,#PB_Default,#PB_Default)
CanvasGadget(10,10,10,780,540,#PB_Canvas_Container)
TextGadget(12,WindowWidth(0)/2-40,WindowHeight(0)-85,80,20 ,"",#PB_Text_Center)
SetGadgetColor(12,#PB_Gadget_BackColor,0)
SetGadgetColor(12,#PB_Gadget_FrontColor,$FFFFFF)
SetGadgetFont(12,FontID(0))
ContainerGadget(20,0,0,780,540,#PB_Container_Flat)
ButtonImageGadget(0,-1,-1,780,540,0)
CloseGadgetList()
DisableGadget(20,1)    
CloseGadgetList()
ScrollBarGadget  (3,275,562 ,513,24,0,50,1)
SetGadgetState(3,0)
ContainerGadget(30,10,560,255,30)
ButtonGadget(1,0,0,60,30,"Open")
ButtonGadget(2,65,0,60,30,"Save")
TextGadget(4,130,6,60,20," W: 0")
SetGadgetFont(4,FontID(0))
TextGadget(5,195,6,60,20," H: 0")
SetGadgetFont(5,FontID(0))
CloseGadgetList()

scale.f = 1
BindGadgetEvent(3,@gadTIP())
BindEvent(#PB_Event_SizeWindow,@sizeCB())
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1 
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          scale.f = 1
          FreeImage(#PB_All)
          SetGadgetAttribute(0,#PB_Button_Image,0)
          File$ = OpenFileRequester("Choose image file to load", "*.*", Pattern$, 0)
          If File$ And FileSize(File$)
            LoadImage(0,File$)
            CopyImage(0,1)
            Value = GetGadgetState(3)
            Rock(1,Value)
            SetGadgetText(4," W :"+Str(ImageWidth(1)))
            SetGadgetText(5," H :"+Str(ImageHeight(1)))
            SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
          EndIf
          
        Case 2
          If IsImage(1)
            sfile.s = SaveFileRequester("Please choose file to save",""," All supported formats|*.bmp; *.jpg; *.png | BMP image (*.bmp)| *.bmp| JPEG image (*.jpg;*.jpeg)|*.jpg| PNG image (*.png)| *.png",0)
            If sfile
              If GetExtensionPart(sfile) = ""
                If SelectedFilePattern() = 1 Or selectpattern = 1
                  sfile + ".bmp"
                ElseIf SelectedFilePattern() = 2 Or selectpattern = 2
                  sfile + ".jpg"
                ElseIf SelectedFilePattern() = 0 Or SelectedFilePattern() = 3 Or selectpattern = 3
                  sfile + ".png"
                EndIf
              EndIf               
              If GetExtensionPart(sfile) = "bmp"
                SaveImage(1, sfile ,#PB_ImagePlugin_BMP)
              ElseIf GetExtensionPart(sfile) = "jpg"
                SaveImage(1, sfile ,#PB_ImagePlugin_JPEG)
              ElseIf GetExtensionPart(sFile) = "png"
                SaveImage(1, sfile ,#PB_ImagePlugin_PNG)
              EndIf
              MessageRequester("Info","File saved successfully", #PB_MessageRequester_Ok | #PB_MessageRequester_Info)
            Else
              MessageRequester("Error","Process failed !", #PB_MessageRequester_Ok | #PB_MessageRequester_Error)
            EndIf
          Else
            MessageRequester("Error","No Image to Save !", #PB_MessageRequester_Ok | #PB_MessageRequester_Error)
          EndIf
          
        Case 3
          If IsImage(0)
            CopyImage(0,1)
            ResizeImage(1,ImageWidth(0)*scale,ImageHeight(0)*scale)
            SetGadgetText(4," W :"+Str(ImageWidth(1)))
            SetGadgetText(5," H :"+Str(ImageHeight(1)))
            Value = GetGadgetState(3)
            Rock(1,Value)
            SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
          EndIf
          
        Case 10
          Select EventType()
            Case #PB_EventType_MouseWheel
              If IsImage(0)
                CopyImage(0,1)
                delta = GetGadgetAttribute(10,#PB_Canvas_WheelDelta )
                If delta = 1 And Run = 0
                  If scale < 10          
                    scale.f = scale.f + 0.01        
                  EndIf         
                ElseIf delta = -1 And Run = 0       
                  If scale > 0.01
                    scale.f = scale.f - 0.01
                  EndIf         
                EndIf
                Run = 1
                SetGadgetAttribute(10, #PB_Canvas_Cursor ,#PB_Cursor_Busy)
                ResizeImage(1,ImageWidth(0)*scale,ImageHeight(0)*scale)
                SetGadgetText(4," W :"+Str(ImageWidth(1)))
                SetGadgetText(5," H :"+Str(ImageHeight(1)))
                Value = GetGadgetState(3)
                Rock(1,Value)
                SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
                SetGadgetAttribute(10, #PB_Canvas_Cursor ,#PB_Cursor_Default)
                Run = 0
              EndIf
          EndSelect              
      EndSelect
  EndSelect
Until Quit = 1
Egypt my love
Top
User avatar
ar-s
Enthusiast
Enthusiast
Posts: 344
Joined: Sat Oct 06, 2007 11:20 pm
Location: France

Re: Rock Effect

Post by ar-s »

Nice one, thanks
~Ar-S~
My Image Hoster for PB users
My webSite (french) with PB apps : LDVMULTIMEDIA
PB - 3.x / 5.7x / 6 - W11 x64 - Ryzen 7 3700x / #Rpi4

Code: Select all

r3p347 : 7ry : un71l d0n3 = 1
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

Re: Rock Effect

Post by IdeasVacuum »

Seriously clever! 8)
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: Rock Effect

Post by RASHAD »

@ar-s
Thanks Mate
For Worms on the Desktops too :P
Much appreciated

@IV
Thanks Mate
I can post a True 8 bit palletized GrayScale .png or .bmp if you like too
Egypt my love
Top
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Rock Effect

Post by davido »

@RASHAD,
Another very nice effect. Thank you.

Might there be some benefit in the effects to be combined in a single program to allow switching between them?
DE AA EB
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

Re: Rock Effect

Post by IdeasVacuum »

I can post a True 8 bit palletized GrayScale .png or .bmp if you like too
:mrgreen: Hi Rashad - you are hyper-productive these days.

What I would like to see is a high gloss effect for button shapes (circles, ovals, radiused corner rectangles). Pretty sure someone has already achieved it with PB, long ago, but it seems to have vanished.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Rock Effect

Post by Kwai chang caine »

Good thing.... i needed bricks to expand my house :mrgreen:
Very nice effect, thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Top
Post Reply

Return to “Tricks 'n' Tips”