ColorText

AZJIO · Post by **AZJIO** » Wed May 21, 2025 9:11 pm

ColorText

Allows you to get a text like this

Download: yandex, upload.ee

; AZJIO 21.05.2025
;- TOP
EnableExplicit

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

#CountStrLang = 10
Global Dim Lng.s(#CountStrLang)
Lng(1) = "BBcode to clipboard"
Lng(2) = "Number of loops"
Lng(3) = "Spectrum Range"
Lng(4) = "Tone Shift"
Lng(5) = "Bold"
Lng(6) = "Italic"
Lng(7) = "Back"
Lng(8) = "Correction"
Lng(9) = "Happy Birthday!!!"
Lng(10) = "Done"

If UserIntLang = 1049 ; ru
	Lng(1) = "BBcode в буфер обмена"
	Lng(2) = "Количество циклов"
	Lng(3) = "Диапазон спектра"
	Lng(4) = "Сдвиг тона"
	Lng(5) = "Жирный"
	Lng(6) = "Курсив"
	Lng(7) = "Обратно"
	Lng(8) = "Коррекция"
	Lng(9) = "Поздравляю с днём рождения!!!"
	Lng(10) = "Готово"
EndIf

;- # Constants
#Window = 0

;- ● Enumeration
Enumeration
	#txt1
	#cbx
	#btn1
	#tbg1
	#tbg2
	#tbg3
	#EditorRTF
	#bold
	#italic
	#Reverse
	#correction
	#txtLoop
	#txtNumLoop
	#txtRange
	#txtNumRange
	#txtShift
	#txtNumShift
EndEnumeration

;- ● Global
Global tmp
Global loops0 = 1, Range0 = 360, Shift0
Global hTrackBar1, hTrackBar2, hTrackBar3
Global RTFtext$, text$, RTFColorTable$, Len1, Len2
Global Bold$, italic$, Font$, correction, Reverse
Global RTFHeaderPart1$ = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fnil\fcharset204 Arial;}}{\colortbl;"
Global RTFHeaderPart2$ = "}{\*\generator Riched20 10.0.16299}\viewkind4\uc1\pard\f0\fs"
Global Dim arr_rgb(2)
Global Dim arr_hsb(2)
arr_hsb(1) = 100
arr_hsb(2) = 100


Define CharFormat.CHARFORMAT


;- ● Declare
Declare hsb_to_rgb()
Declare ToBBcode()
Declare SizeHandler()
Declare Start()
Declare WindowCallback(WindowId, Message, wParam, lParam)
Declare SetTextRTF()

;-┌──GUI──┐
If OpenWindow(#Window, 0, 0, 560, 315, "ColorText",
              #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget)
	WindowBounds(#Window, 560, 200, #PB_Ignore, #PB_Ignore)
; 	TextGadget(#txt1, 10, 12, 60, 20, "Образцы:")
; 	ComboBoxGadget(#cbx, 70, 10, 110, 25)
	ButtonGadget(#btn1, 200, 10, 240, 25,  Lng(1))
	hTrackBar1 = TrackBarGadget(#tbg1, 185, 40, 270, 30, 1, 10)
	hTrackBar2 = TrackBarGadget(#tbg2, 185, 70, 270, 30, 0, 360)
	SetGadgetState(#tbg2, Range0)
	hTrackBar3 = TrackBarGadget(#tbg3, 185, 100, 270, 30, 0, 360)
	EditorGadget(#EditorRTF , 10, 145, 540, 160)
	SendMessage_(GadgetID(#EditorRTF), #EM_SETTEXTMODE, #TM_RICHTEXT, 0)
	
	TextGadget(#txtLoop, 10, 45, 145, 30, Lng(2))
	TextGadget(#txtNumLoop, 155, 45, 30, 30, "1")
	TextGadget(#txtRange, 10, 75, 145, 30, Lng(3))
	TextGadget(#txtNumRange, 155, 75, 30, 30, "360")
	TextGadget(#txtShift, 10, 105, 145, 30, Lng(4))
	TextGadget(#txtNumShift, 155, 105, 30, 30, "0")
	
	
	CheckBoxGadget(#bold, 460, 45, 95, 20, Lng(5))
	CheckBoxGadget(#italic, 460, 65, 95, 20, Lng(6))
	CheckBoxGadget(#Reverse, 460, 85, 95, 20, Lng(7))
	CheckBoxGadget(#correction, 460, 105, 95, 20, Lng(8))
	
	SetGadgetState(#bold, #PB_Checkbox_Checked)
	SetGadgetState(#italic, #PB_Checkbox_Checked)
	SetGadgetState(#correction, #PB_Checkbox_Checked)
	
	
	text$ = Lng(9)
	Len1 = Len(text$)
	Len2 = Len(ReplaceString(text$, " ", ""))
	; 	text$ = "Happy Birthday!!!"
	SetTextRTF()

	SetWindowCallback(@WindowCallback())
	BindEvent(#PB_Event_SizeWindow, @SizeHandler())
	

;-┌──Loop──┐
	Repeat
		Select WaitWindowEvent()
;- ├ Gadget
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #btn1
; 						text$ = GetGadgetText(#EditorRTF)
						ToBBcode()
					Case #Reverse
						Reverse = GetGadgetState(#Reverse) & #PB_Checkbox_Checked
						Start()
					Case #correction
						correction = GetGadgetState(#correction) & #PB_Checkbox_Checked
						Start()
					Case #bold
						If GetGadgetState(#bold) & #PB_Checkbox_Checked
							Bold$ = "\b"
						Else
							Bold$ = ""
						EndIf
						SetGadgetText(#EditorRTF, RTFHeaderPart1$ + RTFColorTable$ + RTFHeaderPart2$ + Font$ + Bold$ + italic$ + RTFtext$ + "}")

					Case #italic
						If GetGadgetState(#italic) & #PB_Checkbox_Checked
							italic$ = "\i"
						Else
							italic$ = ""
						EndIf
						SetGadgetText(#EditorRTF, RTFHeaderPart1$ + RTFColorTable$ + RTFHeaderPart2$ + Font$ + Bold$ + italic$ + RTFtext$ + "}")
						
; 						Debug 1
					Case #EditorRTF
						Select EventType()
							Case #PB_EventType_Change
								SendMessage_(GadgetID(#EditorRTF), #EM_GETSEL, @tmp, 0)
								text$ = GetGadgetText(#EditorRTF)
								Len1 = Len(text$)
								Len2 = Len(ReplaceString(text$, " ", ""))
								SetTextRTF()
								SendMessage_(GadgetID(#EditorRTF), #EM_SETSEL, tmp, tmp)
						EndSelect
				EndSelect
			Case #PB_Event_CloseWindow
				CloseWindow(#Window)
				End
		EndSelect
	ForEver
;-└──Loop──┘
EndIf


Procedure WindowCallback(WindowId, Message, wParam, lParam)
	Protected Result = #PB_ProcessPureBasicEvents, nScrollCode, value

	Select Message
		Case #WM_HSCROLL
			;             Это (LoWord и HiWord) должно быть в Protected процедуры а не под #WM_HSCROLL, если используется другие WM_Сообщения
			nScrollCode = wParam & $FFFF ; LoWord
			value = wParam >> 16   ; HiWord

			Select nScrollCode
				Case #SB_THUMBTRACK, #SB_THUMBPOSITION;, #SB_PAGELEFT, #SB_PAGERIGHT, #SB_LINELEFT, #SB_LINERIGHT
					Select lParam
						Case hTrackBar1
							loops0 = value
							Start()
							SetGadgetText(#txtNumLoop, Str(value))
						Case hTrackBar2
							Range0 = value
							Start()
							SetGadgetText(#txtNumRange, Str(value))
						Case hTrackBar3
							Shift0 = value
							Start()
							SetGadgetText(#txtNumShift, Str(value))
					EndSelect
			EndSelect

	EndSelect
	ProcedureReturn Result
EndProcedure

Procedure ToBBcode()
	Protected *c.Character = @text$
	Protected Brightness = 100, *m, *p
	Protected delta, tmp$
	If Len2 < 2
		ProcedureReturn
	EndIf
	delta = Range0 * loops0 / (Len2 - 1)
	
	If Reverse
		arr_hsb(0) = 359 - Shift0
	Else
		arr_hsb(0) = Shift0
	EndIf
	correction = GetGadgetState(#correction) & #PB_Checkbox_Checked

	*m = AllocateMemory(Len1 * 48 + 2)
	If Not *m
		ProcedureReturn 0
	EndIf
	*p = *m

	While *c\c
		If correction
			Select arr_hsb(0)
				Case 39 To 43
					Brightness = 96
				Case 44 To 48
					Brightness = 93
				Case 49 To 53
					Brightness = 86
				Case 54 To 180
					Brightness = 82
				Case 181 To 190
					Brightness = 86
				Case 191 To 200
					Brightness = 90
				Default
					Brightness = 100
			EndSelect
		EndIf
		arr_hsb(2) = Brightness
		hsb_to_rgb()
		Select *c\c
			Case ' '
				CopyMemoryString(" ", @*p)
			Default
				CopyMemoryString("[color=#", @*p)
				CopyMemoryString(LSet(Hex(arr_rgb(0)), 2, "0"), @*p)
				CopyMemoryString(LSet(Hex(arr_rgb(1)), 2, "0"), @*p)
				CopyMemoryString(LSet(Hex(arr_rgb(2)), 2, "0"), @*p)
				CopyMemoryString("]", @*p)
				CopyMemoryString(Chr(*c\c), @*p)
				CopyMemoryString("[/color]", @*p)
		EndSelect
		*c + 2
		If Reverse
			arr_hsb(0) - delta
			If arr_hsb(0) < 0
				arr_hsb(0) + 360
			EndIf
		Else
			arr_hsb(0) + delta
		EndIf
	Wend
	tmp$ = PeekS(*m)
; 	Debug MemorySize(*m) ; выделено
; 	Debug StringByteLength(tmp$) ; требуется
	FreeMemory(*m)
	
	If Asc(italic$)
		tmp$ = "[i]" + tmp$ + "[/i]"
	EndIf
	If Asc(Bold$)
		tmp$ = "[b]" + tmp$ + "[/b]"
	EndIf
	
	SetClipboardText(tmp$)
	MessageRequester("BBcode", Lng(10))
EndProcedure

Procedure Start()
	Protected i, Brightness = 100
	Protected delta
	If Len2 < 2
		ProcedureReturn
	EndIf
	If Reverse
		arr_hsb(0) = 359 - Shift0
	Else
		arr_hsb(0) = Shift0
	EndIf
	RTFColorTable$ = ""
	delta = Range0 * loops0 / (Len2 - 1)
	correction = GetGadgetState(#correction) & #PB_Checkbox_Checked
	
	For i = 1 To Len2
		If correction
			Select arr_hsb(0)
				Case 39 To 43
					Brightness = 96
				Case 44 To 48
					Brightness = 93
				Case 49 To 53
					Brightness = 86
				Case 54 To 180
					Brightness = 82
				Case 181 To 190
					Brightness = 86
				Case 191 To 200
					Brightness = 90
				Default
					Brightness = 100
			EndSelect
		EndIf
		arr_hsb(2) = Brightness
		hsb_to_rgb()
		; 		наполняем таблицу цветами
; 		Debug arr_hsb(0)
		RTFColorTable$ + "\red" + arr_rgb(0) + "\green" + arr_rgb(1) + "\blue" + arr_rgb(2) + ";"
		
		If Reverse
			arr_hsb(0) - delta
			If arr_hsb(0) < 0
				arr_hsb(0) + 360
			EndIf
		Else
			arr_hsb(0) + delta
		EndIf
	Next

	SetGadgetText(#EditorRTF, RTFHeaderPart1$ + RTFColorTable$ + RTFHeaderPart2$ + Font$ + Bold$ + italic$ + RTFtext$ + "}")
EndProcedure


Procedure SetTextRTF()
	Protected *c.Character = @text$
	Protected i, Brightness = 100, *m, *p
	Protected delta
	If Len2 < 2
		ProcedureReturn
	EndIf
	delta = 360 / (Len2 - 1)
	
	If Reverse
		arr_hsb(0) = 359
	Else
		arr_hsb(0) = 0
	EndIf

	*m = AllocateMemory(Len1 * 16 + 2)
	If Not *m
		ProcedureReturn
	EndIf
	*p = *m
	RTFColorTable$ = ""
	correction = GetGadgetState(#correction) & #PB_Checkbox_Checked

	While *c\c
		Select *c\c
			Case ' '
				CopyMemoryString("\", @*p)
				CopyMemoryString(" ", @*p)
				*c + 2
				Continue
			Case '\', '}', '{'
				i + 1
				CopyMemoryString("\cf", @*p)
				CopyMemoryString(Str(i), @*p)
				CopyMemoryString("\", @*p)
				CopyMemoryString(Chr(*c\c), @*p)
			Default
				i + 1
				CopyMemoryString("\cf", @*p)
				CopyMemoryString(Str(i), @*p)
				CopyMemoryString(Chr(*c\c), @*p)
		EndSelect
		*c + 2
; 		arr_hsb(0) + delta
		If correction
			Select arr_hsb(0)
				Case 39 To 43
					Brightness = 96
				Case 44 To 48
					Brightness = 93
				Case 49 To 53
					Brightness = 86
				Case 54 To 180
					Brightness = 82
				Case 181 To 190
					Brightness = 86
				Case 191 To 200
					Brightness = 90
				Default
					Brightness = 100
			EndSelect
		EndIf
		arr_hsb(2) = Brightness
		hsb_to_rgb()
		; 		наполняем таблицу цветами
; 		Debug arr_hsb(0)
		RTFColorTable$ + "\red" + arr_rgb(0) + "\green" + arr_rgb(1) + "\blue" + arr_rgb(2) + ";"
		If Reverse
			arr_hsb(0) - delta
			If arr_hsb(0) < 0
				arr_hsb(0) + 360
			EndIf
		Else
			arr_hsb(0) + delta
		EndIf
	Wend
	RTFtext$ = PeekS(*m) ; уже добавлены экранирование
; 	Debug MemorySize(*m) ; выделено
; 	Debug StringByteLength(RTFtext$) ; требуется
	FreeMemory(*m)

; If iniFontSize
; 	Font = iniFontSize * 2
; Else
; 	Font = 35
; EndIf
	Font$ = "35"
	Bold$ = "\b"
	italic$ = "\i"
	
	SetGadgetText(#EditorRTF, RTFHeaderPart1$ + RTFColorTable$ + RTFHeaderPart2$ + Font$ + Bold$ + italic$ + RTFtext$ + "}")

EndProcedure

Procedure SizeHandler()
	ResizeGadget(#EditorRTF, #PB_Ignore, #PB_Ignore, WindowWidth(0) - 20, WindowHeight(0) - 155)
EndProcedure

; Procedure hsb_to_rgb(arr_hsb)
Procedure hsb_to_rgb()
	Protected sector
	Protected.f ff, pp, qq, tt
	Protected.f Dim af_rgb(2) ; создаём массивы в которых числа будут в диапазоне 0-1
	Protected.f Dim af_hsb(2)
	; Protected Dim arr_rgb(2)

	af_hsb(2) = arr_hsb(2) / 100

	If arr_hsb(1) = 0 ; если серый, то одно значение всем
		arr_rgb(0) = Round(af_hsb(2) * 255, #PB_Round_Nearest)
		arr_rgb(1) = arr_rgb(0)
		arr_rgb(2) = arr_rgb(0)
		; ProcedureReturn arr_rgb
	EndIf

	While arr_hsb(0) >= 360 ; если тон задан большим запредельным числом, то
		arr_hsb(0) - 360
	Wend

	af_hsb(1) = arr_hsb(1) / 100
	af_hsb(0) = arr_hsb(0) / 60
	; sector = Int(arr_hsb(0))
	sector = Round(af_hsb(0), #PB_Round_Down)

	ff = af_hsb(0) - sector
	pp = af_hsb(2) * (1 - af_hsb(1))
	qq = af_hsb(2) * (1 - af_hsb(1) * ff)
	tt = af_hsb(2) * (1 - af_hsb(1) * (1 - ff))

	Select sector
		Case 0
			af_rgb(0) = af_hsb(2)
			af_rgb(1) = tt
			af_rgb(2) = pp
		Case 1
			af_rgb(0) = qq
			af_rgb(1) = af_hsb(2)
			af_rgb(2) = pp
		Case 2
			af_rgb(0) = pp
			af_rgb(1) = af_hsb(2)
			af_rgb(2) = tt
		Case 3
			af_rgb(0) = pp
			af_rgb(1) = qq
			af_rgb(2) = af_hsb(2)
		Case 4
			af_rgb(0) = tt
			af_rgb(1) = pp
			af_rgb(2) = af_hsb(2)
		Default
			af_rgb(0) = af_hsb(2)
			af_rgb(1) = pp
			af_rgb(2) = qq
	EndSelect

	; RGB
	arr_rgb(0) = Round(af_rgb(0) * 255, #PB_Round_Nearest)
	arr_rgb(1) = Round(af_rgb(1) * 255, #PB_Round_Nearest)
	arr_rgb(2) = Round(af_rgb(2) * 255, #PB_Round_Nearest)

	; BGR
	; arr_rgb(2)=Round(af_rgb(0)*255, #PB_Round_Nearest)
	; arr_rgb(1)=Round(af_rgb(1)*255, #PB_Round_Nearest)
	; arr_rgb(0)=Round(af_rgb(2)*255, #PB_Round_Nearest)

	; ProcedureReturn arr_rgb
EndProcedure

HeX0R · Post by **HeX0R** » Thu May 22, 2025 12:31 pm

"[color=#xxxxxx][/color]" are 23 characters, or 46 bytes, therefore it should be 46 instead of 44 here:

Code: Select all

*m = AllocateMemory(Len1 * 44 + 2)

Wondering why it didn't crash on your side?
Anyway, besides that too extensive use of global variables, nice tool!

AZJIO · Post by **AZJIO** » Thu May 22, 2025 7:19 pm

HeX0R wrote: Thu May 22, 2025 12:31 pm "[color=#xxxxxx][/color]" are 23 characters, or 46 bytes, therefore it should be 46 instead of 44 here:
Code: Select all
*m = AllocateMemory(Len1 * 44 + 2)

Initially, I forgot to add:

Code: Select all

CopyMemoryString("]", @*p)

Perhaps because of this, I calculated it incorrectly. I didn't make a separate line and counted the number of characters directly from the code. If anything, it worked for me. It probably affected someone else's memory a little, but the program did not crash.

I also checked with these lines that I was not mistaken.

Code: Select all

; Debug MemorySize(*m) ; allocated memory
; Debug StringByteLength(tmp$) ; required

In any case, I fixed it by changing it to 48, because there are still 2 bytes for the letter itself.

I used to write this program on AutoIt3.

HeX0R wrote: Thu May 22, 2025 12:31 pm Wondering why it didn't crash on your side?

Tell

HeX0R wrote: Thu May 22, 2025 12:31 pm Anyway, besides that too extensive use of global variables, nice tool!

If you remove global variables, you need to create a structure and pass it by reference. I understand that this is not professional, but as part of this task, I decided to simplify it. Initially, I thought that I would have to pass 4 parameters to the function each time, and I decided that it was easier to make global variables than to copy strings through the function parameters. We don't have ByRef yet.

That's why I'm not taking on complex programs like TextReplace yet, because I haven't mastered all the nuances of writing code correctly yet.

Phollyer · Post by **Phollyer** » Thu May 29, 2025 8:40 pm

AZJIO This is outstanding!

Pete

PureBasic Forums - English

ColorText

ColorText

Re: ColorText

Re: ColorText

Re: ColorText