[IDE tool] Code Localization

Working on new editor enhancements?
AZJIO
Addict
Addict
Posts: 1364
Joined: Sun May 14, 2017 1:48 am

[IDE tool] Code Localization

Post by AZJIO »

I haven't tested enough yet, but the code is not complicated and gets the job done. I have previously posted this tool written in AutoIt3, but now I have converted it to PureBasic. Interest arose when I wanted to check strings that required localization. Look at the IsLangRange() function to set your range there if your letters are not Latin. The flag "flgLRange = 1" enables it for additional processing. By default, the flag is disabled and localization includes Latin letters.

Download

Image

Code: Select all

;- TOP
; AZJIO 2024

EnableExplicit

Global UserIntLang


Define *Lang
If OpenLibrary(0, "kernel32.dll")
	*Lang = GetFunction(0, "GetUserDefaultUILanguage")
	If *Lang
		UserIntLang = CallFunctionFast(*Lang)
	EndIf
	CloseLibrary(0)
EndIf


Global Dim Lng.s(17)
Lng(0) = "Code localization"
Lng(1) = "Open source"
Lng(2) = "pcs"
Lng(3) = "Strings"
Lng(4) = "Settings"
Lng(5) = "Embed translation and paste to clipboard"
Lng(6) = "Reread the list after manually deleting rows"
Lng(7) = "Save"
Lng(8) = "Done. Sent to clipboard. Number of replacements:"
Lng(9) = "Message"
Lng(10) = "The number of lines does not match"
Lng(11) = ", continue?"
Lng(12) = "Use array"
Lng(13) = "Select a file to save."
; Lng(14) = "File not found: "
Lng(15) = "A string with these characters (a-zA-ZÄäÖöÜüß)"
Lng(16) = "Reopen file"
Lng(17) = "No rows found to process"
; Lng(7) = "No limit"
; Lng(13) = "Minimum string length"
; Lng(14) = "Ignore a line containing only characters:"

If UserIntLang = 1049
	Lng(0) = "Локализация кода"
	Lng(1) = "Открыть исходник"
	Lng(2) = "шт"
	Lng(3) = "Строки"
	Lng(4) = "Настройки"
	Lng(5) = "Встроить перевод и вставить в буфер обмена"
	Lng(6) = "Перечитать список после удаления строк вручную"
	Lng(7) = "Сохранить"
	Lng(8) = "Готово. Отправлено в буфер обмена. Количество замен:"
	Lng(9) = "Сообщение"
	Lng(10) = "Число строк не совпадает"
	Lng(11) = ", продолжить?"
	Lng(12) = "Использовать массив"
	Lng(13) = "Выберите файл для сохранения"
; 	Lng(14) = "Не найден файл: "
	Lng(15) = "Строка с этими символами (А-яЁё)"
	Lng(16) = "Переоткрыть файл"
	Lng(17) = "Не найдено строк для обработки"
; 	Lng(7) = "Нет лимита"
; 	Lng(13) = "Минимальная длина строки"
; 	Lng(14) = "Игнорировать строку, в которой только символы:"
EndIf


;- ● #Constants
Enumeration Token
	#SYNTAX_Text
	#SYNTAX_Keyword
	#SYNTAX_Comment
	#SYNTAX_Constant
	#SYNTAX_String
	#SYNTAX_Function
	#SYNTAX_Asm
	#SYNTAX_Operator
	#SYNTAX_Structure
	#SYNTAX_Number
	#SYNTAX_Pointer
	#SYNTAX_Separator
	#SYNTAX_Label
	#SYNTAX_Module
EndEnumeration

Enumeration Window
	#Window
	#WinSet
EndEnumeration

Enumeration rGadget
	#BtnOpen
	#ReOpen
	#Edit
	#EditTranslation
	#Splitter
	#Setting
	#ReRead
	#Translated
	#Save
	#StatusBar
	#txt1
	#txt2
	#LLine
	#Ignore1
	#ChRpc
	#ChLRange
	#StrCharSet
	#OK
EndEnumeration

; #Dummy = 0

