Re: ColorMask BMP Mask Builder

This is frmAbout.frm
cut
here -----------------------------------------------------------------------
VERSION 5.00
Begin VB.Form frmAbout
BorderStyle = 3 'Fixed Dialog
Caption = "About MyApp"
ClientHeight = 4260
ClientLeft = 2340
ClientTop = 1935
ClientWidth = 6525
ClipControls = 0 'False
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2940.328
ScaleMode = 0 'User
ScaleWidth = 6127.313
ShowInTaskbar = 0 'False
Begin VB.PictureBox picIcon
AutoSize = -1 'True
ClipControls = 0 'False
Height = 540
Left = 240
Picture = "frmAbout.frx":0000
ScaleHeight = 337.12
ScaleMode = 0 'User
ScaleWidth = 337.12
TabIndex = 1
Top = 240
Width = 540
End
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Caption = "OK"
Default = -1 'True
Height = 345
Left = 5205
TabIndex = 0
Top = 2025
Width = 1260
End
Begin VB.CommandButton cmdSysInfo
Caption = "&System Info..."
Height = 345
Left = 5220
TabIndex = 2
Top = 2475
Width = 1245
End
Begin VB.Line Line1
BorderColor = &H00808080&
BorderStyle = 6 'Inside Solid
Index = 1
X1 = 84.515
X2 = 6085.056
Y1 = 1325.218
Y2 = 1325.218
End
Begin VB.Label lblDescription
Caption = "App Description"
ForeColor = &H00000000&
Height = 690
Left = 1050
TabIndex = 3
Top = 1125
Width = 3885
End
Begin VB.Label lblTitle
Caption = "Application Title"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 480
Left = 1050
TabIndex = 5
Top = 240
Width = 3885
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 2
Index = 0
X1 = 98.6
X2 = 6085.056
Y1 = 1325.218
Y2 = 1325.218
End
Begin VB.Label lblVersion
Caption = "Version"
Height = 225
Left = 1050
TabIndex = 6
Top = 780
Width = 3885
End
Begin VB.Label lblDisclaimer
Caption = "Warning: ..."
ForeColor = &H00000000&
Height = 2145
Left = 255
TabIndex = 4
Top = 2025
Width = 4830
End
End
Attribute VB_Name = "frmAbout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA"
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long,
ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As
Long


Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub

Private Sub cmdOK_Click()
Unload Me
End Sub

Private Sub Form_Load()
Me.Caption = "About " & App.Title
lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." &
App.Revision
lblTitle.Caption = App.Title
lblDescription.Caption = "Create a mask bitmap for a single color"
lblDisclaimer = "STS/ColorMask " & App.LegalCopyright & vbCrLf & _
"All rights reserved. Use at your own risk" & vbCrLf &
vbCrLf & _
"This software is FreeWare and may be used for any moral
purpose" & _
vbCrLf & vbCrLf & _
"If you wish to pay for this program, please send One
million dollars " & _
"or whatever you feel is appropriate to " & _
vbCrLf & "The International Rescue Committee" & vbCrLf
& _
"122 East 42nd Street, New York, NY, 10168-1289"
End Sub

Public Sub StartSysInfo()
On Error GoTo SysInfoErr

Dim rc As Long
Dim SysInfoPath As String

' Try To Get System Info Program Path\Name From Registry...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO,
SysInfoPath) Then
' Try To Get System Info Program Path Only From Registry...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC,
gREGVALSYSINFOLOC, SysInfoPath) Then
' Validate Existance Of Known 32 Bit File Version
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"

' Error - File Can Not Be Found...
Else
GoTo SysInfoErr
End If
' Error - Registry Entry Can Not Be Found...
Else
GoTo SysInfoErr
End If

Call Shell(SysInfoPath, vbNormalFocus)

Exit Sub
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As
String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An
Open Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A
Registry Key
Dim tmpVal As String ' Tempory
Storage For A Registry Key Value
Dim KeyValSize As Long ' Size Of
Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open
Registry Key

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle
Error...

tmpVal = String$(1024, 0) ' Allocate
Variable Space
KeyValSize = 1024 ' Mark Variable
Size

'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Get/Create Key
Value

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds
Null Terminated String...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found,
Extract From String
Else ' WinNT Does NOT
Null Terminate String...
tmpVal = Left(tmpVal, KeyValSize) ' Null Not
Found, Extract String Only
End If
'------------------------------------------------------------
' Determine Key Value Type For Conversion...
'------------------------------------------------------------
Select Case KeyValType ' Search Data
Types...
Case REG_SZ ' String
Registry Key Data Type
KeyVal = tmpVal ' Copy String
Value
Case REG_DWORD ' Double Word
Registry Key Data Type
For i = Len(tmpVal) To 1 Step -1 ' Convert Each
Bit
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value
Char. By Char.
Next
KeyVal = Format$("&h" + KeyVal) ' Convert Double
Word To String
End Select

GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry
Key
Exit Function ' Exit

GetKeyError: ' Cleanup After An Error Has Occured...
KeyVal = "" ' Set Return Val
To Empty String
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry
Key
End Function

cut
here -----------------------------------------------------------------------
"Philip S. Rist" <prist@xxxxxxxxxxxx> wrote in message
news:dfi360026gk@xxxxxxxxxxxxxxxxxxxxx
> This is a simple VB6 program I put together this week. It scans a
> bitmap image for a selected color. It creates a second image
> containing containing black rgb(0,0,0) at ech pixel that did not
> match the selected color and white, rgb(255,255,255) at each pixel that
> did match.
>
> Since this program works on a pixel by pixel basis it can be very slow on
> large images. It should be used only on small image files. The source
will
> be posted as replays to this message. The program consists of two forms
and
> the project file. You should be able to fill in anything that may be
> missing.
>
> This program seems to work ok on my system. I have not tried testing it
on
> any other systems. There still may some problems. Give it a try. You
have
> the source. You can always change it to do what you want. Send all
> comments to Philip S. Rist at prist@xxxxxxxxxxxxx
>
> '------------------------------------------------------------------------
> ' Module : STS\ColorMask
> ' DateTime : 8/24/05 08:16
> ' Author : Philip S. Rist
> ' E-mail : prist@xxxxxxxxxxxx
> ' Web site : http://www.innernet.net/prist
> '
> '------------------------------------------------------------------------
> ' Copyright 2005 by St. Thomas Software - All rights reserved
> '------------------------------------------------------------------------
> ' This product is used at your own risk. St.Thomas Software does not
> ' guarantee that this software does anything. Though it usually does
> ' something.
> '
> ' This software is freeware. It may be used for amy moral purpose.
> ' If you feel you need to pay for this product, please send one million
> ' dollars or whatever you feel is appropriate to
> '
> ' International Rescue Committee
> ' 122 East 42nd Street
> ' New York, NY 10168-1289
> '------------------------------------------------------------------------
>
>
> Thank you
> Philip S. Rist
>
>
>
>
>


.

Loading