Little More Help On Shading 
Author Message
 Little More Help On Shading

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



Tue, 20 Dec 2005 01:31:50 GMT  
 Little More Help On Shading
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



Tue, 20 Dec 2005 01:58:11 GMT  
 Little More Help On Shading

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



Tue, 20 Dec 2005 02:08:45 GMT  
 Little More Help On Shading
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

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()

>(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



Tue, 20 Dec 2005 02:22:49 GMT  
 Little More Help On Shading

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

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



Tue, 20 Dec 2005 02:26:02 GMT  
 Little More Help On Shading
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/



Tue, 20 Dec 2005 07:56:31 GMT  
 
 [ 6 post ] 

 Relevant Pages 

1. a little help (for a little person)

2. Shaded title bar and misc help

3. Excel object uses less and less of CPU

4. ♀♂More Efficiency,More Benefit,Less Risk,Less Work!

5. A little help on Help (pun intended)

6. shading/coloring values

7. Macro/VBA Code for changing the cell shade color

8. Word Color Shading problems in Excel VBA

9. Shading a frame in a style

10. Shade only a checkbox

11. Page shading

12. Table row shading

 

 
Powered by phpBB® Forum Software