PANTOGRAF 1.0 This software communication with pc and pic 16f series microchips.

by Sel?uk YUKSEL & Serdar YUKSEL (1 Submission)
Category: Custom Controls/Forms/Menus
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 2^nd August 2009
Date Added: Mon 8^th February 2021
Rating: (1 Votes)
API Declarations
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Dim f1 As String * 5 Dim f2 As String * 5 Copyright Selçuk & Serdar YÜKSEL
Rate PANTOGRAF 1.0 This software communication with pc and pic 16f series microchips.



End Sub

Private Sub Command1_Click()
Timer1.Enabled = True
MSComm1.Output = "H" 'yatay hareketi ba&#351;lat&#305;r
Timer4.Enabled = True
Timer6.Enabled = True
Timer7.Enabled = True
End Sub

Private Sub Command10_Click()
On Error Resume Next

Kill "C:\sondata.txt"
End Sub

Private Sub Command11_Click()
Text7.Text = 0
Text9.Text = 0
Text10.Text = 0
Text11.Text = 0

End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
Timer4.Enabled = False
Timer6.Enabled = False
Timer7.Enabled = False
End Sub

Private Sub Command3_Click()
MSComm1.Output = "G"
End Sub

Private Sub Command4_Click()
MSComm1.Output = "Y"
End Sub

Private Sub Command5_Click()

MSComm1.Output = "H"
Timer2.Enabled = True

End Sub


Private Sub Command6_Click()
MSComm1.Output = "J"
Timer3.Enabled = True
End Sub

Private Sub Command7_Click()
If Val(Text1) < 1 Then MsgBox ("!!!  ÖNCE RES&#304;M YÜKLEMEL&#304;S&#304;N .. &#351;imdi tamam dü&#287;mesine bas ve ard&#305;ndan resmi yükle.. sonra ne yapacaksan yap.. !!!")

If Val(Text1) < 1 Then

On Error GoTo error:

    With cde
        .DialogTitle = "Open Picture"
        .Filter = "Pictures (*.Bmp *.Jpg *.Gif)|*.bmp; *.jpg; *.gif"
        .ShowOpen
        Picture1.Picture = LoadPicture(cde.FileName)
        Text1.Text = Picture1.Width - 5
        Text2.Text = Picture1.Height - 5
        Label14.Caption = cde.FileTitle
        Label15.Caption = cde.FileName
        Picture2.Width = Val(Text1) + 10
        Picture2.Height = Val(Text2) + 10
        
        
    End With
    Exit Sub
error:
    Err.Clear


If Val(Text1) < 1 Then Exit Sub


End If






Timer5.Enabled = True
End Sub

Private Sub Command8_Click()
Timer5.Enabled = False
End Sub

Private Sub Command9_Click()
On Error Resume Next

Dim t
Open "C:\sondata.txt" For Input As #1
Do
Line Input #1, ad 'dosyadan bir sat&#305;r oku
t = "yatay   dikey " & Chr(13) & Chr(10) & ad 'sat&#305;r ba&#351;&#305; yaparak öncekine ekle
Loop While Not EOF(1)
Text6 = t
Close #1




End Sub

Private Sub dikeygeri_Click()
MSComm1.Output = "Y"
End Sub

Private Sub Dosya_Ac_Click()
On Error GoTo error:

    With cde
        .DialogTitle = "Open Picture"
        .Filter = "Pictures (*.Bmp *.Jpg *.Gif)|*.bmp; *.jpg; *.gif"
        .ShowOpen
        Picture1.Picture = LoadPicture(cde.FileName)
        Text1.Text = Picture1.Width - 5
        Text2.Text = Picture1.Height - 5
        Label14.Caption = cde.FileTitle
        Label15.Caption = cde.FileName
        Picture2.Width = Val(Text1) + 10
        Picture2.Height = Val(Text2) + 10
        
        
    End With
    Exit Sub
error:
    Err.Clear


End Sub

Private Sub form_load()
On Error Resume Next

pixel = 3
    Form1.ScaleMode = pixel
    Picture1.ScaleMode = pixel
    Picture2.ScaleMode = pixel
MSComm1.Settings = "2400,N,8,1"
MSComm1.PortOpen = True
On Error Resume Next



End Sub

Private Function serialgonder()

If Val(Text8) = 0 Then
MSComm1.Output = "a"
Text3 = "a"
End If

If Val(Text8) = 1 Then
MSComm1.Output = "b"
Text3 = "b"
End If

If Val(Text8) = 2 Then
MSComm1.Output = "c"
Text3 = "c"
End If

If Val(Text8) = 3 Then
MSComm1.Output = "d"
Text3 = "d"
End If

If Val(Text8) = 4 Then
MSComm1.Output = "e"
Text3 = "e"
End If

If Val(Text8) = 5 Then
MSComm1.Output = "f"
Text3 = "f"
End If

If Val(Text8) = 6 Then
MSComm1.Output = "g"
Text3 = "g"
End If

If Val(Text8) = 7 Then
MSComm1.Output = "h"
Text3 = "h"
End If

If Val(Text8) = 8 Then
MSComm1.Output = "i"
Text3 = "i"
End If

