Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: Qbasic Programm umschreiben nach VB6 Teil1
Autor: T.i.m.
Datum: 14.05.06 00:37
Hallo Seek1, vielleicht nicht gerade der beste Code, aber vielleicht kommst ja hiermit weiter?! Musst noch selbst die letzten 3 Rountinen anpassen Später wenn es soweit läuft, kannste das Programm auch besser aufbauen (kompl. neu designen). Setz das ganze in eine Form1 rein   it Public Sub Form_Load() 5 Rem Software Robomemm rev B 6 Rem change 18 to rbit=abit for rev A 7 Rem change 540 to abit for rev A 8 Rem change 560 to <> for rev A 10 Port = &H378 11 sport = &H379 12 cport = &H37A 13 ibit = &H4 14 sbit = &H1 15 bbit = &H80 16 abit = &H40 17 sbith = &HFE 18 rbit = bbit ' 19 Dim resp(64) Form1.Show Routine2000 ' 20 GoTo 2000 End Sub Private Sub Routine50() Dim k As Integer Dim a As Integer Dim j As Integer Dim Index As Integer Dim response As Long Dim Status As Integer 50 For k = 0 To 63 100 a = INP(cport) 110 OUT cport, (a Or ibit) And sbith 120 Routine6000 ' GoSub 6000 130 For j = 1 To 8 140 Routine7000 ' GoSub 7000 160 Next 170 Routine6000 ' GoSub 6000 180 Routine8000 ' GoSub 8000 200 Routine7000 ' GoSub 7000 300 Index = &H20 Do Until Index <> 0 ' 430 If Index <> 0 Then GoTo 310 310 If (k And Index) = 0 Then ' GoTo 400 Routine7000 ' 400 GoSub 7000 End If 320 Routine8000 ' GoSub 8000 ' 350 GoTo 420 ' 400 GoSub 7000 420 Index = Index \ 2 Loop ' 430 If Index <> 0 Then GoTo 310 450 response = 0 500 For Index = 0 To 15 510 Routine7000 ' GoSub 7000 530 response = response * 2 540 Status = (INP(sport) And rbit) 560 If Status = 0 Then ' GoTo 600 570 response = response + 1 End If 600 Next 604 resp(k) = response 610 Next 620 For k = 0 To 63 625 Print Chr$(resp(k) - ((resp(k) \ 256) * 256)); 630 Print Chr$(resp(k) \ 256); 660 Next 670 Print ' 700 Return End Sub Private Sub Routine1000() Dim a As Integer Dim j As Integer Dim k As Integer Dim Index As Long 1000 a = INP(cport) 1010 OUT cport, (a Or ibit) And sbith 1020 Routine6000 ' GoSub 6000 1030 Routine7000 ' GoSub 7000 1050 Routine7000 ' GoSub 7000 1070 Routine8000 ' GoSub 8000 1090 Routine8000 ' GoSub 8000 1110 For j = 1 To 15 1120 Routine7000 ' GoSub 7000 1140 Next 1200 For k = 0 To 63 1210 Routine6000 ' GoSub 6000 1220 Routine7000 ' GoSub 7000 1240 Routine8000 ' GoSub 8000 1260 Index = &H20 Do Until Index <> 0 ' 1340 If Index <> 0 Then GoTo 1270 1270 If (k And Index) = 0 Then ' GoTo 1310 Routine7000 ' 1310 Routine7000 ' GoSub 7000 End If 1280 Routine8000 ' GoSub 8000 ' 1300 Routine1330 ' GoTo 1330 ' 1310 Routine7000 ' GoSub 7000 1330 Index = Index \ 2 Loop ' 1340 If Index <> 0 Then GoTo 1270 1350 Index = 32768 Do Until Not 0 1360 If (resp(k) And Index) <> 0 Then ' If (resp(k) And Index) = 0 Then GoTo 1400 1370 Routine8000 ' GoSub 8000 ' 1390 GoTo 1430 Else 1400 Routine7000 ' GoSub 7000 End If 1430 Index = Index \ 2 Loop ' 1440 If Index <> 0 Then GoTo 1360 1450 OUT Port, &HFF 1460 SLEEP 1 1470 Next ' 1500 Return End Sub Private Sub Routine2000() Dim a As Integer 2000 Print "Bust a memmory options" 2010 Print "read = 0" 2020 Print "write = 1" 2025 Print "stop = 2" a = MsgBox("Sollen Daten geschrieben werden? falls NEIN, werden Daten eingelesen", vbQuestion & vbYesNoCancel, "Bitte wählen Sie folgende Möglichkeiten aus:") ' 2030 INPUT a 2040 If a = 7 Then Routine2100 2050 If a = 6 Then Routine2200 2060 If a = 2 Then Routine2300 2070 Routine2000 ' GoTo 2000 End Sub Private Sub Routine2100() 2100 Routine50 ' GoSub 50 2110 Routine2000 ' GoTo 2000 End Sub Private Sub Routine2200() 2200 Routine1000 ' GoSub 1000 2210 Routine2000 ' GoTo 2000 End Sub Private Sub Routine2300() 2300 End ' Stop Unload Me End Sub Private Sub Routine6000() 6000 OUT Port, &HFF 'clock high data high select off 6010 OUT Port, &HFC 'clock low data low select off 6020 OUT Port, &H5C 'select on 6030 OUT Port, &H5D 'clock high data low 6040 OUT Port, &H5E 'clock low data high 6050 OUT Port, &H5F 'clock high data high ' 6060 Return End Sub Private Sub Routine7000() 7000 OUT Port, &H5C 'clock low data low 7010 OUT Port, &H5D 'clock high data low ' 7020 Return End Sub Private Sub Routine8000() 8000 OUT Port, &H5E 'clock low data high 8010 OUT Port, &H5F 'clock high data high ' 8020 Return End Sub *greetz* Tim . http://www.DotNetWorld.de

Qbasic Programm umschreiben nach VB6	1.117	Seek1	11.05.06 12:06
Re: Qbasic Programm umschreiben nach VB6 Teil1	800	T.i.m.	14.05.06 00:37
Re: Qbasic Programm umschreiben nach VB6 Teil1	648	ProofP	14.05.06 14:17
Re: Qbasic Programm umschreiben nach VB6 Teil1	899	T.i.m.	14.05.06 15:12
Re: Qbasic Programm umschreiben nach VB6 Teil2	709	T.i.m.	14.05.06 00:38
Re: Qbasic Programm umschreiben nach VB6	625	Seek1	14.05.06 15:10
Re: Qbasic Programm umschreiben nach VB6	999	Seek1	17.05.06 17:31

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen