├── .gitattributes ├── .gitignore ├── README.md ├── Vector06CBasic.vbp ├── font ├── Vector06C.fcp └── Vector06C.ttf ├── release ├── Vector06CBasic.exe └── config.ini ├── resources ├── BASIC_KEYWORDS.bin ├── KOI72UNICODE.bin ├── UNICODE2KOI7.bin ├── compile.bat ├── icon.ico ├── manifest.xml ├── resources.RES └── resources.rc ├── sources ├── classes │ ├── CBasicParser.cls │ ├── CCASFile.cls │ ├── CParserTree.cls │ └── CTextFile.cls ├── controls │ └── ctlTextBoxW.ctl ├── forms │ ├── frmAbout.frm │ ├── frmAbout.frx │ ├── frmInsertSymbol.frm │ ├── frmInsertSymbol.frx │ ├── frmMain.frm │ ├── frmMain.frx │ ├── frmSettings.frm │ └── frmSettings.frx ├── modules │ ├── modMain.bas │ ├── modSubclass.bas │ └── modWinApi.bas └── tables │ ├── BASIC_KEYWORDS.asm │ ├── KOI72UNICODE.asm │ ├── UNICODE2KOI7.asm │ └── compile.bat └── typelib ├── Vec06BAsConv.idl ├── Vec06BAsConv.tlb ├── advapi32.inc ├── comctl32.inc ├── comdlg32.inc ├── compile.bat ├── edit_ctl.inc ├── gdi32.inc ├── kernel32.inc ├── msvbvm60.inc ├── oleaut32.inc ├── shlwapi.inc ├── subclass.inc └── user32.inc /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | * text eol=crlf 4 | 5 | *.bin binary 6 | *.tlb binary 7 | *.DCA binary 8 | *.dsx binary 9 | *.png binary 10 | *.Png binary 11 | *.exe binary 12 | *.dll binary 13 | *.frx binary 14 | *.exp binary 15 | *.lib binary 16 | *.pdb binary 17 | *.RES binary 18 | *.obj binary 19 | *.suo binary 20 | *.ttf binary 21 | *.vcxproj.filters binary -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *.vbw 3 | *.pdb 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Vector06C-Basic-Converter 2 | Convert between CAS/BAS/TXT Vector-06C BASIC files 3 | 4 | -------------------------------------------------------------------------------- /Vector06CBasic.vbp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/Vector06CBasic.vbp -------------------------------------------------------------------------------- /font/Vector06C.fcp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/font/Vector06C.fcp -------------------------------------------------------------------------------- /font/Vector06C.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/font/Vector06C.ttf -------------------------------------------------------------------------------- /release/Vector06CBasic.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/release/Vector06CBasic.exe -------------------------------------------------------------------------------- /release/config.ini: -------------------------------------------------------------------------------- 1 | [Appearance] 2 | Theme=Dark 3 | FontSize=Small 4 | -------------------------------------------------------------------------------- /resources/BASIC_KEYWORDS.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/resources/BASIC_KEYWORDS.bin -------------------------------------------------------------------------------- /resources/KOI72UNICODE.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/resources/KOI72UNICODE.bin -------------------------------------------------------------------------------- /resources/UNICODE2KOI7.bin: -------------------------------------------------------------------------------- 1 |  2 |  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ ABCDEFGHIJKLMNOPQRSTUVWXYZ  $    abwgdevzijklmnoprstufhc~{}xyx|`qabwgdevzijklmnoprstufhc~{}xyx|`q                                       -------------------------------------------------------------------------------- /resources/compile.bat: -------------------------------------------------------------------------------- 1 | "C:\Program Files (x86)\Microsoft Visual Studio\Common\MSDev98\Bin\RC.EXE" /v /r /fo resources.RES resources.RC 2 | pause -------------------------------------------------------------------------------- /resources/icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/resources/icon.ico -------------------------------------------------------------------------------- /resources/manifest.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /resources/resources.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/resources/resources.RES -------------------------------------------------------------------------------- /resources/resources.rc: -------------------------------------------------------------------------------- 1 | 1 24 manifest.xml 2 | 100 FONT "..\\font\\Vector06C.ttf" 3 | 100 RCDATA BASIC_KEYWORDS.bin 4 | 101 RCDATA KOI72UNICODE.bin 5 | 102 RCDATA UNICODE2KOI7.bin -------------------------------------------------------------------------------- /sources/classes/CBasicParser.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "CBasicParser" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | ' // 15 | ' // CBasicParser.cls - this class allow to convert between Vector-06C BASIC source and tokens 16 | ' // By The trick 2021 17 | ' // 18 | 19 | Option Explicit 20 | Option Base 0 21 | 22 | Private Const MODULE_NAME = "CBasicParser" 23 | 24 | Private Type tSourceLine 25 | lNextAddr As Long 26 | lLineNumber As Long 27 | lTokens As Long 28 | bTokens() As Byte 29 | End Type 30 | 31 | Private m_cParser As CParserTree 32 | 33 | ' // Convert tokenized basic data to source code 34 | Public Function ConvertBasicDataToString( _ 35 | ByRef bData() As Byte) As String 36 | Const PROC_NAME = "ConvertBasicDataToString", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 37 | 38 | Dim lIndex As Long 39 | Dim lNextAddr As Long 40 | Dim lMode As Long 41 | Dim lLine As Long 42 | Dim sRet As String 43 | Dim lSize As Long 44 | 45 | lSize = SACount(ArrPtr(bData)) 46 | 47 | lMode = 0 ' // Line number 48 | 49 | Do 50 | 51 | Select Case lMode 52 | Case 0 ' // Next line address low 53 | lNextAddr = bData(lIndex) 54 | lMode = 1 55 | Case 1 ' // Next line address high 56 | 57 | lNextAddr = (bData(lIndex) * &H100&) Or lNextAddr 58 | 59 | If lNextAddr = 0 Then Exit Do 60 | 61 | lMode = 2 62 | Case 2 ' // Line number parsing low 63 | lLine = bData(lIndex) 64 | lMode = 3 65 | Case 3 ' // Line number parsing high 66 | 67 | lLine = (bData(lIndex) * &H100&) Or lLine 68 | lMode = 4 69 | sRet = sRet & CStr(lLine) & " " 70 | 71 | Case Else ' // Tokens 72 | 73 | Select Case bData(lIndex) 74 | Case 0 75 | sRet = sRet & vbNewLine 76 | lMode = 0 77 | Case Is <= 228 78 | sRet = sRet & Vec6BasicKeyword(bData(lIndex)) 79 | Case Else 80 | sRet = sRet & Chr$(bData(lIndex)) 81 | End Select 82 | 83 | End Select 84 | 85 | lIndex = lIndex + 1 86 | 87 | Loop While lIndex < lSize 88 | 89 | ConvertBasicDataToString = sRet 90 | 91 | End Function 92 | 93 | ' // Convert source code to tokenized basic data 94 | Public Sub ConvertSourceToBasicData( _ 95 | ByRef sSource As String, _ 96 | ByRef bOut() As Byte) 97 | Const PROC_NAME = "ConvertSourceToBasicData", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 98 | 99 | Dim bSource() As Byte 100 | Dim tLines() As tSourceLine 101 | Dim lLines As Long 102 | Dim lChrIndex As Long 103 | Dim lOutSize As Long 104 | Dim lIndex As Long 105 | Dim lLineIndex As Long 106 | Dim lAddress As Long 107 | 108 | If Len(sSource) = 0 Then 109 | Erase bOut 110 | Exit Sub 111 | End If 112 | 113 | bSource = UnicodeToVec6KOI7(sSource) 114 | lAddress = &H4301 ' // Start basic program address 115 | 116 | Do While lChrIndex <= UBound(bSource) 117 | 118 | If lLines Then 119 | If lLines > UBound(tLines) Then 120 | ReDim Preserve tLines(lLines * 2 - 1) 121 | End If 122 | Else 123 | ReDim tLines(49) 124 | End If 125 | 126 | lChrIndex = ParseLine(bSource(), lChrIndex, tLines(lLines)) 127 | 128 | lAddress = lAddress + tLines(lLines).lTokens + 4 129 | 130 | tLines(lLines).lNextAddr = lAddress 131 | 132 | lOutSize = lOutSize + tLines(lLines).lTokens 133 | lLines = lLines + 1 134 | 135 | Loop 136 | 137 | lOutSize = lOutSize + lLines * 4 138 | 139 | If lOutSize > 0 Then 140 | ReDim bOut(lOutSize - 1) 141 | Else 142 | Erase bOut 143 | End If 144 | 145 | For lLineIndex = 0 To lLines - 1 146 | 147 | With tLines(lLineIndex) 148 | 149 | GetMem2 .lNextAddr, bOut(lIndex) 150 | lIndex = lIndex + 2 151 | 152 | GetMem2 .lLineNumber, bOut(lIndex) 153 | lIndex = lIndex + 2 154 | 155 | memcpy bOut(lIndex), .bTokens(0), .lTokens 156 | lIndex = lIndex + .lTokens 157 | 158 | End With 159 | 160 | Next 161 | 162 | End Sub 163 | 164 | ' // Parse a text line 165 | Private Function ParseLine( _ 166 | ByRef bData() As Byte, _ 167 | ByVal lIndex As Long, _ 168 | ByRef tOut As tSourceLine) As Long 169 | Const PROC_NAME = "ParseLine", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 170 | 171 | Dim eTokens() As Byte 172 | Dim lTokenIndex As Long 173 | Dim lCount As Long 174 | Dim bDone As Boolean 175 | Dim bChar As Byte 176 | 177 | tOut.lLineNumber = 0 178 | tOut.lTokens = 0 179 | 180 | Do While lIndex <= UBound(bData) 181 | 182 | Select Case bData(lIndex) 183 | Case &H30 To &H39 184 | 185 | tOut.lLineNumber = tOut.lLineNumber * 10 + bData(lIndex) - &H30 186 | 187 | If tOut.lLineNumber > 65535 Then 188 | Err.Raise 5, FULL_PROC_NAME, "Error line number" 189 | End If 190 | 191 | Case Else 192 | 193 | If lIndex = 0 Then 194 | Err.Raise 5, FULL_PROC_NAME, "Line number not found" 195 | End If 196 | 197 | Exit Do 198 | 199 | End Select 200 | 201 | lIndex = lIndex + 1 202 | 203 | Loop 204 | 205 | m_cParser.Reset 206 | 207 | ' // Skip spaces 208 | Do While lIndex <= UBound(bData) 209 | 210 | If bData(lIndex) <> 32 Then 211 | Exit Do 212 | End If 213 | 214 | lIndex = lIndex + 1 215 | 216 | Loop 217 | 218 | 'Debug.Assert tOut.lLineNumber <> 480 219 | 220 | Do Until bDone 221 | 222 | If lIndex > UBound(bData) Then 223 | If m_cParser.Complete Then 224 | Exit Do 225 | Else 226 | If lIndex = UBound(bData) + 1 Then 227 | bChar = 13 228 | Else 229 | bChar = 10 230 | End If 231 | End If 232 | Else 233 | bChar = bData(lIndex) 234 | End If 235 | 236 | eTokens = m_cParser.PutSymbol(bChar) 237 | 238 | lCount = SACount(ArrPtr(eTokens)) 239 | 240 | If lCount > 0 Then 241 | 242 | If tOut.lTokens Then 243 | If tOut.lTokens + lCount > UBound(tOut.bTokens) Then 244 | ReDim Preserve tOut.bTokens(tOut.lTokens * 2 + lCount - 1) 245 | End If 246 | Else 247 | ReDim tOut.bTokens(31) 248 | End If 249 | 250 | memcpy tOut.bTokens(tOut.lTokens), eTokens(0), lCount 251 | tOut.lTokens = tOut.lTokens + lCount 252 | 253 | If eTokens(0) = TT_NEWLINE Then 254 | lIndex = lIndex + 1 255 | Exit Do 256 | End If 257 | 258 | End If 259 | 260 | lIndex = lIndex + 1 261 | 262 | Loop 263 | 264 | ParseLine = lIndex 265 | 266 | End Function 267 | 268 | Private Sub Class_Initialize() 269 | Set m_cParser = New CParserTree 270 | End Sub 271 | -------------------------------------------------------------------------------- /sources/classes/CCASFile.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "CCASFile" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | ' // 15 | ' // CCASFile.cls - this class manages file and converts between CAS/BAS/TXT 16 | ' // By The trick 2021 17 | ' // 18 | 19 | Option Explicit 20 | Option Base 0 21 | 22 | Implements CBasicParser 23 | 24 | Private Const MODULE_NAME = "CCASFile" 25 | 26 | Private m_sFileName As String 27 | Private m_sSource As String 28 | Private m_sProgramName As String 29 | Private m_cParser As CBasicParser 30 | Private m_lOriginalHash As Long ' // Original hash of data. Used to track changes 31 | 32 | ' // Current file name 33 | Public Property Get FileName() As String 34 | FileName = m_sFileName 35 | End Property 36 | Public Property Let FileName( _ 37 | ByRef sValue As String) 38 | m_sFileName = sValue 39 | End Property 40 | 41 | ' // Current source code 42 | Public Property Get Source() As String 43 | Source = m_sSource 44 | End Property 45 | Public Property Let Source( _ 46 | ByRef sValue As String) 47 | m_sSource = FixUnicode(sValue) 48 | End Property 49 | 50 | ' // Current program name 51 | Public Property Get ProgramName() As String 52 | ProgramName = m_sProgramName 53 | End Property 54 | Public Property Let ProgramName( _ 55 | ByRef sValue As String) 56 | If Len(sValue) > 127 Then 57 | m_sProgramName = Left$(sValue, 127) 58 | Else 59 | m_sProgramName = sValue 60 | End If 61 | End Property 62 | 63 | ' // Determines if there is unsaved changes 64 | Public Property Get Changed() As Boolean 65 | Changed = CalcHash <> m_lOriginalHash 66 | End Property 67 | 68 | ' // Load a CAS/BAS/TXT/KOI7 file 69 | Public Sub Load( _ 70 | ByRef sFileName As String) 71 | Const PROC_NAME = "Load", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 72 | 73 | Dim bFileData() As Byte 74 | Dim lFileSize As Long 75 | Dim bBasicData() As Byte 76 | Dim sProgramName As String 77 | Dim cTxtFile As CTextFile 78 | 79 | If Not LoadFileToArray(sFileName, bFileData, lFileSize) Then 80 | Err.Raise 75, FULL_PROC_NAME, "LoadFileToArray failed" 81 | End If 82 | 83 | Select Case LCase(GetFileExtension(sFileName)) 84 | Case ".cas" 85 | 86 | If Not ConvertCASToBinBasic(bFileData, sProgramName, bBasicData) Then 87 | Err.Raise 5, FULL_PROC_NAME, "Invalid file format" 88 | End If 89 | 90 | m_sSource = m_cParser.ConvertBasicDataToString(bBasicData) 91 | m_sProgramName = sProgramName 92 | 93 | Case ".txt" 94 | 95 | Set cTxtFile = New CTextFile 96 | 97 | If lFileSize > 0 Then 98 | m_sSource = cTxtFile.LoadFromMemory(VarPtr(bFileData(0)), lFileSize) 99 | End If 100 | 101 | m_sProgramName = GetFileTitle(sFileName) 102 | 103 | Case ".bas" 104 | 105 | m_sSource = m_cParser.ConvertBasicDataToString(bFileData) 106 | m_sProgramName = GetFileTitle(sFileName) 107 | 108 | Case ".koi7" 109 | 110 | m_sSource = Vec6KOI7ToUnicode(bFileData) 111 | m_sProgramName = GetFileTitle(sFileName) 112 | 113 | End Select 114 | 115 | m_sFileName = sFileName 116 | m_lOriginalHash = CalcHash 117 | 118 | End Sub 119 | 120 | ' // Save current data to CAS/BAS/TXT/KOI7 121 | Public Sub Save( _ 122 | ByRef sFileName As String) 123 | Const PROC_NAME = "Save", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 124 | 125 | Dim bBasicData() As Byte 126 | Dim bFileData() As Byte 127 | Dim cTxtFile As CTextFile 128 | 129 | Select Case LCase(GetFileExtension(sFileName)) 130 | Case ".cas" 131 | 132 | m_cParser.ConvertSourceToBasicData m_sSource, bBasicData 133 | ConvertBinBasicToCAS bBasicData, m_sProgramName, bFileData 134 | 135 | If Not SaveArrayToFile(sFileName, bFileData) Then 136 | Err.Raise 75, FULL_PROC_NAME, "SaveArrayToFile failed" 137 | End If 138 | 139 | Case ".txt" 140 | 141 | Set cTxtFile = New CTextFile 142 | 143 | cTxtFile.Encoding = TE_UTF8 Or TE_HASBOM 144 | cTxtFile.Content = m_sSource 145 | 146 | If Not cTxtFile.SaveTextFile(sFileName) Then 147 | Err.Raise 75, FULL_PROC_NAME, "SaveTextFile failed" 148 | End If 149 | 150 | Case ".bas" 151 | 152 | m_cParser.ConvertSourceToBasicData m_sSource, bBasicData 153 | 154 | If Not SaveArrayToFile(sFileName, bBasicData) Then 155 | Err.Raise 75, FULL_PROC_NAME, "SaveArrayToFile failed" 156 | End If 157 | 158 | Case ".koi7" 159 | 160 | bFileData = UnicodeToVec6KOI7(m_sSource) 161 | 162 | If Not SaveArrayToFile(sFileName, bFileData) Then 163 | Err.Raise 75, FULL_PROC_NAME, "SaveArrayToFile failed" 164 | End If 165 | 166 | End Select 167 | 168 | m_sFileName = sFileName 169 | m_lOriginalHash = CalcHash 170 | 171 | End Sub 172 | 173 | ' // Calculate hash on current data 174 | Private Function CalcHash() As Long 175 | Const PROC_NAME = "CalcHash", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 176 | 177 | Dim lHash As Long 178 | 179 | If LenB(m_sSource) > 0 Then 180 | If HashData(ByVal StrPtr(m_sSource), LenB(m_sSource), lHash, Len(lHash)) < 0 Then 181 | Err.Raise 75, FULL_PROC_NAME, "HashData failed" 182 | End If 183 | Else 184 | lHash = 0 185 | End If 186 | 187 | CalcHash = lHash 188 | 189 | If LenB(m_sProgramName) > 0 Then 190 | If HashData(ByVal StrPtr(m_sProgramName), LenB(m_sProgramName), lHash, Len(lHash)) < 0 Then 191 | Err.Raise 75, FULL_PROC_NAME, "HashData failed" 192 | End If 193 | Else 194 | lHash = 0 195 | End If 196 | 197 | CalcHash = CalcHash Xor lHash 198 | 199 | End Function 200 | 201 | ' // Convert raw basic toekns to CAS file 202 | Private Sub ConvertBinBasicToCAS( _ 203 | ByRef bData() As Byte, _ 204 | ByRef sProgramName As String, _ 205 | ByRef bOutData() As Byte) 206 | Const PROC_NAME = "ConvertBinBasicToCAS", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 207 | 208 | Dim lSize As Long 209 | Dim lBasSize As Long 210 | Dim lIndex As Long 211 | Dim lIndex2 As Long 212 | Dim bProgName() As Byte 213 | Dim lProgNameSize As Long 214 | Dim lCRC As Long 215 | 216 | bProgName = UnicodeToVec6KOI7(sProgramName) 217 | lProgNameSize = SACount(ArrPtr(bProgName)) 218 | lBasSize = SACount(ArrPtr(bData)) 219 | lSize = lBasSize + 784 + lProgNameSize 220 | lCRC = CalcCRC(bData) 221 | 222 | ReDim bOutData(lSize - 1) 223 | 224 | For lIndex = 0 To 3 225 | bOutData(lIndex) = &HD3 226 | Next 227 | 228 | If Len(sProgramName) Then 229 | memcpy bOutData(4), bProgName(0), UBound(bProgName) + 1 230 | lIndex = lIndex + UBound(bProgName) + 1 231 | End If 232 | 233 | lIndex = lIndex + 3 ' // NULLs 234 | 235 | For lIndex2 = 0 To 767 236 | bOutData(lIndex) = &H55 237 | lIndex = lIndex + 1 238 | Next 239 | 240 | bOutData(lIndex) = &HE6 241 | lIndex = lIndex + 1 242 | 243 | For lIndex2 = 0 To 2 244 | bOutData(lIndex) = &HD3 245 | lIndex = lIndex + 1 246 | Next 247 | 248 | lIndex = lIndex + 1 249 | 250 | If lBasSize > 0 Then 251 | memcpy bOutData(lIndex), bData(0), lBasSize 252 | End If 253 | 254 | lIndex = lIndex + lBasSize + 2 255 | 256 | GetMem2 lCRC, bOutData(lIndex) 257 | 258 | End Sub 259 | 260 | ' // Convert CAS file to raw basic tokens 261 | Private Function ConvertCASToBinBasic( _ 262 | ByRef bData() As Byte, _ 263 | ByRef sProgramName As String, _ 264 | ByRef bOutData() As Byte) As Boolean 265 | Const PROC_NAME = "ConvertCASToBinBasic", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 266 | 267 | Dim bOut() As Byte 268 | Dim bProgramName() As Byte 269 | Dim lIndex As Long 270 | Dim lIndex2 As Long 271 | Dim lNameSize As Long 272 | Dim lContentSize As Long 273 | Dim lCRC As Long 274 | Dim lSize As Long 275 | 276 | lSize = SACount(ArrPtr(bData)) 277 | 278 | If lSize < 784 Then 279 | Exit Function 280 | End If 281 | 282 | For lIndex = 0 To 3 283 | If bData(lIndex) <> &HD3 Then 284 | Exit Function 285 | End If 286 | Next 287 | 288 | Do While bData(lIndex) And lIndex < lSize - 1 289 | lIndex = lIndex + 1 290 | Loop 291 | 292 | If lIndex = lSize Then 293 | Exit Function 294 | End If 295 | 296 | lNameSize = lIndex - 4 297 | 298 | If lNameSize > 127 Then 299 | Exit Function 300 | End If 301 | 302 | lContentSize = lSize - lNameSize - 784 303 | 304 | If lNameSize > 0 Then 305 | 306 | ReDim bProgramName(lNameSize - 1) 307 | memcpy bProgramName(0), bData(4), lNameSize 308 | 309 | End If 310 | 311 | sProgramName = Vec6KOI7ToUnicode(bProgramName) 312 | 313 | For lIndex2 = 0 To 2 314 | 315 | If bData(lIndex) <> 0 Then Exit Function 316 | lIndex = lIndex + 1 317 | 318 | Next 319 | 320 | For lIndex2 = 0 To 767 321 | 322 | If bData(lIndex) <> &H55 Then Exit Function 323 | lIndex = lIndex + 1 324 | 325 | Next 326 | 327 | If bData(lIndex) <> &HE6 Then Exit Function 328 | lIndex = lIndex + 1 329 | 330 | For lIndex2 = 0 To 2 331 | 332 | If bData(lIndex) <> &HD3 Then Exit Function 333 | lIndex = lIndex + 1 334 | 335 | Next 336 | 337 | If bData(lIndex) <> 0 Then Exit Function 338 | lIndex = lIndex + 1 339 | 340 | If lContentSize > 0 Then 341 | 342 | ReDim bOut(lContentSize - 1) 343 | 344 | memcpy bOut(0), bData(lIndex), lContentSize 345 | 346 | lIndex = lIndex + lContentSize 347 | 348 | End If 349 | 350 | For lIndex2 = 0 To 1 351 | 352 | If bData(lIndex) <> 0 Then Exit Function 353 | lIndex = lIndex + 1 354 | 355 | Next 356 | 357 | ' // Check CRC 358 | lCRC = CalcCRC(bOut()) 359 | 360 | If (lCRC And &HFF) <> bData(lIndex) Or _ 361 | ((lCRC \ &H100) And &HFF) <> bData(lIndex + 1) Then Exit Function 362 | 363 | bOutData = bOut 364 | ConvertCASToBinBasic = True 365 | 366 | End Function 367 | 368 | ' // Calculate CAS CRC 369 | Private Function CalcCRC( _ 370 | ByRef bData() As Byte) As Long 371 | Dim lCRC As Long 372 | Dim lIndex As Long 373 | Dim lCount As Long 374 | 375 | lCount = SACount(ArrPtr(bData)) 376 | 377 | For lIndex = 0 To lCount - 1 378 | lCRC = (lCRC + bData(lIndex)) And &HFFFF& 379 | Next 380 | 381 | CalcCRC = lCRC 382 | 383 | End Function 384 | 385 | Private Function CBasicParser_ConvertBasicDataToString( _ 386 | ByRef bData() As Byte) As String 387 | CBasicParser_ConvertBasicDataToString = m_cParser.ConvertBasicDataToString(bData) 388 | End Function 389 | 390 | Private Sub CBasicParser_ConvertSourceToBasicData( _ 391 | ByRef sSource As String, _ 392 | ByRef bOut() As Byte) 393 | m_cParser.ConvertSourceToBasicData sSource, bOut 394 | End Sub 395 | 396 | Private Sub Class_Initialize() 397 | Set m_cParser = New CBasicParser 398 | End Sub 399 | -------------------------------------------------------------------------------- /sources/classes/CParserTree.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "CParserTree" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | ' // 15 | ' // CParserTree.cls - this class can convert a text code representaion to tokens 16 | ' // By The trick 2021 17 | ' // 18 | 19 | Option Explicit 20 | Option Base 0 21 | 22 | Private Const MODULE_NAME = "CParserTree" 23 | 24 | Public Enum eTokenType 25 | TT_NEWLINE = 0 26 | TT_REM = 142 27 | TT_DATA = 131 28 | End Enum 29 | 30 | ' // This is parser tree 31 | ' // 32 | ' // [R]->[E]->[S]->[T]->[O]->[R]->[E] 33 | ' // | | 34 | ' // | +->[T]->[U]->[R]->[N] 35 | ' // +->[U]->[N] 36 | ' // 37 | 38 | ' // The first 255 items contains ASCII symbols mapping 39 | Private Type tTreeItem 40 | bSymbol As Byte 41 | bToken As Byte 42 | lParent As Long 43 | lCount As Long 44 | lChildren() As Long ' // Child indices 45 | End Type 46 | 47 | Private m_tItems() As tTreeItem ' // It has 255 items in 1st level 48 | Private m_lPointer As Long ' // Index of item which will be added 49 | Private m_lCount As Long ' // Count of items 50 | 51 | Private m_lCurIndex As Long ' // Current tree item index. -1 if initialized 52 | Private m_bInQuote As Boolean ' // The parser is in quote (process symbols without keywords) 53 | Private m_bRemData As Boolean ' // The parser si in REM/DATA block 54 | 55 | ' // Reset state 56 | Public Sub Reset() 57 | 58 | m_lCurIndex = -1 59 | m_bInQuote = False 60 | m_bRemData = False 61 | 62 | End Sub 63 | 64 | ' // Check if parsing process is incomplete 65 | Public Property Get Complete() As Boolean 66 | Complete = m_lCurIndex = -1 67 | End Property 68 | 69 | ' // Put a symbol to parser 70 | Public Function PutSymbol( _ 71 | ByVal bSymbol As Byte) As Byte() 72 | Dim lIndex As Long 73 | Dim bRet() As Byte 74 | Dim lSize As Long 75 | 76 | ' // Check keywords 77 | If m_lCurIndex = -1 Then 78 | 79 | ' // 1st level 80 | m_lCurIndex = bSymbol 81 | 82 | If bSymbol = 34 And Not m_bRemData Then 83 | m_bInQuote = Not m_bInQuote 84 | End If 85 | 86 | Exit Function 87 | 88 | Else 89 | 90 | For lIndex = 0 To m_tItems(m_lCurIndex).lCount - 1 91 | With m_tItems(m_tItems(m_lCurIndex).lChildren(lIndex)) 92 | If .bSymbol = bSymbol Then 93 | If .lCount = 0 Then 94 | 95 | If .bToken = TT_NEWLINE Then 96 | m_bRemData = False 97 | m_bInQuote = False 98 | Else 99 | If Not m_bRemData Then 100 | If .bToken = TT_DATA Or .bToken = TT_REM Then 101 | m_bRemData = True 102 | ElseIf .bSymbol = 34 Or m_bInQuote Then 103 | Exit For 104 | End If 105 | Else 106 | Exit For 107 | End If 108 | End If 109 | 110 | m_lCurIndex = -1 111 | 112 | ReDim bRet(0) 113 | bRet(0) = .bToken 114 | PutSymbol = bRet 115 | 116 | Exit Function 117 | 118 | Else 119 | 120 | If m_bRemData Or m_bInQuote Then 121 | Exit For 122 | Else 123 | m_lCurIndex = m_tItems(m_lCurIndex).lChildren(lIndex) 124 | End If 125 | 126 | Exit Function 127 | 128 | End If 129 | End If 130 | End With 131 | Next 132 | 133 | With m_tItems(m_lCurIndex) 134 | 135 | If .bToken Then 136 | 137 | ' // Existing keyword was broken 138 | ReDim bRet(0) 139 | 140 | If m_bInQuote Or m_bRemData Then 141 | bRet(0) = .bSymbol 142 | Else 143 | bRet(0) = .bToken 144 | End If 145 | 146 | If .bToken = TT_DATA Or .bToken = TT_REM Then 147 | m_bRemData = True 148 | End If 149 | 150 | ElseIf .lCount Then 151 | 152 | ' // Part of keyword, translate to symbols 153 | lSize = NumberOfParents(m_lCurIndex) 154 | 155 | ReDim bRet(lSize - 1) 156 | 157 | Do While m_lCurIndex > 0 158 | 159 | lSize = lSize - 1 160 | bRet(lSize) = m_tItems(m_lCurIndex).bSymbol 161 | m_lCurIndex = m_tItems(m_lCurIndex).lParent 162 | 163 | Loop 164 | 165 | End If 166 | 167 | If bSymbol = 34 And Not m_bRemData Then 168 | m_bInQuote = Not m_bInQuote 169 | End If 170 | 171 | PutSymbol = bRet 172 | m_lCurIndex = bSymbol 173 | 174 | End With 175 | 176 | End If 177 | 178 | End Function 179 | 180 | ' // Add a token 181 | Private Sub Add( _ 182 | ByRef sValue As String, _ 183 | ByVal bToken As Byte) 184 | Const PROC_NAME = "Add", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 185 | 186 | Dim bValue() As Byte 187 | Dim lIndex As Long 188 | Dim lNewIndex As Long 189 | 190 | If Len(sValue) = 0 Then 191 | Err.Raise 5, FULL_PROC_NAME 192 | End If 193 | 194 | bValue = UnicodeToVec6KOI7(sValue) 195 | 196 | lNewIndex = -1 197 | 198 | For lIndex = 0 To UBound(bValue) 199 | ' // Populate tree 200 | lNewIndex = EnsureInTree(lNewIndex, bValue(lIndex)) 201 | Next 202 | 203 | m_tItems(lNewIndex).bToken = bToken 204 | 205 | End Sub 206 | 207 | Private Property Get Count() As Long 208 | Count = m_lCount 209 | End Property 210 | 211 | ' // Returns number of parents of item 212 | Private Function NumberOfParents( _ 213 | ByVal lIndex As Long) As Long 214 | 215 | Do While lIndex > 0 216 | lIndex = m_tItems(lIndex).lParent 217 | NumberOfParents = NumberOfParents + 1 218 | Loop 219 | 220 | End Function 221 | 222 | ' // Return index of child item or add new if there is no item 223 | Private Function EnsureInTree( _ 224 | ByVal lIndex As Long, _ 225 | ByVal bValue As Byte) As Long 226 | Dim lNewIndex As Long 227 | Dim lChildIndex As Long 228 | Dim lIndex2 As Long 229 | 230 | ' // To 1st level 231 | If lIndex = -1 Then 232 | 233 | If m_tItems(bValue).bSymbol = 0 Then 234 | m_tItems(bValue).bSymbol = bValue 235 | m_lCount = m_lCount + 1 236 | End If 237 | 238 | EnsureInTree = bValue 239 | Exit Function 240 | 241 | End If 242 | 243 | lChildIndex = m_tItems(lIndex).lCount 244 | 245 | ' // Check if already exists 246 | For lIndex2 = 0 To lChildIndex - 1 247 | If m_tItems(m_tItems(lIndex).lChildren(lIndex2)).bSymbol = bValue Then 248 | EnsureInTree = m_tItems(lIndex).lChildren(lIndex2) 249 | Exit Function 250 | End If 251 | Next 252 | 253 | ' // Add new 254 | If lChildIndex = 0 Then 255 | ReDim m_tItems(lIndex).lChildren(9) 256 | Else 257 | If lChildIndex > UBound(m_tItems(lIndex).lChildren) Then 258 | ReDim Preserve m_tItems(lIndex).lChildren(lChildIndex + 10) 259 | End If 260 | End If 261 | 262 | lNewIndex = m_lPointer 263 | 264 | If lNewIndex > UBound(m_tItems) Then 265 | ReDim Preserve m_tItems(lNewIndex + 256) 266 | End If 267 | 268 | m_tItems(lNewIndex).bSymbol = bValue 269 | m_tItems(lNewIndex).lParent = lIndex 270 | m_tItems(lIndex).lChildren(lChildIndex) = lNewIndex 271 | m_tItems(lIndex).lCount = m_tItems(lIndex).lCount + 1 272 | 273 | m_lPointer = m_lPointer + 1 274 | m_lCount = m_lCount + 1 275 | 276 | EnsureInTree = lNewIndex 277 | 278 | End Function 279 | 280 | Private Sub Class_Initialize() 281 | Dim lIndex As Long 282 | 283 | ReDim m_tItems(255) 284 | 285 | For lIndex = 0 To 255 286 | m_tItems(lIndex).lParent = -1 287 | Next 288 | 289 | m_lPointer = 256 290 | 291 | For lIndex = 1 To 31 292 | Add Chr$(lIndex), lIndex 293 | Next 294 | 295 | Add vbNewLine, TT_NEWLINE 296 | 297 | For lIndex = 32 To 228 298 | Add Vec6BasicKeyword(lIndex), lIndex 299 | Next 300 | 301 | End Sub 302 | -------------------------------------------------------------------------------- /sources/classes/CTextFile.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "CTextFile" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | ' // 15 | ' // CTextFile.cls - this class can detect code-page of text and convert text to specified encoding 16 | ' // By The trick 2021 17 | ' // 18 | 19 | Option Explicit 20 | Option Base 0 21 | 22 | Private Const MODULE_NAME = "CTextFile" 23 | 24 | Public Enum eTextEncoding 25 | TE_ANSI = 0 26 | TE_UNICODE = 1 27 | TE_UTF8 = 2 28 | TE_CPMASK = 3 29 | TE_BIGENDIAN = 4 30 | TE_HASBOM = 8 31 | End Enum 32 | 33 | Private m_sContent As String 34 | Private m_eEncoding As eTextEncoding 35 | Private m_sFileName As String 36 | 37 | Public Property Get Encoding() As eTextEncoding 38 | Encoding = m_eEncoding 39 | End Property 40 | Public Property Let Encoding( _ 41 | ByVal eValue As eTextEncoding) 42 | m_eEncoding = eValue 43 | End Property 44 | 45 | Public Property Get Content() As String 46 | Content = m_sContent 47 | End Property 48 | Public Property Let Content( _ 49 | ByRef sValue As String) 50 | m_sContent = sValue 51 | End Property 52 | 53 | Public Property Get FileName() As String 54 | FileName = m_sFileName 55 | End Property 56 | Public Property Let FileName( _ 57 | ByRef sValue As String) 58 | m_sFileName = sValue 59 | End Property 60 | 61 | ' // Save current content to file using current encoding 62 | Public Function SaveTextFile( _ 63 | ByRef sFileName As String) As Boolean 64 | Const PROC_NAME = "SaveTextFile", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 65 | 66 | Dim bData() As Byte 67 | Dim hFile As OLE_HANDLE 68 | Dim lSize As Long 69 | Dim lIndex As Long 70 | Dim lSymIdx As Long 71 | Dim pString As Long 72 | Dim lChar As Long 73 | Dim lTotalSize As Long 74 | Dim lCodePage As Long 75 | 76 | On Error GoTo CleanUp 77 | 78 | hFile = CreateFile(sFileName, GENERIC_WRITE Or GENERIC_READ, 0, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) 79 | If hFile = INVALID_HANDLE_VALUE Then 80 | Err.Raise 7, FULL_PROC_NAME, "CreateFile failed" 81 | End If 82 | 83 | Select Case (m_eEncoding And TE_CPMASK) 84 | Case TE_ANSI, TE_UTF8 85 | 86 | If (m_eEncoding And TE_CPMASK) = TE_ANSI Then 87 | lCodePage = CP_ACP 88 | Else 89 | 90 | lCodePage = CP_UTF8 91 | 92 | If m_eEncoding And TE_HASBOM Then 93 | lTotalSize = 3: lIndex = 3 94 | End If 95 | 96 | End If 97 | 98 | If Len(m_sContent) Then 99 | 100 | lSize = WideCharToMultiByte(lCodePage, 0, ByVal StrPtr(m_sContent), Len(m_sContent), ByVal 0&, 0, ByVal 0&, ByVal 0&) 101 | If lSize = 0 Then 102 | Err.Raise 7, FULL_PROC_NAME, "WideCharToMultiByte failed" 103 | End If 104 | 105 | lTotalSize = lTotalSize + lSize 106 | 107 | ReDim bData(lTotalSize - 1) 108 | 109 | If WideCharToMultiByte(lCodePage, 0, ByVal StrPtr(m_sContent), Len(m_sContent), bData(lIndex), lSize, ByVal 0&, ByVal 0&) = 0 Then 110 | Err.Raise 7, FULL_PROC_NAME, "WideCharToMultiByte failed" 111 | End If 112 | 113 | End If 114 | 115 | If (m_eEncoding And TE_HASBOM) And ((m_eEncoding And TE_CPMASK) = TE_UTF8) Then 116 | bData(0) = &HEF 117 | bData(1) = &HBB 118 | bData(2) = &HBF 119 | End If 120 | 121 | Case TE_UNICODE 122 | 123 | lSize = LenB(m_sContent) 124 | 125 | If m_eEncoding And TE_HASBOM Then 126 | lTotalSize = lSize + 2 127 | Else 128 | lTotalSize = lSize 129 | End If 130 | 131 | If lTotalSize > 0 Then 132 | 133 | ReDim bData(lTotalSize - 1) 134 | 135 | If m_eEncoding And TE_HASBOM Then 136 | If m_eEncoding And TE_BIGENDIAN Then 137 | GetMem2 &HFFFE&, bData(0) 138 | Else 139 | GetMem2 &HFEFF&, bData(0) 140 | End If 141 | 142 | lIndex = lIndex + 2 143 | 144 | End If 145 | 146 | If m_eEncoding And TE_BIGENDIAN Then 147 | 148 | pString = StrPtr(m_sContent) 149 | 150 | For lSymIdx = 0 To Len(m_sContent) - 1 151 | GetMem2 ByVal pString + lSymIdx * 2, lChar 152 | lChar = (lChar \ &H100) Or ((lChar And &HFF) * &H100) 153 | GetMem2 lChar, bData(lIndex + lSymIdx * 2) 154 | Next 155 | 156 | Else 157 | memcpy bData(lIndex), ByVal StrPtr(m_sContent), LenB(m_sContent) 158 | End If 159 | 160 | End If 161 | 162 | End Select 163 | 164 | If lTotalSize > 0 Then 165 | 166 | If WriteFile(hFile, bData(0), lTotalSize, lSize, ByVal 0&) = 0 Then 167 | Err.Raise 7, FULL_PROC_NAME, "WriteFile failed" 168 | End If 169 | 170 | If lSize = lTotalSize Then 171 | SaveTextFile = True 172 | End If 173 | 174 | Else 175 | SaveTextFile = True 176 | End If 177 | 178 | m_sFileName = sFileName 179 | 180 | CleanUp: 181 | 182 | CloseHandle hFile 183 | 184 | If Err.Number Then 185 | ThrowCurrentErrorUp FULL_PROC_NAME 186 | End If 187 | 188 | End Function 189 | 190 | ' // 191 | ' // Load file and convert it to UTF-16 192 | ' // 193 | Public Sub LoadTextFile( _ 194 | ByRef sFileName As String) 195 | Const PROC_NAME = "LoadTextFile", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 196 | 197 | Dim hFile As OLE_HANDLE 198 | Dim hMap As OLE_HANDLE 199 | Dim pData As Long 200 | Dim liSize As LARGE_INTEGER 201 | 202 | hFile = CreateFile(sFileName, GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) 203 | If hFile = INVALID_HANDLE_VALUE Then 204 | Err.Raise 7, FULL_PROC_NAME, "CreateFile failed" 205 | End If 206 | 207 | If GetFileSizeEx(hFile, liSize) = 0 Then 208 | CloseHandle hFile 209 | Err.Raise 7, FULL_PROC_NAME, "GetFileSizeEx failed" 210 | End If 211 | 212 | If liSize.HighPart <> 0 Or liSize.LowPart < 0 Or liSize.LowPart > 10000000 Then 213 | CloseHandle hFile 214 | Err.Raise 7, FULL_PROC_NAME, "File is too big" 215 | End If 216 | 217 | hMap = CreateFileMapping(hFile, ByVal 0&, PAGE_READONLY, 0, 0, vbNullString) 218 | CloseHandle hFile 219 | If hMap = 0 Then 220 | Err.Raise 7, FULL_PROC_NAME, "CreateFileMapping failed" 221 | End If 222 | 223 | pData = MapViewOfFile(hMap, FILE_MAP_READ, 0, 0, 0) 224 | CloseHandle hMap 225 | If pData = 0 Then 226 | Err.Raise 7, FULL_PROC_NAME, "MapViewOfFile failed" 227 | End If 228 | 229 | On Error GoTo CleanUp 230 | 231 | LoadFromMemory pData, liSize.LowPart 232 | 233 | m_sFileName = sFileName 234 | 235 | CleanUp: 236 | 237 | UnmapViewOfFile ByVal pData 238 | 239 | If Err.Number Then 240 | ThrowCurrentErrorUp FULL_PROC_NAME 241 | End If 242 | 243 | End Sub 244 | 245 | Public Function LoadFromMemory( _ 246 | ByVal pData As Long, _ 247 | ByVal lSize As Long) As String 248 | Const PROC_NAME = "LoadFromMemory", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 249 | 250 | Dim eEncoding As eTextEncoding 251 | Dim sRet As String 252 | Dim lRetSize As Long 253 | Dim lIndex As Long 254 | Dim lCodePage As Long 255 | Dim lSwap As Long 256 | Dim pRet As Long 257 | 258 | If lSize = 0 Then Exit Function 259 | 260 | eEncoding = DetectEncoding(pData, lSize) 261 | 262 | If (eEncoding And TE_CPMASK) = TE_UNICODE Then 263 | 264 | If eEncoding And TE_HASBOM Then 265 | pData = pData + 2 266 | lSize = lSize - 2 267 | End If 268 | 269 | sRet = Space$((lSize + 1) \ 2) 270 | 271 | If eEncoding And TE_BIGENDIAN Then 272 | 273 | pRet = StrPtr(sRet) 274 | 275 | For lIndex = 0 To Len(sRet) - 1 276 | 277 | GetMem2 ByVal pData + lIndex * 2, lSwap 278 | lSwap = ((lSwap And &HFF) * &H100) Or (lSwap \ &H100) 279 | GetMem2 lSwap, ByVal pRet + lIndex * 2 280 | 281 | Next 282 | 283 | Else 284 | memcpy ByVal StrPtr(sRet), ByVal pData, lSize 285 | End If 286 | 287 | Else 288 | 289 | If (eEncoding And TE_CPMASK) = TE_ANSI Then 290 | lCodePage = CP_ACP 291 | ElseIf (eEncoding And TE_CPMASK) = TE_UTF8 Then 292 | 293 | lCodePage = CP_UTF8 294 | 295 | If eEncoding And TE_HASBOM Then 296 | pData = pData + 3 297 | lSize = lSize - 3 298 | End If 299 | 300 | End If 301 | 302 | lRetSize = MultiByteToWideChar(lCodePage, 0, ByVal pData, lSize, ByVal 0&, 0) 303 | If lRetSize = 0 Then 304 | Err.Raise 7, FULL_PROC_NAME, "MultiByteToWideChar failed" 305 | End If 306 | 307 | sRet = Space$(lRetSize) 308 | 309 | If MultiByteToWideChar(lCodePage, 0, ByVal pData, lSize, ByVal StrPtr(sRet), lRetSize) = 0 Then 310 | Err.Raise 7, FULL_PROC_NAME, "MultiByteToWideChar failed" 311 | End If 312 | 313 | End If 314 | 315 | m_sContent = sRet 316 | LoadFromMemory = sRet 317 | m_eEncoding = Encoding 318 | 319 | End Function 320 | 321 | Private Function DetectEncoding( _ 322 | ByVal pData As Long, _ 323 | ByVal lSize As Long) As eTextEncoding 324 | Dim lBOM As Long 325 | Dim bBE As Boolean 326 | 327 | If lSize < 2 Then 328 | DetectEncoding = TE_ANSI 329 | Exit Function 330 | End If 331 | 332 | GetMem2 ByVal pData, lBOM 333 | 334 | If lBOM = &HFEFF& Then 335 | ' // UTF-16 LE 336 | DetectEncoding = TE_UNICODE Or TE_HASBOM 337 | ElseIf lBOM = &HFFFE& Then 338 | ' // UTF-16 BE 339 | DetectEncoding = TE_UNICODE Or TE_BIGENDIAN Or TE_HASBOM 340 | ElseIf lSize > 2 Then 341 | If lBOM = &HBBEF& Then 342 | 343 | GetMem1 ByVal pData + 2, lBOM 344 | 345 | If (lBOM And &HFF) = &HBF Then 346 | ' // UTF-8 347 | DetectEncoding = TE_UTF8 Or TE_HASBOM 348 | End If 349 | 350 | Else 351 | If IsInputTextUnicode(pData, lSize, bBE) Then 352 | ' // UTF-16 353 | If bBE Then 354 | DetectEncoding = TE_UNICODE Or TE_BIGENDIAN 355 | Else 356 | DetectEncoding = TE_UNICODE 357 | End If 358 | ElseIf IsInputTextUTF8(pData, lSize) Then 359 | ' // UTF-8 360 | DetectEncoding = TE_UTF8 361 | Else 362 | ' // ANSI 363 | DetectEncoding = TE_ANSI 364 | End If 365 | End If 366 | Else 367 | DetectEncoding = TE_ANSI 368 | End If 369 | 370 | End Function 371 | 372 | Private Function IsInputTextUTF8( _ 373 | ByVal pData As Long, _ 374 | ByVal lSize As Long) As Boolean 375 | Dim bChar As Byte 376 | Dim lIndex As Long 377 | Dim bNoHigh As Boolean 378 | Dim lCount As Long 379 | 380 | If lSize <= 0 Then Exit Function 381 | 382 | bNoHigh = True 383 | 384 | For lIndex = 0 To lSize - 1 385 | 386 | GetMem1 ByVal pData + lIndex, bChar 387 | 388 | If (bChar And &H80) <> 0 Then 389 | bNoHigh = False 390 | End If 391 | 392 | If lCount Then 393 | 394 | If (bChar And &HC0) <> &H80 Then 395 | Exit Function 396 | End If 397 | 398 | lCount = lCount - 1 399 | 400 | ElseIf bChar >= &H80 Then 401 | 402 | Do 403 | 404 | bChar = (CLng(bChar) * 2) And &HFF 405 | lCount = lCount + 1 406 | 407 | Loop While bChar And &H80 408 | 409 | lCount = lCount - 1 410 | 411 | If lCount = 0 Then 412 | Exit Function 413 | End If 414 | 415 | End If 416 | 417 | Next 418 | 419 | If CBool(lCount) Or bNoHigh Then 420 | Exit Function 421 | Else 422 | IsInputTextUTF8 = True 423 | End If 424 | 425 | End Function 426 | 427 | Private Function IsInputTextUnicode( _ 428 | ByVal pData As Long, _ 429 | ByVal lSize As Long, _ 430 | ByRef bIsBigEndian As Boolean) As Boolean 431 | Dim lFlags As Long 432 | 433 | lFlags = -1 434 | 435 | If IsTextUnicode(ByVal pData, lSize, lFlags) Then 436 | If lSize < 100 And lFlags = IS_TEXT_UNICODE_STATISTICS Then 437 | IsInputTextUnicode = False 438 | Else 439 | 440 | If lFlags = IS_TEXT_UNICODE_REVERSE_STATISTICS Then 441 | bIsBigEndian = True 442 | Else 443 | bIsBigEndian = False 444 | End If 445 | 446 | IsInputTextUnicode = True 447 | 448 | End If 449 | End If 450 | 451 | End Function 452 | 453 | 454 | 455 | -------------------------------------------------------------------------------- /sources/controls/ctlTextBoxW.ctl: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.UserControl ctlTextBox 3 | BackColor = &H80000005& 4 | CanGetFocus = 0 'False 5 | ClientHeight = 3600 6 | ClientLeft = 0 7 | ClientTop = 0 8 | ClientWidth = 4800 9 | ScaleHeight = 240 10 | ScaleMode = 3 'Pixel 11 | ScaleWidth = 320 12 | End 13 | Attribute VB_Name = "ctlTextBox" 14 | Attribute VB_GlobalNameSpace = False 15 | Attribute VB_Creatable = True 16 | Attribute VB_PredeclaredId = False 17 | Attribute VB_Exposed = False 18 | ' // 19 | ' // ctlTextBox.cls - simple UNICODE textbox control 20 | ' // By The trick 2021 21 | ' // 22 | 23 | Option Explicit 24 | Option Base 0 25 | 26 | Public Event OnCopy() 27 | Public Event OnPaste() 28 | Public Event OnCut() 29 | 30 | Implements ISubclass 31 | 32 | Private WithEvents m_cFont As StdFont 33 | Attribute m_cFont.VB_VarHelpID = -1 34 | 35 | Private m_hWnd As Long 36 | Private m_hActualFont As Long ' // Because StdFont uses antialiasing the control re-creates the font without antialiasing 37 | 38 | Public Property Get BackColor() As OLE_COLOR 39 | BackColor = UserControl.BackColor 40 | End Property 41 | 42 | Public Property Let BackColor( _ 43 | ByVal lValue As OLE_COLOR) 44 | 45 | UserControl.BackColor = lValue 46 | InvalidateRect m_hWnd, ByVal 0&, 1 47 | PropertyChanged "BackColor" 48 | 49 | End Property 50 | 51 | Public Property Get ForeColor() As OLE_COLOR 52 | ForeColor = UserControl.ForeColor 53 | End Property 54 | 55 | Public Property Let ForeColor( _ 56 | ByVal lValue As OLE_COLOR) 57 | 58 | UserControl.ForeColor = lValue 59 | InvalidateRect m_hWnd, ByVal 0&, 1 60 | PropertyChanged "ForeColor" 61 | 62 | End Property 63 | 64 | Public Property Get Font() As StdFont 65 | Set Font = m_cFont 66 | End Property 67 | 68 | Public Property Set Font( _ 69 | ByVal cValue As StdFont) 70 | Set m_cFont = cValue 71 | UpdateFont 72 | PropertyChanged "Font" 73 | End Property 74 | 75 | Public Property Get hWnd() As Long 76 | hWnd = m_hWnd 77 | End Property 78 | 79 | Public Property Get Text() As String 80 | Dim lSize As Long 81 | 82 | lSize = GetWindowTextLength(m_hWnd) 83 | 84 | If lSize > 0 Then 85 | Text = Space$(lSize) 86 | GetWindowText m_hWnd, Text, lSize + 1 87 | End If 88 | 89 | End Property 90 | 91 | Public Property Let Text( _ 92 | ByRef sValue As String) 93 | SetWindowText m_hWnd, sValue 94 | End Property 95 | 96 | Public Property Let SelStart( _ 97 | ByVal lValue As Long) 98 | Dim lCurStart As Long 99 | Dim lCurEnd As Long 100 | 101 | SendMessage m_hWnd, EM_GETSEL, VarPtr(lCurStart), lCurEnd 102 | SendMessage m_hWnd, EM_SETSEL, lValue, ByVal lCurEnd 103 | 104 | End Property 105 | 106 | Public Property Get SelStart() As Long 107 | SendMessage m_hWnd, EM_GETSEL, VarPtr(SelStart), ByVal 0& 108 | End Property 109 | 110 | Public Property Let SelLength( _ 111 | ByVal lValue As Long) 112 | Dim lCurStart As Long 113 | 114 | SendMessage m_hWnd, EM_GETSEL, VarPtr(lCurStart), ByVal 0& 115 | SendMessage m_hWnd, EM_SETSEL, lCurStart, ByVal lCurStart + lValue 116 | 117 | End Property 118 | 119 | Public Property Get SelLength() As Long 120 | Dim lCurStart As Long 121 | Dim lCurEnd As Long 122 | 123 | SendMessage m_hWnd, EM_GETSEL, VarPtr(lCurStart), lCurEnd 124 | 125 | SelLength = lCurEnd - lCurStart 126 | 127 | End Property 128 | 129 | Public Property Let SelText( _ 130 | ByRef sValue As String) 131 | SendMessage m_hWnd, EM_REPLACESEL, 1, ByVal StrPtr(sValue) 132 | End Property 133 | 134 | Public Property Get SelText() As String 135 | Dim lCurStart As Long 136 | Dim lCurEnd As Long 137 | Dim lSize As Long 138 | Dim hMem As Long 139 | Dim pText As Long 140 | 141 | SendMessage m_hWnd, EM_GETSEL, VarPtr(lCurStart), lCurEnd 142 | 143 | lSize = lCurEnd - lCurStart 144 | 145 | If lSize > 0 Then 146 | 147 | hMem = SendMessage(m_hWnd, EM_GETHANDLE, 0, ByVal 0&) 148 | 149 | If hMem Then 150 | 151 | pText = LocalLock(hMem) 152 | 153 | If pText Then 154 | 155 | SelText = Space$(lSize) 156 | memcpy ByVal StrPtr(SelText), ByVal pText + lCurStart * 2, lSize * 2 157 | LocalUnlock hMem 158 | 159 | End If 160 | 161 | End If 162 | 163 | End If 164 | 165 | End Property 166 | 167 | Public Sub SelectAll() 168 | SendMessage m_hWnd, EM_SETSEL, 0, ByVal -1& 169 | End Sub 170 | 171 | Private Property Get ISubclass_hWnd() As Long 172 | ISubclass_hWnd = m_hWnd 173 | End Property 174 | 175 | Private Function ISubclass_OnWindowProc( _ 176 | ByVal hWnd As Long, _ 177 | ByVal lMsg As Long, _ 178 | ByVal wParam As Long, _ 179 | ByVal lParam As Long, _ 180 | ByRef bDefCall As Boolean) As Long 181 | 182 | bDefCall = False 183 | 184 | Select Case lMsg 185 | Case WM_COPY 186 | RaiseEvent OnCopy 187 | Case WM_CUT 188 | RaiseEvent OnCut 189 | Case WM_PASTE 190 | RaiseEvent OnPaste 191 | Case Else 192 | bDefCall = True 193 | End Select 194 | 195 | End Function 196 | 197 | Private Sub m_cFont_FontChanged( _ 198 | ByVal PropertyName As String) 199 | UpdateFont 200 | End Sub 201 | 202 | Private Sub UpdateFont() 203 | Dim cFont As IFont 204 | Dim tLogFont As LOGFONT 205 | Dim hNewFont As Long 206 | 207 | Set cFont = m_cFont 208 | 209 | If GetObjectAPI(cFont.hFont, LenB(tLogFont), tLogFont) Then 210 | 211 | tLogFont.lfQuality = NONANTIALIASED_QUALITY 212 | 213 | hNewFont = CreateFontIndirect(tLogFont) 214 | 215 | If hNewFont Then 216 | 217 | If m_hActualFont Then 218 | DeleteObject m_hActualFont 219 | End If 220 | 221 | m_hActualFont = hNewFont 222 | 223 | End If 224 | 225 | End If 226 | 227 | SendMessage m_hWnd, WM_SETFONT, m_hActualFont, 1 228 | 229 | End Sub 230 | 231 | Private Sub UserControl_Initialize() 232 | 233 | m_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, _ 234 | "Edit", vbNullString, WS_CHILD Or WS_VISIBLE Or ES_AUTOHSCROLL Or _ 235 | ES_AUTOVSCROLL Or ES_MULTILINE Or ES_WANTRETURN Or WS_VSCROLL, _ 236 | 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, UserControl.hWnd, 0, App.hInstance, ByVal 0&) 237 | SendMessage m_hWnd, EM_LIMITTEXT, 0, ByVal 0& 238 | SubclassWindow Me 239 | 240 | End Sub 241 | 242 | Private Sub UserControl_GotFocus() 243 | SetFocusAPI m_hWnd 244 | End Sub 245 | 246 | Private Sub UserControl_Resize() 247 | MoveWindow m_hWnd, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, 1 248 | End Sub 249 | 250 | Private Sub UserControl_InitProperties() 251 | Set m_cFont = Ambient.Font 252 | End Sub 253 | 254 | Private Sub UserControl_ReadProperties( _ 255 | ByRef PropBag As PropertyBag) 256 | 257 | Set m_cFont = PropBag.ReadProperty("Font", Ambient.Font) 258 | UserControl.BackColor = PropBag.ReadProperty("BackColor", vbWindowBackground) 259 | UserControl.ForeColor = PropBag.ReadProperty("ForeColor", Ambient.ForeColor) 260 | UpdateFont 261 | 262 | End Sub 263 | 264 | Private Sub UserControl_Terminate() 265 | 266 | UnsubclassWindow Me 267 | 268 | If m_hActualFont Then 269 | DeleteObject m_hActualFont 270 | End If 271 | 272 | End Sub 273 | 274 | Private Sub UserControl_WriteProperties( _ 275 | ByRef PropBag As PropertyBag) 276 | 277 | PropBag.WriteProperty "Font", m_cFont, Ambient.Font 278 | PropBag.WriteProperty "BackColor", UserControl.BackColor, vbWindowBackground 279 | PropBag.WriteProperty "ForeColor", UserControl.ForeColor, Ambient.ForeColor 280 | 281 | End Sub 282 | -------------------------------------------------------------------------------- /sources/forms/frmAbout.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/sources/forms/frmAbout.frm -------------------------------------------------------------------------------- /sources/forms/frmAbout.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/sources/forms/frmAbout.frx -------------------------------------------------------------------------------- /sources/forms/frmInsertSymbol.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmInsertSymbol 3 | BorderStyle = 4 'Fixed ToolWindow 4 | Caption = "Insert symbol" 5 | ClientHeight = 3495 6 | ClientLeft = 45 7 | ClientTop = 315 8 | ClientWidth = 4230 9 | Icon = "frmInsertSymbol.frx":0000 10 | LinkTopic = "Form1" 11 | MaxButton = 0 'False 12 | MinButton = 0 'False 13 | ScaleHeight = 233 14 | ScaleMode = 3 'Pixel 15 | ScaleWidth = 282 16 | ShowInTaskbar = 0 'False 17 | StartUpPosition = 1 'CenterOwner 18 | End 19 | Attribute VB_Name = "frmInsertSymbol" 20 | Attribute VB_GlobalNameSpace = False 21 | Attribute VB_Creatable = False 22 | Attribute VB_PredeclaredId = True 23 | Attribute VB_Exposed = False 24 | ' // 25 | ' // frmInsertSymbol.frm - form with ability to add special basic symbols (0 - 31, 127 range) 26 | ' // By The trick 2021 27 | ' // 28 | 29 | Option Explicit 30 | 31 | Private Const MODULE_NAME = "frmInsertSymbol" 32 | 33 | ' // Button state 34 | Private Enum eButtonState 35 | BS_PRESSED = 1 ' // Button was pressed 36 | BS_HOT = 2 ' // The mouse over button 37 | BS_DISABLED = 3 ' // Button was disabled 38 | End Enum 39 | 40 | ' // It doesn't use controls at all. All the buttons are painted by code 41 | 42 | Private m_lButtonWidth As Long ' // Buttons metrics 43 | Private m_lButtonHeight As Long 44 | Private m_lSpaceSize As Long ' // Space between form and buttons 45 | Private m_lActiveButton As Long ' // Current active button index. If no active then -1 46 | Private m_cVectorFont As StdFont 47 | Private m_cOriginFont As StdFont 48 | Private m_tButtonsArea As RECT ' // Buttons area (to test mouse) 49 | 50 | ' // We don't need double-click 51 | Private Sub Form_DblClick() 52 | Const PROC_NAME = "Form_DblClick", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 53 | 54 | On Error GoTo error_handler 55 | 56 | If m_lActiveButton >= 0 Then 57 | ButtonPressed m_lActiveButton 58 | End If 59 | 60 | Exit Sub 61 | 62 | error_handler: 63 | 64 | ShowCurrentError 65 | 66 | End Sub 67 | 68 | Private Sub Form_Load() 69 | Const PROC_NAME = "Form_Load", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 70 | 71 | On Error GoTo error_handler 72 | 73 | m_lActiveButton = -1 74 | 75 | Set m_cOriginFont = Me.Font 76 | Set m_cVectorFont = New StdFont 77 | 78 | ' // Big font 79 | m_cVectorFont.Name = "Vector06C" 80 | m_cVectorFont.Size = 12 81 | 82 | Exit Sub 83 | 84 | error_handler: 85 | 86 | ShowCurrentError 87 | 88 | End Sub 89 | 90 | Private Sub Form_MouseDown( _ 91 | ByRef Button As Integer, _ 92 | ByRef Shift As Integer, _ 93 | ByRef x As Single, _ 94 | ByRef y As Single) 95 | Const PROC_NAME = "Form_MouseDown", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 96 | 97 | Dim lIndex As Long 98 | 99 | On Error GoTo error_handler 100 | 101 | If PtInRect(m_tButtonsArea, x, y) Then 102 | 103 | lIndex = ButtonIndexFromCoord(x, y) 104 | 105 | If m_lActiveButton >= 0 Then 106 | DrawButton m_lActiveButton, 0 107 | End If 108 | 109 | ' // Skip CL and LF unprintable 110 | If lIndex = 10 Or lIndex = 13 Then 111 | m_lActiveButton = -1 112 | Exit Sub 113 | End If 114 | 115 | m_lActiveButton = lIndex 116 | 117 | DrawButton m_lActiveButton, BS_PRESSED 118 | 119 | ButtonPressed lIndex 120 | 121 | End If 122 | 123 | Exit Sub 124 | 125 | error_handler: 126 | 127 | ShowCurrentError 128 | 129 | End Sub 130 | 131 | Private Sub Form_MouseMove( _ 132 | ByRef Button As Integer, _ 133 | ByRef Shift As Integer, _ 134 | ByRef x As Single, _ 135 | ByRef y As Single) 136 | Const PROC_NAME = "Form_MouseMove", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 137 | 138 | Dim lIndex As Long 139 | 140 | On Error GoTo error_handler 141 | 142 | If PtInRect(m_tButtonsArea, x, y) Then 143 | 144 | lIndex = ButtonIndexFromCoord(x, y) 145 | 146 | If lIndex = m_lActiveButton Then 147 | Exit Sub 148 | End If 149 | 150 | If m_lActiveButton >= 0 Then 151 | DrawButton m_lActiveButton, 0 152 | End If 153 | 154 | If lIndex = 10 Or lIndex = 13 Then 155 | m_lActiveButton = -1 156 | Exit Sub 157 | End If 158 | 159 | m_lActiveButton = lIndex 160 | 161 | DrawButton m_lActiveButton, BS_HOT 162 | 163 | ElseIf m_lActiveButton >= 0 Then 164 | 165 | DrawButton m_lActiveButton, 0 166 | m_lActiveButton = -1 167 | 168 | End If 169 | 170 | Exit Sub 171 | 172 | error_handler: 173 | 174 | ShowCurrentError 175 | 176 | End Sub 177 | 178 | Private Sub Form_MouseUp( _ 179 | ByRef Button As Integer, _ 180 | ByRef Shift As Integer, _ 181 | ByRef x As Single, _ 182 | ByRef y As Single) 183 | Const PROC_NAME = "Form_MouseUp", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 184 | 185 | On Error GoTo error_handler 186 | 187 | If m_lActiveButton >= 0 Then 188 | 189 | DrawButton m_lActiveButton, 0 190 | m_lActiveButton = -1 191 | 192 | End If 193 | 194 | Exit Sub 195 | 196 | error_handler: 197 | 198 | ShowCurrentError 199 | 200 | End Sub 201 | 202 | Private Sub Form_Paint() 203 | Const PROC_NAME = "Form_Paint", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 204 | 205 | Dim lIndex As Long 206 | Dim eState As eButtonState 207 | Dim lX As Long 208 | Dim lY As Long 209 | 210 | On Error GoTo error_handler 211 | 212 | For lIndex = 0 To 31 213 | 214 | If lIndex = 10 Or lIndex = 13 Then 215 | eState = BS_DISABLED 216 | Else 217 | eState = 0 218 | End If 219 | 220 | DrawButton lIndex, eState 221 | 222 | Next 223 | 224 | Exit Sub 225 | 226 | error_handler: 227 | 228 | ShowCurrentError 229 | 230 | End Sub 231 | 232 | ' // The event when a button was pressed 233 | Private Sub ButtonPressed( _ 234 | ByVal lIndex As Long) 235 | Const PROC_NAME = "ButtonPressed", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 236 | 237 | Dim bText(0) As Byte 238 | 239 | On Error GoTo error_handler 240 | 241 | If lIndex = 0 Then 242 | lIndex = 127 ' // Button with 0 index = 127 char 243 | End If 244 | 245 | bText(0) = lIndex 246 | 247 | frmMain.ctlTextBox.SelText = Vec6KOI7ToUnicode(bText) 248 | 249 | Exit Sub 250 | 251 | error_handler: 252 | 253 | ThrowCurrentErrorUp FULL_PROC_NAME 254 | 255 | End Sub 256 | 257 | ' // Calculate index from ccords 258 | Private Function ButtonIndexFromCoord( _ 259 | ByVal lX As Long, _ 260 | ByVal lY As Long) As Long 261 | Dim lCol As Long 262 | Dim lRow As Long 263 | 264 | lX = lX - m_lSpaceSize 265 | lY = lY - m_lSpaceSize 266 | 267 | lRow = lX \ m_lButtonWidth 268 | lCol = lY \ m_lButtonHeight 269 | 270 | ButtonIndexFromCoord = lCol * 8 + lRow 271 | 272 | End Function 273 | 274 | Private Sub DrawButton( _ 275 | ByVal lIndex As Long, _ 276 | ByVal eState As eButtonState) 277 | Const PROC_NAME = "DrawButton", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 278 | 279 | Dim lX As Long 280 | Dim lY As Long 281 | Dim lRow As Long 282 | Dim lCol As Long 283 | Dim tRC As RECT 284 | Dim sText As String 285 | Dim bKOI(0) As Byte 286 | 287 | On Error GoTo error_handler 288 | 289 | lRow = lIndex Mod 8 290 | lCol = lIndex \ 8 291 | 292 | lX = m_lSpaceSize + lRow * m_lButtonWidth 293 | lY = m_lSpaceSize + lCol * m_lButtonHeight 294 | 295 | Me.Line (lX, lY)-Step(m_lButtonWidth, m_lButtonHeight), Me.BackColor, BF 296 | 297 | Select Case eState 298 | Case BS_PRESSED 299 | Me.Line (lX + 1, lY + 1)-Step(m_lButtonWidth - 2, m_lButtonHeight - 2), vbHighlight, BF 300 | Case BS_HOT 301 | Me.Line (lX + 1, lY + 1)-Step(m_lButtonWidth - 2, m_lButtonHeight - 2), vb3DHighlight, B 302 | Case BS_DISABLED 303 | Me.Line (lX + 1, lY + 1)-Step(m_lButtonWidth - 2, m_lButtonHeight - 2), vbInactiveBorder, B 304 | Case Else 305 | Me.Line (lX + 1, lY + 1)-Step(m_lButtonWidth - 2, m_lButtonHeight - 2), vbActiveBorder, B 306 | End Select 307 | 308 | SetRect tRC, lX, lY, lX + m_lButtonWidth, lY + m_lButtonHeight 309 | 310 | If lIndex = 10 Or lIndex = 13 Then 311 | sText = " " 312 | Else 313 | 314 | If lIndex = 0 Then 315 | lIndex = 127 316 | End If 317 | 318 | bKOI(0) = lIndex 319 | sText = Vec6KOI7ToUnicode(bKOI) 320 | 321 | End If 322 | 323 | Set Me.Font = m_cVectorFont 324 | 325 | ' // Draw symbol 326 | DrawText Me.hDC, sText, -1, tRC, DT_CALCRECT 327 | 328 | OffsetRect tRC, (m_lButtonWidth - (tRC.Right - tRC.Left)) \ 2, (m_lButtonHeight - (tRC.Bottom - tRC.Top)) \ 2 329 | 330 | DrawText Me.hDC, sText, -1, tRC, 0 331 | 332 | Set Me.Font = m_cOriginFont 333 | 334 | ' // Draw hex code 335 | OffsetRect tRC, 0, tRC.Bottom - tRC.Top 336 | 337 | sText = Hex$(lIndex) 338 | 339 | If Len(sText) = 1 Then 340 | sText = "0" & sText 341 | End If 342 | 343 | DrawText Me.hDC, sText, -1, tRC, DT_CENTER 344 | 345 | Exit Sub 346 | 347 | error_handler: 348 | 349 | ThrowCurrentErrorUp FULL_PROC_NAME 350 | 351 | End Sub 352 | 353 | Private Sub Form_Resize() 354 | Const PROC_NAME = "Form_Resize", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 355 | 356 | Dim lTextWidth As Long 357 | Dim lTextHeight As Long 358 | 359 | On Error GoTo error_handler 360 | 361 | lTextWidth = Me.TextWidth("0") 362 | lTextHeight = Me.TextHeight("0") 363 | 364 | If lTextWidth > lTextHeight Then 365 | m_lSpaceSize = lTextWidth 366 | Else 367 | m_lSpaceSize = lTextHeight 368 | End If 369 | 370 | m_lSpaceSize = m_lSpaceSize 371 | 372 | m_lButtonWidth = (Me.ScaleWidth - m_lSpaceSize * 2) \ 8 373 | m_lButtonHeight = (Me.ScaleHeight - m_lSpaceSize * 2) \ 4 374 | 375 | SetRect m_tButtonsArea, m_lSpaceSize, m_lSpaceSize, _ 376 | m_lButtonWidth * 8 + m_lSpaceSize, m_lButtonHeight * 4 + m_lSpaceSize 377 | 378 | Exit Sub 379 | 380 | error_handler: 381 | 382 | ShowCurrentError 383 | 384 | End Sub 385 | -------------------------------------------------------------------------------- /sources/forms/frmInsertSymbol.frx: -------------------------------------------------------------------------------- 1 | lt -------------------------------------------------------------------------------- /sources/forms/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | ClientHeight = 4485 4 | ClientLeft = 225 5 | ClientTop = 855 6 | ClientWidth = 5505 7 | Icon = "frmMain.frx":0000 8 | LinkTopic = "Form1" 9 | ScaleHeight = 4485 10 | ScaleWidth = 5505 11 | StartUpPosition = 3 'Windows Default 12 | Begin Vector06CBasic.ctlTextBox ctlTextBox 13 | Height = 4335 14 | Left = 60 15 | Top = 60 16 | Width = 5415 17 | _extentx = 9551 18 | _extenty = 7646 19 | font = "frmMain.frx":0442 20 | End 21 | Begin VB.Menu mnuFile 22 | Caption = "&File" 23 | Begin VB.Menu mnuOpen 24 | Caption = "&Open..." 25 | Shortcut = ^O 26 | End 27 | Begin VB.Menu mnuSave 28 | Caption = "&Save" 29 | Shortcut = ^S 30 | End 31 | Begin VB.Menu mnuSaveAs 32 | Caption = "Save as..." 33 | End 34 | Begin VB.Menu mnuProgramName 35 | Caption = "Program name..." 36 | End 37 | Begin VB.Menu mnuSep 38 | Caption = "-" 39 | Index = 0 40 | End 41 | Begin VB.Menu mnuQuit 42 | Caption = "Quit" 43 | End 44 | End 45 | Begin VB.Menu mnuEdit 46 | Caption = "&Edit" 47 | Begin VB.Menu mnuInsertSymbol 48 | Caption = "&Insert symbol..." 49 | Shortcut = ^{INSERT} 50 | End 51 | Begin VB.Menu mnuSelectAll 52 | Caption = "Select &All" 53 | Shortcut = ^A 54 | End 55 | End 56 | Begin VB.Menu mnuOptions 57 | Caption = "&Options" 58 | Begin VB.Menu mnuSettings 59 | Caption = "&Settings..." 60 | End 61 | End 62 | Begin VB.Menu mnuAbout 63 | Caption = "&About" 64 | End 65 | End 66 | Attribute VB_Name = "frmMain" 67 | Attribute VB_GlobalNameSpace = False 68 | Attribute VB_Creatable = False 69 | Attribute VB_PredeclaredId = True 70 | Attribute VB_Exposed = False 71 | 72 | ' // 73 | ' // frmMain.frm - main window and GUI-logic 74 | ' // By The trick 2021 75 | ' // 76 | 77 | Option Explicit 78 | 79 | Private Const MODULE_NAME = "frmMain" 80 | 81 | Implements ISubclass ' // Form supports sublcassing 82 | 83 | Private m_cFile As CCASFile ' // Current file 84 | Private m_hFont As Long ' // Handle of installed Vector06C font 85 | 86 | ' // Set current theme of textbox 87 | ' // The frmSettings uses this method to apply settings 88 | ' // This method should be public 89 | Public Sub SetTextboxTheme( _ 90 | ByVal eTheme As eTheme) 91 | Const PROC_NAME = "SetTextboxTheme", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 92 | 93 | Dim lForeColor As OLE_COLOR 94 | Dim lBackColor As OLE_COLOR 95 | 96 | On Error GoTo error_handler 97 | 98 | Select Case eTheme 99 | Case T_WIN 100 | lForeColor = vbWindowText 101 | lBackColor = vbWindowBackground 102 | Case T_DARK 103 | lBackColor = &H580000 104 | lForeColor = &HD9D9& 105 | Case T_SOFT 106 | lBackColor = &HDBCDBF 107 | lForeColor = &H303030 108 | End Select 109 | 110 | ctlTextBox.BackColor = lBackColor 111 | ctlTextBox.ForeColor = lForeColor 112 | 113 | Exit Sub 114 | 115 | error_handler: 116 | 117 | ThrowCurrentErrorUp FULL_PROC_NAME 118 | 119 | End Sub 120 | 121 | ' // Set current size of textbox 122 | ' // The frmSettings uses this method to apply settings 123 | ' // This method should be public 124 | Public Sub SetTextboxFontSize( _ 125 | ByVal eSize As eFontSize) 126 | Const PROC_NAME = "SetTextboxFontSize", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 127 | 128 | On Error GoTo error_handler 129 | 130 | Select Case eSize 131 | Case FS_SMALL 132 | ctlTextBox.Font.Size = 6 ' // The font developed with 6 size so all sizes should be multiple this value 133 | Case FS_LARGE 134 | ctlTextBox.Font.Size = 12 135 | End Select 136 | 137 | Exit Sub 138 | 139 | error_handler: 140 | 141 | ThrowCurrentErrorUp FULL_PROC_NAME 142 | 143 | End Sub 144 | 145 | ' // Replace copying procedure to replace forbidden symbols with spaces 146 | Private Sub ctlTextBox_OnCopy() 147 | Const PROC_NAME = "ctlTextBox_OnCopy", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 148 | 149 | Dim sText As String 150 | Dim lSize As Long 151 | Dim hMem As Long 152 | Dim pData As Long 153 | Dim bOpened As Boolean 154 | 155 | On Error GoTo error_handler 156 | 157 | ' // Convert all to Upperbound 158 | sText = FixUnicode(ctlTextBox.SelText) 159 | 160 | If OpenClipboard(ctlTextBox.hWnd) = 0 Then 161 | Err.Raise 7, FULL_PROC_NAME, "OpenClipboard failed" 162 | End If 163 | 164 | bOpened = True 165 | 166 | If EmptyClipboard() = 0 Then 167 | Err.Raise 7, FULL_PROC_NAME, "EmptyClipboard failed" 168 | End If 169 | 170 | lSize = LenB(sText) 171 | 172 | If lSize > 0 Then 173 | 174 | hMem = GlobalAlloc(GMEM_MOVEABLE, lSize + 2) 175 | 176 | If hMem Then 177 | 178 | pData = GlobalLock(hMem) 179 | 180 | If pData Then 181 | memcpy ByVal pData, ByVal StrPtr(sText), LenB(sText) + 2 182 | Else 183 | GlobalFree hMem 184 | Err.Raise 7, FULL_PROC_NAME, "GlobalLock failed" 185 | End If 186 | 187 | GlobalUnlock hMem 188 | 189 | If SetClipboardData(CF_UNICODETEXT, hMem) = 0 Then 190 | GlobalFree hMem 191 | Err.Raise 7, FULL_PROC_NAME, "SetClipboardData failed" 192 | End If 193 | 194 | Else 195 | Err.Raise 7, FULL_PROC_NAME, "GlobalAlloc failed" 196 | End If 197 | 198 | End If 199 | 200 | CloseClipboard 201 | 202 | Exit Sub 203 | 204 | error_handler: 205 | 206 | If bOpened Then 207 | CloseClipboard 208 | End If 209 | 210 | ShowCurrentError 211 | 212 | End Sub 213 | 214 | Private Sub ctlTextBox_OnCut() 215 | ctlTextBox_OnCopy 216 | ctlTextBox.SelText = vbNullString 217 | End Sub 218 | 219 | ' // Replace pasting procedure 220 | Private Sub ctlTextBox_OnPaste() 221 | Const PROC_NAME = "ctlTextBox_OnPaste", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 222 | 223 | Dim sText As String 224 | Dim lSize As Long 225 | Dim hMem As Long 226 | Dim pData As Long 227 | Dim bOpened As Boolean 228 | 229 | On Error GoTo error_handler 230 | 231 | If IsClipboardFormatAvailable(CF_UNICODETEXT) = 0 Then Exit Sub 232 | 233 | If OpenClipboard(ctlTextBox.hWnd) = 0 Then 234 | Err.Raise 7, FULL_PROC_NAME, "OpenClipboard failed" 235 | End If 236 | 237 | bOpened = True 238 | 239 | hMem = GetClipboardData(CF_UNICODETEXT) 240 | If hMem = 0 Then 241 | Err.Raise 7, FULL_PROC_NAME, "GetClipboardData failed" 242 | End If 243 | 244 | pData = GlobalLock(hMem) 245 | If pData = 0 Then 246 | Err.Raise 7, FULL_PROC_NAME, "GlobalLock failed" 247 | End If 248 | 249 | lSize = lstrlenW(ByVal pData) 250 | 251 | If lSize > 0 Then 252 | 253 | sText = Space$(lSize) 254 | memcpy ByVal StrPtr(sText), ByVal pData, lSize * 2 255 | GlobalUnlock hMem 256 | 257 | ctlTextBox.SelText = FixUnicode(sText) 258 | 259 | End If 260 | 261 | CloseClipboard 262 | 263 | Exit Sub 264 | 265 | error_handler: 266 | 267 | If bOpened Then 268 | CloseClipboard 269 | End If 270 | 271 | ShowCurrentError 272 | 273 | End Sub 274 | 275 | Private Sub Form_Initialize() 276 | Const PROC_NAME = "Form_Initialize", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 277 | 278 | Dim bFontData() As Byte 279 | 280 | On Error GoTo error_handler 281 | 282 | ' // Install private font (Vector06C) from resources 283 | bFontData = LoadResData(100, RT_FONT) 284 | 285 | m_hFont = AddFontMemResourceEx(bFontData(0), UBound(bFontData) + 1, 0, 0) 286 | 287 | If m_hFont = 0 Then 288 | Err.Raise 7, PROC_NAME, "AddFontMemResourceEx failed" 289 | End If 290 | 291 | Exit Sub 292 | 293 | error_handler: 294 | 295 | ThrowCurrentErrorUp FULL_PROC_NAME 296 | 297 | End Sub 298 | 299 | Private Sub Form_Load() 300 | Const PROC_NAME = "Form_Load", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 301 | 302 | On Error GoTo error_handler 303 | 304 | ' // Subclass me 305 | If Not SubclassWindow(Me) Then 306 | Err.Raise 7, FULL_PROC_NAME, "SubclassWindow failed" 307 | End If 308 | 309 | Set m_cFile = New CCASFile 310 | 311 | ' // Update textbox settings from ini file 312 | SetTextboxTheme Settings(SET_THEME) 313 | SetTextboxFontSize Settings(SET_FONT_SIZE) 314 | 315 | ' // Update info about file 316 | UpdateInfo 317 | 318 | Exit Sub 319 | 320 | error_handler: 321 | 322 | ShowCurrentError 323 | 324 | End Sub 325 | 326 | Private Sub Form_QueryUnload( _ 327 | ByRef Cancel As Integer, _ 328 | ByRef UnloadMode As Integer) 329 | 330 | On Error GoTo error_handler 331 | 332 | ' // Try to close current file. It'll show dialog if file was changed 333 | If Not CloseCurrentFile() Then 334 | Cancel = True 335 | End If 336 | 337 | Exit Sub 338 | 339 | error_handler: 340 | 341 | ShowCurrentError 342 | 343 | End Sub 344 | 345 | Private Sub Form_Resize() 346 | 347 | On Error GoTo error_handler 348 | 349 | If Me.WindowState = vbMinimized Then 350 | Exit Sub 351 | End If 352 | 353 | ctlTextBox.Move ctlTextBox.Left, ctlTextBox.Top, Me.ScaleWidth - ctlTextBox.Left * 2, _ 354 | Me.ScaleHeight - ctlTextBox.Top * 2 355 | 356 | Exit Sub 357 | 358 | error_handler: 359 | 360 | ShowCurrentError 361 | 362 | End Sub 363 | 364 | Private Sub Form_Terminate() 365 | 366 | On Error GoTo error_handler 367 | 368 | ' // Remove installed font if it was installed 369 | If m_hFont Then 370 | RemoveFontMemResourceEx m_hFont 371 | End If 372 | 373 | Exit Sub 374 | 375 | error_handler: 376 | 377 | ShowCurrentError 378 | 379 | End Sub 380 | 381 | Private Sub Form_Unload( _ 382 | ByRef Cancel As Integer) 383 | 384 | On Error GoTo error_handler 385 | 386 | UnsubclassWindow Me 387 | 388 | Exit Sub 389 | 390 | error_handler: 391 | 392 | ShowCurrentError 393 | 394 | End Sub 395 | 396 | Private Property Get ISubclass_hWnd() As Long 397 | Const PROC_NAME = "ISubclass_OnWindowProc", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 398 | 399 | On Error GoTo error_handler 400 | 401 | ISubclass_hWnd = Me.hWnd 402 | 403 | Exit Property 404 | 405 | error_handler: 406 | 407 | ThrowCurrentErrorUp FULL_PROC_NAME 408 | 409 | End Property 410 | 411 | Private Function ISubclass_OnWindowProc( _ 412 | ByVal hWnd As Long, _ 413 | ByVal lMsg As Long, _ 414 | ByVal wParam As Long, _ 415 | ByVal lParam As Long, _ 416 | ByRef bDefCall As Boolean) As Long 417 | Const PROC_NAME = "ISubclass_OnWindowProc", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 418 | 419 | On Error GoTo error_handler 420 | 421 | Dim tMinMaxInfo As MINMAXINFO 422 | 423 | Select Case lMsg 424 | ' // Process minimum/maximum size of window 425 | Case WM_GETMINMAXINFO 426 | 427 | memcpy tMinMaxInfo, ByVal lParam, Len(tMinMaxInfo) 428 | 429 | tMinMaxInfo.ptMaxTrackSize.x = Screen.Width / Screen.TwipsPerPixelX 430 | tMinMaxInfo.ptMaxTrackSize.y = Screen.Height / Screen.TwipsPerPixelY 431 | tMinMaxInfo.ptMinTrackSize.x = 320 432 | tMinMaxInfo.ptMinTrackSize.y = 240 433 | 434 | memcpy ByVal lParam, tMinMaxInfo, Len(tMinMaxInfo) 435 | 436 | bDefCall = False 437 | 438 | Case Else 439 | bDefCall = True 440 | End Select 441 | 442 | Exit Function 443 | 444 | error_handler: 445 | 446 | ThrowCurrentErrorUp FULL_PROC_NAME 447 | 448 | End Function 449 | 450 | Private Sub mnuAbout_Click() 451 | 452 | On Error GoTo error_handler 453 | 454 | frmAbout.Show vbModal, Me 455 | 456 | Exit Sub 457 | 458 | error_handler: 459 | 460 | ShowCurrentError 461 | 462 | End Sub 463 | 464 | Private Sub mnuInsertSymbol_Click() 465 | 466 | On Error GoTo error_handler 467 | 468 | frmInsertSymbol.Show vbModeless, Me 469 | 470 | Exit Sub 471 | 472 | error_handler: 473 | 474 | ShowCurrentError 475 | 476 | End Sub 477 | 478 | Private Sub mnuOpen_Click() 479 | Dim sFileName As String 480 | 481 | On Error GoTo error_handler 482 | 483 | If Not CloseCurrentFile Then Exit Sub 484 | 485 | sFileName = GetOpenFile(Me.hWnd, "Open file", "All supported files" & vbNullChar & "*.cas;*.txt;*.bas;*.koi7" & vbNullChar) 486 | If Len(sFileName) = 0 Then Exit Sub 487 | 488 | m_cFile.Load sFileName 489 | 490 | ctlTextBox.Text = m_cFile.Source 491 | 492 | UpdateInfo 493 | 494 | Exit Sub 495 | 496 | error_handler: 497 | 498 | ShowCurrentError 499 | 500 | End Sub 501 | 502 | ' // Save current file 503 | ' // Returns true if successful 504 | Private Function SaveCurrentFile( _ 505 | ByVal bSaveAs As Boolean) As Boolean 506 | Const PROC_NAME = "SaveCurrentFile", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 507 | 508 | Dim sFileName As String 509 | 510 | On Error GoTo err_handler 511 | 512 | m_cFile.Source = ctlTextBox.Text 513 | 514 | ' // Show dialog if this is new file or Save as... menu was selected 515 | If Len(m_cFile.FileName) And Not bSaveAs Then 516 | m_cFile.Save m_cFile.FileName 517 | Else 518 | 519 | sFileName = GetSaveFile(Me.hWnd, "Save file", "CAS files" & vbNullChar & "*.cas" & vbNullChar & _ 520 | "Text files" & vbNullChar & "*.txt" & vbNullChar & _ 521 | "BAS files" & vbNullChar & "*.bas" & vbNullChar & _ 522 | "KOI-7 N2 files" & vbNullChar & "*.koi7" & vbNullChar, _ 523 | "cas", GetFileTitle(m_cFile.FileName)) 524 | If Len(sFileName) = 0 Then Exit Function 525 | 526 | m_cFile.Save sFileName 527 | 528 | End If 529 | 530 | UpdateInfo 531 | 532 | SaveCurrentFile = True 533 | 534 | Exit Function 535 | 536 | err_handler: 537 | 538 | ThrowCurrentErrorUp FULL_PROC_NAME 539 | 540 | End Function 541 | 542 | ' // Show form caption with program name and file name 543 | Private Sub UpdateInfo() 544 | Const PROC_NAME = "UpdateInfo", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 545 | 546 | Dim sFileName As String 547 | 548 | On Error GoTo err_handler 549 | 550 | sFileName = m_cFile.FileName 551 | 552 | If Len(sFileName) Then 553 | sFileName = "(" & sFileName & ")" 554 | End If 555 | 556 | Me.Caption = "VECTOR-06C BASIC converter by The trick " & sFileName 557 | 558 | Exit Sub 559 | 560 | err_handler: 561 | 562 | ThrowCurrentErrorUp FULL_PROC_NAME 563 | 564 | End Sub 565 | 566 | ' // Close current file 567 | ' // If file was changed since last saving it shows Save dialog 568 | ' // Returns true if file can be closed 569 | Private Function CloseCurrentFile() As Boolean 570 | Const PROC_NAME = "CloseCurrentFile", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 571 | 572 | On Error GoTo err_handler 573 | 574 | m_cFile.Source = ctlTextBox.Text 575 | 576 | If m_cFile.Changed Then 577 | Select Case MsgBox("The file was modified. Do you want to save changes?", vbYesNoCancel Or vbQuestion) 578 | Case vbYes 579 | CloseCurrentFile = SaveCurrentFile(False) 580 | Case vbNo 581 | CloseCurrentFile = True 582 | End Select 583 | Else 584 | CloseCurrentFile = True 585 | End If 586 | 587 | Exit Function 588 | 589 | err_handler: 590 | 591 | ThrowCurrentErrorUp FULL_PROC_NAME 592 | 593 | End Function 594 | 595 | Private Sub mnuProgramName_Click() 596 | Dim sProgramName As String 597 | 598 | On Error GoTo err_handler 599 | 600 | sProgramName = InputBox("Enter program name:", , m_cFile.ProgramName) 601 | If StrPtr(sProgramName) = 0 Then Exit Sub 602 | 603 | m_cFile.ProgramName = sProgramName 604 | 605 | Exit Sub 606 | 607 | err_handler: 608 | 609 | ShowCurrentError 610 | 611 | End Sub 612 | 613 | Private Sub mnuQuit_Click() 614 | Unload Me 615 | End Sub 616 | 617 | Private Sub mnuSave_Click() 618 | 619 | On Error GoTo err_handler 620 | 621 | SaveCurrentFile False 622 | 623 | Exit Sub 624 | 625 | err_handler: 626 | 627 | ShowCurrentError 628 | 629 | End Sub 630 | 631 | Private Sub mnuSaveAs_Click() 632 | 633 | On Error GoTo err_handler 634 | 635 | SaveCurrentFile True 636 | 637 | Exit Sub 638 | 639 | err_handler: 640 | 641 | ShowCurrentError 642 | 643 | End Sub 644 | 645 | Private Sub mnuSelectAll_Click() 646 | 647 | On Error GoTo err_handler 648 | 649 | ctlTextBox.SelectAll 650 | 651 | Exit Sub 652 | 653 | err_handler: 654 | 655 | ShowCurrentError 656 | 657 | End Sub 658 | 659 | Private Sub mnuSettings_Click() 660 | Dim cFrm As frmSettings 661 | 662 | On Error GoTo err_handler 663 | 664 | Set cFrm = New frmSettings 665 | 666 | cFrm.Show vbModal 667 | 668 | Exit Sub 669 | 670 | err_handler: 671 | 672 | ShowCurrentError 673 | 674 | End Sub 675 | -------------------------------------------------------------------------------- /sources/forms/frmMain.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/sources/forms/frmMain.frx -------------------------------------------------------------------------------- /sources/forms/frmSettings.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmSettings 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "Settings" 5 | ClientHeight = 1395 6 | ClientLeft = 45 7 | ClientTop = 375 8 | ClientWidth = 3435 9 | Icon = "frmSettings.frx":0000 10 | MaxButton = 0 'False 11 | MinButton = 0 'False 12 | ScaleHeight = 1395 13 | ScaleWidth = 3435 14 | StartUpPosition = 1 'CenterOwner 15 | Begin VB.CommandButton cmdCancel 16 | Cancel = -1 'True 17 | Caption = "Cancel" 18 | Height = 435 19 | Left = 1680 20 | TabIndex = 5 21 | Top = 900 22 | Width = 1275 23 | End 24 | Begin VB.CommandButton cmdOK 25 | Caption = "OK" 26 | Default = -1 'True 27 | Height = 435 28 | Left = 360 29 | TabIndex = 4 30 | Top = 900 31 | Width = 1275 32 | End 33 | Begin VB.ComboBox cboTheme 34 | Height = 315 35 | ItemData = "frmSettings.frx":000C 36 | Left = 960 37 | List = "frmSettings.frx":0019 38 | Style = 2 'Dropdown List 39 | TabIndex = 3 40 | Top = 480 41 | Width = 2235 42 | End 43 | Begin VB.ComboBox cboFontSize 44 | Height = 315 45 | ItemData = "frmSettings.frx":0032 46 | Left = 960 47 | List = "frmSettings.frx":003C 48 | Style = 2 'Dropdown List 49 | TabIndex = 1 50 | Top = 60 51 | Width = 2235 52 | End 53 | Begin VB.Label lblLabel 54 | Caption = "Theme:" 55 | Height = 255 56 | Index = 1 57 | Left = 60 58 | TabIndex = 2 59 | Top = 480 60 | Width = 795 61 | End 62 | Begin VB.Label lblLabel 63 | Caption = "Font size:" 64 | Height = 255 65 | Index = 0 66 | Left = 60 67 | TabIndex = 0 68 | Top = 120 69 | Width = 795 70 | End 71 | End 72 | Attribute VB_Name = "frmSettings" 73 | Attribute VB_GlobalNameSpace = False 74 | Attribute VB_Creatable = False 75 | Attribute VB_PredeclaredId = True 76 | Attribute VB_Exposed = False 77 | ' // 78 | ' // frmSettings.frm - settings form 79 | ' // By The trick 2021 80 | ' // 81 | 82 | Option Explicit 83 | 84 | Private Const MODULE_NAME = "frmSettings" 85 | 86 | Private m_bApply As Boolean ' // If true - save settings 87 | 88 | Private Sub cboFontSize_Click() 89 | Const PROC_NAME = "cboFontSize_Click", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 90 | 91 | Dim eSize As eFontSize 92 | 93 | On Error GoTo error_handler 94 | 95 | Select Case cboFontSize.ListIndex 96 | Case 0: eSize = FS_SMALL 97 | Case 1: eSize = FS_LARGE 98 | End Select 99 | 100 | frmMain.SetTextboxFontSize eSize 101 | 102 | Exit Sub 103 | 104 | error_handler: 105 | 106 | ShowCurrentError 107 | 108 | End Sub 109 | 110 | Private Sub cboTheme_Click() 111 | Const PROC_NAME = "cboTheme_Click", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 112 | 113 | Dim eTheme As eTheme 114 | 115 | On Error GoTo error_handler 116 | 117 | Select Case cboTheme.ListIndex 118 | Case 0: eTheme = T_WIN 119 | Case 1: eTheme = T_DARK 120 | Case 2: eTheme = T_SOFT 121 | End Select 122 | 123 | frmMain.SetTextboxTheme eTheme 124 | 125 | Exit Sub 126 | 127 | error_handler: 128 | 129 | ShowCurrentError 130 | 131 | End Sub 132 | 133 | Private Sub cmdCancel_Click() 134 | Unload Me 135 | End Sub 136 | 137 | Private Sub cmdOK_Click() 138 | m_bApply = True 139 | Unload Me 140 | End Sub 141 | 142 | Private Sub Form_Load() 143 | Const PROC_NAME = "Form_Load", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 144 | 145 | Dim lIndex As Long 146 | 147 | On Error GoTo error_handler 148 | 149 | Set Me.Icon = frmMain.Icon 150 | 151 | Select Case Settings(SET_THEME) 152 | Case T_WIN: lIndex = 0 153 | Case T_DARK: lIndex = 1 154 | Case T_SOFT: lIndex = 2 155 | End Select 156 | 157 | cboTheme.ListIndex = lIndex 158 | 159 | Select Case Settings(SET_FONT_SIZE) 160 | Case FS_SMALL: lIndex = 0 161 | Case FS_LARGE: lIndex = 1 162 | End Select 163 | 164 | cboFontSize.ListIndex = lIndex 165 | 166 | Exit Sub 167 | 168 | error_handler: 169 | 170 | ShowCurrentError 171 | 172 | End Sub 173 | 174 | Private Sub Form_Unload( _ 175 | ByRef Cancel As Integer) 176 | Const PROC_NAME = "Form_Unload", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 177 | 178 | Dim eTheme As eTheme 179 | Dim eSize As eFontSize 180 | 181 | On Error GoTo error_handler 182 | 183 | If m_bApply Then 184 | 185 | Select Case cboTheme.ListIndex 186 | Case 0: eTheme = T_WIN 187 | Case 1: eTheme = T_DARK 188 | Case 2: eTheme = T_SOFT 189 | End Select 190 | 191 | Settings(SET_THEME) = eTheme 192 | 193 | Select Case cboFontSize.ListIndex 194 | Case 0: eSize = FS_SMALL 195 | Case 1: eSize = FS_LARGE 196 | End Select 197 | 198 | Settings(SET_FONT_SIZE) = eSize 199 | 200 | Else 201 | 202 | frmMain.SetTextboxTheme Settings(SET_THEME) 203 | frmMain.SetTextboxFontSize Settings(SET_FONT_SIZE) 204 | 205 | End If 206 | 207 | Exit Sub 208 | 209 | error_handler: 210 | 211 | ShowCurrentError 212 | 213 | End Sub 214 | -------------------------------------------------------------------------------- /sources/forms/frmSettings.frx: -------------------------------------------------------------------------------- 1 | lt000WindowsDarkSoft00SmallLarge -------------------------------------------------------------------------------- /sources/modules/modMain.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modMain" 2 | ' // 3 | ' // modMain.bas - startup module with global functions 4 | ' // By The trick 2021 5 | ' // 6 | 7 | Option Explicit 8 | Option Base 0 9 | 10 | Private Const MODULE_NAME = "modMain" 11 | 12 | Public Enum eSettings 13 | SET_THEME ' // Current theme 14 | SET_FONT_SIZE ' // Current font size 15 | End Enum 16 | 17 | Public Enum eTheme 18 | T_WIN 19 | T_DARK 20 | T_SOFT 21 | End Enum 22 | 23 | Public Enum eFontSize 24 | FS_SMALL 25 | FS_LARGE 26 | End Enum 27 | 28 | Public Sub Main() 29 | Const PROC_NAME = "Main", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 30 | 31 | Dim tICC As tagINITCOMMONCONTROLSEX 32 | 33 | On Error GoTo error_handler 34 | 35 | tICC.dwSize = Len(tICC) 36 | tICC.dwICC = ICC_WIN95_CLASSES 37 | 38 | InitCommonControlsEx tICC 39 | 40 | frmMain.Show 41 | 42 | Exit Sub 43 | 44 | error_handler: 45 | 46 | ShowCurrentError 47 | 48 | End Sub 49 | 50 | ' // Show current error message 51 | Public Sub ShowCurrentError() 52 | MsgBox "An error occured 0x" & Hex$(Err.Number) & vbNewLine & "Source: " & Err.Source & _ 53 | vbNewLine & vbNewLine & Err.Description, vbCritical 54 | End Sub 55 | 56 | ' // Throw error 57 | Public Sub ThrowCurrentErrorUp( _ 58 | ByRef sProcName As String) 59 | If StrComp(Err.Source, sProcName, vbTextCompare) = 0 Or Len(Err.Source) = 0 Then 60 | Err.Raise Err.Number, sProcName, Err.Description 61 | Else 62 | Err.Raise Err.Number, sProcName, Err.Source & vbNewLine & Err.Description 63 | End If 64 | End Sub 65 | 66 | ' // Save settings 67 | Public Property Let Settings( _ 68 | ByVal eParam As eSettings, _ 69 | ByVal lValue As Long) 70 | Const PROC_NAME = "Settings_put", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 71 | 72 | Dim sSection As String 73 | Dim sKey As String 74 | Dim sValue As String 75 | 76 | On Error GoTo error_handler 77 | 78 | sSection = "Appearance" 79 | 80 | Select Case eParam 81 | Case SET_THEME 82 | 83 | sKey = "Theme" 84 | 85 | Select Case lValue 86 | Case T_DARK 87 | sValue = "Dark" 88 | Case T_SOFT 89 | sValue = "Soft" 90 | Case Else 91 | sValue = "Windows" 92 | End Select 93 | 94 | Case SET_FONT_SIZE 95 | 96 | sKey = "FontSize" 97 | 98 | Select Case lValue 99 | Case FS_LARGE 100 | sValue = "Large" 101 | Case Else 102 | sValue = "Small" 103 | End Select 104 | 105 | End Select 106 | 107 | If WritePrivateProfileString(sSection, sKey, sValue, App.Path & "\config.ini") = 0 Then 108 | Err.Raise 7, FULL_PROC_NAME, "WritePrivateProfileString failed" 109 | End If 110 | 111 | Exit Property 112 | 113 | error_handler: 114 | 115 | ThrowCurrentErrorUp FULL_PROC_NAME 116 | 117 | End Property 118 | 119 | ' // Load settings 120 | Public Property Get Settings( _ 121 | ByVal eParam As eSettings) As Long 122 | Const PROC_NAME = "Settings_get", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 123 | 124 | Dim sSection As String 125 | Dim sKey As String 126 | Dim sRet As String 127 | Dim lRet As Long 128 | 129 | On Error GoTo error_handler 130 | 131 | sSection = "Appearance" 132 | 133 | Select Case eParam 134 | Case SET_THEME 135 | sKey = "Theme" 136 | Case SET_FONT_SIZE 137 | sKey = "FontSize" 138 | End Select 139 | 140 | sRet = Space$(255) 141 | 142 | lRet = GetPrivateProfileString(sSection, sKey, vbNullString, sRet, Len(sRet), App.Path & "\config.ini") 143 | 144 | If lRet Then 145 | sRet = Left$(sRet, lRet) 146 | Else 147 | sRet = vbNullString 148 | End If 149 | 150 | Select Case eParam 151 | Case SET_THEME 152 | 153 | If StrComp(sRet, "dark", vbTextCompare) = 0 Then 154 | Settings = T_DARK 155 | ElseIf StrComp(sRet, "soft", vbTextCompare) = 0 Then 156 | Settings = T_SOFT 157 | Else 158 | Settings = T_WIN 159 | End If 160 | 161 | Case SET_FONT_SIZE 162 | 163 | If StrComp(sRet, "large", vbTextCompare) = 0 Then 164 | Settings = FS_LARGE 165 | Else 166 | Settings = FS_SMALL 167 | End If 168 | 169 | End Select 170 | 171 | Exit Property 172 | 173 | error_handler: 174 | 175 | ThrowCurrentErrorUp FULL_PROC_NAME 176 | 177 | End Property 178 | 179 | ' // Convert UNICODE text to UNICODE with allowed characters 180 | Public Function FixUnicode( _ 181 | ByRef sValue As String) As String 182 | Const PROC_NAME = "FixUnicode", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 183 | 184 | Dim bKOI() As Byte 185 | 186 | On Error GoTo error_handler 187 | 188 | bKOI = UnicodeToVec6KOI7(sValue) 189 | FixUnicode = Vec6KOI7ToUnicode(bKOI) 190 | 191 | Exit Function 192 | 193 | error_handler: 194 | 195 | ThrowCurrentErrorUp FULL_PROC_NAME 196 | 197 | End Function 198 | 199 | ' // Convert token to keyword or symbol 200 | Public Function Vec6BasicKeyword( _ 201 | ByVal bCode As Byte) As String 202 | Const PROC_NAME = "Vec6BasicKeyword", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 203 | 204 | Static s_sTable() As String 205 | Static s_bInit As Boolean 206 | 207 | Dim bTemp() As Byte 208 | Dim lIndex As Long 209 | Dim lIndex2 As Long 210 | Dim lSize As Long 211 | 212 | On Error GoTo error_handler 213 | 214 | If Not s_bInit Then 215 | 216 | bTemp = LoadResData(100, RT_RCDATA) 217 | 218 | ReDim s_sTable(228) 219 | 220 | For lIndex = 0 To UBound(s_sTable) 221 | 222 | lSize = lstrlenW(bTemp(lIndex2)) 223 | 224 | If lSize = 0 Then 225 | lSize = 1 226 | End If 227 | 228 | s_sTable(lIndex) = Space$(lSize) 229 | memcpy ByVal StrPtr(s_sTable(lIndex)), bTemp(lIndex2), lSize * 2 230 | lIndex2 = lIndex2 + (lSize + 1) * 2 231 | 232 | Next 233 | 234 | s_bInit = True 235 | 236 | End If 237 | 238 | If bCode > 228 Then 239 | Err.Raise 5, FULL_PROC_NAME, "Invalid code" 240 | End If 241 | 242 | Vec6BasicKeyword = s_sTable(bCode) 243 | 244 | Exit Function 245 | 246 | error_handler: 247 | 248 | ThrowCurrentErrorUp FULL_PROC_NAME 249 | 250 | End Function 251 | 252 | ' // Convert native Vector-06C KOI-7 to UNICODE symbols 253 | Public Function Vec6KOI7ToUnicode( _ 254 | ByRef bValue() As Byte) As String 255 | Const PROC_NAME = "Vec6KOI7ToUnicode", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 256 | 257 | Static s_bTable() As Byte 258 | 259 | Dim lCount As Long 260 | Dim bOut() As Byte 261 | Dim lIndex As Long 262 | 263 | On Error GoTo error_handler 264 | 265 | If SACount(ArrPtr(s_bTable)) = 0 Then 266 | s_bTable = LoadResData(101, RT_RCDATA) 267 | End If 268 | 269 | lCount = SACount(ArrPtr(bValue)) 270 | If lCount = 0 Then Exit Function 271 | 272 | ReDim bOut(lCount * 2 - 1) 273 | 274 | For lIndex = 0 To lCount - 1 275 | 276 | If bValue(lIndex) > 127 Then 277 | Err.Raise 5, FULL_PROC_NAME, "Invalid symbol" 278 | End If 279 | 280 | GetMem2 s_bTable(bValue(lIndex) * 2), bOut(lIndex * 2) 281 | 282 | Next 283 | 284 | Vec6KOI7ToUnicode = bOut 285 | 286 | Exit Function 287 | 288 | error_handler: 289 | 290 | ThrowCurrentErrorUp FULL_PROC_NAME 291 | 292 | End Function 293 | 294 | ' // Convert UNICODE string to native Vector-06C KOI-7 295 | Public Function UnicodeToVec6KOI7( _ 296 | ByRef sValue As String) As Byte() 297 | Const PROC_NAME = "UnicodeToVec6KOI7", FULL_PROC_NAME = MODULE_NAME & "::" & PROC_NAME 298 | 299 | Static s_bTable() As Byte 300 | 301 | Dim bRet() As Byte 302 | Dim bIn() As Byte 303 | Dim lIndex As Long 304 | Dim lChar As Long 305 | 306 | On Error GoTo error_handler 307 | 308 | If SACount(ArrPtr(s_bTable)) = 0 Then 309 | s_bTable = LoadResData(102, RT_RCDATA) 310 | End If 311 | 312 | If Len(sValue) = 0 Then Exit Function 313 | 314 | ReDim bRet(Len(sValue) - 1) 315 | 316 | bIn = sValue 317 | 318 | For lIndex = 0 To Len(sValue) - 1 319 | GetMem2 bIn(lIndex * 2), lChar 320 | bRet(lIndex) = s_bTable(lChar) 321 | Next 322 | 323 | UnicodeToVec6KOI7 = bRet 324 | 325 | Exit Function 326 | 327 | error_handler: 328 | 329 | ThrowCurrentErrorUp FULL_PROC_NAME 330 | 331 | End Function 332 | 333 | ' // Save byte array to file 334 | ' // Returns true if successful 335 | Public Function SaveArrayToFile( _ 336 | ByRef sFileName As String, _ 337 | ByRef bData() As Byte) As Boolean 338 | Dim hFile As Long 339 | Dim lSize As Long 340 | Dim lWritten As Long 341 | 342 | hFile = CreateFile(sFileName, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) 343 | 344 | If hFile = INVALID_HANDLE_VALUE Then 345 | Exit Function 346 | End If 347 | 348 | lSize = SACount(ArrPtr(bData)) 349 | 350 | If lSize > 0 Then 351 | 352 | If WriteFile(hFile, bData(0), lSize, lWritten, ByVal 0&) = 0 Then 353 | GoTo CleanUp 354 | End If 355 | 356 | If lSize <> lWritten Then 357 | GoTo CleanUp 358 | End If 359 | 360 | End If 361 | 362 | SaveArrayToFile = True 363 | 364 | CleanUp: 365 | 366 | CloseHandle hFile 367 | 368 | End Function 369 | 370 | ' // Load byte array from file 371 | ' // Returns true if successful 372 | ' // lSize receives the size of loaded data 373 | Public Function LoadFileToArray( _ 374 | ByRef sFileName As String, _ 375 | ByRef bData() As Byte, _ 376 | ByRef lSize As Long) As Boolean 377 | Dim hFile As Long 378 | Dim liSize As LARGE_INTEGER 379 | Dim lRead As Long 380 | 381 | hFile = CreateFile(sFileName, GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) 382 | 383 | If hFile = INVALID_HANDLE_VALUE Then 384 | Exit Function 385 | End If 386 | 387 | If GetFileSizeEx(hFile, liSize) = 0 Then 388 | GoTo CleanUp 389 | End If 390 | 391 | If liSize.HighPart <> 0 Or liSize.LowPart < 0 Or liSize.LowPart > &H6400000 Then 392 | GoTo CleanUp 393 | End If 394 | 395 | ReDim bData(liSize.LowPart - 1) 396 | 397 | If ReadFile(hFile, bData(0), liSize.LowPart, lRead, ByVal 0&) = 0 Then 398 | GoTo CleanUp 399 | End If 400 | 401 | If lRead <> liSize.LowPart Then 402 | GoTo CleanUp 403 | End If 404 | 405 | lSize = lRead 406 | 407 | LoadFileToArray = True 408 | 409 | CleanUp: 410 | 411 | CloseHandle hFile 412 | 413 | End Function 414 | 415 | ' // Get file extenstion 416 | Public Function GetFileExtension( _ 417 | ByRef sPath As String) As String 418 | Dim pExt As Long 419 | 420 | pExt = PathFindExtension(ByVal StrPtr(sPath)) 421 | 422 | GetFileExtension = Mid$(sPath, (pExt - StrPtr(sPath)) \ 2 + 1) 423 | 424 | End Function 425 | 426 | ' // Get file title (only filename without extension) 427 | Public Function GetFileTitle( _ 428 | ByRef sPath As String) As String 429 | Dim pExt As Long 430 | Dim pName As Long 431 | 432 | pName = PathFindFileName(sPath) 433 | pExt = PathFindExtension(ByVal pName) 434 | 435 | GetFileTitle = Mid$(sPath, (pName - StrPtr(sPath)) \ 2 + 1, (pExt - pName) \ 2) 436 | 437 | End Function 438 | 439 | ' // OpenFileName dialog 440 | Public Function GetOpenFile( _ 441 | ByVal hWnd As Long, _ 442 | ByRef sTitle As String, _ 443 | ByRef sFilter As String, _ 444 | Optional ByRef sDefFileNameDir As String) As String 445 | Dim tOFN As OPENFILENAME 446 | Dim strInputFile As String 447 | Dim sDefDir As String 448 | 449 | With tOFN 450 | 451 | .nMaxFile = 260 452 | strInputFile = String$(.nMaxFile, vbNullChar) 453 | 454 | If Len(sDefFileNameDir) Then 455 | 456 | memcpy ByVal StrPtr(strInputFile), ByVal StrPtr(sDefFileNameDir), LenB(sDefFileNameDir) 457 | sDefDir = sDefFileNameDir 458 | PathRemoveFileSpec sDefDir 459 | .lpstrInitialDir = StrPtr(sDefDir) 460 | 461 | End If 462 | 463 | .hwndOwner = hWnd 464 | .lpstrTitle = StrPtr(sTitle) 465 | .lpstrFile = StrPtr(strInputFile) 466 | .lStructSize = Len(tOFN) 467 | .lpstrFilter = StrPtr(sFilter) 468 | 469 | If GetOpenFileName(tOFN) = 0 Then Exit Function 470 | 471 | GetOpenFile = Left$(strInputFile, InStr(1, strInputFile, vbNullChar) - 1) 472 | 473 | End With 474 | 475 | End Function 476 | 477 | ' // Show save file name dialog 478 | Public Function GetSaveFile( _ 479 | ByVal hWnd As Long, _ 480 | ByRef sTitle As String, _ 481 | ByRef sFilter As String, _ 482 | ByRef sDefExtension As String, _ 483 | Optional ByRef sDefFileName As String) As String 484 | Dim tOFN As OPENFILENAME 485 | Dim strOutputFile As String 486 | Dim sDefDir As String 487 | 488 | With tOFN 489 | 490 | .nMaxFile = 260 491 | strOutputFile = String$(.nMaxFile, vbNullChar) 492 | 493 | If Len(sDefFileName) Then 494 | 495 | memcpy ByVal StrPtr(strOutputFile), ByVal StrPtr(sDefFileName), LenB(sDefFileName) 496 | sDefDir = sDefFileName 497 | PathRemoveFileSpec sDefDir 498 | .lpstrInitialDir = StrPtr(sDefDir) 499 | 500 | End If 501 | 502 | .hwndOwner = hWnd 503 | .lpstrTitle = StrPtr(sTitle) 504 | .lpstrFile = StrPtr(strOutputFile) 505 | .lStructSize = Len(tOFN) 506 | .lpstrFilter = StrPtr(sFilter) 507 | .lpstrDefExt = StrPtr(sDefExtension) 508 | .nFilterIndex = 1 509 | .flags = OFN_EXPLORER Or _ 510 | OFN_ENABLESIZING Or OFN_NOREADONLYRETURN Or OFN_PATHMUSTEXIST Or _ 511 | OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT 512 | 513 | If GetSaveFileName(tOFN) = 0 Then Exit Function 514 | 515 | GetSaveFile = Left$(strOutputFile, InStr(1, strOutputFile, vbNullChar) - 1) 516 | 517 | End With 518 | 519 | End Function 520 | 521 | 522 | 523 | -------------------------------------------------------------------------------- /sources/modules/modSubclass.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modSubclass" 2 | ' // 3 | ' // modSubclass.bas - module implements windows-subclassing logic 4 | ' // By The trick 2021 5 | ' // 6 | 7 | Option Explicit 8 | 9 | Private Const MODULE_NAME = "modSubclass" 10 | 11 | ' // Subclass a window. Returns true if successful 12 | Public Function SubclassWindow( _ 13 | ByVal cObj As ISubclass) As Boolean 14 | SubclassWindow = SetWindowSubclass(cObj.hWnd, AddressOf SubclassWndProc, 1, ByVal ObjPtr(cObj)) 15 | End Function 16 | 17 | ' // Unsubclass a window. Returns true if successful 18 | Public Function UnsubclassWindow( _ 19 | ByVal cObj As ISubclass) As Boolean 20 | UnsubclassWindow = RemoveWindowSubclass(cObj.hWnd, AddressOf SubclassWndProc, 1) 21 | End Function 22 | 23 | ' // Main subclass procedure. 24 | Private Function SubclassWndProc( _ 25 | ByVal hWnd As Long, _ 26 | ByVal lMsg As Long, _ 27 | ByVal wParam As Long, _ 28 | ByVal lParam As Long, _ 29 | ByVal uIdSubclass As Long, _ 30 | ByVal dwRefData As Long) As Long 31 | Dim cObject As ISubclass 32 | Dim bDefCall As Boolean 33 | 34 | On Error GoTo unsubclass 35 | 36 | If dwRefData Then 37 | 38 | vbaObjSetAddref cObject, ByVal dwRefData 39 | SubclassWndProc = cObject.OnWindowProc(hWnd, lMsg, wParam, lParam, bDefCall) 40 | 41 | Else 42 | bDefCall = True 43 | End If 44 | 45 | If bDefCall Then 46 | SubclassWndProc = DefSubclassProc(hWnd, lMsg, wParam, ByVal lParam) 47 | End If 48 | 49 | Exit Function 50 | 51 | unsubclass: 52 | 53 | UnsubclassByHwnd hWnd 54 | 55 | End Function 56 | 57 | Private Sub UnsubclassByHwnd( _ 58 | ByVal hWnd As Long) 59 | RemoveWindowSubclass hWnd, AddressOf SubclassWndProc, 1 60 | End Sub 61 | 62 | -------------------------------------------------------------------------------- /sources/modules/modWinApi.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modWinapi" 2 | ' // 3 | ' // modWinapi.bas - common procedures. Before it was module with WINAPI declarations. 4 | ' // By The trick 2021 5 | ' // 6 | 7 | Option Explicit 8 | 9 | ' // Return number of elements in array 10 | Public Function SACount( _ 11 | ByVal ppSA As Long) As Long 12 | Dim tSA As SAFEARRAY 13 | Dim pBound As Long 14 | Dim tBound As SAFEARRAYBOUND 15 | 16 | If ppSA = 0 Then Exit Function 17 | 18 | GetMem4 ByVal ppSA, ppSA 19 | 20 | If ppSA = 0 Then Exit Function 21 | 22 | memcpy tSA, ByVal ppSA, Len(tSA) 23 | 24 | pBound = ppSA + Len(tSA) 25 | SACount = 1 26 | 27 | Do While tSA.cDims > 0 28 | 29 | memcpy tBound, ByVal pBound, Len(tBound) 30 | 31 | SACount = SACount * tBound.cElements 32 | pBound = pBound + Len(tBound) 33 | tSA.cDims = tSA.cDims - 1 34 | 35 | Loop 36 | 37 | End Function 38 | 39 | -------------------------------------------------------------------------------- /sources/tables/BASIC_KEYWORDS.asm: -------------------------------------------------------------------------------- 1 | 2 | du 0x0000, 0, 0x263a, 0, 0x263b, 0, 0x2665, 0, 0x2666, 0, 0x2663, 0, 0x2660, 0, 0x266a, 0 3 | du 0x25d8, 0, 0x25ab, 0, 0x000a, 0, 0x260c, 0, 0x2640, 0, 0x000d, 0, 0x266c, 0, 0x263c, 0 4 | du 0x25b6, 0, 0x25c0, 0, 0x2195, 0, 0x203c, 0, 0x03c0, 0, 0x00a7, 0, 0x2582, 0, 0x21de, 0 5 | du 0x2191, 0, 0x2193, 0, 0x2192, 0, 0x2190, 0, 0x02fe, 0, 0x2194, 0, 0x23f6, 0, 0x23f7, 0 6 | 7 | du ' ', 0, '!', 0, '"', 0, '#', 0, 0xA4, 0, '%', 0, '&', 0, "'", 0 8 | du '(', 0, ')', 0, '*', 0, '+', 0, ',', 0, '-', 0, '.', 0, '/', 0 9 | du '0', 0, '1', 0, '2', 0, '3', 0, '4', 0, '5', 0, '6', 0, '7', 0 10 | du '8', 0, '9', 0, ':', 0, ';', 0, '<', 0, '=', 0, '>', 0, '?', 0 11 | du '@', 0, 'A', 0, 'B', 0, 'C', 0, 'D', 0, 'E', 0, 'F', 0, 'G', 0 12 | du 'H', 0, 'I', 0, 'J', 0, 'K', 0, 'L', 0, 'M', 0, 'N', 0, 'O', 0 13 | du 'P', 0, 'Q', 0, 'R', 0, 'S', 0, 'T', 0, 'U', 0, 'V', 0, 'W', 0 14 | du 'X', 0, 'Y', 0, 'Z', 0, '[', 0, '\', 0, ']', 0, '^', 0, '_', 0 15 | du 0x42E, 0, 0x410, 0, 0x411, 0, 0x426, 0, 0x414, 0, 0x415, 0, 0x424, 0 16 | du 0x413, 0, 0x425, 0, 0x418, 0, 0x419, 0, 0x41A, 0, 0x41B, 0, 0x41C, 0 17 | du 0x41D, 0, 0x41E, 0, 0x41F, 0, 0x42F, 0, 0x420, 0, 0x421, 0, 0x422, 0 18 | du 0x423, 0, 0x416, 0, 0x412, 0, 0x42C, 0, 0x42B, 0, 0x417, 0, 0x428, 0 19 | du 0x42D, 0, 0x429, 0, 0x427, 0, 0x25A0, 0, 'CLS', 0, 'FOR', 0, 'NEXT', 0 20 | du 'DATA', 0, 'INPUT', 0, 'DIM', 0, 'READ', 0, 'CUR', 0, 'GOTO', 0 21 | du 'RUN', 0, 'IF', 0, 'RESTORE', 0, 'GOSUB', 0, 'RETURN', 0, 'REM', 0 22 | du 'STOP', 0, 'OUT', 0, 'ON', 0, 'PLOT', 0, 'LINE', 0, 'POKE', 0 23 | du 'PRINT', 0, 'DEF', 0, 'CONT', 0, 'LIST', 0, 'CLEAR', 0, 'CLOAD', 0 24 | du 'CSAVE', 0, 'NEW', 0, 'TAB(', 0, 'TO', 0, 'SPC(', 0, 'FN', 0 25 | du 'THEN', 0, 'NOT', 0, 'STEP', 0, '+', 0, '-', 0, '*', 0, '/', 0 26 | du '^', 0, 'AND', 0, 'OR', 0, '>', 0, '=', 0, '<', 0, 'SGN', 0, 'INT', 0 27 | du 'ABS', 0, 'USR', 0, 'FRE', 0, 'INP', 0, 'POS', 0, 'SQR', 0, 'RND', 0 28 | du 'LOG', 0, 'EXP', 0, 'COS', 0, 'SIN', 0, 'TAN', 0, 'ATN', 0, 'PEEK', 0 29 | du 'LEN', 0, 'STR', 0xA4, 0, 'VAL', 0, 'ASC', 0, 'CHR', 0xA4, 0, 'LEFT', 0xA4, 0 30 | du 'RIGHT', 0xA4, 0, 'MID', 0xA4, 0, 'POINT', 0, 'INKEY', 0xA4, 0, 'AT', 0, '&', 0 31 | du 'BEEP', 0, 'PAUSE', 0, 'VERIFY', 0, 'HOME', 0, 'EDIT', 0, 'DELETE', 0 32 | du 'MERGE', 0, 'AUTO', 0, 'HIMEM', 0, '@', 0, 'ASN', 0, 'ADDR', 0 33 | du 'PI', 0, 'RENUM', 0, 'ACS', 0, 'LG', 0, 'LPRINT', 0, 'LLIST', 0 34 | du 'SCREEN', 0, 'COLOR', 0, 'GET', 0, 'PUT', 0, 'BSAVE', 0, 'BLOAD', 0 35 | du 'PLAY', 0, 'PAINT', 0, 'CIRCLE', 0 -------------------------------------------------------------------------------- /sources/tables/KOI72UNICODE.asm: -------------------------------------------------------------------------------- 1 | ; FASM 2 | ; Unicode translation table 3 | ; This table maps 0 - 127 symbols to unicode 4 | 5 | du 0x0000, 0x263a, 0x263b, 0x2665, 0x2666, 0x2663, 0x2660, 0x266a 6 | du 0x25d8, 0x25ab, 0x000a, 0x260c, 0x2640, 0x000d, 0x266c, 0x263c 7 | du 0x25b6, 0x25c0, 0x2195, 0x203c, 0x03c0, 0x00a7, 0x2582, 0x21de 8 | du 0x2191, 0x2193, 0x2192, 0x2190, 0x02fe, 0x2194, 0x23f6, 0x23f7 9 | 10 | du 0x0020, 0x0021, 0x0022, 0x0023, 0x00a4, 0x0025, 0x0026, 0x0027 11 | du 0x0028, 0x0029, 0x002A, 0x002B, 0x002C, 0x002D, 0x002E, 0x002F 12 | du 0x0030, 0x0031, 0x0032, 0x0033, 0x0034, 0x0035, 0x0036, 0x0037 13 | du 0x0038, 0x0039, 0x003A, 0x003B, 0x003C, 0x003D, 0x003E, 0x003F 14 | du 0x0040, 0x0041, 0x0042, 0x0043, 0x0044, 0x0045, 0x0046, 0x0047 15 | du 0x0048, 0x0049, 0x004A, 0x004B, 0x004C, 0x004D, 0x004E, 0x004F 16 | du 0x0050, 0x0051, 0x0052, 0x0053, 0x0054, 0x0055, 0x0056, 0x0057 17 | du 0x0058, 0x0059, 0x005A, 0x005B, 0x005C, 0x005D, 0x005E, 0x005F 18 | 19 | du 0x042E, 0x0410, 0x0411, 0x0426, 0x0414, 0x0415, 0x0424, 0x0413 20 | du 0x0425, 0x0418, 0x0419, 0x041A, 0x041B, 0x041C, 0x041D, 0x041E 21 | du 0x041F, 0x042F, 0x0420, 0x0421, 0x0422, 0x0423, 0x0416, 0x0412 22 | du 0x042C, 0x042B, 0x0417, 0x0428, 0x042D, 0x0429, 0x0427, 0x2b1b 23 | 24 | 25 | -------------------------------------------------------------------------------- /sources/tables/UNICODE2KOI7.asm: -------------------------------------------------------------------------------- 1 | 2 | ; FASM 3 | ; Unicode to VECTOR-06C KOI7 translation table 4 | 5 | ; Fill ascending values at specified offset 6 | macro fill_inc initval, start, count { 7 | repeat count 8 | store byte % - 1 + initval at % - 1 + start 9 | end repeat 10 | } 11 | 12 | ; Put values at specified offset 13 | macro put start, [args] { 14 | common 15 | local c 16 | c = 0 17 | forward 18 | store byte args at start + c 19 | c = c + 1 20 | } 21 | 22 | ; Put value at specified offsets 23 | macro put_multiple value, [start*] { 24 | forward 25 | store byte value at start 26 | } 27 | 28 | ; Fill all range with spaces 29 | repeat 65536 30 | db ' ' 31 | end repeat 32 | 33 | ; Modify needed values 34 | fill_inc 0, 0, 0x60 35 | put 0x60, ' ' 36 | fill_inc 'A', 'a', 26 37 | put 0x7b, ' ', ' ', ' ', ' ', 0x7f 38 | put 0xa4, '$' 39 | 40 | ; Cyrillic 41 | put 0x410, 'a', 'b', 'w', 'g', 'd', 'e', 'v', 'z', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', \ 42 | 'r', 's', 't', 'u', 'f', 'h', 'c', '~', '{', '}', 'x', 'y', 'x', '|', '`', 'q' 43 | put 0x430, 'a', 'b', 'w', 'g', 'd', 'e', 'v', 'z', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', \ 44 | 'r', 's', 't', 'u', 'f', 'h', 'c', '~', '{', '}', 'x', 'y', 'x', '|', '`', 'q' 45 | put 0x263a, 1, 2 ; Smiles 46 | put_multiple 3, 0x2665, 0x2764, 0x2661 ; Heart 47 | put_multiple 4, 0x25C6, 0x2666, 0x25C7, 0x2662, 0x2BC1 ; Diamond 48 | put_multiple 5, 0x2663, 0x2667 ; Club suit 49 | put_multiple 6, 0x2660, 0x2664 ; Spade suit 50 | put_multiple 7, 0x2669, 0x266A ; Note 51 | put 0x25d8, 8 52 | put_multiple 9, 0x25AA, 0x25AB ; Rect 53 | put_multiple 11, 0x260C, 0x2642 ; Conjunction/male 54 | put 0x2640, 12 ; Female 55 | put_multiple 14, 0x266C, 0x266B ; Beamed Sixteenth Notes 56 | put_multiple 15, 0x263C, 0x2638, 0x2699, 0x26ED ; Sun / Gear 57 | put_multiple 16, 0x23F5, 0x25B6, 0x25B7, 0x25B8, 0x25B9, 0x2BC8 ; Right-Pointing Triangle 58 | put_multiple 17, 0x23F4, 0x25C0, 0x25C1, 0x25C2, 0x25C3, 0x2BC7 ; Left-Pointing Triangle 59 | put_multiple 18, 0x2195, 0x21D5, 0x21F3, 0x2B0D, 0x2B65 ; Up Down Arrow 60 | put 0x203c, 19 ; Double Exclamation Mark 61 | put_multiple 20, 0x3C0, 0x213C ; PI 62 | put 0xa7, 21 ; Section 63 | put_multiple 22, 0x2582, 0x2583, 0x2584 ; Lower block 64 | put_multiple 23, 0x21DE, 0x21EF ; Upwards Arrow with Double Stroke 65 | put_multiple 24, 0x2191, 0x21d1, 0x21e7, 0x2b06, 0x2b61 ; Up Arrow 66 | put_multiple 25, 0x2193, 0x21d3, 0x21e9, 0x2b07, 0x2b63 ; Down Arrow 67 | put_multiple 26, 0x2192, 0x21d2, 0x21e8, 0x2b95, 0x2b62 ; Right Arrow 68 | put_multiple 27, 0x2190, 0x21d0, 0x21e6, 0x2b05, 0x2b60 ; Left Arrow 69 | put 0x02fe, 28 ; Righthand Interior Product 70 | put_multiple 29, 0x20E1, 0x2194, 0x21D4, 0x21FF, 0x27F7, 0x27FA, 0x2B0C ; Left Right Arrow 71 | put_multiple 30, 0x23f6, 0x25b2, 0x25b3, 0x25b4, 0x25b5, 0x2bc5, 0x2616, 0x2617 ; Shogi Piece / Up Triangle 72 | put_multiple 31, 0x23f7, 0x25bc, 0x25bd, 0x25be, 0x25bf, 0x2bc6 ; Down Triangle 73 | put_multiple 127, 0x2B1B, 0x2BC0, 0x25AA, 0x25a0, 0x25FE, 0x2588, 0x2589 ;Black Square -------------------------------------------------------------------------------- /sources/tables/compile.bat: -------------------------------------------------------------------------------- 1 | fasm.exe BASIC_KEYWORDS.asm ..\..\resources\BASIC_KEYWORDS.bin 2 | fasm.exe KOI72UNICODE.asm ..\..\resources\KOI72UNICODE.bin 3 | fasm.exe UNICODE2KOI7.asm ..\..\resources\UNICODE2KOI7.bin 4 | pause -------------------------------------------------------------------------------- /typelib/Vec06BAsConv.idl: -------------------------------------------------------------------------------- 1 | [ 2 | uuid(A8344850-343E-42F5-AAD1-4B041A94C8D4), 3 | version(1.00), 4 | helpstring("Vector-06C BASIC converter type library by The trick") 5 | ] 6 | library vec06basconv_tlb { 7 | 8 | importlib("stdole2.tlb"); 9 | 10 | #include "kernel32.inc" 11 | #include "gdi32.inc" 12 | #include "user32.inc" 13 | #include "comctl32.inc" 14 | #include "comdlg32.inc" 15 | #include "advapi32.inc" 16 | #include "oleaut32.inc" 17 | #include "shlwapi.inc" 18 | #include "msvbvm60.inc" 19 | #include "subclass.inc" 20 | } -------------------------------------------------------------------------------- /typelib/Vec06BAsConv.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vector06C-Basic-Converter/9d13d4e4da5a5211ebe8fd9e7540718820fd0651/typelib/Vec06BAsConv.tlb -------------------------------------------------------------------------------- /typelib/advapi32.inc: -------------------------------------------------------------------------------- 1 | typedef enum IS_TEXT_UNICODE_FLAGS { 2 | IS_TEXT_UNICODE_ASCII16 = 0x0001, 3 | IS_TEXT_UNICODE_REVERSE_ASCII16 = 0x0010, 4 | IS_TEXT_UNICODE_STATISTICS = 0x0002, 5 | IS_TEXT_UNICODE_REVERSE_STATISTICS = 0x0020, 6 | IS_TEXT_UNICODE_CONTROLS = 0x0004, 7 | IS_TEXT_UNICODE_REVERSE_CONTROLS = 0x0040, 8 | IS_TEXT_UNICODE_SIGNATURE = 0x0008, 9 | IS_TEXT_UNICODE_REVERSE_SIGNATURE = 0x0080, 10 | IS_TEXT_UNICODE_ILLEGAL_CHARS = 0x0100, 11 | IS_TEXT_UNICODE_ODD_LENGTH = 0x0200, 12 | IS_TEXT_UNICODE_DBCS_LEADBYTE = 0x0400, 13 | IS_TEXT_UNICODE_NULL_BYTES = 0x1000, 14 | IS_TEXT_UNICODE_UNICODE_MASK = 0x000F, 15 | IS_TEXT_UNICODE_REVERSE_MASK = 0x00F0, 16 | IS_TEXT_UNICODE_NOT_UNICODE_MASK = 0x0F00, 17 | IS_TEXT_UNICODE_NOT_ASCII_MASK = 0xF000 18 | } IS_TEXT_UNICODE_FLAGS; 19 | 20 | [dllname("ADVAPI32.DLL")] 21 | module advapi32 { 22 | 23 | [entry("IsTextUnicode")] 24 | long IsTextUnicode( 25 | [in] void* lpBuffer, 26 | [in] long cb, 27 | [in] IS_TEXT_UNICODE_FLAGS *lpi 28 | ); 29 | 30 | } -------------------------------------------------------------------------------- /typelib/comctl32.inc: -------------------------------------------------------------------------------- 1 | typedef enum ICC_CONSTANTS { 2 | ICC_LISTVIEW_CLASSES = 0x00000001, // listview, header 3 | ICC_TREEVIEW_CLASSES = 0x00000002, // treeview, tooltips 4 | ICC_BAR_CLASSES = 0x00000004, // toolbar, statusbar, trackbar, tooltips 5 | ICC_TAB_CLASSES = 0x00000008, // tab, tooltips 6 | ICC_UPDOWN_CLASS = 0x00000010, // updown 7 | ICC_PROGRESS_CLASS = 0x00000020, // progress 8 | ICC_HOTKEY_CLASS = 0x00000040, // hotkey 9 | ICC_ANIMATE_CLASS = 0x00000080, // animate 10 | ICC_WIN95_CLASSES = 0x000000FF, 11 | ICC_DATE_CLASSES = 0x00000100, // month picker, date picker, time picker, updown 12 | ICC_USEREX_CLASSES = 0x00000200, // comboex 13 | ICC_COOL_CLASSES = 0x00000400, // rebar (coolbar) control 14 | ICC_INTERNET_CLASSES = 0x00000800, 15 | ICC_PAGESCROLLER_CLASS = 0x00001000, // page scroller 16 | ICC_NATIVEFNTCTL_CLASS = 0x00002000, // native font control 17 | ICC_STANDARD_CLASSES = 0x00004000, 18 | ICC_LINK_CLASS = 0x00008000 19 | } ICC_CONSTANTS; 20 | 21 | typedef struct tagINITCOMMONCONTROLSEX { 22 | long dwSize; 23 | ICC_CONSTANTS dwICC; 24 | } tagINITCOMMONCONTROLSEX; 25 | 26 | [dllname("COMCTL32.DLL")] 27 | module comctl32 { 28 | 29 | [entry("InitCommonControlsEx")] 30 | long InitCommonControlsEx( 31 | [in] tagINITCOMMONCONTROLSEX* tICC 32 | ); 33 | 34 | [entry("SetWindowSubclass")] 35 | long SetWindowSubclass( 36 | [in] long hwnd, 37 | [in] long pfnSubclass, 38 | [in] long uIdSubclass, 39 | [in] void* dwRefData 40 | ); 41 | 42 | [entry("RemoveWindowSubclass")] 43 | long RemoveWindowSubclass( 44 | [in] long hwnd, 45 | [in] long pfnSubclass, 46 | [in] long uIdSubclass 47 | ); 48 | 49 | [entry("DefSubclassProc")] 50 | long DefSubclassProc( 51 | [in] long hwnd, 52 | [in] long uMsg, 53 | [in] long wParam, 54 | [in] void* lParam 55 | ); 56 | 57 | } 58 | 59 | #include "edit_ctl.inc" -------------------------------------------------------------------------------- /typelib/comdlg32.inc: -------------------------------------------------------------------------------- 1 | typedef enum OFN_FLAGS { 2 | OFN_READONLY = 0x00000001, 3 | OFN_OVERWRITEPROMPT = 0x00000002, 4 | OFN_HIDEREADONLY = 0x00000004, 5 | OFN_NOCHANGEDIR = 0x00000008, 6 | OFN_SHOWHELP = 0x00000010, 7 | OFN_ENABLEHOOK = 0x00000020, 8 | OFN_ENABLETEMPLATE = 0x00000040, 9 | OFN_ENABLETEMPLATEHANDLE = 0x00000080, 10 | OFN_NOVALIDATE = 0x00000100, 11 | OFN_ALLOWMULTISELECT = 0x00000200, 12 | OFN_EXTENSIONDIFFERENT = 0x00000400, 13 | OFN_PATHMUSTEXIST = 0x00000800, 14 | OFN_FILEMUSTEXIST = 0x00001000, 15 | OFN_CREATEPROMPT = 0x00002000, 16 | OFN_SHAREAWARE = 0x00004000, 17 | OFN_NOREADONLYRETURN = 0x00008000, 18 | OFN_NOTESTFILECREATE = 0x00010000, 19 | OFN_NONETWORKBUTTON = 0x00020000, 20 | OFN_NOLONGNAMES = 0x00040000, 21 | OFN_EXPLORER = 0x00080000, 22 | OFN_NODEREFERENCELINKS = 0x00100000, 23 | OFN_LONGNAMES = 0x00200000, 24 | OFN_ENABLEINCLUDENOTIFY = 0x00400000, 25 | OFN_ENABLESIZING = 0x00800000, 26 | OFN_DONTADDTORECENT = 0x02000000, 27 | OFN_FORCESHOWHIDDEN = 0x10000000 28 | } OFN_FLAGS; 29 | 30 | typedef struct OPENFILENAME { 31 | long lStructSize; 32 | long hwndOwner; 33 | long hInstance; 34 | long lpstrFilter; 35 | long lpstrCustomFilter; 36 | long nMaxCustFilter; 37 | long nFilterIndex; 38 | long lpstrFile; 39 | long nMaxFile; 40 | long lpstrFileTitle; 41 | long nMaxFileTitle; 42 | long lpstrInitialDir; 43 | long lpstrTitle; 44 | OFN_FLAGS flags; 45 | short nFileOffset; 46 | short nFileExtension; 47 | long lpstrDefExt; 48 | long lCustData; 49 | long lpfnHook; 50 | long lpTemplateName; 51 | } OPENFILENAME; 52 | 53 | [dllname("COMDLG32.DLL")] 54 | module comdlg32 { 55 | 56 | [entry("GetOpenFileNameW")] 57 | long GetOpenFileName( 58 | [in] OPENFILENAME* pOpenfilename 59 | ); 60 | 61 | [entry("GetSaveFileNameW")] 62 | long GetSaveFileName( 63 | [in] OPENFILENAME* pOpenfilename 64 | ); 65 | 66 | } 67 | -------------------------------------------------------------------------------- /typelib/compile.bat: -------------------------------------------------------------------------------- 1 | midl.exe Vec06BAsConv.idl 2 | pause 3 | -------------------------------------------------------------------------------- /typelib/edit_ctl.inc: -------------------------------------------------------------------------------- 1 | typedef enum EDITCTL_STYLES { 2 | ES_LEFT = 0x0000, 3 | ES_CENTER = 0x0001, 4 | ES_RIGHT = 0x0002, 5 | ES_MULTILINE = 0x0004, 6 | ES_UPPERCASE = 0x0008, 7 | ES_LOWERCASE = 0x0010, 8 | ES_PASSWORD = 0x0020, 9 | ES_AUTOVSCROLL = 0x0040, 10 | ES_AUTOHSCROLL = 0x0080, 11 | ES_NOHIDESEL = 0x0100, 12 | ES_OEMCONVERT = 0x0400, 13 | ES_READONLY = 0x0800, 14 | ES_WANTRETURN = 0x1000, 15 | ES_NUMBER = 0x2000 16 | } EDITCTL_STYLES; 17 | 18 | typedef enum EDITCTL_MESSAGES { 19 | EM_GETSEL = 0x00B0, 20 | EM_SETSEL = 0x00B1, 21 | EM_GETRECT = 0x00B2, 22 | EM_SETRECT = 0x00B3, 23 | EM_SETRECTNP = 0x00B4, 24 | EM_SCROLL = 0x00B5, 25 | EM_LINESCROLL = 0x00B6, 26 | EM_SCROLLCARET = 0x00B7, 27 | EM_GETMODIFY = 0x00B8, 28 | EM_SETMODIFY = 0x00B9, 29 | EM_GETLINECOUNT = 0x00BA, 30 | EM_LINEINDEX = 0x00BB, 31 | EM_SETHANDLE = 0x00BC, 32 | EM_GETHANDLE = 0x00BD, 33 | EM_GETTHUMB = 0x00BE, 34 | EM_LINELENGTH = 0x00C1, 35 | EM_REPLACESEL = 0x00C2, 36 | EM_GETLINE = 0x00C4, 37 | EM_LIMITTEXT = 0x00C5, 38 | EM_CANUNDO = 0x00C6, 39 | EM_UNDO = 0x00C7, 40 | EM_FMTLINES = 0x00C8, 41 | EM_LINEFROMCHAR = 0x00C9, 42 | EM_SETTABSTOPS = 0x00CB, 43 | EM_SETPASSWORDCHAR = 0x00CC, 44 | EM_EMPTYUNDOBUFFER = 0x00CD, 45 | EM_GETFIRSTVISIBLELINE = 0x00CE, 46 | EM_SETREADONLY = 0x00CF, 47 | EM_SETWORDBREAKPROC = 0x00D0, 48 | EM_GETWORDBREAKPROC = 0x00D1, 49 | EM_GETPASSWORDCHAR = 0x00D2, 50 | EM_SETMARGINS = 0x00D3, 51 | EM_GETMARGINS = 0x00D4, 52 | EM_SETLIMITTEXT = 0x00C5, 53 | EM_GETLIMITTEXT = 0x00D5, 54 | EM_POSFROMCHAR = 0x00D6, 55 | EM_CHARFROMPOS = 0x00D7, 56 | EM_SETIMESTATUS = 0x00D8, 57 | EM_GETIMESTATUS = 0x00D9 58 | } EDITCTL_MESSAGES; 59 | 60 | -------------------------------------------------------------------------------- /typelib/gdi32.inc: -------------------------------------------------------------------------------- 1 | typedef struct LOGFONT { 2 | long lfHeight; 3 | long lfWidth; 4 | long lfEscapement; 5 | long lfOrientation; 6 | long lfWeight; 7 | unsigned char lfItalic; 8 | unsigned char lfUnderline; 9 | unsigned char lfStrikeOut; 10 | unsigned char lfCharSet; 11 | unsigned char lfOutPrecision; 12 | unsigned char lfClipPrecision; 13 | unsigned char lfQuality; 14 | unsigned char lfPitchAndFamily; 15 | short lfFaceName[/* LF_FACESIZE */ 32]; 16 | } LOGFONT; 17 | 18 | typedef enum LOGFONT_QUALITY { 19 | DEFAULT_QUALITY = 0, 20 | DRAFT_QUALITY = 1, 21 | PROOF_QUALITY = 2, 22 | NONANTIALIASED_QUALITY = 3, 23 | ANTIALIASED_QUALITY = 4, 24 | CLEARTYPE_QUALITY = 5, 25 | CLEARTYPE_NATURAL_QUALITY = 6 26 | } LOGFONT_QUALITY; 27 | 28 | [dllname("GDI32.DLL")] 29 | module gdi32 { 30 | 31 | const int LF_FACESIZE = 32; 32 | 33 | [entry("CreateFontIndirectW")] 34 | long CreateFontIndirect( 35 | [in] LOGFONT* lpLogFont 36 | ); 37 | 38 | [entry("DeleteObject")] 39 | long DeleteObject( 40 | [in] long hObject 41 | ); 42 | 43 | [entry("GetObjectW")] 44 | long GetObjectAPI( 45 | [in] long hObject, 46 | [in] long nCount, 47 | [in] void* lpObject 48 | ); 49 | 50 | [entry("AddFontMemResourceEx")] 51 | long AddFontMemResourceEx( 52 | [in] void* pFileView, 53 | [in] long cjSize, 54 | [in] long pvResrved, 55 | [in] long* pNumFonts 56 | ); 57 | 58 | [entry("RemoveFontMemResourceEx")] 59 | long RemoveFontMemResourceEx( 60 | [in] long h 61 | ); 62 | 63 | } 64 | -------------------------------------------------------------------------------- /typelib/kernel32.inc: -------------------------------------------------------------------------------- 1 | 2 | typedef enum GMEM_FLAGS { 3 | GMEM_FIXED = 0x0000, 4 | GMEM_MOVEABLE = 0x0002, 5 | GMEM_NOCOMPACT = 0x0010, 6 | GMEM_NODISCARD = 0x0020, 7 | GMEM_ZEROINIT = 0x0040, 8 | GMEM_MODIFY = 0x0080, 9 | GMEM_DISCARDABLE = 0x0100, 10 | GMEM_NOT_BANKED = 0x1000, 11 | GMEM_SHARE = 0x2000, 12 | GMEM_DDESHARE = 0x2000, 13 | GMEM_NOTIFY = 0x4000, 14 | GMEM_LOWER = GMEM_NOT_BANKED, 15 | GMEM_VALID_FLAGS = 0x7F72, 16 | GMEM_INVALID_HANDLE = 0x8000, 17 | GHND = 0x0042, // (GMEM_MOVEABLE | GMEM_ZEROINIT) 18 | GPTR = 0x0040, // (GMEM_FIXED | GMEM_ZEROINIT), 19 | GMEM_DISCARDED = 0x4000, 20 | GMEM_LOCKCOUNT = 0x00FF 21 | } GMEM_FLAGS; 22 | 23 | typedef enum FILE_ATTRIBUTES_AND_FLAGS { 24 | 25 | FILE_ATTRIBUTE_READONLY = 0x00000001, 26 | FILE_ATTRIBUTE_HIDDEN = 0x00000002, 27 | FILE_ATTRIBUTE_SYSTEM = 0x00000004, 28 | FILE_ATTRIBUTE_DIRECTORY = 0x00000010, 29 | FILE_ATTRIBUTE_ARCHIVE = 0x00000020, 30 | FILE_ATTRIBUTE_DEVICE = 0x00000040, 31 | FILE_ATTRIBUTE_NORMAL = 0x00000080, 32 | FILE_ATTRIBUTE_TEMPORARY = 0x00000100, 33 | FILE_ATTRIBUTE_SPARSE_FILE = 0x00000200, 34 | FILE_ATTRIBUTE_REPARSE_POINT = 0x00000400, 35 | FILE_ATTRIBUTE_COMPRESSED = 0x00000800, 36 | FILE_ATTRIBUTE_OFFLINE = 0x00001000, 37 | FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = 0x00002000, 38 | FILE_ATTRIBUTE_ENCRYPTED = 0x00004000, 39 | FILE_ATTRIBUTE_VIRTUAL = 0x00010000, 40 | FILE_FLAG_WRITE_THROUGH = 0x80000000, 41 | FILE_FLAG_OVERLAPPED = 0x40000000, 42 | FILE_FLAG_NO_BUFFERING = 0x20000000, 43 | FILE_FLAG_RANDOM_ACCESS = 0x10000000, 44 | FILE_FLAG_SEQUENTIAL_SCAN = 0x08000000, 45 | FILE_FLAG_DELETE_ON_CLOSE = 0x04000000, 46 | FILE_FLAG_BACKUP_SEMANTICS = 0x02000000, 47 | FILE_FLAG_POSIX_SEMANTICS = 0x01000000, 48 | FILE_FLAG_OPEN_REPARSE_POINT = 0x00200000, 49 | FILE_FLAG_OPEN_NO_RECALL = 0x00100000, 50 | FILE_FLAG_FIRST_PIPE_INSTANCE = 0x00080000 51 | 52 | } FILE_ATTRIBUTES_AND_FLAGS; 53 | 54 | typedef enum FILE_SHARE { 55 | 56 | FILE_SHARE_DELETE = 4, 57 | FILE_SHARE_READ = 1, 58 | FILE_SHARE_WRITE = 2, 59 | FILE_SHARE_NONE = 0 60 | 61 | } FILE_SHARE; 62 | 63 | typedef enum PAGE_ACCESS { 64 | PAGE_EXECUTE_READ=0x20, 65 | PAGE_EXECUTE_READWRITE=0x40, 66 | PAGE_EXECUTE_WRITECOPY=0x80, 67 | PAGE_READONLY=0x02, 68 | PAGE_READWRITE=0x04, 69 | PAGE_WRITECOPY=0x08, 70 | PAGE_NOCACHE = 0x200, 71 | PAGE_NOACCESS = 1, 72 | PAGE_GUARD = 0x100, 73 | SEC_COMMIT=0x8000000, 74 | SEC_IMAGE=0x1000000, 75 | SEC_IMAGE_NO_EXECUTE=0x11000000, 76 | SEC_LARGE_PAGES=0x80000000, 77 | SEC_NOCACHE=0x10000000, 78 | SEC_RESERVE=0x4000000, 79 | SEC_WRITECOMBINE=0x40000000 80 | } PAGE_ACCESS; 81 | 82 | typedef enum CREATION_DISPOSITION { 83 | CREATE_ALWAYS = 2, 84 | CREATE_NEW = 1, 85 | OPEN_ALWAYS = 4, 86 | OPEN_EXISTING = 3, 87 | TRUNCATE_EXISTING = 5 88 | } CREATION_DISPOSITION; 89 | 90 | typedef enum FILE_MAP { 91 | FILE_MAP_READ = 4, 92 | FILE_MAP_WRITE = 2, 93 | FILE_MAP_COPY = 1, 94 | FILE_MAP_ALL_ACCESS = 0xF001F, 95 | FILE_MAP_EXECUTE = 0x20 96 | } FILE_MAP; 97 | 98 | typedef enum CODEPAGES { 99 | CP_WINANSI = 1004, /* default codepage for windows & old DDE convs. */ 100 | CP_WINUNICODE = 1200, 101 | CP_ACP = 0, // default to ANSI code page 102 | CP_OEMCP = 1, // default to OEM code page 103 | CP_MACCP = 2, // default to MAC code page 104 | CP_THREAD_ACP = 3, // current thread's ANSI code page 105 | CP_SYMBOL = 42, // SYMBOL translations 106 | CP_UTF7 = 65000, // UTF-7 translation 107 | CP_UTF8 = 65001 // UTF-8 translation 108 | } CODEPAGES; 109 | 110 | typedef struct LARGE_INTEGER { 111 | long LowPart; 112 | long HighPart; 113 | } LARGE_INTEGER; 114 | 115 | [dllname("KERNEL32.DLL")] 116 | module kernel32 { 117 | 118 | const int MAX_PATH = 260; 119 | 120 | const int GENERIC_READ = 0x80000000; 121 | const int GENERIC_WRITE = 0x40000000; 122 | const int GENERIC_EXECUTE = 0x20000000; 123 | const int GENERIC_ALL = 0x10000000; 124 | 125 | const int INVALID_HANDLE_VALUE = -1; 126 | 127 | [entry("lstrlenW")] 128 | int lstrlenW( 129 | [in] void* lpString 130 | ); 131 | 132 | [entry("lstrcpynA")] 133 | int lstrcpynA( 134 | [in] void* lpString1, 135 | [in] void* lpString2, 136 | [in] long nMaxLen 137 | ); 138 | 139 | [entry("lstrcpynW")] 140 | int lstrcpynW( 141 | [in] void* lpString1, 142 | [in] void* lpString2, 143 | [in] long nMaxLen 144 | ); 145 | 146 | [entry("GetFileSizeEx")] 147 | long GetFileSizeEx( 148 | [in] long hFile, 149 | [in, out] LARGE_INTEGER *lpFileSize 150 | ); 151 | 152 | [entry("RtlMoveMemory")] 153 | void memcpy( 154 | [in] void* Destination, 155 | [in] void* Source, 156 | [in] long Length 157 | ); 158 | 159 | [entry("CloseHandle")] 160 | long CloseHandle( 161 | [in] long hObject); 162 | 163 | [entry("CreateFileW")] 164 | long CreateFile( 165 | [in] LPWSTR lpFileName, 166 | [in] long dwDesiredAccess, 167 | [in] FILE_SHARE dwShareMode, 168 | [in] void *lpSecurityAttributes, 169 | [in] CREATION_DISPOSITION dwCreationDisposition, 170 | [in] FILE_ATTRIBUTES_AND_FLAGS dwFlagsAndAttributes, 171 | [in] long hTemplateFile 172 | ); 173 | 174 | [entry("ReadFile")] 175 | long ReadFile( 176 | [in] long hFile, 177 | [in] void *lpBuffer, 178 | [in] long nNumberOfBytesToRead, 179 | [in] long *lpNumberOfBytesRead, 180 | [in] void *lpOverlapped 181 | ); 182 | 183 | [entry("WriteFile")] 184 | long WriteFile( 185 | [in] long hFile, 186 | [in] void *lpBuffer, 187 | [in] long nNumberOfBytesToWrite, 188 | [in] long *lpNumberOfBytesWritten, 189 | [in] void *lpOverlapped 190 | ); 191 | 192 | [entry("WideCharToMultiByte")] 193 | long WideCharToMultiByte( 194 | [in] long CodePage, 195 | [in] long dwFlags, 196 | [in] void* lpWideCharStr, 197 | [in] long cchWideChar, 198 | [in] void* lpMultiByteStr, 199 | [in] long cchMultiByte, 200 | [in] void* lpDefaultChar, 201 | [in] void* lpUsedDefaultChar 202 | ); 203 | 204 | [entry("MultiByteToWideChar")] 205 | long MultiByteToWideChar( 206 | [in] long CodePage, 207 | [in] long dwFlags, 208 | [in] void* lpMultiByteStr, 209 | [in] long cchMultiByte, 210 | [in] void* lpWideCharStr, 211 | [in] long cchWideChar 212 | ); 213 | 214 | [entry("CreateFileMappingW")] 215 | long CreateFileMapping( 216 | [in] long hFile, 217 | [in] void* lpFileMappigAttributes, 218 | [in] PAGE_ACCESS flProtect, 219 | [in] long dwMaximumSizeHigh, 220 | [in] long dwMaximumSizeLow, 221 | [in] LPWSTR lpName 222 | ); 223 | 224 | [entry("MapViewOfFile")] 225 | long MapViewOfFile( 226 | [in] long hFileMappingObject, 227 | [in] FILE_MAP dwDesiredAccess, 228 | [in] long dwFileOffsetHigh, 229 | [in] long dwFileOffsetLow, 230 | [in] long dwNumberOfBytesToMap 231 | ); 232 | 233 | [entry("UnmapViewOfFile")] 234 | long UnmapViewOfFile( 235 | [in] void* lpBaseAddress 236 | ); 237 | 238 | [entry("WritePrivateProfileStringW")] 239 | long WritePrivateProfileString( 240 | [in] LPWSTR lpAppName, 241 | [in] LPWSTR lpKeyName, 242 | [in] LPWSTR lpString, 243 | [in] LPWSTR lpFileName 244 | ); 245 | 246 | [entry("GetPrivateProfileStringW")] 247 | long GetPrivateProfileString( 248 | [in] LPWSTR lpAppName, 249 | [in] LPWSTR lpKeyName, 250 | [in] LPWSTR lpDefault, 251 | [in] LPWSTR lpReturnedString, 252 | [in] long nSize, 253 | [in] LPWSTR lpFileName 254 | ); 255 | 256 | [entry("GlobalAlloc")] 257 | long GlobalAlloc( 258 | [in] GMEM_FLAGS uFlags, 259 | [in] long dwBytes 260 | ); 261 | 262 | [entry("GlobalLock")] 263 | long GlobalLock( 264 | [in] long hMem 265 | ); 266 | 267 | [entry("GlobalUnlock")] 268 | long GlobalUnlock( 269 | [in] long hMem 270 | ); 271 | 272 | [entry("GlobalFree")] 273 | long GlobalFree( 274 | [in] long hMem 275 | ); 276 | 277 | [entry("GlobalSize")] 278 | long GlobalSize( 279 | [in] long hMem 280 | ); 281 | 282 | [entry("LocalLock")] 283 | long LocalLock( 284 | [in] long hMem 285 | ); 286 | 287 | [entry("LocalUnlock")] 288 | long LocalUnlock( 289 | [in] long hMem 290 | ); 291 | 292 | } 293 | -------------------------------------------------------------------------------- /typelib/msvbvm60.inc: -------------------------------------------------------------------------------- 1 | [dllname("MSVBVM60.DLL")] 2 | module msvbvm60 { 3 | 4 | [entry("GetMem1")] 5 | void GetMem1( 6 | [in] void *pSrc, 7 | [in, out] void *pDst); 8 | 9 | [entry("GetMem2")] 10 | void GetMem2( 11 | [in] void *pSrc, 12 | [in, out] void *pDst); 13 | 14 | [entry("GetMem4")] 15 | void GetMem4( 16 | [in] void *pSrc, 17 | [in, out] void *pDst); 18 | 19 | [entry("GetMem8")] 20 | void GetMem8( 21 | [in] void *pSrc, 22 | [in, out] void *pDst); 23 | 24 | [entry("PutMem1")] 25 | void PutMem1( 26 | [in, out] void *pDst, 27 | [in] unsigned char v); 28 | 29 | [entry("PutMem2")] 30 | void PutMem2( 31 | [in, out] void *pDst, 32 | [in] short v); 33 | 34 | [entry("PutMem4")] 35 | void PutMem4( 36 | [in, out] void *pDst, 37 | [in] long v); 38 | 39 | [entry("PutMem8")] 40 | void PutMem8( 41 | [in, out] void *pDst, 42 | [in] long vL, 43 | [in] long vH); 44 | 45 | [entry("__vbaObjSetAddref")] 46 | void vbaObjSetAddref( 47 | [in, out] void *pDstObj, 48 | [in] void *pSrcObj); 49 | 50 | [entry("VarPtr")] 51 | long ArrPtr( 52 | [in] SAFEARRAY(void) *pDst); 53 | 54 | } -------------------------------------------------------------------------------- /typelib/oleaut32.inc: -------------------------------------------------------------------------------- 1 | 2 | typedef struct SAFEARRAYBOUND { 3 | long cElements; 4 | long lLBound; 5 | } SAFEARRAYBOUND; 6 | 7 | typedef struct SAFEARRAY { 8 | short cDims; 9 | short fFeatures; 10 | long cbElements; 11 | long cLocks; 12 | long pvData; 13 | //SAFEARRAYBOUND rgsabound[1]; 14 | } SAFEARRAY; 15 | 16 | -------------------------------------------------------------------------------- /typelib/shlwapi.inc: -------------------------------------------------------------------------------- 1 | 2 | [dllname("SHLWAPI.DLL")] 3 | module shlwapi { 4 | 5 | [entry("HashData")] 6 | long HashData( 7 | [in] void* pbData, 8 | [in] long cbData, 9 | [in] void *pbHash, 10 | [in] long cbHash 11 | ); 12 | 13 | [entry("PathFindExtensionW")] 14 | long PathFindExtension( 15 | [in] void* pszPath 16 | ); 17 | 18 | [entry("PathFindFileNameW")] 19 | long PathFindFileName( 20 | [in] LPWSTR pszPath 21 | ); 22 | 23 | [entry("PathRemoveFileSpecW")] 24 | long PathRemoveFileSpec( 25 | [in] LPWSTR pszPath 26 | ); 27 | 28 | } 29 | -------------------------------------------------------------------------------- /typelib/subclass.inc: -------------------------------------------------------------------------------- 1 | 2 | [uuid(DEEB842B-4D58-44BE-AC71-E1D2EECF1591)] 3 | interface ISubclass : IUnknown { 4 | 5 | [propget] 6 | HRESULT hWnd( 7 | [out, retval] long* pResult); 8 | 9 | HRESULT OnWindowProc( 10 | [in] long hWnd, 11 | [in] long lMsg, 12 | [in] long wParam, 13 | [in] long lParam, 14 | [in, out] VARIANT_BOOL *bDefCall, 15 | [out, retval] long* pResult); 16 | 17 | } -------------------------------------------------------------------------------- /typelib/user32.inc: -------------------------------------------------------------------------------- 1 | typedef struct POINT { 2 | long x; 3 | long y; 4 | } POINT; 5 | 6 | typedef struct RECT { 7 | long Left; 8 | long Top; 9 | long Right; 10 | long Bottom; 11 | } RECT; 12 | 13 | typedef enum CLIPBOARD_FORMAT_CONSTS { 14 | CF_TEXT = 1, 15 | CF_BITMAP = 2, 16 | CF_METAFILEPICT = 3, 17 | CF_SYLK = 4, 18 | CF_DIF = 5, 19 | CF_TIFF = 6, 20 | CF_OEMTEXT = 7, 21 | CF_DIB = 8, 22 | CF_PALETTE = 9, 23 | CF_PENDATA = 10, 24 | CF_RIFF = 11, 25 | CF_WAVE = 12, 26 | CF_UNICODETEXT = 13, 27 | CF_ENHMETAFILE = 14, 28 | CF_HDROP = 15, 29 | CF_LOCALE = 16, 30 | CF_DIBV5 = 17, 31 | CF_MAX = 18, 32 | CF_OWNERDISPLAY = 0x0080, 33 | CF_DSPTEXT = 0x0081, 34 | CF_DSPBITMAP = 0x0082, 35 | CF_DSPMETAFILEPICT = 0x0083, 36 | CF_DSPENHMETAFILE = 0x008E, 37 | CF_PRIVATEFIRST = 0x0200, 38 | CF_PRIVATELAST = 0x02FF, 39 | CF_GDIOBJFIRST = 0x0300, 40 | CF_GDIOBJLAST = 0x03FF 41 | } CLIPBOARD_FORMAT_CONSTS; 42 | 43 | typedef enum GWL_CONSTS { 44 | GWL_WNDPROC=(-4), 45 | GWL_HINSTANCE=(-6), 46 | GWL_HWNDPARENT=(-8), 47 | GWL_STYLE=(-16), 48 | GWL_EXSTYLE=(-20), 49 | GWL_USERDATA=(-21), 50 | GWL_ID=(-12), 51 | DWL_MSGRESULT=0, 52 | DWL_DLGPROC=4, 53 | DWL_USER=8 54 | } GWL_CONSTS; 55 | 56 | typedef enum DRAWTEXT_FORMATS { 57 | DT_TOP = 0x00000000, 58 | DT_LEFT = 0x00000000, 59 | DT_CENTER = 0x00000001, 60 | DT_RIGHT = 0x00000002, 61 | DT_VCENTER = 0x00000004, 62 | DT_BOTTOM = 0x00000008, 63 | DT_WORDBREAK = 0x00000010, 64 | DT_SINGLELINE = 0x00000020, 65 | DT_EXPANDTABS = 0x00000040, 66 | DT_TABSTOP = 0x00000080, 67 | DT_NOCLIP = 0x00000100, 68 | DT_EXTERNALLEADING = 0x00000200, 69 | DT_CALCRECT = 0x00000400, 70 | DT_NOPREFIX = 0x00000800, 71 | DT_INTERNAL = 0x00001000, 72 | DT_EDITCONTROL = 0x00002000, 73 | DT_PATH_ELLIPSIS = 0x00004000, 74 | DT_END_ELLIPSIS = 0x00008000, 75 | DT_MODIFYSTRING = 0x00010000, 76 | DT_RTLREADING = 0x00020000, 77 | DT_WORD_ELLIPSIS = 0x00040000, 78 | DT_NOFULLWIDTHCHARBREAK = 0x00080000, 79 | DT_HIDEPREFIX = 0x00100000, 80 | DT_PREFIXONLY = 0x00200000 81 | } DRAWTEXT_FORMATS; 82 | 83 | typedef enum WM_CONSTANTS { 84 | WM_NULL = 0x0000, 85 | WM_CREATE = 0x0001, 86 | WM_DESTROY = 0x0002, 87 | WM_MOVE = 0x0003, 88 | WM_SIZE = 0x0005, 89 | WM_ACTIVATE = 0x0006, 90 | WM_SETFOCUS = 0x0007, 91 | WM_KILLFOCUS = 0x0008, 92 | WM_ENABLE = 0x000A, 93 | WM_SETREDRAW = 0x000B, 94 | WM_SETTEXT = 0x000C, 95 | WM_GETTEXT = 0x000D, 96 | WM_GETTEXTLENGTH = 0x000E, 97 | WM_PAINT = 0x000F, 98 | WM_CLOSE = 0x0010, 99 | WM_QUERYENDSESSION = 0x0011, 100 | WM_QUERYOPEN = 0x0013, 101 | WM_ENDSESSION = 0x0016, 102 | WM_QUIT = 0x0012, 103 | WM_ERASEBKGND = 0x0014, 104 | WM_SYSCOLORCHANGE = 0x0015, 105 | WM_SHOWWINDOW = 0x0018, 106 | WM_WININICHANGE = 0x001A, 107 | WM_SETTINGCHANGE = 0x001A, 108 | WM_DEVMODECHANGE = 0x001B, 109 | WM_ACTIVATEAPP = 0x001C, 110 | WM_FONTCHANGE = 0x001D, 111 | WM_TIMECHANGE = 0x001E, 112 | WM_CANCELMODE = 0x001F, 113 | WM_SETCURSOR = 0x0020, 114 | WM_MOUSEACTIVATE = 0x0021, 115 | WM_CHILDACTIVATE = 0x0022, 116 | WM_QUEUESYNC = 0x0023, 117 | WM_GETMINMAXINFO = 0x0024, 118 | WM_PAINTICON = 0x0026, 119 | WM_ICONERASEBKGND = 0x0027, 120 | WM_NEXTDLGCTL = 0x0028, 121 | WM_SPOOLERSTATUS = 0x002A, 122 | WM_DRAWITEM = 0x002B, 123 | WM_MEASUREITEM = 0x002C, 124 | WM_DELETEITEM = 0x002D, 125 | WM_VKEYTOITEM = 0x002E, 126 | WM_CHARTOITEM = 0x002F, 127 | WM_SETFONT = 0x0030, 128 | WM_GETFONT = 0x0031, 129 | WM_SETHOTKEY = 0x0032, 130 | WM_GETHOTKEY = 0x0033, 131 | WM_QUERYDRAGICON = 0x0037, 132 | WM_COMPAREITEM = 0x0039, 133 | WM_GETOBJECT = 0x003D, 134 | WM_COMPACTING = 0x0041, 135 | WM_COMMNOTIFY = 0x0044, 136 | WM_WINDOWPOSCHANGING = 0x0046, 137 | WM_WINDOWPOSCHANGED = 0x0047, 138 | WM_POWER = 0x0048, 139 | WM_COPYDATA = 0x004A, 140 | WM_CANCELJOURNAL = 0x004B, 141 | WM_NOTIFY = 0x004E, 142 | WM_INPUTLANGCHANGEREQUEST = 0x0050, 143 | WM_INPUTLANGCHANGE = 0x0051, 144 | WM_TCARD = 0x0052, 145 | WM_HELP = 0x0053, 146 | WM_USERCHANGED = 0x0054, 147 | WM_NOTIFYFORMAT = 0x0055, 148 | WM_CONTEXTMENU = 0x007B, 149 | WM_STYLECHANGING = 0x007C, 150 | WM_STYLECHANGED = 0x007D, 151 | WM_DISPLAYCHANGE = 0x007E, 152 | WM_GETICON = 0x007F, 153 | WM_SETICON = 0x0080, 154 | WM_NCCREATE = 0x0081, 155 | WM_NCDESTROY = 0x0082, 156 | WM_NCCALCSIZE = 0x0083, 157 | WM_NCHITTEST = 0x0084, 158 | WM_NCPAINT = 0x0085, 159 | WM_NCACTIVATE = 0x0086, 160 | WM_GETDLGCODE = 0x0087, 161 | WM_SYNCPAINT = 0x0088, 162 | 163 | 164 | WM_NCMOUSEMOVE = 0x00A0, 165 | WM_NCLBUTTONDOWN = 0x00A1, 166 | WM_NCLBUTTONUP = 0x00A2, 167 | WM_NCLBUTTONDBLCLK = 0x00A3, 168 | WM_NCRBUTTONDOWN = 0x00A4, 169 | WM_NCRBUTTONUP = 0x00A5, 170 | WM_NCRBUTTONDBLCLK = 0x00A6, 171 | WM_NCMBUTTONDOWN = 0x00A7, 172 | WM_NCMBUTTONUP = 0x00A8, 173 | WM_NCMBUTTONDBLCLK = 0x00A9, 174 | WM_NCXBUTTONDOWN = 0x00AB, 175 | WM_NCXBUTTONUP = 0x00AC, 176 | WM_NCXBUTTONDBLCLK = 0x00AD, 177 | 178 | WM_INPUT_DEVICE_CHANGE = 0x00FE, 179 | WM_INPUT = 0x00FF, 180 | 181 | WM_KEYFIRST = 0x0100, 182 | WM_KEYDOWN = 0x0100, 183 | WM_KEYUP = 0x0101, 184 | WM_CHAR = 0x0102, 185 | WM_DEADCHAR = 0x0103, 186 | WM_SYSKEYDOWN = 0x0104, 187 | WM_SYSKEYUP = 0x0105, 188 | WM_SYSCHAR = 0x0106, 189 | WM_SYSDEADCHAR = 0x0107, 190 | WM_UNICHAR = 0x0109, 191 | WM_KEYLAST = 0x0109, 192 | 193 | WM_IME_STARTCOMPOSITION = 0x010D, 194 | WM_IME_ENDCOMPOSITION = 0x010E, 195 | WM_IME_COMPOSITION = 0x010F, 196 | WM_IME_KEYLAST = 0x010F, 197 | 198 | WM_INITDIALOG = 0x0110, 199 | WM_COMMAND = 0x0111, 200 | WM_SYSCOMMAND = 0x0112, 201 | WM_TIMER = 0x0113, 202 | WM_HSCROLL = 0x0114, 203 | WM_VSCROLL = 0x0115, 204 | WM_INITMENU = 0x0116, 205 | WM_INITMENUPOPUP = 0x0117, 206 | WM_MENUSELECT = 0x011F, 207 | WM_MENUCHAR = 0x0120, 208 | WM_ENTERIDLE = 0x0121, 209 | WM_MENURBUTTONUP = 0x0122, 210 | WM_MENUDRAG = 0x0123, 211 | WM_MENUGETOBJECT = 0x0124, 212 | WM_UNINITMENUPOPUP = 0x0125, 213 | WM_MENUCOMMAND = 0x0126, 214 | 215 | WM_CHANGEUISTATE = 0x0127, 216 | WM_UPDATEUISTATE = 0x0128, 217 | WM_QUERYUISTATE = 0x0129, 218 | 219 | WM_CTLCOLORMSGBOX = 0x0132, 220 | WM_CTLCOLOREDIT = 0x0133, 221 | WM_CTLCOLORLISTBOX = 0x0134, 222 | WM_CTLCOLORBTN = 0x0135, 223 | WM_CTLCOLORDLG = 0x0136, 224 | WM_CTLCOLORSCROLLBAR = 0x0137, 225 | WM_CTLCOLORSTATIC = 0x0138, 226 | MN_GETHMENU = 0x01E1, 227 | 228 | WM_MOUSEFIRST = 0x0200, 229 | WM_MOUSEMOVE = 0x0200, 230 | WM_LBUTTONDOWN = 0x0201, 231 | WM_LBUTTONUP = 0x0202, 232 | WM_LBUTTONDBLCLK = 0x0203, 233 | WM_RBUTTONDOWN = 0x0204, 234 | WM_RBUTTONUP = 0x0205, 235 | WM_RBUTTONDBLCLK = 0x0206, 236 | WM_MBUTTONDOWN = 0x0207, 237 | WM_MBUTTONUP = 0x0208, 238 | WM_MBUTTONDBLCLK = 0x0209, 239 | WM_MOUSEWHEEL = 0x020A, 240 | WM_XBUTTONDOWN = 0x020B, 241 | WM_XBUTTONUP = 0x020C, 242 | WM_XBUTTONDBLCLK = 0x020D, 243 | WM_MOUSEHWHEEL = 0x020E, 244 | 245 | WM_PARENTNOTIFY = 0x0210, 246 | WM_ENTERMENULOOP = 0x0211, 247 | WM_EXITMENULOOP = 0x0212, 248 | 249 | WM_NEXTMENU = 0x0213, 250 | WM_SIZING = 0x0214, 251 | WM_CAPTURECHANGED = 0x0215, 252 | WM_MOVING = 0x0216, 253 | 254 | WM_POWERBROADCAST = 0x0218, 255 | 256 | WM_DEVICECHANGE = 0x0219, 257 | 258 | WM_MDICREATE = 0x0220, 259 | WM_MDIDESTROY = 0x0221, 260 | WM_MDIACTIVATE = 0x0222, 261 | WM_MDIRESTORE = 0x0223, 262 | WM_MDINEXT = 0x0224, 263 | WM_MDIMAXIMIZE = 0x0225, 264 | WM_MDITILE = 0x0226, 265 | WM_MDICASCADE = 0x0227, 266 | WM_MDIICONARRANGE = 0x0228, 267 | WM_MDIGETACTIVE = 0x0229, 268 | 269 | 270 | WM_MDISETMENU = 0x0230, 271 | WM_ENTERSIZEMOVE = 0x0231, 272 | WM_EXITSIZEMOVE = 0x0232, 273 | WM_DROPFILES = 0x0233, 274 | WM_MDIREFRESHMENU = 0x0234, 275 | 276 | WM_IME_SETCONTEXT = 0x0281, 277 | WM_IME_NOTIFY = 0x0282, 278 | WM_IME_CONTROL = 0x0283, 279 | WM_IME_COMPOSITIONFULL = 0x0284, 280 | WM_IME_SELECT = 0x0285, 281 | WM_IME_CHAR = 0x0286, 282 | WM_IME_REQUEST = 0x0288, 283 | WM_IME_KEYDOWN = 0x0290, 284 | WM_IME_KEYUP = 0x0291, 285 | 286 | WM_MOUSEHOVER = 0x02A1, 287 | WM_MOUSELEAVE = 0x02A3, 288 | WM_NCMOUSEHOVER = 0x02A0, 289 | WM_NCMOUSELEAVE = 0x02A2, 290 | 291 | WM_WTSSESSION_CHANGE = 0x02B1, 292 | 293 | WM_TABLET_FIRST = 0x02c0, 294 | WM_TABLET_LAST = 0x02df, 295 | 296 | WM_CUT = 0x0300, 297 | WM_COPY = 0x0301, 298 | WM_PASTE = 0x0302, 299 | WM_CLEAR = 0x0303, 300 | WM_UNDO = 0x0304, 301 | WM_RENDERFORMAT = 0x0305, 302 | WM_RENDERALLFORMATS = 0x0306, 303 | WM_DESTROYCLIPBOARD = 0x0307, 304 | WM_DRAWCLIPBOARD = 0x0308, 305 | WM_PAINTCLIPBOARD = 0x0309, 306 | WM_VSCROLLCLIPBOARD = 0x030A, 307 | WM_SIZECLIPBOARD = 0x030B, 308 | WM_ASKCBFORMATNAME = 0x030C, 309 | WM_CHANGECBCHAIN = 0x030D, 310 | WM_HSCROLLCLIPBOARD = 0x030E, 311 | WM_QUERYNEWPALETTE = 0x030F, 312 | WM_PALETTEISCHANGING = 0x0310, 313 | WM_PALETTECHANGED = 0x0311, 314 | WM_HOTKEY = 0x0312, 315 | 316 | WM_PRINT = 0x0317, 317 | WM_PRINTCLIENT = 0x0318, 318 | 319 | WM_APPCOMMAND = 0x0319, 320 | 321 | WM_THEMECHANGED = 0x031A, 322 | 323 | WM_CLIPBOARDUPDATE = 0x031D, 324 | 325 | WM_DWMCOMPOSITIONCHANGED = 0x031E, 326 | WM_DWMNCRENDERINGCHANGED = 0x031F, 327 | WM_DWMCOLORIZATIONCOLORCHANGED = 0x0320, 328 | WM_DWMWINDOWMAXIMIZEDCHANGE = 0x0321, 329 | 330 | WM_GETTITLEBARINFOEX = 0x033F, 331 | 332 | WM_HANDHELDFIRST = 0x0358, 333 | WM_HANDHELDLAST = 0x035F, 334 | 335 | WM_AFXFIRST = 0x0360, 336 | WM_AFXLAST = 0x037F, 337 | 338 | WM_PENWINFIRST = 0x0380, 339 | WM_PENWINLAST = 0x038F, 340 | 341 | WM_APP = 0x8000, 342 | 343 | WM_USER = 0x0400, 344 | 345 | WM_REFLECT = 0x2000 346 | } WM_CONSTANTS; 347 | 348 | typedef enum WINDOWS_STYLES { 349 | WS_OVERLAPPED = 0x00000000, 350 | WS_POPUP = 0x80000000, 351 | WS_CHILD = 0x40000000, 352 | WS_MINIMIZE = 0x20000000, 353 | WS_VISIBLE = 0x10000000, 354 | WS_DISABLED = 0x08000000, 355 | WS_CLIPSIBLINGS = 0x04000000, 356 | WS_CLIPCHILDREN = 0x02000000, 357 | WS_MAXIMIZE = 0x01000000, 358 | WS_CAPTION = 0x00C00000, /* WS_BORDER | WS_DLGFRAME */ 359 | WS_BORDER = 0x00800000, 360 | WS_DLGFRAME = 0x00400000, 361 | WS_VSCROLL = 0x00200000, 362 | WS_HSCROLL = 0x00100000, 363 | WS_SYSMENU = 0x00080000, 364 | WS_THICKFRAME = 0x00040000, 365 | WS_GROUP = 0x00020000, 366 | WS_TABSTOP = 0x00010000, 367 | WS_MINIMIZEBOX = 0x00020000, 368 | WS_MAXIMIZEBOX = 0x00010000, 369 | WS_TILED = 0x00000000, 370 | WS_ICONIC = 0x20000000, 371 | WS_SIZEBOX = 0x00040000, 372 | WS_OVERLAPPEDWINDOW = 0x00cf0000, 373 | WS_POPUPWINDOW = 0x80880000, 374 | WS_CHILDWINDOW = 0x40000000, 375 | WS_TILEDWINDOW = 0x00cf0000 376 | } WINDOWS_STYLES; 377 | 378 | typedef enum WINDOWS_EXSTYLES { 379 | WS_EX_DLGMODALFRAME = 0x00000001, 380 | WS_EX_NOPARENTNOTIFY = 0x00000004, 381 | WS_EX_TOPMOST = 0x00000008, 382 | WS_EX_ACCEPTFILES = 0x00000010, 383 | WS_EX_TRANSPARENT = 0x00000020, 384 | WS_EX_MDICHILD = 0x00000040, 385 | WS_EX_TOOLWINDOW = 0x00000080, 386 | WS_EX_WINDOWEDGE = 0x00000100, 387 | WS_EX_CLIENTEDGE = 0x00000200, 388 | WS_EX_CONTEXTHELP = 0x00000400, 389 | WS_EX_RIGHT = 0x00001000, 390 | WS_EX_LEFT = 0x00000000, 391 | WS_EX_RTLREADING = 0x00002000, 392 | WS_EX_LTRREADING = 0x00000000, 393 | WS_EX_LEFTSCROLLBAR = 0x00004000, 394 | WS_EX_RIGHTSCROLLBAR = 0x00000000, 395 | WS_EX_CONTROLPARENT = 0x00010000, 396 | WS_EX_STATICEDGE = 0x00020000, 397 | WS_EX_APPWINDOW = 0x00040000, 398 | WS_EX_OVERLAPPEDWINDOW = 0x300, 399 | WS_EX_PALETTEWINDOW = 0x188, 400 | WS_EX_LAYERED = 0x00080000, 401 | WS_EX_NOINHERITLAYOUT = 0x00100000, // Disable inheritence of mirroring by children 402 | WS_EX_LAYOUTRTL = 0x00400000, // Right to left mirroring 403 | WS_EX_COMPOSITED = 0x02000000, 404 | WS_EX_NOACTIVATE = 0x08000000 405 | } WINDOWS_EXSTYLES; 406 | 407 | typedef struct MINMAXINFO { 408 | POINT ptReserved; 409 | POINT ptMaxSize; 410 | POINT ptMaxPosition; 411 | POINT ptMinTrackSize; 412 | POINT ptMaxTrackSize; 413 | } MINMAXINFO; 414 | 415 | [dllname("USER32.DLL")] 416 | module user32 { 417 | 418 | const int RT_RCDATA = 10; 419 | const int RT_FONT = 8; 420 | 421 | [entry("SendMessageW")] 422 | long SendMessage( 423 | [in] long hWnd, 424 | [in] long Msg, 425 | [in] long wParam, 426 | [in] void *lParam 427 | ); 428 | 429 | [entry("CreateWindowExW")] 430 | long CreateWindowEx( 431 | [in] long dwExStyle, 432 | [in] LPWSTR lpClassName, 433 | [in] LPWSTR lpWindowName, 434 | [in] long dwStyle, 435 | [in] long X, 436 | [in] long Y, 437 | [in] long nWidth, 438 | [in] long nHeight, 439 | [in] long hWndParent, 440 | [in] long hMenu, 441 | [in] long hInstance, 442 | [in] void* lpParam 443 | ); 444 | 445 | [entry("DestroyWindow")] 446 | long DestroyWindow( 447 | [in] long hWnd 448 | ); 449 | 450 | [entry("OffsetRect")] 451 | long OffsetRect( 452 | [in] RECT* lpRect, 453 | [in] long x, 454 | [in] long y 455 | ); 456 | 457 | [entry("InvalidateRect")] 458 | long InvalidateRect( 459 | [in] long hwnd, 460 | [in] void* lpRect, 461 | [in] long bErase 462 | ); 463 | 464 | [entry("DrawTextW")] 465 | long DrawText( 466 | [in] long hDC, 467 | [in] LPWSTR lpStr, 468 | [in] long nCount, 469 | [in] RECT* lpRect, 470 | [in] DRAWTEXT_FORMATS wFormat 471 | ); 472 | 473 | [entry("MoveWindow")] 474 | long MoveWindow( 475 | [in] long hwnd, 476 | [in] long x, 477 | [in] long y, 478 | [in] long nWidth, 479 | [in] long nHeight, 480 | [in] long bRepaint 481 | ); 482 | 483 | [entry("PtInRect")] 484 | long PtInRect( 485 | [in] RECT* lpRect, 486 | [in] long x, 487 | [in] long y 488 | ); 489 | 490 | [entry("SetRect")] 491 | long SetRect( 492 | [in] RECT* lpRect, 493 | [in] long x1, 494 | [in] long y1, 495 | [in] long x2, 496 | [in] long y2 497 | ); 498 | 499 | [entry("SetFocus")] 500 | long SetFocusAPI( 501 | [in] long hwnd 502 | ); 503 | 504 | [entry("SetWindowTextW")] 505 | long SetWindowText( 506 | [in] long hWnd, 507 | [in] LPWSTR lpString 508 | ); 509 | 510 | [entry("GetWindowTextW")] 511 | long GetWindowText( 512 | [in] long hWnd, 513 | [in] LPWSTR lpString, 514 | [in] long cch 515 | ); 516 | 517 | [entry("GetWindowTextLengthW")] 518 | long GetWindowTextLength( 519 | [in] long hWnd 520 | ); 521 | 522 | [entry("OpenClipboard")] 523 | long OpenClipboard( 524 | [in] long hWndNewOwner 525 | ); 526 | 527 | [entry("EmptyClipboard")] 528 | long EmptyClipboard(); 529 | 530 | [entry("CloseClipboard")] 531 | long CloseClipboard(); 532 | 533 | [entry("SetClipboardData")] 534 | long SetClipboardData( 535 | [in] CLIPBOARD_FORMAT_CONSTS uFormat, 536 | [in] long hMem 537 | ); 538 | 539 | [entry("GetClipboardData")] 540 | long GetClipboardData( 541 | [in] CLIPBOARD_FORMAT_CONSTS uFormat 542 | ); 543 | 544 | [entry("IsClipboardFormatAvailable")] 545 | long IsClipboardFormatAvailable( 546 | [in] CLIPBOARD_FORMAT_CONSTS uFormat 547 | ); 548 | 549 | } 550 | --------------------------------------------------------------------------------