PureBasic Forums - English

Code: Select all

;- TOP
; AZJIO 2024

EnableExplicit


Global UserIntLang

CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Windows
		Global *Lang
		If OpenLibrary(0, "kernel32.dll")
			*Lang = GetFunction(0, "GetUserDefaultUILanguage")
			If *Lang And CallFunctionFast(*Lang) = 1049 ; ru
				UserIntLang = 1
			EndIf
			CloseLibrary(0)
		EndIf
	CompilerCase #PB_OS_Linux
		If ExamineEnvironmentVariables()
			While NextEnvironmentVariable()
				If Left(EnvironmentVariableName(), 4) = "LANG" And Left(EnvironmentVariableValue(), 2) = "ru"
					; LANG=ru_RU.UTF-8
					; LANGUAGE=ru
					UserIntLang = 1
					Break
				EndIf
			Wend
		EndIf
CompilerEndSelect


Global Dim Lng.s(17)
Lng(0) = "CommentLocalization"
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
	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

; Не используются внешние файлы локализации так как инструмент предназначен
; только для PureBasic и может быть скомпилирован самостоятельно на родном языке


;- ● #Constants
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

UseGIFImageDecoder()

XIncludeFile "ForCommentLocalization.pb"

; #Dummy = 0

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



;- ● Global
Global tmp, tmp$, sCurrentPath$, sTextOrig$, CountStr
Global Lib_id
Global NewMap LangStrMap()
Global ArrSz = 1000
Global Dim aTrslText.s(ArrSz)
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
Define Count

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()) + "CommentLocalization.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)
	ignorset = ReadPreferenceInteger("ignorset", ignorset)
	flgLRange = ReadPreferenceInteger("range", flgLRange)
	CharacterSet$ = ReadPreferenceString("char", "")
	ClosePreferences()
EndIf
; кешируем для сравнения и сохранения в ini
w = DspW
h = DspH
CharacterSet0$ = CharacterSet$
flgLRange0 = flgLRange
splitter0 = splitter


;- Data
DataSection
	CompilerIf #PB_Compiler_OS = #PB_OS_Linux
		IconTitle:
		IncludeBinary "images" + #PS$ + "icon.gif"
		IconTitleend:
	CompilerEndIf
	folder:
	IncludeBinary "images" + #PS$ + "folder.gif"
	folderend:
	chbox:
	IncludeBinary "images" + #PS$ + "chbox.gif"
	chboxend:
	do:
	IncludeBinary "images" + #PS$ + "do.gif"
	doend:
	set:
	IncludeBinary "images" + #PS$ + "set.gif"
	setend:
	save:
	IncludeBinary "images" + #PS$ + "save.gif"
	saveend:
	re:
	IncludeBinary "images" + #PS$ + "re.gif"
	reend:
EndDataSection

CatchImage(0, ?folder)
CatchImage(1, ?chbox)
CatchImage(2, ?do)
CatchImage(3, ?set)
CatchImage(4, ?save)
CatchImage(5, ?re)
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
	CatchImage(6, ?IconTitle)
CompilerEndIf

