Programming FAQ -- show off your cool tips here!

Here's some code that will teach the basics of using a speech engine (both input and output).

Add to a Form with a DirectSS and DirectSR control.

VB Code:

Private Sub DirectSR1_PhraseFinish(ByVal flags As Long, ByVal beginhi As Long, ByVal beginlo As Long, ByVal endhi As Long, ByVal endlo As Long, ByVal Phrase As String, ByVal parsed As String, ByVal results As Long)
 
If Phrase = "hello" Then
    Phrase = ""
    DirectSS1.Speak "Hi to you too."
End If
 
If Phrase = "bye" Then
    Phrase = ""
    DirectSS1.Speak "goodbye."
End If
 
Text1.Text = Phrase
 
End Sub
 
 
Private Sub Form_Load()
 
' The following are words that the Engine will reconize
DirectSR1.GrammarFromString "[Grammar]" + vbNewLine + _
         "type=cfg" + vbNewLine + _
         "[<start>]" + vbNewLine + _
         "<start>=hello" + vbNewLine + _
         "<start>=bye" + vbNewLine
DirectSR1.Activate
 
End Sub

Here's one to return the contents of any directory (files and subdirectories), you can also use it to search for files of a particular type or files/subdirectories that contain any string.

VB Code:

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * 260
        cAlternate As String * 14
End Type
 
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
 
Private Sub Form_Load()
 Dim sF() As String
 Dim sD() As String
 Dim iCt As Integer
 
 ' to search for files of a particular file type pass C:\*.txt, for example _
   in the strDirectory parameter, or to search for a file containing a particular _
   string pass "C:\*Jon*, for example, to the strDirectory parameter
 MsgBox GetDirectoryContents("C:\*suh*", sF, sD)
 
Debug.Print "************FILES************"
 
 For iCt = LBound(sF) To UBound(sF)
 
    Debug.Print sF(iCt)
 
 Next iCt
 
Debug.Print "************FOLDERS************"
 
 For iCt = LBound(sD) To UBound(sD)
 
    Debug.Print sD(iCt)
    
 Next iCt
 
End Sub
 
Function GetDirectoryContents(strDirectory As String, strFiles() As String, strDirectories() As String) As Integer
 Dim hFile As Long
 Dim iFileCt As Long, iDirCt As Long
 Dim iNext As Long
 Dim wfd As WIN32_FIND_DATA
 
 ' get the handle of the first file
 hFile = FindFirstFile(strDirectory, wfd)
 
 If hFile Then
    
    ' initialize the arrays to hold directory contents
    ReDim strDirectories(0)
    ReDim strFiles(0)
    
    Do
    
        ' if the current file is a directory add to the directory array
        If wfd.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
    
            ReDim Preserve strDirectories(iDirCt)
            ' trim the null characters and add to array
            strDirectories(iDirCt) = Left$(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
            iDirCt = iDirCt + 1
    
    
        Else
        
            ReDim Preserve strFiles(iFileCt)
            ' trim the null characters and add to array
            strFiles(iFileCt) = Left$(wfd.cFileName, InStr(1, wfd.cFileName, Chr(0)) - 1)
            iFileCt = iFileCt + 1
    
        End If
        
        ' get the data for the next file/directory in directory
        iNext = FindNextFile(hFile, wfd)
    
    Loop Until iNext = 0
    
    ' close the file handle
    FindClose hFile
    
 End If
 
 ' return the total number of files and subdirectories in the _
   passed directory
 GetDirectoryContents = iFileCt + iDirCt
 
End Function

This code will find the current item that the mouse pointer is over in a listbox without ever having to wait on the user to click a mousebutton. This is demonstrated by selecting the item that the mouse is currently over. You will need a ListBox named List1.

VB Code:

Option Explicit
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_GETITEMRECT = &H198
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Sub Form_Load()
    Dim i As Integer
    ' populate the listbox with the
    ' indexes for each entry
 
 
    For i = 0 To 50
        List1.AddItem i, i
    Next i
End Sub
 
 
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim iSelected As Integer
    ' retrieve the index the mouse
    ' pointer is over (-1 represents
    ' mouse is over nothing)
    iSelected = GetListItemFromPt(List1, x, y)
    ' select the item the mouse
    ' is currently over
 
 
    If Not iSelected = -1 Then
        List1.ListIndex = iSelected
    End If
End Sub
 
 
Public Function GetListItemFromPt(plist As ListBox, x As Single, y As Single) As Integer
    Dim bFound As Boolean
    Dim rCur As RECT
    Dim iIndex As Integer
    Dim iPixX As Integer, iPixY As Integer
    ' convert the coordinates to
    ' pixels (remove the next two
    ' lines if you will be passing
    ' the coordinates in pixels)
    iPixX = Me.ScaleX(x, vbTwips, vbPixels)
    iPixY = Me.ScaleY(y, vbTwips, vbPixels)
 
 
    For iIndex = 0 To plist.ListCount - 1
        ' get the coordinates for each
        ' item in the listbox in its current
        ' state, if Top is less than 0 or Bottom
        '
        '
        ' is greater than the height of the
        ' listbox then the item is currently off
        '
        ' screen
        SendMessage plist.hwnd, LB_GETITEMRECT, iIndex, rCur
        ' if passed corrdinates are within
        ' the bounds of the current item than
        ' exit the loop and return the index
 
 
        If iPixY >= rCur.Top And iPixY <= rCur.Bottom Then
            bFound = True
            Exit For
        End If
    Next iIndex
 
 
    If bFound Then
        GetListItemFromPt = iIndex
    Else
        GetListItemFromPt = -1
    End If
End Function

Don't try and ask me for tricks cos I don't know any

Quote:

---

Originally posted by VBTZH
Don't try and ask me for tricks cos I don't know any

---

If you don't know any tricks and tips don't posts here. It's very annoying to read that you don't have any code to add when the thread said If you have code to add.

did mlewis die? no updates or comments in over a week.

Using this trick is faster than an If or IIf statement, both because it takes a few less milliseconds, and it doesn't mess up the CPU cache.

Instead of:

VB Code:

Dim X as Long, Y as Long
If X = 32 Then
  Y = 2
Else
  Y = 4
End If

VB Code:

Dim X as Long, Y as Long, CompareResult as Boolean
CompareResult = (X = 32)
Y = (CompareResult And 2) Or ((Not CompareResult) And 4)

This trick works VERY well in C++ code, too.
How it works:
VB stores True values as -1, which is all ones in binary two's complement format (which VB uses). This means that if you AND a True value with any other value, the value stays the same, but if you AND a false value, the value is erased.
This formula ANDs two values with the opposites of a comparison's result, and then ORs the results of both of those ANDs, leaving you with one of the two values.

No IF statement, no branching, no messing up the cache. :)

This trick only works well with Integers and Long variables, but I think it might work with currency and byte variables too.

Here's a few functions I and a friend have written, that allow you to:
Get a Long array of an image's pixels (Way faster than Rod Stephens' method)
Copy any piece of a Long array of an image's pixels, to a DC at any location (This is VERY fast, too.)
Create an image (IPictureDisp) from any piece of an hDC.

VB Code:

'
'
'   GDI Image Tools (v1.0)
'   Copyright 2001, Kevin Gadd & Benjamin Marty
'   You are free to use this code in your own applications, and reproduce it on web pages,
'   Provided you leave this header intact.
'
'
Option Explicit
 
Public Type GITRect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Public Type iid
    x As Long
    s1 As Integer
    s2 As Integer
    c(0 To 7) As Byte
End Type
 
Public Type PICTDESC
    cbSizeOfStruct As Long
    picType As Long
    hBitmap As Long
    hPal As Long
End Type
 
Public Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type
 
Public Type RGBQUAD
        RGBBlue As Byte
        RGBGreen As Byte
        RGBRed As Byte
        rgbReserved As Byte
End Type
 
Public Type RGBTRIPLE
        rgbtBlue As Byte
        rgbtGreen As Byte
        rgbtRed As Byte
End Type
 
Public Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End Type
 
Public Const DIB_RGB_COLORS = 0
Public Const BI_RGB = 0&
Public Const OBJ_PAL = 5
Public Const BLACK_BRUSH = 4
Public Const S_OK = &H0
 
Public Enum picType ' IPictureDisp.Type
    PICTYPE_UNINITIALIZED = -1
    PICTYPE_NONE = 0
    PICTYPE_BITMAP = 1
    PICTYPE_METAFILE = 2
    PICTYPE_ICON = 3
    PICTYPE_ENHMETAFILE = 4
End Enum
 
Public Declare Function GetCurrentObject Lib "gdi32" (ByVal hDC As Long, ByVal uObjectType As Long) As Long
Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As GITRect, ByVal hBrush As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32" (ByRef pPictDesc As PICTDESC, ByRef riid As iid, ByVal fOwn As Boolean, ByRef ppvObj As StdPicture) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal sWidth As Long, ByVal sHeight As Long, ByVal PointerToBits As Long, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Public Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
 
Public Function CreateMemoryDC() As Long
On Error Resume Next
Dim deskWnd As Long, deskDC As Long
    deskWnd = GetDesktopWindow
    deskDC = GetDC(deskWnd)
    CreateMemoryDC = CreateCompatibleDC(deskDC)
    ReleaseDC deskWnd, deskDC
End Function
 
Public Sub DeleteMemoryDC(hDC As Long)
On Error Resume Next
    DeleteDC hDC
End Sub
 
