Selamat datang di ForSa! Forum diskusi seputar sains, teknologi dan pendidikan Indonesia.

Welcome to Forum Sains Indonesia. Please login or sign up.

Maret 29, 2024, 01:00:07 AM

Login with username, password and session length

Topik Baru

Artikel Sains

Anggota
Stats
  • Total Tulisan: 139,653
  • Total Topik: 10,405
  • Online today: 102
  • Online ever: 1,582
  • (Desember 22, 2022, 06:39:12 AM)
Pengguna Online
Users: 0
Guests: 96
Total: 96

Aku Cinta ForSa

ForSa on FB ForSa on Twitter

Contoh Script Program VB6

Dimulai oleh Ceevuik, Juli 16, 2010, 02:08:32 PM

« sebelumnya - berikutnya »

0 Anggota dan 1 Pengunjung sedang melihat topik ini.

Ceevuik

Forsa, ada yang ngerti VB 6 ga? Bantuin aq dunks, ada contoh program di bawah ini:

Private Sub Decode_string(Tmpstr As String)                                         ' Receive and decode data
  Dim StrLen As Long, i As Long
  Dim Rx As Byte
 
  Static toggle As Byte
 
  Static next_pulse As Boolean
  Static next_spo2 As Boolean
  Static next_status As Boolean
  Static next_quality As Boolean
  Static next_plethy As Boolean
 
  Dim pt
            '81   82   83   84   85   86   87   88   89   90   91   92   93   94   95   96    97    98    99    100
  pt = Array(440, 466, 494, 523, 554, 587, 622, 659, 698, 740, 784, 831, 880, 932, 988, 1046, 1109, 1175, 1244, 1328)
  Static frq As Byte
   
      StrLen = LenB(Tmpstr)
       
       For i = 1 To StrLen
         Rx = AscB(MidB(Tmpstr, i, 1))
       
                       
                       
        If next_quality Then                                                                    ' Receive Quality (not displayed)
         Quality = Rx
         next_quality = False
       
        ElseIf next_status Then                                                               ' Receive Status and update window
         Status = Rx
         
         If Status <> 0 Then
            Label2.Caption = "--"
            Label1.Caption = "---"
            Pulse_bar.Value = 0
         Else
            If SpO2 < 100 Then
              Label2.Caption = SpO2
            Else
              Label2.Caption = "--"
            End If
         
            If Pulse < 255 Then
              Label1.Caption = Pulse
            Else
              Label1.Caption = "---"
            End If
         End If
         
         If Status = 1 Then
         Label4.Caption = LoadResString(23 + Language)
         Label4.ToolTipText = LoadResString(26 + Language)
         ElseIf Status = 2 Then
         Label4.Caption = LoadResString(25 + Language)
         Label4.ToolTipText = LoadResString(27 + Language)
         Else
         Label4.Caption = "OK!"
         Label4.ToolTipText = LoadResString(28 + Language)
         End If
         
         next_status = False
       
        ElseIf next_pulse Then                                                                       ' Receive Pulse
         Pulse = Rx
         If setBeep.Checked And Pulse And SpO2 <= 100 Then                            ' Have to beep ?
            If SpO2 > 80 Then                                  ' V1.51
              frq = SpO2 - 80
            Else
              frq = 0
            End If
           
            Piep pt(frq), 50
         End If
        next_pulse = False
         
        ElseIf next_spo2 Then                                                         ' Receive spo2
         SpO2 = Rx
         next_spo2 = False
         
        ElseIf Rx < &HF8 Then
         draw_plethy (Rx)
         If toggle > 3 Then
           toggle = 0
           plethy = Rx
           Pulse_bar.Value = plethy
         End If
        End If
         
        If toggle < 250 Then
          toggle = toggle + 1
        End If
       
        If Rx = &HF9 Then                  ' set spo2 flag for next loop
         timer_rx = 0                      ' reset no communication counter
         next_spo2 = True
        End If
        If Rx = &HFA Then                  ' set pulse flag for next loop
         next_pulse = True
        End If
        If Rx = &HFB Then                  ' set status flag for next loop
         next_status = True
        End If
        If Rx = &HFC Then                  ' set quality flag for next loop
          next_quality = True
        End If
        If Rx = &HF8 Then                  ' Plethysmogram
          next_plethy = True
        End If
             
        Next i
        Tmpstr = ""
End Sub

Maksud Rx = AscB(MidB(Tmpstr, i, 1)) baris 16 gimana yaa?? Ada yang bisa jelasin program ini??
Help, thankyou.. :)
by Miss Ceevuik

cartiman

Rx = AscB(MidB(Tmpstr, i, 1))

Itu proses pengambilan data satu per satu

Rumusan : MidB(data, Nomor_start, Jumlah_data)

Misal : Bufffer= MidB(Tmpstr, i, 1)
dengan :
Tmpstr = MAKANAN
i=3

Maka Buffer isinya = karakter "K"


Kalau Kode AscB untuk mendapatkan kode ASCI dari Karakter.