If Val(Text8) = 9 Then
MSComm1.Output = "j"
Text3 = "j"
End If

If Val(Text8) = 10 Then
MSComm1.Output = "k"
Text3 = "k"
End If

If Val(Text8) = 11 Then
MSComm1.Output = "l"
Text3 = "l"
End If

If Val(Text8) = 12 Then
MSComm1.Output = "m"
Text3 = "m"
End If

If Val(Text8) = 13 Then
MSComm1.Output = "n"
Text3 = "n"
End If

If Val(Text8) = 14 Then
MSComm1.Output = "o"
Text3 = "o"
End If

If Val(Text8) = 15 Then
MSComm1.Output = "p"
Text3 = "p"
End If

If Val(Text8) = 16 Then
MSComm1.Output = "r"
Text3 = "r"
End If

If Val(Text8) = 17 Then
MSComm1.Output = "x"
Text3 = "x"
End If





End Function


Private Function piksel()

Dim x, y As Single
Dim Button, Shift As Integer
x = Val(h)
y = Val(v)
    
    ix = CLng(x)
    iy = CLng(y)
    Text8.Text = Round(Val(16777215 - Abs(GetPixel(Picture1.hdc, ix, iy))) / 1000000)
End Function

Private Sub vk_Change()

End Sub

Private Sub Picture3_Click()

End Sub

Private Sub MSRDC1_Validate(Action As Integer, Reserved As Integer)

End Sub




Private Sub Label16_()
Label16.Caption = Slider1.Value
End Sub


Private Sub save_Click()
cde.ShowSave
SavePicture Picture2.Image, cde.FileName

End Sub

Private Sub ScriptControl1_Error()

End Sub

Private Sub Slider1_form_load()

End Sub

Private Sub Slider1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label16.Caption = Slider1.Value
End Sub



Private Sub Slider2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
msc.Text = Slider2.Value
End Sub

Private Sub start_Click()
Timer1.Enabled = True
MSComm1.Output = "H" 'yatay hareketi ba&#351;lat&#305;r
Timer4.Enabled = True
Timer6.Enabled = True
Timer7.Enabled = True
End Sub

Private Sub stop_Click()
Timer1.Enabled = False
Timer1.Enabled = False
Timer4.Enabled = False
Timer6.Enabled = False
Timer7.Enabled = False
End Sub

Private Sub telif_Click()
Dim bilgi, pant
bilgi = "Bu program Masa tipi,GRAVÜR OTOMATI -SSY PANTO- için yaz&#305;lm&#305;&#351; özel amaçl&#305; bir yaz&#305;l&#305;md&#305;r.. bütün haklar&#305; sakl&#305;d&#305;r.. ."

pant = MsgBox(bilgi + "                     Selcuk YÜKSEL  ---  Serdar YÜKSEL (Yüksek Biyolog)   ", 4 + 64, "bilgilendirme  ve  te&#351;ekkür")
If pant = vbYes Then MsgBox ("selcuk yuksel   -   serdar yuksel ")


If pant = vbNo Then MsgBox ("      selcuk yuksel    &    serdar yuksel   ")



End Sub


Private Sub teststart_Click()
If Val(Text1) < 1 Then MsgBox ("!!!  ÖNCE RES&#304;M YÜKLEMEL&#304;S&#304;N ..  &#351;imdi tamam dü&#287;mesine bas ve ard&#305;ndan resmi yükle.. sonra ne yapacaksan yap.. !!!")

If Val(Text1) < 1 Then

On Error GoTo error:

    With cde
        .DialogTitle = "Open Picture"
        .Filter = "Pictures (*.Bmp *.Jpg *.Gif)|*.bmp; *.jpg; *.gif"
        .ShowOpen
        Picture1.Picture = LoadPicture(cde.FileName)
        Text1.Text = Picture1.Width - 5
        Text2.Text = Picture1.Height - 5
        Label14.Caption = cde.FileTitle
        Label15.Caption = cde.FileName
        Picture2.Width = Val(Text1) + 10
        Picture2.Height = Val(Text2) + 10
        
        
    End With
    Exit Sub
error:
    Err.Clear


If Val(Text1) < 1 Then Exit Sub


End If

Timer5.Enabled = True
End Sub

Private Sub teststop_Click()
Timer5.Enabled = False
End Sub





Private Sub Text1_Validate(Cancel As Boolean)
If Val(Text1) < 0 Then

MsgBox ("resim yükle")
Cancel = True

End If
End Sub

Private Sub Timer1_Timer()
msc.Text = MSComm1.Input



If msc.Text = "W" Then 'e&#287;er yatay hareketten görev sonunda W gelirse
h.Text = h.Text + 1
Call piksel
Call serialgonder 'vurma kafas&#305;na veri gönder
Call resim
Call durum
End If
If msc.Text = "T" Then  'vurma kafas&#305; hareketi bitirir ve T gönderir
MSComm1.Output = "H" 'yatay harekete devam


