Code samples please - for a VB book

Hi, I'm helping a friend write a VB book (i must add that he is much better at VB than I am!) and we want some ideas from you guys and some of your fave code samples would be cool too.

we currently have a framework for the following chapters...

* Recursion
* Manipulating Boolean Variables
* Flags
* Differences between IF...IIF...Select Case...Switch...Choose
* Loops (Various)
* Error Handling
* Compilation Options
* CODE OPTIMISATION!

Send us some code and / or explanations of your best programming techniques.

You'll get a full credit in the bibleography, goes to press in mid 2001.

[kedaman]

On the Recursion topic, i could give you my recursive Subdirs and file listing class:

Option Explicit
Event Filecatch(File As String, Path As String, level As Integer)
Event Direcatch(dire As String, Path As String, level As Integer)
Private curlevel As Integer
Private filemax As Long
Private diremax As Long
Sub explore(startdir$, Optional pauses = 100)
    filemax = 0: diremax = 0:  curlevel = 0
    If Right(startdir, 1) <> "\" Then startdir = startdir & "\"
    SubFiles startdir, pauses
End Sub
Property Get Filecount() As Long
    Filecount = filemax
End Property
Property Get Directorycount() As Long
    Directorycount = diremax
End Property
Function SubFiles(Path$, Optional pauses = 100): Dim i&, dmax&, dirname$, dire$(), threader&
    dirname = Dir(Path, 63)
    Do While dirname <> ""
        If dirname <> "." And dirname <> ".." Then
            If Int(GetAttr(Path + dirname) / 16) Mod 2 = 1 Then
                    If (dmax Mod 10) = 0 Then
                        ReDim Preserve dire(dmax + 10)    ' Resize the array.
                    End If
                diremax = diremax + 1: dmax = dmax + 1
                dire(dmax) = dirname
                RaiseEvent Direcatch(dirname, Path, curlevel)
            Else
                filemax = filemax + 1
                RaiseEvent Filecatch(dirname, Path, curlevel)
            End If
        End If
            dirname = Dir   ' Get another directory name.
        threader = threader + 1: If threader Mod (pauses) = 0 Then DoEvents
    Loop
    For i = 1 To dmax
        curlevel = curlevel + 1
        SubFiles Path & dire(i) & "\"
    Next i
    curlevel = curlevel - 1
End Function

Cool, now I have a version like yours and my version using the FSO.

Does anyone use Recursion to do anything other than Files / treeviews?

Any other subjects needed too

(Scribbling notes as i type)

[kedaman]

Yeah, sure but i have those in my current game i'm developing and those i don't think would fit in your friends book

Anyway, sort algoritms like quicksort use recursion, some search algoritms uses recursion, spy apps finding window handles in windows environment uses recursion, there's a lot of them

What about an API chapter?
And some of the source code that people often need is usually things you thought would be trivial, like Always-On-Top and adding an icon to the system tray.
Always on top:

Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As eZOrder, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As eSetWndPosFlags) As Long

Public Enum eZOrder
    HWND_BOTTOM = 1
    HWND_NOTOPMOST = -2
    HWND_TOP = 0
    HWND_TOPMOST = -1
End Enum

Public Enum eSetWndPosFlags
    SWP_NOMOVE = &H2
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
End Enum

Public Sub AlwaysOnTop(ByVal hWnd As Long, ByVal bAdd As Boolean)
   Select Case bAdd
      Case True
          SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
      Case False
            SetWindowPos hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
   End Select
End Sub

Good luck with the book.


[Edited by Sc0rp on 10-14-2000 at 11:56 AM]

wossname:
how is the target of the reader of the book, because i read few books.. most of them tried to sell books for beginner and moderate user (i don't think expert like you gutys need to read any more book ) so, it makes people difficult to follow.... so from the view of marketing, aim target before shooting...
also, i think API can be a big market... since moderate user would like to try it... but it is difficult to read todays' nAPI ... too difficult .... and lack of example like those mentioned above StayOnTop form or Icon staff ....

More opinion ? i think you might don't need them.. as I am not a programmer.......

[Jop]

Check out this threads I started a while ago.
before adding it to the book, ask the persons in question if you can use their code in a book (don't use code I posted unless the author is Jop, because most of the code I posted there I got from sites)

http://forums.vb-world.net/showthrea...threadid=32360

here are some of my snippets, they're pretty small and maybe useless but in case you need them
ehr... I got more complicated **** somewhere on CD's, I'll look them up for ya and post them if I have the time!

'[begin of code]
'Author: Jop
'Origin: ...
'Purpose: Convert Ascii numbers to binair numbers
'Version: VB5+

Private Function MakeBin()
Static bin As String, asc As Long
bin = ""
asc = Val(Text1.Text)
Do
'If 0 Then Exit the loop
If asc = 0 Then Exit Do
'Check if even
If asc Mod 2 = 0 Then
   'If even then add 0 to the binair number
   bin = "0" & bin
   'and divide ascii by 2
   asc = asc / 2
Else
   'If odd then add 1 to the binair number
   bin = "1" & bin
   'Subtract 1 and divide by 2
   asc = (asc - 1) / 2
End If
Loop

MakeBin = bin
End Function

'Usage: Text1.Text = MakeBin
'[end of code]

'[begin of code]
'Author: Jop
'Origin: 
'Purpose: Open a file with it's default program
'Version: Vb5+

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'Open a file with it's default program
Public Sub Execute(file As String)
    lngResult = ShellExecute(hWnd, "Open", file, "", "", vbNormalFocus)
End Sub

'Usage
'Call Execute("MyFile")


'[end of code]

'[begin of code]
'Author: Jop
'Origin: Inspired by some post on this forum (can't remember who)
'Purpose: Show or hide a window without unloading it.
'Version: VB5+

'Api calls
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Dim Myhwnd As Long, showme As Integer
Private Sub ShowHideWindow(Classname As String, WindowCaption As String, Show As Boolean)
If Classname = "" Then Classname = vbNullString
If WindowCaption = "" Then WindowCaption = vbNullString
'Find the window by either his classname or caption
    Myhwnd = FindWindow(Classname, WindowCaption)
'if found
    If Myhwnd <> 0 Then
    If Show = True Then
    showme = 5
    Else
    showme = 0
    End If
'Show or hide the window
    ShowWindow Myhwnd, showme
    End If
End Sub
'Usage: 
'ShowHideWindow "MYHANDLE", "MYCAPTION", True/False
'[end of code]

'[begin of code]
'Author: Jop
'Origin: 
'Purpose: Check if a number is Even or Odd
'Version: VB5+

Private Function IsEven(ByVal nr As Long) As Boolean
If nr Mod 2 = 0 Then
    'If Even
    IsEven = True
Else
    'If false
    IsEven = False
End If
End Function

'[end of code]

This one is of none interest for you I think

'[begin of code]
'Author: Jop
'Origin: 
'Purpose: Check if a number is a dutch telefone number
'Version: VB5+

Private Function isDPhoneNR(nr As String) As Boolean
If nr Like "###[!0-9]#######" Then
    If Mid(nr, 4, 1) = "-" Then
        isDPhoneNR = True
    End If
Else
    isDPhoneNR = False
End If
End Function

'[end of code]

'[begin of code]
'Author: Jop
'Origin: 
'Purpose: Check if a file is *empty*
'Version: VB5+

Private Function IsEmpty(File As String) As Boolean
If FileLen(File) = 0 Then
IsEmpty = True
Else
IsEmpty = False
End If
End Function

'USAGE:
'MsgBox IsEmpty("C:\jop\hehe.txt")


'[end of code]

This is to check if the source of a webpage is a 404 error message (not complete yet, add your own!)
Public Function Is404(str As String) As Boolean
str = LCase(str)
    Is404 = False
If str Like "*<title>404 file not found*</title>*" Then Is404 = True: Exit Function
If str Like "*error 404*" Then Is404 = True: Exit Function
If str Like "*404 file not found*" Then Is404 = True: Exit Function
If str Like "*404 not found*" Then Is404 = True: Exit Function
If str Like "*404 page not found*" Then Is404 = True: Exit Function
If str Like "*error file not found*" Then Is404 = True: Exit Function
If str Like "*the page cannot be found*" Then Is404 = True: Exit Function
If str Like "*404 page not found*" Then Is404 = True: Exit Function
If str Like "*404 - file not found*" Then Is404 = True: Exit Function
If str Like "*sorry, there is no microsoft.com web page matching your request*" Then Is404 = True: Exit Function
If str Like "*404: file not found*" Then Is404 = True: Exit Function
If str Like "*Error: file not found*" Then Is404 = True: Exit Function
'Geocities, fortunecity
If str Like "*whoops! we can't find your page!*" Then Is404 = True: Exit Function
If str Like "*404:<br> file not found*" Then Is404 = True: Exit Function
End Function

'MsgBox is404(MySource)
it's not good formatted yet, some bugs in it too :), I'm still busy with this for my own prog.

Hehe all pretty useless but it may inspire you

[Edited by Jop on 10-14-2000 at 02:16 PM]

[kedaman]

On the topic of flags, you could ask me a lot, well here's something you can think about:

Flags:
	2 Bit flags only:
		- The constants should be valued: 2^X for each flag X
		- Use OR operator, not + operator to add flags, since some constants are multiflags.
                - Use XOR carefully, if you want to substract flags from multiflags, NOT is actually safest
	multi bit flags:
		- Try optimizing each group of flags to be compatible with the rest, keep each group at 2^X
		- Use AND operator to check for a certain flaggroup value:
			(flag and nexflaggroup-thisflaggroup)
		For instance if you have a ENumeration:

Enum SWindowFlags
    gd_restored = 0 '(Flags and 3)=0
    gd_maximized = 1 '(Flags and 3)=1
    gd_minimized = 2 '(Flags and 3)=2
    gd_Undermove = 3 '(Flags and 3)=3
    gd_BoxFixed = 0 '(Flags and 12)=0
    gd_TitleFixed = 4 '(Flags and 12)=4
    gd_TitleResizableMini = 8 '(Flags and 12)=8
    gd_TitleResizableMiniMaxi = 12 '(Flags and 12)=12
    gd_Closebtn = 16
    gd_Helpbtn = 32
    gd_NoTrayIcon = 0
    gd_TrayIcon = 64
    gd_updown = 128 'Restoring up/maximizing not minimizing/restoring down
    gd_maximini = 256 'when maximizing/restoring down not minimizing/restoring up
End Enum
	
	now this is actually from my game, but i thought you could understand it better if you saw a example :)
	A window can't be both minimized and maximized at the same time you see?
	So what do you do? You add them into the same flaggroup and same some memory.
	The gd_restored group use therefor only the space for 2^0 and 2^1 instead of 2^0 - 2^3
	Now to know what state the the window is in use and operator:
MSgbox (Flags and 3) where the 3 is the next base (2^2) minus the first base the flagroup uses (2^0)

[kedaman]

Hey you, you have to learn how to use booleans too

Private Function IsEmpty(File As String) As Boolean
If FileLen(File) = 0 Then
IsEmpty = True
Else
IsEmpty = False
End If
End Function
'can be changed to:
Private Function IsEmpty(File As String) As Boolean
     IsEmpty=FileLen(File) = 0
End Function

= operation returns a boolean you know

[Jop]

hehe never saw it that way, but logical you're right : ) thanx for teaching man!

The target audience for this book is the "beginner".

Ahh, wait, i hear you cry. Define beginner.
Okay, I have the dubious blessing of being a beginner in the C++ language, while being quite well-versed in VB.

The things i desperately want to know how to to in C++ (writing to files and printers etc...) will be high up there on the equivalent VB schedule. Plus things like upper / lower case strings (comparisons).

I am also going to put in some real-world tasks to carry out. Of which i had plenty of need for at work when i was first learning VB. for instance, how to convert a CSV file into a fixed width file, and back again. This is very much sought after in the Data-capture industry.

I could go on for several hours, but I'd rather you went out and got the book when it goes on sale, lol!

Heck, we havent even though of a title for the book yet!

[[Digital-X-Treme]]

This is pretty cool, and simple. It is kinda like the pin thing on the windows in the C++ Dev Environment

Slap this into a class and call it "PinPoint.cls".

'Copyright, Digital-X-Treme 2K
Option Explicit

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40


Private Declare Sub SetWindowPos Lib "User32" (ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

Private mlngHwnd As Long    'Hwnd to object

'~~~Sets the Hwnd for use in the functions
Public Property Get Hwnd() As Long
    Hwnd = mlngHwnd
End Property

Public Property Let Hwnd(ByVal Data As Long)
    mlngHwnd = Data
End Property

Public Sub Pin()
    'Set the window position to topmost
    SetWindowPos mlngHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub

Public Sub UnPin()
    'Set the window to not topmost
    SetWindowPos mlngHwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub

Then, in a form, use the class like this. Add a check box and the following code to a form:

'Copyright, Digital-X-Treme 2K
Option Explicit
'Declare as many of these as you need (one for each form u want to be able to pin)
Private pinCls As PinPoint

Private Sub Check1_Click()

'True, it is checked
If Check1.Value = 1 Then
    'Pin the HWnd
    pinCls.Pin
Else
    'UnPin the hwnd
    pinCls.UnPin
End If

End Sub

Private Sub Form_Load()

Set pinCls = New PinPoint
'Set the Hwnd of the form to pin
pinCls.Hwnd = frmBlah.Hwnd
'Pin it.
pinCls.Pin

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set pinCls = Nothing
End Sub

If you wanna use it you can, just give me credit. Cheers :P

Laterz.

I think this thread can go on endlessly if people are just posting code samples. Why not go to some sites and see what types they have, ie: look under the Topic Areas section of VB-World. Or search planet-source-code.com for a specific code.

[kedaman]

Well actually wossname put those topics right from the book and i think it's good if he got the tips, at least those you don't get usually even by searhing for them

Hey, this is some good stuff guys, thanks. Don't stop though! heh heh

Should have this book well on its way soon.

[kedaman]

Error handling!! Yeah, this one i'm sure not many knows, at least those who haven't used qbasic
ERL - ERROR LINE (where did the error occur?)

On Error GoTo handler
1: Err.Raise 9
2: Err.Raise 10
a: Err.Raise 11
3: Err.Raise 12
Exit Sub
handler:
    MsgBox "Line number:" & Erl & " Error Number:" & Err & " description:" & Err.Description
    Resume Next

Note, the label a: will refer back to 2, so use numbers as labels, and use text labels to make "groups"
well, i guess you know the other way to handle errors, with on error resume next, you already know what line cause them, but on the other hand it may be a mess with integrated error handling.

On Local error resume next - will only catch errors from withing current procedure.

On error goto 0 - ends the error handling sometimes you need to do that.
well i hope i got you enough about error handling.