Metallic effects [For KCC]

RASHAD · Post by **RASHAD** » Tue Jan 26, 2021 12:50 pm

Hi every one
This one specially for KCC
- Use Ctrl + ,Ctrl - to resize the image too

DisableDebugger

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

Global Dim bits.a(0),Pitch,Count,Width,Height,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

Structure ColorAmp
  Low.l
  High.l
  LowRed.l
  LowGreen.l
  LowBlue.l
  HighRed.l
  HighGreen.l
  HighBlue.l
EndStructure

Procedure.l AssignTables (Array RedTable.a(1), Array GreenTable.a(1), Array  BlueTable.a(1), Array Bits.a(1),  Width, Height)
  For h = 0 To Height-1
    For w = 0 To Width-1
      i = h * pitch + trim * w
      Bits(i+2) = RedTable(Bits(i+2))
      Bits(i+1) = GreenTable(Bits(i+1))
      Bits( i ) = BlueTable(Bits( i ))
    Next
  Next  
EndProcedure

Procedure.l GradientValue ( FirstValue.d, SecondValue.d, Gradient.d)	
  If Gradient = 0.0	
    ProcedureReturn FirstValue
  EndIf
  If Gradient = 255.0
    ProcedureReturn SecondValue
  EndIf
  ProcedureReturn ((FirstValue * (255 - Gradient) + SecondValue * Gradient) / 256)
EndProcedure

Procedure.l  MakeGradient ( *cAmp.ColorAmp,Array rTable.a(1),Array gTable.a(1),Array bTable.a(1))
  Define.d delta, temp
  If *cAmp\High = *cAmp\Low
    ProcedureReturn
  EndIf	
  delta = 255.0 / (*cAmp\High - *cAmp\Low)
  
  For i = *cAmp\Low To *cAmp\High
    temp = (i - *cAmp\Low) * delta
    rTable(i) = GradientValue (*cAmp\LowRed,   *cAmp\HighRed,   temp)
    gTable(i) = GradientValue (*cAmp\LowGreen, *cAmp\HighGreen, temp)
    bTable(i) = GradientValue (*cAmp\LowBlue,  *cAmp\HighBlue,  temp)
  Next  
EndProcedure

Procedure ShiftTable (Array Table.a(1),Shift.l)  
  Dim tempTable.a (256)
  CopyMemory (@Table(), @tempTable(), 256)
  For i = 0 To 255
    NewPosition = Int(Abs(i + Shift)) &  $000000FF
    Table(NewPosition) = tempTable(i)
  Next
EndProcedure

Procedure.l  ApplyMetallicLayer (Array	Bits.a(1),Width.l ,Height.l ,Levels.l)
  Dim mTable.a (256)  
  If Levels < 2
    ProcedureReturn
  EndIf
  
  For j = 0 To 254    
    For k = 0 To 255
      mTable(j+1) = k
    Next
    While k > 1
      mTable(j+1) = k
      k-Levels
    Wend
    If Levels % 2 = 0
      mTable(255) = 0
    Else
      mTable(255) = 255
    EndIf    
    AssignTables (mTable(), mTable(), mTable(), Bits(), Width, Height)
  Next  
EndProcedure

Procedure.l ApplyMetallicShiftLayer (Array	Bits.a(1),Width.l,Height.l,Levels.l,Shift.l)  
  cAmp.ColorAmp
  Dim mTable.a (256)
  
  If Levels < 1
    ProcedureReturn
  EndIf
  
  factor = 255 / Levels
  For i = 0 To Levels-1   
    If i % 2
      cAmp\Low = i * factor
      cAmp\LowRed = 255
      cAmp\LowGreen = 255
      cAmp\LowBlue = 255            
      cAmp\High = (i + 1) * factor
      cAmp\HighRed = 0
      cAmp\HighGreen = 0
      cAmp\HighBlue = 0
      mTable(255) = 0
    Else
      cAmp\Low = i * factor + 1
      cAmp\LowRed = 0
      cAmp\LowGreen = 0
      cAmp\LowBlue = 0      
      cAmp\High = (i + 1) * factor      
      cAmp\HighRed = 255
      cAmp\HighGreen = 255
      cAmp\HighBlue = 255
      mTable(255) = 255
    EndIf
    MakeGradient (@cAmp, mTable(), mTable(), mTable())
  Next
  ShiftTable (mTable(), Shift)
  AssignTables (mTable(), mTable(), mTable(), Bits(), Width, Height)
