GFSkinEngine/FrameMaker/FrameMaker.frm
VERSION 5.00
Begin VB.Form FrameMakerfrm
BorderStyle = 1 'Fest Einfach
Caption = "Frame Maker"
ClientHeight = 6015
ClientLeft = 45
ClientTop = 450
ClientWidth = 7635
Icon = "FrameMaker.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6015
ScaleWidth = 7635
StartUpPosition = 3 'Windows‑Standard
Begin VB.Frame FMViewFrame
Caption = "View"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2775
Left = 60
TabIndex = 36
ToolTipText = $"FrameMaker.frx":0442
Top = 2940
Width = 7515
Begin VB.Frame FMBorderFrame
BorderStyle = 0 'Kein
Height = 2355
Left = 120
TabIndex = 37
Top = 300
Width = 7275
Begin VB.PictureBox FMPicture
Height = 855
Left = 120
ScaleHeight = 795
ScaleWidth = 5295
TabIndex = 38
ToolTipText = "left‑ or right‑click to set light positions, press Ctrl and right‑click to move"
Top = 120
Width = 5355
End
End
End
Begin VB.Frame FMControlFrame
Caption = "Control"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2835
Left = 60
TabIndex = 35
Top = 60
Width = 7515
Begin VB.CommandButton FMResetCommand
Caption = "&Reset"
Height = 315
Left = 5100
TabIndex = 15
Top = 2340
Width = 1035
End
Begin VB.TextBox FMPlusMinusText
Height = 285
Left = 5100
TabIndex = 10
ToolTipText = "difference between the R,G and B values of the top and bottom (left and right) frame lines"
Top = 1080
Width = 1035
End
Begin VB.Frame FMSurroundingColorFrame
BackColor = &H00000000&
BorderStyle = 0 'Kein
Height = 375
Left = 6900
TabIndex = 20
ToolTipText = "surrounding color of frame/button to create"
Top = 660
Width = 435
End
Begin VB.CheckBox FMLight1Check
Caption = "Light &1"
Height = 195
Left = 1320
TabIndex = 4
ToolTipText = "left‑click into view to set position of light 1"
Top = 1560
Width = 975
End
Begin VB.CheckBox FMLight2Check
Caption = "Light &2"
Height = 195
Left = 2580
TabIndex = 5
ToolTipText = "right‑click into view to set position of light 2"
Top = 1560
Width = 975
End
Begin VB.TextBox FMLight1PowerText
Height = 285
Left = 1320
TabIndex = 6
ToolTipText = "value that will be added to the R,G and B value of the point in the light center"
Top = 1920
Width = 1035
End
Begin VB.TextBox FMLight2PowerText
Height = 285
Left = 2580
TabIndex = 7
Top = 1920
Width = 1035
End
Begin VB.TextBox FMLight1ExpansionText
Height = 285
Left = 1320
TabIndex = 8
ToolTipText = "distance between the light center and the farest point that is manipulated by the light"
Top = 2340
Width = 1035
End
Begin VB.TextBox FMLight2ExpansionText
Height = 285
Left = 2580
TabIndex = 9
Top = 2340
Width = 1035
End
Begin VB.CheckBox FMAutoRedrawEnabledCheck
Caption = "&Auto Redraw"
Height = 435
Left = 4080
TabIndex = 14
ToolTipText = "when enabled then the 'View' is updated whenever any value is changed (you don't need to press the Create button)"
Top = 2280
Width = 1035
End
Begin VB.TextBox FMThicknessText
Height = 285
Left = 1320
TabIndex = 3
ToolTipText = "1 to 3 are useful values"
Top = 1080
Width = 1035
End
Begin VB.ComboBox FMTypeCombo
Height = 315
Left = 1320
Style = 2 'Dropdown‑Liste
TabIndex = 2
ToolTipText = "select 'Risen' to create a button, 'Sunk' to create a 3D frame and 'Simple' to create a 2D frame"
Top = 660
Width = 2295
End
Begin VB.TextBox FMSizeXText
Height = 285
Left = 1320
TabIndex = 0
ToolTipText = "enter x size of frame/button to create"
Top = 240
Width = 1035
End
Begin VB.TextBox FMSizeYText
Height = 285
Left = 2580
TabIndex = 1
ToolTipText = "enter y size of frame/button to create"
Top = 240
Width = 1035
End
Begin VB.TextBox FMSaveAsText
Height = 285
Left = 5100
TabIndex = 11
ToolTipText = "use a graphics program to include the frame/button into your self‑made skin"
Top = 1500
Width = 2235
End
Begin VB.CommandButton FMSaveAsBrowseCommand
Caption = "..."
Height = 315
Left = 5100
TabIndex = 12
ToolTipText = "browse"
Top = 1920
Width = 1035
End
Begin VB.CommandButton FMSaveCommand
Caption = "&Save"
Height = 315
Left = 6300
TabIndex = 13
ToolTipText = "save the button/frame as visible in the 'View' field below"
Top = 1920
Width = 1035
End
Begin VB.Frame FMFillColorFrame
BackColor = &H00000000&
BorderStyle = 0 'Kein
Height = 375
Left = 5100
TabIndex = 19
ToolTipText = "fill color of button/frame to create"
Top = 660
Width = 435
End
Begin VB.Frame FMInnerColorFrame
BackColor = &H00000000&
BorderStyle = 0 'Kein
Height = 375
Left = 6900
TabIndex = 18
ToolTipText = "color close to fill color"
Top = 240
Width = 435
End
Begin VB.Frame FMOuterColorFrame
BackColor = &H00000000&
BorderStyle = 0 'Kein
Height = 375
Left = 5100
TabIndex = 17
ToolTipText = "color close to surrounding color"
Top = 240
Width = 435
End
Begin VB.CommandButton FMCreateCommand
Caption = "&Create"
Height = 315
Left = 6300
TabIndex = 16
ToolTipText = "redraw frame/button"
Top = 2340
Width = 1035
End
Begin VB.Label FMPlusMinusLabel
Caption = "Plus Minus"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3900
TabIndex = 32
Top = 1140
Width = 1215
End
Begin VB.Label FMLabel3
Caption = "RGB +/‑"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 6300
TabIndex = 33
Top = 1140
Width = 1035
End
Begin VB.Label FMSurroundingColorLabel
Caption = "Surr. Color:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 5700
TabIndex = 31
Top = 720
Width = 1215
End
Begin VB.Label FMExtensionLabel
Caption = "Extension (pixels)"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 120
TabIndex = 27
Top = 2280
Width = 1215
End
Begin VB.Label FMPowerLabel
Caption = "Power (RGB +/‑)"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 120
TabIndex = 26
Top = 1860
Width = 1215
End
Begin VB.Label FMThicknessLabel
Caption = "Thickness:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 24
Top = 1140
Width = 1215
End
Begin VB.Label FMLabel5
Caption = "pixels"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2580
TabIndex = 25
Top = 1140
Width = 1035
End
Begin VB.Label FMLabel4
Caption = "Frame type:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 23
Top = 720
Width = 1215
End
Begin VB.Label FMLabel1
Caption = "Frame size:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 21
Top = 300
Width = 1215
End
Begin VB.Label FMLabel2
Caption = "x"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2400
TabIndex = 22
Top = 300
Width = 135
End
Begin VB.Label FMLabel6
Caption = "Save as:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3900
TabIndex = 34
Top = 1560
Width = 1215
End
Begin VB.Label FMFillColorLabel
Caption = "Fill Color:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3900
TabIndex = 30
Top = 720
Width = 1215
End
Begin VB.Label FMOuterColorLabel
Caption = "Outer Color:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3900
TabIndex = 28
ToolTipText = "make the colors fit to the colors used in your self‑made skin"
Top = 300
Width = 1215
End
Begin VB.Label FMInnerColorLabel
Caption = "Inner Color:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 5700
TabIndex = 29
Top = 300
Width = 1215
End
End
Begin VB.Label FMInfoLabel
Caption = "Use the Frame Maker to create frames and buttons for your skin. An additional graphics app is required."
Height = 195
Left = 60
TabIndex = 39
ToolTipText = "Use an external graphics application to include the frames into you skin's back pictures"
Top = 5760
Width = 7515
End
End
Attribute VB_Name = "FrameMakerfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2002, 2003 by Louis. Originally developed for the Skin Engine (MP3 Renamer 2).
'
'NOTE: this form should be usable as stand‑alone project, together with
'the Skin Engine and also with any other project.
'The code's software architecture must support these three scenarios.
'
#Const GFSkinEngineAvailableFlag = True
'
'GFCDGetFileName
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
'GFCDSetFileName
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
'GFCDGetColor
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLORSTRUCT) As Long
'GFCDGetFileName; GFCDSetFileName
Const OFN_HIDEREADONLY = &H4
Dim NULLARRAYSTRING(0 To 0) As String 'disable if already existing in target project
'GFCDGetFileName; GFCDSetFileName
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'GFCDGetColor
Private Type CHOOSECOLORSTRUCT
lStructSize As Long
hWndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'GFCDGetColor
Const CC_RGBINIT = &H1
'other
Dim NULLARRAYLONG(0 To 0) As Long
'PointStruct
Private Type PointStruct
X As Long
Y As Long
End Type
'FMControlStruct ‑ general data
Private Type FMControlStruct
RegMainKey As Long
RegRootKey As String
RegWriteDisabledFlag As Boolean 'FMToReg won't write if this flag is set to True
End Type
Dim FMControlStructVar As FMControlStruct
'LightStruct
Private Type LightStruct
Light1EnabledFlag As Boolean
Light2EnabledFlag As Boolean
Light1Pos As PointStruct
Light2Pos As PointStruct
Light1Power As Long
Light2Power As Long
Light1Expansion As Long
Light2Expansion As Long
End Type
'FMCreationStruct ‑ contains all data necessary to create a frame
Private Type FMCreationStruct
FrameXSize As Long
FrameYSize As Long
FrameType As Integer
FrameOuterColor As Long
FrameInnerColor As Long
FrameFillColor As Long
FrameSurroundingColor As Long
FrameThickness As Long
FramePlusMinus As Long 'color difference between top and bottom, left and right frame edge
LightStructVar As LightStruct
AutoRedrawEnabledFlag As Boolean
AutoRedrawLockedFlag As Boolean 'if enabled then there will be no auto‑redraw
OutputDir As String 'default dir where files are to be saved
FMPictureTop As Single
FMPictureLeft As Single
End Type
Dim FrameCreationStructVar As FMCreationStruct
'FMPictureMoveStruct
Private Type FMPictureMoveStruct
MoveEnabledFlag As Boolean
MoveXPos As Long 'X of MouseDown() event
MoveYPos As Long 'Y of MouseDown() event
End Type
Dim FMPictureMoveStructVar As FMPictureMoveStruct
'FrameType constants
Private Const FRAMETYPE_RISEN As Integer = 1
Private Const FRAMETYPE_SUNK As Integer = 2
Private Const FRAMETYPE_SIMPLE As Integer = 3
Private Sub Form_Load()
'On Error Resume Next
FMControlStructVar.RegWriteDisabledFlag = True 'don't write if Change‑event of some controls fire
Call DefineFMControlStruct
Call DefineFMTypeCombo
Call DefineStatus
FMControlStructVar.RegWriteDisabledFlag = False
Call FMFromReg(FrameCreationStructVar)
Call FMFromCreationStruct(FrameCreationStructVar)
Call FMCreateCommand_Click
End Sub
Private Sub DefineFMControlStruct()
'On Error Resume Next
'
'NOTE: this sub presets the registry settings. Any kind of target project
'can use FM_Initialize to change the registry settings.
'NOTE: we must not set the values below if already set as
'FM_Initialize() may be called before this sub is called (tested).
'
If FMControlStructVar.RegMainKey = 0 Then _
FMControlStructVar.RegMainKey = HKEY_LOCAL_MACHINE
If FMControlStructVar.RegRootKey = "" Then _
FMControlStructVar.RegRootKey = "SOFTWARE\FrameMaker"
End Sub
Private Sub DefineFMTypeCombo()
'On Error Resume Next
FMTypeCombo.Clear 'reset
FMTypeCombo.AddItem "Risen"
FMTypeCombo.AddItem "Sunk"
FMTypeCombo.AddItem "Simple"
FMTypeCombo.TEXT = FMTypeCombo.List(1) 'default is Sunk
End Sub
Private Sub DefineStatus()
'On Error Resume Next
FMSizeXText.MaxLength = Len(LTrim$(Str$((Screen.Width / Screen.TwipsPerPixelX))))
FMSizeYText.MaxLength = Len(LTrim$(Str$((Screen.Height / Screen.TwipsPerPixelY))))
FMThicknessText.MaxLength = 3
FMPlusMinusText.MaxLength = 4 '1 extra for minus sign
FMLight1PowerText.MaxLength = 4 '1 extra for minus sign
FMLight2PowerText.MaxLength = 4 '1 extra for minus sign
FMLight1ExpansionText.MaxLength = 5
FMLight2ExpansionText.MaxLength = 5
End Sub
'************************************INTERFACE SUBS*************************************
Public Sub FM_Initialize(ByVal RegMainKey As Long, ByVal RegRootKey As String)
'On Error Resume Next
'NOTE: pass e.g. HKEY_LOCAL_MACHINE and "Software\MP3 Renamer 2\".
FMControlStructVar.RegMainKey = RegMainKey
FMControlStructVar.RegRootKey = RegRootKey + "FrameMaker\"
End Sub
Public Sub FM_Show()
'On Error Resume Next
'preset (important, tested)
Call FMFromReg(FrameCreationStructVar)
Call FMFromCreationStruct(FrameCreationStructVar)
Call FMCreateCommand_Click
'begin
Me.Enabled = True
Me.Visible = True
Me.Refresh
#If GFSkinEngineAvailableFlag = True Then
Call SE_ForwardCallBackMessage(SECBMSG_FRAMEMAKERFRM_OPENED, "", "")
#End If
End Sub
Public Sub FM_Hide()
'On Error Resume Next
Me.Visible = False
Me.Enabled = False
Me.Refresh
#If GFSkinEngineAvailableFlag = True Then
Call SE_ForwardCallBackMessage(SECBMSG_FRAMEMAKERFRM_CLOSED, "", "")
#End If
End Sub
'*********************************END OF INTERFACE SUBS*********************************
'************************************CONTROL EVENTS*************************************
'***MOUSE EVENTS***
'NOTE: the user can move the frame/button (FMPicture) around to verify
'every edge and corner of the frame/button can be viewed.
Private Sub FMPicture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'On Error Resume Next
'
'NOTE: by clicking here the user can change the position of the
'two lights ‑ left click: change pos of light 1, right click: change pos of light 2.
'
If Shift = 0 Then
Select Case Button
Case vbLeftButton
FrameCreationStructVar.LightStructVar.Light1Pos.X = X
FrameCreationStructVar.LightStructVar.Light1Pos.Y = Y
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
Case vbRightButton
FrameCreationStructVar.LightStructVar.Light2Pos.X = X
FrameCreationStructVar.LightStructVar.Light2Pos.Y = Y
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Select
End If
If Shift = vbCtrlMask Then
Select Case Button
Case vbLeftButton, vbRightButton
FMPictureMoveStructVar.MoveEnabledFlag = True
FMPictureMoveStructVar.MoveXPos = X
FMPictureMoveStructVar.MoveYPos = Y
FMPicture.MousePointer = vbSizeAll
End Select
End If
End Sub
Private Sub FMPicture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'On Error Resume Next
Dim NewLeft As Single
Dim NewTop As Single
'begin
If FMPictureMoveStructVar.MoveEnabledFlag = True Then
NewLeft = FMPicture.Left + (X ‑ FMPictureMoveStructVar.MoveXPos)
NewTop = FMPicture.Top + (Y ‑ FMPictureMoveStructVar.MoveYPos)
'verify
Call FMPicture_VerifyPosition(NewLeft, NewTop)
'apply new position
If Not (FMPicture.Left = NewLeft) Then
FMPicture.Left = NewLeft
FMPicture.Refresh 'avoid window‑salad
FMBorderFrame.Refresh 'avoid window‑salad
End If
If Not (FMPicture.Left = NewTop) Then
FMPicture.Top = NewTop
FMPicture.Refresh 'avoid window‑salad
FMBorderFrame.Refresh 'avoid window‑salad
End If
End If
End Sub
Private Sub FMPicture_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'On Error Resume Next
If FMPictureMoveStructVar.MoveEnabledFlag = True Then
FMPictureMoveStructVar.MoveEnabledFlag = False 'reset
FMPicture.MousePointer = vbNormal
End If
End Sub
Private Sub FMPicture_VerifyPosition(ByRef NewLeft As Single, ByRef NewTop As Single)
'On Error Resume Next 'verifies FMPicture is visible (at least 10 pixels)
If NewLeft > (FMBorderFrame.Width ‑ (10 * Screen.TwipsPerPixelX)) Then _
NewLeft = (FMBorderFrame.Width ‑ (10 * Screen.TwipsPerPixelX))
If (NewLeft + FMPicture.Width) < (10 * Screen.TwipsPerPixelX) Then _
NewLeft = (10 * Screen.TwipsPerPixelX ‑ FMPicture.Width)
If NewTop > (FMBorderFrame.Height ‑ (10 * Screen.TwipsPerPixelY)) Then _
NewTop = (FMBorderFrame.Height ‑ (10 * Screen.TwipsPerPixelY))
If (NewTop + FMPicture.Height) < (10 * Screen.TwipsPerPixelY) Then _
NewTop = (10 * Screen.TwipsPerPixelY ‑ FMPicture.Height)
End Sub
'***END OF MOUSE EVENTS***
'***KEY EVENTS***
Private Sub FMPicture_KeyDown(KeyCode As Integer, Shift As Integer)
'On Error Resume Next
If KeyCode = vbKeyControl Then
FMPicture.MousePointer = vbSizeAll
End If
End Sub
Private Sub FMPicture_KeyUp(KeyCode As Integer, Shift As Integer)
'On Error Resume Next
If KeyCode = vbKeyControl Then
If FMPictureMoveStructVar.MoveEnabledFlag = False Then
FMPicture.MousePointer = vbDefault
Else
'NOTE: the mouse pointer will be reset in FMPicture_MouseUp().
End If
End If
End Sub
'***END OF KEY EVENTS***
'***SAVE***
Private Sub FMSaveAsBrowseCommand_Click()
'On Error Resume Next
Dim FilterDescriptionArray(1 To 1) As String
Dim FilterStringArray(1 To 1) As String
Dim DefaultPath As String
Dim SaveAs As String
'preset
If (Len(FMSaveAsText.TEXT)) Then
DefaultPath = FMSaveAsText.TEXT
Else
DefaultPath = App.Path
If Not (Right$(DefaultPath, 1) = "\") Then DefaultPath = DefaultPath + "\" 'verify
End If
FilterDescriptionArray(1) = "Bitmap"
FilterStringArray(1) = "*.bmp"
'begin
FrameMakerfrm.Enabled = False 'important (tested)
SaveAs = GFCDSetFileName("Save frame as...", 1, FilterDescriptionArray(), FilterStringArray(), 1, DefaultPath)
FrameMakerfrm.Enabled = True 'reset
FrameMakerfrm.SetFocus 'important (tested)
If (Len(SaveAs)) Then 'verify user didn't cancel
If Not (LCase$(Right$(SaveAs, 4)) = ".bmp") Then SaveAs = SaveAs + ".bmp" 'verify
FMSaveAsText.TEXT = SaveAs
End If
End Sub
Private Sub FMSaveCommand_Click()
On Error GoTo Error: 'important (if save name invalid)
If (Right$(FMSaveAsText.TEXT, 1) = "\") Or (Len(FMSaveAsText.TEXT) = 0) Then 'verify
Call FMSaveAsBrowseCommand_Click
End If
If (Not (Right$(FMSaveAsText.TEXT, 1) = "\") Or (Len(FMSaveAsText.TEXT) = 0)) Then 'verify
If Not (LCase$(Right$(FMSaveAsText.TEXT, 4)) = ".bmp") Then FMSaveAsText.TEXT = FMSaveAsText.TEXT + ".bmp" 'verify
Call SavePicture(FMPicture.Image, FMSaveAsText.TEXT)
MsgBox "File has been saved.", vbOKOnly + vbInformation
Else
MsgBox "Saving file failed !", vbOKOnly + vbExclamation
End If
Exit Sub
Error:
MsgBox "Error saving file, reason: " + Err.Description + " !", vbOKOnly + vbExclamation
Exit Sub 'error
End Sub
'***END OF SAVE***
'***CHANGE EVENTS***
'NOTE: if any value used to create the frame/button is changed by the user
'then the frame/button is redrawn automatically if the related check box is checked.
Private Sub FMSizeXText_Change()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMSizeYText_Change()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMTypeCombo_Click()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMLight1Check_Click()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMLight2Check_Click()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMLight1PowerText_Change()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMLight2PowerText_Change()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMLight1ExpansionText_Change()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMLight2ExpansionText_Change()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMThicknessText_Change()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMOuterColorFrame_Click()
'On Error Resume Next
Dim Color As Long
'begin
Color = GFCDGetColor(FMOuterColorFrame.BackColor, 0, NULLARRAYLONG())
If Not (Color = True) Then 'verify
FMOuterColorFrame.BackColor = Color
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End If
End Sub
Private Sub FMInnerColorFrame_Click()
'On Error Resume Next
Dim Color As Long
'begin
Color = GFCDGetColor(FMInnerColorFrame.BackColor, 0, NULLARRAYLONG())
If Not (Color = True) Then 'verify
FMInnerColorFrame.BackColor = Color
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End If
End Sub
Private Sub FMFillColorFrame_Click()
'On Error Resume Next
Dim Color As Long
'begin
Color = GFCDGetColor(FMFillColorFrame.BackColor, 0, NULLARRAYLONG())
If Not (Color = True) Then 'verify
FMFillColorFrame.BackColor = Color
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End If
End Sub
Private Sub FMSurroundingColorFrame_Click()
'On Error Resume Next
Dim Color As Long
'begin
Color = GFCDGetColor(FMSurroundingColorFrame.BackColor, 0, NULLARRAYLONG())
If Not (Color = True) Then 'verify
FMSurroundingColorFrame.BackColor = Color
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End If
End Sub
Private Sub FMPlusMinusText_Change()
'On Error Resume Next
If (FrameCreationStructVar.AutoRedrawEnabledFlag = True) And (FrameCreationStructVar.AutoRedrawLockedFlag = False) Then _
Call FMCreateCommand_Click
End Sub
Private Sub FMAutoRedrawEnabledCheck_Click()
'On Error Resume Next
FrameCreationStructVar.AutoRedrawEnabledFlag = CHECKTOBOOL(FMAutoRedrawEnabledCheck.Value)
End Sub
'***END OF CHANGE EVENTS***
Private Sub FMResetCommand_Click()
'On Error Resume Next
If MsgBox("Are you sure you want to use the default values ?", vbYesNo + vbQuestion) = vbYes Then
Call Rmod.RegDeleteSubKey(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey)
'reload (code from Form_Load)
Call FMFromReg(FrameCreationStructVar)
Call FMFromCreationStruct(FrameCreationStructVar)
Call FMCreateCommand_Click
End If
End Sub
Private Sub FMCreateCommand_Click()
'On Error Resume Next
Dim NewLeft As Single
Dim NewTop As Single
'preset
Call FMToFrameCreationStruct(FrameCreationStructVar)
'
'NOTE: transferring verified values back to the controls did not work
'(endless loops, negative values turned into positive ones, etc.).
'
FMPicture.Width = (FrameCreationStructVar.FrameXSize + 0) * Screen.TwipsPerPixelX 'border style is 0
FMPicture.Height = (FrameCreationStructVar.FrameYSize + 0) * Screen.TwipsPerPixelY 'border style is 0
FMPicture.AutoRedraw = True
FMPicture.BorderStyle = 0 'no border
FMPicture.ScaleMode = vbPixels
FMPicture.Cls 'reset
FMPicture.BackColor = FrameCreationStructVar.FrameFillColor
FMBorderFrame.BackColor = FrameCreationStructVar.FrameSurroundingColor
'verify
NewLeft = FMPicture.Left
NewTop = FMPicture.Top
Call FMPicture_VerifyPosition(NewLeft, NewTop) 'important if frame has been shrunk
If Not (FMPicture.Left = NewLeft) Then FMPicture.Left = NewLeft
If Not (FMPicture.Left = NewTop) Then FMPicture.Top = NewTop
'begin
Me.MousePointer = vbHourglass
Call FM_CreateFrame(FrameCreationStructVar, FMPicture)
Call FMToReg(FrameCreationStructVar)
Me.MousePointer = vbDefault
End Sub
'*********************************END OF CONTROL EVENTS*********************************
'***********************************DRAWING FUNCTIONS***********************************
Private Sub FM_CreateFrame(ByRef FrameCreationStructVar As FMCreationStruct, ByRef PictureBoxControl As PictureBox)
'On Error Resume Next 'draws frame/button, light effects are created by FM_DrawLine()
Dim LineColorPlusMinus As Long
Dim LineStartPoint As PointStruct
Dim LineEndPoint As PointStruct
Dim LineColor As Long
Dim Temp As Long
'preset
LineColorPlusMinus = FrameCreationStructVar.FramePlusMinus
'begin
With FrameCreationStructVar
'top line(s)
For Temp = 1 To .FrameThickness
'
LineStartPoint.X = (Temp ‑ 1)
LineStartPoint.Y = (Temp ‑ 1)
LineEndPoint.X = .FrameXSize ‑ Temp
LineEndPoint.Y = (Temp ‑ 1)
'
LineColor = GFColormod.GFColor_MixColor( _
.FrameInnerColor, .FrameOuterColor, (CSng(Temp) / CSng(.FrameThickness)))
'
Select Case .FrameType
Case FRAMETYPE_SUNK
LineColor = GFColormod.GFColor_ChangeBrightness(LineColor, ‑LineColorPlusMinus)
Case FRAMETYPE_RISEN
LineColor = GFColormod.GFColor_ChangeBrightness(LineColor, LineColorPlusMinus)
Case FRAMETYPE_SIMPLE
'leave LineColor unchanged
End Select
'
Call FM_DrawLine(LineStartPoint, LineEndPoint, LineColor, FrameCreationStructVar.LightStructVar, PictureBoxControl)
Next Temp
'bottom line(s)
For Temp = 1 To .FrameThickness
'
LineStartPoint.X = (Temp ‑ 1)
LineStartPoint.Y = (.FrameYSize ‑ 1) ‑ (Temp ‑ 1)
LineEndPoint.X = .FrameXSize ‑ Temp
LineEndPoint.Y = (.FrameYSize ‑ 1) ‑ (Temp ‑ 1)
'
LineColor = GFColormod.GFColor_MixColor( _
.FrameInnerColor, .FrameOuterColor, (CSng(Temp) / CSng(.FrameThickness)))
'
Select Case .FrameType
Case FRAMETYPE_SUNK
LineColor = GFColormod.GFColor_ChangeBrightness(LineColor, LineColorPlusMinus)
Case FRAMETYPE_RISEN
LineColor = GFColormod.GFColor_ChangeBrightness(LineColor, ‑LineColorPlusMinus)
Case FRAMETYPE_SIMPLE
'leave LineColor unchanged
End Select
'
Call FM_DrawLine(LineStartPoint, LineEndPoint, LineColor, FrameCreationStructVar.LightStructVar, PictureBoxControl)
Next Temp
'left line(s)
For Temp = 1 To .FrameThickness
'
LineStartPoint.X = (Temp ‑ 1)
LineStartPoint.Y = (Temp ‑ 1)
LineEndPoint.X = (Temp ‑ 1)
LineEndPoint.Y = (.FrameYSize ‑ 1) ‑ (Temp ‑ 1)
'
LineColor = GFColormod.GFColor_MixColor( _
.FrameInnerColor, .FrameOuterColor, (CSng(Temp) / CSng(.FrameThickness)))
'
Select Case .FrameType
Case FRAMETYPE_SUNK
LineColor = GFColormod.GFColor_ChangeBrightness(LineColor, ‑LineColorPlusMinus)
Case FRAMETYPE_RISEN
LineColor = GFColormod.GFColor_ChangeBrightness(LineColor, LineColorPlusMinus)
Case FRAMETYPE_SIMPLE
'leave LineColor unchanged
End Select
Call FM_DrawLine(LineStartPoint, LineEndPoint, LineColor, FrameCreationStructVar.LightStructVar, PictureBoxControl)
Next Temp
'right line(s)
For Temp = 1 To .FrameThickness
'
LineStartPoint.X = (.FrameXSize ‑ 1) ‑ (Temp ‑ 1)
LineStartPoint.Y = (Temp ‑ 1)
LineEndPoint.X = (.FrameXSize ‑ 1) ‑ (Temp ‑ 1)
LineEndPoint.Y = (.FrameYSize ‑ 1) ‑ (Temp ‑ 1)
'
LineColor = GFColormod.GFColor_MixColor( _
.FrameInnerColor, .FrameOuterColor, (CSng(Temp) / CSng(.FrameThickness)))
'
Select Case .FrameType
Case FRAMETYPE_SUNK
LineColor = GFColormod.GFColor_ChangeBrightness(LineColor, LineColorPlusMinus)
Case FRAMETYPE_RISEN
LineColor = GFColormod.GFColor_ChangeBrightness(LineColor, ‑LineColorPlusMinus)
Case FRAMETYPE_SIMPLE
'leave LineColor unchanged
End Select
'
Call FM_DrawLine(LineStartPoint, LineEndPoint, LineColor, FrameCreationStructVar.LightStructVar, PictureBoxControl)
Next Temp
End With
End Sub
Private Sub FM_DrawLine(ByRef LineStartPoint As PointStruct, ByRef LineEndPoint As PointStruct, ByVal LineColor As Long, ByRef LightStructVar As LightStruct, ByRef PictureBoxControl As PictureBox)
'On Error Resume Next 'draws a line, automatically includes light effects
Dim LineColorPlusMinus As Long
Dim PM1 As Long
Dim PM2 As Long
Dim DotLoopLng As Long
Dim DotLoopMax As Long
Dim DotColor As Long
Dim DotXPos As Long
Dim DotYPos As Long
Dim Tempsngl!
'preset
DotLoopMax = GetPointPointDistLong2D(LineStartPoint.X, LineStartPoint.Y, LineEndPoint.X, LineEndPoint.Y)
'begin
For DotLoopLng = 0 To DotLoopMax 'start at 0 (tested)
'
DotXPos = LineStartPoint.X + (CSng(LineEndPoint.X) ‑ CSng(LineStartPoint.X)) * (CSng(DotLoopLng) / CSng(DotLoopMax))
DotYPos = LineStartPoint.Y + (CSng(LineEndPoint.Y) ‑ CSng(LineStartPoint.Y)) * (CSng(DotLoopLng) / CSng(DotLoopMax))
'
If LightStructVar.Light1EnabledFlag = True Then
'
Tempsngl! = _
CSng(MAX( _
LightStructVar.Light1Expansion ‑ ( _
GFMaths_Geometrymod.GetPointPointDistLong2D( _
DotXPos, DotYPos, LightStructVar.Light1Pos.X, LightStructVar.Light1Pos.Y) _
), _
0)) / CSng(LightStructVar.Light1Expansion)
'
PM1 = CLng(Tempsngl! * CSng(LightStructVar.Light1Power))
Else
PM1 = 0&
End If
If LightStructVar.Light2EnabledFlag = True Then
'
Tempsngl! = _
CSng(MAX( _
LightStructVar.Light2Expansion ‑ ( _
GFMaths_Geometrymod.GetPointPointDistLong2D( _
DotXPos, DotYPos, LightStructVar.Light2Pos.X, LightStructVar.Light2Pos.Y) _
), _
0)) / CSng(LightStructVar.Light2Expansion)
'
PM2 = CLng(Tempsngl! * CSng(LightStructVar.Light2Power))
Else
PM2 = 0&
End If
'
LineColorPlusMinus = _
PM1 + _
PM2
'
DotColor = GFColormod.GFColor_ChangeBrightness( _
LineColor, _
LineColorPlusMinus)
'
PictureBoxControl.PSet ( _
DotXPos, _
DotYPos), DotColor
'
Next DotLoopLng
End Sub
'*******************************END OF DRAWING FUNCTIONS********************************
'***********************************FMCREATIONSTRUCT************************************
'NOTE: call FMToFrameCreationStruct() to transfer the control values to the structure.
'The structure values are verified but the control values are not changed in any way.
'Call FMFromCreationStruct() to transfer the values from the structure to the controls.
Private Sub FMToFrameCreationStruct(ByRef FrameCreationStructVar As FMCreationStruct)
'On Error Resume Next
'
'NOTE: we use Val(Left$(... to avoid any Long overflow error.
'
'begin
With FrameCreationStructVar
.FrameXSize = Val(Left$(FMSizeXText.TEXT, 5))
.FrameYSize = Val(Left$(FMSizeYText.TEXT, 5))
Select Case FMTypeCombo.TEXT
Case "Risen"
.FrameType = FRAMETYPE_RISEN
Case "Sunk"
.FrameType = FRAMETYPE_SUNK
Case "Simple"
.FrameType = FRAMETYPE_SIMPLE
End Select
.FrameInnerColor = FMInnerColorFrame.BackColor
.FrameOuterColor = FMOuterColorFrame.BackColor
.FrameFillColor = FMFillColorFrame.BackColor
.FrameSurroundingColor = FMSurroundingColorFrame.BackColor
.FrameThickness = Val(Left$(FMThicknessText.TEXT, 5))
.FramePlusMinus = Val(Left$(FMPlusMinusText.TEXT, 5))
.LightStructVar.Light1EnabledFlag = CHECKTOBOOL(FMLight1Check)
.LightStructVar.Light2EnabledFlag = CHECKTOBOOL(FMLight2Check)
.LightStructVar.Light1Power = Val(FMLight1PowerText.TEXT)
.LightStructVar.Light2Power = Val(FMLight2PowerText.TEXT)
.LightStructVar.Light1Expansion = Val(FMLight1ExpansionText.TEXT)
.LightStructVar.Light2Expansion = Val(FMLight2ExpansionText.TEXT)
.AutoRedrawEnabledFlag = CHECKTOBOOL(FMAutoRedrawEnabledCheck.Value)
.OutputDir = GetDirectoryName(FMSaveAsText.TEXT)
.FMPictureLeft = FMPicture.Left
.FMPictureTop = FMPicture.Top
End With
'verify
With FrameCreationStructVar
Select Case .FrameThickness 'verify first
Case Is < 1
.FrameThickness = 1
Case Is > 128
.FrameThickness = 128
End Select
Select Case .FrameXSize 'verify after verifying .FrameThickness
Case Is < (.FrameThickness * 2)
.FrameXSize = (.FrameThickness * 2)
Case Is > (Screen.Width / Screen.TwipsPerPixelX)
.FrameXSize = (Screen.Width / Screen.TwipsPerPixelX)
End Select
Select Case .FrameYSize 'verify after verifying .FrameThickness
Case Is < (.FrameThickness * 2)
.FrameYSize = (.FrameThickness * 2)
Case Is > (Screen.Height / Screen.TwipsPerPixelY)
.FrameYSize = (Screen.Height / Screen.TwipsPerPixelY)
End Select
Select Case .FramePlusMinus
Case Is < ‑255&
.FramePlusMinus = ‑255&
Case Is > 255&
.FramePlusMinus = 255&
End Select
Select Case .LightStructVar.Light1Power
Case Is < ‑255&
.LightStructVar.Light1Power = ‑255&
Case Is > 255&
.LightStructVar.Light1Power = 255&
End Select
Select Case .LightStructVar.Light2Power
Case Is < ‑255&
.LightStructVar.Light2Power = ‑255&
Case Is > 255&
.LightStructVar.Light2Power = 255&
End Select
Select Case .LightStructVar.Light1Expansion
Case Is < 1&
.LightStructVar.Light1Expansion = 1&
Case Is > 10240&
.LightStructVar.Light1Expansion = 10240&
End Select
Select Case .LightStructVar.Light2Expansion
Case Is < 1&
.LightStructVar.Light2Expansion = 1&
Case Is > 10240&
.LightStructVar.Light2Expansion = 10240&
End Select
Select Case .LightStructVar.Light1Pos.X
Case Is < 0
.LightStructVar.Light1Pos.X = 0
Case Is > .FrameXSize
.LightStructVar.Light1Pos.X = .FrameXSize
End Select
Select Case .LightStructVar.Light2Pos.X
Case Is < 0
.LightStructVar.Light2Pos.X = 0
Case Is > .FrameXSize
.LightStructVar.Light2Pos.X = .FrameXSize
End Select
Select Case .LightStructVar.Light1Pos.Y
Case Is < 0
.LightStructVar.Light1Pos.Y = 0
Case Is > .FrameYSize
.LightStructVar.Light1Pos.Y = .FrameYSize
End Select
Select Case .LightStructVar.Light2Pos.Y
Case Is < 0
.LightStructVar.Light2Pos.Y = 0
Case Is > .FrameYSize
.LightStructVar.Light2Pos.Y = .FrameYSize
End Select
Select Case .FramePlusMinus
Case Is < ‑255&
.FramePlusMinus = ‑255&
Case Is > 255&
.FramePlusMinus = 255&
End Select
End With
End Sub
Private Sub FMFromCreationStruct(ByRef FMCreationStructVar As FMCreationStruct)
'On Error Resume Next
'
FMCreationStructVar.AutoRedrawLockedFlag = True 'do not redraw frame/button (important)
'
FMSizeXText.TEXT = LTrim$(Str$(FMCreationStructVar.FrameXSize))
FMSizeYText.TEXT = LTrim$(Str$(FMCreationStructVar.FrameYSize))
FMThicknessText.TEXT = LTrim$(Str$(FMCreationStructVar.FrameThickness))
Select Case FMCreationStructVar.FrameType
Case FRAMETYPE_RISEN
FMTypeCombo.TEXT = "Risen"
Case FRAMETYPE_SUNK
FMTypeCombo.TEXT = "Sunk"
Case FRAMETYPE_SIMPLE
FMTypeCombo.TEXT = "Simple"
End Select
FMOuterColorFrame.BackColor = FMCreationStructVar.FrameOuterColor
FMInnerColorFrame.BackColor = FMCreationStructVar.FrameInnerColor
FMFillColorFrame.BackColor = FMCreationStructVar.FrameFillColor
FMSurroundingColorFrame.BackColor = FMCreationStructVar.FrameSurroundingColor
FMPlusMinusText.TEXT = LTrim$(Str$(FMCreationStructVar.FramePlusMinus))
FMLight1Check.Value = BOOLTOCHECK(FMCreationStructVar.LightStructVar.Light1EnabledFlag)
FMLight2Check.Value = BOOLTOCHECK(FMCreationStructVar.LightStructVar.Light2EnabledFlag)
FMLight1PowerText.TEXT = LTrim$(Str$(FMCreationStructVar.LightStructVar.Light1Power))
FMLight2PowerText.TEXT = LTrim$(Str$(FMCreationStructVar.LightStructVar.Light2Power))
FMLight1ExpansionText.TEXT = LTrim$(Str$(FMCreationStructVar.LightStructVar.Light1Expansion))
FMLight2ExpansionText.TEXT = LTrim$(Str$(FMCreationStructVar.LightStructVar.Light2Expansion))
FMAutoRedrawEnabledCheck.Value = BOOLTOCHECK(FMCreationStructVar.AutoRedrawEnabledFlag)
FMSaveAsText.TEXT = FMCreationStructVar.OutputDir
Call FMPicture_VerifyPosition(FMCreationStructVar.FMPictureLeft, FMCreationStructVar.FMPictureTop)
FMPicture.Left = FMCreationStructVar.FMPictureLeft
FMPicture.Top = FMCreationStructVar.FMPictureTop
'
FrameCreationStructVar.AutoRedrawLockedFlag = False 'reset
'
End Sub
'***********************************FMCREATIONSTRUCT************************************
'******************************************REG******************************************
'NOTE: all FMCreationStruct values are saved in the registry when calling FMToReg().
Private Sub FMToReg(ByRef FMCreationStructVar As FMCreationStruct)
'On Error Resume Next
'verify
If FMControlStructVar.RegWriteDisabledFlag = True Then Exit Sub 'don't write if presetting control properties
'reset
Call Rmod.RegDeleteSubKey(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey)
Call Rmod.RegCreateSubKey(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey)
'begin
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame x size", CVar(FMCreationStructVar.FrameXSize), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame y size", CVar(FMCreationStructVar.FrameYSize), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame type", CVar(FMCreationStructVar.FrameType), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame thickness", CVar(FMCreationStructVar.FrameThickness), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame plus minus", CVar(FMCreationStructVar.FramePlusMinus), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame outer color", CVar(COLORTOSTRING(FMCreationStructVar.FrameOuterColor)), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame inner color", CVar(COLORTOSTRING(FMCreationStructVar.FrameInnerColor)), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame fill color", CVar(COLORTOSTRING(FMCreationStructVar.FrameFillColor)), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame surrounding color", CVar(COLORTOSTRING(FMCreationStructVar.FrameSurroundingColor)), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 enabled", CVar(BOOLTOSTRING(FMCreationStructVar.LightStructVar.Light1EnabledFlag)), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 x pos", CVar(FMCreationStructVar.LightStructVar.Light1Pos.X), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 y pos", CVar(FMCreationStructVar.LightStructVar.Light1Pos.Y), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 enabled", CVar(BOOLTOSTRING(FMCreationStructVar.LightStructVar.Light2EnabledFlag)), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 x pos", CVar(FMCreationStructVar.LightStructVar.Light2Pos.X), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 y pos", CVar(FMCreationStructVar.LightStructVar.Light2Pos.Y), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 power", CVar(FMCreationStructVar.LightStructVar.Light1Power), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 power", CVar(FMCreationStructVar.LightStructVar.Light2Power), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 expansion", CVar(FMCreationStructVar.LightStructVar.Light1Expansion), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 expansion", CVar(FMCreationStructVar.LightStructVar.Light2Expansion), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "auto redraw enabled", CVar(BOOLTOSTRING(FMCreationStructVar.AutoRedrawEnabledFlag)), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "output dir", CVar(FMCreationStructVar.OutputDir), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "fm picture left", CVar(FMCreationStructVar.FMPictureLeft), REG_SZ)
Call Rmod.RegSetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "fm picture top", CVar(FMCreationStructVar.FMPictureTop), REG_SZ)
Exit Sub
End Sub
Private Sub FMFromReg(ByRef FMCreationStructVar As FMCreationStruct)
'On Error Resume Next
Dim Tempstr$
'
'NOTE: this sub presets any var to a useful value if
'no value is saved in registry.
'
'begin
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame x size")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FrameXSize = Val(Left$(Tempstr$, 5))
Else
FMCreationStructVar.FrameXSize = 150&
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame y size")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FrameYSize = Val(Left$(Tempstr$, 5))
Else
FMCreationStructVar.FrameYSize = 25&
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame type")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FrameType = Val(Left$(Tempstr$, 3))
Else
FMCreationStructVar.FrameType = FRAMETYPE_SUNK
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame thickness")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FrameThickness = Val(Left$(Tempstr$, 3))
Else
FMCreationStructVar.FrameThickness = 2&
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame plus minus")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FramePlusMinus = Val(Left$(Tempstr$, 5))
Else
FMCreationStructVar.FramePlusMinus = 64
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame outer color")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FrameOuterColor = STRINGTOCOLOR(Tempstr$) 'no Left$() used
Else
FMCreationStructVar.FrameOuterColor = RGB(0, 0, 0)
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame inner color")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FrameInnerColor = STRINGTOCOLOR(Tempstr$) 'no Left$() used
Else
FMCreationStructVar.FrameInnerColor = RGB(255, 255, 255)
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame fill color")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FrameFillColor = STRINGTOCOLOR(Tempstr$) 'no Left$() used
Else
FMCreationStructVar.FrameFillColor = RGB(200, 200, 220)
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "frame surrounding color")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FrameSurroundingColor = STRINGTOCOLOR(Tempstr$) 'no Left$() used
Else
FMCreationStructVar.FrameSurroundingColor = RGB(200, 200, 200)
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 enabled")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light1EnabledFlag = STRINGTOBOOL(Tempstr$)
Else
FMCreationStructVar.LightStructVar.Light1EnabledFlag = True 'light 2 is NOT enabled by default
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 x pos")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light1Pos.X = Val(Tempstr$)
Else
FMCreationStructVar.LightStructVar.Light1Pos.X = 0&
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 y pos")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light1Pos.Y = Val(Tempstr$)
Else
FMCreationStructVar.LightStructVar.Light1Pos.Y = 0&
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 enabled")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light2EnabledFlag = STRINGTOBOOL(Tempstr$)
Else
FMCreationStructVar.LightStructVar.Light2EnabledFlag = False
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 x pos")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light2Pos.X = Val(Tempstr$)
Else
FMCreationStructVar.LightStructVar.Light2Pos.X = FMCreationStructVar.FrameXSize
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 y pos")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light2Pos.Y = Val(Tempstr$)
Else
FMCreationStructVar.LightStructVar.Light2Pos.Y = FMCreationStructVar.FrameYSize
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 power")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light1Power = Val(Left$(Tempstr$, 5)) 'use Left$() to avoid overflow
Else
FMCreationStructVar.LightStructVar.Light1Power = 64
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 power")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light2Power = Val(Left$(Tempstr$, 5)) 'use Left$() to avoid overflow
Else
FMCreationStructVar.LightStructVar.Light2Power = ‑64
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 1 expansion")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light1Expansion = Val(Left$(Tempstr$, 5)) 'use Left$() to avoid overflow
Else
FMCreationStructVar.LightStructVar.Light1Expansion = 50
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "light 2 expansion")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.LightStructVar.Light2Expansion = Val(Left$(Tempstr$, 5)) 'use Left$() to avoid overflow
Else
FMCreationStructVar.LightStructVar.Light2Expansion = 50
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "auto redraw enabled")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.AutoRedrawEnabledFlag = STRINGTOBOOL(Tempstr$)
Else
FMCreationStructVar.AutoRedrawEnabledFlag = True
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "output dir")
If Rmod.RegGetKeyValueErrorFlag = False Then FMCreationStructVar.OutputDir = Tempstr$
If FMCreationStructVar.OutputDir = "" Then FMCreationStructVar.OutputDir = App.Path 'verify
If Not (Right$(FMCreationStructVar.OutputDir, 1) = "\") Then FMCreationStructVar.OutputDir = FMCreationStructVar.OutputDir + "\" 'verify
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "fm picture left")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FMPictureLeft = Val(Tempstr$)
Else
FMCreationStructVar.FMPictureLeft = (FMBorderFrame.Width / 4!) ‑ ((FMCreationStructVar.FrameXSize * Screen.TwipsPerPixelX) / 2!) 'do not use FMPicture.Width as not set yet
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(FMControlStructVar.RegMainKey, FMControlStructVar.RegRootKey, "fm picture top")
If Rmod.RegGetKeyValueErrorFlag = False Then
FMCreationStructVar.FMPictureTop = Val(Tempstr$)
Else
FMCreationStructVar.FMPictureTop = (FMBorderFrame.Height / 4!) ‑ ((FMCreationStructVar.FrameYSize * Screen.TwipsPerPixelY) / 2!) 'do not use FMPicture.Height as not set yet
End If
'
End Sub
'**************************************END OF REG***************************************
'***********************************GENERAL FUNCTIONS***********************************
Private Function GFCDGetFileName(ByVal Title As String, ByRef FilterNumber As Integer, ByRef FilterDescriptionArray() As String, ByRef FilterStringArray() As String, ByVal DefaultFilterIndex As Integer, ByVal DefaultPath As String) As String
'On Error Resume Next 'must be placed into a form (uses hWnd); FilterNumber may be 0 (then pass NULLARRAYSTRING()), DefaultPath should contain path and file name
Dim OPENFILENAMEVar As OPENFILENAME
Dim DefaultFileName As String
Dim DefaultDirectoryName As String
Dim Temp As Long
'
'NOTE: the FilerDescriptionArray() and the FilterStringArray() data
'must have the following format (example; description/string):
'
'Bitmap/*.bmp;*.jpg;*.gif
'
'If FilterNumber is 0, the preset filter 'All Files/*.*' is used.
'If the user pressed 'Cancel' the function returns nothing ("").
'
'initialize structure
OPENFILENAMEVar.lStructSize = Len(OPENFILENAMEVar)
OPENFILENAMEVar.hWndOwner = 0 'do not use form (module ?!) handle
OPENFILENAMEVar.hInstance = App.hInstance
If Not (FilterNumber = 0) Then
'
'NOTE: the filter string contains string pairs (filter description/string),
'the string end is marked by two null chars.
'
For Temp = 1 To FilterNumber
OPENFILENAMEVar.lpstrFilter = OPENFILENAMEVar.lpstrFilter + _
FilterDescriptionArray(Temp) + Chr$(0) + FilterStringArray(Temp) + Chr$(0)
Next Temp
OPENFILENAMEVar.lpstrFilter = OPENFILENAMEVar.lpstrFilter + Chr$(0) 'two null chars at filter string end
Else
OPENFILENAMEVar.lpstrFilter = "All Files" + Chr$(0) + "*.*" + Chr$(0) + Chr$(0)
End If
OPENFILENAMEVar.nFilterIndex = DefaultFilterIndex
If Not (GetFileName(DefaultPath) = "") Then
DefaultFileName = GetFileName(DefaultPath)
OPENFILENAMEVar.nMaxFile = 260 + 1 'MAX_PATH
OPENFILENAMEVar.lpstrFile = String$(260 + 1, Chr$(0))
Mid$(OPENFILENAMEVar.lpstrFile, 1, Len(DefaultFileName)) = Left$(DefaultFileName, 260)
Else
OPENFILENAMEVar.nMaxFile = 260 + 1 'MAX_PATH
OPENFILENAMEVar.lpstrFile = String$(260 + 1, Chr$(0))
End If
OPENFILENAMEVar.lpstrTitle = Title + Chr$(0)
DefaultDirectoryName = Left$(DefaultPath, Len(DefaultPath) ‑ Len(DefaultFileName))
OPENFILENAMEVar.lpstrInitialDir = DefaultDirectoryName + Chr$(0)
OPENFILENAMEVar.nMaxFileTitle = 260 + 1 'MAX_PATH
OPENFILENAMEVar.lpstrFileTitle = String$(260 + 1, Chr$(0)) 'receives selected file name (without directory)
OPENFILENAMEVar.Flags = OFN_HIDEREADONLY
'end of initializing structure
If Not (GetOpenFileName(OPENFILENAMEVar) = 0) Then
If Not (InStr(1, OPENFILENAMEVar.lpstrFile, Chr$(0), vbBinaryCompare) = 0) Then 'verify
GFCDGetFileName = Left$(OPENFILENAMEVar.lpstrFile, InStr(1, OPENFILENAMEVar.lpstrFile, Chr$(0), vbBinaryCompare) ‑ 1)
Else
GFCDGetFileName = OPENFILENAMEVar.lpstrFile
End If
Else
GFCDGetFileName = "" 'reset (error)
End If
End Function
Private Function GFCDSetFileName(ByVal Title As String, ByRef FilterNumber As Integer, ByRef FilterDescriptionArray() As String, ByRef FilterStringArray() As String, ByVal DefaultFilterIndex As Integer, ByVal DefaultPath As String) As String
'On Error Resume Next 'must be placed into a form (uses hWnd); FilterNumber may be 0 (then pass NULLARRAYSTRING()), DefaultPath should contain path and file name
Dim OPENFILENAMEVar As OPENFILENAME
Dim DefaultFileName As String
Dim DefaultDirectoryName As String
Dim Temp As Long
'
'NOTE: the FilerDescriptionArray() and the FilterStringArray() data
'must have the following format (example; description/string):
'
'Bitmap/*.bmp;*.jpg;*.gif
'
'If FilterNumber is 0, the preset filter 'All Files/*.*' is used.
'If the user pressed 'Cancel' the function returns nothing ("").
'
'initialize structure
OPENFILENAMEVar.lStructSize = Len(OPENFILENAMEVar)
OPENFILENAMEVar.hWndOwner = 0 'do not use form (module ?!) handle
OPENFILENAMEVar.hInstance = App.hInstance
If Not (FilterNumber = 0) Then
'
'NOTE: the filter string contains string pairs (filter description/string),
'the string end is marked by two null chars.
'
For Temp = 1 To FilterNumber
OPENFILENAMEVar.lpstrFilter = OPENFILENAMEVar.lpstrFilter + _
FilterDescriptionArray(Temp) + Chr$(0) + FilterStringArray(Temp) + Chr$(0)
Next Temp
OPENFILENAMEVar.lpstrFilter = OPENFILENAMEVar.lpstrFilter + Chr$(0) 'two null chars at filter string end
Else
OPENFILENAMEVar.lpstrFilter = "All Files" + Chr$(0) + "*.*" + Chr$(0) + Chr$(0)
End If
OPENFILENAMEVar.nFilterIndex = DefaultFilterIndex
If Not (GetFileName(DefaultPath) = "") Then
DefaultFileName = GetFileName(DefaultPath)
OPENFILENAMEVar.nMaxFile = 260 + 1 'MAX_PATH
OPENFILENAMEVar.lpstrFile = String$(260 + 1, Chr$(0))
Mid$(OPENFILENAMEVar.lpstrFile, 1, Len(DefaultFileName)) = Left$(DefaultFileName, 260)
Else
OPENFILENAMEVar.nMaxFile = 260 + 1 'MAX_PATH
OPENFILENAMEVar.lpstrFile = String$(260 + 1, Chr$(0))
End If
OPENFILENAMEVar.lpstrTitle = Title + Chr$(0)
DefaultDirectoryName = Left$(DefaultPath, Len(DefaultPath) ‑ Len(DefaultFileName))
OPENFILENAMEVar.lpstrInitialDir = DefaultDirectoryName + Chr$(0)
OPENFILENAMEVar.nMaxFileTitle = 260 + 1 'MAX_PATH
OPENFILENAMEVar.lpstrFileTitle = String$(260 + 1, Chr$(0)) 'receives selected file name (without directory)
OPENFILENAMEVar.Flags = OFN_HIDEREADONLY
'end of initializing structure
If Not (GetSaveFileName(OPENFILENAMEVar) = 0) Then
If Not (InStr(1, OPENFILENAMEVar.lpstrFile, Chr$(0), vbBinaryCompare) = 0) Then 'verify
GFCDSetFileName = Left$(OPENFILENAMEVar.lpstrFile, InStr(1, OPENFILENAMEVar.lpstrFile, Chr$(0), vbBinaryCompare) ‑ 1)
Else
GFCDSetFileName = OPENFILENAMEVar.lpstrFile
End If
Else
GFCDSetFileName = "" 'reset (error)
End If
End Function
Private Function GFCDGetColor(ByVal DefaultColor As Long, ByVal UserColorNumberPassed As Integer, ByRef UserColorArrayPassed() As Long) As Long
'On Error Resume Next 'v1.0 (no user color support); returns True if user aborted (always check if return value is True)
Dim CHOOSECOLORSTRUCTVar As CHOOSECOLORSTRUCT
Dim UserColorArray(1 To 16) As Long
Dim UserColorLoop As Integer
'
'NOTE: the ChooseColor function requires to be able to
'access an array of exactly 16 COLORREF (Long) variables, otherwise
'the program will crash.
'The passed array must not contain 16 values, this function
'will transfer the user color values of the passed user color array.
'
'preset
For UserColorLoop = 1 To UserColorNumberPassed
If UserColorLoop > 16 Then Exit For
UserColorArray(UserColorLoop) = UserColorArrayPassed(UserColorLoop)
Next UserColorLoop
'initialize structure
CHOOSECOLORSTRUCTVar.lStructSize = Len(CHOOSECOLORSTRUCTVar)
CHOOSECOLORSTRUCTVar.hWndOwner = 0 'do not use an owner window (module?)
CHOOSECOLORSTRUCTVar.hInstance = App.hInstance
CHOOSECOLORSTRUCTVar.rgbResult = DefaultColor
CHOOSECOLORSTRUCTVar.Flags = CC_RGBINIT
CHOOSECOLORSTRUCTVar.lpCustColors = VarPtr(UserColorArray(1))
CHOOSECOLORSTRUCTVar.lCustData = 0
CHOOSECOLORSTRUCTVar.lpfnHook = 0
CHOOSECOLORSTRUCTVar.lpTemplateName = Chr$(0)
'end of initializing structure
'begin
If Not (ChooseColor(CHOOSECOLORSTRUCTVar) = 0) Then 'verify
GFCDGetColor = CHOOSECOLORSTRUCTVar.rgbResult 'ok
Else
GFCDGetColor = True 'error
End If
End Function
Private Function GetFileName(ByVal GetFileNameName As String) As String
On Error Resume Next 'returns chars after last backslash or nothing
Dim GetFileNameLoop As Integer
GetFileName = "" 'reset
For GetFileNameLoop = Len(GetFileNameName) To 1 Step (‑1)
If Mid$(GetFileNameName, GetFileNameLoop, 1) = "\" Then
GetFileName = Right$(GetFileNameName, Len(GetFileNameName) ‑ GetFileNameLoop)
Exit For
End If
Next GetFileNameLoop
End Function
Private Function GetDirectoryName(ByVal GetDirectoryNameName As String) As String
'On Error Resume Next 'returns chars from string beginning to (including) last backslash or nothing
Dim GetDirectoryNameLoop As Integer
GetDirectoryName = "" 'reset
For GetDirectoryNameLoop = Len(GetDirectoryNameName) To 1 Step (‑1)
If Mid$(GetDirectoryNameName, GetDirectoryNameLoop, 1) = "\" Then
GetDirectoryName = Left$(GetDirectoryNameName, GetDirectoryNameLoop)
Exit For
End If
Next GetDirectoryNameLoop
End Function
'***CONVERSION FUNCTIONS***
Private Function STRINGTOBOOL(ByVal StringString As String) As Boolean
'On Error Resume Next
If UCase$(StringString) = "TRUE" Then
STRINGTOBOOL = True
Else
STRINGTOBOOL = False
End If
End Function
Private Function BOOLTOSTRING(ByVal BooleanFlag As Boolean) As String
'On Error Resume Next
If BooleanFlag = True Then
BOOLTOSTRING = "True"
Else
BOOLTOSTRING = "False"
End If
End Function
Private Function CHECKTOBOOL(ByVal CheckBoxValue As Integer) As Boolean
'On Error Resume Next
If CheckBoxValue = 1 Then
CHECKTOBOOL = True
Else
CHECKTOBOOL = False
End If
End Function
Private Function BOOLTOCHECK(ByVal BooleanFlag As Boolean) As Integer
'On Error Resume Next
If BooleanFlag = True Then
BOOLTOCHECK = 1
Else
BOOLTOCHECK = 0
End If
End Function
'***END OF CONVERSION FUNCTIONS***
Private Function MIN(ByVal Value1 As Long, ByVal Value2 As Long) As Long
'On Error Resume Next 'use for i.e. CopyMemory(a(1), ByVal b, MIN(UBound(a()), Len(b))
If Value1 < Value2 Then
MIN = Value1
Else
MIN = Value2
End If
End Function
Private Function MAX(ByVal Value1 As Long, ByVal Value2 As Long) As Long
'On Error Resume Next 'use in combination with ReDim()
If Value1 > Value2 Then
MAX = Value1
Else
MAX = Value2
End If
End Function
'*******************************END OF GENERAL FUNCTIONS********************************
Private Sub Form_Unload(Cancel As Integer)
'On Error Resume Next
Call FMToFrameCreationStruct(FrameCreationStructVar)
Call FMToReg(FrameCreationStructVar)
Call FM_Hide 'may re‑enable forms of the target project
End Sub
[END OF FILE]