Kodovi vezani za kontrole(objekte)

Kodove mozete probati jednostavno sa Copy-Paste

Dozvoliti maksimalnu vrijednost u TextBox-u

Staviti kursor na kraj TextBox-a

Otvoriti ComboBox automatski (kada primi Focus)

Karakter "&" u Label kontroli

Traziti odredjenu rijec u ListBox

Oznaciti odredjeni text U TextBox kada dobije fokus

TextBox koji prihvata samo brojeve

Odrediti duzinu stringe u ComboBox

Kako klonirati TextBox u jednom Form-u

Kako napraviti TextBox "Read only"

Traziti odredjenu rijec u TextBox MultiLine

Napraviti od PictureBox ProgressBar koji prikazuje procenat izvrsene operacije

Kopirati File i prikazati u ProgressBar-u napredak

TextBox koji ima samo velika slova

Odsvirati .wav File sa MMControl

'Dozvoliti maksimalnu vrijednost u TextBox
Private Sub Text1_KeyPress(KeyAscii As Integer)
'Ovaj primjer dozvoljava unos od 0 do 200.
'Voditi racuna da privremeni string nije prazan jer daje gresku
If Not IsNumeric(Chr(KeyAscii)) Then
If KeyAscii <> Asc(vbTab) And KeyAscii <> Asc(vbBack) And KeyAscii <> Asc(vbCr) And KeyAscii _
<> Asc(vbLf) Then 'karakteri neprihvatljivi
KeyAscii = 0
Exit Sub
End If
End If
'kontrola vrijednosti napr. 1-200
Dim TmpStr As String
If KeyAscii <> Asc(vbBack) Then
TmpStr = Left(Text1.Text, Text1.SelStart)
TmpStr = TmpStr & Chr(KeyAscii)
TmpStr = TmpStr & Right(Text1.Text, Len(Text1.Text) - Text1.SelStart - Text1.SelLength)
Else 'ponasanje backspace-a
TmpStr = Left(Text1.Text, Text1.SelStart)
If Text1.SelLength > 0 Then
' backspace ponistava selekcuju
TmpStr = TmpStr & Right(Text1.Text, Len(Text1.Text) - Text1.SelStart - Text1.SelLength)
Else
' backspace ponistava karakter lijevo od kursora
TmpStr = Left(TmpStr, Len(TmpStr) - 1)
TmpStr = TmpStr & Right(Text1.Text, Len(Text1.Text) - Text1.SelStart - Text1.SelLength)
End If
End If
If Not (Val(TmpStr) >= 0 And Val(TmpStr) <= 200) Then
KeyAscii = 0
End If
End Sub

'Staviti kursor na kraj TextBox-a
Private Sub Command1_Click()
Text1.SelStart = Len(Text1.Text)
Text1.SetFocus
End Sub

'Otvoriti ComboBox automatski (kada primi Focus)
Sub Combo1_GotFocus()
SendKeys "%{Down}"
End Sub

'Karakter "&" u Label kontroli
Label1.Caption = "Tips && Tricks"

'Traziti odredjenu rijec u ListBox
Private Const WM_USER As Long = &H400
Private Const LB_FINDSTRING As Long = &H18F
Private Declare Function SendMessage Lib "User32.dll" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub Text1_Change()
Dim Pos As Long
'Trazi u listi elemenat koji pocinje sa upisanim slovima.
List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub

'Oznaciti odredjeni text U TextBox kada dobije fokus
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub

'TextBox koji prihvata samo brojeve
Function Broj(cContr As Control, Dugme As Integer, iMaxLen As Integer)
If Dugme = vbKeyBack Then
Broj = Dugme
Exit Function
End If
If Len(cContr.Text) >= iMaxLen Then
If cContr.SelLength = 0 Then
Broj = 0
Exit Function
End If
End If
If Not IsNumeric(Chr(Dugme)) And Dugme <> 46 Then '46 = tacka
MsgBox "Morate unijeti numericku vrijednost!"
Dugme = 0
Else
If InStr(cContr.Text, ".") > 0 And Dugme = 46 Then
Dugme = 0
Else
Broj = Dugme
End If
End If
End Function
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Broj(Text1, KeyAscii, 10)
End Sub

'Odrediti duzinu stringe u ComboBox
'ComboBox nema property MaxLenght kao TextBox
'ali je moguce postaviti i u ComboBox u event: KeyPress
Private Sub Combo1_KeyPress(KeyAscii As Integer)
Const MAXLENGTH = 10
If Len(Combo1.Text) >= MAXLENGTH And KeyAscii <> vbKeyBack Then KeyAscii = 0
End Sub

