Little More Help On Shading

Little More Help On Shading

Post by Lee Peedi » Sat, 05 Jul 2003 02:31:50



Using Mike's sample code (thanks), I'm now attempting to turn this
into an ActiveX DLL.  Got that done, and it works from scipting
languages; however I need to make it "generic".

The function in the DLL is named "Shade".  I would like to pass to it
2 parameters - 1) the number of coordinates & 2) an array of X Y
positions.

You'll see in the code below where I am passing the first parameter
and that works everywhere EXCEPT in the

Dim Points(5) As PointAPI

line.  If I place the variable Num_Coor here I get an error "Constant
Expression Required"

Also I need to know how to place each element of the array (once I
learn how to pass it) into
Points(n) = NewPoint()

(I'll worry about getting the scale correct later :-).)

Thanks for your help!!

Here's what I got so far: (watch for line wraps)

Option Explicit
Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, ByRef
lpPoint As PointAPI, ByVal nCount As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor
As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long,
ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As
Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As
Long) As Long

Private Type PointAPI
    X As Long
    Y As Long
End Type

Private Const NULL_PEN As Long = 8

Public Function Shade(Num_Coor As Long)
    Printer.Print

    Dim Points(5) As PointAPI
    Dim DrawBrush As Long
    Dim OldBrush As Long, OldPen As Long

    Points(0) = NewPoint(66.0162918752011, 50)
    Points(1) = NewPoint(302.871917878727, 58.2711807184927)
    Points(2) = NewPoint(296.834304949194, 231.165793792796)
    Points(3) = NewPoint(25, 221.673130689716)
    Points(4) = NewPoint(69.7756948027361, 54.5679627417072)
    Points(5) = NewPoint(66.0163089378646, 50.0000229523706)

    DrawBrush = CreateSolidBrush(vbRed)
    OldBrush = SelectObject(Printer.hDC, DrawBrush)
    OldPen = SelectObject(Printer.hDC, GetStockObject(NULL_PEN))

    Call Polygon(Printer.hDC, Points(0), Num_Coor)
    Call DeleteObject(SelectObject(Printer.hDC, OldBrush))
    Call SelectObject(Printer.hDC, OldPen)
    Call Printer.EndDoc
End Function

Private Function NewPoint(ByVal inX As Long, ByVal inY As Long) As
PointAPI
    NewPoint.X = inX
    NewPoint.Y = inY
End Function

 
 
 

Little More Help On Shading

Post by Lee Peedi » Sat, 05 Jul 2003 02:58:11


Using Mike's sample code (thanks), I'm now attempting to turn this
into an ActiveX DLL.  Got that done, and it works from scipting
languages; however I need to make it "generic".

The function in the DLL is named "Shade".  I would like to pass to it
2 parameters - 1) the number of coordinates & 2) an array of X Y
positions.

You'll see in the code below where I am passing the first parameter
and that works everywhere EXCEPT in the

Dim Points(5) As PointAPI

line.  If I place the variable Num_Coor here I get an error "Constant
Expression Required"

Also I need to know how to place each element of the array (once I
learn how to pass it) into
Points(n) = NewPoint()

(I'll worry about getting the scale correct later :-).)

Thanks for your help!!

Here's what I got so far: (watch for line wraps)

Option Explicit
Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, ByRef
lpPoint As PointAPI, ByVal nCount As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor
As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long,
ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As
Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As
Long) As Long

Private Type PointAPI
    X As Long
    Y As Long
End Type

Private Const NULL_PEN As Long = 8

Public Function Shade(Num_Coor As Long)
    Printer.Print

    Dim Points(5) As PointAPI
    Dim DrawBrush As Long
    Dim OldBrush As Long, OldPen As Long

    Points(0) = NewPoint(66.0162918752011, 50)
    Points(1) = NewPoint(302.871917878727, 58.2711807184927)
    Points(2) = NewPoint(296.834304949194, 231.165793792796)
    Points(3) = NewPoint(25, 221.673130689716)
    Points(4) = NewPoint(69.7756948027361, 54.5679627417072)
    Points(5) = NewPoint(66.0163089378646, 50.0000229523706)

    DrawBrush = CreateSolidBrush(vbRed)
    OldBrush = SelectObject(Printer.hDC, DrawBrush)
    OldPen = SelectObject(Printer.hDC, GetStockObject(NULL_PEN))

    Call Polygon(Printer.hDC, Points(0), Num_Coor)
    Call DeleteObject(SelectObject(Printer.hDC, OldBrush))
    Call SelectObject(Printer.hDC, OldPen)
    Call Printer.EndDoc