' Written by Kevin Gadd
Function GetPictureArray(ByRef Pic As IPictureDisp) As Long()
On Error Resume Next
Dim MinX As Long, MinY As Long
Dim MaxX As Long, MaxY As Long
Dim SetX As Long, SetY As Long
Dim DestAddress As Long, YOffset As Long
Dim bmiDest As BITMAPINFO
Dim DIBitsDest() As Long, DC As Long
    
   DC = CreateMemoryDC
   
   With bmiDest.bmiHeader
       .biSize = Len(bmiDest.bmiHeader)
       .biPlanes = 1
   End With
   
   If 0 = GetDIBits(DC, Pic.Handle, 0, 0, ByVal 0&, bmiDest, DIB_RGB_COLORS) Then
       DeleteMemoryDC DC
       Exit Function
   End If
 
   With bmiDest.bmiHeader
       .biBitCount = 32
       .biCompression = BI_RGB
   End With
   
   YOffset = (bmiDest.bmiHeader.biHeight - 1) - MaxY
 
   ReDim DIBitsDest(0 To bmiDest.bmiHeader.biWidth * bmiDest.bmiHeader.biHeight - 1)
   
   bmiDest.bmiHeader.biHeight = -bmiDest.bmiHeader.biHeight
   
   If 0 = GetDIBits(DC, Pic.Handle, 0, Abs(bmiDest.bmiHeader.biHeight), DIBitsDest(0), bmiDest, DIB_RGB_COLORS) Then
       DeleteMemoryDC DC
       Exit Function
   End If
   
   bmiDest.bmiHeader.biHeight = -bmiDest.bmiHeader.biHeight
   
   GetPictureArray = DIBitsDest
   
   DeleteMemoryDC DC
   
End Function
 
' Written by Kevin Gadd
Sub DrawArrayToDC(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByRef Data() As Long)
On Error Resume Next
Dim bitDesc As BITMAPINFO
    With bitDesc.bmiHeader
        .biSize = Len(bitDesc.bmiHeader)
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        .biWidth = UBound(Data, 1) + 1
        .biHeight = -(UBound(Data, 2) + 1)
        .biSizeImage = 0
        .biXPelsPerMeter = 0
        .biYPelsPerMeter = 0
        .biClrImportant = vbNull
        .biClrUsed = vbNull
    End With
    StretchDIBits hDC, x, y, UBound(Data, 1) + 1, UBound(Data, 2) + 1, 0, 0, UBound(Data, 1) + 1, UBound(Data, 2) + 1, VarPtr(Data(0, 0)), bitDesc, DIB_RGB_COLORS, vbSrcCopy
End Sub
 
' Written by Benjamin Marty
Public Function CapturePicture(ByVal hDC As Long, ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long) As IPictureDisp
    Dim picGuid As iid
    Dim picDesc As PICTDESC
    Dim hdcMem As Long
    Dim hBmp As Long
    Dim hOldBmp As Long
    Dim Pic As IPictureDisp
    Dim rcBitmap As GITRect
    
    ' IID_IPictureDisp
    picGuid.x = &H7BF80981
    picGuid.s1 = &HBF32
    picGuid.s2 = &H101A
    picGuid.c(0) = &H8B
    picGuid.c(1) = &HBB
    picGuid.c(2) = &H0
    picGuid.c(3) = &HAA
    picGuid.c(4) = &H0
    picGuid.c(5) = &H30
    picGuid.c(6) = &HC
    picGuid.c(7) = &HAB
    
    picDesc.cbSizeOfStruct = Len(picDesc)
    hdcMem = CreateCompatibleDC(hDC)
    If hdcMem = 0 Then
        Exit Function
    End If
    hBmp = CreateCompatibleBitmap(hDC, Width, Height)
    If hBmp = 0 Then
        DeleteDC hdcMem
        Exit Function
    End If
    hOldBmp = SelectObject(hdcMem, hBmp)
    If Left >= 0 And Top >= 0 Then
        If BitBlt(hdcMem, 0, 0, Width, Height, hDC, Left, Top, vbSrcCopy) = 0 Then
            SelectObject hdcMem, hOldBmp
            DeleteDC hdcMem
            DeleteObject hBmp
            Exit Function
        End If
    Else
        With rcBitmap
           .Left = 0
           .Top = 0
           .Right = Width
           .Bottom = Height
        End With
        FillRect hdcMem, rcBitmap, GetStockObject(BLACK_BRUSH)
    End If
    SelectObject hdcMem, hOldBmp
    picDesc.hBitmap = hBmp
    picDesc.hPal = GetCurrentObject(hDC, OBJ_PAL)
    picDesc.picType = PICTYPE_BITMAP
    If OleCreatePictureIndirect(picDesc, picGuid, True, Pic) <> S_OK Then
        DeleteDC hdcMem
        DeleteObject hBmp
        Exit Function
    End If
    Set CapturePicture = Pic
    Set Pic = Nothing
    DeleteDC hdcMem
End Function

A universal code that would allow resizing of regions of the form.

