Re: Gradient Generator BMP Tool Improved

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 new image files for a color gradient."
lblDisclaimer = "STS/GradGen " & 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:dfi2sv02656@xxxxxxxxxxxxxxxxxxxxx
>
> This is a simple VB6 program I put together this week. Currently it is
> composed of four forms. The source will be posted in replys to this post.
> There should be three .frm and one .vbp. The rest you should be able to
> figure out.
>
> Form1: This form is used to select two colors to form the beginning and
> ending colors of a gradient. The program generates the requested number
of
> colors evenly spaced between these two colors. The Build button is used
to
> generate a .BAS file containing VB6 CONSTant definitions for all the
colors
> displayed. The gradient can contain 8, 16, 32, 64, 128 or 256 colors.
> Depending on the terminal colors chosen these may or may not be unique
> colors. The increment at the bottom sets the increment for the UpDown
> controls. Clicking on a displayed color will set it as the dark end
> terminating color. Shift clicking a color will set it as the bright end
> terminating color.
>
> Form2: This form is activated from the Tools | BMP Generator menu item.
> This form is used to generate a series of images (.BMP, .ICO or .CUR).
One
> image is generated for each color in the Form1 gradient. The user selects
> an image file and one color on that image file. That color will be
replaced
> with the gradient color from Form1. No other colors are changed. The
user
> can choose to use only the first and last color in the gradient.
>
> Form3: This form is activated from the Tools | Colorize menu item. All
> colors except white, black and a color chosen by the user are replaced by
a
> color from the Form1 gradient. The replacement color is chosen based on
the
> intensity of the image color. Dark colors are replaced with colors at the
> top of the gradient, light colors by colors at the bottom of the gradient.
> T
>
> You can select one color to remain unchanged. If you do not want to save
a
> color check 'No saved color'. Black and white will be saved by default
> unless you selct to replace them as explained below. This option should
be
> used for any other color.
>
> To replace black check the 'Convert black' option. Unless the reverse
color
> order is checked black will be replaced with the first color in the
> gradient. This is usually the darkest color.
> To replace white check the 'Convert white' option. Unless the reverse
> color order is checked white will be replaced with the last color in the
> gradient. This is usually the lightest color.
>
> You can also choose to reverse color intensity so that dark colors are
> replaced by light colors and light colors are replaced by dark colors.
> Check 'Reverse color order' to accomplish this.
>
> 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 .bmp files and icons.
>
> 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\GradGen
> ' 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