Change Contrast 4 Any Image [Windows]

[RASHAD]

Based on ice-soft code

Code: Select all

UseJPEGImageDecoder() 
UseJPEG2000ImageDecoder() 
UsePNGImageDecoder()
UseTIFFImageDecoder() 
UseTGAImageDecoder() 
UseGIFImageDecoder()

#TBS_TOOLTIPS     = $0100
#TBM_SETTOOLTIPS  = $41D
#TTF_TRACK        = $20

Macro CopyImageToBuffer(img, Buffer)
	TemporaryBitmapInfo.BITMAPINFO
	TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
	GetObject_(ImageID(img), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
	TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
	TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
	TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
	TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
	TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
	TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
	GetDIBits_(TemporaryDC, ImageID(img), 0, TemporaryBitmap\bmHeight, Buffer, TemporaryBitmapInfo.BITMAPINFO, #DIB_RGB_COLORS)
	DeleteDC_(TemporaryDC)
EndMacro

Macro CopyBufferToImage(Buffer, img)
	TemporaryBitmapInfo.BITMAPINFO
	TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
	GetObject_(ImageID(img), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
	TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
	TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
	TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
	TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
	TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
	TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
	SetDIBits_(TemporaryDC, ImageID(img), 0, TemporaryBitmap\bmHeight, Buffer, TemporaryBitmapInfo.BITMAPINFO, #DIB_RGB_COLORS)
	DeleteDC_(TemporaryDC)
EndMacro

Procedure.l LimitValues (x.l)
	!mov eax,dword[p.v_x]
	!xor edx,edx      ; set EDX to zero
	!cmp eax,0         ; compare with top limit
	!cmovl eax,edx   ;
	!mov edx,255      ; 255
	!cmp eax,edx      ; compare with bottom limit
	!cmovg eax,edx   ; if lower, set value to bottom limit
	ProcedureReturn
EndProcedure

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

Procedure Contrast (DImage,SImage,red.f,green.f,blue.f)
	Protected TemporaryBitmapInfo.BITMAPINFO, TemporaryBitmap.BITMAP ,PicDestDC.l,PicSrcDC.l ,BitCount ,Width,Height,LineWidth =0
	Define.l TemporaryDC
	Width = ImageWidth(SImage)
	Height = ImageHeight(SImage)
	LineWidth = Width * 4

	BitCount = LineWidth * Height
	Dim Bits.a (BitCount)
	CopyImageToBuffer(SImage, @Bits())
	Define.l i
	If Red   < 0.0 :  Red = 0.1 : EndIf
	If Green < 0.0: Green = 0.1 : EndIf
	If Blue  < 0.0 : Blue = 0.1 : EndIf
	
	Dim TableR.a(256)
	Dim TableG.a(256)
	Dim TableB.a(256)
	
	For i = 0 To 255
		TableR(i) = LimitValues (Int(((i - 127) *   Red) + 127))
		TableG(i) = LimitValues (Int(((i - 127) * Green) + 127))
		TableB(i) = LimitValues (Int(((i - 127) *  Blue) + 127))
	Next
	AssignTables (TableR(), TableG(), TableB(), Bits(), Width, Height)
	CopyBufferToImage(@Bits(), DImage)
	
	ReDim TableR.a(0)
	ReDim TableG.a(0)
	ReDim TableB.a(0)	
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|"

OpenWindow(0,0,0,800,600,"test",#PB_Window_SystemMenu |#PB_Window_ScreenCentered)
  cont = ContainerGadget(#PB_Any,10,10,780,540,#PB_Container_Flat)
    ButtonImageGadget(0,-1,-1,780,540,0,#PB_Image_Border)
  CloseGadgetList()
  DisableGadget(cont,1)
  ButtonGadget(1,10,560,60,30,"Open")
  ButtonGadget(2,80,560,60,30,"Save")
  TrackBarGadget(3,150,562 ,645,24,0,255)
  TTIP = CreateWindowEx_(0, #TOOLTIPS_CLASS, "", #TTS_NOPREFIX, 0, 0, 0, 0, WindowID(0), 0, GetModuleHandle_(0), 0)
  ti.TOOLINFO
  ti\cbSize = SizeOf(ti)
  ;ti\hWnd = WindowID(0)
  ti\uFlags = #TTF_IDISHWND | #TTF_TRACK | #TTF_CENTERTIP
  ti\uId = GadgetID(3)
  Text$ = Str(GetGadgetState(3))
  ti\lpszText = @Text$
  SendMessage_(GadgetID(3), #TBM_SETTOOLTIPS, TTIP, 0)
  SendMessage_(TTIP, #TTM_ADDTOOL, 0, @ti)
  SetWindowLongPtr_(GadgetID(3),#GWL_STYLE,GetWindowLongPtr_(GadgetID(3),#GWL_STYLE)|#WS_VISIBLE | #WS_CHILD | #TBS_ENABLESELRANGE| #TBS_TOOLTIPS |#TBS_FIXEDLENGTH)
  SendMessage_(GadgetID(3), #TBM_SETTHUMBLENGTH,25,0)
  SetGadgetState(3,127)
  scale.f = 1
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #WM_LBUTTONUP
      GetCursorPos_(p.POINT)
      If WindowFromPoint_(p\y << 32 + p\x) = GadgetID(3)
        Text$ = Str(GetGadgetState(3))
          ti\lpszText = @Text$
          SendMessage_(TTIP, #TTM_UPDATETIPTEXT, 0, @ti)
          SendMessage_(TTIP, #TTM_TRACKACTIVATE, 1, @ti)
        EndIf
        
    Case #WM_MOUSEMOVE
      GetCursorPos_(p.POINT)
      If WindowFromPoint_(p\y << 32 + p\x) = GadgetID(3)
        Text$ = Str(GetGadgetState(3))
        If text$ <> oldtext$
          ti\lpszText = @Text$
          SendMessage_(TTIP, #TTM_UPDATETIPTEXT, 0, @ti)
          SendMessage_(TTIP, #TTM_TRACKACTIVATE, 1, @ti)
          oldtext$ = text$
        EndIf
      Else
        oldtext$ = ""
        SendMessage_(TTIP, #TTM_TRACKACTIVATE, 0, @ti)
      EndIf
      
    Case #WM_MOUSEWHEEL
      If IsImage(0)
        CopyImage(0,1)
        delta = EventwParam()>>16 & $FFFF
        If delta = 120
          If scale < 2           
            scale.f = scale.f + 0.05            
          EndIf          
        Else          
          If scale > 0.1
            scale.f = scale.f - 0.05
          EndIf          
        EndIf
        ResizeImage(1,ImageWidth(0)*scale,ImageHeight(0)*scale)
        SetGadgetState(3,127)
        SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
      EndIf
     
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          SetGadgetState(3,127)
          If IsImage(0)
            FreeImage(0)
          EndIf
          If IsImage(1)
            FreeImage(1)
          EndIf
          If IsImage(2)
            FreeImage(2)
          EndIf
          File$ = OpenFileRequester("Choose image file to load", "*.*", Pattern$, 0)
          If File$ And FileSize(File$)
            LoadImage(0,File$)
            SetGadgetAttribute(0,#PB_Button_Image,ImageID(0))
          EndIf
          
        Case 2
          
        Case 3
          If IsImage(0)
            color.f = GetGadgetState(3)/100
            If IsImage(1)
              CopyImage(1,2)
              Contrast (2,1,color.f,color.f,color.f)
            Else
              CopyImage(0,2)
              Contrast (2,0,color.f,color.f,color.f)
            EndIf
            SetGadgetAttribute(0,#PB_Button_Image,ImageID(2))
          EndIf
          
      EndSelect
  EndSelect
Until Quit = 1

Edit : Bugs fixed

[Kwai chang caine]

Hello RASHAD

Works great, except the cursor who not moove in regulary
Thanks for sharing

[RASHAD]

Hi KCC
Thanks
Try the full version

Code: Select all

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

Global TBhwnd

#TBS_TOOLTIPS     = $0100
#TBM_SETTOOLTIPS  = $41D
#TTF_TRACK        = $20

Macro CopyImageToBuffer(img, Buffer)
   TemporaryBitmapInfo.BITMAPINFO
   TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
   GetObject_(ImageID(img), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
   TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
   TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
   TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
   TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
   TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
   TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
   GetDIBits_(TemporaryDC, ImageID(img), 0, TemporaryBitmap\bmHeight, Buffer, TemporaryBitmapInfo.BITMAPINFO, #DIB_RGB_COLORS)
   DeleteDC_(TemporaryDC)
EndMacro

Macro CopyBufferToImage(Buffer, img)
   TemporaryBitmapInfo.BITMAPINFO
   TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
   GetObject_(ImageID(img), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
   TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
   TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
   TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
   TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
   TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
   TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
   SetDIBits_(TemporaryDC, ImageID(img), 0, TemporaryBitmap\bmHeight, Buffer, TemporaryBitmapInfo.BITMAPINFO, #DIB_RGB_COLORS)
   DeleteDC_(TemporaryDC)
EndMacro

Procedure.l LimitValues (x.l)
   !mov eax,dword[p.v_x]
   !xor edx,edx      ; set EDX to zero
   !cmp eax,0         ; compare with top limit
   !cmovl eax,edx   ;
   !mov edx,255      ; 255
   !cmp eax,edx      ; compare with bottom limit
   !cmovg eax,edx   ; if lower, set value to bottom limit
   ProcedureReturn
EndProcedure

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

Procedure Contrast (DImage,SImage,red.f,green.f,blue.f)
   Protected TemporaryBitmapInfo.BITMAPINFO, TemporaryBitmap.BITMAP ,PicDestDC.l,PicSrcDC.l ,BitCount ,Width,Height,LineWidth =0
   Define.l TemporaryDC
   Width = ImageWidth(SImage)
   Height = ImageHeight(SImage)
   LineWidth = Width * 4

   BitCount = LineWidth * Height
   Dim Bits.a (BitCount)
   CopyImageToBuffer(SImage, @Bits())
   Define.l i
   If Red   < 0.0 :  Red = 0.1 : EndIf
   If Green < 0.0: Green = 0.1 : EndIf
   If Blue  < 0.0 : Blue = 0.1 : EndIf
   
   Dim TableR.a(256)
   Dim TableG.a(256)
   Dim TableB.a(256)
   
   For i = 0 To 255
      TableR(i) = LimitValues (Int(((i - 127) *   Red) + 127))
      TableG(i) = LimitValues (Int(((i - 127) * Green) + 127))
      TableB(i) = LimitValues (Int(((i - 127) *  Blue) + 127))
   Next
   AssignTables (TableR(), TableG(), TableB(), Bits(), Width, Height)
   CopyBufferToImage(@Bits(), DImage)
   
   ReDim TableR.a(0)
   ReDim TableG.a(0)
   ReDim TableB.a(0)   
EndProcedure

Procedure sizeCB()
  ResizeGadget(10,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-60)
  ResizeGadget(0,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-60)
  ResizeGadget(1,#PB_Ignore,WindowHeight(0)-40,#PB_Ignore,#PB_Ignore)
  ResizeGadget(2,#PB_Ignore,WindowHeight(0)-40,#PB_Ignore,#PB_Ignore)
  MoveWindow_(TBhwnd,GadgetX(2 ,#PB_Gadget_WindowCoordinate)+65,WindowHeight(0)-38,WindowWidth(0)-148,25,1)
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|"

OpenWindow(0,0,0,800,600,"Adjust Contrast",#PB_Window_SystemMenu |#PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
  ContainerGadget(10,10,10,780,540,#PB_Container_Flat)
    ButtonImageGadget(0,-1,-1,780,540,0)
  CloseGadgetList()
  DisableGadget(10,1)
  ButtonGadget(1,10,560,60,30,"Open")
  ButtonGadget(2,80,560,60,30,"Save")
 
  ;TrackBarGadget(3,150,562 ,645,24,0,255)
  TBhwnd = CreateWindowEx_(0,"msctls_trackbar32","",#WS_VISIBLE | #WS_CHILD | #TBS_ENABLESELRANGE| #TBS_TOOLTIPS |#TBS_FIXEDLENGTH,145,562 ,652,24,WindowID(0),200,0,0)
  SendMessage_(TBhwnd, #TBM_SETRANGE,1,255 << 16)
  SendMessage_(TBhwnd, #TBM_SETTHUMBLENGTH,25,0)
  SendMessage_(TBhwnd,#TBM_SETPOS,1,127)
  scale.f = 1
 
  BindEvent(#PB_Event_SizeWindow,@sizeCB())
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
;*********************** At current position process ***************      
    Case #WM_LBUTTONDOWN
      If GetFocus_() = TBhwnd
        downflag = 1
      EndIf
      
    Case #WM_LBUTTONUP
      If downflag = 1
        downflag = 0
        pos = SendMessage_(TBhwnd,#TBM_GETPOS,0,0)
        If IsImage(0)         
          color.f = pos/100
          If IsImage(1)
            CopyImage(1,2)
            Contrast (2,1,color,color,color)
          Else
            CopyImage(0,2)
            Contrast (2,0,color,color,color)
          EndIf
          SetGadgetAttribute(0,#PB_Button_Image,ImageID(2))
        EndIf
      EndIf
;********************************************************************
        
; ***************************  Instant process *******************      
;     Case #WM_MOUSEMOVE
;       If GetFocus_() = TBhwnd
;         pos = SendMessage_(TBhwnd,#TBM_GETPOS,0,0)
;         If IsImage(0)         
;           color.f = pos/100
;           If IsImage(1)
;             CopyImage(1,2)
;             Contrast (2,1,color,color,color)
;           Else
;             CopyImage(0,2)
;             Contrast (2,0,color,color,color)
;           EndIf
;           SetGadgetAttribute(0,#PB_Button_Image,ImageID(2))
;         EndIf
;       EndIf
;******************************************************************
     
    Case #WM_MOUSEWHEEL
      If IsImage(0)
        CopyImage(0,1)
        delta = EventwParam()>>16 & $FFFF
        If delta = 120
          If scale < 4           
            scale.f = scale.f + 0.05           
          EndIf         
        Else         
          If scale > 0.1
            scale.f = scale.f - 0.05
          EndIf         
        EndIf
        ResizeImage(1,ImageWidth(0)*scale,ImageHeight(0)*scale)
        ;SendMessage_(TBhwnd,#TBM_SETPOS,1,127)
        SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
      EndIf
     
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          SendMessage_(TBhwnd,#TBM_SETPOS,1,127)
          If IsImage(0)
            FreeImage(0)
          EndIf
          If IsImage(1)
            FreeImage(1)
          EndIf
          If IsImage(2)
            FreeImage(2)
          EndIf
          File$ = OpenFileRequester("Choose image file to load", "*.*", Pattern$, 0)
          If File$ And FileSize(File$)
            LoadImage(0,File$)
            SetGadgetAttribute(0,#PB_Button_Image,ImageID(0))
          EndIf
         
        Case 2
          If IsImage(2)
            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(2, sfile ,#PB_ImagePlugin_BMP)
              ElseIf GetExtensionPart(sfile) = "jpg"
                SaveImage(2, sfile ,#PB_ImagePlugin_JPEG)
              ElseIf GetExtensionPart(sFile) = "png"
                SaveImage(2, 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
         
      EndSelect
  EndSelect
Until Quit = 1

Edit : Code modified

[Kwai chang caine]

I have try your new version
I move the mouse and the cursor move more time after
But surely my VIVO PC is not also strong for do the calculates
You have surely a plane PC compare to me

[RASHAD]

Hi KCC
Previous post updated for your VIVO PC

[Kwai chang caine]

Yes !!!! better better better
Now the cursor follow my mouse

It's a pity your code can't change the processor , because the change of contrast come not immediately after the "LeftMouseUp", i must wait 1 to 3 seconds for see the result
Apparently, my VIVO have the same brain that his owner .... a "little bit" long to the reflection

Thanks a lot MASTER for to have modify your code for me

[Saki]

Hi,
the trick is that while you use the slider, you can only change the visible area.
Only after leaving the slider you convert the whole image.
This is the usual way for large images.
Then it will also be fast

[RASHAD]

Hi KCC
Simplified and faster for your VIVO

Code: Select all

DisableDebugger

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

Global TBhwnd

#TBS_TOOLTIPS     = $100
#TBM_SETTOOLTIPS  = $41D
#TTF_TRACK        = $20

Procedure.l LimitValues (x.l)
   !mov eax,dword[p.v_x]
   !xor edx,edx       ; set EDX to zero
   !cmp eax,0         ; compare with top limit
   !cmovl eax,edx     ;
   !mov edx,255       ; 255
   !cmp eax,edx       ; compare with bottom limit
   !cmovg eax,edx     ; if lower, set value to bottom limit
   ProcedureReturn
EndProcedure

Procedure Contrast (Dimg,percent.f)
  StartDrawing(ImageOutput(Dimg))
    For x = 0 To ImageWidth(Dimg)-1
      For y = 0 To ImageHeight(Dimg)-1
        c = Point(x,y)
        r = LimitValues (Int(Red(c)-127)*percent+127)
        g = LimitValues (Int(Green(c)-127)*percent+127)
        b = LimitValues (Int(Blue(c)-127)*percent+127)
        Plot(x,y,RGB(r,g,b))        
      Next
    Next
  StopDrawing()    
  
EndProcedure

Procedure sizeCB()
  ResizeGadget(10,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-60)
  ResizeGadget(0,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-60)
  ResizeGadget(1,#PB_Ignore,WindowHeight(0)-40,#PB_Ignore,#PB_Ignore)
  ResizeGadget(2,#PB_Ignore,WindowHeight(0)-40,#PB_Ignore,#PB_Ignore)
  MoveWindow_(TBhwnd,GadgetX(2 ,#PB_Gadget_WindowCoordinate)+65,WindowHeight(0)-38,WindowWidth(0)-148,25,1)
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|"

OpenWindow(0,0,0,800,600,"Adjust Contrast",#PB_Window_SystemMenu |#PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
  ContainerGadget(10,10,10,780,540,#PB_Container_Flat)
    ButtonImageGadget(0,-1,-1,780,540,0)
  CloseGadgetList()
  DisableGadget(10,1)
  ButtonGadget(1,10,560,60,30,"Open")
  ButtonGadget(2,80,560,60,30,"Save")
 
  ;TrackBarGadget(3,150,562 ,645,24,0,255)
  TBhwnd = CreateWindowEx_(0,"msctls_trackbar32","",#WS_VISIBLE | #WS_CHILD | #TBS_ENABLESELRANGE| #TBS_TOOLTIPS |#TBS_FIXEDLENGTH,145,562 ,652,24,WindowID(0),200,0,0)
  SendMessage_(TBhwnd, #TBM_SETRANGE,1,255 << 16)
  SendMessage_(TBhwnd, #TBM_SETTHUMBLENGTH,25,0)
  SendMessage_(TBhwnd,#TBM_SETPOS,1,127)
  scale.f = 1
 
  BindEvent(#PB_Event_SizeWindow,@sizeCB())
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
;*********************** At current position process ***************      
    Case #WM_LBUTTONDOWN
      If GetFocus_() = TBhwnd
        downflag = 1
      EndIf
      
    Case #WM_LBUTTONUP
      If downflag = 1
        downflag = 0
        pos = SendMessage_(TBhwnd,#TBM_GETPOS,0,0)
        If IsImage(0)         
          percent.f = pos/100
          If IsImage(1)
            CopyImage(1,2)
          Else
            CopyImage(0,2)
          EndIf
          Contrast (2,percent)
          SetGadgetAttribute(0,#PB_Button_Image,ImageID(2))
        EndIf
      EndIf
;********************************************************************
        
; ***************************  Instant process *******************      
;     Case #WM_MOUSEMOVE
;       If GetFocus_() = TBhwnd
;         pos = SendMessage_(TBhwnd,#TBM_GETPOS,0,0)
;         If IsImage(0)         
;           color.f = pos/100
;           If IsImage(1)
;             CopyImage(1,2)
;             Contrast (2,percent)
;           Else
;             CopyImage(0,2)
;             Contrast (2,percent)
;           EndIf
;           SetGadgetAttribute(0,#PB_Button_Image,ImageID(2))
;         EndIf
;       EndIf
;******************************************************************
     
    Case #WM_MOUSEWHEEL
      If IsImage(0)
        CopyImage(0,1)
        delta = EventwParam()>>16 & $FFFF
        If delta = 120
          If scale < 4           
            scale.f = scale.f + 0.05           
          EndIf         
        Else         
          If scale > 0.1
            scale.f = scale.f - 0.05
          EndIf         
        EndIf
        ResizeImage(1,ImageWidth(0)*scale,ImageHeight(0)*scale)
        ;SendMessage_(TBhwnd,#TBM_SETPOS,1,127)
        SetGadgetAttribute(0,#PB_Button_Image,ImageID(1))
      EndIf
     
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          SendMessage_(TBhwnd,#TBM_SETPOS,1,127)
          If IsImage(0)
            FreeImage(0)
          EndIf
          If IsImage(1)
            FreeImage(1)
          EndIf
          If IsImage(2)
            FreeImage(2)
          EndIf
          File$ = OpenFileRequester("Choose image file to load", "*.*", Pattern$, 0)
          If File$ And FileSize(File$)
            LoadImage(0,File$)
            SetGadgetAttribute(0,#PB_Button_Image,ImageID(0))
          EndIf
         
        Case 2
          If IsImage(2)
            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(2, sfile ,#PB_ImagePlugin_BMP)
              ElseIf GetExtensionPart(sfile) = "jpg"
                SaveImage(2, sfile ,#PB_ImagePlugin_JPEG)
              ElseIf GetExtensionPart(sFile) = "png"
                SaveImage(2, 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
         
      EndSelect
  EndSelect
Until Quit = 1

[Kwai chang caine]

Waoooouhhh !!!!



This time it's close to the perfection
Only one second after leave the mouse button

SAKI have right
The image have a résolution of 2448 x 3264
It's not a smiley

Again thanks for have a new time modify your code for my VIVO
Have a very good sunday