In other words, the form gets split into say 2 rows and 3 columns and there are spaces in between where the user can resize that region of the form. I think someone posted good code on the forums that resized everything by scale. Maybe have the size of each region in an array and then use one function to handle the resizing. Can you do this with maybe a flexgrid, or frames collection, or maybe pictureboxes? What would be really cool is if left click on the "separator" object would just expand the region but right click would move the region so that the form would resize as well. This would be totally cool.

Prolly everybody and their grandmother know about this one, but go the the properties of the icon you use to start VB (wherever it is located).

On the shortcut-tab, change the start-in value to whereever it is you store your VB code.

Next time you start VB, if you click open, or save, you'll ve in that folder right away.


-Vf-

It seems that many people here don't know a cool trick that makes your program much easier to read and ==> debug.
Just use the underscore _ to continue a line onto the next line.

Espescially handy for declarinf functions or testing many ifs.
e.g. a function from below:

VB Code:

Public Declare Function StretchDIBits Lib "gdi32" _
(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, _
ByVal Width As Long, ByVal Height As Long, ByVal x2 As Long, _
ByVal y2 As Long, ByVal sWidth As Long, ByVal sHeight As Long, _
ByVal PointerToBits As Long, lpBitsInfo As BITMAPINFO, _
ByVal wUsage As Long, ByVal dwRop As Long) As Long

or such things like:
If a=b or_
a=c or_
a=d or_
a=e or_
a=f or_
....
a=z then

Adding to sql_lall's post. You can also do this with strings...

I.e. strErrormessage = "Error occurred " & _
"specification: " & Err.Number & _
Err.Description

-Vf-

Howdy

This function will return just the file / exe what ever from the full path.

ie StripFromPath("c:\program files\trancender\bob.exe") will return:

bob.exe

Code:

---


'Returns just the inplicit file from the whole path
Public Function StripFromPath(FullPath As String) As String

    'first check to see if the string is formatted correctly
    If InStr(1, FullPath, "\") Then
        'basically find the last back slash and use that postion to the
        'length of the sting to
        StripFromPath = Mid(FullPath, InStrRev(FullPath, "\") + 1, Len(FullPath))
   
    End If
   
End Function

---

Geoff

Firstly:
Another little thing that programmers may not know is that you can use : to put something that should be on two lines on the same line, this can be usefull when you know that some of the code doesn't need debug (like hardcoding the value of an array that will be use later) and is really long

VB Code:

Array(0) = "1" : Array(1) = "2" : Array(2) = "6"
...

Secondly:
this code resizes the controls of a form

VB Code:

' Thanks for MartinLiss for the original code
' This code was edited by STAii ([email protected])
Option Explicit
Private Type CtrlProportions
    HeightProportions As Single
    WidthProportions As Single
    TopProportions As Single
    LeftProportions As Single
    FormHwnd As Long
End Type
Dim ProportionsArray() As CtrlProportions
Dim NumberOfForms As Long
 
Public Sub InitResizeArray(AForm As Form)
On Error Resume Next
Dim I As Integer
NumberOfForms = NumberOfForms + 1
ReDim Preserve ProportionsArray(0 To AForm.Controls.Count, 1 To NumberOfForms)
ProportionsArray(0, NumberOfForms).FormHwnd = AForm.hWnd
For I = 1 To AForm.Controls.Count
    ProportionsArray(I, NumberOfForms).HeightProportions = AForm.Controls(I - 1).Height / AForm.ScaleHeight
    ProportionsArray(I, NumberOfForms).WidthProportions = AForm.Controls(I - 1).Width / AForm.ScaleWidth
    ProportionsArray(I, NumberOfForms).TopProportions = AForm.Controls(I - 1).Top / AForm.ScaleHeight
    ProportionsArray(I, NumberOfForms).LeftProportions = AForm.Controls(I - 1).Left / AForm.ScaleWidth
Next I
End Sub
 
Public Sub ResizeControls(AForm As Form)
On Error Resume Next
Dim I As Integer
Dim TempVar As Long
For I = 1 To NumberOfForms
    If ProportionsArray(0, I).FormHwnd = AForm.hWnd Then Exit For
Next I
If I = NumberOfForms + 1 Then Exit Sub
TempVar = I
For I = 1 To AForm.Controls.Count
    AForm.Controls(I - 1).Move ProportionsArray(I, TempVar).LeftProportions * AForm.ScaleWidth, _
    ProportionsArray(I, TempVar).TopProportions * AForm.ScaleHeight, _
    ProportionsArray(I, TempVar).WidthProportions * AForm.ScaleWidth
    AForm.Controls(I - 1).Height = ProportionsArray(I, TempVar).HeightProportions * AForm.ScaleHeight
Next I
End Sub

all you to do is to put (InitResizeArray Me) at form load, and (ResizeControls Me) at form resize (the aim of putting me is to use the function for several forms, put the code in a module then call it for wahtever form, it'll work for them all instead of caopying it for every form or making it a class module)

hope i helped

"The rumors of my death have been greatly exaggerated."

-- Tom Sawyer.






I am alive, and hit hard with jetlag, but I have posted all the tips (I hope) onto the site.

If I missed one, just let me know :)

hi
how can i make acommand bottom opens a file from my pc
i meen what do i have to write in the code
please help

Here's a tutorial from the FAQ that you might be interested in:

http://www.piqsoftware.com/projects/...faq/fileio.htm


For example, you could write:

VB Code:

Private Sub Command1_Click()
Dim FromFile As String
Dim FileNumber As Integer
 
FileNumber = FreeFile()
 
Open "c:\test.txt" For Output As #FileNumber
  Print #FileNumber, "Hello"
Close #FileNumber
 
Open "c:\test.txt" For Append As #FileNumber
  Print #FileNumber, "World"
Close #FileNumber
 
Open "c:\test.txt" For Input As #FileNumber
  Input #FileNumber, FromFile
Close #FileNumber
 
MsgBox FromFile
End Sub

Make sure the form has a button called Command1 first! When you click that button, this code will write "Hello" and "World" on two separate lines in the file c:\test.txt. If that file already exists, it will erase the file before writing to it. Otherwise, it will automatically create the file.

The code will then read the first line from the file, and show it in a message box.

Lewis,

Have you ever thought of putting all the code you have in a book and publishing it?

Uh, no actually...

think it would sell?

Quote:

---

Originally posted by mlewis
Uh, no actually...

think it would sell?

---

It was just a thought.

Maybe yet another tip that a lot of people will think is too obvious for words, but I've ran into experienced programmers who were not aware of this.

When you're in the code-window, you can start typing, and in the middle of the 'word' press CTRL+SPACE to have VB auto-complete the word for you. (The same way it shows a pop-up when you hit the dot (.) after an objectname, to access it's properties).

Using this, you can whip up code much faster, and in the process prevent typos with variablenames etc.

actually pressing CTRL+Space brings up the pop-up window, pressing space when one of the items in the list is highlighted autocompletes it for you ;)

maybe it's not a good tips but you forgot one of mine!

for a score for example, you want it to be

0000009845

just do


Right("0000000000" & yourScore,10)

see the above would be

00000000009845

so 0000 will be droped!!

Nightwalker: It's a cool idea, but I wouldn't feel right selling all the code that people contributed for free. I dunno..


darre1/viagrafalls: Tip published :)

Sebs: Sorry! I totally overlooked that one. Its been put up, sorry for the mistake :)

no problem bro!!

for the book, just do a pdf format of a book that all of us
can contribute nad when it's done, we could just print it!

i dunno, just a though!

Got any software that can write PDFs? :D

Adobe Acrobat!

Plus it can converts .doc to .pdf !

I don't know much about Acrobat! But i'm sure you can get it for
free on Morpheus or KaZaA, oops i did'nt say that!!

What about my other one? Page 5, third from the top. I find it quite usefull.

Just wondering if it got overlooked, or just not what you are looking for.

Must have been overlooked...

uhm, I don't see any posts by you on page 5. Could you quote it for me please?

Thanks :)

hey, mlewis,

Coming soon:
C/C++
HTML, JavaScript, VBScript, ASP
Handheld/PDA Development
Databases (mostly VB/ASP code)

this is from your site, can we post tips and trick in this thread
on those languages!

plus, it would be cool if you put a flash general and/or flash actionscript, problably a lot of us do some thing in flash
and i have a couple of tips and optimazation trick for it!

what do you think!!

Quote:

---

Prolly everybody and their grandmother know about this one, but go the the properties of the icon you use to start VB (wherever it is located).

On the shortcut-tab, change the start-in value to whereever it is you store your VB code.

Next time you start VB, if you click open, or save, you'll ve in that folder right away.


-Vf-

---

sebs: by all means! Post your tips and I'll start those sections!


v.f.: Posted -- sorry I missed it the first time :)

ok, i have a few asp one

To find out a images size

VB Code:

<%
  function GetBytes(flnm, offset, bytes)
     Dim objFSO
     Dim objFTemp
     Dim objTextStream
     Dim lngSize
 
     on error resume next
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     
     Set objFTemp = objFSO.GetFile(flnm)
     lngSize = objFTemp.Size
     set objFTemp = nothing
 
     fsoForReading = 1
     Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)
 
     if offset > 0 then
        strBuff = objTextStream.Read(offset - 1)
     end if
 
     if bytes = -1 then
        GetBytes = objTextStream.Read(lngSize)
     else
        GetBytes = objTextStream.Read(bytes)
     end if
 
     objTextStream.Close
     set objTextStream = nothing
     set objFSO = nothing
  end function
 
  function lngConvert(strTemp)
     lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
  end function
 
  function lngConvert2(strTemp)
     lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
  end function
 
  function gfxSpex(flnm, width, height, depth, strImageType)
     dim strPNG 
     dim strGIF
     dim strBMP
     dim strType
     strType = ""
     strImageType = "(unknown)"
 
     gfxSpex = False
 
     strPNG = chr(137) & chr(80) & chr(78)
     strGIF = "GIF"
     strBMP = chr(66) & chr(77)
 
     strType = GetBytes(flnm, 0, 3)
 
     if strType = strGIF then
        strImageType = "GIF"
        Width = lngConvert(GetBytes(flnm, 7, 2))
        Height = lngConvert(GetBytes(flnm, 9, 2))
        Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
        gfxSpex = True
     elseif left(strType, 2) = strBMP then
        strImageType = "BMP"
        Width = lngConvert(GetBytes(flnm, 19, 2))
        Height = lngConvert(GetBytes(flnm, 23, 2))
        Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
        gfxSpex = True
     elseif strType = strPNG then
        strImageType = "PNG"
        Width = lngConvert2(GetBytes(flnm, 19, 2))
        Height = lngConvert2(GetBytes(flnm, 23, 2))
        Depth = getBytes(flnm, 25, 2)
 
        select case asc(right(Depth,1))
           case 0
              Depth = 2 ^ (asc(left(Depth, 1)))
              gfxSpex = True
           case 2
              Depth = 2 ^ (asc(left(Depth, 1)) * 3)
              gfxSpex = True
           case 3
              Depth = 2 ^ (asc(left(Depth, 1)))
              gfxSpex = True
           case 4
              Depth = 2 ^ (asc(left(Depth, 1)) * 2)
              gfxSpex = True
           case 6
              Depth = 2 ^ (asc(left(Depth, 1)) * 4)
              gfxSpex = True
           case else
              Depth = -1
        end select
     else
        strBuff = GetBytes(flnm, 0, -1)
        lngSize = len(strBuff)
        flgFound = 0
 
        strTarget = chr(255) & chr(216) & chr(255)
        flgFound = instr(strBuff, strTarget)
 
        if flgFound = 0 then
           exit function
        end if
 
        strImageType = "JPG"
        lngPos = flgFound + 2
        ExitLoop = false
 
        do while ExitLoop = False and lngPos < lngSize
           do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
              lngPos = lngPos + 1
           loop
 
           if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
              lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
              lngPos = lngPos + lngMarkerSize  + 1
           else
              ExitLoop = True
           end if
       loop
 
       if ExitLoop = False then
          Width = -1
          Height = -1
          Depth = -1
       else
          Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
          Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
          Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
          gfxSpex = True
       end if
     end if
  end function
 
function FitPicture(strPath,max)
  if gfxSpex(strPath, w, h, c, strType) then
    if (cint(w)) > (cint(h)) then
      ratio=h/w
      FitPicture = "height='" & max  * ratio & "' width='" & max & "'" 
    else
      ratio=w/h
      FitPicture = "height='" & max & "' width='" & max * ratio & "'" 
    end if
  end if
end function
%>

so you can use FitPicture resize all the picture to a max heigth of width

you also use this function

VB Code:

Function getBits(ByVal LNum)
    Dim i
    Do Until (2^i = LNum) Or (i > 32)
        i = i + 1
    Loop
    GetBits = i & "Bits"
End Function

to find out hte depth of a picture in Bits

if you want to put a progress bar in a asp page:

put this in the body section of the page, before your asp

<div id="progressbar" style="position:absolute;width:280;height:50;top:20;left:20;z-index:1;visibility:visible;"></div>

put this asp function:

function writeProgress(b,value,max)
response.write "<script language=""javascript"">" & vbcrlf
response.write "document.all[""progressbar""].innerHTML=""<table border=0 width=80% cellpadding=0 cellspacing=0><tr><td height=10 width=" & value & "% ><table bgcolor=red width=100% height=100% cellpadding=0 cellspacing=0><tr><td></td></tr></table></td><td width=" & (100-value) & "% ><table bgcolor=black width=100% height=100% cellpadding=0 cellspacing=0><tr><td></td></tr></table></td></tr></table><br>" & round(value,2) & "%<br><br>"& b &"/" & max & " bytes"";"
response.write "</script>" & vbcrlf
end function

and call it like

writeProgress i,(i*100)/LenB(binaryFileContent),LenB(binaryFileContent)

this will only work in explorer, but it can be done for netscape with some little changes,i used it
for uploading, that why you see bytes!

another tip would be with form and asp!
when you have multiple dropdown, and when loading the page you need to preselect some, instead
of looping thru the value and select the corresponding one try this!

myDropDown="<SELECT NAME=carColor>" & vbCrLf _
& "<OPTION VALUE=1>Blue" & vbCrLf _
& "<OPTION VALUE=3>Red" & vbCrLf _
& "<OPTION VALUE=4>Yellow" & vbCrLf _
& "<OPTION VALUE=6>Brown" & vbCrLf _
& "<OPTION VALUE=7>Blue" & vbCrLf _
& "</SELECT>"

and then when you'll have you value,

let's say your color id is 3

<%=replace(myDropDown,"value=" & myColorId,"value=" & myColorId & " selected")%>

it will replace
<OPTION VALUE=3> with <OPTION VALUE=3 selected>

that's it for now!!
i have some for javascript and flash, but now i have work to do, so
when i'll have time today!

cheers

ASP tip:

You can mix ASP and html, like this:

<table>
<% For I = 1 to 5 %>
<tr>
<% For J = 1 to 5 %>
<td>
<% response.write I & " " & J %>
</td>
<% next %>
</tr>
<% Next %>
</table>

This makes a 5 x 5 table layout in loops.




Tip 2:

You can use <%= as a shorthand for <% response.write

Therefore, these lines are the same:

<% response.write "Test" %>
<%= "Test" %>


Note, however, that you can't use <%= inside of ASP tags. In other words, this will NOT work:

<%

Response.write "test1"
<%= "test2" %>

%>







Will post those later today when work is done :)

ASP tip,

you can assign Javascript variable



<SCRIPT language="javascript">
var myVar = '<%=myAspVariable%>';
alert(myVar);
</SCRIPT>

since the asp happens before the javascript!

Javascript tip:

to make a window modal :
<body onBlur="document.focus();">


a function similar to request.queryString() in asp

function request(obj){
var position=0;
var fullLength=0;
var value='';

url=new String(location.href);
fullLength=parseInt(url.length);
position=url.indexOf(obj);
if(position==-1 || url.charAt((position+obj.length+1))=='&'){
return '';
}else{
position += obj.length;

do{
position++;
value+=url.charAt(position);
}while(url.charAt((position+1))!='&' && (position+1)!=fullLength);

return unescape(value);
}
}

another tip would be when loading a images, you can put a layer that will take all you window size(or picture size)
and put picture loading... or something, and on your body tag do
<body onLoad="hideLayer();">

hideLayer is a function that hide the layer

how about to open a new thread for ASP tips
i don't think VB programmers that don't know about ASP would like to read asp tips

yeah, i could be a good idea!

well, until then, here's some flash tip:

Flash tips:

this one is obvious, but i remember when i started it was bugging me!

-try to get rid of the line if you don't need them, use them to fill in
object but delete them after! It's take more space in the files, it makes
ugly tweening and it does'nt rezise well!! Try it you'll see

-this one is an optimazation tip, when you have dynamic text box, to keep
the font anti-alias, you have to import some data for it! But only include
to one you need, if you know that only, number and $ . will go in,
well include the number and type in $., so flash will only export
0 to 9, $ and . , you save at least 20-40K on your files!!

-this is a prototype i made: it's like the Right function in VB:

Code:

---

String.prototype.right = function (numOf) {
        var tmp = "";
        for (x=this.length-numOf; x<this.length; x++) {
                tmp += this.charAt(x);
        }
        return tmp;
};

---

usage: myString.right(2);

-another tips, in case someone does'nt know, you can launch external file
within a flash projector, similar to shell in vb,

on (release) {
fscommand ("exec", "c:\\winnt\\notepad.exe");
}

will open notepad

Please post Web-related tips HERE

Thanks again everyone!

Hi Everyone,


Have had to post this in two parts.

Not all of this stuff is applicable to VB, but I have certainly found all of it applicable to VBA (M$ Access etc)...

Code:

---

Public Function LastSunday(ByVal paramDate As Date) As Variant
'Returns the closest previous Sunday to the date indicated...
   
   
    If IsNull(paramDate) Then Exit Function
    LastSunday = paramDate - WeekDay(paramDate, vbSunday) + 1
   
   
End Function




Public Function IsLeapYear(Optional ByVal paramDate As Date) As Boolean
'Returns whether or not the specified year is a leap year...

Dim target As Integer
   
   
    If IsNull(paramDate) Then Exit Function
    If IsMissing(paramDate) Then paramDate = DATE
   
    target = Year(paramDate)
   
    IsLeapYear = (target Mod 4 = 0) And (target Mod 400 <> 0) And (target Mod 100 <> 0)
   
   
End Function




Public Function crlf(Optional numberof As Integer) As String
'Returns a string containing 1 to 'numberof' crlfs...

Dim temp    As String
Dim n      As Long
   
    crlf = vbCrLf
    If Not IsMissing(numberof) Then
        For n = 1 To numberof - 1
            temp = temp & vbCrLf
        Next n
        crlf = crlf & temp
    End If


End Function




Public Function GetListItem(paramList As String, paramItem As Long, Optional paramDelim As String) As String
'Returns the nth item from a list...

