Auto SmartCase

Procedure to change the small letters into capital letters automatically in accordance with the rules of writing, for example, small letters at the beginning of the word, small letters after the space / point.

Rem// AUTHOR

Nandy Novrizal (Original Source Code)

Rem// INTRODUCTION



Procedure to change the small letters into capital letters automatically in accordance with the rules of writing,

such small letters at the beginning of the word, small letters after the space / point.

Rem// PUBLIC PROCEDURE

Sub goSmartCase(TextBoxName As Control, KeyAscii As Integer)
On Error Resume Next
If Mid(TextBoxName.Text, TextBoxName.SelStart, 1) = " " Or _
Mid(TextBoxName.Text, TextBoxName.SelStart,1) = "." _
Or Mid(TextBoxName.Text, TextBoxName.SelStart, 1) = "" Or _
Mid(TextBoxName.Text,TextBoxName.SelStart, 1) = "(" _
Or Mid(TextBoxName.Text, TextBoxName.SelStart, 1) = "{" Or _
Mid(TextBoxName.Text,TextBoxName.SelStart, 1) = "[" _
Or Mid(TextBoxName.Text, TextBoxName.SelStart, 1) = "/" Then
KeyAscii = Asc(UCase(Chr(KeyAscii)))
Else
KeyAscii = Asc(LCase(Chr(KeyAscii)))
End If
End Sub

Rem// HOW TO USE
Private Sub Text1_KeyPress(KeyAscii As Integer)
goSmartCase Text1, KeyAscii
End Sub

Access the Database with the same time

Have all the partners when we access the database and other users also do same? akbitanya what? Perhaps in the Client-Server architecture sometimes have access to the database by accident at the same time (same time). even world-class drivers michael summacker I even print the score, but on different data packet that is sent does not like drivers, equality can occur when we menyelect databse.


Option Explicit

Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Private Sub Form_Load()
Set rs = New ADODB.Recordset
Set cn = New ADODB.Connection

With cn
.ConnectionString = "provider=microsoft.jet.oledb.4.0;" & _
"data source=C:\oks.mdb"
.CursorLocation = adUseClient
.Open
End With
With rs
.ActiveConnection = cn
.LockType = adLockPessimistic
.Open "select * from barang"
End With
rs.MoveLast
If rs.RecordCount = 0 Then
Exit Sub
End If

If cn.BeginTrans = True Then
cn.BeginTrans
End If
rs.MoveFirst
Do Until rs.EOF
If rs("kodebarang") = "2004" Then
rs("kodebarang") = "2005"
rs.Update
End If
rs.MoveNext
Loop
If MsgBox("Apakah Anda yakin untuk menyimpan-nya?", _
vbQuestion + vbYesNo, "Konfirmasi") = vbYes Then
cn.CommitTrans
Else
cn.RollbackTrans
End If
End Sub

how to remove the Close X button in the menu

The fire Code Required

Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" _
(ByVal hwnd As Long) As Long

Private Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long

'Constant value for the operation menubar
Const MF_BYPOSITION = &H400&
Const MF_REMOVE = &H1000&

Public Sub HideMenuX(Form As Form)
Dim hSysMenu As Long, nCnt As Long
hSysMenu = GetSystemMenu(Form.hwnd, False)
If hSysMenu Then
nCnt = GetMenuItemCount(hSysMenu)
If nCnt Then

'Basic Menu is the number of 0 (0, 1, 2, 3 ...) RemoveMenu hSysMenu, nCnt - 1, _
MF_BYPOSITION Or MF_REMOVE

'Remove the separator line before the close RemoveMenu hSysMenu, nCnt - 2, _
MF_BYPOSITION Or MF_REMOVE
DrawMenuBar Form.hwnd
End If
End If
End Sub

Private Sub Command1_Click()
'call function HideMenu
HideMenuX Me
End Sub

How to make animation star

Animated images are often used to embellish the view, in the form vb we can also touch up the look with the animation. Here I give examples of animation in vb

Create a form with some labels and a timer, with propertis masing2 as follows:
Form -> backcolor = select color black, borderstyle-0 = none, 2 = windowstate-maximized.
Label1 dst ... -> Backstyle-transparant = 0, l = caption, font = webdings (size = 72), here I use the 35 labels (label1 name = s / d label35).
Timer1 -> interval = 100.

source code for the following:

Private Sub Timer1_Timer ()
Label1.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label2.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label3.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label4.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label5.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label6.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label7.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label8.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label9.ForeColor = RGB ( Rnd * 255, Rnd * 255, Rnd * 255) Label10.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label11.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label12. ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label13.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label14.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label15.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label16.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label17.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label18.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label19.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label20.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label21.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label22.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) = Label23.ForeColor RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label24.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label25.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label26.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label27.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label28.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label29.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label30.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label31.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label32.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label33.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255) Label34.ForeColor = RGB ( Rnd * 255, Rnd * 255, Rnd * 255) Label35.ForeColor = RGB (Rnd * 255, Rnd * 255, Rnd * 255)
End Sub

Search for words in ListBox

'Copyright by x-vb @ jhie
'http://www.vbbego.cjb.net
'Author: x-vb @ jhie - 7/19/2004

Option explicit
Private Declare Function SendMessage lib "User32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal _
wMsg As Integer, ByVal wParam As Integer, _ lParam
As Any) As Long
Const LB_FINDSTRING = & H18F

Private Sub Form_Load ()
With List1
. Clear
. AddItem "CPU"
. AddItem "RAM"
. AddItem "ROM"
. AddItem "Cache"
. AddItem "motherboard"
. AddItem "Hard Disk"
. AddItem "Floppy Disk"
End With
End Sub

Private Sub Text1_Change ()
List1.ListIndex = SendMessage (List1.hWnd, _
LB_FINDSTRING, -1, ByVal Text1.Text)
End Sub
> swap

Retrieving Data / Pictures

GetData function is used to retrieve the contents of the clipboard
can be a text or image.

Basic syntax:
Clipboard.Getdata ([format clipboard])

Clipboard format consists of several types of

Constant value description
-------------------------------------------------- -----
vbCFBitmap 2 Bitmap (. bmp files)
vbCFMetafile 3 Metafile (. wmf files)
vbCFDIB 8-Device independent bitmap (DIB)
vbCFPalette 9 Color palette


Example:

Dim Msg
On Error Resume Next
Msg = "Choose OK to load bitmap into the clipboard."
MsgBox Msg
Clipboard.Clear 'Clear the Clipboard.

'Take a picture of the file and save it to the clipboard
Clipboard.SetData LoadPicture ( "C: \ vbBego.BMP")

MsgBox "Showing a picture from the clipboard"
Picture = Clipboard.GetData () 'Copy from Clipboard.

Tips And Trick & Animation Form

You can simply copy and paste the per-example to try to script this ...


Example 1:
Private Sub Form_Unload(Cancel As Integer)
Me.BackColor = vbWhite ' warna belakang putih
WindowState = 2 ' maximized-kan
DrawWidth = 4 '/ ketebalan
For i = 1 To 16000
Bawah = Bawah + 1
Kanan = Kanan + 1
PSet (Rnd * Kanan, Rnd * Bawah), QBColor(Rnd * 15)
Next i
End Sub


Example 2:
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
cepat = 150
While Left + Width < left =" Left" top =" Top">



Example 3:
Private Sub Timer1_Timer()
Dim LingkaranX, LingkaranY, Radius
ScaleMode = 3
LingkaranX = ScaleWidth / 2
LingkaranY = ScaleHeight / 2
For Radius = 0 To 100
Circle (LingkaranX + Radius / 2, LingkaranY), Radius, RGB(Rnd * 215, Rnd * 55, Rnd * 15)
Next Radius
End Sub


Example 4:
Private Sub Form_Load()
Me.AutoRedraw = True
BackColor = 0
For i = 1 To 500
CurrentX = i * 100
CurrentY = i * 100
h = h & i
ForeColor = i * 10000
Print h
Next i
End Sub

Example 5:
Private Sub Form_Load()
Me.AutoRedraw = True
Me.DrawWidth = 10
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Form_MouseMove 1, 0, X, Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Caption = "PosisiX=" & X & " - " & "PosisiY=" & Y
If Button = 1 Then
PSet (X, Y), vbBlue
End If
End Sub

How To Find Files with VB

Private Declare Function SearchTreeForFile Lib "imagehlp" _
(ByVal RootPath As String, ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
Private Const MAX_PATH = 260
Private Sub Form_Load()


Dim tempStr As String, Ret As Long
tempStr = String(MAX_PATH, 0)
Ret = SearchTreeForFile("c:", "calc.exe", tempStr)
If Ret <> 0 Then
MsgBox "Lokasi file di " + Left$(tempStr, _
InStr(1, tempStr, Chr$(0)) - 1)
Else
MsgBox "File tidak ditemukan!"
End If
End Sub