AlphaBlend and Per Pixel Alpha Help needed

June 7, 2014, 7:49 am

≫ Next: VB6 - SMTP Relay

≪ Previous: A Listbox for millions items and transparent background

$

0

0

Hi,

Im currently using the Alphablend API for full image alphablending from a source DC to a dest DC, and am aware that you can set its parameter to do per pixel also.

A ton of questions;

1. Is the blending done based on the source alpha only, or does it take into consideration the dest alpha channel and average it out with the result dest alpha being replaced?

2. Premultiplied Alpha for the RGB values are required I read, so does this mean I need to convert a typical RGB with alpha channel image (such as a non premultiplied PNG) prior to getting the effect I need and if im running in 32bpp, does my DC store the image as a premultiplied RGB?

3. I've noticed hardware acceleration applies to the Alphablend API on Windows 7/8, however, I seem to only get this when I work with a source/dest DC that belongs to a form, if I create an offscreen DC through the API, I seem to loose hardware acceleration. I presume this is because hardware acceleration is tied to the WDDM, and any DC's not considered a program window aren't kept in video memory. Is there anyway I can circumvent this, to force a API created DC to be treated like a form's DC and remain hardware accelerated.

4. Hardware acceleration does not apply to GDI+, only GDI API. From what I read the BitBlt, StretchBlt, TransparentBlt and AlphaBlend functions are hw accelerated. TrueType fonts are supposed to be hardware accelerated as well I hear, so I guess api like TextOut is as well. I presume calls to SetPixel(v)/GetPixel result in a surface lock/unlock per call similar to if one was working with a surface in directdraw and thus should be avoided?

Cheers!

Tim

---

VB6 - SMTP Relay

June 7, 2014, 10:23 pm

≫ Next: VB6 Cairo-Blending-Performance (Collision-Handling using the Physics-Engine)

≪ Previous: AlphaBlend and Per Pixel Alpha Help needed

$

0

0

SMTPRelay is a Relay or Proxy server for sending email, and was born of the need to send email from a PC that is not connected to the Internet, but is a member of a private network with access to the Internet. It consists of 3 projects, all of which use the Unicode compatible NewSocket Class.

prjRelay is more or less a demonstration program. By default there is no SMTP Server defined, and the program responds with it's own SMTP responses. Remove the comment on the 'Server = "smtp.isp.net" line and add your own SMTP server. Then Telnet or use an email program from elsewhere on the network on port 25. The program should relay an email similar to:
<-- 220 cmta14.telus.net TELUS ESMTP server ready
--> HELO me
<-- 250 cmta14.telus.net hello [206.116.168.96], pleased to meet you
--> MAIL FROM: <xxxxxxx@telus.net>
<-- 250 2.1.0 <xxxxxxx@telus.net> sender ok
--> RCPT TO: xxxxxxx@pobox.com>
<-- 250 2.1.5 <xxxxxxx@pobox.com> recipient ok
--> DATA
<-- 354 enter mail, end with "." on a line by itself
--> To: <xxxxxxx@pobox.com>
--> From: <xxxxxxx@telus.net>
--> Subject: Test Message!
-->
Testing SMTP server speed!
--> .
<-- 250 2.0.0 BUdk1o00E257f4m01UdkC4 mail accepted for delivery
--> QUIT
<-- 221 2.0.0 cmta14.telus.net TELUS closing connection

prjSRSvc is the same thing without the ability to produce it's own responses, but is designed to run as a service. There are no visible forms or controls, and the SMTP Server, the Listening Port, and the Connecting Port are all defined in the registry. A word of caution is necessary here. When compiled, installed as a service, and activated, it will not automatically update the Windows Firewall (at least not in Win 8.1). To facilitate this, run the compiled executable directly. You will have to use the Task Manager or reboot the system to shut the program down as there is no visible interface.

prjInterface is the visible program used to manage the service. It will Install/Uninstall the service, Start/Stop the service, and Setup the registry values. Because the registry entries are in a section of the registry to which the System has access, it must be run in Administrative Mode. It uses the Microsoft NTService Control, which is readily available on the Internet.

J.A. Coutts

Attached Files

• SMTPRelay.zip (36.6 KB)

VB6 Cairo-Blending-Performance (Collision-Handling using the Physics-Engine)

June 8, 2014, 8:44 am

≫ Next: Using a cDibsection to paint, view and print bitmap

≪ Previous: VB6 - SMTP Relay

$

0

0

A small Demo, referring to the Blending-comparison-thread here:
http://www.vbforums.com/showthread.p...-Cairo-Drawing

Now covering a more realistic "2D-game-scenario" with 12 moving PNG-Sprites (5 larger and 7 smaller ones),
which constantly change their Pixel-Contents whilst moving around on a more realistic gaming-surface-size
in the range of 1024x768 Pixels (each Sprite also updating itself with a Text-Rendering, showing the Collision-
Count it encountered so far).

What Cairo achieves with that amount of semitransparently rendered Sprites is about 250FPS
(measured on Win 8.1, on a 2.1GHz Intel-Mobile-CPU, singlethreaded) - whilst codewise consisting
of only about 40 lines in cBall.cls and about 60 lines of code in fTest.frm.

