Programming FAQ -- show off your cool tips here!

... finally

Code:

---

Public Function Strip(ByVal paramPhrase As String, ByVal paramRemove As String, paramSearchType As Integer) As String
'Strip characters from the string...
'version 1.0

Dim strLast As String
Dim strTemp As String
Dim strChar As String
Dim strWord As String
Dim lngWord As Long
Dim i      As Long
Dim j      As Long
Dim n      As Long

On Error GoTo Strip_Error
   
   
'Depad the phrase and word list...
    If paramSearchType = sysStripWord Then
        paramPhrase = DePad(paramPhrase, " ")
        paramRemove = " " + DePad(paramRemove, " ") + " "
    End If
   
'Main routine...
    Select Case paramSearchType
       
       
'Strip out each character...................................................................................
        Case sysStripChar
           
            For n = 1 To Len(paramPhrase)
                strChar = Mid$(paramPhrase, n, 1)
                If InStr(paramRemove, strChar) = 0 Then strTemp = strTemp + strChar
            Next n
           
           
'Strip out each word........................................................................................
        Case sysStripWord
           
'Assign the strings...
            strLast = Trim(paramRemove) + " "
            strTemp = " " + Trim(paramPhrase) + " "
           
'Look for the next space in Last and get the word...
            j = 1
            i = InStr(2, strLast, " ")
            strWord = " " + LEFT$(strLast, i - 1) + " "
           
'Repeat while there's a space left...
            While i > 0
               
'Determine if the word is in the string...
                n = InStr(strTemp, strWord)
                While n > 0
                   
'...then take it out...
                    lngWord = Len(strWord)
                    If n + lngWord < Len(strTemp) Then
                        strTemp = LEFT(strTemp, n - 1) + Mid(strTemp, n + lngWord)  'Middle of the string...
                    Else
                        strTemp = LEFT(strTemp, n - 1)                              'End of the string...
                    End If
                   
'...and do it all again...
                    n = InStr(strTemp, strWord)
                   
                Wend
               
'Get the next word...
                j = i + 1
                i = InStr(j, strLast, " ")
                If i > 0 Then strWord = " " + Trim(Mid$(strLast, j, i - j)) + " "
               
            Wend
           
           
'Strip out the phrase.......................................................................................
        Case sysStripPhrase
           
            strTemp = paramPhrase
            i = InStr(strTemp, paramRemove)
            lngWord = Len(paramRemove)
           
            While i > 0
               
                If i + lngWord < Len(strTemp) Then
                    strTemp = LEFT(strTemp, i - 1) + Mid(strTemp, i + lngWord)
                Else
                    strTemp = LEFT(strTemp, i - 1)
                End If
               
                i = InStr(strTemp, paramRemove)
               
            Wend
           
           
    End Select
   
    Strip = DePad(Trim(strTemp), " ")
   
   
Strip_Error:
    If Err.number <> 0 Then
        MsgBox Err.DESCRIPTION, vbCritical, "Strip"
    End If
   
End Function

---

The following commands are included:

<out_date> = LastSunday(<any_date>)
Returns the Sunday prior to the date indicated. Please note that this function forces Sunday as the first day of the week.

<out_date> = IsLeapYear([<any_date>])
Uses a fairly basic boolean calculation to assess whether the year specified is a leap year. Default is the current year.

<crlf_str> = crlf([<numberof_int>])
Creates a list of one or more vbCrLf's. (Very useful in the Query builder of M$ Access).


<item_str> = GetListItem(<itemlist_str>, <item_lng>[, <delim_str>)
Gets the n'th item from a list (string) delimitted by comma (default) or the character specified by the programmer.

<items_lng> = CoutListItems(<itemlist_str>[, <delim_str>)
Counts the number of items in a text list separated by comma (default) or the character specified by the programmer.

<text_str> = DePad(<phrase_str>[, <char_str>)
Depads (removes) multiple occurrences of the same character (default = space).

<text_str> = Strip(<phrase_str>, <remove_str>, <mode_int>)
Strips the specified characters, word or phrase from the <phrase_str> based on the mode (1 = Character, 2 = Word, 3 = Phrase).


Hope these prove useful to some of you.


Regards,

sorry Mandelbrot to tell you that most of your function can be done easily in VB
for example
instead of using your CoutListItems
use this

VB Code:

Ubound(Split(<Text>,<Seperator>))

i think it does the same ;)

Hi Staifour,


Have written these routines originally for VBA - M$ Access, and are very useful. Not so many functions in VBA - have to write yourself.


;)

hi this would

Quote:

---

Originally posted by Staifour
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

---

Doesn't work or me. I get a type mismatch on the form load event.

This is a good way to find only the filename from a path...
Like from :
C:\WINDOWS\test\test.txt
it would return only :
test.txt

VB Code:

Public Function IsolerNom(str As String) As String
 
    If (Instr(1,str,"\")) Then
        IsolerNom = Right(str, Len(str) - InStrRev(str, "\"))
    Else
        IsolerNom = str
    End If
 
End Function

Btw, GetFileTitle API does the same thing :cool:

Here's some that's useful in Microsoft Access (certainly upto 97, if not further) and also Excel...

CTRL + ; (Semicolon) Inserts the system date
CTRL + : (Colon) Inserts the system time
CTRL + ' (Apostrophe) Copies the equivalent field in the previous record (cell above - Excel)


:)

Yes, I Am still alive!


Sorry everyone for the delays, but I've been really busy lately. I just started working on moving the FAQ to a database, which means I will be able to let others moderate the FAQ and that will keep the load off of me.

The new admin features should be done and ready for use by the end of the week. Until then, I will be unable to make any updates.

I would very much appreciate any volunteers for the job of moderating the FAQ.

this is a module for sorting the listview control by whatever

If you want to sort some string arrays don´t use sortet listboxes. It´s a very slow method. I use these ol´ QuickSort for sorting.

And slightly modified you can use these Function to sort any portion of a string

Code:

---

' Sort the items in array values() with bounds min and max.
Sub Quicksort(values() As String, _
                ByVal SortStart As Integer, _
                ByVal SortLen As Integer, _
                ByVal min As Long, _
                ByVal max As Long)

    Dim med_value As String
    Dim hi As Long
    Dim lo As Long
    Dim i As Long
    On Error Resume Next
    ' If the list has only 1 item, it's sorted.
    If min >= max Then Exit Sub

    ' Pick a dividing item randomly.
    i = min + Int(Rnd(max - min + 1))
    med_value = values(i)

    ' Swap the dividing item to the front of the list.
    values(i) = values(min)

    ' Separate the list into sublists.
    lo = min
    hi = max
    Do
        ' Look down from hi for a value < med_value.
        Do While UCase(Mid$(values(hi), SortStart, SortLen)) >= _
                    UCase(Mid$(med_value, SortStart, SortLen))
            hi = hi - 1
            If hi <= lo Then Exit Do
        Loop

        If hi <= lo Then
            ' The list is separated.
            values(lo) = med_value
            Exit Do
        End If

        ' Swap the lo and hi values.
        values(lo) = values(hi)

        ' Look up from lo for a value >= med_value.
        lo = lo + 1
        Do While UCase(Mid$(values(lo), SortStart, SortLen) < _
                    UCase(Mid$(med_value, SortStart, SortLen)))
            lo = lo + 1
            If lo >= hi Then Exit Do
        Loop

        If lo >= hi Then
            ' The list is separated.
            lo = hi
            values(hi) = med_value
            Exit Do
        End If

        ' Swap the lo and hi values.
        values(hi) = values(lo)
    Loop ' Loop until the list is separated.

    ' Recursively sort the sublists.
    Quicksort values, SortStart, SortLen, min, lo - 1
    Quicksort values, SortStart, SortLen, lo + 1, max

End Sub

---

For those of you who use the TextStream object and are tired of getting the Input past end of file error then do this in a loop.

Code:

---

do until objTextStream.AtEndOfStream = true
'code
loop

---

yeah, and instead of looping thru the text files to
retrieve all of it's content just use:

objTextStream.ReadAll()

Quote:

---

Originally posted by sebs
yeah, and instead of looping thru the text files to
retrieve all of it's content just use:

objTextStream.ReadAll()

---

but sometimes it is usefull to loop through each line

yeah i know , i agree,
but sometime you want to get all the file content, and i remember
when i first started i use to loop thru to get all the content!!

If you want to save a gif or jpg as a bmp without using any control;

VB Code:

SavePicture LoadPicture(imageSrc), imgDestination

Sorry everyone, but my server went screwy today, and it looks like the FAQ may have been lost. I will try to keep you updated and see if I can salvage the site, but it may not happen.

:( :( :(

The FAQ has been moved to the PiQ forums rather than me wasting my valuable time writing a specialized system for it. Anyone who is interested in contributing to the FAQ, just head on over and have a look. No registration required.