I got the lil rascal of a robot controller working..

Trying to figure out what is going on.. DO you program? if so I can
email you the current code (comment to ezvidcap). I stopped posting
all the raw code cause it is changing so rapidly. I have been doing
versions now. V16 got wrote over by v10 on the motoboard communicator.

Gimme a day or so here then pull my chain again. I am on the linux box
here.

I got a bug in the motoboard here too.. it kills the trackball. I am
using a usb-232 adapter. Frustrated so I backed up for a bit. I may go
back to the normal 232 port.

>  Does the camera work in windows? is it configured? I thought the ocx
> compiled in it. I pulled the zip file with it in there. I'll look at
> the error codes in the bottom of the pdf. Later..
>

As said below, it works in ezvidcap, in windows, inside irfanview,
everywhere BUT in machinist_cam10... /mark


> > Works in easyvidcap, but in Machinist_cam10 I get runtime error 10
> > when I try to set cam update speed.  No image from microscope.
> > /mark
> >
>

WOW..

   I got the monkey whipped...

   NOW? You can toggle the packet transmission from the lil tiny board,
and it sends you 128 bytes of relevant information.

   OR? you can just toggle the encoder read function and it sends you
the 32bit odometer of the quadrature encoder position.

   At $72  right now, this is the best bargain I have seen. THE G-rex
from geckoland is probably just a tad more incorporate to the "world"
of cnc.. but wait here just a second. THIS puppy "GENERATES" PWM, has
built in PID subroutine, built in encoder velocity, built in straight
PWM, encoder/pid and a few more applications already burned into the
chip, you just toggle them and run them at 40khz. THe servo drive is
accessed by two inline connectors on top of the board, I have a 5volt
quadrature encoder just stabbed into mine here. Meaning the Back board
you wire to is here.. NO more crapola to purchase, AND,

   SO, Standardazation is here for the CheapAss DRO. ANybody currently
developing a pic can either make it simulate the encoder read format
via the 232 port or get left behind.

   My 40 hours sorting out the bug was not in vain.. I got more options
on this lil chip than to be believed. I still don't have the dll
sorted out to read with "thier" software. I am still struggling
through the Mscomm. It works tho. We may just go ahead with this till
I can do better.

  We will apply this as a DRO, but, it will get much better. A baseline
cnc system for about $200 total plus servo motors. Yeah, it will be
CheapAss cnc then. external interpolation will be the next nightmare.

  DRO will be done within a week. USING quadrature glass scales or
encoders.

Posted the moto board program that is kicking my butt.

It works with two commands, does not work with the encoder read. Or
any other.. just the heartbeat and Heart-beat-rate via slider.

Probably something simple. Then again.. I am working on converting the
dlls to visual basic.

  These are $72 each, have a pic onboard pre-programmed, have digital
I/O and two encoder channels and two PWM outputs, on board PID.
   They will be a machinists dream come true.. if I can get them to
work. A few mosfets, drivers on heatsinks, these two boards and you
are good for four axis.. Nothing else is close excepts perhaps the
gecko g-rex.
   external intepolating, now, that is going to be a trick? timing pins?

For game imaging, memory blitting, they are superior to Intel. I have
three computers here running intel. Kinda biased. Two are intel
motherboards with intel processors.

Still the windows bugs hit me. I got three plug in drives with linux.
I am trying to learn C++ on Linux. Free with the OS. It prefers Intel
also, some motheboards & processors have windows subroutines in the bios.

  I don't know everything, I'm mostly a instrumentation electrician
geek. I dabble in robotics. DOn't take anything I say personal.

   I refused to install windows on my machines at all till the early
90s..  I kinda miss the dos days.





--- In CheapAss@yahoogroups.com, "David Bloomfield"
<davidbloomfield@...> wrote:
>
> Huh?  Intel is way behind the technology curve and AMD processors are
> anything but cheap.  Please check out any hardware review site and
> you'll see that AMD is the only option right now for enthusiasts.
>
> --- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@> wrote:
> >
> > 1)I like intel processors. Have had problems running my programs on
> > amd, some squirrels in that cheaper cpu that do not work with all
> > intel based code.
>

right off, without looking, that sounds like the ocx file error.

  Does the camera work in windows? is it configured? I thought the ocx
compiled in it. I pulled the zip file with it in there. I'll look at
the error codes in the bottom of the pdf. Later..

   I got some excitement going on here. A small robotic controller
(moto board), two channels, 232 port, encoders already programmed in,
pwm already programmed in.. meaning you can take a few mosfets and
make a cnc.

   I'm getting my ass kicked on packet transmissions. They are using
C++ to talk to it, NO documentation on the dlls whatsoever. Two
commands work flawlessly, none others do.. I am so confused.

   I have been at it now for about 40 hours, slept about six hours last
night. I had it running on a tcp ip network for a bit on the serial
port like a modem.. LOOKIN interesting for the DRO.. This is the way I
think, you could put several machines on wireless and it be
transparent on a laptop. I was already running the laptop via a link
program I developed from what I learned last night.

   I have been bidding on one of them microscopes for about three
months now. I keep being cheap. If I had one, I'd know for sure.
Probably something configured wrong, or looking in the wrong place for
the drivers. c:\windows\system is where I peeked, I got a subroutine I
wrote to search the disc.. Not put it in.. but.. That is hubcaps.. the
tires are flat..

David


--- In CheapAss@yahoogroups.com, "markotime" <markotime@...> wrote:
>
> Works in easyvidcap, but in Machinist_cam10 I get runtime error 10
> when I try to set cam update speed.  No image from microscope.
> /mark
>

Huh?  Intel is way behind the technology curve and AMD processors are
anything but cheap.  Please check out any hardware review site and
you'll see that AMD is the only option right now for enthusiasts.

--- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@...> wrote:
>
> 1)I like intel processors. Have had problems running my programs on
> amd, some squirrels in that cheaper cpu that do not work with all
> intel based code.

Works in easyvidcap, but in Machinist_cam10 I get runtime error 10
when I try to set cam update speed.  No image from microscope.
/mark

Polling works, sometimes,
Heartbeat update command works 100% time
Other commands do not??? clues?

I am looking at using the .dll provided by the company, but no
information whatsoever.. gives ya a headache trying to figure out how
to utilize a dll without any information on calls.

David..

This took about 30hours to write.. I like the motoboard robotics bd.
It has onboard servo drivers, onboard encoder reads, cost $72.. two
channels onboard. Digital I./O.. Analog output.. ANybody done anything
similar? This pic would work to read two channels of quadrature
encoder input for a machine.




Option Explicit
  Private Declare Function timeGetTime Lib
"c:\windows\SYSTEM\winmm.dll" () As Long
  Dim prg_run As Boolean
  Public BSTEM As Byte ' bstem is a variable because
  ' I use 2 modules
  Dim bbuff(0 To 12) As Byte ' Arrays and ...
  Const cmdDEV_VAL As Byte = 4 ' constants can not be declared "Public"
  Const cmdVAL_GET As Byte = 17 ' on object-modul level in VB
  Const cmdVAL_SET As Byte = 18
  Const cmdVAL_SAV As Byte = 19
  Const cmdSRV_SAV As Byte = 20
  Const cmdVM_RUN As Byte = 21
  Const cmdVM_KILL As Byte = 22
  Const cmdDEBUG As Byte = 23
  Const cmdRESET As Byte = 24
  Const cmdDIG_CFG As Byte = 26
  Const cmdDIG_RST As Byte = 28
  Const cmdPTIME_RD As Byte = 29
  Const cmdSRV_CFG As Byte = 31
  Const cmdSRV_LMT As Byte = 32
  Const cmdSRV_REL As Byte = 34
  Const cmdSRV_RFLX As Byte = 35
  Const cmdSRV_STOP As Byte = 36
  Const cmdRAW_INPUT As Byte = 38
  Const cmdTMR_SET As Byte = 39
  Const cmdRFLXE_CFG As Byte = 40
  Const cmdRFLXE_CHK As Byte = 41
  Const cmdCTR_SET As Byte = 42
  Const cmdCTR_CT As Byte = 43
  Const cmdRAIL As Byte = 44
  Const cmdFUNC As Byte = 45
  Const cmdMPD_SET As Byte = 46
  Const cmdMPD_CHK As Byte = 47
  Const cmdWINDOW As Byte = 48
  Const cmdERRAMP As Byte = 49
  Const cmdERRATT As Byte = 50
  Const cmdPAD_IO As Byte = 51
  Const cmdPAD_INPUT As Byte = 52
  Const cmdPWINDOW As Byte = 53
  Const cmdPERRAMP As Byte = 54
  Const cmdPERRATT As Byte = 55
  Const cmdPTMR_SET As Byte = 56
  Const cmdPCTR_SET As Byte = 57
  Const cmdPCTR_WR As Byte = 58
  Const cmdA2D_RD As Byte = 25
  Const cmdDIG_IO As Byte = 27
  Const cmdIR02_RD As Byte = 30
  Const cmdSRV_ABS As Byte = 33
  Const cmdIIC_RD As Byte = 37
  Const cmdIIC_XMIT As Byte = 2
  Const cmdMo_Enc32 As Byte = 66
  Const cmdMO_peek As Byte = 61
  Const cmdMO_Cfg As Byte = 63
  Const cmdHB As Byte = 0
  Const magic_byte As Byte = 173
  Const swoff = &HFFFF&
  Const swon = &HFF&
  Const Swgo = &HFF00&
  Dim baud_rate As Integer
  'Dim Heart_beat As Integer
  Dim heart_freq As Integer
  Dim mode_cap As Integer





Private Sub Combo1_Change()
BBuff1.Text = Combo1.Index
End Sub

Private Sub End_but_Click()
prg_run = False
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
'Unload
End
End Sub

' MAIN
Private Sub Form_Load()
Dim ff As Integer
Dim a$
   Dim stemp As String
   prg_run = True
   Form1.Show
   'ff = FreeFile
   'Open "moto_commands.txt" For Input As #ff
    '  Load file into listbox
   'Do Until EOF(ff)
   '  Line Input #ff, stemp 'get the string from the file data
   '  Combo1.AddItem stemp  ' add item to the list1 box
   'Loop
   Fill_combo
   ' Close #ff
    ' Initialization routines for the 2 brainstem card
     'InitMSComm1
     'InitBrainStem2
     'InitBrainStem4
    Set_port.BackColor = swoff
    Slider1.Value = 1000
    Read_moto_timer.Interval = Slider1.Value
    com_speed.Text = Slider1.Value & " Msec "
    Poll_moto.BackColor = swoff
    Heart_beat.BackColor = swoff
    VScroll1.Value = 100
    Heart_sp.Text = VScroll1.Value
    Do
    DoEvents
    Loop Until prg_run = False
End Sub

' RS232 IO

Private Sub InitBrainStem4()


    set_Heart_mode
    set_heart_freq
    set_config_mode
    Read_serial_speed
    read_heart_rate
    read_heart_mode

End Sub

    'baud_rate Heart_beat Heart_freq mode as setup check
    'BSTEM = magic_byte
    'Call sendPacketVB

  Private Sub Read_serial_speed()
    '  baud rate 0=2400,1=4800,2=9600,3=19200,4=38400
     BSTEM = 4
     bbuff(0) = 2
     bbuff(1) = cmdVAL_GET
     bbuff(2) = 3 'read the serial baud rate register
     bbuff(3) = 0
     Call sendPacketVB
     Read_moto 'read the reply
  '    If moto_resp.Text <> "" Then
  '   baud_rate.Caption = Right$(moto_resp.Text, 2)
   delay_time (3)
  '    End If
  End Sub
   Private Sub read_heart_rate()
     BSTEM = 4
     bbuff(0) = 2
     bbuff(1) = cmdVAL_GET
     bbuff(2) = 2
     bbuff(3) = 0
     Call sendPacketVB
     Read_moto 'read the reply
  '   If moto_resp.Text <> "" Then
  '   heart.Caption = heart.Caption & " " & Right$(moto_resp.Text, 2)
     delay_time (3)
   End Sub
'    End If

Private Sub read_heart_mode()
' IIC bus baud rate 100 Khz
     BSTEM = 4
     bbuff(0) = 2
     bbuff(1) = cmdVAL_GET
     bbuff(2) = 5
     bbuff(3) = 0
     Call sendPacketVB
     Read_moto
  '   If moto_resp.Text <> "" Then
  '   heart.Caption = heart.Caption & " " & Right$(moto_resp.Text, 2)
     delay_time (3)
  '   End If
  End Sub

  Private Sub set_config_mode()
  'Set read mode of operation
     bbuff(0) = 2
     bbuff(1) = cmdMO_Cfg
     bbuff(2) = 5 'set for encoder Pid mode
     bbuff(3) = 0
     Call sendPacketVB
     Read_moto
'    If moto_resp.Text <> "" Then
'    mode.Caption = Right$(moto_resp.Text, 2)
   delay_time (3)
'  End If
End Sub

Private Sub set_Heart_mode()
  'Set read mode of operation
     bbuff(0) = 2
     bbuff(1) = cmdVAL_SET
     bbuff(2) = 5 '
     bbuff(3) = 0 '1=internal 0=external
     Call sendPacketVB
     Read_moto
'    If moto_resp.Text <> "" Then
'    mode.Caption = Right$(moto_resp.Text, 2)
   delay_time (3)
'  End If
End Sub

Private Sub set_heart_freq()
  'Set read mode of operation
     bbuff(0) = 2
     bbuff(1) = cmdVAL_SET
     bbuff(2) = 50 '50 x ms
     bbuff(3) = 0
     Call sendPacketVB
     Read_moto
'    If moto_resp.Text <> "" Then
'    mode.Caption = Right$(moto_resp.Text, 2)
   delay_time (3)
'  End If
End Sub

  Private Sub sendPacketVB()
   TX_moto.Value = 1
   TX_moto.BackColor = swon

   moto_resp.Text = "******************"

     Dim i As Integer
     Dim SendString As String

    If MSComm1.InBufferCount > 0 Then MSComm1.InBufferCount = 0 ' clear
inBuffer
     SendString = ""
     SendString = Chr(BSTEM)
     SendString = SendString & Chr(bbuff(0))  'the first length of
packet transmission
     Moto_tx.Text = BSTEM & Val(bbuff(0))
     For i = 1 To bbuff(0)                    'number of bytes to send
loop.. add them in.
     SendString = SendString & Chr(bbuff(i))
     Moto_tx.Text = Moto_tx.Text & Val(bbuff(i))
     Next
    If MSComm1.PortOpen = True Then
          Else
       MSComm1.PortOpen = True
       Set_port.BackColor = Swgo
    End If

      MSComm1.Output = SendString
   TX_moto.Value = 0

   'Moto_tx.Text = BSTEM & " " & bbuff(0) & " " & bbuff(1) & " " &
bbuff(2) & " " & bbuff(3)
End Sub

' Get Packet with added the readiong of the complete input string from
the device
Private Sub Read_moto()
'Private Sub read_moto_timer_timer()
   Dim tim_com As Long
   Rx_moto.Value = 1
   Rx_moto.BackColor = swon
   Dim time_com As Long
   Dim buff_str As String
   Dim err_code As Integer
   If prg_run = False Then
      'Unload.Form1
    End
   End If
   Moto_add_txt.Text = "Addr:" & BSTEM
   err_cod_txt.Text = ""

     Dim txtBuff As String
     Dim i As Integer
     Dim c As Long
     Dim BuffLength
     Dim Len_txtBuff As Integer
     tim_com = timeGetTime() + 500
     MSComm1.InBufferCount = 0 ' clear inBuffer
     Do ' wait for incoming bytes
       DoEvents
     Loop Until MSComm1.InBufferCount > 0 Or tim_com < timeGetTime()
     txtBuff = MSComm1.Input
     BuffLength = Len(txtBuff) ' number of received bytes
    If Len(txtBuff) > 2 Then                                       '
(<= 4 bytes)
     BSTEM = Asc(Mid(txtBuff, 1, 1)) ' get module number
     bbuff(0) = Asc(Mid(txtBuff, 2, 1)) ' get packet size
     End If
     tim_com = timeGetTime() + 500
     If BuffLength < 2 + bbuff(0) Then ' if received bytes < packet size
         MSComm1.InBufferCount = 0 ' do it again
         Do
            DoEvents
         Loop Until MSComm1.InBufferCount > 0 Or tim_com < timeGetTime
         txtBuff = txtBuff & MSComm1.Input
     End If
     For i = 3 To Len(txtBuff) ' write received data
         c = Asc(Mid(txtBuff, i, 1)) ' to array bbuff()
         bbuff(i - 2) = c
     Next
     buff_str = ""
     For i = 1 To Len(txtBuff)
         buff_str = buff_str + Str(Asc(Mid(txtBuff, i, 1)))
     Next
'send ack to module...
   MSComm1.Output = Chr(6)
'************************
    If moto_resp.Text = "" Then
    moto_resp.Text = "error no data returned"
    Else
    moto_resp.Text = buff_str
    End If

    Rx_moto.Value = 0
    Rx_moto.BackColor = swoff



If Len(buff_str) > 2 And Mid$(buff_str, 3, 3) = "128" Then


err_code = Val(Right$(buff_str, 2))

  Select Case err_code   ' Evaluate Number.
Case 0   ' Number between 1 and 5, inclusive.
    err_cod_txt.Text = "A device on the IIC bus did not send an ACK in
response to a transmission.  This message may also be seen if the
module is not getting sufficient power"
     Case 1
     err_cod_txt.Text = "The IIC write address was not an even value."
     Case 2
     err_cod_txt.Text = "The outgoing IIC packet queue overflowed.
Data was queued for transmission faster than the hardware could send it."
     Case 3
     err_cod_txt.Text = "The outgoing IIC packet queue underflowed.
This message may also be seen if the module is not getting sufficient
power. (This message could indicate a firmware bug -- contact vendor.)"
     Case 4
     err_cod_txt.Text = "The module experienced a reset by command or
by cycling power   "
     Case 5
     err_cod_txt.Text = "The module's EEPROM did not send an ACK in
response to a memory access."
     Case 6
     err_cod_txt.Text = "The length for the cmdMEM_RD command is too long."
     Case 7
     err_cod_txt.Text = "The address for a cmdMEM_RD or cmdMEM_WR
command is invalid."
     Case 8
     err_cod_txt.Text = "The module does not support the command."
     Case 9
     err_cod_txt.Text = "The length of a command packet was too long.
The module executed the command and ignored the extra bytes."
     Case 10
     err_cod_txt.Text = "The index of a system value, I/O device, or
servo is invalid.  It is illegal to read from a device configured for
output.  It is illegal to write to a device configured for input."
     Case 11
     err_cod_txt.Text = "A parameter for a command is invalid.  The
number of bytes in a command is invalid based on command flags."
     Case 12
     err_cod_txt.Text = "The command queue overflowed.  Commands were
queued faster than the hardware could execute them."
     Case 13
     err_cod_txt.Text = "The command queue underflowed. (This message
could indicate a firmware bug -- contact vendor.)"
     Case 14
     err_cod_txt.Text = "The serial packet queue overflowed.  Data was
queued for transmission faster than the hardware could send it."
     Case 15
     err_cod_txt.Text = "An attempt to set a software timer conflicted
with an active software timer."
     Case 16
     err_cod_txt.Text = "A TEA file ID was invalid or the specified TEA
file was already open."
     Case 17
     err_cod_txt.Text = "A cmdTEADATA (file write) command was issued
to a read-only TEA file.  A cmdTEAREAD (file read) command was issued
to a write-only TEA file. (The first write or read command for a TEA
file determines its mode.)"
     Case 18
     err_cod_txt.Text = "The specified TEA file was already closed."
     Case 19
     err_cod_txt.Text = "Too many bytes were written to a TEA file."
     Case 20
     err_cod_txt.Text = "A reflex command message had an invalid length."
     Case 21
     err_cod_txt.Text = "A raw input reflex ID was out of range."
     Case 22
     err_cod_txt.Text = "An incoming IIC transmission overwrote the
hardware IIC buffer register. (This message could indicate a firmware
bug -- contact vendor.)"
     Case 23
     err_cod_txt.Text = "An incoming IIC command overflowed the IIC
command queue.  Commands were queued faster than the hardware could
execute them."
     Case 24
     err_cod_txt.Text = "The incoming IIC command queue underflowed.
(This message could indicate a firmware bug -- contact vendor.)"
     Case 25
     err_cod_txt.Text = "The desired VM process ID was not free or all
processes were busy."
     Case 26
     err_cod_txt.Text = "A VM terminated execution."
     Case 27
     err_cod_txt.Text = "The length of a command packet was too short.
  The module was expecting more data and did not execute the command."
     Case 28
     err_cod_txt.Text = "An incoming serial byte overwrote a byte in
the hardware buffer.  The device transmitting data may be too fast for
the module."

  Case Else   ' Other values.
     err_cod_txt.Text = "not in list"
End Select


End If

    TX_moto.BackColor = swoff


End Sub

Private Sub InitBrainStem5()

' IIC bus baud rate 100 Khz
     BSTEM = 4
     bbuff(0) = 3
     bbuff(1) = cmdVAL_SET
     bbuff(2) = 3
     bbuff(3) = 0
     Call sendPacketVB
' Set Internal HeartBeat
     bbuff(0) = 3
     bbuff(1) = cmdVAL_SET
     bbuff(2) = 5
     bbuff(3) = 1
     Call sendPacketVB
End Sub

'
Private Sub Read_encoders()

Dim SendString As String
   TX_moto.Value = 1
   TX_moto.BackColor = Swgo
   If Moto_add.Text = "" Then Moto_add.Text = "04"
   If bbuff0.Text = "" Then bbuff0.Text = "0"
   If BBuff1.Text = "" Then BBuff1.Text = "0"
   If BBuff2.Text = "" Then BBuff2.Text = "0"
   If BBuff3.Text = "" Then BBuff3.Text = "0"



     BSTEM = Val(Moto_add.Text)   ' was hex conversion here.. changed
to dec..
     bbuff(0) = Val(bbuff0.Text)
     bbuff(1) = cmdMo_Enc32 ' Val(BBuff1.Text)
     bbuff(2) = Val(BBuff2.Text)
     bbuff(3) = Val(BBuff3.Text)

   sendPacketVB
  Read_moto
   TX_moto.Value = 0
   TX_moto.BackColor = swoff


End Sub


Private Sub Heart_beat_Click()
   If Heart_beat.BackColor = swoff Then
    Heart_beat.BackColor = swon
    Heart_beat.Caption = "Comm HB"
    TX_moto.Value = 1
   TX_moto.BackColor = Swgo
   If Moto_add.Text = "" Then Moto_add.Text = "04"
   bbuff0.Text = "3"
   BBuff1.Text = "18"
   BBuff2.Text = "5"
   BBuff3.Text = "0"
     BSTEM = Val(Moto_add.Text)   ' was hex conversion here.. changed
to dec..
     bbuff(0) = Val(bbuff0.Text)
     bbuff(1) = Val(BBuff1.Text)
     bbuff(2) = Val(BBuff2.Text)
     bbuff(3) = Val(BBuff3.Text)

   sendPacketVB
   TX_moto.Value = 0
   TX_moto.BackColor = swoff

    Exit Sub
  End If

If Heart_beat.BackColor = swon Then
    Heart_beat.BackColor = swoff
    Heart_beat.Caption = "Internal HB"
     TX_moto.Value = 1
   TX_moto.BackColor = Swgo
   If Moto_add.Text = "" Then Moto_add.Text = "04"
   bbuff0.Text = "3"
   BBuff1.Text = "18"
   BBuff2.Text = "5"
   BBuff3.Text = "1"
     BSTEM = Val(Moto_add.Text)   ' was hex conversion here.. changed
to dec..
     bbuff(0) = Val(bbuff0.Text)
     bbuff(1) = Val(BBuff1.Text)
     bbuff(2) = Val(BBuff2.Text)
     bbuff(3) = Val(BBuff3.Text)

   sendPacketVB
   TX_moto.Value = 0
   TX_moto.BackColor = swoff

Exit Sub
End If
End Sub

Private Sub Heart_speed_Click()
     TX_moto.Value = 1
   TX_moto.BackColor = Swgo
   If Moto_add.Text = "" Then Moto_add.Text = "04"
   bbuff0.Text = "3"
   BBuff1.Text = "18"
   BBuff2.Text = "2"
   BBuff3.Text = VScroll1.Value
     BSTEM = Val(Moto_add.Text)   ' was hex conversion here.. changed
to dec..
     bbuff(0) = Val(bbuff0.Text)
     bbuff(1) = Val(BBuff1.Text)
     bbuff(2) = Val(BBuff2.Text)
     bbuff(3) = Val(Hex$(BBuff3.Text))

   sendPacketVB
   TX_moto.Value = 0
   TX_moto.BackColor = swoff

End Sub

Private Sub Initialize_moto_Click()
InitBrainStem4 'send to configure the moto
End Sub

Private Sub Poll_moto_Click()

If Poll_moto.BackColor = swoff Then
Read_moto_timer.Enabled = False
Poll_moto.BackColor = swon
Poll_moto.Caption = "stop polling"
Read_moto_timer.Enabled = True
Exit Sub
End If

If Poll_moto.BackColor = swon Then
Read_moto_timer.Enabled = False
Poll_moto.BackColor = swoff
Poll_moto.Caption = "start polling"
Read_moto_timer.Enabled = False
Exit Sub
End If

End Sub

Private Sub Read_moto_timer_Timer()

Read_encoders

End Sub



Private Sub reset_Click()
   TX_moto.Value = 1
   TX_moto.BackColor = Swgo
   If Moto_add.Text = "" Then Moto_add.Text = "04"
   bbuff0.Text = "1"
   BBuff1.Text = "2"
   BBuff2.Text = "0"
   BBuff3.Text = "0"



     BSTEM = Val(Moto_add.Text)   ' was hex conversion here.. changed
to dec..
     bbuff(0) = Val(bbuff0.Text)
     bbuff(1) = Val(BBuff1.Text)
     bbuff(2) = Val(BBuff2.Text)
     bbuff(3) = Val(BBuff3.Text)

   sendPacketVB
   TX_moto.Value = 0
   TX_moto.BackColor = swoff

End Sub

Private Sub Send_packet_Click()


   If Moto_add.Text = "" Then Moto_add.Text = "04"
   If bbuff0.Text = "" Then bbuff0.Text = "0"
   If BBuff1.Text = "" Then BBuff1.Text = "0"
   If BBuff2.Text = "" Then BBuff2.Text = "0"
   If BBuff3.Text = "" Then BBuff3.Text = "0"
     BSTEM = Val(Moto_add.Text)    ' was hex conversion here.. all data..
     bbuff(0) = Val(bbuff0.Text)
     bbuff(1) = Val(BBuff1.Text)
     bbuff(2) = Val(BBuff2.Text)
     bbuff(3) = Val(BBuff3.Text)
     Call sendPacketVB

     Read_moto
     'bbuff(0) = 0
     'bbuff(1) = cmdMO_peek
     'bbuff(2) = 0
     'bbuff(3) = 0
     'Call sendPacketVB
     'Read_moto
   delay_time (5)
   Read_moto_timer.Interval = Slider1.Value

   End Sub

'Private Sub Slider1_Click()
'Read_moto_timer.Value = Slider1.Value
'End Sub
Private Sub delay_time(pausetime) 'seconds to pause
'delay to pause for program in seconds. Data passed here is Pausetime
  Dim start As Long
  Dim curr_time As Long
    ProgressBar1.Visible = True
         start = Timer ' Set start time.
         ProgressBar1.Max = pausetime
         curr_time = Timer
       Do While Timer < start + pausetime
        ProgressBar1.Value = ProgressBar1.Max - (Int((start +
pausetime)) - Int(curr_time)) 'update the configurable timer
        'timer_time.Text = ProgressBar3.Value

             DoEvents
       ' Read_FF_FE_Timer 'read for buttons or estops.
       'read estop buttons while in this loop for change
       curr_time = Timer
        Loop
     ProgressBar1.Visible = False
      End Sub
   Private Sub delay_motor_stall(mtr_freq)
      Dim time_out As Double
      time_out = mtr_freq + timeGetTime()
   Do Until time_out <= timeGetTime()
       ' the delay for the steppers accel/decell
      Loop
End Sub



Private Sub Set_port_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If

Set_port.BackColor = Swgo

'The program uses the MSComm-Control default property settings:
     MSComm1.DTREnable = False
     MSComm1.EOFEnable = False
     MSComm1.Handshaking = comNone
     MSComm1.InBufferSize = 1024
     MSComm1.InputLen = 0
     MSComm1.InputMode = comInputModeText
     MSComm1.NullDiscard = False
     MSComm1.OutBufferSize = 512
     MSComm1.RTSEnable = False
     MSComm1.SThreshold = 0
    ' MSComm1.RThreshold = 0 'this value should be different from
                                         'default value 0 when using an
OnComm event
     MSComm1.RThreshold = 1
     MSComm1.Settings = "9600,N,8,1"
     MSComm1.CommPort = Val(Port_num.Text) 'select COM-Port
     If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
  'InitBrainStem4 'send to configure the moto

End Sub


Private Sub Slider1_Click()
com_speed.Text = Slider1.Value & " Milleseconds"
End Sub

Private Sub Fill_combo()
Combo1.AddItem "cmdHB = 0", 0
Combo1.AddItem "cmdROUTE = 1", 1
Combo1.AddItem "cmdIIC_XMIT = 2", 2
Combo1.AddItem "3", 3
Combo1.AddItem "cmdDEV_VAL = 4", 4
Combo1.AddItem "5", 5
Combo1.AddItem "6", 6
Combo1.AddItem "7", 7
Combo1.AddItem "8", 8
Combo1.AddItem "9", 9
Combo1.AddItem "10", 10
Combo1.AddItem "11", 11
Combo1.AddItem "12", 12
Combo1.AddItem "13", 13
Combo1.AddItem "14", 14
Combo1.AddItem "15", 15
Combo1.AddItem "16", 16
Combo1.AddItem "cmdVAL_GET = 17", 17
Combo1.AddItem "cmdVAL_SET = 18", 18
Combo1.AddItem "cmdVAL_SAV = 19", 19
Combo1.AddItem "cmdSRV_SAV = 20", 20
Combo1.AddItem "cmdVM_RUN = 21", 21
Combo1.AddItem "cmdVM_KILL = 22", 22
Combo1.AddItem "cmdDEBUG = 23", 23
Combo1.AddItem "cmdRESET = 24", 24
Combo1.AddItem "cmdA2D_RD = 25", 25
Combo1.AddItem "cmdDIG_CFG = 26", 26
Combo1.AddItem "cmdDIG_IO = 27", 27
Combo1.AddItem "cmdDIG_RST = 28", 28
Combo1.AddItem "cmdPTIME_RD = 29", 29
Combo1.AddItem "cmdIR02_RD = 30", 30
Combo1.AddItem "cmdSRV_CFG = 31", 31
Combo1.AddItem "cmdSRV_LMT = 32", 32
Combo1.AddItem "cmdSRV_ABS = 33", 33
Combo1.AddItem "cmdSRV_REL = 34", 34
Combo1.AddItem "cmdSRV_RFLX = 35", 35
Combo1.AddItem "cmdSRV_STOP = 36", 36
Combo1.AddItem "cmdIIC_RD = 37", 37
Combo1.AddItem "cmdRAW_INPUT = 38", 38
Combo1.AddItem "cmdTMR_SET = 39", 39
Combo1.AddItem "cmdRFLXE_CFG = 40", 40
Combo1.AddItem "cmdRFLXE_CHK = 41", 41
Combo1.AddItem "cmdCTR_SET = 42", 42
Combo1.AddItem "cmdCTR_CT = 43", 43
Combo1.AddItem "cmdRAIL = 44", 44
Combo1.AddItem "cmdFUNC = 45", 45
Combo1.AddItem "cmdMPD_SET = 46", 46
Combo1.AddItem "cmdMPD_CHK = 47", 47
Combo1.AddItem "cmdWINDOW = 48", 48
Combo1.AddItem "cmdERRAMP = 49", 49
Combo1.AddItem "cmdERRATT = 50", 50
Combo1.AddItem "cmdPAD_IO = 51", 51
Combo1.AddItem "cmdPAD_INPUT = 52", 52
Combo1.AddItem "cmdPWINDOW = 53", 53
Combo1.AddItem "cmdPERRAMP = 54", 54
Combo1.AddItem "cmdPERRATT = 55", 55
Combo1.AddItem "cmdPTMR_SET = 56", 56
Combo1.AddItem "cmdPCTR_SET = 57", 57
Combo1.AddItem "cmdPCTR_WR = 58", 58
Combo1.AddItem "cmdSER_RELAY = 59", 59
Combo1.AddItem "cmdSER_TOIIC = 60", 60
Combo1.AddItem "cmdMO_peek = 61", 61
Combo1.AddItem "cmdMO_SET = 62", 62
Combo1.AddItem "cmdMO_Cfg = 63", 63
Combo1.AddItem "cmdMO_SAV = 64", 64
Combo1.AddItem "cmdMO_VAL = 65", 65
Combo1.AddItem "cmdMo_Enc32 = 66", 66
Combo1.AddItem "cmdMO_RMPCFG = 67", 67
Combo1.AddItem "cmdMO_RMPENA = 68", 68
Combo1.AddItem "cmdPAD_SETPTR = 69", 69
'Combo1.AddItem "cmdMSG = 128", 128


End Sub
Private Sub select_cmd_Click()
BBuff1.Text = Val(Combo1.ListIndex)
err_cod_txt.Text = Val(Combo1.ListIndex)
End Sub

Private Sub VScroll1_Change()
Heart_sp.Text = VScroll1.Value
Heart_speed.BackColor = Swgo
End Sub

1)I like intel processors. Have had problems running my programs on
amd, some squirrels in that cheaper cpu that do not work with all
intel based code.
2)I like the command set for the Motoboard brainstem I think I will
write the software to communicate via those packet transactions. You
will be able to purchase two of them to "control and read" encoders
and motors via pWM output and encoder feedback. SIMPLY, I wanted to
use the G-rex from Gecko, but can not afford one yet. I have this.
MOving forward with it. Modules are $72 from [url]www.acroname.com[/url]
3)I Like the play station 2 two stick joysticks, will incorporate the
controls from another code=let I wrote using them. Manual control, and
zooming of windows for scans. A checkbox will be there to load driver
and make it "work" with software, so a mouse will still do primitive
functions.
4) As I become better with 3d, a 3ddrafting program will be
incorporated to import the scanned files directly. A later addition
flowing toward a end result. A cheapass system.
5) As My robotics applications grow this code may go stale. I need input
6) usb to serial adapters are going to rule the roost for a while, I
just converted mine to communicate with the brainstem here on my
bench. I am interested in hooking a stamp up here to see if it can
read it directly. Since the brainstem has a usb-ttl communications
adapter it may be a mute point. ttl, yeah.. fixes the scale problems,
just address a port for each usb to ttl adapter. You are allowed 5..
check the acroname site for use. I will do up the code for the
cheapass system here in a bit.

I hope all you understand I am not a super-genius, I can not solve all
the issues and problems, I am however the most stubborn goat ever put
on this earth and butt my head against a problem till a solution is
offered. I do need help, plan on offering some too. A open source project.
added to file mods...

Hi..
   Please post us a picture when you can in the pictures area, start
you a folder there.

   I took apart a sears lasertrac? it is one of the 90 degree line jobs
that goes on a drill press, got the individual laser led modules and
the waffle lens out of it. Problem is the line width, it is not near
as tight of a line as the HeNe laser. I'll post pictures of the
insides I had to gut it, take it apart and mount it on a plate under
my spindle. I can post a picture of how it is laid out inside, THE
item cost $39.99 but I could not find a waffle lens to make a line for
that. Since then, Harbor freight came out with a line throwing level
for $10.. I bought two, got them home and found out they were "dot"
type levels. I bought the wrong ones. I plan on mounting them on my
press-break and another tool here.

   Yes, I am afraid of it from now on. I'll make sure to put a
disclaimer on it and one on the software. I got enough health issues
as it is.

   Using True-space-6 you can make a stl file of anything from a point
cloud. I played with thier demo till time ran out. I wanted it really
bad. BUT, can't afford it, I still got lil kids. The Animation part of
that, the Head you just scanned can speak any text file.. lips move as
you designed in the rotational points of the jaw,  and face. The heads
they have as models in there do that without doing all the point
inport, and you can stretch them to look like anybody.

  I have working software in C+ I downloaded from a linux site. Pretty
cool stuff. I don't know enough C yet to compile it. I did look at the
math.

  Need another moderator here to carry this in case I go off on a
diagonal line. I got to make money at times too. I have worked on some
of these subroutines since the 80s.

   I'll post a picture or two.

  David Cofer


--- In CheapAss@yahoogroups.com, "th.carel" <th.carel@...> wrote:
>
> David
>
> This is how I proceed for scan with my turntable , my cn ,under
Mach2/3 :
>
> I have made a optoswitch linked with a lenght of opticfiber , the
opto can send the info
> as any probe switch in the digitize probe input of the lpt.
>
> My camera have a little led wich monitor the ready state for the
next shot in the multi-shot
> mode.
>
> The opticfiber is installed close to this camera's led....ok ?..
>
> I run the digitize wizard from Mach/x , 360 for the X scan , 1 for Y
, and the Z is set to a deep lenght
>  of about  (under)the  time of a shot like a dwell cycle ....min 5
sec for an IXUS  Canon , 2 for the new one
>
> I press the start key of the digitizing process ,but before , I edit
   a M7 for the pneumatic switch pressor
> for the camera and a dwell for the first time AF...
>
> The step by step process is now automatic , shot ,...led on ->next
step (as a Z acquisition) ,shot,,next, etc...
>
> This work also for flat scan of course .
>
> To use a cn and Mach/x for laser scanning is a litte bit "heavy" ,
it would be better to change
> for a direct custom bundle ,hardware/software ...?
>
> Hey , I paint black the subject ......this is my laser safe mode
(during the open aera test phase.....!)
> and also some sheet of black curtains  around, just testing with a
2mW HeNe , next should be a 3.5 mW Laser diode.
>
> And , maybe , could you disengage your responsability with laser
hazard with a warning disclaimer....?
>
> The video lazer aquisition mode is a little bit more tiedous because
it's a pain to manage with
> synchro frame/feedrate axes move , but it's also working (the  video
frames can be saved as separated images
> under virtualdub and divided per 2 ...any , according with the ratio
amount of frames/lenght analysed by the point cloud
> convertor.
>
> But the best accurate is the interval shoting mode ...360 x 2 sec =
12 mn (:-)
>
> I  would share lot of others info but my laptop battery is down .
not a pillow excuse
> hurry to send ..arghhh
>
> thierry
>
>   ----- Original Message -----
>   From: ibewgypsie
>   To: CheapAss@yahoogroups.com
>   Sent: Wednesday, February 22, 2006 12:30 AM
>   Subject: [CheapAss] Group question? Logic direction of program?
>
>
>   I got a cnc.. most you guys don't..
>
>   With the cheapass DRO, I can.. scan..  Putting a object on the table
>   and using the scale input, I can take a snapshot and stack them on the
>   hard drive. After it is done the distance, snapshots end.
>
>   THEN, the pictures load sequentially, converting the laser line to
>   real world vectors into a point cloud list. (to import into a 3d
program)
>
>   This is the proper way? we don't need to pause at every scan point? I
>   mean with a manual machine and a pretty good computer someone could
>   crank it as fast as they wanted and it scan a item. My logic last
>   night was to stop my cnc at every picture scan.
>
>   I am tempted, to load the scanner and camera onto a laptop for my use,
>   scan, trigger the "keyboard emulator" jog though the parallel port to
>   step my cnc.. my use on my machine. I will have to figure out a way to
>   make sure the cnc is in position each time.
>
>   Which is better, stopping each time and processing picture, or making
>   snapshots?  A man, real smart man could rig a turntable up to scan
>   things.. like faces.. or??  In that case you would want a snapshot
>   mode and not a stop-snapshot each time.. a person would move.
>
>   I got the main page the way I want it.. you all take a look and tell
>   me what is up?
>
>
>
>
>
>   SPONSORED LINKS Robotics  Laser scanner  Cheap computer
>         Mechanical  Dro
>
>
>
------------------------------------------------------------------------------
>   YAHOO! GROUPS LINKS
>
>     a..  Visit your group "CheapAss" on the web.
>
>     b..  To unsubscribe from this group, send an email to:
>      CheapAss-unsubscribe@yahoogroups.com
>
>     c..  Your use of Yahoo! Groups is subject to the Yahoo! Terms of
Service.
>
>
>
------------------------------------------------------------------------------
>

----- Original Message -----

From: ibewgypsie

To: CheapAss@yahoogroups.com

Sent: Wednesday, February 22, 2006 12:30 AM

Subject: [CheapAss] Group question? Logic direction of program?

I got a cnc.. most you guys don't..

With the cheapass DRO, I can.. scan..  Putting a object on the table
and using the scale input, I can take a snapshot and stack them on the
hard drive. After it is done the distance, snapshots end.

THEN, the pictures load sequentially, converting the laser line to
real world vectors into a point cloud list. (to import into a 3d program)

This is the proper way? we don't need to pause at every scan point? I
mean with a manual machine and a pretty good computer someone could
crank it as fast as they wanted and it scan a item. My logic last
night was to stop my cnc at every picture scan.

I am tempted, to load the scanner and camera onto a laptop for my use,
scan, trigger the "keyboard emulator" jog though the parallel port to
step my cnc.. my use on my machine. I will have to figure out a way to
make sure the cnc is in position each time.

Which is better, stopping each time and processing picture, or making
snapshots?  A man, real smart man could rig a turntable up to scan
things.. like faces.. or??  In that case you would want a snapshot
mode and not a stop-snapshot each time.. a person would move.

I got the main page the way I want it.. you all take a look and tell
me what is up?

Hay guys! Careful with those lasers.

I burnt my retina in 1969 and still suffer from it.

Was sighting the light path on a hologram setup when a small mirror
fell out of it's holder, had a bright red flash in my left eye,
slammed my eyes shut, but too late.
That was only a 0.5 mW HeNe for a fraction of a second.

To this day if close my right eye and look directly at this period.
It appears there are 2 of them. I have a very small burn that's smack
dab directly in the middle of my line of sight.

Drives Optometrists Nuts! Can't correct that with no stinking lenses.
I love it, let them squirm and earn their pay before I tell them to
look carefully at the center of my Retina.

Tom M.

--- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@...> wrote:
>
> Hey torker..
>
>   That damn subroutine has kicked my butt.. The main polar part
took
> about thirty minutes..
>
>   BUT, a squirrel got into the varibles during the switch between
> polar and rectangular and I have not found it yet.. ha..
>
>   I thought I had it. I am going to flush all the varibles, only
one,
> is global *used throughout.. and I use the same textboxes for
> simplicity.. probably my problem, too simple..
>
>   Keep playing with it.. you are the first not afraid to find
problems
> for me.
>
>   I'll post a update as soon as I complete the "present project" on
> puter now.
>
>   Scanner.... I got a group question... lemme start another thread.
>
David...This thing is going to be good when you get the bugs out.
  I've tried some of the other bolt circle calculators and this one
seems like it'll be better...or simpler once it's working right.
  Hey...Rome wasn't built in a day...specially by a busy guy like you
with 25 things on the go at once...lol!
  Russ
>
>
>
>
> --- In CheapAss@yahoogroups.com, "torker_199" <torker_199@> wrote:
> >
> > --- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@>
wrote:
> > >
> > > New file in files section, a polar hole calculator program
> > > Compiled exe, code not there yet.
> > >
> > > Simple to use wizard.. we will group all this together in a
few weeks
> > > and do some pages to flip between features.
> > >
> > >  My pillow calls me.
> > >
> > > David
> >
> >
> > >
> >  David...last night I was playing with the rectangular mode.
> >  I don't know if I'm doing something wrong or what.
> >  All I did was to enter 4 into the "number of holes" box.
> >  I left everything else the same.
> >  The movements all seem right except for the last one.
> >  It says to move both X and Y 2". This doesn't seem right to me.
> >  Shouldn't there only be one movement for the last hole or am I
mixing
> > something up?
> >  Thanks!
> >  Russ
> >
>

Yeah, they meant it with the sticker on this one.

It says beware... I was shining it onto the white doorway. Got me a
good dose of welders burned eyes ..  Reflection off the white door as
I tinkered with the software/camera. I guess I need some eskimo
glasses with the slits or maybe some welding goggles? It is a visible
spectrum laser about 3millewatts.

I went on to reading a Linux graphics manual, now feels like salt.
Scanner laser User beware.

  Now I am off to Tinkering with the motoboard from www.acroname.com it
has direct communication and two encoders already programmed in. It
may be the first coded in segment. It would work great with rotary
encoders or sliding glass scales. I have wrote a bit for it in visual
basic, timing problems exist in my code because of the varience
windows does per loop.

If I was not so deep in the visual basic, I would start over in C++
and Linux..

  I have found no more errors in the polar hole exe program. Check some
more for me if you'all would.

Okay, I am still scratching my head..
   Once, it looked just wrong the output. I did not do the math to
check it. It looked too evenly spaced. shift the degrees and the 3
holes shifted out of synch.. yeah..

   I am printing out the degrees and the radius in the combo box on the
bottom on the polar mode. to test it.

   ON the rectangular mode, you do not enter the number holes, it
enters it from the rows and columns. I think I will lock that box.

   I noticed the way the nested program loops step through it, it does
not make sense. It does go, one axis, step columns, then step rows,
then step columns. then rows.. Both axis moves on last move.. also, no
odd holes. It would be easy to swap the way it steps through to
reverse it.

   I looked it over again, see no error.. well I have not flushed all
the varibles yet in between the polar and rectangular modes.

   I hate to complicate it further, but I am tempted to stitch it to
the graphics page and display the bolt pattern on the screen. Erase
the bolt, number till it calculates them. I did grey it out. Lemme
look here in a bit.

   I got most the code crunched for the scanner. open files, close
files, write point cloud. I still don't have a scale to read scanner
position from thou. Well I got one, it is not mounted on anything. and
a single 232 port adapter.


--- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@...> wrote:
>
> Hey torker..
>
>   That damn subroutine has kicked my butt.. The main polar part took
> about thirty minutes..
>
>   BUT, a squirrel got into the varibles during the switch between
> polar and rectangular and I have not found it yet.. ha..
>
>   I thought I had it. I am going to flush all the varibles, only one,
> is global *used throughout.. and I use the same textboxes for
> simplicity.. probably my problem, too simple..
>
>   Keep playing with it.. you are the first not afraid to find problems
> for me.
>
>   I'll post a update as soon as I complete the "present project" on
> puter now.
>
>   Scanner.... I got a group question... lemme start another thread.
>
>
>
>
>
> --- In CheapAss@yahoogroups.com, "torker_199" <torker_199@> wrote:
> >
> > --- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@> wrote:
> > >
> > > New file in files section, a polar hole calculator program
> > > Compiled exe, code not there yet.
> > >
> > > Simple to use wizard.. we will group all this together in a few
weeks
> > > and do some pages to flip between features.
> > >
> > >  My pillow calls me.
> > >
> > > David
> >
> >
> > >
> >  David...last night I was playing with the rectangular mode.
> >  I don't know if I'm doing something wrong or what.
> >  All I did was to enter 4 into the "number of holes" box.
> >  I left everything else the same.
> >  The movements all seem right except for the last one.
> >  It says to move both X and Y 2". This doesn't seem right to me.
> >  Shouldn't there only be one movement for the last hole or am I
mixing
> > something up?
> >  Thanks!
> >  Russ
> >
>

I got a cnc.. most you guys don't..

With the cheapass DRO, I can.. scan..  Putting a object on the table
and using the scale input, I can take a snapshot and stack them on the
hard drive. After it is done the distance, snapshots end.

THEN, the pictures load sequentially, converting the laser line to
real world vectors into a point cloud list. (to import into a 3d program)

This is the proper way? we don't need to pause at every scan point? I
mean with a manual machine and a pretty good computer someone could
crank it as fast as they wanted and it scan a item. My logic last
night was to stop my cnc at every picture scan.

I am tempted, to load the scanner and camera onto a laptop for my use,
scan, trigger the "keyboard emulator" jog though the parallel port to
step my cnc.. my use on my machine. I will have to figure out a way to
make sure the cnc is in position each time.

  Which is better, stopping each time and processing picture, or making
snapshots?  A man, real smart man could rig a turntable up to scan
things.. like faces.. or??  In that case you would want a snapshot
mode and not a stop-snapshot each time.. a person would move.

  I got the main page the way I want it.. you all take a look and tell
me what is up?

Hey torker..

   That damn subroutine has kicked my butt.. The main polar part took
about thirty minutes..

   BUT, a squirrel got into the varibles during the switch between
polar and rectangular and I have not found it yet.. ha..

   I thought I had it. I am going to flush all the varibles, only one,
is global *used throughout.. and I use the same textboxes for
simplicity.. probably my problem, too simple..

   Keep playing with it.. you are the first not afraid to find problems
for me.

   I'll post a update as soon as I complete the "present project" on
puter now.

   Scanner.... I got a group question... lemme start another thread.





--- In CheapAss@yahoogroups.com, "torker_199" <torker_199@...> wrote:
>
> --- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@> wrote:
> >
> > New file in files section, a polar hole calculator program
> > Compiled exe, code not there yet.
> >
> > Simple to use wizard.. we will group all this together in a few weeks
> > and do some pages to flip between features.
> >
> >  My pillow calls me.
> >
> > David
>
>
> >
>  David...last night I was playing with the rectangular mode.
>  I don't know if I'm doing something wrong or what.
>  All I did was to enter 4 into the "number of holes" box.
>  I left everything else the same.
>  The movements all seem right except for the last one.
>  It says to move both X and Y 2". This doesn't seem right to me.
>  Shouldn't there only be one movement for the last hole or am I mixing
> something up?
>  Thanks!
>  Russ
>

--- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@...> wrote:
>
> New file in files section, a polar hole calculator program
> Compiled exe, code not there yet.
>
> Simple to use wizard.. we will group all this together in a few weeks
> and do some pages to flip between features.
>
>  My pillow calls me.
>
> David


>
  David...last night I was playing with the rectangular mode.
  I don't know if I'm doing something wrong or what.
  All I did was to enter 4 into the "number of holes" box.
  I left everything else the same.
  The movements all seem right except for the last one.
  It says to move both X and Y 2". This doesn't seem right to me.
  Shouldn't there only be one movement for the last hole or am I mixing
something up?
  Thanks!
  Russ

New file in files section, a polar hole calculator program
Compiled exe, code not there yet.

Simple to use wizard.. we will group all this together in a few weeks
and do some pages to flip between features.

  My pillow calls me.

David

Newer version of centerfinder using Ray Mercers ezvideo ocx.

This was added into the compiled file using the components box.
This should work on every windows computer with a camera configured
and on.

I also uploaded the code for this section, it is real close to being a
scanner also, the cursor position displays red green blue values.

I will have to add a for/next loop, a mouse-pick color for selecting
the laser color on screen to scan for, the examine each pixel on the
screen for the laser color. Also, then, a movement subroutine to move
mach3.

This was wrote more for my own use. BUT, since it works and is here.

Problems? random problems with the ezvideo no shutting off. When you
reboot you have to cancel it out. I did do a preview.disable when the
form closes.

Please load, try it out, and let me know what is missing in the manner
of dlls. not a full fledged DRO program, just a subsection. We will
get it working in sections and load them back onto the main program
once everyone is happy.

See files section, DRO label. I was kinda in a rush, A visitation
weekend on my daughter.

Probably give ya a day or two to look that over.

I also uploaded the dlls and ocx that was missing. Not sure about XP,

I will probably gut the un-used sections there until we need them. THE
gcode parser is not needed anytime soon.

Plans are for it later to be able to "run" a gcode program by cranking
the handles on a manual machine.

Any more programmers here yet?

' CnC code writer and stepper system using the parallel port
' Code 10-20-01
'cofer@...
' David Cofer
' Po Box 837
' Tunnel hill, Ga 30755
'   Needs screen configuration, to make the same. Needs a screen resizer
'a redrawer for existing code, a Dxf input for drawings, a circle
setup for code
'to represent the mills.
' Please send any improved versions back to me in appreciation for use.
'M00 program end
'M01 program stop
'M02 end of program
'M03 start spindle
'M04 pause program
'M05 stop spindle
'M07 start coolant pump
'M09 stop coolant
'M10 start aux motor
'M11 stop aux motor
'M06 tool change

Option Compare Text     'RLP

Option Explicit
  'declare use of dll

  Private Type POINTAPI
     x As Long
     y As Long
End Type
'
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _
     ByVal x As Long, ByVal y As Long) As Long 'this subroutine gets 3
hex numbers related to the dot.
Private Declare Function GetCursorPos Lib "User32" (lpPoint As
POINTAPI) As Long 'reads windows loc of cursor
Private Declare Function GetWindowDC Lib "User32" (ByVal hWnd As Long)
As Long 'actuallY I don't remember what this does.
Const filename = "temp"
Dim R_clr As Long
Dim G_clr As Long
Dim B_clr As Long
Const Red = &HFF&
Const Blue = &HFF0000
'Public Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long,
ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
'Public Declare Function ExtFloodFill Lib "gdi32.dll" (ByVal hdc As
Long, ByVal nXStart As Long, ByVal nYStart As Long, ByVal crColor As
Long, ByVal fuFillType As Long) As Long
'Private Declare Function Out8255 Lib "c:\WINDOWS\8255.dll" (ByVal
portaddress As Integer, ByVal portdata As Integer) As Integer
Private Declare Function timeGetTime Lib "c:\windows\SYSTEM\winmm.dll"
() As Long

Dim obj_array(9000, 6000) As Boolean
Dim nXPos As Long
Dim nYPos As Long
Dim picmask As Long
Dim Xstart As Integer
Dim word_pos As Integer
Dim Ystart As Integer
Dim Zstart As Integer
Dim Word_start As Integer
Dim x As Integer
Dim y As Integer
Dim X_posi As Integer
Dim Y_posi As Integer
Dim Z_posi As Integer
'Dim xscreen As Integer
'Dim Yscreen As Integer
Dim Data_string As String
Dim Loop_file As Integer
Dim ig As Integer
Dim x_actual As Integer
Dim y_actual As Integer
Dim old_X As Single
Dim old_Y As Single
Dim old_z As Single
Dim i As Single
Dim t As Integer
Dim gcode As String
Dim not_complete As Integer
'Dim grid As Integer
Dim cutter_size As Single
Dim oldscroll1 As Integer
Dim oldscroll2 As Integer
Dim oldscroll3 As Integer
Dim Feed_rate As Integer
Dim mtr_run As Boolean     'flag for toggle
Dim coolant_run As Boolean
Dim aux_mtr As Boolean
Dim seq_cut As Boolean ' flag for toggle
Const xoffset = 720
Const yoffset = 840
Const Xscreen_max = 10800
Const Yscreen_max = 6975
Const RGB_RED = &HFF&
Const RGB_ORANGE = &H80FF&
Const RGB_YELLOW = &HFFFF&
Const RGB_GREEN = &HFF00&
Const RGB_BLUE = &HFF0000
Const RGB_PURPLE = &HFF00FF
Const RGB_GREY = &HC0C0C0
Dim z1var As Single
   Dim z2var As Single
   Dim z3var As Single
'Const PI = 3.1415927 'make Pi


Private Type polypt       'RLP
   x As Single
   y As Single
   cutrad As Single
   marker As Boolean
End Type

Private Type GridPoint
   x As Single
   y As Single
End Type

Dim beenhere As Boolean   'RLP
Dim gridsnap As Boolean
Dim gridON As Boolean
Dim marker As Boolean

Dim yspan As Single
Dim xspan As Single
Dim xscreen As Single
Dim Yscreen As Single
Dim xgrid As Single
Dim ygrid As Single
Dim grid As Single
Dim marksize As Single

Dim polyset() As polypt   'RLP
Dim GridSet() As GridPoint

'we have the accuracy available so let's use it
Const swoff = &HFFC0C0             'RLP
Const swon = &H80FF80              'RLP
Const single1 As Single = 1        'RLP
Const dblzero As Double = 0#       'RLP
Const mkdbl As Double = 1#         'RLP
Const pio2 = 1.5707963267949       'RLP  dbl by default
Const pio4 = 0.78539816339745      'RLP
Const pi = 3.14159265358979        'RLP
Const threepio2 = 4.71238898038469 'RLP
Const twopi = 6.28318530717958     'RLP
Const dtr = 1.74532925199433E-02   'RLP
Const rtd = 57.2957795130824       'RLP
Const gridcolor1 = &H80FF80        'RLP
Const gridcolor = &H8000&          'RLP
Const markcolor = &HFFFFFF         'RLP

Private Sub Check2_Click()
   If Check2.Value = 1 Then
     gridsnap = True
   Else
     gridsnap = False
   End If
End Sub

Private Sub Check4_Click()
If Check4.Value > 0 Then
VScroll2.Visible = True
Text17.Visible = True
Text18.Visible = True
Command1.Visible = True
Label23.Visible = True
Label24.Visible = True
  Else

  VScroll2.Visible = False
Text17.Visible = False
Text18.Visible = False
Command1.Visible = False
Label23.Visible = False
Label24.Visible = False

End If
End Sub





Private Sub Command1_Click() 'enable check drill subroutine...
gcode = "G00"
'top=VScroll1.Value / 1000
  frmeditor.Myeditor.SelText = gcode & "X" & Text17.Text & "Y" &
Text18.Text & "Z" & VScroll1.Value / 1000 & Chr$(13)
  frmeditor.Myeditor.SelText = ""
'bot = VScroll2.value/1000
gcode = "G01"
frmeditor.Myeditor.SelText = gcode & "X" & Text17.Text & "Y" &
Text18.Text & "Z" & VScroll2.Value / 1000 & "F" & VScroll3.Value &
Chr$(13)
  frmeditor.Myeditor.SelText = ""
  gcode = "G00"
frmeditor.Myeditor.SelText = gcode & "X" & Text17.Text & "Y" &
Text18.Text & "Z" & VScroll1.Value / 1000 & Chr$(13)
  frmeditor.Myeditor.SelText = ""
End Sub



Private Sub Form_Load()

'xscreen = 11520
'Yscreen = 10800
   Dim oldx As Integer
   Dim oldy As Integer
   Dim oldz As Integer

   Text4.Visible = False
   Text5.Visible = False
   Text6.Visible = False
   If VScroll1.Value <> oldscroll1 Then
     Text8.Text = VScroll1.Value / 1000 'sets the text box
     oldscroll1 = VScroll1.Value   'loads the variable
   End If
   If VScroll2.Value <> oldscroll2 Then
     Text9.Text = VScroll2.Value / 1000 'sets the text box
     oldscroll2 = VScroll2.Value   'loads the variable
   End If
   If VScroll3.Value <> oldscroll3 Then
     Text10.Text = " F" & VScroll3.Value 'sets the text box
     oldscroll3 = VScroll3.Value   'loads the variable
   End If

   If x = 0 And y = 0 Then
     VScroll3.Value = 3
     Option3_Click (0)
   ' Check1.Value = 1
   End If
    'VScroll3.Value = 3
'******
after:
         'If GetAsyncKeyState(vbKeyUp) <> 0 Then
         '    Y = Y - 2
        ' End If
        'If GetAsyncKeyState(vbKeyDown) <> 0 Then
        '     Y = Y + 2
        ' End If
        ' If GetAsyncKeyState(vbKeyLeft) <> 0 Then
         '    X = X - 5
         'End If
         'If GetAsyncKeyState(vbKeyRight) <> 0 Then
         '    X = X + 3
         'End If
         'If GetAsyncKeyState(vbKeyEscape) <> 0 Then
        ' Beep
       'End If
   Label21(0).BackColor = swoff   'RLP
   Label21(1).BackColor = swoff   'RLP
   Label21(2).BackColor = swoff   'RLP
   'account for borders/mouse sensing area inside picbox & aspect & scaling
   'Me.Width = Me.Height * aspect
   PicMain.Width = PicMain.Height * 9 / 6
   xspan = PicMain.Width - 45   'RLP
   yspan = PicMain.Height - 45  'RLP

   'account for 3d shading vs flat
   If PicMain.Appearance = 1 Then
     xspan = xspan - 30
     yspan = yspan - 30
   End If

   xscreen = xspan / 9   '9 inches
   Yscreen = yspan / 6   '6 inches
   grid = 2             '0.100
   xgrid = xspan / (9 * grid)
   ygrid = yspan / (6 * grid)

   CurrentX = 0
   CurrentY = yspan
   old_X = CurrentX
   old_Y = CurrentY

   ReDim polyset(0)             'RLP
   polyset(0).x = dblzero       'RLP
   polyset(0).y = yspan         'RLP
   polyset(0).cutrad = dblzero  'RLP
   polyset(0).marker = True     'RLP

   Image1.Left = PicMain.Left + PicMain.Width + 15
   Image1.Top = PicMain.Top + (PicMain.Height - Image1.Height) / 2
   Label14.Left = Image1.Left + (Image1.Width - Label14.Width) / 2
   Label15.Left = Label14.Left
   Label14.Top = Image1.Top - Label14.Height - 15
   Label15.Top = Image1.Top + Image1.Height + 15
   Option3(1).Value = True
   Option4(2).Value = True

   marksize = (0.1 * xscreen) / 2

   Image2.Top = PicMain.Top - Image2.Height - 15
   Image2.Left = PicMain.Left + (PicMain.Width - Image2.Width) / 2

   Label12.Left = Image2.Left - Label12.Width - 15
   Label12.Top = Image2.Top + (Image2.Height - Label12.Height) / 2

   Label13.Top = Label12.Top
   Label13.Left = Image2.Left + Image2.Width + 15

   'Frame1.Top = -60            'hide the leader strip
   'Frame1.Left = PicMain.Left + (PicMain.Width - Frame1.Width) / 2

   'Frame6.Top = -60            'hide the leader strip
   'Frame6.Left = PicMain.Left + PicMain.Width - Frame6.Width
   'Frame4.Top = -60            'hide the leader strip
   'Frame4.Left = (Frame6.Left - Frame4.Width + Frame1.Left +
Frame1.Width) / 2

   'Frame2.Top = PicMain.Top + PicMain.Height - 75
   'Frame2.Left = PicMain.Left
   'Frame3.Top = Frame2.Top
   'Frame5.Top = Frame2.Top

   'Frame5.Left = PicMain.Left + PicMain.Width - Frame5.Width
   'Frame3.Left = (Frame2.Left + Frame2.Width + Frame5.Left -
Frame3.Width) / 2

   'Label5.Top = Frame3.Top + Frame3.Height + 60
   'Label5.Left = Frame3.Left + (Frame3.Width - Label5.Width) / 2
   'LoadGcode.Left = Frame5.Left
   'LoadGcode.Top = Label5.Top
   'CodeEdit.Top = Label5.Top
   'CodeEdit.Left = Frame5.Left + Frame5.Width - CodeEdit.Width

   'Redraw.Left = PicMain.Left   'left anchor
   'Redraw.Top = Label5.Top
   'ClearSession.Top = Label5.Top
   'ClearSession.Left = Frame2.Left + Frame2.Width - ClearSession.Width
  'right anchor

   'ProgressBar1.Left = Frame3.Left
   'ProgressBar1.Width = Frame3.Width
   'ProgressBar1.Top = Label5.Top + Label5.Height + 30




   ClearMe
   Show                         'RLP

End Sub
'
Private Sub scan_for_laser()
  'search across top line looking for laser color
  'then when line is found, calculate angle according to pixel offset
from edge
  'then walk up,down from point and find left-most point of laser color
on connecting pixel
  'write laser pixels using triangulation into a point cloud file on editor

  Dim tPOS As POINTAPI
     Dim sTmp As String
     Dim lColor As Long
     Dim lDC As Long
     Dim xctr As Single
     Dim yctr As Single
     Dim x_loop As Single
     Dim y_loop As Single
     Dim gridtrack As Single
     Dim oldcolor
   'first locate the variables for screen picture size to scan.
   'laser color point picked previously by setup.

     gridtrack = 0
     xctr = PicMain.ScaleWidth / 2
     yctr = PicMain.ScaleHeight / 2
     xspan = PicMain.ScaleWidth
     yspan = PicMain.ScaleHeight
   'scan picture from left to max value, top to bottom using a for/next
loop
   For x_loop = 0 To xspan
    For y_loop = 0 To yspan
     lDC = GetWindowDC(0)
     Call GetCursorPos(tPOS)
     lColor = GetPixel(lDC, tPOS.x, tPOS.y)
   '  Label2.BackColor = lColor
     sTmp = Right$("000000" & Hex(lColor), 6)
     Caption = "X" & tPOS.x & " Y" & tPOS.y & " R:" & Right$(sTmp, 2) &
" G:" & Mid$(sTmp, 3, 2) & " B:" & Left$(sTmp, 2)
     'check pixel against laser color
     'figure in the angle by known camera to laser distance, camera
angle trig.
     'write it to the editor in a point cloud format.
     'first the red
     'ProgressBar1.Value = Val("&h" & Right$(sTmp, 2))
     'Text3.Text = Val("&h" & Right$(sTmp, 2))
     'then the green
     'ProgressBar2.Value = Val("&h" & Mid$(sTmp, 3, 2))
     'Text4.Text = Val("&h" & Mid$(sTmp, 3, 2))
     'then the blue
     'ProgressBar3.Value = Val("&h" & Left$(sTmp, 2))
     'Text5.Text = Val("&h" & Left$(sTmp, 2))
    'now the check against the previously mouse picked laser color.

    Next y_loop
    Next x_loop

End Sub

Private Sub ClearMe()
   Label21(0).BackColor = swoff   'RLP
   Label21(1).BackColor = swoff   'RLP
   Label21(2).BackColor = swoff   'RLP
   'account for borders/mouse sensing area inside picbox & aspect & scaling
   'Me.Width = Me.Height * aspect
   PicMain.Width = PicMain.Height * 9 / 6
   xspan = PicMain.Width - 45   'RLP
   yspan = PicMain.Height - 45  'RLP

   'account for 3d shading vs flat
   If PicMain.Appearance = 1 Then
     xspan = xspan - 30
     yspan = yspan - 30
   End If

   xscreen = xspan / 9   '9 inches
   Yscreen = yspan / 6   '6 inches
   grid = 2             '0.100
   xgrid = xspan / (9 * grid)
   ygrid = yspan / (6 * grid)

   CurrentX = 0
   CurrentY = yspan
   old_X = CurrentX
   old_Y = CurrentY

   ReDim polyset(0)             'RLP
   polyset(0).x = dblzero       'RLP
   polyset(0).y = yspan         'RLP
   polyset(0).cutrad = dblzero  'RLP
   polyset(0).marker = True     'RLP
   marksize = (0.1 * xscreen) / 2
   Text15.Text = "1.4145926<45"
   Check2.Value = 0
   Check3.Value = 0
   gridsnap = False
   gridON = False
   BtnUp
   PicMain.Cls
   frmeditor.Cls
End Sub

Private Sub grid_display()
   Dim xctr As Single
   Dim gridtrack As Single
   Dim oldcolor

   oldcolor = PicMain.ForeColor
   PicMain.ForeColor = gridcolor
   gridtrack = 0

   For xctr = 0 To xspan Step xgrid
     PicMain.Line (xctr, 0)-(xctr, yspan)
   Next

   For xctr = 0 To yspan Step ygrid
     PicMain.Line (0, xctr)-(xspan, xctr)
   Next
   PicMain.ForeColor = oldcolor
End Sub
  Private Sub Crosshair_display_Click()
   Dim xctr As Single
   Dim yctr As Single
   Dim loopy As Single
   Dim gridtrack As Single
   Dim oldcolor

   oldcolor = PicMain.ForeColor
   PicMain.ForeColor = gridcolor
   gridtrack = 0
   xctr = PicMain.ScaleWidth / 2
   yctr = PicMain.ScaleHeight / 2
   xspan = PicMain.ScaleWidth
   yspan = PicMain.ScaleHeight

   'For loopy = 1 To line_width
     PicMain.Line (xctr, 0)-(xctr, yspan), Line_color.Value 'line left
to right
     PicMain.Line (0, yctr)-(xspan, yctr), Line_color.Value 'line top
to bottom
   'Next loopy
   PicMain.ForeColor = oldcolor
End Sub
Private Sub Circle_display_Click()

   Dim xctr As Single
   Dim yctr As Single
   Dim gridtrack As Single
   Dim oldcolor

   oldcolor = PicMain.ForeColor
   PicMain.ForeColor = gridcolor
   gridtrack = 0
   xctr = PicMain.Width / 2
   yctr = PicMain.Height / 2
   xspan = PicMain.Width
   yspan = PicMain.Height
   size_select.Max = yctr

     'PicMain.Line (xctr, 0)-(xctr, yspan), Line_color.Value 'line left
to right
     'PicMain.Line (0, yctr)-(xspan, yctr), Line_color.Value 'line top
to bottom
     PicMain.Circle (xctr, yctr), size_select.Value, Line_color.Value
   PicMain.ForeColor = oldcolor

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As
Single, y As Single)
'form msemov routine added RLP
   If beenhere Then   'kill last rubberband line in pic windo
     PicMain.Line (CurrentX, CurrentY)-(old_X, old_Y), PicMain.BackColor
     PicMain.Circle (CurrentX, CurrentY), cutter_size, PicMain.BackColor
     beenhere = False
   End If

End Sub

Private Sub Label21_Click(index As Integer)

   Select Case index
     Case 0
       If mtr_run = False Then
         mtr_run = True
         Label21(0).BackColor = swon
         frmeditor.Myeditor.SelText = "M03" & "(start spindle) " & Chr$(13)
         frmeditor.Myeditor.SelText = ""
       Else
         mtr_run = False
         Label21(0).BackColor = swoff
         frmeditor.Myeditor.SelText = "M05" & "(stop spindle) " & Chr$(13)
         frmeditor.Myeditor.SelText = ""
       End If
     Case 1
       If coolant_run = False Then
         coolant_run = True
         Label21(1).BackColor = swon
         frmeditor.Myeditor.SelText = "M07" & "(start coolant) " & Chr$(13)
         frmeditor.Myeditor.SelText = ""
       Else
         coolant_run = False
         Label21(1).BackColor = swoff
         frmeditor.Myeditor.SelText = "M09" & "(stop coolant) " & Chr$(13)
         frmeditor.Myeditor.SelText = ""
       End If
     Case 2
       If aux_mtr = False Then
         aux_mtr = True
         Label21(2).BackColor = swon
         frmeditor.Myeditor.SelText = "M10" & "(start aux mtr)" & Chr$(13)
         frmeditor.Myeditor.SelText = ""
       Else
         aux_mtr = False
         Label21(2).BackColor = swoff
         frmeditor.Myeditor.SelText = "M11" & "(stop aux mtr)" & Chr$(13)
         frmeditor.Myeditor.SelText = ""
       End If
   End Select

End Sub

Private Sub ManVecMark_Click()
   ManVecMark.Tag = "CHK"
   ManVecSet_Click
End Sub

Private Sub ManVecSet_Click()
   Dim tmpval, xval, yval As Single
   Dim tmpangl  As Double, tmpangl1 As Double
   Dim angchar As Integer
   Dim errmsg, tmpstr As String

   tmpstr = Trim(Text15.Text)

   If Len(tmpstr) < 3 Then
     errmsg = "Check format:  eg 1.25<45"
     GoTo errout
   End If

   angchar = InStr(1, tmpstr, "<")

   If (angchar < 2) Or (angchar = Len(tmpstr)) Then
     errmsg = "Check format:  eg 1.25<45"
     GoTo errout
   End If

   tmpval = Val(Left$(tmpstr, angchar - 1))

   If tmpval < 0.00001 Then
     errmsg = "Negative or Zero Vector Length..."
     GoTo errout
   End If

   tmpangl = Val(Mid(tmpstr, angchar + 1))
   tmpangl1 = tmpangl

   tmpangl = tmpangl * dtr
   xval = tmpval * Cos(tmpangl)
   yval = tmpval * Sin(tmpangl)

   yval = -yval * Yscreen + old_Y
   xval = xval * xscreen + old_X

   Select Case tmpangl1
     Case 0, 180
       yval = old_Y
     Case 90, 270
       xval = old_X
   End Select

   If (xval > xspan) Or (xval < 0) Or (yval < 0) Or (yval > yspan) Then
     errmsg = "X or Y resultant out of range..."
     GoTo errout
   End If

   If ManVecMark.Tag = "CHK" Then
     PicMain.Circle (xval, yval), marksize, markcolor
     ManVecMark.Tag = ""
   Else
     PicMain_mousemove 1, 0, (xval), (yval) 'note parens to force data
type coercion
     PicMain_mousedown 1, 0, (xval), (yval) 'note parens to force data
type coercion
   End If
   Exit Sub
errout:
   MsgBox "Check format:  eg 1.25<45" & Chr$(13) & "Check range: X<9 Y<6"
End Sub

Private Sub camera_enable_Click() 'option button to load driver
     If camera_enable = 1 Then
     'camera section
   '* This sub runs when our main form is loaded.
'* Primary responsibility is to initialize the video portal
     '* First call to the portal is always PrepareControl:
     VideoPortal1.PrepareControl "QCSDK_VBDEMO", _
         "HKEY_LOCAL_MACHINE\Software\Logitech\QCSDK_VBDEMO", 0
     VideoPortal1.EnableUIElements UIELEMENT_STATUSBAR, 0, 1
     '* Try to connect to a camera
     If VideoPortal1.ConnectCamera2() = 0 Then
         MsgBox "Unable to connect to any QuickCam camera"
         Exit Sub
     End If
     '* Found a camera, turn on video previewing
     VideoPortal1.EnablePreview = 1
     Slider1.Value = 1000
     Timer1.Enabled = False
     Timer1.Interval = Slider1.Value
     size_select.Value = 500
     'end camera insert
     Slider1.Visible = True
     StrFileSave.Visible = True
     Text19.Visible = True
     Camera_on.BackColor = RGB_RED
     Camera_on.Visible = True
     Else
     VideoPortal1.EnablePreview = 0
     Slider1.Visible = False
     StrFileSave.Visible = False
     Text19.Visible = False
     Camera_on.Visible = False
     VideoPortal1.Visible = False
    End If
End Sub

Private Sub Option4_Click(index As Integer)
   Select Case index
     Case 0
       grid = 10
     Case 1
       grid = 8
     Case 2
       grid = 4
     Case 3
       grid = 2
     Case 4
       grid = 1
   End Select

   xgrid = xspan / (9 * grid)
   ygrid = yspan / (6 * grid)
   If Check3.Value = 1 Then
     PicMain.Cls
     refreshtoolpath
   End If
End Sub

Private Sub ClearSession_Click()
   ClearMe

End Sub

Private Sub Redraw_Click()
   PicMain.Cls
   refreshtoolpath
End Sub

Private Sub PicMain_Paint()
   refreshtoolpath
End Sub

Private Sub PicMain_mousemove(Button As Integer, Shift As Integer, x
As Single, y As Single)

If Camera_on.Value = 1 Then Exit Sub 'send out, do not write on picture


'ADDED RUBBERBANDING ROUTINE AND DELTA/VECTOR TRACKING, GRIDSNAP RLP
   PicMain.DrawStyle = 2     'dottedline
   If Not beenhere Then
     beenhere = True
   Else
     PicMain.Line (CurrentX, CurrentY)-(old_X, old_Y), PicMain.BackColor
     PicMain.Circle (CurrentX, CurrentY), cutter_size, PicMain.BackColor
   End If

   Dim intX, intY As Integer
   Dim snapX, snapY, xdif, ydif, xhysteresis, yhysteresis, dx, dy As Single
   Dim xlo, ylo, xhi, yhi, xmid, ymid As Single
   Dim tmpv1, tmpv2, vec1, ang1, ang2, tangent As Double
   Dim vecstring As String

   If gridON Then
     If gridsnap Then
       snapX = x / xgrid
       snapY = y / ygrid
       intX = Int(snapX)
       intY = Int(snapY)

       xlo = (intX - 1) * xgrid
       xhi = (intX + 1) * xgrid
       xmid = intX * xgrid
       ylo = (intY + 1) * ygrid
       yhi = (intY - 1) * ygrid
       ymid = intY * ygrid

       xhysteresis = xgrid / 2
       yhysteresis = ygrid / 2

       xdif = snapX - CSng(intX)
       ydif = snapY - CSng(intY)

       If x > (xmid + xhysteresis) Then
         x = xhi
       Else
         If x < (xmid - xhysteresis) Then
           x = xlo
         Else
           x = xmid
         End If
       End If

       If y > (ymid + yhysteresis) Then
         y = ylo
       Else
         If y < (ymid - yhysteresis) Then
           y = yhi
         Else
           y = ymid
         End If
       End If
     End If
   End If

   PicMain.Line (x, y)-(old_X, old_Y), RGB_RED
   PicMain.Circle (x, y), cutter_size, RGB_RED
   PicMain.DrawStyle = 0  'back to solid
   refreshtoolpath

   dx = (x - old_X) / xscreen
   dy = -(y - old_Y) / Yscreen   'negate to measure angles CCW per pic
display
   'do quadrant rotations to keep angle directions in sync with xy