;-┌──GUI──┐
OpenWindow(#Window, 0, 0, DspW, DspH, Lng(0), #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
	gtk_window_set_icon_(WindowID(#Window), ImageID(6)) ; назначаем иконку в заголовке
CompilerEndIf
WindowBounds(#Window, 250, 250, #PB_Ignore, #PB_Ignore) 

ButtonImageGadget(#BtnOpen, 5, 4, 28, 28, ImageID(0))
GadgetToolTip(#BtnOpen, Lng(1))

ButtonImageGadget(#ReOpen, 45, 4, 28, 28, ImageID(5))
GadgetToolTip(#ReOpen, Lng(16))

ButtonImageGadget(#ReRead, 85, 4, 28, 28, ImageID(1))
GadgetToolTip(#ReRead, Lng(6))

ButtonImageGadget(#Translated, 125, 4, 28, 28, ImageID(2))
GadgetToolTip(#Translated, Lng(5))

ButtonImageGadget(#Setting, 165, 4, 28, 28, ImageID(3))
GadgetToolTip(#Setting, Lng(4))

ButtonImageGadget(#Save, 205, 4, 28, 28, ImageID(4))
GadgetToolTip(#Save, Lng(7))


EditorGadget(#Edit, 5, 40, DspW / 2 - 5, DspH - 60, #PB_Editor_WordWrap)
EditorGadget(#EditTranslation, 5, 40, DspW / 2 - 5, DspH - 60, #PB_Editor_WordWrap)
SplitterGadget(#Splitter, 5, 40, DspW - 10, DspH - 60, #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$)
; 	ForEach Ranges()
; 		Debug Chr(Ranges()\start)
; 		Debug Chr(Ranges()\end0)
; 	Next
; 	ForEach Letters()
; 		Debug Chr(Letters())
; 	Next
EndIf

	CompilerIf #PB_Compiler_Debugger
; 		OpenDoc("C:\ProgramData\PureBasic\Examples\test\Source\zzz.pb")
; 	OpenDoc("C:\D\PureBasic\Source\!My_projects\Tools\CommentLocalization\CommentLocalization.pb")
	OpenDoc("/media/windows/D/PureBasic/Source/!My_projects/Tools/CommentLocalization/CommentLocalization.pb")
; 		OpenDoc("C:\ProgramData\PureBasic\Examples\Sources\CanvasGadget.pb")
CompilerElse

	; "%FILE" %TEMPFILE"
	Count = CountProgramParameters()
	For i = 1 To Count
		tmp$ = ProgramParameter()
		; две кавычки. Если несохранённый файл, то его путь пустой, лишь обрамляющие кавычки.
		; Проверяем что файл существует, что расширение pb*, что путь ещё не принят (если принят, то второй раз не берём)
		If Asc(tmp$) And FileSize(tmp$) > 3 And Left(GetExtensionPart(tmp$), 2) = "pb"
			Break
		EndIf
	Next

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$
					
					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
					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 flgLRange0 <> flgLRange
					WritePreferenceInteger("range", flgLRange)
				EndIf
				splitter = GetGadgetState(#Splitter)
				If splitter0 <> splitter
					WritePreferenceInteger("splitter", splitter)
				EndIf
				ClosePreferences()
			EndIf
			
			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 - 60)
	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))

	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 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 GetString(InputFile$)
	Protected flgOpnQt, c, i, tilda
	Protected id_file, Format, Text$, *c.Character
	Protected NewMap LangStrMap()
; 	MessageRequester("", InputFile$)

	id_file = ReadFile(#PB_Any, InputFile$)
	If id_file
		Format = ReadStringFormat(id_file)
		; 		тут можно прочитать целиком в оригинал и поставить указатель в 0
		sTextOrig$ = ReadString(id_file, Format | #PB_File_IgnoreEOL)
		FileSeek(id_file, 0)
		Format = ReadStringFormat(id_file) ; ещё раз перемещаем указатель на ширину метки BOM
		While Not Eof(id_file)
			Text$ = ReadString(id_file, Format) ; читаем построчно, так легче анализировать
								
			; удаление настроек компилятора. Если встречена строка, то дальше не читаем
			If ignorset And Asc(Text$) = ';' And Left(Text$, 25) = "; IDE Options = PureBasic"
				Break
			EndIf

			Text$ = LTrimChar(Text$, #TAB$ + " ") ; удаляем табы и пробелы в начале строки
			If Asc(Text$) = '!' ; если строка начинается с !, что значит ASM, то пропускаем эту строку, так как ";" не является символом комментария
				Continue
			EndIf
; 			Debug Text$
			*c = @Text$
			flgOpnQt = 0 ; сбросили флаг
			While *c\c
				Select *c\c
						
;- '
					Case 39 ; ' ' апостроф
						If flgOpnQt = 0 ; если кавычка не открыта, то
							*c + SizeOf(Character)
							If *c\c = 0 : Break : EndIf
							If *c\c = 39
								*c + SizeOf(Character)
								Continue
							EndIf
							Repeat
								*c + SizeOf(Character)
							Until *c\c = 0 Or *c\c = 39 ; идём до конца строки или до заканчивающегося апострофа
							If *c\c = 0 : Break : EndIf ; выпрыг, если конец строки или апостроф в ненадлежащем месте.
						EndIf
						
;- "
					Case '"'
						If tilda
							Select tilda
								Case 1, 3
									tilda = 2
									*c + SizeOf(Character)
									Continue
								Case 2
									; пришли к завершающей кавычке и срабатывает ниже условие flgOpnQt, так как нет Continue по тексту
									tilda = 0
							EndSelect
						EndIf
						
; 						Debug flgOpnQt

						If flgOpnQt
; 							Попалась последняя кавычка, закрывающая
							flgOpnQt = 0
						Else
; 							Попалась первая кавычка, открывающая
							flgOpnQt = 1
						EndIf
;- \
					Case '\'
						; этот механизм чисто для проверки экранированных кавычек после тильды
						; двойная проверка флагов изменяет поведение при дублировании слеша
						Select tilda
							Case 2
								tilda = 3
							Case 3
								tilda = 2
						EndSelect
;- ;
					Case ';'
						; Debug "комент, если нет открытой кавычки"
						If Not flgOpnQt
							tmp$ = PeekS(*c)
							If Not FindMapElement(LangStrMap(), tmp$)
								
								AddMapElement(LangStrMap(), tmp$)
								; почему в массив? потому что порядок строк имеет значение,
								; 								а также сортировка без перемешивания, которое происходит в карте
								
								If UCase(tmp$) <> LCase(tmp$) ; если в нижнем и верхнем регистре текст изменяется, то требуется перевод и строка добавляется
									If flgLRange
										If IsLangRange(@tmp$) ; если хоть один символ в разрешённом диапазоне, то требуется перевод и строка добавляется
											aTrslText(i) = tmp$
											i + 1
											If i > ArrSz
												ArrSz * 2
												ReDim aTrslText(ArrSz)
											EndIf
										EndIf
									Else
										aTrslText(i) = tmp$
										i + 1
										If i > ArrSz
											ArrSz * 2
											ReDim aTrslText(ArrSz)
										EndIf
									EndIf
								EndIf
							EndIf
							Break ; выпрыгиваем, так как прочитали всю строку до конца и нет смысла её анализировать.
						EndIf
;- ~
					Case '~'
						If flgOpnQt = 0 ; если комментарий не открыт, то начинаем считать что открылись тильда-данные
							*c + SizeOf(Character)
							If *c\c = '"' ; тильда может быть как знак "НЕ", поэтому ещё проверяем кавычку
								flgOpnQt = 1 ; режим открытия кавычки, начинаем ждать закрывающую (кроме начальной и экранированных)
								tilda = 1	 ; включаем флаг запуска тильды
							EndIf
							*c - SizeOf(Character)
						EndIf
				EndSelect
				*c + SizeOf(Character)
			Wend
		Wend
		CloseFile(id_file)
	EndIf

	If i - 1 < ArrSz
		ArrSz = i - 1
		ReDim aTrslText(ArrSz)
	EndIf
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 >= 0
		sRes$ = Join(aTrslText(), #CRLF$) ; объединение
		sRes$ = RTrimChar(sRes$, #CRLF$)
		SetGadgetText(#Edit, sRes$)
	Else
		ProcedureReturn Clear()
	EndIf
	SetGadgetText(#StatusBar, Lng(3) + " - " + Str(CountStr + 1) + " " + Lng(2))
	SetActiveGadget(#Edit)
EndProcedure

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

Code: Select all

; Mac IDE Tool (no parameters needed) to quickly translate selected text via Right-Click (and more…)
shell = RunProgram("/bin/sh","","", #PB_Program_Open|#PB_Program_Write|#PB_Program_Read)
WriteProgramStringN(shell,~"osascript -e 'tell application \"System Events\" to tell UI element 1 of"+
   ~" scroll area 1 of group 1 of group 1 of splitter group 1 of splitter group 1 of window 1 of process "+
   ~"\"PureBasic\" to get value of attribute \"AXSelectedText\"'"):WriteProgramData(shell,#PB_Program_Eof,0)
While ProgramRunning(shell):If AvailableProgramOutput(shell):Output$ + ReadProgramString(shell)+~"\n":EndIf
Wend:CloseProgram(shell)
OpenWindow(0,0,0,922,450,"Right-Click on Text",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
EditorGadget(0, 8, 8, 906, 433) : SetGadgetText(0, Left(Output$,Len(Output$)-1))
Range.NSRange:Range\location=0:Range\length=-1:CocoaMessage(0,GadgetID(0),"setSelectedRange:@",@Range)
SetActiveGadget(0):Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

Code: Select all

tell application "System Events"
	set sel to value of attribute "AXSelectedText" of text area 1 of scroll area 1 of group 1 of group 1 of splitter group 1 of splitter group 1 of item 1 of (windows of application process "PureBasic" whose name begins with "PureBasic")
	set sel to (do shell script "export PATH=\"/opt/homebrew/bin:$PATH\";/usr/local/bin/trans -b :en " & quoted form of sel)
	set btn to button returned of (display dialog sel with title "Translation" with icon caution buttons {"Cancel", "Replace"} default button 2)
	tell application "PureBasic" to activate
	tell application process "PureBasic" to keystroke (sel as string)
end tell

Code: Select all

If OpenWindow(0, 0, 0, 200, 60, "ButtonImageGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If LoadImage(0,  #PB_Compiler_Home + "examples/sources/Data/CDPlayer.ico")
    ButtonImageGadget(0, 10, 10, 180, 40, ImageID(0))
    SetGadgetText(0, "This text shows over the image :(")
  EndIf
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Code: Select all

If OpenWindow(0, 0, 0, 200, 60, "ButtonImageGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If LoadImage(0,  #PB_Compiler_Home + "examples/sources/Data/CDPlayer.ico")
    hwnd = ButtonGadget(0, 10, 10, 180, 40, "This text shows over the image :(", #BS_ICON)
    SendMessage_(hwnd, #BM_SETIMAGE, #IMAGE_ICON, ImageID(0))
  EndIf
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf