GFSkinEngine/GFSkinEngine_SkinTransferfrm.frm
VERSION 5.00
Begin VB.Form GFSkinEngine_SkinTransferfrm
BorderStyle = 1 'Fest Einfach
Caption = "[...]"
ClientHeight = 7230
ClientLeft = 45
ClientTop = 330
ClientWidth = 6810
Icon = "GFSkinEngine_SkinTransferfrm.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7230
ScaleWidth = 6810
StartUpPosition = 3 'Windows‑Standard
Begin VB.CommandButton STAuthorRandomCommand
Caption = "Random!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5700
TabIndex = 3
Top = 480
Width = 1035
End
Begin VB.CommandButton STLocationRandomCommand
Caption = "Random!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5700
TabIndex = 5
Top = 900
Width = 1035
End
Begin VB.CommandButton STEditPasswordHintTextRandomCommand
Caption = "Random!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5700
TabIndex = 18
Top = 5640
Width = 1035
End
Begin VB.CommandButton STImportPasswordHintTextRandomCommand
Caption = "Random!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5700
TabIndex = 15
Top = 5280
Width = 1035
End
Begin VB.CheckBox STFileExSaveExCheck
Caption = "Allow saving separately"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1560
TabIndex = 22
ToolTipText = "if enabled then the user will be asked if the file is to be copied from the imported skin's directory over to a special directory"
Top = 6360
Value = 1 'Aktiviert
Width = 2055
End
Begin VB.CommandButton STFileExBrowseCommand
Caption = "Browse..."
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5700
TabIndex = 20
Top = 6000
Width = 1035
End
Begin VB.TextBox STFileExText
Height = 285
Left = 1560
MaxLength = 260
TabIndex = 19
Top = 6000
Width = 4035
End
Begin VB.TextBox STEditPasswordHintTextText
Height = 285
Left = 4020
MaxLength = 64
TabIndex = 17
Top = 5640
Width = 1575
End
Begin VB.TextBox STImportPasswordHintTextText
Height = 285
Left = 4020
MaxLength = 64
TabIndex = 14
Top = 5280
Width = 1575
End
Begin VB.TextBox STEditPasswordText
Height = 285
IMEMode = 3 'DISABLE
Left = 1560
MaxLength = 35
PasswordChar = "?"
TabIndex = 16
ToolTipText = $"GFSkinEngine_SkinTransferfrm.frx":000C
Top = 5640
Width = 1455
End
Begin VB.TextBox STImportPasswordText
Height = 285
IMEMode = 3 'DISABLE
Left = 1560
MaxLength = 35
PasswordChar = "?"
TabIndex = 13
ToolTipText = $"GFSkinEngine_SkinTransferfrm.frx":00D5
Top = 5280
Width = 1455
End
Begin VB.CommandButton STFileExSaveExCommand
Caption = "Save As..."
Height = 315
Left = 5700
TabIndex = 21
ToolTipText = "click to copy the additional file (if any) from the current skin's directory over to a special directory"
Top = 6000
Width = 1035
End
Begin VB.TextBox STMottoText
Height = 285
Left = 2520
MaxLength = 64
TabIndex = 6
Top = 1260
Width = 3075
End
Begin VB.TextBox STCurrentLocationText
Height = 285
Left = 2520
MaxLength = 64
TabIndex = 4
Top = 900
Width = 3075
End
Begin VB.TextBox STDateText
Height = 285
Left = 4500
MaxLength = 64
TabIndex = 8
Top = 1740
Width = 2235
End
Begin VB.TextBox STAuthorText
Height = 285
Left = 1740
MaxLength = 64
TabIndex = 2
Top = 480
Width = 3855
End
Begin VB.CommandButton STCommentRandomCommand
Caption = "Random!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2520
TabIndex = 12
Top = 3480
Width = 1035
End
Begin VB.CommandButton STDedicatedRandomCommand
Caption = "Random!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2520
TabIndex = 10
Top = 1740
Width = 1035
End
Begin VB.TextBox STCommentText
Height = 1275
Left = 60
MaxLength = 10240
MultiLine = ‑1 'True
ScrollBars = 3 'Beides
TabIndex = 11
Top = 3840
Width = 6675
End
Begin VB.TextBox STDedicatedText
Height = 1275
Left = 60
MaxLength = 10240
MultiLine = ‑1 'True
ScrollBars = 3 'Beides
TabIndex = 9
Top = 2100
Width = 6675
End
Begin VB.CommandButton STSkinNameRandomCommand
Caption = "Random!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5700
TabIndex = 1
Top = 120
Width = 1035
End
Begin VB.CommandButton STOkCommand
Caption = "Ok"
Height = 375
Left = 5400
TabIndex = 24
ToolTipText = "Ok"
Top = 6780
Width = 1335
End
Begin VB.CommandButton STCancelCommand
Caption = "Abort"
Height = 375
Left = 3960
TabIndex = 25
ToolTipText = "Abort"
Top = 6780
Width = 1335
End
Begin VB.CommandButton STExportCommand
Caption = "Export My Skin"
Height = 375
Left = 5400
TabIndex = 23
ToolTipText = "Export"
Top = 6780
Width = 1335
End
Begin VB.TextBox STSkinNameText
Height = 285
Left = 1740
MaxLength = 64
TabIndex = 0
Top = 120
Width = 3855
End
Begin VB.CommandButton STMottoRandomCommand
Caption = "Random!"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5700
TabIndex = 7
Top = 1260
Width = 1035
End
Begin VB.Label STInfoLabel
Caption = "[...]"
Height = 435
Left = 60
TabIndex = 38
Top = 6720
Width = 3795
End
Begin VB.Image STImportImage
Height = 240
Left = 240
Picture = "GFSkinEngine_SkinTransferfrm.frx":0167
Top = 0
Visible = 0 'False
Width = 240
End
Begin VB.Image STExportImage
Height = 240
Left = 0
Picture = "GFSkinEngine_SkinTransferfrm.frx":05A9
Top = 0
Visible = 0 'False
Width = 240
End
Begin VB.Line Line6
BorderColor = &H80000015&
X1 = 60
X2 = 6720
Y1 = 6600
Y2 = 6600
End
Begin VB.Line Line5
BorderColor = &H80000016&
X1 = 75
X2 = 6750
Y1 = 6615
Y2 = 6615
End
Begin VB.Label STFileExLabel
Alignment = 2 'Zentriert
Caption = "Additional File:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 60
TabIndex = 37
Top = 6060
Width = 1455
End
Begin VB.Label STEditPasswordHintTextLabel
Alignment = 2 'Zentriert
Caption = "Hint Text:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3120
TabIndex = 36
Top = 5700
Width = 855
End
Begin VB.Label STImportPasswordHintTextLabel
Alignment = 2 'Zentriert
Caption = "Hint Text:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3120
TabIndex = 34
Top = 5340
Width = 855
End
Begin VB.Label STEditPasswordLabel
Alignment = 2 'Zentriert
Caption = "Edit password:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 60
TabIndex = 35
Top = 5700
Width = 1455
End
Begin VB.Label STImportPasswordLabel
Alignment = 2 'Zentriert
Caption = "Import password:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 60
TabIndex = 33
Top = 5340
Width = 1515
End
Begin VB.Label STMottoLabel
Caption = "Motto/Theme of Skin:"
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 = 29
Top = 1320
Width = 2355
End
Begin VB.Label STCurrentLocationLabel
Caption = "Current Author's Location:"
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 = 28
Top = 960
Width = 2355
End
Begin VB.Label STDateLabel
Alignment = 2 'Zentriert
Caption = "Date:"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3840
TabIndex = 31
Top = 1800
Width = 555
End
Begin VB.Label STAuthorLabel
Caption = "Author:"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 27
Top = 540
Width = 1575
End
Begin VB.Label STCommentLabel
Alignment = 2 'Zentriert
Caption = "Additional comments:"
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 = 32
Top = 3540
Width = 2355
End
Begin VB.Label STDedicatedLabel
Alignment = 2 'Zentriert
Caption = "The Skin is dedicated to:"
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 = 30
Top = 1800
Width = 2355
End
Begin VB.Line Line2
BorderColor = &H80000016&
X1 = 75
X2 = 6750
Y1 = 5175
Y2 = 5175
End
Begin VB.Line Line1
BorderColor = &H80000015&
X1 = 75
X2 = 6735
Y1 = 5160
Y2 = 5160
End
Begin VB.Label STSkinNameLabel
Caption = "Skin Name:"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 26
Top = 180
Width = 1575
End
End
Attribute VB_Name = "GFSkinEngine_SkinTransferfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis (reviewed 2002). Part of the GFSkinEngine project.
'
'NOTE: if the user's resolution is 640x480 then the bottom commands
'will not be completely visible, therefore the ToolTipText should be
'set to the command's caption.
'
'NOTE: this form is displayed when the user wants to export his/her skin.
'Besides the original skin the user has also the option to transfer
'additional data with the SkinPacketFile.
'Officially this form requests information about the skin, and information
'about the user that is related to the creation of the skin.
'Unofficially the whole SkinTransfer is meant to be an 'interface' between
'people, thus the information to enter is mostly personal information
'about the creator.
'The SkinTransfer should work like a 'greeting card'.
'The user must be able to transfer a skin in a way so that it looks like
'he/she sends a greeting card to a friend.
'As a skin is to be sent per email it is compressed, and the user has
'the possibility to include an extra file (FileEx) as 'attachment'
'(like in an email).
'
'The user must have the following feelings during exporting a skin:
'‑presenting oneself in community
' (important: use words like 'my', 'great', etc., write 'My' capitalized)
'‑community
'‑open and friendly
'‑playing a funny game with other people (password hint)
'‑fooling other people (hint text, random)
'
'IMPORTANT: the form must not appear 'too clean' to avoid that people
'are discouraged from doing their own, not so great work.
'Instead it must just look 'funny'.
'
'To make this form 'funny', the random commands are used.
'Also it isn't too obvious they have a very important function.
'They should make the user happy to make him/her continue
'being interested in the skin export, and finally to make him/her
'export an own skin.
'Otherwise users who don't know what to do or who are without
'fantasy would not export their own skin.
'IMPORTANT: use only random texts that cause joyful associations.
'
'Programming notes:
'The prefix of the SkinTransfer sub system is 'ST'
'
'NOTE: the Installer must also install registry keys used by this form to
'display default data when the user opens this form the first time.
'
'NOTE: passwords are encrypted when stored in structures and when written
'to the SkinTransferFile. A password may only be unencrypted when being
'displayed in a text box.
'
'NOTE: the text length of all text boxes was limited at design time:
'‑standard text: 64 chars
'‑extended text: 10240 chars (allow long dedications, comments)
'‑file name text: 260 chars (MAX_PATH of Win98)
'
'ST_RequestExportData
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'GetLongString
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'other
'NOTE: use FileCopy() rather than CopyFile to save 'On Error Resume Next.
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
'STRandomStruct ‑ contains random text strings
Private Type STRandomStruct
AuthorArray(1 To 10) As String
AuthorPointer As Integer
LocationArray(1 To 10) As String
LocationPointer As Integer
MottoArray(1 To 10) As String
MottoPointer As Integer
DedicatedArray(1 To 10) As String
DedicatedPointer As Integer
CommentArray(1 To 10) As String
CommentPointer As Integer
ImportPasswordHintTextArray(1 To 10) As String
ImportPasswordHintTextPointer As Integer
EditPasswordHintTextArray(1 To 10) As String
EditPasswordHintTextPointer As Integer
End Type
Dim STRandomStructVar As STRandomStruct
'STFileExBrowseCommand_Click
Dim NULLARRAYSTRING(0 To 0) As String 'for use with GFCDGetFileName()
'ST_RequestExportData
Dim ST_RequestExportDataCalledFlag As Boolean
Dim ST_ShowInfoCalledFlag As Boolean
'other
Dim ContinueFlag As Boolean
Dim CancelFlag As Boolean
Private Sub Form_Load()
'on error resume next
Call DefineSTRandomStructVar
End Sub
Private Sub DefineSTRandomStructVar()
'on error resume next
Dim TextLoop As Integer
'begin
For TextLoop = 1 To 10
STRandomStructVar.AuthorArray(TextLoop) = SE_GetSystemText(200 + TextLoop)
Next TextLoop
Call DefineSTRandomStructVar_RandomArraySwap(STRandomStructVar.AuthorArray())
For TextLoop = 1 To 10
STRandomStructVar.LocationArray(TextLoop) = SE_GetSystemText(210 + TextLoop)
Next TextLoop
Call DefineSTRandomStructVar_RandomArraySwap(STRandomStructVar.LocationArray())
For TextLoop = 1 To 10
STRandomStructVar.MottoArray(TextLoop) = SE_GetSystemText(220 + TextLoop)
Next TextLoop
Call DefineSTRandomStructVar_RandomArraySwap(STRandomStructVar.MottoArray())
For TextLoop = 1 To 10
STRandomStructVar.DedicatedArray(TextLoop) = SE_GetSystemText(230 + TextLoop)
Next TextLoop
Call DefineSTRandomStructVar_RandomArraySwap(STRandomStructVar.DedicatedArray())
For TextLoop = 1 To 10
STRandomStructVar.CommentArray(TextLoop) = SE_GetSystemText(240 + TextLoop)
Next TextLoop
Call DefineSTRandomStructVar_RandomArraySwap(STRandomStructVar.CommentArray())
For TextLoop = 1 To 10
STRandomStructVar.ImportPasswordHintTextArray(TextLoop) = SE_GetSystemText(250 + TextLoop)
Next TextLoop
Call DefineSTRandomStructVar_RandomArraySwap(STRandomStructVar.ImportPasswordHintTextArray())
For TextLoop = 1 To 10
STRandomStructVar.EditPasswordHintTextArray(TextLoop) = SE_GetSystemText(260 + TextLoop)
Next TextLoop
Call DefineSTRandomStructVar_RandomArraySwap(STRandomStructVar.EditPasswordHintTextArray())
End Sub
Private Sub DefineSTRandomStructVar_RandomArraySwap(ByRef StringArray() As String)
'on error resume next 'swaps strings in StringArray() randomly
Dim StringArrayIndexMax As Long
Dim SwapIndex1 As Long
Dim SwapIndex2 As Long
Dim SwapLoop As Integer
Dim Tempstr$
'preset
Randomize Timer
StringArrayIndexMax = UBound(StringArray())
'begin
For SwapLoop = 1 To StringArrayIndexMax
SwapIndex1 = Int((StringArrayIndexMax ‑ 1 + 1) * Rnd(1) + 1)
SwapIndex2 = Int((StringArrayIndexMax ‑ 1 + 1) * Rnd(1) + 1)
Tempstr$ = StringArray(SwapIndex1)
StringArray(SwapIndex1) = StringArray(SwapIndex2)
StringArray(SwapIndex2) = Tempstr$
Next SwapLoop
End Sub
'************************************INTERFACE SUBS*************************************
'NOTE: GFSkinEngine_SkinTransferfrm can be used for two actions:
'‑requesting skin information from the user,
'‑displaying skin information to the user.
Public Function ST_RequestExportData(ByRef SkinName As String, ByRef ImportPassword As String, ByRef ImportPasswordHintText As String, ByRef UserEditPassword As String, ByRef UserEditPasswordHintText As String, ByRef SkinTransferFile As String, ByRef FileEx As String) As Boolean
'on error resume next 'returns True if user wants to export, False if he/she canceled
'
'NOTE: when this function is called, the SkinTransferfrm is shown and the user
'has the possibility to enter skin and author related data.
'When the user presses 'export', the SkinTransferFile is filled with the entered data.
'The SkinTransferFile is set by this sub, it has the following location:
'SESystemStructVar.SystemSkinDirectory + "SkinTransferFile.dat"
'The calling sub should then create the SkinPacketFile that includes all files of
'the current skin, the SkinTransferFile and (if set by the user) FileEx.
'The calling sub must not delete the SkinTransferFile when it has been packed,
'it should stay in the current skin's directory so that the user must not enter
'the skin information again if exporting the current skin once more.
'Put the SkinName into the created CompresionPackFile as the skin name
'will be the default final skin directory on the machine that imports the skin.
'
'verify
If (ST_RequestExportDataCalledFlag = True) Or (ST_ShowInfoCalledFlag = True) Then
SkinName = "" 'reset
ImportPassword = "" 'reset
ImportPasswordHintText = "" 'reset
SkinTransferFile = "" 'reset
FileEx = "" 'reset
ST_RequestExportData = False 'preset (error, user canceled)
Else
ST_RequestExportDataCalledFlag = True
End If
'preset
SkinTransferFile = SESystemStructVar.SystemSkinDirectory + "SkinTransferFile.dat"
'initialize controls
'
'NOTE: if there is already a SkinTransferFile existing in the current skin's
'directory then the data of this file is reloaded for editing.
'
If Not ((Dir$(SkinTransferFile) = "") Or (Right$(SkinTransferFile, 1) = "\") Or (SkinTransferFile = "")) Then 'verify
'a SkinTransferFile is existing in current skin's directory
If SkinTransferFile_Read(SkinTransferFile, SkinTransferStructVar) = False Then
'use any other default values
Call SkinTransferStructFromReg(SkinTransferStructVar)
End If
SkinTransferStructVar.SkinName = SkinName 'use passed default skin name
SkinTransferStructVar.Date = Date$ + " " + time$ 'special setting (always use current date)
SkinTransferStructVar.SkinTransferFile = SkinTransferFile 'internal use only
Call SkinTransferStruct_Write(SkinTransferStructVar)
Call ST_DisplayControlPalette(True)
Else
'no SkinTransferFile is existing in current skin's directory
Call SkinTransferStructFromReg(SkinTransferStructVar)
SkinTransferStructVar.SkinName = SkinName 'use passed default skin name
SkinTransferStructVar.Date = Date$ + " " + time$ 'special setting (always use current date)
SkinTransferStructVar.SkinTransferFile = "" 'reset
Call SkinTransferStruct_Write(SkinTransferStructVar)
Call ST_DisplayControlPalette(True)
End If
'show window
Me.Enabled = True
Me.Visible = True
Me.Refresh
Call SE_ForwardCallBackMessage(SECBMSG_SKINTRANSFERFRM_OPENED, "", "")
'begin
ReDo:
ContinueFlag = False 'reset
CancelFlag = False 'reset
Me.SetFocus
Do
Call Sleep(10) 'do not use the usual value of 100 as then text box editing is slow
DoEvents
Loop Until (ContinueFlag = True) Or (CancelFlag = True)
'create return values
If ContinueFlag = True Then
'transfer entered stuff to registry and create file
'NOTE: if the SkinTransferFile already exists it is overwritten.
If SkinTransferStruct_Read(SkinTransferStructVar, True) = False Then GoTo ReDo: 'returns False if the user entered an invalid FileEx
If SkinTransferFile_Write(SkinTransferFile, SkinTransferStructVar) = False Then GoTo ReDo: 'could return False if disk space is low
Call SkinTransferStructToReg(SkinTransferStructVar) 'save current data as default for next exporting
'create return values
SkinName = SkinTransferStructVar.SkinName
ImportPassword = SkinTransferStructVar.ImportPassword
ImportPasswordHintText = SkinTransferStructVar.ImportPasswordHintText
UserEditPassword = SkinTransferStructVar.EditPassword
UserEditPasswordHintText = SkinTransferStructVar.EditPasswordHintText
If Not ((DirSave(SkinTransferStructVar.FileEx) = "") Or (Right$(SkinTransferStructVar.FileEx, 1) = "\") Or (SkinTransferStructVar.FileEx = "")) Then 'verify
FileEx = SkinTransferStructVar.FileEx
End If
ST_RequestExportDataCalledFlag = False 'reset
ST_RequestExportData = True 'ok
End If
If CancelFlag = True Then 'see also top of sub
'save entered stuff in registry
Call SkinTransferStruct_Read(SkinTransferStructVar, False) 'do not verify entered data
Call SkinTransferStructToReg(SkinTransferStructVar) 'save current data as default for next exporting
'create return values
SkinName = "" 'reset
ImportPassword = "" 'reset
ImportPasswordHintText = "" 'reset
UserEditPassword = "" 'reset
UserEditPasswordHintText = "" 'reset
SkinTransferFile = "" 'reset
FileEx = "" 'reset
ST_RequestExportDataCalledFlag = False 'reset
ST_RequestExportData = False 'error (user canceled)
End If
'hide window
Me.Visible = False
Me.Enabled = False
Me.Refresh
Call SE_ForwardCallBackMessage(SECBMSG_SKINTRANSFERFRM_CLOSED, "", "")
End Function
Public Sub ST_ShowInfo(ByVal SkinTransferFile As String)
'on error resume next 'reads SkinTransferFile.dat in current skin's directory and displays contained information
'preset
If (Dir$(SkinTransferFile) = "") Or (Right$(SkinTransferFile, 1) = "\") Or (SkinTransferFile = "") Then
MsgBox "Sorry, no information available !" + Chr$(10) + Chr$(10) + "Only a skin that was imported or exported contains extended information.", vbOKOnly + vbInformation
Else
If (ST_RequestExportDataCalledFlag = True) Or (ST_ShowInfoCalledFlag = True) Then
Exit Sub
Else
ST_ShowInfoCalledFlag = True
End If
Call SkinTransferFile_Read(SkinTransferFile, SkinTransferStructVar)
Call SkinTransferStruct_Write(SkinTransferStructVar) 'display data
Call ST_DisplayControlPalette(False)
'show window
Me.Enabled = True
Me.Visible = True
Me.Refresh
Call SE_ForwardCallBackMessage(SECBMSG_SKINTRANSFERFRM_OPENED, "", "")
'begin
ReDo:
ContinueFlag = False 'reset
CancelFlag = False 'reset
Me.SetFocus
Do
Call Sleep(100)
DoEvents
Loop Until (ContinueFlag = True) Or (CancelFlag = True)
'hide window
Me.Visible = False
Me.Enabled = False
Me.Refresh
ST_ShowInfoCalledFlag = False 'reset
Call SE_ForwardCallBackMessage(SECBMSG_SKINTRANSFERFRM_CLOSED, "", "")
End If
End Sub
'*********************************END OF INTERFACE SUBS*********************************
'************************************CONTROL EVENTS*************************************
'NOTE: access control properties rather than SkinTransferStructVar data.
Private Sub STExportCommand_Click()
'on error resume next
ContinueFlag = True
End Sub
Private Sub STOkCommand_Click()
'on error resume next
ContinueFlag = True
End Sub
Private Sub STCancelCommand_Click()
'on error resume next
If MsgBox("Are you sure you want to abort exporting your skin ?", vbYesNo + vbQuestion) = vbYes Then
CancelFlag = True
End If
End Sub
Private Sub STFileExBrowseCommand_Click()
'on error resume next
Dim ProgramPath As String
Dim Tempstr$
'preset
ProgramPath = App.Path
If Not (Right$(ProgramPath, 1) = "\") Then ProgramPath = ProgramPath + "\" 'verify
'begin
Tempstr$ = GFCDGetFileName("Select Attached File", 0, NULLARRAYSTRING(), NULLARRAYSTRING(), 1, ProgramPath + GetFileName(SkinTransferStructVar.FileEx))
If Not (Tempstr$ = "") Then STFileExText.TEXT = Tempstr$
End Sub
Private Sub STFileExText_Change()
'on error resume next
If Len(STFileExText.TEXT) = 0 Then
STFileExSaveExCheck.Enabled = False
Else
STFileExSaveExCheck.Enabled = True
End If
End Sub
Private Sub STFileExSaveExCheck_Click()
'on error resume next
If STFileExSaveExCheck.Value = 1 Then
'NOTE: if the user clicks on 'save separately' then an open file dialog appears if no file has been chosen yet.
If Len(STFileExText.TEXT) = 0 Then
Call STFileExBrowseCommand_Click
If Len(STFileExText.TEXT) = 0 Then
STFileExSaveExCheck.Value = 0 'a stupid user did not select what is to be saved separately
End If
End If
End If
End Sub
Public Sub STFileExSaveEx()
'on error resume next 'called when importing a skin and a file ex is to be saved by the user
Call STFileExSaveExCommand_Click
End Sub
Private Sub STFileExSaveExCommand_Click()
'on error resume next
Dim InputName As String
Dim OutputName As String
Dim ProgramPath As String
'preset
ProgramPath = App.Path
If Not (Right$(ProgramPath, 1) = "\") Then ProgramPath = ProgramPath + "\" 'verify
'begin
If Not (STFileExText.TEXT = "") Then
InputName = STFileExText.TEXT 'SkinTransferStructVar.FileEx is the full path of the ORIGINAL file
OutputName = GFCDSetFileName("Set output file...", 0, NULLARRAYSTRING(), NULLARRAYSTRING(), 0, ProgramPath + GetFileName(STFileExText.TEXT))
If Not ((Right$(OutputName, 1) = "\") Or (OutputName = "")) Then 'verify
If CopyFile(InputName, OutputName, 0) = 0 Then
MsgBox "Copying file failed, please check disk space !", vbOKOnly + vbExclamation
Else
MsgBox "File was copied to '" + OutputName + "'.", vbOKOnly + vbInformation
End If
End If
End If
End Sub
'*********************************END OF CONTROL EVENTS*********************************
'**********************************ST CONTROL PALETTE***********************************
'NOTE: this form can be used either to request skin information from the user when
'exporting a skin or to display skin information after importing a skin.
'Both 'modes' use slightly different controls that are shown/hidden by the
'STControlPalete code.
Private Sub ST_DisplayControlPalette(ByVal RequestOrInfoPaletteFlag As Boolean)
'on error resume next
If RequestOrInfoPaletteFlag = True Then
SkinTransferStructVar.RequestOrInfoPaletteFlag = True
STSkinNameText.Locked = False
STAuthorText.Locked = False
STDedicatedText.Locked = False
STDateText.Locked = False
STCurrentLocationText.Locked = False
STMottoText.Locked = False
STCommentText.Locked = False
STImportPasswordText.Locked = False
STImportPasswordHintTextText.Locked = False
STEditPasswordText.Locked = False
STEditPasswordHintTextText.Locked = False
STFileExText.Locked = False
STFileExBrowseCommand.Visible = True
STFileExSaveExCheck.Enabled = True
STFileExSaveExCheck.Visible = True
STFileExSaveExCommand.Visible = False
STCancelCommand.Visible = True
STExportCommand.Visible = True
STOkCommand.Visible = False
STSkinNameRandomCommand.Enabled = True
STAuthorRandomCommand.Enabled = True
STLocationRandomCommand.Enabled = True
STMottoRandomCommand.Enabled = True
STDedicatedRandomCommand.Enabled = True
STCommentRandomCommand.Enabled = True
STImportPasswordHintTextRandomCommand.Enabled = True
STEditPasswordHintTextRandomCommand.Enabled = True
Me.Caption = "Skin Export"
Set Me.Icon = STExportImage.Picture
STInfoLabel.Caption = "Feel free to enter information about your skin, the random buttons provide some examples."
Else
SkinTransferStructVar.RequestOrInfoPaletteFlag = False
STSkinNameText.Locked = True
STAuthorText.Locked = True
STDedicatedText.Locked = True
STDateText.Locked = True
STCurrentLocationText.Locked = True
STMottoText.Locked = True
STCommentText.Locked = True
STImportPasswordText.Locked = True
STImportPasswordHintTextText.Locked = True
STEditPasswordText.Locked = True
STEditPasswordHintTextText.Locked = True
STFileExText.Locked = True
STFileExBrowseCommand.Visible = False
STFileExSaveExCheck.Visible = False
STFileExSaveExCheck.Enabled = False
STFileExSaveExCommand.Visible = True
STCancelCommand.Visible = False
STExportCommand.Visible = False
STOkCommand.Visible = True
STSkinNameRandomCommand.Enabled = False
STAuthorRandomCommand.Enabled = False
STLocationRandomCommand.Enabled = False
STMottoRandomCommand.Enabled = False
STDedicatedRandomCommand.Enabled = False
STCommentRandomCommand.Enabled = False
STImportPasswordHintTextRandomCommand.Enabled = False
STEditPasswordHintTextRandomCommand.Enabled = False
Me.Caption = "Skin Info"
Set Me.Icon = STImportImage.Picture
STInfoLabel.Caption = "You see information that the original creator of this skin entered."
End If
End Sub
'*******************************END OF ST CONTROL PALETTE*******************************
'***********************************ST FROMREG/TOREG************************************
'NOTE: with the following code it is possible to do these data exchanges:
'structure<‑>registry
'registry<‑>structure
'controls<‑>structure
'structure<‑>file
'(same technique as used in the Installer, see there for further information).
'Note that only the 'write‑subs' have a return value for error checking.
'Note that the SkinTransferFile code is located in the Skin Engine main module.
Private Sub SkinTransferStruct_Write(ByRef SkinTransferStructVar As SkinTransferStruct)
'on error resume next
STSkinNameText.TEXT = SkinTransferStructVar.SkinName
STAuthorText.TEXT = SkinTransferStructVar.Author
STDedicatedText.TEXT = SkinTransferStructVar.Dedicated
STDateText.TEXT = SkinTransferStructVar.Date
STCurrentLocationText.TEXT = SkinTransferStructVar.CurrentLocation
STMottoText.TEXT = SkinTransferStructVar.Motto
STCommentText.TEXT = SkinTransferStructVar.Comment
STEditPasswordText.TEXT = SE_CryptString(SkinTransferStructVar.EditPassword)
STEditPasswordHintTextText.TEXT = SkinTransferStructVar.EditPasswordHintText
STImportPasswordText.TEXT = SE_CryptString(SkinTransferStructVar.ImportPassword)
STImportPasswordHintTextText.TEXT = SkinTransferStructVar.ImportPasswordHintText
If Not (GetFileName(SkinTransferStructVar.FileEx) = "") Then 'verify (FileEx is the path to the original file (when importing))
STFileExText.TEXT = SESystemStructVar.SystemSkinDirectory + GetFileName(SkinTransferStructVar.FileEx)
Else
STFileExText.TEXT = ""
End If
STFileExSaveExCheck.Value = BOOLTOCHECK(SkinTransferStructVar.FileExSaveExFlag)
End Sub
Private Function SkinTransferStruct_Read(ByRef SkinTransferStructVar As SkinTransferStruct, ByVal VerifySkinTransferStructFlag As Boolean) As Boolean
'on error resume next 'control values to structure; returns False if any error occurred
Dim Temp As Long
Dim TempBoolean As Boolean
Dim Tempstr$
'verify
If VerifySkinTransferStructFlag = True Then 'set to False if data is to be saved in registry only
If Not (STFileExText.TEXT = "") Then 'user can leave this box blank
If (DirSave(STFileExText.TEXT) = "") Or (Right$(STFileExText.TEXT, 1) = "\") Then
MsgBox "Error: file '" + STFileExText.TEXT + "' not found, please check settings !", vbOKOnly + vbExclamation
SkinTransferStruct_Read = False 'error
Exit Function 'error
End If
End If
If Len(STSkinNameText.TEXT) < 3 Then
MsgBox "Please enter at least 3 chars as skin name !", vbOKOnly + vbExclamation
SkinTransferStruct_Read = False 'error
Exit Function 'error
End If
If UCase$(STSkinNameText.TEXT) = "BASESKIN" Then
MsgBox "The entered skin name is reserved, please use an other one !", vbOKOnly + vbExclamation
SkinTransferStruct_Read = False 'error
Exit Function 'error
End If
For Temp = 1 To Len(STSkinNameText.TEXT)
Select Case Mid$(STSkinNameText.TEXT, Temp, 1)
Case "<", ">", "|", "/", "\", ":", "?", "*", """"
MsgBox "Error: the skin name must not contain the following chars:" + Chr$(10) + "< > | / \ : "" * ? ", vbOKOnly + vbExclamation
SkinTransferStruct_Read = False 'error
Exit Function 'error
End Select
Next Temp
Select Case Len(STImportPasswordText.TEXT)
Case 1 To 3
MsgBox "A password must be at least 4 chars long !", vbOKOnly + vbExclamation
SkinTransferStruct_Read = False 'error
Exit Function 'error
End Select
Select Case Len(STEditPasswordText.TEXT)
Case 1 To 3
MsgBox "A password must be at least 4 chars long !", vbOKOnly + vbExclamation
SkinTransferStruct_Read = False 'error
Exit Function 'error
End Select
'check if all data was entered
If Len(STAuthorText.TEXT) = 0 Then GoTo Jump1:
If Len(STDedicatedText.TEXT) = 0 Then GoTo Jump1:
If Len(STDateText.TEXT) = 0 Then GoTo Jump1:
If Len(STCurrentLocationText.TEXT) = 0 Then GoTo Jump1:
If Len(STMottoText.TEXT) = 0 Then GoTo Jump1:
If Len(STCommentText.TEXT) = 0 Then GoTo Jump1:
GoTo Jump2:
Jump1:
MsgBox "Please fill all fields 'till (including) the comment !", vbOKOnly + vbExclamation
SkinTransferStruct_Read = False 'error
Exit Function 'error
Jump2:
ReDo1:
If Not (Len(STImportPasswordText.TEXT) = 0) Then
Tempstr$ = GFMsgBoxmod.GFInputBox("Please re‑enter import password:", "password confirmation", "", True, TempBoolean)
If TempBoolean = True Then 'user canceled
SkinTransferStruct_Read = False 'error
Exit Function 'error
End If
If Not (Tempstr$ = STImportPasswordText.TEXT) Then
If MsgBox("Wrong !" + Chr$(10) + "Do you want to retry confirming the password ?", vbYesNo + vbInformation) = vbYes Then
GoTo ReDo1:
Else
SkinTransferStruct_Read = False 'error
Exit Function 'error
End If
End If
End If
ReDo2:
If Not (Len(STEditPasswordText.TEXT) = 0) Then
Tempstr$ = GFMsgBoxmod.GFInputBox("Please re‑enter edit password:", "password confirmation", "", True)
If TempBoolean = True Then 'user canceled
SkinTransferStruct_Read = False 'error
Exit Function 'error
End If
If Not (Tempstr$ = STEditPasswordText.TEXT) Then
If MsgBox("Wrong !" + Chr$(10) + "Do you want to retry confirming the password ?", vbYesNo + vbInformation) = vbYes Then
GoTo ReDo2:
Else
SkinTransferStruct_Read = False 'error
Exit Function 'error
End If
End If
End If
End If
'begin
SkinTransferStructVar.SkinName = STSkinNameText.TEXT
SkinTransferStructVar.Author = STAuthorText.TEXT
SkinTransferStructVar.Dedicated = STDedicatedText.TEXT
SkinTransferStructVar.Date = STDateText.TEXT
SkinTransferStructVar.CurrentLocation = STCurrentLocationText.TEXT
SkinTransferStructVar.Motto = STMottoText.TEXT
SkinTransferStructVar.Comment = STCommentText.TEXT
SkinTransferStructVar.EditPassword = SE_CryptString(STEditPasswordText.TEXT)
SkinTransferStructVar.EditPasswordHintText = STEditPasswordHintTextText.TEXT
SkinTransferStructVar.ImportPassword = SE_CryptString(STImportPasswordText.TEXT)
SkinTransferStructVar.ImportPasswordHintText = STImportPasswordHintTextText.TEXT
SkinTransferStructVar.FileEx = STFileExText.TEXT
SkinTransferStructVar.FileExSaveExFlag = CHECKTOBOOL(STFileExSaveExCheck.Value)
SkinTransferStruct_Read = True 'ok
Exit Function
End Function
Private Sub SkinTransferStructToReg(ByRef SkinTransferStructVar As SkinTransferStruct)
'on error resume next
'reset
With SESystemStructVar
Call Rmod.RegDeleteSubKey(.RegMainKey, .RegRootKey + "SkinTransferStruct")
Call Rmod.RegCreateSubKey(.RegMainKey, .RegRootKey + "SkinTransferStruct")
'begin
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "skin name", CVar(SkinTransferStructVar.SkinName), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "author", CVar(SkinTransferStructVar.Author), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "dedicated", CVar(SkinTransferStructVar.Dedicated), REG_SZ)
'Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "date", CVar(SkinTransferStructVar.Date), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "current location", CVar(SkinTransferStructVar.CurrentLocation), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "motto", CVar(SkinTransferStructVar.Motto), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "comment", CVar(SkinTransferStructVar.Comment), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "edit password", CVar(SkinTransferStructVar.EditPassword), REG_SZ) 'already encrypted
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "edit password hint text", CVar(SkinTransferStructVar.EditPasswordHintText), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "import password", CVar(SkinTransferStructVar.ImportPassword), REG_SZ) 'already encrypted
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "import password hint text", CVar(SkinTransferStructVar.ImportPasswordHintText), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "file ex", CVar(SkinTransferStructVar.FileEx), REG_SZ)
Call Rmod.RegSetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "file ex save ex", CVar(BOOLTOSTRING(SkinTransferStructVar.FileExSaveExFlag)), REG_SZ)
End With
End Sub
Private Sub SkinTransferStructFromReg(ByRef SkinTransferStructVar As SkinTransferStruct)
'on error resume next
Dim Tempstr$
'
'NOTE: when this sub is called the first time on a machine where the registry
'values are not set, then use default values to avoid that the user does
'not know what to do.
'
'begin
With SESystemStructVar
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "skin name")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.SkinName = Tempstr$
Else
SkinTransferStructVar.SkinName = "" 'set anyway by calling sub
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "author")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.Author = Tempstr$
Else
Call STAuthorRandomCommand_Click
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "dedicated")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.Dedicated = Tempstr$
Else
Call STDedicatedRandomCommand_Click
End If
'
'Rmod.RegGetKeyValueErrorFlag = False 'reset
'Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "date")
'If Rmod.RegGetKeyValueErrorFlag = False Then SkinTransferStructVar.Date = Tempstr$
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "current location")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.CurrentLocation = Tempstr$
Else
Call STLocationRandomCommand_Click
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "motto")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.Motto = Tempstr$
Else
Call STMottoRandomCommand_Click
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "comment")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.Comment = Tempstr$
Else
Call STCommentRandomCommand_Click
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "import password")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.ImportPassword = Tempstr$ 'already encrypted
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "import password hint text")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.ImportPasswordHintText = Tempstr$
Else
Call STImportPasswordHintTextRandomCommand_Click
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "edit password")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.EditPassword = Tempstr$ 'already encrypted
End If
'
Rmod.RegGetKeyValueErrorFlag = False 'reset
Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "edit password hint text")
If Rmod.RegGetKeyValueErrorFlag = False Then
SkinTransferStructVar.EditPasswordHintText = Tempstr$
Else
Call STEditPasswordHintTextRandomCommand_Click
End If
'
'NOTE: the file ex stuff is not recovered as too confusing for the user when suddenly any file names appear.
'Rmod.RegGetKeyValueErrorFlag = False 'reset
'Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "file ex")
'If Rmod.RegGetKeyValueErrorFlag = False Then SkinTransferStructVar.FileEx = Tempstr$
'
'Rmod.RegGetKeyValueErrorFlag = False 'reset
'Tempstr$ = Rmod.RegGetKeyValue(.RegMainKey, .RegRootKey + "SkinTransferStruct", "file ex save ex")
'If Rmod.RegGetKeyValueErrorFlag = False Then SkinTransferStructVar.FileExSaveExFlag = STRINGTOBOOL(Tempstr$)
'
End With
End Sub
'********************************END OF ST FROMREG/TOREG********************************
'***************************************ST RANDOM***************************************
'NOTE: the default standard‑user is afraid of many empty text boxes that must be filled (tested).
'Therefore the STRandom commands were created to give the user examples what could
'be written into the text boxes.
Private Sub STSkinNameRandomCommand_Click()
'on error resume next
Dim Tempstr$
Dim Temp As Long
'begin
For Temp = 1 To 8
Tempstr$ = Tempstr$ + Chr$(Int((122 ‑ 97 + 1) * Rnd(1) + 97))
Next Temp
STSkinNameText.TEXT = Tempstr$
End Sub
Private Sub STAuthorRandomCommand_Click()
'on error resume next
STRandomStructVar.AuthorPointer = STRandomStructVar.AuthorPointer + 1
If STRandomStructVar.AuthorPointer > UBound(STRandomStructVar.AuthorArray()) Then STRandomStructVar.AuthorPointer = 1
STAuthorText.TEXT = STRandomStructVar.AuthorArray(STRandomStructVar.AuthorPointer)
End Sub
Private Sub STLocationRandomCommand_Click()
'on error resume next
STRandomStructVar.LocationPointer = STRandomStructVar.LocationPointer + 1
If STRandomStructVar.LocationPointer > UBound(STRandomStructVar.LocationArray()) Then STRandomStructVar.LocationPointer = 1
STCurrentLocationText.TEXT = STRandomStructVar.LocationArray(STRandomStructVar.LocationPointer)
End Sub
Private Sub STMottoRandomCommand_Click()
'on error resume next
STRandomStructVar.MottoPointer = STRandomStructVar.MottoPointer + 1
If STRandomStructVar.MottoPointer > UBound(STRandomStructVar.MottoArray()) Then STRandomStructVar.MottoPointer = 1
STMottoText.TEXT = STRandomStructVar.MottoArray(STRandomStructVar.MottoPointer)
End Sub
Private Sub STDedicatedRandomCommand_Click()
'on error resume next
STRandomStructVar.DedicatedPointer = STRandomStructVar.DedicatedPointer + 1
If STRandomStructVar.DedicatedPointer > UBound(STRandomStructVar.DedicatedArray()) Then STRandomStructVar.DedicatedPointer = 1
STDedicatedText.TEXT = STRandomStructVar.DedicatedArray(STRandomStructVar.DedicatedPointer)
End Sub
Private Sub STCommentRandomCommand_Click()
'on error resume next
STRandomStructVar.CommentPointer = STRandomStructVar.CommentPointer + 1
If STRandomStructVar.CommentPointer > UBound(STRandomStructVar.CommentArray()) Then STRandomStructVar.CommentPointer = 1
STCommentText.TEXT = STRandomStructVar.CommentArray(STRandomStructVar.CommentPointer)
End Sub
Private Sub STImportPasswordHintTextRandomCommand_Click()
'on error resume next
STRandomStructVar.ImportPasswordHintTextPointer = STRandomStructVar.ImportPasswordHintTextPointer + 1
If STRandomStructVar.ImportPasswordHintTextPointer > UBound(STRandomStructVar.ImportPasswordHintTextArray()) Then STRandomStructVar.ImportPasswordHintTextPointer = 1
STImportPasswordHintTextText.TEXT = STRandomStructVar.ImportPasswordHintTextArray(STRandomStructVar.ImportPasswordHintTextPointer)
End Sub
Private Sub STEditPasswordHintTextRandomCommand_Click()
'on error resume next
STRandomStructVar.EditPasswordHintTextPointer = STRandomStructVar.EditPasswordHintTextPointer + 1
If STRandomStructVar.EditPasswordHintTextPointer > UBound(STRandomStructVar.EditPasswordHintTextArray()) Then STRandomStructVar.EditPasswordHintTextPointer = 1
STEditPasswordHintTextText.TEXT = STRandomStructVar.EditPasswordHintTextArray(STRandomStructVar.EditPasswordHintTextPointer)
End Sub
'***********************************END OF ST RANDOM************************************
'***********************************GENERAL FUNCTIONS***********************************
Private Function GetFileName(ByVal GetFileNameName As String) As String 'also used by Hmod.KeyHook_Open()
'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
'NOTE: we use DirSave() to verify the existence of SaveExFileEx.
Private Function DirSave(ByRef PathName As String, Optional ByVal Attributes As Integer = vbNormal) As String
On Error GoTo Error: 'important
'
'NOTE: DirSave() raises an error if PathName represents a cdrom drive
'and the cd is not inserted (damn VB!). Use this function rather than DirSave().
'
DirSave = Dir$(PathName, Attributes) 'ok
Exit Function
Error:
DirSave = "" 'error
Exit Function
End Function
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 BOOLTOCHECK(ByVal BooleanFlag As Boolean) As Integer
'on error resume next
If BooleanFlag = True Then
BOOLTOCHECK = 1
Else
BOOLTOCHECK = 0
End If
End Function
Private Function CHECKTOBOOL(ByVal CheckValue As Integer) As Boolean
'on error resume next
If CheckValue = 1 Then
CHECKTOBOOL = True
Else
CHECKTOBOOL = False
End If
End Function
Private Sub Form_Unload(Cancel As Integer)
'on error resume next
'NOTE: the code should not call this sub, use [Cancel/Continue]Flag instead.
If SkinTransferStructVar.RequestOrInfoPaletteFlag = True Then
If (Me.Enabled = True) And (Me.Visible = True) Then 'don't show message when unloading this form by an other one
If MsgBox("Are you sure you want to abort exporting your skin ?", vbYesNo + vbQuestion) = vbNo Then
Cancel = True 'do not unload form
Else
'Cancel = True 'do not unload form 'no! unload to save memory
CancelFlag = True
End If
Else
'Cancel = True 'do not unload form 'no! unload to save memory
CancelFlag = True
End If
Else
'Cancel = True 'do not unload form 'no! unload to save memory
ContinueFlag = True
End If
End Sub
[END OF FILE]