'Kako klonirati TextBox u jednom Form-u
Option Explicit
Private Sub Command1_Click()
Dim index As Integer
index = Text1.Count
Load Text1(index)
Text1(index).Top = Text1(index - 1).Top + _
Text1(index - 1).Height + 30
Text1(index).Text = "Text1(" & Format$(index) & ")"
Text1(index).Visible = True
End Sub

'Kako napraviti TextBox "Read only"
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

'Traziti odredjenu rijec u TextBox MultiLine
'Text1 = MultiLine
'Text2 = String koji trazim
'Command1 = start
'Command2 = trazi sledecu rijec
Option Explicit
Private TargetPosition As Integer

Private Sub Command1_Click()
'Trazi text
FindText 1
End Sub

Private Sub FindText(Start_at As Integer)
Dim Pos As Integer
Dim Target As String
Target = Text2.Text
Pos = InStr(Start_at, Text1.Text, Target)
If Pos > 0 Then
'Pronasao.
TargetPosition = Pos
With Text1
.SelStart = TargetPosition - 1
.SelLength = Len(Target)
.SetFocus
End With
Else
'Nema.
MsgBox "Nemogu naci '" & Target & "'.", vbInformation, Me.Caption
Text1.SetFocus
End If
End Sub

Private Sub Command2_Click()
'trazi sledecu rijec.
FindText TargetPosition + 1
End Sub

'Napraviti od PictureBox ProgressBar koji prikazuje procenat izvrsene operacije
Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer,
ByVal Y As Integer, ByVal nWidth As Integer, _ ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc
As Integer, ByVal dwRop As Long) As Integer

Private Sub Stanje_Progress()
Static lProgress As Long
Dim txtBroj
lProgress = lProgress + 3
If lProgress > Picture1.ScaleWidth Then
lProgress = Picture1.ScaleWidth
Picture1.Cls
Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(txtBroj)) \ 2 - 7
Picture1.CurrentY = Picture1.Height
Picture1.Print "100%"
Picture1.Line (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight), Picture1.ForeColor, BF
End 'Ovdje staviti kod koji slijedi kada je izvrseno 100% operacije. Ja sam stavio End(zatvara aplikaciju).
Exit Sub
Else
txtBroj = Format$(CLng((lProgress / Picture1.ScaleWidth) * 100)) + "%"
Picture1.Cls
Picture1.CurrentX = (Picture1.ScaleWidth - Picture1.TextWidth(txtBroj)) \ 2
Picture1.CurrentY = Picture1.Height
Picture1.Print txtBroj
Picture1.Line (0, 0)-(lProgress, Picture1.ScaleHeight), Picture1.ForeColor, BF
End If
End Sub

Private Sub Command1_Click()
Picture1.ScaleWidth = 109
For i = 1 To 100
Stanje_Progress
X = Timer
While Timer < X + 0.35
DoEvents
Wend
Next
End Sub

'Kopirati File i prikazati u ProgressBar-u napredak
Option Explicit

'Text1 = File za kopiranje
'Text2 = File destinacija
'ProgressBar = Prog
Function KopiraFile(Original As String, Destinacija As String, Prog As ProgressBar) As Long
'Kopira File i prikazuje napredak operacije.
Const BUFSIZE As Long = 1024 'Odredjuje dimenziju buffer-a.
Dim Buf As String
Dim BTest As Single, FSize As Single
Dim Chunk As Integer, iOldValue As Integer
With Prog
.Max = 100
.Min = 0
End With
Prog.Value = 0
Open Original For Binary As #1 ' Otvara file.
FSize = LOF(1) ' Utvrdjuje duzinu file-a.
Open Destinacija For Binary As #2 ' Otvara file.
BTest = FSize - LOF(2)
Do
If BTest < BUFSIZE Then
Chunk = BTest
Else
Chunk = BUFSIZE
End If
Buf = String(Chunk, " ")
Get 1, , Buf
Put 2, , Buf
BTest = FSize - LOF(2)
Prog.Value = (100 - Int(100 * BTest / FSize)) 'Pokrece ProgressBar.
If Prog.Value <> iOldValue Then
DoEvents
iOldValue = Prog.Value
End If
Loop Until BTest = 0
Close 1 'Zatvara original
Close 2 'Zatvara kopiju.
End Function

Private Sub Command1_Click()
'Kopira odrednjeni File.
Call KopiraFile(Text1.Text, Text2.Text, Prog)
End Sub

'TextBox koji ima samo velika slova
Private Sub Text1_KeyPress(KeyAscii As Integer)
Char = Chr(KeyAscii)
KeyAscii = Asc(UCase(Char))
End Sub

'Odsvirati .wav File sa MMControl
MMControl1.Command = "close"
MMControl1.DeviceType = "WaveAudio"
MMControl1.FileName = "C:\WavFile.wav"
MMControl1.Command = "open"
MMControl1.Command = "play"