[RESOLVED] Adjustable cursor.

[Poppa Mintin]

Hi,

I'm trying to create an adjustable size cursor.

I figured I'd copy a .png file, (embedded in Resources) to a PictureBox, then maybe copy the (Zoom) image to a cursor.
I had hoped that I could then re-size the PictureBox, then copy the new size image to the cursor.

This works:

Imports System.IO

Dim Cur As Bitmap = (DirectCast(My.Resources.ResourceManager.GetObject("Ring80BW"), Bitmap))

Private Sub MakeCursor()
        Dim ptrCur As IntPtr = Cur.GetHicon
 
        Csr = New Cursor(ptrCur)
        Me.Cursor = Csr
    End Sub

But with PictureBox1.Image = Ring80BW, this does not:

Dim Cur As Bitmap = PictureBox1.Image

I'm stuck because the 'Image' in the box can't be converted to a 'Bitmap' despite 'em both being bitmaps!
Sadly I can't find a 'C' (convert) code to do this.

Is there a way around this?


Poppa

[dday9]

The Bitmap has a constructor argument that accepts an Image: https://docs.microsoft.com/en-us/dot...Drawing_Image_

So you are able to do:

Dim Cur As Bitmap = New Bitmap(PictureBox1.Image)

[Poppa Mintin]

The Bitmap has a constructor argument that accepts an Image: https://docs.microsoft.com/en-us/dot...Drawing_Image_

So you are able to do:

Dim Cur As Bitmap = New Bitmap(PictureBox1.Image)

Thanks Dday9,

Dim Cur As Bitmap = New Bitmap(PictureBox1.Image) gives no problem with Intellisence. Come to run it however:

System.NullReferenceException
HResult=0x80004003
Message=Object reference not set to an instance of an object.
Source=Cursor Size Trial
StackTrace:
at Cursor_Size_Trial.Form1..ctor() in D:\~VB Trials\Cursor Size Trial\Form1.vb:line 11

Took a look at your URL, and from there I tried:

Dim Cur As New Bitmap(GetType(PictureBox), "PictureBox.bmp")

That ran successfully but from a 100px x 100px Picturebox (80px x 80px .png image) I get a 32px x 32px cursor so changing the size of the PictureBox isn't going to achieve my goal.
I may have to resort to ignoring the PictureBox and just having a series of different sized images, which could hardly be considered adjustable.

Poppa

[dday9]

Object reference not set to an instance of an object suggests that the Image was not set when you went to get the property. To confirm, add this:

If (PictureBox1.Image Is Nothing) Then
    MessageBox.Show("Image not set.")
Else
    Dim Curr = New Bitmap(PictureBox1.Image)
End If

[Poppa Mintin]

Thanks Dday9,

I tried that and had no MessageBox.
So I re-coded to the code below. This works fine up to a point, the cursor is 80px square and Clicking the 'Test' button, PictureBox1 changes from 100px Sqr. to 180px Sqr. but of course the cursor stays the same.
I obviously need to discover how to copy P'Box1 image to a bitmap, this may take a while.


Poppa

Imports System.IO
 
    Public Class Form1
 
    Dim Csr As Cursor
    Dim Cur As Bitmap
    Private Sub Form1_Load() Handles MyBase.Load
 
        MakeCursor()
    End Sub
 
    Private Sub ExitButton_Click() Handles ExitButton.Click
        Me.Close()
    End Sub
 
    Private Sub Test_Click() Handles Test.Click
        Dim siz As Integer = Cur.Height * 2
 
        PictureBox1.Height = siz
        PictureBox1.Width = siz
        Me.Cursor.Dispose()
        MakeCursor()
    End Sub
 
    Private Sub MakeCursor()
        Cur = New Bitmap(PictureBox1.Image)
        Dim ptrCur As IntPtr = Cur.GetHicon
 
        Csr = New Cursor(ptrCur)
        Me.Cursor = Csr
    End Sub
 
End Class

[boops boops]

I obviously need to discover how to copy P'Box1 image to a bitmap, this may take a while.

PictureBox1.DrawToBitmap

BB

[Poppa Mintin]

Thanks BB, I can't get the syntax for that command.

Meanwhile I've been trying the following:

Private Sub CaptureImage(ctrl As Control, fileName As String)
        Me.TopMost = True
        Dim posn As Rectangle = ctrl.Bounds
        Dim pt As Point = ctrl.PointToScreen(posn.Location)
        Dim map As New Bitmap(posn.Width, posn.Height)
        Using gr As Graphics = Graphics.FromImage(map)
            gr.CopyFromScreen(New Point(pt.X - ctrl.Location.X, pt.Y - ctrl.Location.Y), Point.Empty, posn.Size)
            'gr.CopyFromScreen(New Point(ctrl.Location.X, ctrl.Location.Y), Point.Empty, posn.Size)
            'gr.CopyFromScreen(New Point(pt.X, pt.Y), Point.Empty, posn.Size)
        End Using
        Me.TopMost = False
        map.Save("C:\Temp\ImageTrial.png")
    End Sub