End Function

Private Function NewPoint(ByVal inX As Long, ByVal inY As Long) As
PointAPI
    NewPoint.X = inX
    NewPoint.Y = inY
End Function

 
 
 

Little More Help On Shading

Post by Larry Serflate » Sat, 05 Jul 2003 03:08:45



Quote:> Using Mike's sample code (thanks), I'm now attempting to turn this
> into an ActiveX DLL.  Got that done, and it works from scipting
> languages; however I need to make it "generic".

> The function in the DLL is named "Shade".  I would like to pass to it
> 2 parameters - 1) the number of coordinates & 2) an array of X Y
> positions.

You could just pass it the points you want to use, and determine the
number of points from those actually passed in.  The VB method
for passing a non-determinate number of parameters is to use a
parameter array.  I am not sure if that will be OK from a scripting
language, if not you could still pass in a Variant that contains the
array and determine how many are in the array from inside the
routine.  Also, I would think you would want to avoid using Print
or EndDoc since you may have several to do.  The calling procedure
would be responsible for that.

In any case, the code below may give you some ideas:

The calling syntax would be like:

  Printer.Print
  MyDll.Shade X1,Y1, X2,Y2, X3, Y3
  MyDll.Shade X1, Y1, X4, Y4, X5, Y5, X6, Y6
  Printer.EnDoc

Note that it can take any (reasonable) number of parameters.

HTH
LFS

Public Function Shade(ParamArray Points())

    Dim Pts() As PointAPI
    Dim DrawBrush As Long
    Dim OldBrush As Long, OldPen As Long
    Dim ub As Long, i As Long

    ub = UBound(Points)
    ' Validate input (At least two vertices and even # of elements)
    If (ub > 3) And (ub And 1) Then
      ' Create array of points
      ReDim Pts(0 To ub \ 2)
      For i = 0 To ub Step 2
        Pts(i \ 2).x = CLng(Points(i))
        Pts(i \ 2).Y = CLng(Points(i + 1))
      Next

      ' Select drawing objects
      DrawBrush = CreateSolidBrush(vbRed)
      OldBrush = SelectObject(Printer.hDC, DrawBrush)
      OldPen = SelectObject(Printer.hDC, GetStockObject(NULL_PEN))

      ' Draw and clean up
      Polygon Printer.hDC, Pts(0), ub \ 2
      DeleteObject SelectObject(Printer.hDC, OldBrush)
      SelectObject Printer.hDC, OldPen

    End If

End Function

 
 
 

Little More Help On Shading

Post by alpin » Sat, 05 Jul 2003 03:22:49


Try it like this.....

  Dim Points() As PointAPI

  ReDim Points(Num_Coor) As PointAPI

HTH,
Bryan
____________________________________________________________
New Vision Software                   "When the going gets weird,"
Bryan Stafford                        "the weird turn pro."

Microsoft MVP-Visual Basic     Fear and Loathing in LasVegas

On Thu, 03 Jul 2003 13:31:50 -0400, Lee Peedin


>Using Mike's sample code (thanks), I'm now attempting to turn this
>into an ActiveX DLL.  Got that done, and it works from scipting
>languages; however I need to make it "generic".

>The function in the DLL is named "Shade".  I would like to pass to it
>2 parameters - 1) the number of coordinates & 2) an array of X Y
>positions.

>You'll see in the code below where I am passing the first parameter
>and that works everywhere EXCEPT in the

>Dim Points(5) As PointAPI

>line.  If I place the variable Num_Coor here I get an error "Constant
>Expression Required"

>Also I need to know how to place each element of the array (once I
>learn how to pass it) into
>Points(n) = NewPoint()

>(I'll worry about getting the scale correct later :-).)

>Thanks for your help!!

>Here's what I got so far: (watch for line wraps)

>Option Explicit
>Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, ByRef
>lpPoint As PointAPI, ByVal nCount As Long) As Long
>Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor
>As Long) As Long
>Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long,
>ByVal hObject As Long) As Long
>Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As
>Long) As Long
>Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As
>Long) As Long