EndProcedure

Procedure.l ApplyGoldLayer (Array Bits.a(1),Width.l ,Height.l)  
  cAmp.ColorAmp
  Dim rTable.a (256)
  Dim gTable.a (256)
  Dim bTable.a (256)
  
  cAmp\Low = 0
  cAmp\LowRed = 0
  cAmp\LowGreen = 0
  cAmp\LowBlue = 0
  cAmp\High = 55
  cAmp\HighRed = 190
  cAmp\HighGreen = 55
  cAmp\HighBlue = 0
  MakeGradient (@cAmp, rTable(), gTable(), bTable())
  
  cAmp\Low = 55
  cAmp\LowRed = 190
  cAmp\LowGreen = 55
  cAmp\LowBlue = 0  
  cAmp\High = 155
  cAmp\HighRed = 255
  cAmp\HighGreen = 190
  cAmp\HighBlue = 50
  MakeGradient (@cAmp, rTable(), gTable(), bTable())
  
  cAmp\Low = 155
  cAmp\LowRed = 255
  cAmp\LowGreen = 190
  cAmp\LowBlue = 50
  cAmp\High = 255
  cAmp\HighRed = 255
  cAmp\HighGreen = 255
  cAmp\HighBlue = 255
  MakeGradient (@cAmp, rTable(), gTable(), bTable())
  AssignTables (rTable(), gTable(), bTable(), Bits(), Width, Height)
EndProcedure

Procedure Metallic (img,level=1,shift=1,mode=0)
  width = ImageWidth(img)
  height = ImageHeight(img)
  If ImageDepth(img) = 32
    trim = 4
  Else
    trim = 3
  EndIf
  
  Effect_ON(img)
  
  If Level % 2
    Level+1
  EndIf
  
  For h = 0 To Height-1
    For w = 0 To Width-1      
      i = h * pitch + trim * w
      Gray = Int(Bits(i+2) + Bits(i+1) + Bits(i) / 3)
      Bits(i+2)= Gray
      Bits(i+1) = Gray
      Bits(i) = Gray
    Next
  Next
  
  ApplyMetallicShiftLayer (Bits(), Width, Height, Level, Shift)  
  If Mode = 2     
    ApplyGoldLayer (Bits(), Width, Height)
  EndIf
  
  Effect_OFF(img)  
EndProcedure

Procedure gadtip3()
  SetGadgetText(12,Str(GetGadgetState(3)))
EndProcedure

Procedure gadtip6()
  SetGadgetText(12,Str(GetGadgetState(6)))
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,325,WindowHeight(0)-35 ,230,24)
    ResizeGadget(6,560,WindowHeight(0)-35 ,230,24)
  Else
    ResizeGadget(3,325,WindowHeight(0)-35 ,230,24)
  EndIf
EndProcedure