;- ● Declare
Declare Setting()
Declare.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
Declare.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
Declare IsLangRange(*text)
Declare CallbackGetString(*Position, Length, TypeToken)
Declare GetString(InputFile$)
Declare.s Join(Array StringArray.s(1), Separator.s = " ")
Declare OpenDoc(sFilePath$)
Declare Clear()
Declare SplitA2(String$, Array StringList.s(1), Separator$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
Declare WindowSize()
Declare.s ReadFileToVar(Path$)
Declare ParseLang(CharacterSet$)
Declare IsLangRange2(*text)

Structure Two
	start.u
	end0.u
EndStructure
Global NewList Ranges.Two()
Global NewList Letters.u()
Global flgLRange = 0
Global CharacterSet$ = ""


; этот текст можно вставить через инклуд
Define textLang$= ~"If OpenLibrary(0, \"kernel32.dll\")" + #CRLF$ + ~"	*Lang = GetFunction(0, \"GetUserDefaultUILanguage\")" + #CRLF$ + "	If *Lang" + #CRLF$ + "		UserIntLang = CallFunctionFast(*Lang)" + #CRLF$ + "	EndIf" + #CRLF$ + "	CloseLibrary(0)" + #CRLF$ + "EndIf" + #CRLF$

;- ● Global
Global tmp, tmp$, sCurrentPath$, sTextOrig$, CountStr, flgArr = 1
Global Lib_id
Global NewMap LangStrMap()
Global Dim aTrslText.s(0)
Global Dim aTrslTextNew.s(0)
;- ● Define
Define sTmpTextOut$, sArrayVarText$, sArrayVarTextNew$, CountStrNew, iCountCur, iCount3, n, i
; Define LengthLine = 1, sIgnore$ = "\<>!@#$ " + #TAB$ + "%^+*()-+_{}[]:;|/?.," ; , TrEmpty = 1
Define Occurrences
Define isINI
Define w
Define h
Define splitter, splitter0
Define CharacterSet0$, flgLRange0, flgArr0

ExamineDesktops()
Define DspW = 600 ; DesktopWidth(0) / 2
Define DspH = DesktopHeight(0) * 2 / 3


Procedure Limit(*Value.integer, Min, Max)
  If *Value\i < Min
    *Value\i = Min
  ElseIf *Value\i > Max
    *Value\i = Max
  EndIf
EndProcedure

;- ini
Global ini$ = GetPathPart(ProgramFilename()) + "CodeLocalization.ini"

If FileSize(ini$) > -1 And OpenPreferences(ini$)
	isINI = 1
	w = ReadPreferenceInteger("width", DspW)
	Limit(@w, 250, DesktopWidth(0))
	DspW = w

	h = ReadPreferenceInteger("height", DspH)
	Limit(@h, 250, DesktopHeight(0))
	DspH = h
	
	splitter = ReadPreferenceInteger("splitter", -1)
	Limit(@splitter, 20, DspW - 30)
	flgLRange = ReadPreferenceInteger("range", flgLRange)
	CharacterSet$ = ReadPreferenceString("char", "")
	ClosePreferences()
EndIf
; кешируем для сравнения и сохранения в ini
w = DspW
h = DspH
CharacterSet0$ = CharacterSet$
flgLRange0 = flgLRange
flgArr0 = flgArr
splitter0 = splitter

;-┌──GUI──┐
OpenWindow(#Window, 0, 0, DspW, DspH, Lng(0), #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
WindowBounds(#Window, 250, 250, #PB_Ignore, #PB_Ignore) 

Define hIcon1
Define hIcon2
Define hIcon3
Define hIcon4
Define hIcon5
Define hIcon6
ExtractIconEx_("Shell32.dll", 4, 0, @hIcon1, 1)
ExtractIconEx_("Shell32.dll", 144, 0, @hIcon2, 1)
ExtractIconEx_("Shell32.dll", 24, 0, @hIcon3, 1)
ExtractIconEx_("Shell32.dll", 90, 0, @hIcon4, 1)
ExtractIconEx_("Shell32.dll", 6, 0, @hIcon5, 1)
ExtractIconEx_("Shell32.dll", 238, 0, @hIcon6, 1)

ButtonImageGadget(#BtnOpen, 5, 4, 23, 23, hIcon1)
GadgetToolTip(#BtnOpen, Lng(1))

ButtonImageGadget(#ReOpen, 30, 4, 23, 23, hIcon6)
GadgetToolTip(#ReOpen, Lng(16))

ButtonImageGadget(#ReRead, 55, 4, 23, 23, hIcon2)
GadgetToolTip(#ReRead, Lng(6))

ButtonImageGadget(#Translated, 80, 4, 23, 23, hIcon3)
GadgetToolTip(#Translated, Lng(5))

ButtonImageGadget(#Setting, 105, 4, 23, 23, hIcon4)
GadgetToolTip(#Setting, Lng(4))

ButtonImageGadget(#Save, 130, 4, 23, 23, hIcon5)
GadgetToolTip(#Save, Lng(7))

EditorGadget(#Edit, 5, 30, DspW / 2 - 5, DspH - 50, #PB_Editor_WordWrap)
EditorGadget(#EditTranslation, 5, 30, DspW / 2 - 5, DspH - 50, #PB_Editor_WordWrap)
SplitterGadget(#Splitter, 5, 30, DspW - 10, DspH - 50, #Edit , #EditTranslation, #PB_Splitter_Vertical) ; #PB_Splitter_Separator | 
SetGadgetAttribute(#Splitter, #PB_Splitter_FirstMinimumSize, 50)
SetGadgetAttribute(#Splitter, #PB_Splitter_SecondMinimumSize, 50)
SetGadgetState(#Splitter, splitter)

TextGadget(#StatusBar, 5, DspH - 20, DspW - 10, 20, "AZJIO 2024")

EnableGadgetDrop(#Edit, #PB_Drop_Files, #PB_Drag_Copy)
EnableGadgetDrop(#EditTranslation, #PB_Drop_Files, #PB_Drag_Copy)
; AddKeyboardShortcut(0, #PB_Shortcut_Control | #PB_Shortcut_A, #Dummy)

BindEvent(#PB_Event_SizeWindow, @WindowSize())

If flgLRange And Asc(CharacterSet$)
	ParseLang(CharacterSet$)
EndIf

	CompilerIf #PB_Compiler_Debugger
		OpenDoc("C:\ProgramData\PureBasic\Examples\test\Source\RegExp_WinLin.pb")
; 		OpenDoc("C:\ProgramData\PureBasic\Examples\Sources\CanvasGadget.pb")
CompilerElse
tmp$ = ProgramParameter()
If FileSize(tmp$) > -1
	OpenDoc(tmp$)
; Else
; 	MessageRequester(Lng(9), Lng(14) + #CRLF$ + tmp$)
EndIf
CompilerEndIf

;-┌──Loop──┐
Repeat
	Select WaitWindowEvent()
;-├ Drop Events
		Case #PB_Event_GadgetDrop ; событие перетаскивания
			Select EventGadget()
				Case #EditTranslation
					If Not FindString(EventDropFiles(), #LF$)
						If GetExtensionPart(EventDropFiles()) = "txt"
							SetGadgetText(#EditTranslation, ReadFileToVar(EventDropFiles()))
						Else
							OpenDoc(EventDropFiles())
						EndIf
					EndIf
				Case #Edit ; гаджеты, которые получили событие перетаскивания файлов/папок
					If Not FindString(EventDropFiles(), #LF$)
						If GetExtensionPart(EventDropFiles()) = "txt"
							SetGadgetText(#Edit, ReadFileToVar(EventDropFiles()))
						Else
							OpenDoc(EventDropFiles())
						EndIf
						OpenDoc(EventDropFiles())
					EndIf
			EndSelect
; 		Case #PB_Event_Menu
; 			Select EventMenu()
; 				Case #Dummy
; 					SendMessage_(GadgetID(#Edit), #EM_SETSEL, 0, -1)
; 			EndSelect

;-├ Gadget Events
		Case #PB_Event_Gadget
			Select EventGadget()
				Case #Setting
					Setting()
				Case #Save
					tmp$ = SaveFileRequester(Lng(13), GetCurrentDirectory(), "(*.txt)|*.txt|(*.*)|*.*", 0)
					If Asc(tmp$)
						CompilerIf #PB_Compiler_OS = #PB_OS_Windows
							; условие, если пользователь не ввёл расширение файла, но в случае если фильтр только "txt"
							If Right(tmp$, 4) <> ".txt"
								tmp$ + ".txt"
							EndIf
						CompilerEndIf
; 						Debug tmp$
						tmp = CreateFile(#PB_Any, tmp$)
						If tmp
							WriteStringFormat(tmp, #PB_UTF8)
							WriteString(tmp, GetGadgetText(#Edit), #PB_UTF8)
							CloseFile(tmp)
						EndIf
						
					EndIf
					
				Case #ReOpen
					If Asc(sCurrentPath$)
						OpenDoc(sCurrentPath$)
					EndIf
				Case #BtnOpen
					tmp$ = OpenFileRequester(Lng(1), GetCurrentDirectory(), "PureBasic (*.pb)|*.pb;*.pbi|(*.*)|*.*", 0)
					If Asc(tmp$)
						OpenDoc(tmp$)
					EndIf
				Case #ReRead
					SplitA2(GetGadgetText(#Edit), aTrslText(),  #CRLF$)
					CountStr = ArraySize(aTrslText())
					SetGadgetText(#StatusBar, Lng(3) + " - " + Str(CountStr) + " " + Lng(2))
				Case #Translated
					If Not Asc(sCurrentPath$) Or Not CountStr
						Continue
					EndIf
					SplitA2(GetGadgetText(#EditTranslation), aTrslTextNew(),  #CRLF$)
					
					; _ArrayDisplay(aTrslTextNew(), "Array")
					CountStrNew = ArraySize(aTrslTextNew())
					If CountStrNew <> CountStr And MessageRequester(Lng(9), Lng(10) + " (" + CountStrNew + "<>" + CountStr + ") " + Lng(11), #PB_MessageRequester_YesNo) = #PB_MessageRequester_No
						Continue
					EndIf
					iCountCur = 0
					n = 0
; 					Выбираем наименьшее число строк
					If CountStrNew < CountStr
						iCount3 = CountStrNew
					Else
						iCount3 = CountStr
					EndIf
					; Делаем копию переменной, потому что можно применить повторную операцию без переоткрытия файла.
					sTmpTextOut$ = sTextOrig$
					If flgArr ; если конструкция в виде массива, то
						sArrayVarText$ = "" ; Формирования кода массива
						sArrayVarTextNew$ = "If UserIntLang = 1049" + #CRLF$ ; Формирования кода массива переведённого
						For i = 0 To iCount3
							If aTrslText(i) <> aTrslTextNew(i)
								Occurrences = CountString(sTmpTextOut$, aTrslText(i))
								If Occurrences
									n +1
									sArrayVarText$ + "Lng(" + n + ") = " + aTrslTextNew(i) + #CRLF$ ; Формирования кода элементов массива
									sArrayVarTextNew$ + #TAB$ + "Lng(" + n + ") = " + aTrslText(i) + #CRLF$ ; Формирования кода элементов массива
									sTmpTextOut$ = ReplaceString(sTmpTextOut$, aTrslText(i), "Lng(" + Str(n) + ")", 0, 1)
									iCountCur + Occurrences
								EndIf
							EndIf
						Next
						sTmpTextOut$ = textLang$ + #CRLF$ + #CRLF$ + "Global Dim Lng.s(" + Str(n) + ")" + #CRLF$ + sArrayVarText$ + #CRLF$ + sArrayVarTextNew$ + "EndIf" + #CRLF$ + #CRLF$ + sTmpTextOut$
					Else
						For i = 0 To iCount3
							If aTrslText(i) <> aTrslTextNew(i)
								Occurrences = CountString(sTmpTextOut$, aTrslText(i))
								If Occurrences
									sTmpTextOut$ = ReplaceString(sTmpTextOut$, aTrslText(i), aTrslTextNew(i), #PB_String_CaseSensitive)
									iCountCur + Occurrences
								EndIf
							EndIf
						Next
					EndIf
					SetClipboardText(sTmpTextOut$)
					SetGadgetText(#StatusBar, Lng(8) + " " + iCountCur)
; 					очищаем переменные
					sTmpTextOut$ = ""
					ReDim aTrslTextNew(0)
			EndSelect
		Case #PB_Event_CloseWindow
			
			If isINI And OpenPreferences(ini$)
				w = WindowWidth(#Window)
				If w <> DspW
					WritePreferenceInteger("width", w)
				EndIf
				h = WindowHeight(#Window)
				If h <> DspH
					WritePreferenceInteger("height", h)
				EndIf
				If CharacterSet0$ <> CharacterSet$
					ReadPreferenceString("char", CharacterSet$)
				EndIf
				If flgArr0 <> flgArr
					WritePreferenceInteger("array", flgArr)
				EndIf
				If flgLRange0 <> flgLRange
					WritePreferenceInteger("range", flgLRange)
				EndIf
				splitter = GetGadgetState(#Splitter)
				If splitter0 <> splitter
					WritePreferenceInteger("splitter", splitter)
				EndIf
				ClosePreferences()
			EndIf
			
			DestroyIcon_(hIcon1)
			DestroyIcon_(hIcon2)
			DestroyIcon_(hIcon3)
			DestroyIcon_(hIcon4)
			DestroyIcon_(hIcon5)
			DestroyIcon_(hIcon6)
			CloseWindow(#Window)
			End
	EndSelect
ForEver

;-└──Loop──┘

Procedure WindowSize()
	Protected w, h
	h = WindowHeight(#Window)
	w = WindowWidth(#Window)
	ResizeGadget(#Splitter, #PB_Ignore, #PB_Ignore, w - 10, h - 50)
	ResizeGadget(#StatusBar, #PB_Ignore, h - 20, w - 10, #PB_Ignore)
EndProcedure

Procedure Setting()
; 	aRect = _GetChildCoor(WindowID(#Window), 410, 240)
	DisableWindow(#Window, #True)
	
	OpenWindow(#WinSet, 0, 0,  410, 240, Lng(4), #PB_Window_SystemMenu | #PB_Window_WindowCentered, WindowID(#Window))

	CheckBoxGadget(#ChRpc, 5, 5, 400, 25, Lng(12))
	If flgArr
		SetGadgetState(#ChRpc, #PB_Checkbox_Checked)
	EndIf

	CheckBoxGadget(#ChLRange, 5, 35, 400, 25, Lng(15))
	If flgLRange
		SetGadgetState(#ChLRange, #PB_Checkbox_Checked)
	EndIf
	
	StringGadget(#StrCharSet, 20, 65, 370, 30, "")
	SetGadgetText(#StrCharSet, CharacterSet$)
	
	ButtonGadget(#OK, (410 - 60) / 2, 240 - 35, 60, 30, "OK")
	

;-┌──Loop──┐
	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #OK
						If GetGadgetState(#ChRpc) & #PB_Checkbox_Checked
							flgArr = 1
						Else
							flgArr = 0
						EndIf
						CharacterSet$ = GetGadgetText(#StrCharSet)
						If Asc(CharacterSet$)
							If GetGadgetState(#ChLRange) & #PB_Checkbox_Checked
								flgLRange = 1
								ParseLang(CharacterSet$)
							Else
								flgLRange = 0
							EndIf
						EndIf
; 						If UserIntLang = 1033
; 							flgLRange = 0
; 						EndIf
						DisableWindow(#Window, #False)
						CloseWindow(#WinSet)
						Break
				EndSelect
			Case #PB_Event_CloseWindow
				DisableWindow(#Window, #False)
				CloseWindow(#WinSet)
				Break
		EndSelect
	ForEver
EndProcedure



Procedure.s ReadFileToVar(Path$)
	Protected id_file, Format, Text$

	id_file = ReadFile(#PB_Any, Path$)
	If id_file
		Format = ReadStringFormat(id_file)
		Text$ = ReadString(id_file, Format | #PB_File_IgnoreEOL)
		; 	Text$ = ReadString(id_file, #PB_UTF8 | #PB_File_IgnoreEOL)
		CloseFile(id_file)
	EndIf

	ProcedureReturn Text$
EndProcedure


; https://www.purebasic.fr/english/viewtopic.php?t=79183
Procedure.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
	Protected *jc0, *c.Character, *jc.Character
	
	If Not Asc(String$)
		ProcedureReturn ""
	EndIf
	
	*c = @String$
	*jc0 = @TrimChar$
	
	While *c\c
		*jc = *jc0
		
		While *jc\c
			If *c\c = *jc\c
				*c\c = 0
				Break
			EndIf
			*jc + SizeOf(Character)
		Wend
		
		If *c\c
			String$ = PeekS(*c)
			Break
		EndIf
		*c + SizeOf(Character)
	Wend
	
	ProcedureReturn String$
EndProcedure


; https://www.purebasic.fr/english/viewtopic.php?t=79183
Procedure.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
	Protected Len2, Blen, i
	Protected *jc0, *c.Character, *jc.Character
	
	Len2 = Len(String$)
	Blen = StringByteLength(String$)
	
	If Not Asc(String$)
		ProcedureReturn ""
	EndIf
	
	*c = @String$ + Blen - SizeOf(Character)
	*jc0 = @TrimChar$
	
	For i = Len2 To 1 Step - 1
		*jc = *jc0
		
		While *jc\c
			If *c\c = *jc\c
				*c\c = 0
				Break
			EndIf
			*jc + SizeOf(Character)
		Wend
		
		If *c\c
			Break
		EndIf
		*c - SizeOf(Character)
	Next
	
	ProcedureReturn String$
EndProcedure


Procedure ParseLang(CharacterSet$)
    Protected *c.Unicode
    Protected pos, tmp$
	Repeat
		pos = FindString(CharacterSet$, "-")
; 		Debug pos
; 		Debug Len(CharacterSet$)
		If Not pos
			Break
		ElseIf pos = 1 Or pos = Len(CharacterSet$)
			ClearList(Ranges())
			ClearList(Letters())
; 			Debug "Error"
			ProcedureReturn -1
; 			End
		ElseIf pos
			tmp$ = Mid(CharacterSet$, pos - 1, 3)
			CharacterSet$ = ReplaceString(CharacterSet$, tmp$, "", #PB_String_CaseSensitive, 1, 1)
			If AddElement(Ranges())
				Ranges()\start = Asc(tmp$)
				Ranges()\end0 = Asc(Mid(tmp$, 3))
			EndIf
		EndIf
	ForEver
	
	*c = @CharacterSet$
	While *c\u
		If AddElement(Letters())
			Letters() = *c\u
		EndIf
		*c + SizeOf(Unicode)
	Wend
EndProcedure

Procedure IsLangRange(*text)
    Protected flag = #False, *c.Unicode = *text

    If *c = 0 Or *c\u = 0
        ProcedureReturn 0
    EndIf
    
    Repeat
    	ForEach Ranges()
    		If *c\u >= Ranges()\start And *c\u <= Ranges()\end0
    			ProcedureReturn 1
    		EndIf
    	Next
    	ForEach Letters()
    		If *c\u = Letters()
    			ProcedureReturn 1
    		EndIf
    	Next
    	*c + SizeOf(Unicode)
    Until Not *c\u
    ProcedureReturn 0
EndProcedure

; Здесь указан русский диапазон, как пример оптимизированный индивидуальной функции.
Procedure IsLangRange2(*text)
    Protected flag = #False, *c.Character = *text

    If *c = 0 Or *c\c = 0
        ProcedureReturn 0
    EndIf

    Repeat
;- ► Specify language ◄
        If (*c\c >= 'А' And *c\c <= 'я') Or  *c\c = 'ё' Or  *c\c = 'Ё'
            flag = #True
            Break
        EndIf
        *c + SizeOf(Character)
    Until Not *c\c

    ProcedureReturn flag
EndProcedure


Procedure CallbackGetString(*Position, Length, TypeToken)
	Protected tmp$, *mem
	
	If TypeToken = #SYNTAX_String
		*mem = AllocateMemory(Length + 2)
		CopyMemory(*Position, *mem, Length)
		tmp$ = PeekS(*mem, -1, #PB_UTF8)
		FreeMemory(*mem)
		; tmp$ = PeekS(*Position, Length, #PB_UTF8)
		tmp$ = LTrimChar(tmp$)
		tmp$ = RTrimChar(tmp$)
; 		Debug "|" + tmp$ + "|"
		If UCase(tmp$) <> LCase(tmp$) ; если в нижнем и верхнем регистре текст изменяется, то требуется перевод и строка добавляется
			If flgLRange
				If  IsLangRange(@tmp$) ; если хоть один символ русский, то требуется перевод и строка добавляется
					AddMapElement(LangStrMap(), tmp$)
				EndIf
			Else
				AddMapElement(LangStrMap(), tmp$)
			EndIf
		EndIf
	EndIf
EndProcedure

; https://www.purebasic.fr/english/viewtopic.php?p=581152#p581152
Procedure.i Is64BitOS()
	Protected HDLL, IsWow64Process_, Is64BitOS
	If SizeOf(Integer) = 8
		Is64BitOS = 1 ; this is a 64 bit exe
	Else
		HDll = OpenLibrary(#PB_Any, "kernel32.dll")
		If HDll
			IsWow64Process_ = GetFunction(HDll, "IsWow64Process")
			If IsWow64Process_
				CallFunctionFast(IsWow64Process_, GetCurrentProcess_(), @Is64BitOS)
			EndIf
			CloseLibrary(HDll)
		EndIf
	EndIf
	ProcedureReturn Is64BitOS
EndProcedure

Procedure GetString(InputFile$)
	Protected *Buffer, Length, file_id, c, i, Format, bytes, tmp$, isFind, PathDLL$

	; Нативная библиотека, которая идеально парсит код PureBasic
	If Not Lib_id
		CompilerIf #PB_Compiler_Debugger
			Lib_id = OpenLibrary(#PB_Any, #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll")
		CompilerElse
			PathDLL$ = "C:\Program Files\PureBasic\SDK\Syntax Highlighting\SyntaxHighlighting.dll"
			If Is64BitOS() And SizeOf(Integer) = 4
				PathDLL$ = "C:\Program Files\PureBasic (x86)\SDK\Syntax Highlighting\SyntaxHighlighting.dll"
			EndIf
			If FileSize(PathDLL$) < 3
				PathDLL$ = GetPathPart(ProgramFilename()) + "SyntaxHighlighting.dll"
			EndIf
			If FileSize(PathDLL$) < 3
				tmp$ = OpenFileRequester("", "", "SyntaxHighlighting.dll|SyntaxHighlighting.dll", 0)
				If Asc(tmp$)
					PathDLL$ = tmp$
				Else
					MessageRequester("Cancel", Lng(14))
					End
				EndIf
			EndIf
			If FileSize(PathDLL$) < 3
				MessageRequester("", Lng(14) + #CRLF$ + #CRLF$ + PathDLL$)
				End
			EndIf
; 			MessageRequester("PathDLL$", PathDLL$)
			Lib_id = OpenLibrary(#PB_Any, PathDLL$)
			If Lib_id
				If ExamineLibraryFunctions(Lib_id)
					While NextLibraryFunction()
; 						MessageRequester("функ", LibraryFunctionName())
						If LibraryFunctionName() = "SyntaxHighlight" ; ищем наличие функции, так как битность может не соответствовать или левая либа
							isFind = 1
						EndIf
					Wend
					If Not isFind
						CloseLibrary(Lib_id)
						Lib_id = 0
					EndIf
				EndIf
			EndIf
		CompilerEndIf
		If Not Lib_id
			MessageRequester("x86? x64?", Lng(14) + #CRLF$ + #CRLF$ + PathDLL$)
			End
		EndIf
	EndIf
	file_id = ReadFile(#PB_Any, InputFile$, #PB_UTF8) ; And CreateFile(#Output, OutputFile$)
	If file_id
		Format = ReadStringFormat(file_id)
		Length = Lof(file_id)
		*Buffer = AllocateMemory(Length)
		
		If *Buffer
			bytes = ReadData(file_id, *Buffer, Length)
			sTextOrig$ = PeekS(*Buffer, bytes, #PB_UTF8)
			CallFunction(Lib_id, "SyntaxHighlight", *Buffer, bytes, @CallbackGetString(), 0)
			FreeMemory(*Buffer)
			
; 			почему экспорт в массив? потому что порядок строк имеет значение
			c = MapSize(LangStrMap())
			ReDim aTrslText(c)
			i = 0
			ForEach LangStrMap()
				aTrslText(i) = MapKey(LangStrMap())
				i + 1
			Next
			
		EndIf
		
		CloseFile(file_id)
	EndIf

	ProcedureReturn
EndProcedure

; wilbert
; https://www.purebasic.fr/english/viewtopic.php?p=486382#p486382
Procedure.s Join(Array StringArray.s(1), Separator.s = " ")
	
	Protected asize, i, slen, tlen, *buffer
	asize = ArraySize(StringArray())
	slen = Len(Separator)
	For i = 0 To asize
		tlen + Len(StringArray(i)) + slen
	Next
	tlen - slen
	
	Protected Dim buffer.c(tlen)
	*buffer = @buffer()
	CopyMemoryString(StringArray(0), @*buffer)
	For i = 1 To asize
		CopyMemoryString(Separator)
		CopyMemoryString(StringArray(i))
	Next
	
	ProcedureReturn PeekS(@buffer())
	
EndProcedure

Procedure OpenDoc(sFilePath$)
	Protected pos, sRes$
	ClearMap(LangStrMap()) 
	pos = FindString(sFilePath$, #LF$)
	If pos
		sFilePath$ = Mid(sFilePath$, 1, pos - 1)
	EndIf
	If FileSize(sFilePath$) < 3
		ProcedureReturn ; Вылет если это не файл
	EndIf
	GetString(sFilePath$) ; Извлечение текстов
	
	; 	sTextOrig$ = ReadFileToVar(Path$)
	Tmp$ = sTextOrig$
	sRes$ = ""
	sCurrentPath$ = sFilePath$
	CountStr = ArraySize(aTrslText())
	SetWindowTitle(#Window, Lng(0) + " (" + GetFilePart(sCurrentPath$) + ")")
	If CountStr
		sRes$ = Join(aTrslText(), #CRLF$) ; объединение
		sRes$ = RTrimChar(sRes$, #CRLF$)
		SetGadgetText(#Edit, sRes$)
	Else
		ProcedureReturn Clear()
	EndIf
	SetGadgetText(#StatusBar, Lng(3) + " - " + Str(CountStr) + " " + Lng(2))
	SetActiveGadget(#Edit)
EndProcedure

Procedure Clear()
; 	sCurrentPath$ = ""
	sTextOrig$ = ""
	CountStr = 0
	ReDim aTrslText(0)
	SetGadgetText(#Edit, "")
; 	SetWindowTitle(#Window, Lng(0))
	SetGadgetText(#StatusBar, Lng(17))
EndProcedure

Procedure SplitA2(String$, Array StringList.s(1), Separator$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
    Protected *S.Integer = @String$
    Protected *jc.Character, *c.Character = @String$
    Protected i

    i = 0
    While *c\c
        *jc = @Separator$

        While *jc\c
            If *c\c = *jc\c
                *c\c = 0
                If *S <> *c
                	ReDim StringList(i)
                    StringList(i) = PeekS(*S)
                    i + 1
                EndIf
                *S = *c + SizeOf(Character)
                Break
            EndIf
            *jc + SizeOf(Character)
        Wend

        *c + SizeOf(Character)
    Wend
    ReDim StringList(i)
    StringList(i) = PeekS(*S)
EndProcedure
AZJIO
Addict
Addict
Posts: 1364
Joined: Sun May 14, 2017 1:48 am

Re: [IDE tool] Code Localization

Post by AZJIO »

The path to the dll is now viewed in two directories and next to the executable and is offered to open if not found, and with a function search so that it does not turn out to be a third-party library

A universal option has been added with support for specifying a range or listing characters for captured strings (files with the Uni suffix).
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: [IDE tool] Code Localization

Post by Kwai chang caine »

Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
AZJIO
Addict
Addict
Posts: 1364
Joined: Sun May 14, 2017 1:48 am

Re: [IDE tool] Code Localization

Post by AZJIO »

I made my own string parser to capture quoted strings. Lines starting with a tilde (~) are supported.
Now you can try this on Linux, since it does not require a dll.
I added two sources to the archive with the suffix "Enum"
Download

When testing I got a strange thing. At the end of the GetString() function there is the following code:

Code: Select all

	c = MapSize(LangStrMap())
; 	Debug c
	ReDim aTrslText(c - 1)
; 	Debug  ArraySize(aTrslText())
Try opening a file in this program that does not contain a quoted string. The MapSize() function returns 0, and the ArraySize() function returns -1. If I explicitly specify ReDim Arr(-1), I get a warning from the compiler that a negative number cannot be used.
AZJIO
Addict
Addict
Posts: 1364
Joined: Sun May 14, 2017 1:48 am

Re: [IDE tool] Code Localization

Post by AZJIO »

Simplified the character-by-character enumeration loop
Post Reply