coordinate changes
   If (Abs(dx) < 0.0000001) Then
     If (Abs(dy) < 0.0000001) Then
       ang1 = dblzero
     ElseIf (dy < 0#) Then
       ang1 = threepio2
     Else
       ang1 = pio2
     End If
   Else
     tangent = dy / dx
     ang1 = Atn(tangent)
     If (dx < 0) Then
       ang1 = ang1 + pi
     Else
       If (dy < 0#) Then
         ang1 = twopi + ang1
       End If
     End If
   End If
   ang2 = ang1 * rtd   'cvrt degrees
   vecstring = " <" & Format(ang2, "##.000")
   tmpv1 = mkdbl * dx
   tmpv2 = mkdbl * dy
   vec1 = Sqr((tmpv1 * tmpv1) + (tmpv2 * tmpv2))
   vecstring = Format(vec1, "##.000") & vecstring
   Text12.Text = vecstring
   Text13.Text = Format(dx, "##.000")
   Text14.Text = Format(dy, "##.000")
'ADDED RUBBERBANDING ROUTINE AND DELTA/VECTOR TRACKING, GRIDSNAP RLP


'Text7.Text = PicMain.Point(X, Y)
   CurrentX = x
   CurrentY = y
   gcode = "G01"
   Text1.Text = Format(x / xscreen, "##.000")
'Text2.Text = Format(6 - y / Yscreen, "##.000")
   Text2.Text = Format((yspan - y) / Yscreen, "##.000")
End Sub

Private Sub PicMain_mousedown(Button As Integer, Shift As Integer, x
As Single, y As Single)
'bot left is 0,0 top right should be.. 9,6 inches
If Camera_on.Value = 1 Then Exit Sub 'do not print on screen..
   Dim Line_color As Integer
   Dim polylines As Integer  'counter

   If gridON Then
     If gridsnap Then
       x = CurrentX
       y = CurrentY
     End If
   End If

   If VScroll1.Value = 4000 Then
     gcode = "G00 "
   Else
     gcode = "G01 "
   End If
'If x > 720 And y > 840 Then 'if inside box on screen
   Text1.Text = Format(x / xscreen, "##.000")
   'Text2.Text = Format(6 - (y / Yscreen), "##.000")
   Text2.Text = Format((yspan - y) / Yscreen, "##.000")
   If Button = 1 Then
     frmeditor.Myeditor.SelText = gcode & "X" & Text1.Text & "Y" &
Text2.Text & Text10.Text & Chr$(13)
     frmeditor.Myeditor.SelText = ""
   If Check4.Value > 0 Then
             gcode = "G00"
             'top=VScroll1.Value / 1000
             'frmeditor.Myeditor.SelText = gcode & "X" & Text17.Text &
"Y" & Text18.Text & "Z" & VScroll1.Value / 1000 & Chr$(13)
              'frmeditor.Myeditor.SelText = ""
               'bot = VScroll2.value/1000
               gcode = "G01"
              frmeditor.Myeditor.SelText = gcode & "X" & Text1.Text &
"Y" & Text2.Text & "Z" & VScroll2.Value / 1000 & "F" & VScroll3.Value
& Chr$(13)
              frmeditor.Myeditor.SelText = ""
              gcode = "G00"
              frmeditor.Myeditor.SelText = gcode & "X" & Text1.Text &
"Y" & Text2.Text & "Z" & VScroll1.Value / 1000 & Chr$(13)
              frmeditor.Myeditor.SelText = ""
      End If

     PicMain.Line (x, y)-(old_X, old_Y), RGB_RED
     PicMain.Circle (x, y), cutter_size, RGB_RED

     If VScroll1.Value <> oldscroll1 Then
       Text8.Text = VScroll1.Value / 1000 'sets the text box
       oldscroll1 = VScroll1.Value   'loads the variable
     End If
     If VScroll2.Value <> oldscroll2 Then
       Text9.Text = VScroll2.Value / 1000 'sets the text box
       oldscroll2 = VScroll2.Value   'loads the variable
     End If
     If VScroll3.Value <> oldscroll3 Then
       Text10.Text = " F" & VScroll3.Value 'sets the text box
       oldscroll3 = VScroll3.Value   'loads the variable
     End If
     If seq_cut = True Then
       sequential_cut
     End If
     marker = False
   Else
     marker = True
   End If
'TRACK PATH  RLP
   polylines = UBound(polyset) + 1
  ' PicMain.Print polylines
   ReDim Preserve polyset(polylines)
   polyset(polylines).x = x
   polyset(polylines).y = y
   polyset(polylines).cutrad = cutter_size
   polyset(polylines).marker = marker

'TRACK PATH  RLP

   old_X = x
   old_Y = y
   Text4.Text = Text1.Text 'sets the old line to the new line after move
   Text5.Text = Text2.Text

End Sub

Private Sub refreshtoolpath()
'REFRESH PIC DISPLAY FOR OVERDRAWING RUBBERBAND AND REGAIN FOCUS
   Dim i As Integer, polytop As Integer
   If Check3.Value = 1 Then
     grid_display
   End If
   polytop = UBound(polyset)
   If polytop > 0 Then
     For i = 0 To polytop - 1
       PicMain.Line (polyset(i).x, polyset(i).y)-(polyset(i + 1).x,
polyset(i + 1).y), RGB_RED
     Next
     For i = 1 To polytop
       If Not polyset(i).marker Then
         PicMain.Circle (polyset(i).x, polyset(i).y),
polyset(i).cutrad, RGB_RED
       Else
         PicMain.Circle (polyset(i).x, polyset(i).y), marksize, markcolor
       End If
         PicMain.CurrentX = polyset(i).x
         PicMain.CurrentY = polyset(i).y
         PicMain.Print i
     Next
   End If
End Sub

Private Sub sequential_cut()


   Dim dirc As Single
   Dim flag_1 As Single
   Dim flag_2 As Single
   Dim ig As Single
   dirc = Val(Text11.Text)

  '********************************* check 3 sub.. Z move*******
   z1var = VScroll1.Value / 1000
   z2var = VScroll2.Value / 1000
   z3var = z1var
  'initilize variables
   Text3.Text = z1var
   Text6.Text = z2var
  '
   flag_1 = 1
   flag_2 = 1
   While z3var <> z2var And ig < 500
     ig = ig + 1
    'check to see if partial increment add
     If z2var > z3var And z2var < z3var + dirc Then
       i = z2var - z3var
       z3var = z3var + i
     End If
    'check to see if partia increment subtract
     If z2var < z3var And z2var > z3var - dirc Then
       i = z3var - z2var
       z3var = z3var - i
     End If
      'check to see if add increment
     If z2var >= z3var + dirc Then z3var = z3var + dirc
     'check to see if increment subtract
     If z2var <= z3var - dirc Then z3var = z3var - dirc
' dump text to editor page
     If flag_1 = 1 And flag_2 = 1 Then
       frmeditor.Myeditor.SelText = gcode & "X" & Text1.Text & "Y" &
Text2.Text & "Z" & z3var & Text10.Text & Chr$(13) ' get the data from
the list.
       frmeditor.Myeditor.SelText = ""
       flag_1 = 0
       flag_2 = 0
     End If
     If flag_1 = 0 And flag_2 = 1 Then
       frmeditor.Myeditor.SelText = gcode & "Z" & z3var & Text10.Text &
Chr$(13)
       frmeditor.Myeditor.SelText = ""
       frmeditor.Myeditor.SelText = gcode & "X" & Text4.Text & "Y" &
Text5.Text & Text10.Text & Chr$(13)   ' get the data from the list.
       frmeditor.Myeditor.SelText = ""
       flag_1 = 1
       flag_2 = 0
     End If
' flag_1 set to exitloop
     flag_2 = 1
   Wend     'end calc loop
  'send the Z back up to top loc...
   frmeditor.Myeditor.SelText = gcode & "Z" & z1var & Text10.Text &
Chr$(13)
   frmeditor.Myeditor.SelText = ""
End Sub
' add code to step through z down according to upper.. lower

Private Sub label20_Click()
   If seq_cut = False Then
'sequential_cut 'steps of G77 code, canned cycles

     Label20.BackColor = &H80C0FF   'swon
   Else
     Label20.BackColor = swoff
   End If
   seq_cut = Not seq_cut
   VScroll2.Visible = seq_cut
End Sub

Private Sub PutComment_MouseDown(Button As Integer, Shift As Integer,
x As Single, y As Single)
   BtnDn
End Sub

Private Sub BtnDn()
   Line1.BorderColor = &H404040
   Line1.Refresh
   Line2.BorderColor = &HE0E0E0
   Line2.Refresh
   Line3.BorderColor = &HE0E0E0
   Line3.Refresh
   Line4.BorderColor = &H404040
   Line4.Refresh
   PutComment.BackColor = &HFFC0C0
   PutComment.ForeColor = &H80FF&
   PutComment.Refresh
End Sub

Private Sub BtnUp()
   Line1.BorderColor = &HC0E0FF
   Line1.Refresh
   Line2.BorderColor = &H404040
   Line2.Refresh
   Line3.BorderColor = &H404040
   Line3.Refresh
   Line4.BorderColor = &HC0E0FF
   Line4.Refresh
   PutComment.BackColor = &HFFC0FF
   PutComment.ForeColor = &H80000008
   PutComment.Refresh
End Sub

Private Sub PutComment_MouseUp(Button As Integer, Shift As Integer, x
As Single, y As Single)
   frmeditor.Myeditor.SelText = "(" & Text7.Text & ")" & Chr$(13)
   frmeditor.Myeditor.SelText = ""
   BtnUp
End Sub

Private Sub VScroll1_Change()
   Text8.Text = VScroll1.Value / 1000
   Text3.Text = Text8.Text
   If VScroll1.Value < VScroll2.Value Then
     VScroll1.Visible = False
     VScroll1.Value = VScroll2.Value
     Beep
   End If

   VScroll1.Visible = True

End Sub

Private Sub VScroll2_Change()
   Text9.Text = VScroll2 / 1000
   Text6.Text = Text9.Text
End Sub

Private Sub VScroll3_Change()

   Feed_rate = VScroll3.Value
   Text10.Text = " F" & VScroll3.Value
End Sub
Private Sub Check1_Click()
   Check1.Value = False

End Sub

Private Sub Check3_Click()
   If Check3.Value = 1 Then
     gridON = True
     grid_display
   Else
     gridON = False
     PicMain.Cls
     refreshtoolpath
   End If
End Sub

Private Sub Option3_Click(index As Integer)
   Dim tmp As Single, sTmp As String

   tmp = xscreen / 2
   Select Case index
     Case 0
       cutter_size = tmp * 0.125
       sTmp = "1/8"
     Case 1
       cutter_size = tmp * 0.25
       sTmp = "1/4"
     Case 2
       cutter_size = tmp * 0.375
       sTmp = "3/8"
     Case 3
       cutter_size = tmp * 0.5
       sTmp = "1/2"
     Case 4
       cutter_size = tmp * 0.625
       sTmp = "5/8"
     Case 5
       cutter_size = tmp * 0.75
       sTmp = "3/4"
     Case 6
       cutter_size = tmp * 0.875
       sTmp = "7/8"
     Case 7
       cutter_size = tmp * 1#
       sTmp = "1"
   End Select
   frmeditor.Myeditor.SelText = "M06" & "(" & sTmp & Chr$(13)  'pause
program
   frmeditor.Myeditor.SelText = ""
End Sub

Private Sub codeedit_Click()  ' quit button exits screen
   Unload Graphical
   frmeditor.Show
End Sub
Private Sub loadgcode_Click() 'load dxf sub... shows files
   Drive1.Visible = True
   File1.Visible = True
   Dir1.Visible = True
   PicMain.Visible = False
End Sub

Private Sub Dir1_Change()
   File1.Path = Dir1.Path
   PicMain.Visible = False
End Sub

Private Sub Drive1_Change()
   Dir1.Path = Drive1.Drive
   PicMain.Visible = False
End Sub

Private Sub File1_Click()
   Dim File_name As String
   Dim b$
   Dim t As Single
   Dim Data_string As String
   Dim Lt As Integer
   Dim maxnumlines As Integer
   Dim dx1pos As Single
   Dim dx2pos As Single
   Dim dy1pos As Single
   Dim dy2pos As Single
   Dim Xstart As Integer
   Dim Ystart As Integer
   Dim Zstart As Integer
   Dim flag1 As Integer
   Dim lin$(20)
   Dim temp1 As Single
   Dim dx_1 As Single
   Dim dx_2 As Single
   Dim dy_1 As Single
   Dim dy_2 As Single
   Drive1.Visible = False
   File1.Visible = False
   Dir1.Visible = False
   PicMain.Visible = True

   File_name = File1.Path & "\" & File1.filename
   frmeditor.Myeditor.SelText = "(" & File_name & ".txt" & Chr$(13)
   frmeditor.Myeditor.SelText = ""
   Open File_name For Input As #1
   While Not EOF(1)
     Line Input #1, Data_string
     Lt = Lt + 1

decipher:
     '*****************////**************
  ' pick out the first GCode start action.

     Xstart = 0
     Ystart = 0
     Zstart = 0

     For word_pos = 1 To Len(Data_string)
       ' pick the "X" out to start the first word.
       If Mid$(Data_string, word_pos, 1) = "X" Then
         Xstart = word_pos
       End If
       ' pick the Y out to start second word.
       If Mid$(Data_string, word_pos, 1) = "Y" Then
         Ystart = word_pos
       End If
       ' pick the Z out to start the third word
       If Mid$(Data_string, word_pos, 1) = "Z" Then
         Zstart = word_pos
       End If
     Next word_pos
    'get numbers out of the array after found word lengths
     If Xstart > 0 And Ystart > 0 Then
       dx1pos = Val(Mid$(Data_string, Xstart + 1, (Ystart - Xstart) - 1))
       If Zstart > 0 Then
         dy1pos = Val(Mid$(Data_string, Ystart + 1, (Zstart - Ystart) - 1))
       End If
       If Zstart < 0 Then
         dy1pos = Val(Right$(Data_string, Len(Data_string) - Ystart) - 1)
       End If
       dx_1 = (dx1pos * xscreen) '+ xoffset
       dy_1 = Yscreen_max - (dy1pos * Yscreen)
      'PicMain.AutoRedraw = True
       PicMain.Line -(dx_1, dy_1), RGB_BLUE
       frmeditor.Myeditor.SelText = "(dxf " & Data_string & Chr$(13)
       frmeditor.Myeditor.SelText = ""
     End If
pass_over:
   Wend
   Close #1
End Sub
Private Sub delay_motor_stall()
   Dim time_out As Single
   Dim delayinMilliseconds
   'delayinMilliseconds = Slider1.Value
   '   ding
   time_out = delayinMilliseconds + timeGetTime()
   Do Until time_out <= timeGetTime()
     Text8.Text = delayinMilliseconds
   Loop
End Sub

Private Sub tool_path()
'***********************----
   Dim XA As Single
   Dim YA As Single
   Dim X_start As Single
   Dim Y_start As Single
   Dim X_finish As Single
   Dim Y_finish As Single
   Dim dirc As Single
   X_start = 0
   Y_start = 5000

   X_finish = 600
   Y_finish = 5000 + cutter_size

'read the first cut.. position cutter at 0,0
   For YA = Y_start To Y_finish
     For XA = X_start To X_finish
       ProgressBar1.Value = XA
       '
       If Val(PicMain.Point(XA, YA)) = RGB_BLUE + 3 Then ' the drawing..
         PicMain.PSet (XA, YA), FillColor
       End If
     Next
     PicMain.PSet (XA, YA), FillColor
   Next
End Sub

'camera program section added in, incorporated...
'************************************************
'////////////////////////////////////////////////
Private Sub Camera_on_Click()
   ' toggle on, off..
Timer1.Enabled = True
Timer1.Interval = Slider1.Value
Text19.Text = Slider1.Value & " Msec update"
VideoPortal1.Visible = True
If Camera_on.Value = 1 Then
Camera_on.BackColor = RGB_GREEN
Camera_on.Caption = "camera off"
Timer1.Enabled = True
Else
Camera_on.BackColor = RGB_RED
Camera_on.Caption = "Camera on"
Timer1.Enabled = False
End If
End Sub

Private Sub Timer1_Timer() 'record to bmp file
Snapshot   ' grab picture subroutine.
  End Sub
Private Sub Snapshot()
     Camera_on.BackColor = RGB_BLUE
     StrFileSave.Caption = ""
     VideoPortal1.PictureToFile 0, 24, "c:\temp.bmp", ""
     StrFileSave.Caption = "The image has been saved as c:\temp.bmp"
     PicMain.Picture = LoadPicture("c:\temp.bmp")
     If Crosshair_display.Value = 1 Then  ' must repaint the line.
       Crosshair_display_Click
     End If
     If Circle_display.Value = 1 Then
       Circle_display_Click
      End If
     Camera_on.BackColor = RGB_GREEN
End Sub


Private Sub EnumCams_Click()
     '* Enumerate all installed cameras and list in CamList listbox.
     Dim index As Long
     Dim count As Long
     VideoPortal1.GetCameraCount count
     'CamList.Clear
     'For index = 0 To count - 1
     '    VideoPortal1.GetCameraDescription index, Desc$
     '    CamList.AddItem Format$(index) + " " + Desc$, index
     'Next
End Sub

Private Sub LEDoff_Click()
     VideoPortal1.SetCameraPropertyLong PROPERTY_LED, 0
End Sub

Private Sub LEDon_Click()
     VideoPortal1.SetCameraPropertyLong PROPERTY_LED, 1
End Sub

Private Function MakeFOURCC(str$) As Long
     Dim fcc As Long
     For i = 0 To 3
         fcc = fcc * 256 + Asc(Mid$(str$, 4 - i, 1))
     Next i
     MakeFOURCC = fcc
End Function

Private Sub SetIndeoCodec_Click()
     VideoPortal1.MovieVideoCompressionFOURCC = MakeFOURCC("IV50")
End Sub

Private Sub SetNullCodec_Click()
     VideoPortal1.MovieVideoCompressionFOURCC = 0
End Sub

Private Sub Slider1_Click()
Timer1.Interval = Slider1.Value
Text19.Text = Slider1.Value & " msec update"

End Sub

Private Sub SnapOverlay_Click()
     Dim Text As String, filename As String
     StrFileSave.Caption = ""
     Text = "Monday April 4, 2000"
     filename = "c:\image_test_overlay.bmp"
     VideoPortal1.StampFontName = "Arial"
     VideoPortal1.StampPointSize = 20
     VideoPortal1.StampTextShadow = False
     VideoPortal1.StampTransparentBackground = True

     VideoPortal1.PictureToFile 0, 24, filename, Text
     StrFileSave.Caption = "The image has been saved as
c:\image_test_overlay.bmp"
End Sub



Private Sub StartAnimation_Click()
     Dim MovieFile As String
     StrFileSave.Caption = ""
     MovieFile = "c:\sample_stepcapture.avi"

     '* Select the manual triggered recording mode:
     VideoPortal1.MovieRecordMode = STEPCAPTURE_MANUALTRIGGERED

     '* Specify the playback rate for this movie - 15 FPS:
     VideoPortal1.MoviePlaybackFPS = 15

     '* Doesn't make sense to record audio in this mode:
     VideoPortal1.MovieRecordAudio = False

     VideoPortal1.StartMovieRecording MovieFile, ""
End Sub

Private Sub AppendFrame_Click()
     If VideoPortal1.StepCaptureAddFrame Then
         'strFileSave.Caption = "Added Frame"
     End If
End Sub

Private Sub EndAnimation_Click()
     VideoPortal1.StopMovieRecording
     StrFileSave.Caption = "The animation has been saved as
c:\sample_stepcapture.avi"
End Sub

Private Sub StartRecording_Click()
     Dim MovieFile As String
     StrFileSave.Caption = ""
     MovieFile = "c:\sample_movie_1.avi"
     VideoPortal1.StartMovieRecording MovieFile, ""
End Sub

Private Sub StopRecording_Click()
     StrFileSave.Caption = "The movie has been saved as
c:\sample_movie_1.avi"
     VideoPortal1.StopMovieRecording
End Sub


Private Sub TextColor_Click()
     '* Get the current video text overlay color
    ' CommonDialog.Color = VideoPortal1.StampTextColor
     '* Display the color-chooser dialog
    ' CommonDialog.ShowColor
     '* Set the video text overlay color
    ' VideoPortal1.StampTextColor = CommonDialog.Color
End Sub



Private Sub VideoPortal1_PortalNotification(ByVal lMsg As Long, ByVal
lParam1 As Long, ByVal lParam2 As Long, ByVal lParam3 As Long)
     Debug.Print "portal notification: lMsg="; lMsg; ", lParam1="; lParam1
End Sub

Private Sub Wizards_Click()
If Wizards.Value = 1 Then
  Frame7.Visible = True
  Else
  Frame7.Visible = False
  End If
End Sub

[url]http://cgi.ebay.com/ws/eBayISAPI.dll?ViewItem&item=7587699732&rd=1&sspagena\
me=STRK%3AMEWN%3AIT&rd=1[/url]

The HeNe laser I got coming off ebay. I think I got a good deal at
$10. THou it is not here yet. In the hands of USPS. The beam should be
much tighter than the led laser.

THe one I was using was a lasertrac from sears, cut apart and the
laser diodes and waffle lens mounted at 90 degree angles to each
other, normally they throw a crosshairs for a drill press. At $39.99 I
thought it was "the ticket" for my project. I could not get a laser
diode and waffle lens for that.

One bite at a time, don't get impaitient.

The 8255 dll.. it is for input output of a specific address.
I was using it to read/write to the parallel ports.

THe Mscomm.ocx driver is included in vb6 enterprise edition. Not sure
why it did not get compiled into it.??  This is for reading the
chinese scales through the 232 port. I understood it was included when
you distributed the program.

The Vportal2 is the logitech driver for the camera. It was included in
the sdk for the camera. I'll upload it also. Not sure about the
distribution rights, It is no longer on the logitech site. A very old
tool kit.
The Ray Henry EzVideo works too, it is more geared around running a
bot and avi files. I had it crash my pc a couple times.

I'll upload them to the files section.. Not sure if they need to be in
with the windows dll files in the windows section ..

seems I address them by calling C:\windows\*.dll

I'll upload them. I need to get the raw code uploaded too.

NEXT?

I'm running XP SP2 and get COMCTL32.OCX is missing or not registered
properly.

-Mike

I had the following two errors.  Windows 2000 SP4 if that matters.

On clicking "GRAPHICAL"
Run-time error '339'
VPORTAL2.DLL missing invalid

On Clicking "DRO"
Run-time error '339'
MSCOMM32.ocx missing or invalid

--- In CheapAss@yahoogroups.com, "ibewgypsie" <ibewgypsie@...> wrote:
>
> Howdy..
>
>  I need to know what all dlls are needed to make this work on
> everyone's computer. I do not have a packaging software for it to make
> and install.
>
>  Please download the exe machinists version and make a note on any
> errors. it will not load the webcam driver till you click the box.
>
>   I will be uploading all the source code here in a bit.
>
> Thanks
>

Howdy..

  I need to know what all dlls are needed to make this work on
everyone's computer. I do not have a packaging software for it to make
and install.

  Please download the exe machinists version and make a note on any
errors. it will not load the webcam driver till you click the box.

   I will be uploading all the source code here in a bit.

Thanks

Hi..

   Open discussion, what do we need next? I am working on the code to
scan. here it is in part.


Private Sub scan_for_laser()
  'search across top line looking for laser color
  'then when line is found, calculate angle according to pixel offset
from edge
  'then walk up,down from point and find left-most point of laser color
on connecting pixel
  'write laser pixels using triangulation into a point cloud file on editor


Declarations to make this work:
  Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _
     ByVal x As Long, ByVal y As Long) As Long 'this subroutine gets 3
hex numbers related to the dot.
Private Declare Function GetCursorPos Lib "User32" (lpPoint As
POINTAPI) As Long 'reads windows loc of cursor
Private Declare Function GetWindowDC Lib "User32" (ByVal hWnd As Long)
As Long 'actuallY I don't remember what this does.


  Dim tPOS As POINTAPI
     Dim sTmp As String
     Dim lColor As Long
     Dim lDC As Long
     Dim xctr As Single
     Dim yctr As Single
     Dim x_loop As Single
     Dim y_loop As Single
     Dim gridtrack As Single
     Dim oldcolor
   'first locate the variables for screen picture size to scan.
   'laser color point picked previously by setup.

     gridtrack = 0
     xctr = PicMain.ScaleWidth / 2
     yctr = PicMain.ScaleHeight / 2
     xspan = PicMain.ScaleWidth
     yspan = PicMain.ScaleHeight
   'scan picture from left to max value, top to bottom using a for/next
loop
   For x_loop = 0 To xspan
    For y_loop = 0 To yspan
     lDC = GetWindowDC(0)
     Call GetCursorPos(tPOS)
     lColor = GetPixel(lDC, tPOS.x, tPOS.y)
   '  Label2.BackColor = lColor
     sTmp = Right$("000000" & Hex(lColor), 6)
     Caption = "X" & tPOS.x & " Y" & tPOS.y & " R:" & Right$(sTmp, 2) &
" G:" & Mid$(sTmp, 3, 2) & " B:" & Left$(sTmp, 2)
     'check pixel against laser color
     'figure in the angle by known camera to laser distance, camera
angle trig.
     'write it to the editor in a point cloud format.
     'first the red
     'ProgressBar1.Value = Val("&h" & Right$(sTmp, 2))
     'Text3.Text = Val("&h" & Right$(sTmp, 2))
     'then the green
     'ProgressBar2.Value = Val("&h" & Mid$(sTmp, 3, 2))
     'Text4.Text = Val("&h" & Mid$(sTmp, 3, 2))
     'then the blue
     'ProgressBar3.Value = Val("&h" & Left$(sTmp, 2))
     'Text5.Text = Val("&h" & Left$(sTmp, 2))
    'now the check against the previously mouse picked laser color.

    Next y_loop
    Next x_loop

End Sub


'when I get the laser point picked by mouse, the laser color spectrum
is fixed, the getpixel scans the camera saved picture for laser color
dots. Saves them to a point cloud file on the editor, then will
sendkey a move to the cnc, or illuminate a toolbar on screen so manual
move can be had to next scan point. Last time I tried a similar sub
with a led laser it got a lot of noise and stray pixels.

  this is unfinished subroutine. Just something to work on till someone
comes up with a cheap pic to translate the chinese scales to rs232 or
usb input for me to read.