initpath$ = GetHomeDirectory()
initspath$ = GetTemporaryDirectory()
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,"Metallic Layer",#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_Keyboard | #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,325,562 ,230,24,0,10,1)
SetGadgetState(3,2)
ScrollBarGadget  (6,560,562 ,230,24,0,255,1)
SetGadgetState(6,128)
ContainerGadget(30,10,560,310,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))
SpinGadget(8, 270,2, 40, 25, 1, 2,#PB_Spin_Numeric)
GadgetToolTip(8," Mode ")
SetGadgetState(8,2)
CloseGadgetList()

scale.f = 1
Effect$ = "Metallic"
BindGadgetEvent(3,@gadTIP3())
BindGadgetEvent(6,@gadTIP6())
BindEvent(#PB_Event_SizeWindow,@sizeCB())
;AddKeyboardShortcut(0,#PB_Shortcut_Up,10)
;AddKeyboardShortcut(0,#PB_Shortcut_Down,20)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_Add,10)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_Subtract,20)
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case 10
          If IsImage(0)
            CopyImage(0,1)
            If Run = 0 And scale < 10
              scale.f = scale.f + 0.01
            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)))                
            Metallic (1,GetGadgetState(3)/2,GetGadgetState(6),GetGadgetState(8))                
            SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
            SetGadgetAttribute(10, #PB_Canvas_Cursor ,#PB_Cursor_Default)
            Run = 0
          EndIf
          
        Case 20
          If IsImage(0)
            CopyImage(0,1)
            If Run = 0 And scale > 0.1
              scale.f = scale.f - 0.01
            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)))                
            Metallic (1,GetGadgetState(3)/2,GetGadgetState(6),GetGadgetState(8))                
            SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
            SetGadgetAttribute(10, #PB_Canvas_Cursor ,#PB_Cursor_Default)
            Run = 0
          EndIf
      EndSelect      
      
    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",initpath$+"*.*", Pattern$,0)
          If File$ And FileSize(File$)
            LoadImage(0,File$)
            If IsImage(0)
              initpath$ = GetPathPart(File$)
              CopyImage(0,1)
              Metallic (1,GetGadgetState(3)/2,GetGadgetState(6),GetGadgetState(8))
              SetGadgetText(4," W :"+Str(ImageWidth(1)))
              SetGadgetText(5," H :"+Str(ImageHeight(1)))
              SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
            Else
              MessageRequester("Error","Format not supported", #PB_MessageRequester_Ok | #PB_MessageRequester_Error)
            EndIf
          EndIf
          
        Case 2
          If IsImage(1)
            sfile$ = SaveFileRequester("Please choose file to save",initspath$+""," All supported formats|*.bmp; *.jpg; *.png | BMP image (*.bmp)| *.bmp| JPEG image (*.jpg;*.jpeg)|*.jpg| PNG image (*.png)| *.png",0)
            If sfile$
              initspath$ = GetPathPart(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 , 6 , 8
          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)))
            Metallic (1,GetGadgetState(3)/2,GetGadgetState(6),GetGadgetState(8))
            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.5        
                  EndIf         
                ElseIf delta = -1 And Run = 0       
                  If scale > 0.5
                    scale.f = scale.f - 0.5
                  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)))                
                Metallic (1,GetGadgetState(3)/2,GetGadgetState(6),GetGadgetState(8))                
                SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
                SetGadgetAttribute(10, #PB_Canvas_Cursor ,#PB_Cursor_Default)
                Run = 0
              EndIf
          EndSelect              
      EndSelect
  EndSelect
Until Quit = 1

Kwai chang caine · Post by **Kwai chang caine** » Tue Jan 26, 2021 1:14 pm

Very very splendid !!!!
My image is not only made of metal, but it even had time to rust in a few days
RASHAD reinvents the time acceleration machine

Sincerely thanks for all, and mainly for this kind and surprising dedication, that goes straight to my heart

It's also that PB, a real and sentimental virtual familly

Have a very good day

dige · Post by **dige** » Tue Jan 26, 2021 1:44 pm

RASHAD!!! Thank you very much!! So much very cool stuff from you, which I could never have done myself. These days I feel like a school kid!

VB6_to_PBx · Post by **VB6_to_PBx** » Tue Jan 26, 2021 5:16 pm

Rashad ,
many thanks for this unique Metallic Effect !

RASHAD · Post by **RASHAD** » Tue Jan 26, 2021 6:58 pm

@KCC,dige and VB6_to_PBx
Thanks guys
Much appreciated

IdeasVacuum · Post by **IdeasVacuum** » Fri Jan 29, 2021 8:14 pm

...there's gold in them there hills

PureBasic Forums - English

Metallic effects [For KCC]

Metallic effects [For KCC]

Re: Metallic effects [For KCC]

Re: Metallic effects [For KCC]

Re: Metallic effects [For KCC]

Re: Metallic effects [For KCC]

Re: Metallic effects [For KCC]