Programming FAQ -- show off your cool tips here!

[Bongo]

BrianHawley - you made it quite clear - and be honest I can not
understand the fass about this copyright here in a Forum. This
does not include whole pieces of Software. I put a copyright on
my SW as well.

But for snipplets or small routines here in the forum I think we
should not be so picky.

As you mentioned If I realy would develop a new (and deffenitly the best) sorting algo. I think I would not release the code before
I have the proper copyright on it.


Interesting is actualy the point you mentioned that MS has allready
testes most thinks - therfore the copyright should actually with them. So if we go this rouad further actually everey peace of SW
written with there development tools are belonging to them????

[BrianHawley]

Originally posted by Bongo
So if we go this rouad further actually everey peace of SW
written with there development tools are belonging to them????

I would not go that far. But if you write a trivial routine that just calls a MS API, it's hardly worth trying to copyright it. The main benefit of the code is to execute the API, and that's all MS code, not yours - so your copyright is trivial.

A lawyer friend of mine has just read my earlier posting and says I'm not quite right. In a trivial copyright case, the court may find that you DO technically own the copyright on the code, but they will only give you small damages (maybe one penny) to punish you for wasting everybody's time, even though you are technically in the right.

[Bongo]

Originally posted by BrianHawley


In a trivial copyright case, the court may find that you DO technically own the copyright on the code, but they will only give you small damages (maybe one penny) to punish you for wasting everybody's time, even though you are technically in the right.

I like this scenario.

ok in the end of the day most of my work is owned by my clients (contracter) and the few Apps I wrote are so specific so there are not on the market for sell.

[BrianHawley]

Originally posted by Bongo


I like this scenario.

ok in the end of the day most of my work is owned by my clients (contracter) and the few Apps I wrote are so specific so there are not on the market for sell.

What can I say? Life's a bummer.

Better knock it off with this discussion or we will be in trouble for thread degeneration.

[jian2587]

Let's not tied by all these copyright stuffs.
Use it freely. What's more this is a tips thread.
We came here to learn new stuffs.

[mlewis]

ROFL this thread got WAY off topic

Back to the FAQ. (gee what a [corny] rhyme! wow!)


I like the idea of letting members maintain the FAQ, but I would have to trust the moderators explicitly before I let them fark around on me web site

If anyone is willing to be a guinea pig -- erm, volunteer -- for the moderating position, just speak up.

I know you kicked the idea around earlier in this thread, but if you are serious about moderating the FAQ, please PM or email me using the coooool little buttons below this post.

There are no perks for moderating the FAQ, except you might get a little fame and glory by having your name on the Moderators list. No cars, no cash, no women, nothing -- those are all for me (j/k)



Also someone asked earlier how much it costs to register a copyright. Technically, $25 US per entry. Thats per entry tho -- if you want to copy code AND interface, you have to pay for 2 entries (last time I checked.) However, if you copyright 30 different windows for your interface, its only one entry as long as your screeen shots are all together in the package.

Of course, you also have to pay for shipping/postage, for the CDs/floppies that your copyrighted material is on (so they can test it out and never send it back) and all that good stuff. But its worth it -- for $200 at the MOST you can have the full legal rights to sue the living crap out of anyone that violates your copyright




Anyway, I am still on my @%$#@^%$#^@%$ trip so I won't be able to do anything on the site, but as soon as I get back to my beloved workstation I will get that moderation stuff going. Priviledged users will be able to:

Post news items on the site
Post items to the FAQ
other cool stuff later in life


The main problem here is that I will have to reconfigure the site to quit storing HTML and start storing the FAQ in the database. I suppose I was a bit of an idiot for not doing that at the very beginning, but oh well

Look for all these updates ... uh.... sometime. I have 2 days to do those changes (which will be busy as heck) and then ANOTHER trip, this time longer. Crap. Hopefully I will have more free time on the next one...

Better go before my timesheet starts looking suspicious

[Wokawidget]

Originally posted by agent
haven't read through all the posts, but...

this code

If a = "Hello" Then
    b = "Hi"
Else
    b = "Bye"
End If

has the same effect as

