Scaling Image On MouseDrag?

I’ve been trying to scale a image that is filling a canvas on MouseDrag. I’m resizing the window manually on MouseDrag, and the image is a picture property of the window containing the canvas.

I’ve been trying to use the StretchBlt function to accomplish this because the quality of a BitBlt capture was somewhat better than what I was able to get using DrawInto.

My problem is when I am resizing the window and scaling the image during MouseDrag the image gets stretched out incorrectly. I have code that recalculates and paints to the canvas on MouseUp that resets it correctly but I want the image to scale properly as the canvas is resized.

I’ve modified some code I found elsewhere on here to use the StretchBlt function:

[code]
Function ScaleRect(X As Integer, Y As Integer, Handle As Int32, Width As Integer, Height As Integer, OldWidth As Integer, OldHeight As Integer) As Picture

#If TargetWin32 Then
Declare Function GetDesktopWindow Lib “User32” () As Integer
Declare Function GetDC Lib “User32” (HWND As Integer) As Integer
Declare Function StretchBlt Lib “GDI32” (DCdest As Integer, nxOriginDest As Integer, nyOriginDest As Integer, nWidthDest As Integer, _
nHeightDest As Integer, DCsource As Integer, nxOriginSource As Integer, nyOriginSource As Integer, nWidthSource As Integer, _
nHeightSource As Integer, rasterOp As Integer) As Boolean
Declare Function ReleaseDC Lib “User32” (HWND As Integer, DC As Integer) As Integer
Const SRCCOPY = &h00CC0020
Const CAPTUREBLT = &h40000000

If Width = 0 Or Height = 0 Then Return Nil
Dim ret As Picture = New Picture(Width, Height, 24)
Dim HWND As Integer = Handle
Dim SourceDC As Integer = GetDC(HWND)
Dim DestDC As Integer = screenCap.Graphics.Handle(screenCap.Graphics.HandleTypeHDC)
Call StretchBlt(DestDC, X, Y, Width, Height, SourceDC, X, Y, oldWidth, oldHeight, SRCCOPY)
Call ReleaseDC(HWND, SourceDC)
Return ret
#Endif

End Function[/code]

On MouseDrag I’m setting the previous Width and Height of the canvas to variables before calling the scaling function using the current sizes.

oldWidth = cnvBackground.Width 
oldHeight = cnvBackground.Height

//////////////////////////////////////////////
' Window resize stuff here...
/////////////////////////////////////////////

' Scale image and paint to canvas
p = ScaleRect(0, 0, cnvBackground.Handle, cnvBackground.Width, cnvBackground.Height, oldWidth, oldHeight)

Any help would be appreciated. :confused:

@Tim Hare

is there any reason you cannot simply use

 g.drawpicture myPic,0,0,mouseX,mouseY, 0,0,mypic.width,mypic.height

just an example, not cut/paste code

[quote=330650:@Dave S]is there any reason you cannot simply use

 g.drawpicture myPic,0,0,mouseX,mouseY, 0,0,mypic.width,mypic.height

just an example, not cut/paste code[/quote]

I wasn’t happy with the quality I was getting from DrawInto so I was trying to use GDI32 instead.

If you use MBS Plugins, there is a cross platform ScaleMBS function. And another one with bicubic interpolation is available.

http://www.monkeybreadsoftware.net/class-picture.shtml

I did not say use DRAWINTO… because yes that is poor quality…
I said use DRAWPICTURE which has its own scaling options

The scaling of DrawPicture isn’t very good. I think I’ve posted some interpolation code to the forum once upon a time. Here it is:

[code]Private Function BilinearInterpolation(OriginalPicture as Picture, newWidth as Integer, newHeight as Integer, constrainProportion as Boolean) as Picture
dim w as Integer = OriginalPicture.Width
dim h as Integer = OriginalPicture.Height
dim x_ratio as Double = (w - 1)/newWidth
dim y_ratio as Double = (h - 1)/newHeight
if constrainProportion then
if x_ratio >= y_ratio then
newHeight = h/x_ratio
else
newWidth = w/y_ratio
end if
x_ratio = max(x_ratio, y_ratio)
y_ratio = max(x_ratio, y_ratio)
end if

dim oldSurf as RGBSurface = OriginalPicture.RGBSurface
dim oldMask as Picture = OriginalPicture.CopyMask
dim oldMaskSurf as RGBSurface
if oldMask <> nil then oldMaskSurf = OriginalPicture.CopyMask.RGBSurface
dim InterpolatedPicture as new Picture(newWidth, newHeight, 32)
dim InterpolatedSurf as RGBSurface = InterpolatedPicture.RGBSurface
dim InterpolatedMaskSurf as RGBSurface = InterpolatedPicture.mask.RGBSurface

dim x, y, alphaValue as Integer
dim x_diff, y_diff, blue, red, green, gray as Double
dim a, b, c, d as Color