Where this subroutine is called with: ctrl = PictureBox1, and Filename = "ImageTrial".
Prior to the addition of the 'TopMost' command, the images produced contained parts of the Form1.vb.
Since then you can see the three 'CopyFromScreen' options I've tried, all of 'em produce an image file in the selected folder, but none of 'em contain any image.
Stepping through the program, I can see that all the locations, and sizes collected are exactly the same as 'Watch' gives independently for P'Box1.
Very disappointing.


Poppa

[boops boops]

Thanks BB, I can't get the syntax for that command.

       Dim bmp As Bitmap
       With PictureBox1
            .BorderStyle = BorderStyle.None 'if necessary
            bmp = New Bitmap(.Width, .Height)
            .DrawToBitmap(bmp, .ClientRectangle)
            .BorderStyle = BorderStyle.Fixed3D 'or whatever, if wanted
       End With

Then have your lurid way with bmp. Don't forget to dispose of it.

BB

[Poppa Mintin]

Thanks BB,

That's brilliant, I'd struggled with that until 2AM but still got nowhere.

All that work and I'm still no better off, yes I can copy the image, yes I can make the cursor with the bitmap...
Sadly of course the bitmap isn't a png so there's no transparency. Obviously I'm also going to have to change the multiplication factor considerably, and have an up and down option. Currently, four clicks and the cursor is as big as Form1 height !

I'm off to play with TransparencyKey now... See if I can get it to only affect the cursor. Ha !

Thanks again BB.

Imports System.IO
 
    Public Class Form1
 
    Dim Csr As Cursor
    Dim Cur As Bitmap
    Dim map As Bitmap
 
    Private Sub Form1_Load() Handles MyBase.Load
        MakeCursor()
    End Sub
 
    Private Sub Copy_Click() Handles Copy.Click
        CaptureImage(PictureBox1)
    End Sub
 
    Private Sub ExitButton_Click() Handles ExitButton.Click
        Me.Close()
    End Sub
 
    Private Sub Test_Click() Handles Test.Click
        Dim siz As Integer = Cur.Width * 2 ' The cursor is square.
 
        PictureBox1.Height = siz
        PictureBox1.Width = siz
        Me.Cursor.Dispose()
        MakeCursor()
    End Sub
 
    Private Sub MakeCursor()
        CaptureImage(PictureBox1)
        Cur = New Bitmap(map)
        Dim ptrCur As IntPtr = Cur.GetHicon
        Csr = New Cursor(ptrCur)
        Me.Cursor = Csr
        map.Dispose()
    End Sub
 
    Private Sub CaptureImage(ctrl As Control)
        With ctrl
            map = New Bitmap(.Width, .Height)
            .DrawToBitmap(map, .ClientRectangle)
        End With
 
        '   Temp.
        map.Save("C:\Temp\ImageTrial.png")
    End Sub
 
End Class

Poppa

PS

Since this thread is now solved I'll mark it resolved.
If I run into problems with transparency, I'll start a new thread.

Pop

[Poppa Mintin]

Just to add the final result in case someone is looking to do the same thing...

'   Trial to change cursor size.    Started: 15:03:2021.
'   Trial completed.                         17:03:2021.
 
Imports System.Drawing.Imaging
Imports System.IO
 
Public Class Form1
 
    Dim Csr As Cursor
    Dim Cur As Bitmap
    Dim map As Image
    ReadOnly img As Image = New Bitmap(My.Resources.Ring80BW)
 
    Private Sub Form1_Load() Handles MyBase.Load
        Reset()
    End Sub
 
    '       Subroutines Alphabetical.
 
    Private Sub DownClick() Handles TestDown.Click
        ResizeCursor(CInt(map.Height * 0.9))
    End Sub
 
    Private Sub ExitButton_Click() Handles ExitButton.Click
        Me.Close()
    End Sub
 
    Private Sub MakeCursor()
        Me.Cursor.Dispose()
        Cur = New Bitmap(map)
        Dim ptrCur As IntPtr = Cur.GetHicon
        Csr = New Cursor(ptrCur)
        Me.Cursor = Csr
    End Sub
 
    Private Sub Reset() Handles Standard.Click
        map = img
        MakeCursor()
    End Sub
 
    Public Sub ResizeCursor(ByVal siz As Integer)
        map = New Bitmap(img, siz, siz)
        Me.Cursor.Dispose()
        MakeCursor()
    End Sub
 
    Private Sub UpClick() Handles TestUP.Click
        ResizeCursor(CInt(map.Height * 1.1))
    End Sub
 
End Class