Dalam Contoh diatas :

Rx = AscB(MidB(Tmpstr, i, 1))
dengan:
Tmpstr = MAKANAN
i=3

Maka Rx berisi Kode ASCI karakter "K"


semoga dapat membantu

Ceevuik

Wah mas, sangat membantu sekali.. :)
Sebelumnya makasiy buat penjelasannya,,,klo boleh saia berguru,,heheh... Saia kurang ngerti euy..  ???

Program awalnya siy seperti ini:

Option Explicit

Private iReceiveFilenum As Integer    ' File value for storage of data

Private WaitSave As Boolean           ' True until there is a valid file
Private SpO2 As Byte                  ' SpO2 value
Private Pulse As Byte                 ' Pulse value
Private Status As Byte                ' Status value
Private Quality As Byte               ' Quality value
Private plethy As Byte                ' Plethysmogram value
Private Now                           ' Current time
Private timer_rx As Byte              ' Receive timer

Private Sub Form_Load()               ' Load the main form

Set_Tags
Set_language (Language)
get_operating_system
init_comport

'---------------------------
                                      'Init and open comm port
Eingangsfenster.Visible = False       ' Clear the intro window

setBeep.Checked = False               ' Don't beep on startup
Pulse_bar.Value = 0
StsBar1.SimpleText = LoadResString(20 + Language)
End Sub

Private Sub Form_Unload(Cancel As Integer) ' closed in task bar
If MSComm1.PortOpen = True Then
  MSComm1.PortOpen = False                ' Close port on program exit if open
End If
If SaveFlag = True Then                   ' Close file on exit if open
  Close #iReceiveFilenum
End If
SaveSetting "Pox_2_pc", "Optionen", "Sprache", CStr(Language)
SaveSetting "Pox_2_pc", "Optionen", "Port", CStr(Gport)
End                                       ' End program
End Sub

Private Sub menEnde_Click()               ' Do the same as above
Form_Unload (0)
End Sub

Private Sub menSpeichern_Click()         ' Select a file for data storage
Dim ErrMsg As String
   
   On Error GoTo ErrHandler
   
   SaveFlag = Not (SaveFlag)
   menSpeichern.Checked = Not (menSpeichern.Checked)

   ' close the file if recflag is false:
   If SaveFlag = False Then
      Close #iReceiveFilenum
      StsBar1.SimpleText = LoadResString(20 + Language)
      Exit Sub
   End If
   WaitSave = True
     
   ' Get filename from user:
   With cdlCD1
      .DialogTitle = LoadResString(21 + Language)
      .Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
      .CancelError = True
      .FileName = ""
      .ShowSave
       'If Err = cdlCancel Then Exit Sub 'User pressed Cancel button
      FileName = .FileName
   End With
   StsBar1.SimpleText = LoadResString(22 + Language) & FileName
   iReceiveFilenum = FreeFile
   Open FileName For Output As iReceiveFilenum
   ' See Sub MSComm1 for the rest of the receiving code
   WaitSave = False
   Exit Sub
   
ErrHandler:
   If cdlCD1.CancelError Then         ' we cancelled, so don't save
     If (SaveFlag) Then
       SaveFlag = False
       menSpeichern.Checked = False   ' remove checked in menu
     End If
     Exit Sub 'User pressed Cancel button
   End If
   ErrMsg = "Error! Errornumber = " & Err.Number
   ErrMsg = ErrMsg & ", Description = " & Err.Description
   ErrMsg = ErrMsg & ", Source = " & Err.Source
   MsgBox ErrMsg, vbOKOnly, "File menu error"
   Err = 0
   Resume Next
End Sub

Private Sub draw_plethy(plethy As Integer)
Static x As Integer
Static old_plethy As Integer

spo2wave.DrawWidth = 2

If Status <> 0 Then
  plethy = 128
End If

If x < spo2wave.ScaleWidth Then
   x = x + 2
Else
   x = 0
End If

plethy = (256 - plethy) / 2

spo2wave.ForeColor = &H80000005

spo2wave.Line (x, 1)-(x, spo2wave.ScaleHeight)
spo2wave.Line (x + 1, 1)-(x + 1, spo2wave.ScaleHeight)
spo2wave.ForeColor = &H8000000D

If x >= 1 Then
  spo2wave.Line (x - 2, old_plethy)-(x, plethy)
End If

old_plethy = plethy

End Sub

'Receiver Code.
Private Sub MSComm1_OnComm()            ' Receive and decode data
  Dim Tmpstr As String
 
  If MSComm1.CommEvent = comEvReceive Then
    While MSComm1.InBufferCount > 0
       Tmpstr = MSComm1.Input
       Decode_string (Tmpstr)
    Wend
  End If
End Sub

Kira-kira gmna ya mas..
by Miss Ceevuik

cartiman

Itu Program untuk pengambilan data dari komunikasi RS232.

Kalau BOleh saya tahu, itu Program Untuk Aplikasi APa ?