for i as Integer = 0 to (newHeight - 1)
for j as Integer = 0 to (newWidth - 1)
x = x_ratio * j
y = y_ratio * i
x_diff = (x_ratio * j) -x
y_diff = (y_ratio * i) - y

  'calculations for red, green and blue
  a = oldSurf.Pixel(x, y)
  b = oldSurf.Pixel(x + 1, y)
  c = oldSurf.Pixel(x, y + 1)
  d = oldSurf.Pixel(x + 1, y + 1)
  
  blue = (a.Blue * (1 - x_diff) * (1 - y_diff)) + (b.Blue * x_diff * (1 - y_diff)) + (c.Blue * y_diff * (1 - x_diff)) + (d.Blue * x_diff * y_diff)
  green = (a.green * (1 - x_diff) * (1 - y_diff)) + (b.green * x_diff * (1 - y_diff)) + (c.green * y_diff * (1 - x_diff)) + (d.green * x_diff * y_diff)
  red = (a.red * (1 - x_diff) * (1 - y_diff)) + (b.red * x_diff * (1 - y_diff)) + (c.red * y_diff * (1 - x_diff)) + (d.red * x_diff * y_diff)
  
  InterpolatedSurf.Pixel(j, i) = RGB(red, green, blue)
  
  if oldMaskSurf <> Nil then
    'now the mask
    a = oldMaskSurf.Pixel(x, y)
    b = oldMaskSurf.Pixel(x + 1, y)
    c = oldMaskSurf.Pixel(x, y + 1)
    d = oldMaskSurf.Pixel(x + 1, y + 1)
    
    gray = (a.Blue * (1 - x_diff) * (1 - y_diff)) + (b.Blue * x_diff * (1 - y_diff)) + (c.Blue * y_diff * (1 - x_diff)) + (d.Blue * x_diff * y_diff)
    
    InterpolatedMaskSurf.Pixel(j, i) = RGB(gray, gray, gray)
  end if
next

next

Return InterpolatedPicture

End Function
[/code]

[quote=330656:@Dave S]I did not say use DRAWINTO… because yes that is poor quality…
I said use DRAWPICTURE which has its own scaling options[/quote]

I’m sorry Dave, I do appreciate you trying to help. I’ll try again using DrawPicture and see what I get.

[quote=330658:@Beatrix Willius]The scaling of DrawPicture isn’t very good. I think I’ve posted some interpolation code to the forum once upon a time. Here it is:

[code]Private Function BilinearInterpolation(OriginalPicture as Picture, newWidth as Integer, newHeight as Integer, constrainProportion as Boolean) as Picture
dim w as Integer = OriginalPicture.Width
dim h as Integer = OriginalPicture.Height
dim x_ratio as Double = (w - 1)/newWidth
dim y_ratio as Double = (h - 1)/newHeight
if constrainProportion then
if x_ratio >= y_ratio then
newHeight = h/x_ratio
else
newWidth = w/y_ratio
end if
x_ratio = max(x_ratio, y_ratio)
y_ratio = max(x_ratio, y_ratio)
end if

dim oldSurf as RGBSurface = OriginalPicture.RGBSurface
dim oldMask as Picture = OriginalPicture.CopyMask
dim oldMaskSurf as RGBSurface
if oldMask <> nil then oldMaskSurf = OriginalPicture.CopyMask.RGBSurface
dim InterpolatedPicture as new Picture(newWidth, newHeight, 32)
dim InterpolatedSurf as RGBSurface = InterpolatedPicture.RGBSurface
dim InterpolatedMaskSurf as RGBSurface = InterpolatedPicture.mask.RGBSurface

dim x, y, alphaValue as Integer
dim x_diff, y_diff, blue, red, green, gray as Double
dim a, b, c, d as Color

for i as Integer = 0 to (newHeight - 1)
for j as Integer = 0 to (newWidth - 1)
x = x_ratio * j
y = y_ratio * i
x_diff = (x_ratio * j) -x
y_diff = (y_ratio * i) - y

  'calculations for red, green and blue
  a = oldSurf.Pixel(x, y)
  b = oldSurf.Pixel(x + 1, y)
  c = oldSurf.Pixel(x, y + 1)
  d = oldSurf.Pixel(x + 1, y + 1)
  
  blue = (a.Blue * (1 - x_diff) * (1 - y_diff)) + (b.Blue * x_diff * (1 - y_diff)) + (c.Blue * y_diff * (1 - x_diff)) + (d.Blue * x_diff * y_diff)
  green = (a.green * (1 - x_diff) * (1 - y_diff)) + (b.green * x_diff * (1 - y_diff)) + (c.green * y_diff * (1 - x_diff)) + (d.green * x_diff * y_diff)
  red = (a.red * (1 - x_diff) * (1 - y_diff)) + (b.red * x_diff * (1 - y_diff)) + (c.red * y_diff * (1 - x_diff)) + (d.red * x_diff * y_diff)
  
  InterpolatedSurf.Pixel(j, i) = RGB(red, green, blue)
  
  if oldMaskSurf <> Nil then
    'now the mask
    a = oldMaskSurf.Pixel(x, y)
    b = oldMaskSurf.Pixel(x + 1, y)
    c = oldMaskSurf.Pixel(x, y + 1)
    d = oldMaskSurf.Pixel(x + 1, y + 1)
    
    gray = (a.Blue * (1 - x_diff) * (1 - y_diff)) + (b.Blue * x_diff * (1 - y_diff)) + (c.Blue * y_diff * (1 - x_diff)) + (d.Blue * x_diff * y_diff)
    
    InterpolatedMaskSurf.Pixel(j, i) = RGB(gray, gray, gray)
  end if
next

next

Return InterpolatedPicture

End Function
[/code][/quote]

Thanks! I’ll give this a try as well. :slight_smile:

@Beatrix Willius I tried to use your example but all I get is a white square. I can see it scaling as I drag but it never produces an image. Any idea what I may be doing wrong?

dim NewPic as new Picture( cnvBackground.Width, cnvBackground.Height, 32 ) NewPic = BilinearInterpolation(OrigPic, cnvBackground.Width, cnvBackground.Height, False) p = NewPic

@Dave S You are right scaling with DrawPicture is much better quality than capturing with DrawInto.

You may want to have a look at the method posted by Norman here :
https://forum.xojo.com/12211-proportionally-resizing-a-picture/0
It should be possible to modify your method along these lines.

Scaling images in Windows, I seem to recall that this has been covered before with some declares that toggle the default graphics context scaling options to get high quality scaling on Windows. Try searching these forums.