End If
If h.Text = Text1.Text Then  ' e&#287;er sat&#305;r tamamlan&#305;rsa yani  h.Text = Text1.Text e e&#351;it olursa
h.Text = "0" 'sat&#305;r ba&#351;&#305;na dön
MSComm1.Output = "G" 'yatay motoru geri sarar
End If
If msc.Text = "Z" Then ' Z geri sar&#305;m&#305;n bitti&#287;ini söyler = switch kapan&#305;nca pic Z gönderir
MSComm1.Output = "J" ' J dikey motoru a&#351;a&#287;&#305; indirir

End If
If msc.Text = "Q" Then 'indirme i&#351;leminin bitti&#287;ini söyler
v.Text = v.Text + 1
MSComm1.Output = "H" 'yatay harekete devam

End If





If msc.Text = "D" Then 'indirme i&#351;leminin bitti&#287;ini söyler
Text5.Text = Text5.Text + 1
End If

If msc.Text = "S" Then 'VURMA KAFASI VURMA NOKTASINDA GÖNDER&#304;R VURU&#350; SAYISINI ÖLCMEDE KULLANILIR

MSComm1.Output = Label16.Caption
End If

If msc.Text = "0" Then

MSComm1.Output = "s"
Text11 = "s"
End If


If v.Text = Text2.Text Then
Timer1.Enabled = False
End If





End Sub
Private Function resim()
Picture2.DrawWidth = 3
Picture2.DrawMode = 13
Picture2.Line (h.Text, v.Text)-(h.Text, v.Text), 16777215 - Val(Text8) * 1000000

End Function


Private Sub Timer2_Timer()
Text4.Text = MSComm1.Input
If Text4.Text = "W" Then
yatay.Text = yatay.Text - 1

MSComm1.Output = "H"
End If
If Val(yatay) = 1 Then
Timer2.Enabled = False
End If

End Sub

Private Sub Timer3_Timer()
Text4.Text = MSComm1.Input
If Text4.Text = "Q" Then
dikey.Text = dikey.Text - 1

MSComm1.Output = "J"
End If
If Val(dikey) = 1 Then
Timer3.Enabled = False
End If

End Sub



Private Function deneme()
If Val(Text8) = 0 Then
test.Text = "a"

End If

If Val(Text8) = 1 Then
test.Text = "b"

End If

If Val(Text8) = 2 Then
test.Text = "c"

End If

If Val(Text8) = 3 Then
test.Text = "d"

End If

If Val(Text8) = 4 Then
test.Text = "e"

End If

If Val(Text8) = 5 Then
test.Text = "f"

End If

If Val(Text8) = 6 Then
test.Text = "g"

End If

If Val(Text8) = 7 Then
test.Text = "h"

End If

If Val(Text8) = 8 Then
test.Text = "i"

End If

If Val(Text8) = 9 Then
test.Text = "j"

End If

If Val(Text8) = 10 Then
test.Text = "k"

End If

If Val(Text8) = 11 Then
test.Text = "l"

End If

If Val(Text8) = 12 Then
test.Text = "m"

End If

If Val(Text8) = 13 Then
test.Text = "n"

End If

If Val(Text8) = 14 Then
test.Text = "o"

End If

If Val(Text8) = 15 Then
test.Text = "p"

End If

If Val(Text8) = 16 Then
test.Text = "r"

End If

If Val(Text8) = 17 Then
test.Text = "x"

End If
End Function

Private Sub Timer4_Timer()
Text7.Text = Text7.Text + 1

Static x
x = Val(Text7)
If x Mod 61 = 60 Then
Text7.Text = 0
End If

If Val(Text7) = 0 Then
Text9 = Text9 + 1
End If

If Val(Text9) Mod 61 = 60 Then
Text9.Text = 0
End If
End Sub

Private Sub Timer5_Timer()




h.Text = h.Text + 1

Call piksel
Call deneme
Call resim
Call durum



If h.Text = Text1.Text - 4 Then
h.Text = "0"
v.Text = v.Text + 1
End If


If v.Text = Text2.Text Then
Timer5.Enabled = False
End If

End Sub

Private Function durum()
On Error Resume Next
Open "C:\sondata.txt" For Append As #1
f1 = h
f2 = v
Write #1, f1, f2
Close #1
End Function



Private Sub Timer6_Timer()
Text10.Text = Text10.Text + 1

Static x
x = Val(Text10)
If x Mod 61 = 60 Then
Text10.Text = 0
End If

End Sub

Private Sub Timer7_Timer()
Text11.Text = Text11.Text + 1

Static x
x = Val(Text11)
If x Mod 101 = 100 Then
Text11.Text = 0
End If
End Sub

Private Sub yataygeri_Click()
MSComm1.Output = "G"
End Sub
Download this snippet Add to My Saved Code
PANTOGRAF 1.0 This software communication with pc and pic 16f series microchips. Comments

No comments have been posted about PANTOGRAF 1.0 This software communication with pc and pic 16f series microchips.. Why not be the first to post a comment about PANTOGRAF 1.0 This software communication with pc and pic 16f series microchips..
PANTOGRAF 1.0 This software communication with pc and pic 16f series microchips.

PANTOGRAF 1.0 This software communication with pc and pic 16f series microchips. Comments

Post your comment

Difficulty