>Private Type PointAPI
>    X As Long
>    Y As Long
>End Type

>Private Const NULL_PEN As Long = 8

>Public Function Shade(Num_Coor As Long)
>    Printer.Print

>    Dim Points(5) As PointAPI
>    Dim DrawBrush As Long
>    Dim OldBrush As Long, OldPen As Long

>    Points(0) = NewPoint(66.0162918752011, 50)
>    Points(1) = NewPoint(302.871917878727, 58.2711807184927)
>    Points(2) = NewPoint(296.834304949194, 231.165793792796)
>    Points(3) = NewPoint(25, 221.673130689716)
>    Points(4) = NewPoint(69.7756948027361, 54.5679627417072)
>    Points(5) = NewPoint(66.0163089378646, 50.0000229523706)

>    DrawBrush = CreateSolidBrush(vbRed)
>    OldBrush = SelectObject(Printer.hDC, DrawBrush)
>    OldPen = SelectObject(Printer.hDC, GetStockObject(NULL_PEN))

>    Call Polygon(Printer.hDC, Points(0), Num_Coor)
>    Call DeleteObject(SelectObject(Printer.hDC, OldBrush))
>    Call SelectObject(Printer.hDC, OldPen)
>    Call Printer.EndDoc
>End Function

>Private Function NewPoint(ByVal inX As Long, ByVal inY As Long) As
>PointAPI
>    NewPoint.X = inX
>    NewPoint.Y = inY
>End Function

 
 
 

Little More Help On Shading

Post by Larry Serflate » Sat, 05 Jul 2003 03:26:02



Quote:>     If (ub > 3) And (ub And 1) Then

should be:
Quote:>     If (ub >= 3) And (ub And 1) Then

 
 
 

Little More Help On Shading

Post by Mike D Sutto » Sat, 05 Jul 2003 08:56:31


Quote:> Using Mike's sample code (thanks), I'm now attempting to turn this
> into an ActiveX DLL.  Got that done, and it works from scipting
> languages; however I need to make it "generic".

> The function in the DLL is named "Shade".  I would like to pass to it
> 2 parameters - 1) the number of coordinates & 2) an array of X Y
> positions.

> You'll see in the code below where I am passing the first parameter
> and that works everywhere EXCEPT in the

> Dim Points(5) As PointAPI

> line.  If I place the variable Num_Coor here I get an error "Constant
> Expression Required"

> Also I need to know how to place each element of the array (once I
> learn how to pass it) into
> Points(n) = NewPoint()

<snip>

It looks like you should be sorted from the results you've got already,
however just one more thing about the code you've got - The NewPoint()
function takes two Long variables for input (Since the structure it outputs
also uses Long's for data storage), so there's no need to pass it floating
point values - These will just get rounded off anyway.  If you need to pass
use higher precision coordinates then use a more detailed mapping mode than
your current one, so that integer coordinates will map to smaller distances
on your display.
Hope this helps,

    Mike

 - Microsoft Visual Basic MVP -

WWW: Http://www.mvps.org/EDais/

 
 
 

1. problem:Increasing contrast means less color shades

When increasing the contrast on low contrast photographs Photoshop ideally
should create shades of colors to make up from the missing ones.
Unfortunately, when choosing the levels  command, Photoshop does not create
new shades of color. It only spreads the available shades over the whole
range of contrast, from black to white. That creates a posterized effect,
if the  contrast of the original scanned image is low.  Is there any way to
tell Photoshop  to " fill in the blanks", and to add colors and shades of
color and to blend them with the existing ones in a given photograph?

In other words: if you have a gradient going form medium gray to medium
light gray and then you increase the contrast dramatically until the
lightest gray becomes white and the darkest gray becomes black then
Photoshop DOES NOT fill in the missing shades to make a smooth gradient. The
image becomes posterized. How can I prevent this ?
Thank you very much
Kurt    

2. 3D "Beveled" Fonts..

3. Gouraud shading with less divs?

4. Extracting scale from a 2D matrix

5. Grouraud shading with less divs?

6. Data Thief software

7. little by little, teachers converse in front of outer lanes, unless they're good

8. mpeg_play installation on SUN

9. Getting the curved text little by little....