PureBasic Forums - English

Posted: **Thu Jan 21, 2021 3:42 pm**

Simple and strait forward
Mouse wheel to change the size of the image

DisableDebugger

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

Global Dim bits.a(0),Pitch,Count,Height,Depth.f,Trim

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 Lim_Max (now, up, max)
  max-1
  While (now > max - up)
    up-1
  Wend
  ProcedureReturn up
EndProcedure

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

Procedure Emboss (img,Depth.f=5.0)
  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
      i = h * Pitch + trim * w
      j = (h + Lim_Max (h, 1, Height)) * Pitch + trim * (w + Lim_Max (w, 1, Width))
      R = Abs (((Bits(i+2) - Bits(j+2)) * Depth + 128))
      G = Abs (((Bits(i+1) - Bits(j+1)) * Depth + 128))
      B = Abs (((Bits( i ) - Bits( j )) * Depth + 128))
      Gray = LimitValues ((R + G + B) / 3)
      Bits(i+2) = Gray
      Bits(i+1) = Gray
      Bits( i ) = Gray
    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,"Emboss 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,100,1)
SetGadgetState(3,10)
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)
            Depth = GetGadgetState(3)/10
            Emboss (1,Depth)
            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)))
            Depth = GetGadgetState(3)/10
            Emboss (1,Depth)
            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)))
                Depth = GetGadgetState(3)/10
                Emboss (1,Depth)
                SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
                SetGadgetAttribute(10, #PB_Canvas_Cursor ,#PB_Cursor_Default)
                Run = 0
              EndIf
          EndSelect              
      EndSelect
  EndSelect
Until Quit = 1

Posted: **Thu Jan 21, 2021 4:37 pm**

Waoooouuuuh RASHAD !!!!
Very nice !!!!

Works fine here

Thanks to you....because during few seconds, i believed i'am Michelangelo

Thanks for sharing

Posted: **Thu Jan 21, 2021 8:32 pm**

@RASHAD,
Very nice - well done.

Seems to work perfectly on my MacBook Pro M1.

Posted: **Thu Jan 21, 2021 9:07 pm**

Thanks for the code!
embossing works great, only the changing of the image size is very slow on my computer, even with very small images .

Posted: **Thu Jan 21, 2021 9:20 pm**

@KCC,davido
Thank you very much for your kind words and be tuned for the next effect

@Mr.L
First thank you for your fantastic work (PBEDIT and FlipBook Module)
Chang to it may help:

Code: Select all

               If delta = 1 And Run = 0
                  If scale < 10          
                    scale.f = scale.f + 0.5        
                  EndIf         
                ElseIf delta = -1 And Run = 0       
                  If scale > 0.5
                    scale.f = scale.f - 0.5
                  EndIf         
                EndIf

BTW :what is your OS and PC configuration (I hope it is not Linux or Mac

)

Posted: **Thu Jan 21, 2021 9:55 pm**

Hi
You don't have to recalculate it every time, only the size changes, not the content.
If you want to, you can recalculate it when you save it.
Or after a MouseWheel timeout.
Or when the workspace is left with the mouse

Posted: **Thu Jan 21, 2021 10:15 pm**

Thx, RASHAD

!
I found out, that my touchpad does not fire the Mousewheel event like I would expect.
If I bind the event it's fine!

Code: Select all

BindEvent(#PB_Event_Gadget, @ResizeProcedure(), 0, 10, #PB_EventType_MouseWheel)

my OS is Widows 10 and I have a Lenovo Laptop with i5-8250U CPU, Quadcore, 1.60GHz, 1800 MHz

Posted: **Thu Jan 21, 2021 10:23 pm**

Saki
You don't understand what is going on
- You must keep the original as it is
_ Do not resize what is resized before
- I do not care about your 4K
And as I told you before go play with your GFX_Wizzard_BF
I get allergen when I see your name
You talk too much with less results

Posted: **Thu Jan 21, 2021 10:35 pm**

If you have an iPhoto with a side length of 6000 px, it's just that big.
And what else are you going to do with it, playing only, but it's ok.
You can never display it in your window, so you must not calculate it constantly.
This also has nothing to do with 4K ?
It is enough to constantly convert the real visible area.
This is factual info, nothing more.

But Windows OS is absolutely predestined for 4K.
Everything you develop for Windows today should support 4K,
as well as DPI Aware, otherwise it will be vintage and incompatible with modern codes quickly.

Posted: **Fri Jan 22, 2021 10:37 am**

Hi!

Mr.L wrote:...
I found out, that my touchpad does not fire the Mousewheel event like I would expect.
...

Maybe #PB_Canvas_Keyboard solves this:

Code: Select all

CanvasGadget(10,10,10,780,540,#PB_Canvas_Container|#PB_Canvas_Keyboard)

At least here on Win7 with PB 5.73LTS

Posted: **Sun Jan 24, 2021 11:05 am**

btw you can also use a convolution filter to provide flexible/dynamic kernels (eg 3x3 or 4x4 etc) to provide special effects like Emboss, i've provided 6 different Emboss kernels here: viewtopic.php?f=12&t=68204

Posted: **Sun Jan 24, 2021 8:50 pm**

@Keya,

Haven't seen you around for a while.
Nice to see you back.

PureBasic Forums - English

Emboss Effect

Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect

Re: Emboss Effect