Centar za edukaciju-BiH

iCentar → Racunari i oprema → Programirannje i baze podataka → Vb/Vbnet


switch Lista naslova: Koristan VB kod
Prosiri i skupi Opcije teme
Stranice (2):1,2
 Prikazi prvu neprocitanu poruku

#11 19.10.2015 13:20
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Postovi:4,807


Predmet:usporedi dva fajla
Ova funkcija će usporediti jednu datoteke sa drugom. Moze usporediti samo duzinu datoteka ili razliku datoteka byte po byte.
Pozivate je:
usporediDatoteke(File1,File2) - samo za usporediti duzinu datoteka
usporediDatoteku(File1,File2,True) - usporeduje byte po byte datoteka

gdje su File1=App.Path & "/ime1.ext" i File2=App.Path & "/ime2.ext"

PreuzmiIzvorni kôd (Visual Basic):
  1. Function usporediDatoteke(ByVal File1 As String, _
  2.   ByVal File2 As String, Optional StringentCheck As _
  3.   Boolean = False) As Boolean
  4. '*******************************************************************************************
  5. 'Ime: usporediDatoteke
  6. 'Namjena: Provjeri dali su dvije datoteke identicne
  7. 'Autor: Ervin Kosch
  8. 'Ulazni parametri:
  9. '     -File1 i File2  = putanje sa imenom datoteke
  10. '     -StringentCheck = if false (default), usporeduje samo duzinu
  11. '     -StringentCheck = if true , usporeduje byte po byte datoteke
  12. 'Izlazni parametri: Boolean
  13. '********************************************************************************************
  14.  
  15. On Error GoTo ErrorHandler
  16.  
  17. If Dir(File1) = "" Then Exit Function
  18. If Dir(File2) = "" Then Exit Function
  19.  
  20. Dim lLen1 As Long, lLen2 As Long
  21. Dim iFileNum1 As Integer
  22. Dim iFileNum2 As Integer
  23. Dim bytArr1() As Byte, bytArr2() As Byte
  24. Dim lCtr As Long, lStart As Long
  25. Dim bAns As Boolean
  26.  
  27. lLen1 = FileLen(File1)
  28. lLen2 = FileLen(File2)
  29. If lLen1 <> lLen2 Then
  30.     Exit Function
  31. ElseIf StringentCheck = False Then
  32.         usporediDatoteke = True
  33.         Exit Function
  34. Else
  35.     iFileNum1 = FreeFile
  36.     Open File1 For Binary Access Read As #iFileNum1
  37.     iFileNum2 = FreeFile
  38.     Open File2 For Binary Access Read As #iFileNum2
  39.  
  40.     'put contents of both into byte Array
  41.    bytArr1() = InputB(LOF(iFileNum1), #iFileNum1)
  42.     bytArr2() = InputB(LOF(iFileNum2), #iFileNum2)
  43.     lLen1 = UBound(bytArr1)
  44.     lStart = LBound(bytArr1)
  45.    
  46.     bAns = True
  47.     For lCtr = lStart To lLen1
  48.         If bytArr1(lCtr) <> bytArr2(lCtr) Then
  49.             bAns = False
  50.             Exit For
  51.         End If
  52.            
  53.     Next
  54.     usporediDatoteke = bAns
  55.        
  56. End If
  57.  
  58. ErrorHandler:
  59. If iFileNum1 > 0 Then Close #iFileNum1
  60. If iFileNum2 > 0 Then Close #iFileNum2
  61. End Function
zivot je moja domovina.
↑  ↓

#12 29.05.2018 00:07
Gjoreski Van mreze
Administrator
Registrovan od:02.02.2009
Postovi:1,854


Predmet:Dinamicko kreirajne Comman Button
Tri varijante kako napraviti dinamicki kontroli ( Command Button ) na forme

Verzija 1
Kreirajte nova Forma Form1 i na njoj stavite jedan command button Commatd1 i jos stavite i
Command1.index=0
Zatim iskopirajte sledeci kod na forme
PreuzmiIzvorni kôd (Visual Basic):
  1. Private Sub Form_Load()
  2.  
  3.   Dim lngIndex As Long
  4.   For lngIndex = 1 To 100
  5.     Load Command1(lngIndex)
  6.   Next lngIndex
  7.   For lngIndex = 0 To Command1.UBound
  8.     With Command1(lngIndex)
  9.       .Caption = CStr(lngIndex)
  10.       .Visible = True
  11.     End With
  12.   Next lngIndex
  13.  
  14.  End Sub
  15.  
  16. Private Sub Form_Resize()
  17.   Dim lngIndex As Long
  18.   Dim sngWidth As Single, sngHeight As Single
  19.   Dim lngRow As Long, lngCol As Long
  20.   sngWidth = ScaleWidth / 10
  21.   sngHeight = ScaleHeight / 10
  22.   For lngIndex = 0 To Command1.UBound
  23.     lngRow = lngIndex \ 10
  24.     lngCol = lngIndex Mod 10
  25.     Command1(lngIndex).Move lngCol * sngWidth, lngRow * sngHeight, sngWidth, sngHeight
  26.   Next lngIndex
  27. End Sub

Verzija 2
Samo kreirajte nova forma i upisite ovaj cod:
PreuzmiIzvorni kôd (Visual Basic):
  1. Dim WithEvents Cmd1 As CommandButton
  2. '
  3. Private Sub Form_Load()
  4.   Set Cmd1 = Controls.Add("vb.commandbutton", "Cmd1")
  5.       Cmd1.Width = 2000
  6.       Cmd1.Top = Me.Height / 2 - Cmd1.Height / 2 - 100
  7.       Cmd1.Left = Me.Width / 2 - Cmd1.Width / 2 - 100
  8.       Cmd1.Caption = "Dynamic Button"
  9.       Cmd1.Visible = True
  10.      
  11.   Set Cmd2 = Controls.Add("vb.commandbutton", "Cmd2")
  12.       Cmd2.Width = 2000
  13.       Cmd2.Top = 10
  14.       Cmd2.Left = 10
  15.       Cmd2.Caption = "Dynamic Button 2"
  16.       Cmd2.Visible = True
  17. End Sub
  18. '
  19. Private Sub Cmd1_click()
  20.   MsgBox "I have been Created Dynamically at Run-time", _
  21.     , "Dynamic Controls"
  22. End Sub

Verzija 3
Kreirajte nova forma i upisite ovaj cod :

PreuzmiIzvorni kôd (Visual Basic):
  1. Dim cmdButton(4) As CommandButton
  2.  
  3. Private Sub Form_Load()
  4.  
  5.     Dim i As Integer
  6.  
  7.     For i = 0 To 4
  8.         Set cmdButton(i) = Me.Controls.Add("VB.CommandButton", "cmdButton" & Me.Controls.Count)
  9.         With cmdButton(i)
  10.             .Left = 750 * i
  11.             .Top = 1000
  12.             .Width = 700
  13.             .Height = 500
  14.             .Caption = "Hello"
  15.             .Visible = True
  16.         End With
  17.     Next i
  18.  
  19. End Sub
  20.  
  21. Private Sub Form_Unload(Cancel As Integer)
  22.  
  23.     Dim i As Integer
  24.  
  25.     For i = 0 To 4
  26.         Set cmdButton(i) = Nothing
  27.     Next i
  28.      
  29. End Sub
↑  ↓

#13 11.06.2018 21:50
Gjoreski Van mreze
Administrator
Registrovan od:02.02.2009
Postovi:1,854


Predmet:Izvlacejne Broj od stinga sa decimalom
Ako nekome zatreba :

PreuzmiIzvorni kôd (Visual Basic):
  1. Public Function Extract_Number_With_Decimal(Phrase As String) As Double
  2. Dim Length_of_String As Integer
  3. Dim Current_Pos As Integer
  4. Dim Temp As String
  5. Length_of_String = Len(Phrase)
  6. Temp = ""
  7. For Current_Pos = 1 To Length_of_String
  8. If (Mid(Phrase, Current_Pos, 1) = "-") Then
  9.   Temp = Temp & Mid(Phrase, Current_Pos, 1)
  10. End If
  11. If (Mid(Phrase, Current_Pos, 1) = ".") Then
  12.  Temp = Temp & Mid(Phrase, Current_Pos, 1)
  13. End If
  14. If (IsNumeric(Mid(Phrase, Current_Pos, 1))) = True Then
  15.     Temp = Temp & Mid(Phrase, Current_Pos, 1)
  16.  End If
  17. Next Current_Pos
  18. If Len(Temp) = 0 Then
  19.     Extract_Number_With_Decimal = 0
  20. Else
  21.     Extract_Number_With_Decimal = CDbl(Temp)
  22. End If
  23. End Function
Ovaj post je ureden 2 puta. Posljednja izmjena 13.06.2018 07:51 od strane Avko. ↑  ↓

Stranice (2):1,2

Srodne teme

Ko je online?

Aktivni clanovi:
nema clanova


Kontakt
Sva vremena su GMT +01:00. Trenutno vrijeme: 12: 09 am.