Re: A Simple BMP Converter

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.055
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.055
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 new image file by replacing selected
colors"
lblDisclaimer = "STS/ColorTab " & 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 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:dfi30i0269n@xxxxxxxxxxxxxxxxxxxxx
> ColorTab is used to create a new image from an already existing image.
> After selecting an image you can change any or all of the colors appearing
> in the image to any other color. If you have an image of a red and blue
> hot air baloon you can create an image of a yellow and green baloon or any
> combination of colors. You can not change the basic image. You can
change
> multiple colors to the same color but you can not add colors.
>
> The source code will be posted as replys to this message. There two forms
> and a vbp project file.
>
> This program will run very slow on large images. It should be used only
> on small images used as icons or images for controls such as treeview.
>
> The procedure
>
> 1. Select an image by clicking the Select button. This will display a
> standard file open dialog. When an image is selected it will be displayed
> on the form. All the colors in the image will be displayed in a separate
> picture box.
>
> 2. Select the color to be replaced. This can be done by clicking either
> source images at a point with the required color or clicking the
appropriate
> color bar in the color display. Any of these will display the color at
the
> bottom of the screen. The red, green and blue values will be displayed.
> Clicking either new image display does nothing.
>
> 3. Select the new color. The second set of red, green and blue values
> define
> the new color. You can change any value by typing a new value or you can
> click the updown control to change the value. You can also click the
Color2
> button. This will display the standard color dialog from which the new
> color can be chosen.
>
> 4. Clicking the Replace button will display the color on the left side of
> the color display.
>
> 5. Repeat steps 2 thru 4 for each color to be replaced.
>
> 6. Click the preview button to build and display the new image. This may
> take a while.
>
> 7. The name of the new file is contained in the Target text box. Update
it
> to the correct name.
>
> 8. Click the Save button to create the new file. This file will be a .bmp
> file unless the source file was a .ico or .cur file in which case the
target
> file will have the same extension. You can only create .bmp, .ico or .cur
> files as described here.
>
> 9. Clicking the Reset button just below the color display will reset all
the
> colors
> to their original values.
>
> 10. Clicking the Reset button next to the selected color display will set
> the new
> color displayed below to the original color. The Replace button can be
used
> to set the target color back to its original value.
>
> 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\ColorTab
> ' 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
>
>
>
>
>


.