Dim lngCount    As Long
Dim lngPos      As Long
Dim strDelim    As String * 1
Dim strPosition As String
Dim strFormat  As String
Dim lngFormat  As Long
Dim lngLength  As Long

On Error GoTo GetListItem_Error
   
   
'Parameter checks...
    If paramList = "" Then Error 2001
    If paramItem < 0 Then Error 2000
   
'Initialise...
    strDelim = ""
    strPosition = ""
    strFormat = String$(Len(Trim(Str$(Len(paramList)))), "0")
    lngFormat = Len(strFormat)
    lngCount = 0
    strDelim = IIf(IsMissing(paramDelim) Or IsNull(paramDelim), ",", LEFT$(paramDelim, 1))
   
'Count items in list...
    lngPos = InStr(paramList, strDelim)
    While lngPos > 0
        lngCount = lngCount + 1
        strPosition = strPosition + Format$(lngPos, strFormat)
        lngPos = InStr(lngPos + 1, paramList, strDelim)
    Wend

'Append start and end delimiter positions...
    strPosition = String$(lngFormat, "0") + strPosition + Format$(Len(paramList) + 1, strFormat)
   
'If the item number exceeds number of items in the list then error...
    If lngCount + 1 < paramItem Then Error 2000
   
'Work-out the start and end position of the list item...
    lngPos = Val(Mid$(strPosition, (paramItem - 1) * lngFormat + 1, lngFormat)) + 1
    lngLength = Val(Mid$(strPosition, paramItem * lngFormat + 1, lngFormat)) - lngPos
    GetListItem = Trim(Mid$(paramList, lngPos, lngLength))
   
   
GetListItem_Error:
    If Err.number <> 0 Then
        Select Case Err.number
           
            Case 2000
                MsgBox "GetListItem (" & Err.number & ": Invalid list item parameter)", vbCritical, "GetListItem"
               
            Case 2001
                MsgBox "GetListItem (" & Err.number & ": No items in list)", vbCritical, "GetListItem"
               
            Case Else
                MsgBox Err.DESCRIPTION, vbCritical, "GetListItem"
               
        End Select
    End If
   
End Function




Public Function CountListItems(paramList As String, Optional paramDelim As String) As Long
'version 1.0
'Counts the number of items in a list based on a delimiter...

Dim lngCount    As Long
Dim lngI        As Long
Dim strDelim    As String
Dim strList    As String
Dim t          As Single

On Error GoTo CountListItems_Error
   
   
'Check parameters...
    strList = Nz(paramList, "")
    lngCount = 0
   
    If Len(paramList) > 0 Then lngCount = 1
   
    If IsMissing(paramDelim) Then
        strDelim = ","
    Else
        strDelim = Nz(paramDelim, ",")
    End If
   
'Counting loop...
    lngI = InStr(strList, strDelim)
    While lngI > 0
        lngCount = lngCount + 1
        lngI = InStr(lngI + 1, strList, strDelim)
    Wend
   
'Assign count...
    CountListItems = lngCount
   
   
CountListItems_Error:
    If Err.number <> 0 Then
        MsgBox Err.DESCRIPTION, vbCritical, "CountListItems"
    End If
   
End Function




Public Function DePad(ByVal paramPhrase As String, Optional ByVal paramChar As String) As String
'Strip out multiple spaces from a phrase...
'version 1.0

Dim strTemp As String
Dim strChar As String
Dim n      As Long

On Error GoTo Depad_Error
   
   
'Trim starting spaces...
    paramPhrase = Trim(paramPhrase)
    paramChar = IIf(IsMissing(paramChar, " ", LEFT$(paramChar, 1))
    strTemp = ""
   
   
'Select case to do an auto-strip of all repeated characters...
    Select Case paramChar
   
        Case sysDePadAll
       
'Loop to get and compare each character with the next one...
            For n = 1 To Len(paramPhrase) - 1
               
                strChar = Mid(paramPhrase, n, 1)
               
'If they're both spaces, then only add one...
                If Not (strChar = Mid(paramPhrase, n + 1, 1)) Then
                    strTemp = strTemp + strChar
                End If
               
            Next n
           
            strTemp = strTemp + Right(paramPhrase, 1)
           
           
        Case Else
           
'Loop to get and compare each character with the next one...
            For n = 1 To Len(paramPhrase) - 1
               
                strChar = Mid(paramPhrase, n, 1)
               
'If they're both spaces, then only add one...
                If Not (strChar = paramChar And Mid(paramPhrase, n + 1, 1) = paramChar) Then
                    strTemp = strTemp + strChar
                End If
               
            Next n
           
            strTemp = strTemp + Right(paramPhrase, 1)
           
    End Select
   
'Assign the value...
    DePad = strTemp
   
   
Depad_Error:
    If Err.number <> 0 Then
        MsgBox Err.DESCRIPTION, vbCritical, "DePad"
    End If
   
End Function

---

<continued...>