So the measured 250FPS in this scenario leave enough room for a lot more Sprites in the Game-Loop
(especially when those Sprites are not as large as the ones I've choosen here).

I consider that quite a good compromise between "convenient coding of complex graphics-stuff" -
and achievable 2D-game-performance.

Here's the Demo-Sources: http://vbRichClient.com/Downloads/Ca...erformance.zip

And here a ScreenShot:


Olaf

Using a cDibsection to paint, view and print bitmap

June 9, 2014, 6:14 am

≫ Next: [VB6] Generic Delimited Text File Reader

≪ Previous: VB6 Cairo-Blending-Performance (Collision-Handling using the Physics-Engine)

$

0

0

This is an example of using a cDIBsection (based on code founded in vbAccelaratior.com) that I extend with some functionality to paint on it directly in a window in a scale defined by presets fit to width, 1:1, 100% etc.
With shift and mouse click you can paint and scroll the window to the edges of bitmap. You can use keyboard to write directly on cDIBsection. The painting procedure is like a brush with transparent feel.

For printing I have a way to hold all the parameters of a print properties dialog, and use them for printing the bitmap.

Enjoy it.

Attached Files

• basicform.zip (25.6 KB)

[VB6] Generic Delimited Text File Reader

June 10, 2014, 11:05 pm

≫ Next: [VB6] Send mail via Command Line ( No Dependencies )

≪ Previous: Using a cDibsection to paint, view and print bitmap

$

0

0

ReadDelimited

This is a simple Function defined within the DelimitedText.bas module.

You pass it a file name of a delimited text columnar data file along with a number of other parameters and get back a 2-dimensional Variant array of data.

Features

• Only reads ANSI files where lines/rows are delimited by Cr or CrLf, since it uses Line Input # to read the lines.
• Delimiter can be comma, Tab, etc.
• First row can define the number of columns, or you can specify a "hard" number of columns. Extra columns are ignored, missing columns are left Empty. Probably best when used without type conversion, but you could enhance this function to accept an array of default values to use.
• Optionally can parse the first row as column headers.
• Optionally can convert column data types from String to an array of specified types (vbLong, vbDate, etc.).
• Conversion can be done for specific locales to handle alternate decimal point symbols and date formats.
• Quotes (") are parsed off to allow delimiter characters within values, optionally this can be overriddden to retain quotes as part of the data.

Miscelleneous

Little effort has gone into optimization. The relatively slow Split() function is used extensively here.

The module is attached here within a demo project that dumps the result into a flexgrid control for viewing, along with some sample data files.

Attached Images

 

Attached Files

• ReadDelimited.zip (5.7 KB)

[VB6] Send mail via Command Line ( No Dependencies )

June 11, 2014, 11:45 am

≫ Next: [VB6] Formatted Text Record Parser

≪ Previous: [VB6] Generic Delimited Text File Reader

$

0

0

Command Line Emailing using Windows CDO.Message

This will allow developers \ coders \ whoever, to send basic email using a shell \ shellexecute \ batch file.

You may also use this to send attachments, html pages, etc although it will require some additional coding
(i left very detailed instruction and functions to make it as easy as possible to manipulate)

the Module is found on github, with all comments and explanations.

https://github.com/StavM/Send-eMail-...ommandline.bas

you may compile, and use the Windows Command Prompt to run it and pass parameters as described in the example below

Module

Code:

---

Attribute VB_Name = "cmdMailModule"
'Command prompt \ Command line mailing executable by Stav Mann. ® Stavmann2@gmail.com
'Open-Source, you may use as you wish.
'Visual Basic 6.0

'Usage:
'Important: You can not just run this through the Visual Basic IDE, you must compile and use the Command-Line to pass parameters !

'To use this, start your Visual Studio IDE and load the .vbp file \ emailFromCommandline.bas file
'If the mail account you wish to use to send the mail is not Gmail, make sure you change settings and credentials on the function.
'Compile to .exe
'
'Shell from vb \ from a command line using this syntax for your Gmail account (use your own credentials to test this if you want):
'<File Path> user=USERNAME pass=PASSWORD mail=Sendto@mail.com from=Sentfrom@mail.com subj=Subject body=This Is The Body of the letter

'P.S HTML tags work flawlessly here, so if you wish to make a new line of text, just type in a <BR> tag.

'Example:
'C:\cmdMail.exe user=myGmailUsername pass=myGmailPassword mail=stavmann2@gmail.com from=mail@mail.com subj=Hello This-Is A Subject body=This Is The Mail Body.<BR><BR>Good-Bye :)


Option Explicit

Private Const cmdUSER As String = "user="      'SMTP Username
Private Const cmdPASS As String = "pass="      'SMTP Password
Private Const cmdMAIL As String = "mail="      'Targeted eMail address (Must have legit email address template (mail@domain.com) )
Private Const cmdFROM As String = "from="      '"Replay To" address    (Must have legit email address template (mail@domain.com) )
Private Const cmdSUBJ As String = "subj="      'eMail Subject
Private Const cmdBODY As String = "body="      'eMail Body
Private Const cmdEND  As String = "=END="      'eMail Body

Public Sub Main()

'The idea is to simply grab the parameters, and split them to text strings, and then implement them straight to the mailing function.
'if went well, Msgbox (Mail Sent), Else Msgbox Error (written in the mailing function itself)

If mailSend(Trim(GetBetween(cmdUSER, cmdPASS)), _
            Trim(GetBetween(cmdPASS, cmdMAIL)), _
            Trim(GetBetween(cmdMAIL, cmdFROM)), _
            GetBetween(cmdFROM, cmdSUBJ), _
            GetBetween(cmdSUBJ, cmdBODY), _
            GetBetween(cmdBODY, cmdEND) _
            ) = 0 Then Call MsgBox("Mail Sent!", vbInformation)
     
End Sub



Private Function mailSend(xUsername, xPassword, xMailTo, xFrom, xSubject, xMainText) As Integer

Dim msgA As Object 'declare the CDO
Set msgA = CreateObject("CDO.Message") 'set the CDO to reffer as CDO.Message (microsoft default object that can be found on almost all windows versions since vista by default)
   
    msgA.To = xMailTo 'get targeted mail from command
    msgA.Subject = xSubject 'get subject from command
    msgA.HTMLBody = xMainText 'Main Text - You may use HTML tags here, for example <BR> to immitate "VBCRLF" (start new line) etc.
    msgA.From = xFrom 'The from part, make sure its syntax template is a valid mail one, user@domain.com, or something.
   
    'Notice, i simplified it, however, you may use more values depending on your needs, such as:
    '.Bcc = "mail@mail.com" ' - BCC..
    '.Cc = "mail@mail.com" ' - CC..
    '.CreateMHTMLBody ("www.mywebsite.com/index.html) 'send an entire webpage from a site
    '.CreateMHTMLBody ("c:\program files\download.htm) 'Send an entire webpage from your PC
    '.AddAttachment ("c:\myfile.zip") 'Send a file from your pc (notice uploading may take a while depending on your connection)

   
    'Gmail Username (from which mail will be sent)
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = xUsername
    'Gmail Password
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = xPassword
   
    'Mail Server address.
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
   
    'To set SMTP over the network = 2
    'To set Local SMTP = 1
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
   
    'Type of Authenthication
    '0 - None
    '1 - Base 64 encoded (Normal)
    '2 - NTLM
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
   
    'Outgoing Port
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   
    'Send using SSL True\False
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
   
    'Update values of the SMTP configuration
    msgA.Configuration.Fields.Update
   
    'Send it.
    msgA.Send
   
    mailSend = Err.Number
        If Err.Number <> 0 Then Call MsgBox("Mail delivery failed: " & Err.Description, vbExclamation)
 
End Function


Private Function GetBetween(strOne As String, strTwo As String) As String

'Grab parameters as a whole, and place the line of text on strBody, in addition to the END-OF-PARAMETERS Flag called cmdEnd.
Dim strBody As String
    strBody = Command$ & cmdEND

'Locate each word's location within strBody, if its not found, don't continue.
Dim lngLocationOne As Long
Dim lngLocationTwo As Long
   
lngLocationOne = InStr(1, strBody, strOne, vbTextCompare)
    If (lngLocationOne = 0) Then GoTo ErrHandle
   
lngLocationTwo = InStr(1, strBody, strTwo, vbTextCompare)
    If (lngLocationTwo = 0) Then GoTo ErrHandle

'Grab a parameter value and return it.
GetBetween = Mid(strBody, lngLocationOne + Len(strOne), (lngLocationTwo - lngLocationOne - Len(strOne)))
       
Exit Function
ErrHandle:
    GetBetween = vbNullString

End Function

---

Usage:

Code:

---

Private Sub Form_Load()

    Shell ("C:\cmdMail.exe user=myGmailUsername pass=myGmailPassword mail=target-mail@mail.com from=my@mail.com subj=Hello This-Is A Subject body=This Is The Mail Body.<BR><BR>Good-Bye :)")

End Sub

---

[VB6] Formatted Text Record Parser

June 12, 2014, 1:32 pm

≫ Next: A Listbox for millions items, transparent background, and changeable charset

≪ Previous: [VB6] Send mail via Command Line ( No Dependencies )

$

0

0

FormattedText

This is a Class for use in parsing data fields from fixed-format records based on one or more simple "Fortran like" format strings.

You assign the LCID to be used for conversion, defaulting to the current user's locale settings. Then assign one or more RecordFormat(n) properties to formatting strings.

Then read your raw records from a file line by line as text and call the ParseRecord() method, passing the String, a Variant array to receive the parsed values, and the format index for the format to be applied to the record.


RecordFormat Strings

These consist of a comma-separated list of optional "repeat counts", "type" characters, and field lengths in characters. Missing or non-numeric repeat count or length values are treated as 1.

Types and Pseudotypes:

X - "filler" (skipped, not returned as a field value)
S - String
T - String (trimmed)
I - Integer
L - Long
R - "real" (Single)
D - Double
B - Boolean
H - Hex (Long)
C - "chron" (Date) for date and time values

The Boolean type requires a field length at least as long as the localized words used for True and False (i.e. 5 for English). If you need to handle a field using T and F for example, make it a String field and test it yourself after parsing each record.

Examples:

"X3,S10,T10,C10,C19,R13,B6,H8"
"7T11"
"R10, 17R13"

The RecordFormat property expects an index value from 0 to n, allowing you to set up multiple formats before you being parsing records.

Demos

The attached archive contains FormattedText.cls along with two demo Projects FmtText1 and FmtTest2 along with sample data.

FmtTest1 scans its way through a file of mixed record types and locates and extracts column headings and data values, putting the data into a 2-dimensional array with lower bounds of 1 instead of 0. Then this information is dumped to a flexgrid for viewing.

FmtTest2 reads a much simpler file containing several kinds of fields. It is also a German file where values are localized using German OLE conventions for data conversion from text.

In both cases the dumped data is displayed using current locale settings.

Attached Files

• Read Formatted.zip (21.8 KB)

A Listbox for millions items, transparent background, and changeable charset

June 7, 2014, 6:29 am

≫ Next: Simplest way to read a joystick in VB6

≪ Previous: [VB6] Formatted Text Record Parser

$

0

0

This is my glist a big listbox as you see!

New,
This is the right version, wich is very fast for adding 1000000 items, and Vscroll bar using "logical lines" no lines (the visible lines of the usercontrol).

I add a new form to show how this listbox help to have previews when scroll the caret by mouse movemnet, and that previews are labels which response to a click event and perform software selection on the list. When the move is fast then the previews are not changed. So if that was images the walking through the list can be done without time consuming image preview for each item. When we select an item form preview list then the selection didn't fire a "selected" event but a "softselected" so maybe we can leave it without code...What we want is done, no selected event produced and that is right because the selection was made by preview list for a list item.

glistCharset shows how you can have any charset to your listbox...(ordinary listbox they don't change charset even they change the property). I change font to Verdana (unicode) and a put several charset, kyrilic, tourkish...etc

Attached Images

 

Attached Files

• glist.zip (34.2 KB)
• glistCharset.zip (34.3 KB)

---

Simplest way to read a joystick in VB6

June 16, 2014, 10:40 pm

≫ Next: Convert your application to Shareware (many ways..)

≪ Previous: A Listbox for millions items, transparent background, and changeable charset

$

0

0

This uses the Windows API.

Below is the code. Place this code your form (Form1), and place a timer control (Timer1) and picturebox control (Picture1) in on the form. Set the timer interval property to 1 (1ms). Set the scalemode property for both the form and the picturebox to Pixels, and set the autoredraw property on both also to tru. Set the picturebox appearance property to flat, borderstyle to none, and fillstyle to solid.

Code:

---

Private Const JOY_RETURNBUTTONS As Long = &H80&
Private Const JOY_RETURNCENTERED As Long = &H400&
Private Const JOY_RETURNPOV As Long = &H40&
Private Const JOY_RETURNPOVCTS As Long = &H200&
Private Const JOY_RETURNR As Long = &H8&
Private Const JOY_RETURNRAWDATA As Long = &H100&
Private Const JOY_RETURNU As Long = &H10
Private Const JOY_RETURNV As Long = &H20
Private Const JOY_RETURNX As Long = &H1&
Private Const JOY_RETURNY As Long = &H2&
Private Const JOY_RETURNZ As Long = &H4&
Private Const JOY_RETURNALL As Long = (JOY_RETURNX Or JOY_RETURNY Or JOY_RETURNZ Or JOY_RETURNR Or JOY_RETURNU Or JOY_RETURNV Or JOY_RETURNPOV Or JOY_RETURNBUTTONS)

Private Type JOYINFOEX
    dwSize As Long ' size of structure
    dwFlags As Long ' flags to dicate what to return
    dwXpos As Long ' x position
    dwYpos As Long ' y position
    dwZpos As Long ' z position
    dwRpos As Long ' rudder/4th axis position
    dwUpos As Long ' 5th axis position
    dwVpos As Long ' 6th axis position
    dwButtons As Long ' button states
    dwButtonNumber As Long ' current button number pressed
    dwPOV As Long ' point of view state
    dwReserved1 As Long ' reserved for communication between winmm driver
    dwReserved2 As Long ' reserved for future expansion
End Type

Private Declare Function joyGetPosEx Lib "winmm.dll" (ByVal uJoyID As Long, ByRef pji As JOYINFOEX) As Long

Dim JI As JOYINFOEX

Const JNum As Long = 0
'Set this to the number of the joystick that
'you want to read (a value between 0 and 15).
'The first joystick plugged in is number 0.
'The API for reading joysticks supports up to
'16 simultaniously plugged in joysticks.
'Change this Const to a Dim if you want to set
'it at runtime.

Private Sub Form_Load()
JI.dwSize = Len(JI)
JI.dwFlags = JOY_RETURNALL
End Sub

Private Sub Timer1_Timer()
Cls
If joyGetPosEx(JNum, JI) <> 0 Then
    Print "Joystick #"; CStr(JNum); " is not plugged in, or is not working."
Else
    With JI
        Print "X = "; CStr(.dwXpos)
        Print "Y = "; CStr(.dwYpos)
        Print "Z = "; CStr(.dwZpos)
        Print "R = "; CStr(.dwRpos)
        Print "U = "; CStr(.dwUpos)
        Print "V = "; CStr(.dwVpos)
        If .dwPOV < &HFFFF& Then Print "PovAngle = "; CStr(.dwPOV / 100) Else Print "PovCentered"
        Print "ButtonsPressedCount = "; CStr(.dwButtonNumber)
        Print "ButtonBinaryFlags = "; CStr(.dwButtons)
        Picture1.Cls
        Picture1.Circle (.dwXpos / &HFFFF& * (Picture1.Width - 1), .dwYpos / &HFFFF& * (Picture1.Height - 1)), 2
    End With
End If
End Sub

---

Then run it. If you have a joystick plugged in it will show all the values for the joysticks controls (all axes, all buttons, and POV hat). All controls that are not supported by the device remain zero. If the joystick with the set number isn't plugged in (or doesn't work), then an error message will display. It will immediately start displaying joystick data though the moment a working josystick is plugged in.

Convert your application to Shareware (many ways..)

June 17, 2014, 10:06 am

≫ Next: VB6 - Add System DSN

≪ Previous: Simplest way to read a joystick in VB6

$

0

0

This project is created in vb6 for converting your vb6 compiled exe's to shareware you can set expiry to days,counts or date..you can set trial key or full secret codes to unlock the application.Just take a view Download it write a comment below :)
P.S: i don't know the original author of this project but I'm not :D

Attached Files

• Convert EXE to Shareware.zip (237.4 KB)

VB6 - Add System DSN

June 18, 2014, 8:03 pm

≫ Next: A new custom listbox and example for how to make it a combobox

≪ Previous: Convert your application to Shareware (many ways..)

$

0

0

Microsoft recommends that application data for "All Users" use the "ProgramData" directory. But if you have ever tried to create a DSN in this directory using the ODBC Manager, you have discovered that directory is not available. The reason is that particular directory is configured as hidden. But it is quite easy to do it programatically.

Code:

---

Option Explicit

Private DataPath As String
Private DataBase As String
Private AllUserPath As String
Private adoConn1 As ADODB.Connection
Private ADOConnStr1 As String

Private Const ODBC_ADD_DSN = 1      ' Add user data source
Private Const ODBC_CONFIG_DSN = 2  ' Modify user data source
Private Const ODBC_REMOVE_DSN = 3  ' Delete user data source
Private Const ODBC_ADD_SYS_DSN = 4  ' System DSN functions only work
Private Const ODBC_CONFIG_SYS_DSN = 5 ' when logged in as administrator
Private Const ODBC_REMOVE_SYS_DSN = 6
Private Const ODBC_REMOVE_DEFAULT_DSN = 7

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Function SQLConfigDataSource Lib "odbccp32.dll" (ByVal hWndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

Private Function LocalInit() As Long
' Purpose:
'  Starting point for application.
' =====================================================
    Dim TaskID As Long
    Dim sErr As Variant
    Const sProc As String = "LocalInit"
    On Error GoTo LocalInitErr
    DataBase = "New_DB"
    AllUserPath = "C:\ProgramData\NewApp\"
    DataPath = AllUserPath & "NewDB.mdb"
    'Verify database exists
    TaskID = TestFile(AllUserPath, "NewDB.mdb")
    If Not GetDSN(DataBase, "Microsoft Access Driver (*.mdb)", DataPath, ODBC_ADD_SYS_DSN) Then
        Err.Raise 53 'File Not Found
    End If
    ADOConnStr1 = "DSN=" + DataBase + ";uid=;pwd=;database='tblNew';"
    Set adoConn1 = CreateObject("ADODB.Connection")
    adoConn1.Open ADOConnStr1
    LocalInit = False
    Exit Function
LocalInitErr:
    sErr = Err
    LocalInit = sErr
End Function

Private Function TestFile(PathName As String, FileName As String) As Boolean
    Dim lngRet As Long
    On Error GoTo TestFileErr
    If Len(Dir(PathName & FileName)) = 0 Then
        MkDir AllUserPath
        lngRet = MsgBox("Database not Found!" & vbCrLf & "Copy blank one?", vbYesNo)
        If lngRet = vbYes Then
            FileCopy App.Path & "\NewDB.mdb.org", PathName & FileName
        End If
    End If
    Exit Function
TestFileErr:
    If Err = 75 Then Resume Next
End Function

Private Function GetDSN(sDSN As String, sDriver As String, sDBFile As String, lAction As Long) As Long
    Dim sAttributes As String
    Dim sDBQ As String
    Dim lngRet As Long
    Dim hKey As Long
    Dim regValue As String
    Dim valueType As Long
    ' query the Registry to check whether the DSN is already installed
    ' open the key
    sDBQ = RegQuery(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" + sDSN, "DBQ")
    If Left$(sDBQ, 11) = "No Such Key" Then
        If Len(sDBFile) Then 'File path/name supplied
            lngRet = MsgBox(sDBQ & vbCrLf & "CREATE IT?", vbYesNo)
            If lngRet = vbYes Then
                sDBQ = ""
            Else
                'Routine failed
                GetDSN = False
                Exit Function
            End If
        Else 'No file name supplied
            GetDSN = False
            Exit Function
        End If
    End If
    If Len(sDBQ) Then 'DBQ found
        If lAction = ODBC_ADD_SYS_DSN Or lAction = ODBC_ADD_DSN Then
            'Verify file actually exists
            If Len(Dir$(sDBFile)) Then
                'Simply return DBQ
                sDBFile = sDBQ
                GetDSN = True
                Exit Function
            Else 'return error
                GetDSN = False
                Exit Function
            End If
        Else 'Delete it
            sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
            lngRet = SQLConfigDataSource(0&, lAction, sDriver, sAttributes)
        End If
    Else 'Add it
        ' check that the file actually exists
        If Len(sDBFile) > 0 And Len(Dir$(sDBFile)) Then 'create DSN
            sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
            lngRet = SQLConfigDataSource(0&, lAction, sDriver, sAttributes)
        Else 'Return with error
            MsgBox "Database file doesn't exist!", vbOKOnly + vbCritical
            GetDSN = False
            Exit Function
        End If
    End If
    If lngRet Then
        GetDSN = True
    Else
        GetDSN = False
    End If
End Function

---

Microsoft still does not offer 64 bit drivers for anything but SQLServer, but at least Win 8.1 shows both the 32 bit & 64 bit ODBC Managers.

J.A. Coutts

A new custom listbox and example for how to make it a combobox

June 19, 2014, 4:42 pm

≫ Next: MJPEG Webcam Receiver

≪ Previous: VB6 - Add System DSN

$

0

0

My old glist..updated with extra functionality.
So now glist (as glist2 control) can act as listbox and with a textbox can act as combo box. You can change charset. List inside listbox isn't a collection but is a dynamic string array.
In the example are three forms. One to show how selected, selected2, scrollselected and softselected events works. One is the old example of 1 million items, and you can scroll the scroll bar and see the list to scrolling accordingly. Also a label display the showing lines, the logical lines (see code) and the scroll lines (the page knowing by scroll bar). Finally the last form show three glist controls that we can show as "popup", and for the left one, we can hold open as we write in textbox, and as we write there is an auto selection in listbox, to show us an item that starts like the text in textbox. Listboxes as combos can also used with arrows, enter, escape, and tab.

Written in vb6 (yes I move from 5 to 6...its time..)

Attached Files

• glist2.zip (64.1 KB)

MJPEG Webcam Receiver

June 19, 2014, 10:16 pm

≫ Next: BassPlayerDB

≪ Previous: A new custom listbox and example for how to make it a combobox

$

0

0

Attached to this message is the complete source code for this program. It is designed to receive webcam video, but will work for any video source that has these specifications:
Server Location = 127.0.0.1 (same computer as the VB application that is running)
Network Protocol = TCP/IP
Application Protocol = HTTP
Port Number = 8080
Container Format = AVI (each frame starts the String "00dc" followed by a Long who's value equals the size in bytes of the frame's payload data)
Video Codec = MJPEG (Motion JPEG, where each frame of video is a JPEG image)
Audio Codec = none (no audio is sent)

To get those specs on your stream, the easiest way to do it is to use VLC Player to stream the video and make sure the protocol is set to HTTP, the port number is set to 8080, and that the transcoding options are set to use the above mentioned container format and video codec, and that audio is not sent. I won't explain how to use VLC Player here, as this isn't a VLC forum. However there is a VLC forum you can go to to get help (or if you are like me, and have used it a lot, you may already know how to do this). And make sure you are running VLC on the same computer that you are running this VB6 program on.

Now as for my receiver's functionality, it can connect to and disconnect from a server. It can display the video directly, or process it prior to displaying it, using one of several different algorithms to add various image altering effects to the frames. You'll notice a drop in frame rate from 30fps to something much lower, as processing can't occur any faster than about one to two tenths of a second per frame on an image size of 640x480.

Attached Files

• MJPEG Webcam Receiver.zip (3.7 KB)

BassPlayerDB

June 20, 2014, 7:32 am

≫ Next: [VB6] ImageList and the Safety Palette

≪ Previous: MJPEG Webcam Receiver

$

0

0

I have seen many folks here and other fora struggling with Window Media Player, the MMControl, and MPI Api calls to create decent Mp3/Wav apps. After a few years working with the Bass library, I'm convinced it is the way to go. Bass was created by Ian Luck at http://www.un4seen.com. The basic package contains the binaries and examples for several languages, including VB. The VB apps all work fine and will give you an idea of how to use the library. The class in this project (cBass.cls) just serves as a wrapper to make it easier to use Bass.

This app is designed for those who have a large collection of music files. It uses an ADO Access database (Music.mdb) to store the info about each mp3/wav file added. When adding music files, it uses the audiogenie3.dll to gather info if the mp3 files have tags. If not you can edit files to store things like album, composer, genre, year, comment, etc in the DB.

If you have your music files centrally located, such as ITunes, it is best to load the entire folder, which can be time comsuming, and then delete such items as desired, but this is not necessary, as you can add files at any time.

Features:
· Select music by category (Artist, Album, Composer, Genre, Year)
· Search for music in the database or in the currently playing list
· Load random lists of music
· Create Playlists that are stored in the database. (There is also a utility under Options to manage/edit/delete Playlists.)
· Add album art to your mp3 files, which is stored in the file's ID3 V2 tag, bmp, jpg, tif, gif, png are supported.

Startup:
At startup, the database is empty and you will be prompted to Use Options/Add Music to enter mp3/wav files to the database. Once you have added music to the database, you will be able to access the player’s features.

Keyboard controls:
Playback:
The Right and Left keys advance/backup the music stream by 5 seconds when the Listview has focus. You can also change
the song’s position using the scroll bar.
Ctrl P – Play the previous song
Ctrl S – Start/Restart the currently selected song
Ctrl Space – Pause/Resume the currently playing song
Ctrl X – Stop the currently playing song
Ctrl N – Play then next song
(Note you can scroll up & down with the arrow keys and play a song by pressing the Return key on the desired item, or you can Double Click an item to play it)

Others:

Ctrl G – Go to the currently playing song (i.e. the playing song has been scrolled out of view)
Ctrl A – Select all songs in the list
Ctrl C – Clear the list
Ctrl R – Remove all selected songs in the list

About Crossfading:
Many people like the music to fade out at the end and start the next song in the list. I have found that about 5 seconds of crossfade/fadeout works pretty well, but you can change this with Options|Preferences. Note that this does not work well with a song that has too much silence at the end. I use Mp3 Trim Pro from http://www.mptrim.com/, which can trim the silence from both the beginning and end of an mp3.
Binaries:
Bass:
http://www.un4seen.com/ Click on 'Bass' at the top left of the page. This will take you to the download page. At the top of the page under the word 'Platform', click on the left most Download link. In this download there are two versions of bass.dll. One is in the root folder and the other in a folder called mp3-free.

If you use the "mp3-free" version, you won't need a license since it uses the OS's MP3 decoder rather than including its own MP3 decoder. It's the same as bass.dll, just without the internal MP3 decoder. As long as Windows Media Player is installed, you will have mp3 codecs installed and the mp3-free version should work fine. If you are not developing a commercial product that uses bass, it doesn't matter and you can use either version. I have the mp3-version in my (XP) System32 folder, but you can put it in the app folder or wherever, as long as windows can find it in its Path.

Audiogenie:
http://sourceforge.net/projects/audiogenie/?source=dlp. This gives you the audiogenie3.dll (also in my System32 folder). The clsAudioGenie in this project is a trimmed down version of the full class which reads/writes tags to many different music file formats. You can get the full class here:
http://en.sourceforge.jp/projects/sf...udioGenie.cls/

The attachment has the VB Files without the binaries.
http://normcook.net/Index.html has this readme file as well as the zip for all the VB files, plus the binaries.
Hope you enjoy it.

Comments/critiques welcome.

Attached Images

 

Attached Files

• BassPlayerDB.zip (116.3 KB)

[VB6] ImageList and the Safety Palette

June 20, 2014, 10:36 am

≫ Next: How do I define joystick pedal all the specific command in Visual Basic? Please help

≪ Previous: BassPlayerDB

$

0

0

This is really not a code sample as much as a technique to use in writing VB6 programs.

Many of the fancier GUI controls in VB6 accept images assigned from a companion ImageList control. Here I'll use the example of the Toolbar control. If we want to use the modern UX-themed versions of these controls based on Windows Common Controls we also need to use the older version 5 COMCTL32.OCX, but that's a separate issue.

Both the version 5 and version 6 VB ImageList controls are designed only to support images of 2, 16, or 256 colors. In the rare case of 2-color images the ImageList's BackColor property comes into play. Otherwise we normally only care about the MaskColor, when we want transparency.


Palettes

For either 16-color or 256-color bitmaps, all of the images must use the same palette. When they don't, you can end up with frustrating symptoms. Often the background or the whole images "go black" after you save your Project and when you run the compiled program.

I don't know why this happens, but it seems to be due to the way these controls persist the bitmaps into the Project's .FRX files.


Better ICO and BMP Files

The VS 6.0 graphics we got with VB6 were meant for another era. Many of them were holdovers from the Win3.x 16-bit era, and look it.

There are newer sets of icons and graphics available for newer versions of Visual Studio, though you'll have to work with them a little to use them with VB6. See:

Visual Studio Image Library

The smaller VS2012 Image Library.zip download there offers plenty to browse through for some better images.


Converting Images

If you want to use 24- or 32-bit images you won't be able to use the standard VB controls. So when you need to do that you'll need 3rd party controls or some other technique.

However quite a lot of the stuff in VS2012 Image Library.zip is usable after some tweaking.

The article Colors: The Safety Palette can be useful. The best thing I found there was a sample image called IC27432.gif under the subheading Get the Safety Palette.


Steps to Convert 24-bit Bitmaps

Go get IrfanView or another utility that can save and load .PAL files.

I grabbed 6 bitmaps from the VS download to demonstrate. Create a folder such as "Original 24-bit" and another such as "Standard 8-bit." Copy 24-bit BMP files to play with there.

Download IC27432.gif, open it in IrfanView, and export its palette. These are also included in the attached archive below.

Then for each bitmap file:

• Open the bitmap from "Original 24-bit" in IrfanView.
• Import the IC27432.pal, converting the image to 8-bit.
• Save as... the new bitmap as BMP format into "Standard 8-bit."

Now you have 8-bit BMPs all using the Safety palette that you can use safely in ImageList controls!

Be sure you set the MaskColor of your ImageLists as well. Many of these use magenta (&H00FF00FF&) as the MaskColor instead of the old default gray shade (&H00C0C0C0&)


Results

Not too bad really. Note that there is only so much you can do with 16x16 images to make them look good though.

Here I don't really care for the shading on the Left-justify icon, it's a little dark. But you can always tweak that as long as you avoid altering the palette.

The archive has the demo Project as well as the BMPs' before and after versions.

Attached Images

 

Attached Files

• Safety Palette.zip (15.3 KB)

---

How do I define joystick pedal all the specific command in Visual Basic? Please help

June 23, 2014, 2:04 pm

≫ Next: A Listbox for millions items, transparent background, and changeable charset

≪ Previous: [VB6] ImageList and the Safety Palette

$

0

0

I need codeBank define joystick pedal ..
for example , define up arrow to click a command .. and so on ..

A Listbox for millions items, transparent background, and changeable charset

June 7, 2014, 6:29 am

≫ Next: A new custom listbox with pan function.

≪ Previous: How do I define joystick pedal all the specific command in Visual Basic? Please help

$

0

0

This is my glist a big listbox as you see!

New,
This is the right version, wich is very fast for adding 1000000 items, and Vscroll bar using "logical lines" no lines (the visible lines of the usercontrol).

I add a new form to show how this listbox help to have previews when scroll the caret by mouse movemnet, and that previews are labels which response to a click event and perform software selection on the list. When the move is fast then the previews are not changed. So if that was images the walking through the list can be done without time consuming image preview for each item. When we select an item form preview list then the selection didn't fire a "selected" event but a "softselected" so maybe we can leave it without code...What we want is done, no selected event produced and that is right because the selection was made by preview list for a list item.

glistCharset shows how you can have any charset to your listbox...(ordinary listbox they don't change charset even they change the property). I change font to Verdana (unicode) and a put several charset, kyrilic, tourkish...etc

Attached Images

 

Attached Files

• glist.zip (34.2 KB)
• glistCharset.zip (34.3 KB)

A new custom listbox with pan function.

June 19, 2014, 4:42 pm

≫ Next: Liistbox and EditBox Unicode and Transparent.

≪ Previous: A Listbox for millions items, transparent background, and changeable charset

$

0

0

My old glist..updated with extra functionality.
So now glist (as glist2 control) can act as listbox and with a textbox can act as combo box. You can change charset. List inside listbox isn't a collection but is a dynamic string array.
In the example are three forms. One to show how selected, selected2, scrollselected and softselected events works. One is the old example of 1 million items, and you can scroll the scroll bar and see the list to scrolling accordingly. Also a label display the showing lines, the logical lines (see code) and the scroll lines (the page knowing by scroll bar). Finally the last form show three glist controls that we can show as "popup", and for the left one, we can hold open as we write in textbox, and as we write there is an auto selection in listbox, to show us an item that starts like the text in textbox. Listboxes as combos can also used with arrows, enter, escape, and tab.

Written in vb6 (yes I move from 5 to 6...its time..)

Updated optimized code.
I put Xp styles, and a normal listbox. One glist and one standard listbox for 10000 items each need 17 seconds when 1 milion items in glist need 9.5 seconds. I have a form with an array of glist, two of them, and load 10000 item each in 2.5 seconds.

classic Listbox cannot use listindex grater than 32767. So when you fill 100000 items you get a wrong listindex. Where you find so many items? In a hard disk. If you want to put all images in a list...simply you can't with classic listbox.

The new glist has pan function. In my old version i use pan to read more of a line that was hidden by the frame. Now i put events so in an example below you find left and right pan to act as page up or down (these are from code outside the control so you can define other functions to perform). I inspired from android, when you throw tasks,.for closing purpose. This glist can serve with many ways, because it is open and not need to do much to display graphics, icons and text instead a simple line text. In my last example two glist operate one the other...so if you scroll one exactly the same scroll happen to second..If you click one, the same do to other. The idea is to make each list as a column of data, and you can hide scrollbar without losing the functionality. One scrollbar for all listboxes. So you can make a grid...
And all from a simple custom control...with no ocx or something special needed.

This is free code.

Attached Files

• glistWithPan.zip (67.8 KB)

Liistbox and EditBox Unicode and Transparent.

June 19, 2014, 4:42 pm

≫ Next: VB6 - Elevated Privileges

≪ Previous: A new custom listbox with pan function.

$

0

0

I work some hours to revision an old control who made for the IDE of M2000, with capability to display all utf16 usinf Arial Unicode MS. I have gList and gTextBox with some forms as examples. Drag and drop (unicode allways) can do if you select 2 or more lines. Cntrl X and V also work.


********New********** I added Unicode support.
I send again the file...I found a variable with an annoying keystroke...r before save it...
...Coming a textbox with unicode supprort based in this control

My old glist..updated with extra functionality.
So now glist (as glist2 control) can act as listbox and with a textbox can act as combo box. You can change charset. List inside listbox isn't a collection but is a dynamic string array.
In the example are three forms. One to show how selected, selected2, scrollselected and softselected events works. One is the old example of 1 million items, and you can scroll the scroll bar and see the list to scrolling accordingly. Also a label display the showing lines, the logical lines (see code) and the scroll lines (the page knowing by scroll bar). Finally the last form show three glist controls that we can show as "popup", and for the left one, we can hold open as we write in textbox, and as we write there is an auto selection in listbox, to show us an item that starts like the text in textbox. Listboxes as combos can also used with arrows, enter, escape, and tab.

Written in vb6 (yes I move from 5 to 6...its time..)

Updated optimized code.
I put Xp styles, and a normal listbox. One glist and one standard listbox for 10000 items each need 17 seconds when 1 milion items in glist need 9.5 seconds. I have a form with an array of glist, two of them, and load 10000 item each in 2.5 seconds.

classic Listbox cannot use listindex grater than 32767. So when you fill 100000 items you get a wrong listindex. Where you find so many items? In a hard disk. If you want to put all images in a list...simply you can't with classic listbox.

The new glist has pan function. In my old version i use pan to read more of a line that was hidden by the frame. Now i put events so in an example below you find left and right pan to act as page up or down (these are from code outside the control so you can define other functions to perform). I inspired from android, when you throw tasks,.for closing purpose. This glist can serve with many ways, because it is open and not need to do much to display graphics, icons and text instead a simple line text. In my last example two glist operate one the other...so if you scroll one exactly the same scroll happen to second..If you click one, the same do to other. The idea is to make each list as a column of data, and you can hide scrollbar without losing the functionality. One scrollbar for all listboxes. So you can make a grid...
And all from a simple custom control...with no ocx or something special needed.

This is a free code.

New glist with unicode output. In the example i also use a picturebox as unicode label. Textboxes cannot display unicode.

Attached Files

• glistUnicode.zip (68.4 KB)
• EditboxListboxUnicode.zip (97.9 KB)

VB6 - Elevated Privileges

June 29, 2014, 8:33 pm

≫ Next: Resizing ListView to Form and Vice Versa

≪ Previous: Liistbox and EditBox Unicode and Transparent.

$

0

0

Ever since Microsoft introduced UAC (User Access Control) with Vista, you sometimes need to know if your application is running with administrative privileges. A quick search on the Net revealed some confusion about the use of the GetTokenInformation call. Using this call with the TOKEN_ELEVATION_TYPE parameter will yield the correct result as long as UAC is enabled. But if UAC is disabled or the built-in Administrator account is being utilized, the wrong result is returned. Using TOKEN_ELEVATION, the correct result is returned regardless of the state of UAC. The small program below demonstrates the difference on a Vista machine with UAC disabled, as well as returning the various user directories.

All Users Directory: C:\ProgramData
Default Users Directory: C:\Users\Default
General User Directory: C:\Users
Current User Directory: C:\Users\couttsj
Using TOKEN_ELEVATION_TYPE,
couttsj is not using elevated privileges, or UAC is turned off!
Using TOKEN_ELEVATION,
couttsj is using elevated privileges!

J.A. Coutts

Code:

---

Option Explicit

Private Const TOKEN_QUERY = (&H8)
Private Const TOKEN_ELEVATION_TYPE As Long = 18
Private Const TOKEN_ELEVATION As Long = 20
Private Declare Function GetAllUsersProfileDirectory Lib "userenv.dll" Alias "GetAllUsersProfileDirectoryA" (ByVal lpProfileDir As String, lpcchSize As Long) As Boolean
Private Declare Function GetDefaultUserProfileDirectory Lib "userenv.dll" Alias "GetDefaultUserProfileDirectoryA" (ByVal lpProfileDir As String, lpcchSize As Long) As Boolean
Private Declare Function GetProfilesDirectory Lib "userenv.dll" Alias "GetProfilesDirectoryA" (ByVal lpProfileDir As String, lpcchSize As Long) As Boolean
Private Declare Function GetUserProfileDirectory Lib "userenv.dll" Alias "GetUserProfileDirectoryA" (ByVal hToken As Long, ByVal lpProfileDir As String, lpcchSize As Long) As Boolean
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long

Private Sub Form_Activate()
    Dim sBuffer          As String
    Dim lRetLen          As Long
    Dim CurrentUser      As String
    Dim hToken          As Long
    Dim tkElevation      As Long
    Dim N%
    'create a string buffer
    sBuffer = String(255, 0)
    'retrieve the all users profile directory
    If GetAllUsersProfileDirectory(sBuffer, 255) = 0 Then _
        Err.Raise Err.LastDllError, , "Could not retrieve the all users profile directory!"
    'show the result
    Print "All Users Directory: " & StripTerminator(sBuffer)
    sBuffer = String(255, 0)
    If GetDefaultUserProfileDirectory(sBuffer, 255) = 0 Then _
        Err.Raise Err.LastDllError, , "Could not retrieve the default users profile directory!"
    Print "Default Users Directory: " & StripTerminator(sBuffer)
    sBuffer = String(255, 0)
    If GetProfilesDirectory(sBuffer, 255) = 0 Then _
        Err.Raise Err.LastDllError, , "Could not retrieve general users profile directory!"
    Print "General User Directory: " & StripTerminator(sBuffer)
    sBuffer = String(255, 0)
    If OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken) = 0 Then _
        Err.Raise Err.LastDllError, , "Could not retrieve current Process Handle!"
    If GetUserProfileDirectory(hToken, sBuffer, 255) = 0 Then _
        Err.Raise Err.LastDllError, , "Could not retrieve the current users profile directory!"
    CurrentUser = StripTerminator(sBuffer)
    Print "Current User Directory: " & StripTerminator(sBuffer)
    N% = InStrRev(CurrentUser, "\")
    If N% > 0 Then CurrentUser = Mid$(CurrentUser, N% + 1)
    If GetTokenInformation(hToken, TOKEN_ELEVATION_TYPE, tkElevation, 4, lRetLen) = 0 Then
        Err.Raise Err.LastDllError, , "Could not retrieve Token Information!"
    Else
        Print "Using TOKEN_ELEVATION_TYPE,"
        Select Case tkElevation
            Case 1
                Print CurrentUser & " is not using elevated privileges," _
                    & " or UAC is turned off!"
            Case 2
                Print CurrentUser & " is using elevated privileges!"
            Case 3
                Print CurrentUser & " is not using elevated privileges!"
        End Select
    End If
    If GetTokenInformation(hToken, TOKEN_ELEVATION, tkElevation, 4, lRetLen) = 0 Then
        Err.Raise Err.LastDllError, , "Could not retrieve Token Information!"
    Else
        Debug.Print tkElevation
        Print "Using TOKEN_ELEVATION,"
        Select Case tkElevation
            Case 0
                Print CurrentUser & " is not using elevated privileges!"
            Case Else
                Print CurrentUser & " is using elevated privileges!"
        End Select
    End If
End Sub

---