b = Iif(a = "Hello", "Hi", "Bye)

Agreed, but the IIf statement is 3 times slower! Not recommended if you require your program to be as fast as possible. It's also the same as:

Select Case a
   Case "Hello"
      b = "Hi!"
   Case Else
      b = "Bye"
End Select

But again, this is slower than the If Then command.
Here's a bench test program I wrote for Vb to work out which commands are the fastest...You will have to replace the Connection string for ADO if you want to bench test it

I appologies for the programming code, I was very hungover, tired and had someone pestering me while I wrote it, so yes I know, it's bad, but it still gives you an idea of speeds.

[Nightwalker83]

Originally posted by mlewis
ROFL this thread got WAY off topic

Back to the FAQ. (gee what a [corny] rhyme! wow!)


I like the idea of letting members maintain the FAQ, but I would have to trust the moderators explicitly before I let them fark around on me web site

If anyone is willing to be a guinea pig -- erm, volunteer -- for the moderating position, just speak up.

I know you kicked the idea around earlier in this thread, but if you are serious about moderating the FAQ, please PM or email me using the coooool little buttons below this post.

There are no perks for moderating the FAQ, except you might get a little fame and glory by having your name on the Moderators list. No cars, no cash, no women, nothing -- those are all for me (j/k)



Also someone asked earlier how much it costs to register a copyright. Technically, $25 US per entry. Thats per entry tho -- if you want to copy code AND interface, you have to pay for 2 entries (last time I checked.) However, if you copyright 30 different windows for your interface, its only one entry as long as your screeen shots are all together in the package.

Of course, you also have to pay for shipping/postage, for the CDs/floppies that your copyrighted material is on (so they can test it out and never send it back) and all that good stuff. But its worth it -- for $200 at the MOST you can have the full legal rights to sue the living crap out of anyone that violates your copyright




Anyway, I am still on my @%$#@^%$#^@%$ trip so I won't be able to do anything on the site, but as soon as I get back to my beloved workstation I will get that moderation stuff going. Priviledged users will be able to:

Post news items on the site
Post items to the FAQ
other cool stuff later in life


The main problem here is that I will have to reconfigure the site to quit storing HTML and start storing the FAQ in the database. I suppose I was a bit of an idiot for not doing that at the very beginning, but oh well

Look for all these updates ... uh.... sometime. I have 2 days to do those changes (which will be busy as heck) and then ANOTHER trip, this time longer. Crap. Hopefully I will have more free time on the next one...

Better go before my timesheet starts looking suspicious

Yeah ok I be a guinea pig for your site. Thanx for the info on the copright rights.

[nishantp]

I thought this was really really cool. its a text box with enhanced capabilities because of a class. Could save people a lot of hassle.

http://www.planet-source-code.com/vb...31890&lngWId=1

[peet]

Remove recent files from vb-ide

Open RegEdit And delete all values In:
HKEY_CURRENT_USER\Software\Microsoft\Visual Basic\6.0\RecentFiles

[jian2587]

I would like to share my vb's source codes gathered from
everywhere - vbworld,PSC,... with others

It's categorized. And every code is seperated by 4 lines
And every code has a remark on top to tell what it does

Later on I'll post source on DirectX7 and DirectX8...

Hope it helps.

[BrianHawley]

How about some .net stuff?

All these VB6 tips are going to be gathering dust soon.

(Stands back and waits to be flamed)

[jian2587]

Nope! I actually dont use .NET and wont forever!(Er...Perhaps
I may have exception later when XP is really popular and when
I get new PC:P120Mhz cant use XP!

The VB tips I posted does has lots of advance cool tips!
If nobody d/l it it's fine, I'll delete the post rightaway!

[BrianHawley]

Originally posted by jian2587
Nope! I actually dont use .NET and wont forever!(Er...Perhaps
I may have exception later when XP is really popular and when
I get new PC:P120Mhz cant use XP!

The VB tips I posted does has lots of advance cool tips!
If nobody d/l it it's fine, I'll delete the post rightaway!

Hey, don't take it too seriously. I meant the whole thread, not just your last post.

I'm just trying to get more people interested in .net.

I agree that VB6 wil be around for a long time, because of hardware limitations if nothing else. But .net WILL take over at some point (how many people are still using vb4?) and we should all start getting ready as soon as we can.

Also a lot of VB6 tips also work in .net with a few small changes.

[jian2587]

Same to you too, pls dont take so seriously on my previous
post. I just put a couplar of !...

I'll stick to VB6. Unless .NET is really popular.
Hey,BTW, I dont know why everybody hates Microsoft,
and yet use their products, it looks like everybody
desperated...Me too, I use their products, just because:
1.Most popular PC games platform
2.Most popular software development target platform
3.Most users use.
4.Get it for A few dollars(pirated) :just kidding
5.Most familiar
6.Most unstable OS ever used(I like the BSOD and illegal
operation ,I've chance to hit my CPU like a mad cow
7.Compatibilty with others
(Or is it others try to compatible with it?!!)

[E-Link]

This code shows a simple way of 'hooking' modal windows (MsgBox or InputBox) and changing their behavior.

'PUT BELOW DECLARATIONS IN A .BAS MODULE
 
Option Explicit
 
Private Declare Function FindWindow Lib "user32" Alias _
   "FindWindowA" (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long
 
Private Declare Function FindWindowEx Lib "user32" Alias _
  "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
   ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
   
Public Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
   lpTimerFunc&)
 
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&)
 
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
 
Const EM_SETPASSWORDCHAR = &HCC
Public Const NV_INPUTBOX As Long = &H5000&
 
Public Sub TimerProc(ByVal hwnd&, ByVal uMsg&, _
   ByVal idEvent&, ByVal dwTime&)
 
    Dim EditHwnd As Long
 
' CHANGE APP.TITLE TO YOUR INPUT BOX TITLE.
 
    EditHwnd = FindWindowEx(FindWindow("#32770", App.Title), _
       0, "Edit", "")
 
    Call SendMessage(EditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)
    KillTimer hwnd, idEvent
End Sub
 
'THIS IS HOW TO USE THE CODE FROM WITHIN A FORM
 
Private Sub Command1_Click()
  Dim ret As String
  SetTimer hwnd, NV_INPUTBOX, 10, AddressOf TimerProc
  ret = InputBox("Enter Password")
End Sub

[mlewis]

Nice! I'll post that as soon as I get a chance!

[E-Link]

this code will show BackGround Wallpaper on Form

Private Declare Function PaintDesktop Lib "user32" _
(ByVal hdc As Long) As Long
 
 
 
Private Sub Command1_Click()
PaintDesktop Form1.hdc
 
End Sub

[BrianHawley]

This is a .net function that returns the CPU serial number.

Good for security and activation routines that need to ID the PC.

Not all CPU's will do this, so you may need to fall back to a MAC number. (Code available to do this. Just ask.)

Not tested much on a range of PC's and OS's, so I would value any comments.

I'm also fairly new to .net, so feel free to point out any errors or missed optimisations.

'--------------------------------
'This is vb.net code. It will not work with vb6
'or earlier.
'--------------------------------
 
Option Strict On
 
Imports System.management
'--------------------------------
'If System.management (above) is underlined in blue, then you need
'to add it to the project references. Click on Project, Add Reference
'Click on the .NET tab, then select System.management from the table.
'Click on Select then OK.
'--------------------------------
 
Module Module1
 
 
  Function GetProcessorUniqueID() As String
 
    'PURPOSE: This function returns the UniqueID of
    '         the processor. (The serial number of the 
    '         CPU.) It is useful for software activation
    '         and protection routines that need to uniquely
    '         identify a processor. Note that not all
    '         processors return this number, so you may need
    '         to fallback to a network card MAC number or
    '         other unique identifier. But this is the best
    '         thing to use, if the processor provides it.
    '
    '         Quickly hacked together by Brian Hawley
    '         and hardly tested at all. Could probably use 
    '         a lot of improvement and testing. Any suggestions,
    '         flaming or praise to VB Q & A on [url]www.vbforums.com[/url] 
    '         or to [email][email protected][/email]
    '
    '         Note that Win32_Processor/UniqueID is only
    '         one example of a whole load of stuff available in
    '         System.management. It's worth exploring. 
 
    Dim mc As ManagementClass
    Dim moc As ManagementObjectCollection
    Dim mo As ManagementObject
    Dim UniqueIDs As String()
 
    mc = New ManagementClass("Win32_Processor") 'Create the management class
    moc = mc.GetInstances()    'Get all the instances. (May be more than one CPU)
    For Each mo In moc    'Check each one
 
      'Increase the size of the array as required.
      '(Yes, I know there is a better way, but I wanted to play
      'with Try Catch.)
      Try
        ReDim Preserve UniqueIDs(UBound(UniqueIDs) + 1)
      Catch
        ReDim UniqueIDs(0)
      End Try
 
      'Stick the result in the array
      UniqueIDs(UBound(UniqueIDs)) = Convert.ToString(mo.Item("UniqueId"))
 
      mo.Dispose()    ' Not sure if I need this, but it can`t hurt.
 
    Next
 
    'Not that UniqueIDsis an array as there may be more than one processor.
    'We only return the first element here, which is the first processor,
    'but there could be several (if you or your client are rich).
 
    Return UniqueIDs(0)
 
    End Function
 
End Module

[sebs]

It's kind a weird that there's 2 thread almost the same!!

But anyway, i post it there and i might as well do it here too:

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!!

[yak77]

This might sound amateurish,but i'm writing it anyway.

To set the font and font size of all controls on a form to values other then the default values, change the font and font size of the form itself(instead of changing it for every control). Any control placed on the form now will have the form's font and font size

[darre1]

Originally posted by yak77
This might sound amateurish,but i'm writing it anyway.

To set the font and font size of all controls on a form to values other then the default values, change the font and font size of the form itself(instead of changing it for every control). Any control placed on the form now will have the form's font and font size

cool

[mlewis]

Actually that's a very useful trick that most programmer's aren't aware of. It will make a good addition to the FAQ

[Nightwalker83]

Originally posted by mlewis
Actually that's a very useful trick that most programmer's aren't aware of. It will make a good addition to the FAQ

I found it out by playing with the controls and forms one day.

[Arc]

Someone Might find this usefull.


This is a function i wrote to return a random file from the Directory Given.

Private Function ReturnRandomFile(Directory As String) As String
Dim i As Integer, File As String
a = Mid(Directory, Len(Directory), 1)
If a <> "\" Then Directory = Directory & "\"
 File = Dir$(Directory, vbDirectory)
Do While File <> ""
DoEvents
i = i + 1
File = Dir$
Loop
 
Randomize
x = Int(i * Rnd) + 1
i = 0
 
File = Dir$(Directory, vbDirectory)
Do While File <> ""
i = i + 1
If i >= x Then Exit Do
File = Dir$
ReturnRandomFile = Directory & "\" & File
Loop
End Function

use it like this

Text1 = ReturnRandomFile("C:\Windows")

Or if you were using it toput random pictures in a picture box you would do this.

Picture1.Picture =LoadPicture(ReturnRandomFile("C:\MyPics"))

[srvb]

Nice tips, but tips can suits everyone more if all this tips are copied into a file .doc or .txt form in zip format and re post it. No one have time to go through all 14 pages. With Index is better one.

I usually copy some tips or solution to a particular problems into a word file and refer it later if I encounter that problems.

Any suggestions guys / gals.

[Nightwalker83]

Originally posted by srvb
Nice tips, but tips can suits everyone more if all this tips are copied into a file .doc or .txt form in zip format and re post it. No one have time to go through all 14 pages. With Index is better one.

I usually copy some tips or solution to a particular problems into a word file and refer it later if I encounter that problems.

Any suggestions guys / gals.

You can't copy the FAQ because you don't have Mr. Lewis promission to do so.

[srvb]

Originally posted by Nightwalker83


You can't copy the FAQ because you don't have Mr. Lewis promission to do so.

I mean the re-modification of this post so it is naturally directed to mlewis. And request suggestions from other viewers.

[jian2587]

How's my vb_src.zip?
The files are in .diz file.
Just use the folder options to make it be able to displayed
using notepad.
Are my tips good?
Should I make a database program and put all these nice tips
into it? So searching for it would be easy.

[BrianHawley]

Originally posted by Arc
[B]...This is a function i wrote to return a random file from the Directory Given....

Maybe evil is in the eye of the beholder, but is there any reason to retrieve a random file name, except for a trojan or virus?

Does Arc have a Dark Side?

[mlewis]

Well, there are several uses for getting a random file. Like someone mentioned above, if you want to load a random picture file from a given folder, that code is highly useful. It also works well for other cases where you need to randomly select something that for some reason needs to be stored in a separate file.


Regarding the FAQ: the code in the FAQ is provided free of charge. Users may copy, use, modify, and/or redistribute the code portion of the FAQ. All other materials are technically mine, and I wouldn't appreciate people copying things that I wrote (e.g. tutorials on file I/O).

I will be adding a copyright notice to the FAQ soon, to alert people to this fact.

[Arc]

Here is a Sub i wrote that will Fade the Background of any control with an hDC property. Such as Forms, PictureBoxes etc... Will fade either Vertically or horizontaly using any 2 RGB colors you specify. Paste all this into a Module.

Public Declare Function GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Public Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Type TRIVERTEX
            X As Long
            Y As Long
            R As Integer
            G As Integer
            B As Integer
            Alpha As Integer
End Type
Type LOGBRUSH
    lbStyle As Long
    lbColor As Long
    lbHatch As Long
End Type
Public Type GRADIENT_RECT
            UpperLeft As Long
            LowerRight As Long  '
End Type
 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Type RGB
            R As Integer
            G As Integer
            B As Integer
End Type
Public Const GRADIENT_FILL_RECT_H As Long = &H0
Public Const GRADIENT_FILL_RECT_V  As Long = &H1
Dim ItemRct As RECT
Public Sub LongToRGB(ByVal Color As Long, Optional ByRef red As Long, Optional ByRef green As Long, Optional ByRef blue As Long)
       red = Color And &HFF&
    green = (Color And &HFF00&) / &H100
    blue = (Color And &HFF0000) / &H10000
End Sub
Public Sub DrawBackGrad(ByVal hdc As Long, R As RECT, _
                        Color1 As RGB, _
                        Color2 As RGB, _
                        Direction As Long)
Dim V(1) As TRIVERTEX
    Dim GRct As GRADIENT_RECT
    With V(0)
        .X = R.Left
        .Y = R.Top
        .R = Color1.R
        .G = Color1.G
        .B = Color1.B
        .Alpha = 0
    End With
    With V(1)
        .X = R.Right
        .Y = R.Bottom
        .R = Color2.R
        .G = Color2.G
        .B = Color2.B
        .Alpha = 0
    End With
    GRct.UpperLeft = 0
    GRct.LowerRight = 1
GradientFillRect hdc, V(0), 2, GRct, 1, Direction
End Sub
Sub FadeBackGround(obj As Object, Color1 As Long, Color2 As Long, Vertical As Boolean)
On Error Resume Next
Dim cGrad1 As RGB
Dim cGrad2 As RGB
cGrad1 = GetRGBColors(GetLngColor(Color1))
cGrad2 = GetRGBColors(GetLngColor(Color2))
Call SetRect(ItemRct, 0, 0, obj.Width / Screen.TwipsPerPixelX, obj.Height / Screen.TwipsPerPixelY)
If Vertical = True Then
DrawBackGrad obj.hdc, ItemRct, cGrad1, cGrad2, GRADIENT_FILL_RECT_V
Else
DrawBackGrad obj.hdc, ItemRct, cGrad1, cGrad2, GRADIENT_FILL_RECT_H
End If
End Sub
Public Function GetLngColor(Color As Long) As Long
On Error Resume Next
    If Color And &H80000000 Then
       GetLngColor = GetSysColor(Color And &H7FFFFFFF)
    Else
       GetLngColor = Color
    End If
End Function
Public Function GetRGBColors(Color As Long) As RGB
On Error Resume Next
    Dim HexColor As String
    HexColor = String(6 - Len(Hex(Color)), "0") & Hex(Color)
    GetRGBColors.R = "&H" & Mid(HexColor, 5, 2) & "00"
    GetRGBColors.G = "&H" & Mid(HexColor, 3, 2) & "00"
    GetRGBColors.B = "&H" & Mid(HexColor, 1, 2) & "00"
End Function
Sub Pause(interval)
current = Timer
Do While Timer - current < Val(interval)
DoEvents
Loop
End Sub

Then to use it do something like...

Complex Example:

'This will randomly fade the control or form with different colors
Private Sub Command1_Click()
On Error Resume Next
Dim R As Long, B As Long, G As Long
Dim reverseR As Boolean, reverseB As Boolean, reverseG As Boolean
R = 0
B = 100
G = 200
Do
DoEvents
Pause (0.01)
If reverseR = False Then R = R + 2
If reverseB = False Then B = B + 3
If reverseG = False Then G = G + 5
If reverseR = True Then R = R - 2
If reverseB = True Then B = B - 3
If reverseG = True Then G = G - 5
If R >= 255 Then reverseR = True
If B >= 255 Then reverseB = True
If G >= 255 Then reverseG = True
If R <= 0 Then reverseR = False
If B <= 0 Then reverseB = False
If G <= 0 Then reverseG = False
Call FadeBackGround(Form1, RGB(R, G, B), RGB(R + 123, G + 234, B + 123), True)
Loop
End Sub

Simple Example:

Private Sub Form_Paint()
Call FadeBackGround(Form1, RGB(255, 255, 255), RGB(0, 0, 0), True)
End Sub

[JoshT]

Here's how to write a CGI app in VB. I don't know why anyone would want to do this except to prove it can be done:

Option Explicit
 
Private Const STD_ERROR_HANDLE As Long = -12&
Private Const STD_INPUT_HANDLE As Long = -10&
Private Const STD_OUTPUT_HANDLE As Long = -11&
 
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1&
Private Const OPEN_ALWAYS As Long = 4&
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
 
Private Const FILE_END As Long = 2&
 
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
 
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, _
    lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
    
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long
    
Public Declare Function SetFilePointer Lib "kernel32.dll" (ByVal hFile As Long, _
    ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, _
    ByVal dwMoveMethod As Long) As Long
 
Private Declare Function GetStdHandle Lib "kernel32" _
    (ByVal nStdHandle As Long) As Long
    
Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" _
    (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
 
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
 
Public Sub Main()
    Dim STDOUT As Long 'handle to standard output
    Dim strHTTP As String 'data buffer for HTTP header output
    Dim strBuffer As String 'data buffer for writing to the log file
    Dim lngBytesWritten As Long 'the number of bytes that were written
    Dim retval As Long 'API return value
    Dim FILEOUT As Long 'handle to the file to log to
    'CGI Variables
    Dim strQueryString As String
    Dim strRemoteAddr As String
    Dim strHTTPUserAgent As String
    
    'fill the buffers with nothing
    strQueryString = Space$(256)
    strRemoteAddr = strQueryString
    strHTTPUserAgent = strQueryString
    
    'get and store the CGI variables needed
    retval = GetEnvironmentVariable("QUERY_STRING", strQueryString, 256)
    strQueryString = Left$(strQueryString, retval)
    retval = GetEnvironmentVariable("REMOTE_ADDR", strRemoteAddr, 256)
    strRemoteAddr = Left$(strRemoteAddr, retval)
    retval = GetEnvironmentVariable("HTTP_USER_AGENT", strHTTPUserAgent, 256)
    strHTTPUserAgent = Left$(strHTTPUserAgent, retval)
    
    strHTTP = "Location: ./win2000.gif" & vbCrLf & vbCrLf
    
    'start the console
    'retval = AllocConsole 'UNCOMMENT FOR IDE DEBUGGING
    
    'get the handle to standard output
    STDOUT = GetStdHandle(STD_OUTPUT_HANDLE)
   
    'write the string to STDOUT, just like writing to a file
    retval = WriteFile(STDOUT, ByVal strHTTP, Len(strHTTP), lngBytesWritten, ByVal 0&)
 
    'close the handle to standard out
    retval = CloseHandle(STDOUT)
    
    'close the console
    'retval = FreeConsole 'UNCOMMENT FOR IDE DEBUGGING
    
    'open the file for writing
    FILEOUT = CreateFile("C:\Inetpub\wwwroot\Test\image.log", GENERIC_WRITE, FILE_SHARE_READ, _
        ByVal 0&, OPEN_ALWAYS, FILE_ATTRIBUTE_ARCHIVE, 0)
    
    'if error
    If FILEOUT = -1 Then Exit Sub
        
    'fill the buffer
    strBuffer = Now & ";" & strQueryString & ";" & strRemoteAddr & ";" & strHTTPUserAgent & vbCrLf
        
    'move the file pointer to EOF
    retval = SetFilePointer(FILEOUT, 0, 0, FILE_END)
    
    'write the buffer to the file
    retval = WriteFile(FILEOUT, ByVal strBuffer, Len(strBuffer), lngBytesWritten, ByVal 0&)
        
    'close the handle to the file
    retval = CloseHandle(FILEOUT)
End Sub

[Arc]

Heres a function I wrote that is the opposite of IsNumeric. It checks to see if a string is only Alphabetic characters.

Function IsAlphabetic(sString As String) As Boolean
Dim GetChars As String
Dim i As Integer
   For i = 1 To Len(sString)
      GetChars = Mid(sString, i, 1)
      Select Case Asc(GetChars)
         Case Asc("A") To Asc("Z")
         Case Asc("a") To Asc("z")
         Case Else
            Exit Function
      End Select
   Next i
   IsAlphabetic = True
End Function

Use it Like

If IsAlphabetic(text1) then Msgbox "Only Letters are in text1"

[Aaron Young]

You can do the same thing, like this:

Function IsAlpha(ByVal sString As String) As Boolean
    IsAlpha = LCase$(sString$) Like Replace$(Space$(Len(sString$)), " ", "[a-z]")
End Function

[jian2587]

Well, the gradient fill seems to be complicated, how about this?
Put a picturebox in a form, set it's Autoredraw property to
True

Private Sub Picture1_Click()
Dim FR, FG, FB, LR, LG, LB
Dim SR, SG, SB
'Any value between 0 and 255 will do for these variables
'They determine ur first color and last color
FR = 255: FG = 0: FB = 255
LR = 0: LG = 255: LB = 0
With Picture1
SR = (LR - FR) / .Width
SG = (LG - FG) / .Width
SB = (LB - FB) / .Width
For X = 0 To .Width
.Line (X,0) - (X, .Height), RGB(FR, FG, FB)
FR = FR + SR: FG = FG + SG: FB = FB + SB
Next
End With
End Sub

Now, this would be too slow, How about this?
This is a few thousand times faster...

Prinvate Sub Picture1_Click()
Dim FR, FG, FB, LR, LG, LB, PCol, Col, PX
'Any value between 0 and 255 will do for these variables
'They determine ur first color and last color
FR = 255: FG = 0: FB = 255
LR = 0: LG = 255: LB = 0
PCol = RGB(FR, FG, FB): PX = 0
With Picture1
SR = (LR - FR) / .Width
SG = (LG - FG) / .Width
SB = (LB - FB) / .Width
Do Until X >= .Width
Col = RGB(FR, FG, FB)
If PCol <> Col Then
.Line (PX, 0) - (X, .Height), PCol, BF
PCol = Col
PX = X
End If
X = X + 1
FR = FR + SR: FG = FG + SG: FB = FB + SB
Loop
End With
End Sub

[Arc]

The Gradient fill code I provided is not complicated at all. To use anyway. All you have to do is paste the code into a .bas and then call the Function.

It is quite a bit longer then your code but then again it looks ALOT smoother. It doesnt have those bars of color... like you can see lines everytime the colors changes a little. My Code gives a very smooth fade with not blockyness or lines.

Also my code provides both horizontal and vertical fading.


So it is a bit more code but well worth it imo.

[Bongo]

did you not get the message last time????

[king_willy]

Does anyone know how i can add all the file in a folder and all the files in the folders under that one and so on into a list box?

[Megatron]

Here's some code that will print the Form. Since it uses PaintPicture, it's more flexible than the PrintForm method.

Private 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
 
'pic = a hidden picturebox
Private Sub PrintFormEx(pic As PictureBox)
    pic.AutoRedraw = True
    pic.ScaleMode = 3
    pic.Width = Me.ScaleWidth
    pic.Height = Me.ScaleHeight
    BitBlt pic.hDC, 0, 0, Me.Width, Me.Height, Me.hDC, 0, 0, vbSrcCopy
    Picture1.Picture = Picture1.Image
    Printer.PaintPicture pic.Picture, 1440, 1440
    Printer.EndDoc
End Sub
 
'Usage:
 
PrintFormEx MyPictureBox