Friday, March 14, 2008

Belajar Input Teks di List

Private Sub cmdHapus_Click()
LstList.RemoveItem (LstList.ListIndex)

End Sub

Private Sub cmdHapusSemua_Click()
LstList.Clear

End Sub

Private Sub cmdInput_Click()
LstList.AddItem txtInput.Text

txtInput.Text = “”

End Sub

Private Sub cmdKeluar_Click()
End
End Sub

Posted by Administrator at 09:04:21 | Permalink | No Comments »

Monday, March 10, 2008

Counter Time

Private Sub Command1_Click()
intbatas = 5
Me.Timer1.Interval = 1000
Me.Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
intbatas = 5
Dim inttout As Integer
Dim dtm As Date
dtm = DateAdd(“s”, intbatas, Now)

Do Until Now >= dtm
DoEvents
inttout = Second(dtm) - Second(Now)
Me.Caption = “TimeOut:” & inttout
Loop
Unload Me
End Sub

Private Sub Timer1_Timer()
intbatas = intbatas - 1
If intbatas <= 0 Then
Me.Timer1.Enabled = False
Unload Me
Else
Me.Caption = “TimeOut:” & intbatas
End If
End Sub

Posted by Administrator at 08:41:29 | Permalink | Comments (1) »

Program Load Gambar

Private Sub Command1_Click()
With Me.CommonDialog1
.DialogTitle = “Ambil Gambar”
.Filter = “JPEG|*.jpg”
.ShowOpen

If .FileName <> “” Then
Set Me.Picture1.Picture = Nothing
Me.Picture1.Picture = LoadPicture(.FileName)
End If
End With
End Sub

‘Private Sub Form_Load()
‘Me.Picture1.Picture = LoadPicture(“D:\gbr_motor\bikes_honda_01.jpg”)
‘End Sub

Posted by Administrator at 08:31:20 | Permalink | No Comments »

Saturday, March 8, 2008

Radio Tuner Dengan VB

‘Thank’s Mackay for your sharing about Radio Tuner with VB
‘by Peter

Form

Option Explicit
‘Sintonizador de emisoras de radios
‘latinas en internet.
‘Creado por E. Mackay D. feb. 2008
Dim nEmisora As String
Dim nRadioPais As String

Private Sub cmdEscuchar_Click()
  On Local Error Resume Next
If cmdEscuchar.Caption = “Escuchar” Then
   Image1(0) = Image1(1)    ‘Rojo
 Tuneador.Enabled = False
  cmdEscuchar.Caption = “Detener”
         WMPradio.URL = nEmisora
        WMPradio.Controls.Play
   Else
  cmdEscuchar.Caption = “Escuchar”
     Image1(0) = Image1(3)   ‘Gris
 Tuneador.Enabled = True
 WMPradio.Controls.Stop
 Escuchar.Panels(1).Text = “”
 lblRadioPais.Caption = “”
   End If
End Sub

Private Sub Form_Load()
Image1(0) = Image1(3)    ‘Gris
Escuchar.Panels(1).Width = Me.Width - 100
Call Emisoras
‘Emisora buffer Radio HRN de Honduras
nEmisora = “http://206.17.135.195/VACILON_LIVE”
End Sub

Private Sub Emisoras()
 Dim strVar As String
 
‘Abre archivo para leer
 On Local Error Resume Next
 ’Sept. 2, 2007
Open UnArchivo For Input As #1

Do While Not EOF(1)
        Line Input #1, strVar
‘Procesa linea a linea, si la linea es valida
   If strVar <> “” Then Call Separar(strVar)
   Loop
Close #1
End Sub
Private Sub Separar(sRlinea As String)
 Dim sNum, iPos As Long
Dim strFinal, lesStr As String
 lesStr = sRlinea
 On Local Error Resume Next
For sNum = 1 To 4
    iPos = InStr(lesStr, “|”)
   
   strFinal = Trim(Left(lesStr, iPos - 1))
  
 Select Case sNum
 ’Numero en la lista
 Case 1
 ListaURL.Add strFinal
 ’Nombre de emisora
  Case 2
 ListaURL.Add strFinal
 ’Pais de origen
 Case 3
 ListaURL.Add strFinal
 ’Url de emisora
 Case 4
ListaURL.Add strFinal
  End Select

    lesStr = Right(sRlinea, Len(lesStr) - iPos)
 Next sNum
 ’Programacion
  ListaURL.Add lesStr
 ’
End Sub

Private Sub Tuneador_Scroll()
On Local Error GoTo Fuera

 ’Muestra instantaneamente la emisora y el pais
Escuchar.Panels(1).Text = ListaURL((Tuneador.Value * 5) + 2) & ” en ” & ListaURL((Tuneador.Value * 5) + 3)
nEmisora = ListaURL((Tuneador.Value * 5) + 4)
        nRadioPais = Escuchar.Panels(1).Text
Exit Sub
Fuera:
  MsgBox “Solo hay ” & ListaURL.Count / 5 & ” estaciones listadas.”, vbInformation + vbOKOnly, “AVISO”
Tuneador.Value = (ListaURL.Count / 5) - 1
End Sub

Private Sub WMPradio_OpenStateChange(ByVal NewState As Long)
Escuchar.Panels(1).Text = WMPradio.Status
If Left(WMPradio.Status, 3) = “Rep” Then
lblRadioPais.Caption = Trim(nRadioPais)
   Image1(0) = Image1(2)    ‘Verde
    Else
lblRadioPais.Caption = “”
   Image1(0) = Image1(1)    ‘Rojo
    End If
   
End Sub

Module
Option Explicit
‘Marzo 2008
‘hp1ml@hotmail.com
‘Para escuchar emisoras de radio latinas en internet
‘……………………..
‘Configuracion del string por paises
Public UnArchivo As String
Public Type TVNAME
    nIdice As Long
    Canal As String
    dirURL As String
    nBitrate As Integer
    namePais As String
    nRata As Integer
    nStatus As Integer
End Type

Public ListaURL As New Collection
Public CanalPorPais As New Collection
Public Type POINTAPI
   x As Long
   y As Long
End Type
‘Para desplegar mas lineas en un combobox
Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Public Declare Function SendMessage Lib _
   “user32″ Alias “SendMessageA” _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long

Public Declare Function MoveWindow Lib _
   “user32″ (ByVal hWnd As Long, _
   ByVal x As Long, ByVal y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal bRepaint As Long) As Long

Public Declare Function GetWindowRect Lib _
   “user32″ (ByVal hWnd As Long, _
   lpRect As RECT) As Long

Public Const CB_SHOWDROPDOWN = &H14F
Public Const CB_GETITEMHEIGHT = &H154

Sub main()

 UnArchivo = App.Path & “\allradio.dat”      ‘channelTV.txt”          ‘”\get3test.htm”

        frmTuner.Show
End Sub

Posted by Administrator at 04:20:10 | Permalink | No Comments »

Wednesday, March 5, 2008

Membuat Animasi Huruf

Private Sub cmdkeluar_Click()
Unload Me

End Sub

Private Sub form_load()
Label1.FontBold = True

Label1.Left = 240
Label1.Top = 240

Timer1.Interval = 200

End Sub

Private Sub Timer1_Timer()
Label1.Top = Label1.Top + 100

If Label1.Top > 3000 Then
Label1.Top = 240
End If

End Sub

Posted by Administrator at 09:05:13 | Permalink | No Comments »