Shaped PicBox (Picture Box Shape)

rpgnewbie · #1 01-27-2004, 01:08 PM

Thie was a code snippet for making round pictureboxes presented in this thread from "sugared":

http://www.xtremevbtalk.com/t137176.html

I wanted to see if it would actually work so I tried it in a project and of course it doesn't.

I tried different AutoRedraw settings combinations (none worked):
picObject.AutoRedraw = True, Form1.AutoRedraw = True
picObject.AutoRedraw = True, Form1.AutoRedraw = False
picObject.AutoRedraw = False, Form1.AutoRedraw = False
picObject.AutoRedraw = False, Form1.AutoRedraw = True

Here's the code

Code:

'DOESN'T WORK
Private Sub cmdMakeRound_Click()
Dim i As Long
Dim intD As Integer
Dim hRgn As Long

intD = 1000

BeginPath picObject.hdc
picObject.Circle (intD / 2, intD / 2), intD / 2
EndPath picObject.hdc
hRgn = PathToRegion(picObject.hdc)
SetWindowRgn picObject.hWnd, hRgn, False
picObject.Circle (intD / 2, intD / 2), intD / 2, vbBlack

End Sub

Here's the code from the modPicBoxShape that I used:

Code:

Public Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

However I did find some working code that did the same thing with using text as the region shaper:
(I used the same modPicBoxShape.bas code as above):

Code:

'DOES WORK
Private Sub Form_Load()
Const TXT = "Hello!"

Dim i As Long
Dim hRgn As Long

    Picture1.AutoRedraw = True

    ' Select a big font.
    Picture1.Font.Name = "Times New Roman"
    Picture1.Font.Bold = True
    Picture1.Font.Size = 50

    ' Make the PictureBox big enough.
    Picture1.Width = Picture1.TextWidth(TXT)
    Picture1.Height = Picture1.TextHeight(TXT)

    ' Make the clipping path.
    BeginPath Picture1.hdc
    Picture1.CurrentX = 0
    Picture1.CurrentY = 0
    Picture1.Print TXT
    EndPath Picture1.hdc

    ' Convert the path into a region.
    hRgn = PathToRegion(Picture1.hdc)

    ' Constrain the PictureBox to the region.
    SetWindowRgn Picture1.hWnd, hRgn, False

    ' Draw some lines on the form.
    AutoRedraw = True
    For i = 0 To ScaleHeight Step 60
        Line (0, i)-Step(ScaleWidth, 0), RGB(0, 128, 255)
    Next i

End Sub

The "hRGN" variable shows "O" in the "Private Sub cmdMakeRound_Clic"
when I set a breakpoint at the following line:
SetWindowRgn Picture1.hWnd, hRgn, False

But in the textshape code above it shows a number other than O, so (I guess) in first set of code the line that starts with
"hRgn = PathToRegion " doesn't work and in the second set of code it does. Very curious...

I thought maybe it was the "obj" code so I tried this:

Code:

Private Sub cmdMakeRound_Click()
Dim i As Long
Dim intD As Integer
Dim hRgn As Long

intD = 1000
picObject.AutoRedraw = True
picObject.CurrentX = 0
picObject.CurrentY = 0

BeginPath picObject.hdc
picObject.Circle (intD / 2, intD / 2), intD / 2
EndPath picObject.hdc
hRgn = PathToRegion(picObject.hdc)
SetWindowRgn picObject.hWnd, hRgn, False

picObject.Circle (intD / 2, intD / 2), intD / 2, vbBlack

' Draw some lines on the form.
AutoRedraw = True
For i = 0 To ScaleHeight Step 60
    Line (0, i)-Step(ScaleWidth, 0), RGB(0, 128, 255)
Next i

End Sub

But it also didn't work...does anyone know why? I'm scratching my head (and probably missing something very obvious...)

rpgnewbie · #2 01-27-2004, 01:25 PM

Could it be that the drawn circle isn't considered a path?

**passel** · #3 01-27-2004, 02:38 PM

Maybe it depends on the machine?
I loaded the circle code you provided, ran it, clicked the button, and the
green rectangle turned into a green circle (with a black outline). I added
a timer, to move it, and it moved as a circle, with the blue lines being
visible around the periphery of the circle. I didn't modify the code
from your zip file at all (until after seeing it work, I added the timer).

If I set the FillColor of the picturebox to Red, and the FillStyle to Solid,
then when I click the MakeRound button, then I get a Red, Round picturebox
without any rectangular area around it.

So I don't know what your problem is, but I know that graphics do work
differently on some computers, and controls will work differently at times
on different machines.

rpgnewbie · #4 01-27-2004, 05:14 PM

Quote:
Originally Posted by passel

So I don't know what your problem is, but I know that graphics do work
differently on some computers, and controls will work differently at times
on different machines.

Thanks passel. It was driving me nuts. At least I know the code works on some machines. I am running Win98SE on an old Pentium. What win O/S are you running Win2000/XP?

I think I may just use a font circle (maybe WingDings font) and see if I can get a circle that way.

**passel** · #5 01-27-2004, 05:36 PM

I'm at work at the moment, so am running VB5 CCE (the one available
for free, but can't create executables), on a NT 4.0 system. I think it's
probably a Pentium III about 800-900 Mhz. I'm not sure which video
card it has, which would be the most likely thing (it's drivers) to cause
a difference like this.

Interestingly, I noted yesterday, that code I had written at home that
picked a color, set the .forecolor, and used pset to plot random pixels in
that color worked fine at home, but on this machine the pixels all came
up black, regardless of what the .forecolor was set to. I had to specify
the color on the pset line, in order for it to work.

Since it's a work, controlled machine, I don't have priviledges to
change the resolution, or color depth. The current setting is 16 bit color.

And, not graphic related but we had that situation last week, where two
people, both running Windows XP, and VB6 SP5 had a difference in how
a locked textbox acted. On one machine, if the textbox was locked, you
could not paste into the textbox, whereas on the other machine you
could still paste into the box, just not type into it. Who knows what
differences can cause these anomalies. There was some other case, I
can't remember now the specifics, but where the same code worked
differently on two different user's machines, and was causing quite a bit
of frustration between the two parties involved, thinking one was not
understanding the other, when it was really some quirk in the hardware/software.

I guess I'll try it when I get home. I have an older Win98 pentium 200mhz
system that I can try it on, as well as the 2Ghz P4.

**passel** · #6 01-27-2004, 09:43 PM

Tried it at home.
Worked fine on the P4 XP machine.
It looked the same as your attachment on my old 200 Mhz, Win 98 system.

rpgnewbie · #7 01-28-2004, 05:52 PM

Quote:
Originally Posted by passel
Tried it at home.
Worked fine on the P4 XP machine.
It looked the same as your attachment on my old 200 Mhz, Win 98 system.

Thanks for the follow-up. I think the problem is this onboard video chip for a Packard Bell computer. I tried an older driver and got it to work, but had to switch back because the older driver crashes to much on low memory (motherboard is maxed at 256MB). I only use this computer for an internet terminal and to test backward compatibility. It used to be a POS terminal for a used software store that went out of business.

It's interesting to see someone else document this kind of weirdness. I've run into it for years. That's why when I built a computer for someone else I always use ATI video cards. I've found they have the least amount of compatibility issues (but I know some would say the same of NVidia).

CARL_SIY · #8 03-03-2004, 05:54 AM

try this code to create ellipse

BAS declaration
Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Form Declaration
Private Sub Form_Load()

Dim ReturnVal As Long
Me.Show
ReturnVal = SetWindowRgn(Me.hWnd, CreateEllipticRgn(10, 25, 100, _
200), True)

End Sub

reply your question to killing_angel_1@yahoo.com