IDE Tool ColorList

sancho2 · Post by **sancho2** » Feb 21, 2017 7:05

Another IDE Tool (Windows only):
ColorList
Updated Version 1.5.1 - February 22, 2017
Fixed program freeze when pressing copy with no items in the out listbox.

This tool is meant to make it easy to add color constants to your program.
This tool shows a dialog with a list of named colors, rgb values, and swatches so you can see what the color looks like.
You can select colors and move them to the copy listbox via the '>>>' button.
You can remove colors from the copy listbox via the '<<<' button.
The 'Copy' button copies the name of the color and its value into the clipboard. This text is formatted as a FreeBasic 'const' definition.
For example:
If you select COLOR_BLUE and COLOR_RED and COLOR_BLACK and press the 'Copy' button, the following code would be put in the clipboard:

Code: Select all

Const As ULong COLOR_BLUE = &HFF0000FF, _
               COLOR_RED = &HFFFF0000, _
               COLOR_BLACK = &HFF000000

Here is the .exe file:
https://github.com/sancho2/IDETools/blo ... t1.5.1.exe

The 'Insert' button is for a later update.

Here is the code (4 Files, ColorList.bas, ColorA.bi, ColorA.rc, ColorData.bi):

ColorList.bas:

Code: Select all

'---------------------------------------------------------------------------------------------------------------
' ColorList - IDE Color selecting tool
'
' Sancho2 February 21, 2017 version 1.5.1
' 1.5.1: Fixed exe freeze when copy is pressed with no items in the out list 
'---------------------------------------------------------------------------------------------------------------
Dim Shared As BOOLEAN OkToEvent = TRUE
#Define GET_X_LPARAM(lp) clng(cshort(LOWORD(lp)))
#define GET_Y_LPARAM(lp) clng(cshort(HIWORD(lp)))
'#define GET_WHEEL_DELTA_WPARAM(wParam) cshort(HIWORD(wParam))

#include once "windows.bi"
#Include Once "win/commctrl.bi"
#Include Once "win/commdlg.bi"
#Include Once "win/shellapi.bi"
#Include "colordata.bi"
#Include "ColorsA.bi"
'---------------------------------------------------------------------------------------------------------------
Declare Sub InitScroll(ByVal hWin As HWND)
Declare Sub CreateSwatches()
Declare Sub set_clipboard (Byref x As String)
Declare Function GetVisibleItemCount(ByVal hWin As HWND) As Integer
Declare Sub AddColorsToLists()
Declare Sub ListBox_ScrollDown(ByVal hWin As HWND, ByVal amt As UByte)
Declare Sub ListBox_ScrollUp(ByVal hWin As HWND, ByVal amt As UByte)
Declare Sub ListBox_ScrollTo(ByVal hWin As HWND, ByVal amt As UByte)
Declare Sub DrawSwatches(ByVal hWin As HWND)
Declare Sub InvalidateSwatchRect()
Declare Sub UnSelectItems(ByVal hLst As HWND)
Declare Sub ChangeSelection(ByVal lstBox As HWND)
Declare Sub AddItems()
Declare Sub DeleteItems()
Declare Sub CreateClipboardEntry()
Declare Function IsPointOnScrollBar(ByVal x As Integer, ByVal y As Integer) As BOOLEAN
Declare Function GetListBoxVisibleItems(ByVal hLst As HWND) As Integer
Declare Function GetMaxTopIndex() As Integer
'---------------------------------------------------------------------------------------------------------------
Function IsDuplicateItem(byref item as string) as boolean
	'
	Dim As HWND hOut
	Dim As Integer index		
	hOut = GetDlgItem(hWnd, lstOut)
	
	index = SendMessage(hOut, LB_FINDSTRINGEXACT, -1, Cast(WPARAM, StrPtr(item)))
	If index = LB_ERR Then
		Return FALSE 
	EndIf

	Return TRUE 
 	
End Function

Function GetListBoxVisibleItems(ByVal hLst As HWND) As Integer
	'
	Dim As Integer rowH
	Dim As RECT r 
	
	rowH = SendMessage(hLst, LB_GETITEMHEIGHT, 0, 0)
	GetClientRect(hLst, @r)
	Return  (r.bottom - r.top) \ rowH  
	
End Function
Function GetMaxTopIndex() As Integer
	'
	Dim As HWND hNames
	Dim As Integer count, n
	Dim As String s
	
	hNames = GetDlgItem(hWnd, lstNames)
	count = SendMessage(hNames, LB_GETCOUNT, 0, 0)
	n = GetListBoxVisibleItems(hNames)
	
	Return count - n + 1
	
End Function

Sub CreateClipboardEntry()
	'
	Dim As HWND hOut, hPrefix, hConstant
	Dim As String txt, s
	Dim As ZString * 256 constant, prefix
	Dim As Integer l, count, buffer(Any), index
	
	hOut = GetDlgItem(hWnd, lstOut)
	hConstant = GetDlgItem(hWnd, txtConstant)
	hPrefix = GetDlgItem(hWnd, txtPrefix)
	
	l = GetWindowTextLength(hConstant)
	GetWindowText(hConstant, @constant, l)	

	l = GetWindowTextLength(hPrefix)
	GetWindowText(hPrefix, @prefix, l + 1)	

	hOut = GetDlgItem(hWnd, lstOut)
	count = SendMessage(hOut, LB_GETCOUNT, 0, 0)
	If count < 1 Then
		Exit Sub
	EndIf
	txt = ""
	s = constant + " " + prefix
	For x As UByte = 0 To count - 1
		txt += s
		index = SendMessage(hOut, LB_GETITEMDATA, x, 0)
		'SendMessage(hOut, LB_GETTEXT,  count,  Cast(LPARAM, @buffer(1)))
		s = colors(index).Name
		txt += s
		txt += " = "
		s = colors(index).ToRGBHex
		txt = txt + "&H" + s  
		s = ", _" + CRLF + Space(14) + prefix
	Next

	set_clipboard(txt)

End Sub

Sub DeleteItems()
	'
	Dim As HWND hOut
	Dim As String s
	Dim As Integer buffer(Any), count 

	hOut = GetDlgItem(hWnd, lstOut)
	count = SendMessage(hOut, LB_GETSELCOUNT, 0, 0)

	ReDim buffer(1 To count)
	SendMessage(hOut, LB_GETSELITEMS, count, Cast(LPARAM, @buffer(1)))

	For x As UByte = count To 1 Step - 1
		SendMessage(hOut, LB_DELETESTRING, buffer(x), 0)
	Next
	
End Sub
Sub AddItems()
	'
	Dim As HWND hNames, hOut
	Dim As zString * 256 z  
	Dim As Integer buffer(Any), count, n, index

	hNames = GetDlgItem(hWnd, lstNames)
	hOut = GetDlgItem(hWnd, lstOut)
	
	UnSelectItems(hOut)
	
	count = SendMessage(hNames, LB_GETSELCOUNT, 0, 0)
	ReDim buffer(1 To count)
	SendMessage(hNames, LB_GETSELITEMS, count, Cast(LPARAM, @buffer(1)))
	
	For x As UByte = 1 To count
		SendMessage(hNames, LB_GETTEXT, buffer(x), Cast(LPARAM, @z))
		If IsDuplicateItem(z) = FALSE  then
			index = SendMessage(hNames, LB_GETITEMDATA, buffer(x), 0)
			SendMessage(hOut, LB_ADDSTRING, 0, Cast(LPARAM, @z))
			n = SendMessage(hOut, LB_GETCOUNT, 0, 0)
			SendMessage(hOut, LB_SETSEL, TRUE, n - 1)
			SendMessage(hOut, LB_SETITEMDATA, n - 1,  index)
		EndIf
	Next
	'UnSelectItems(hNames)
End Sub

Sub InvalidateSwatchRect()
	'
	Dim As HWND hColor
	Dim As RECT r  
	
	hColor = GetDlgItem(hWnd, lstNames)
	GetWindowRect(hColor, @r)

	r.right = r.left
	r.left = 0
	r.top = 0

	InvalidateRect(hwnd, @r, TRUE)
	
End Sub
Function UpdateSwatch(hStatic As HWND, dc As HDC, ByVal hB As HBRUSH) As HBRUSH
	'
	Dim As HWND hColor
  	Dim As Integer id, index, topIndex
  	Dim As String s
  
	hColor = GetDlgItem(hWnd, lstNames)
	topIndex = SendMessage(hColor, LB_GETTOPINDEX, 0, 0)

  	id = GetDlgCtrlID(hStatic)
	index = id -swatches + topindex 

	hB = CreateSolidBrush(colors(index).ToBGRValue)  
  	SetBkColor(dc, colors(index).ToBGRValue)
	
	Return hB
End Function
Sub CreateSwatches()
	'
	Dim As HWND hStatic, hColor
	Dim As Point p
	Dim As Integer rowH, topIndex, nX, nY, w 
	Dim As RECT r
	
	hColor = GetDlgItem(hWnd, lstNames)

	ClientToScreen(hWnd, @p)

	rowH = SendMessage(hColor, LB_GETITEMHEIGHT, 0, 0)
	topIndex = SendMessage(hColor, LB_GETTOPINDEX, 0, 0)
	GetWindowRect(hColor, @r)
	For x As UByte = 1 To 26
		ny = (r.top - p.y) + ((x - 1) * rowH) 
		w = r.left '+ p.x
		hStatic = CreateWindowEx(NULL, StrPtr("Static"),NULL, WS_CHILD Or WS_VISIBLE Or SS_SIMPLE Or ss_notify,_	'ES_READONLY  Or SS_SUNKEN Or SS_NOTIFY
		 nX, nY, w, rowH, hWnd, Cast(HMENU, swatches + x ),GetModuleHandle(NULL), NULL)
		 SetWindowText(hStatic, StrPtr("            "))
	Next

End Sub

Sub InitScroll(ByVal hWin As HWND)
	'
	Dim As HWND hScroll
	Dim As SCROLLINFO sInfo
	Dim As Integer count = UBound(colors), visibleItemCount
	
	visibleItemCount = GetVisibleItemCount(hWin)	
	With sInfo
		.cbSize = SizeOf(SCROLLINFO)
		.fMask = SIF_RANGE
		.nMin = 1
		.nMax = count - visibleItemCount
	End With
	
	hScroll = GetDlgItem(hWin,scbVert)
	
	SetScrollInfo(hScroll, SB_CTL, @sInfo, TRUE) 
	 
		
End Sub
Sub UnSelectItems(ByVal hLst As HWND)
	'
	Dim As Integer buffer(Any), count
	count = SendMessage(hLst, LB_GETSELCOUNT, 0, 0)
	ReDim buffer(1 To count)
	
	SendMessage(hLst, LB_GETSELITEMS, count, Cast(LPARAM, @buffer(1)))
	
	For x As UByte = 1 To count
		SendMessage(hLst, LB_SETSEL, FALSE, buffer(x))
	Next
	
End Sub
Sub ChangeSelection(ByVal lstBox As HWND)
	'
	Dim As Integer index 
	Dim As String s
	Dim As HWND hTemp
	Dim As Integer buffer(Any), count
	
	If GetDlgCtrlID(lstBox) = lstNames Then
		hTemp = GetDlgItem(hWnd, lstRGB) 
	Else
		hTemp = GetDlgItem(hWnd, lstNames)
	EndIf
	
	UnSelectItems(hTemp)
	
	count = SendMessage(lstBox, LB_GETSELCOUNT, 0, 0)
	ReDim buffer(1 To count)
	
	SendMessage(lstBox, LB_GETSELITEMS, count, Cast(LPARAM, @buffer(1)))
	
	For x As UByte = 1 To count
		SendMessage(hTemp, LB_SETSEL, TRUE, buffer(x))
	Next
	
End Sub
Function IsPointOnScrollBar(ByVal x As Integer, ByVal y As Integer) As BOOLEAN
	'
	Dim As HWND hScroll
	Dim As RECT r
	Dim As Point p
	
	p = Type<Point>(x, y)
	
	hScroll = GetDlgItem(hWnd, scbVert)
	GetWindowRect(hScroll, @r)
	
	r.left = 0		' include everyting on the left
	
	Return cbool(PtInRect(@r, p))	

End Function
Sub WHereSwatch(ByVal index As Integer)
	'
	Dim As String s
	Dim As HWND hSwatch
	Dim As RECT r
	s =Str(index - 1 + swatches)
	MessageBox(NULL, StrPtr(s), "hello",MB_OK)
	'End
	hSwatch = GetDlgItem(hWnd, index + swatches)
	s =Str(hSwatch)
	MessageBox(NULL, s, "hello",MB_OK)
	getwindowrect(hSwatch, @r)
	
	s = Str(r.left) + " " + Str(r.top) + " " + Str(r.right) + " " + Str(r.bottom)
	
	MessageBox(NULL, s, "hello",MB_OK) 
	
End Sub

Function WndProc(ByVal hWin As HWND,ByVal uMsg As UINT,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As Integer
	'
	Dim As HBRUSH hB 
	Dim As Integer id
	'Static test As Integer = 0
	Select Case uMsg
		

		Case WM_CTLCOLORSTATIC 
			id = GetDlgCtrlID(Cast(HWND, lParam))
			If id >1200 AndAlso id <= 1226 Then 
				If hB <> NULL Then
					DeleteObject(hB)
				EndIf
				hB = UpdateSwatch(Cast(HWND, lParam), Cast(HDC, wParam), hB)
				Return Cast(INT_PTR, hB)
			EndIf
			
		
		Case WM_INITDIALOG

			hWnd=hWin
			Dim As HWND lstBox
			Dim As LVCOLUMN column
			lstBox = GetDlgItem(hWin, lstNames)
			AddColorsToLists()
			InitScroll(hWin)
			CreateSwatches()

		Case WM_MOUSEWHEEL
			Dim As Integer xPos, yPos, amt
			Dim As String s
			
			xPos = GET_X_LPARAM(lParam)
			yPos = GET_Y_LPARAM(lParam)
			's = Str(xPos)
			If IsPointOnScrollBar(xPos, yPos) = TRUE Then
				amt = GET_WHEEL_DELTA_WPARAM(wparam)
				amt = amt/120
				's = Str(amt)
				'MessageBox(NULL, s, "X", MB_OK)
				If amt < 0 Then
					ListBox_ScrollDown(hWnd, -1 * amt)
				Else
					ListBox_ScrollUp(hWnd, amt)
				EndIf
				InvalidateSwatchRect()
			EndIf 
			
		
		Case WM_VSCROLL
			Dim As Long hWord, lWord
			Dim As String s
			Dim As Integer i
			Dim As RECT r = Type<RECT>(0,0, 200,600)
			hWord = HiWord(wParam)
			lWord = LoWord(wParam)
			
			Select Case lWord
				Case SB_THUMBPOSITION, SB_THUMBTRACK
					ListBox_ScrollTo(hWin, hWord)
				Case SB_LINEDOWN
					ListBox_ScrollDown(hWin, 1)
				Case SB_LINEUP
					ListBox_ScrollUp(hWin, 1)
				Case SB_PAGEDOWN
					i = GetVisibleItemCount(hWin)
					ListBox_ScrollDown(hWin, i)
				Case SB_PAGEUP
					i = GetVisibleItemCount(hWin)
					ListBox_ScrollUp(hWin, i) 
			End Select 
			InvalidateSwatchRect() 
			
		Case WM_COMMAND
					 
			Select Case HiWord(wParam)
				Case LBN_DBLCLK
					AddItems()
				Case LBN_SELCHANGE
					If OkToEvent Then
						OkToEvent = FALSE
						ChangeSelection(Cast(HWND, lParam))
						OkToEvent = TRUE 
					EndIf

				Case BN_CLICKED,1
					Select Case LoWord(wParam)
						Case cmdCopy
							WHereSwatch(1)
							CreateClipboardEntry()
						Case cmdRemove
							DeleteItems()
						Case cmdAdd
							AddItems()
						Case cmdExit		' IDM_FILE_EXIT,
							SendMessage(hWin,WM_CLOSE,0,0)
					End Select
					'
			End Select
			'
		Case WM_SIZE
			'
		Case WM_CLOSE
			DeleteObject(hB)
			DestroyWindow(hWin)
			'
		Case WM_DESTROY
			PostQuitMessage(NULL)
			'
		Case Else
			Return DefWindowProc(hWin,uMsg,wParam,lParam)
			'
	End Select
	Return 0

End Function

Function WinMain(ByVal hInst As HINSTANCE,ByVal hPrevInst As HINSTANCE,ByVal CmdLine As ZString ptr,ByVal CmdShow As Integer) As Integer
	Dim wc As WNDCLASSEX
	Dim msg As MSG

	' Setup and register class for dialog
	wc.cbSize=SizeOf(WNDCLASSEX)
	wc.style=CS_HREDRAW or CS_VREDRAW
	wc.lpfnWndProc=@WndProc
	wc.cbClsExtra=0
	wc.cbWndExtra=DLGWINDOWEXTRA
	wc.hInstance=hInst
	wc.hbrBackground=Cast(HBRUSH,COLOR_BTNFACE+1)
	wc.lpszMenuName=Cast(ZString Ptr,IDM_MENU)
	wc.lpszClassName=@ClassName
	wc.hIcon=LoadIcon(NULL,IDI_APPLICATION)
	wc.hIconSm=wc.hIcon
	wc.hCursor=LoadCursor(NULL,IDC_ARROW)
	RegisterClassEx(@wc)
	' Create and show the dialog
	CreateDialogParam(hInstance,Cast(ZString Ptr,IDD_DIALOG),NULL,@WndProc,NULL)
	ShowWindow(hWnd,SW_SHOWNORMAL)
	UpdateWindow(hWnd)
	' Message loop
	Do While GetMessage(@msg,NULL,0,0)
		TranslateMessage(@msg)
		DispatchMessage(@msg)
	Loop
	Return msg.wParam

End Function
Sub set_clipboard (Byref x As String)
  Dim As HANDLE hText = NULL
  Dim As Ubyte Ptr clipmem = NULL
  Dim As Integer n = Len(x)

  If n > 0 Then
    hText = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, n + 1)
    Sleep 15
    If (hText) Then
      clipmem = GlobalLock(hText)
      If clipmem Then
        CopyMemory(clipmem, Strptr(x), n)
      Else
        hText = NULL
      End If
      If GlobalUnlock(hText) Then
        hText = NULL
      End If
    End If
    If (hText) Then
      If OpenClipboard(NULL) Then
        Sleep 15
        If EmptyClipboard() Then
          Sleep 15
          If SetClipboardData(CF_TEXT, hText) Then
            Sleep 15
          End If
        End If
        CloseClipboard()
      End If
    End If
  End If
End Sub
Sub AddColorsToLists()
	'
	Dim As HWND hNames, hRGB
	Dim As String s
	'Dim As Integer n

	hNames = GetDlgItem(hWnd, lstNames)
	hRGB = GetDlgItem(hWnd, lstRGB)
	
	For x As UByte = 1 To UBound(colors)
		s = colors(x).Name 
		SendMessage(hNames, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(s)))
		SendMessage(hNames, LB_SETITEMDATA, x - 1, x)
		s = colors(x).ToRGBString
		SendMessage(hRGB, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(s)))
	Next
	
End Sub

Function GetVisibleItemCount(ByVal hWin As HWND) As Integer
	'
	Dim As HWND hNames
	Dim As Integer h
	Dim As RECT r

	hNames = GetDlgItem(hWin, lstNames)
	
	GetClientRect(hNames, @r)
	h = sendmessage(hNames, LB_GETITEMHEIGHT, 0, NULL)
	Return (r.bottom - r.top) \ h
End Function
Sub ListBox_ScrollTo(ByVal hWin As HWND, ByVal amt As UByte)
	'
	Dim As HWND hNames, hRGB
	Dim As Integer topIndex 
	
	hNames = GetDlgItem(hWin, lstNames)
	hRGB = GetDlgItem(hWin, lstRGB) 

	SendMessage(hNames, LB_SETTOPINDEX, amt, 0)
	SendMessage(hRGB, LB_SETTOPINDEX, amt, 0)

	Dim As SCROLLINFO sInfo
	Dim As HWND hScroll	
	With sInfo
		.cbSize = SizeOf(SCROLLINFO)
		.fMask = SIF_POS
		.nPos = amt
	End With
	
	hScroll = GetDlgItem(hWin,scbVert)
	
	SetScrollInfo(hScroll, SB_CTL, @sInfo, TRUE)		
	

End Sub
Sub ListBox_ScrollUp(ByVal hWin As HWND, ByVal amt As UByte)
	'
	Dim As HWND hNames, hRGB
	Dim As Integer topIndex 
	
	hRGB = GetDlgItem(hWin, lstRGB) 
	hNames = GetDlgItem(hWin, lstNames)
	topIndex = sendmessage(hNames, LB_GETTOPINDEX, 0, 0)
	topIndex -= amt
	If topIndex < 0 Then
		topIndex = 0
	EndIf

	SendMessage(hNames, LB_SETTOPINDEX, topIndex, 0)
	SendMessage(hRGB, LB_SETTOPINDEX, topIndex, 0)

	Dim As SCROLLINFO sInfo
	Dim As HWND hScroll	
	With sInfo
		.cbSize = SizeOf(SCROLLINFO)
		.fMask = SIF_POS
		.nPos = topIndex
	End With
	
	hScroll = GetDlgItem(hWin,scbVert)
	
	SetScrollInfo(hScroll, SB_CTL, @sInfo, TRUE)		
	
End Sub
Sub ListBox_ScrollDown(ByVal hWin As HWND, ByVal amt As UByte)
	'
	Dim As HWND hNames, hRGB
	Dim As UByte topIndex, maxTopIndex
	
	hRGB = GetDlgItem(hWin, lstRGB) 
	hNames = GetDlgItem(hWin, lstNames)
	topIndex = sendmessage(hNames, LB_GETTOPINDEX, 0, 0)
	topIndex += amt
	maxTopIndex = GetMaxTopIndex()
	If topIndex > maxTopIndex Then
		topIndex = maxTopIndex
	EndIf

	SendMessage(hNames, LB_SETTOPINDEX, topIndex, 0)
	SendMessage(hRGB, LB_SETTOPINDEX, topIndex, 0)

	Dim As SCROLLINFO sInfo
	Dim As HWND hScroll	

	With sInfo
		.cbSize = SizeOf(SCROLLINFO)
		.fMask = SIF_POS
		.nPos = topIndex
	End With
	
	hScroll = GetDlgItem(hWin,scbVert)
	
	SetScrollInfo(hScroll, SB_CTL, @sInfo, TRUE)		
End Sub
'=================================================================================================================
' Program start
'=================================================================================================================
LoadColors()

hInstance=GetModuleHandle(NULL)

InitCommonControls

WinMain(hInstance,NULL,CommandLine,SW_SHOWDEFAULT)

ExitProcess(0)

ColorsA.bi

Code: Select all

#Define IDD_DIALOG			1000
#Define lstNames  	1001
#Define lstRGB 		1002
#Define scbVert 		1003
#Define cmdAdd 		1007
#Define lstOut			1006
#Define cmdExit 		1008
#Define cmdRemove 	1009
#Define cmdInsert		1010
#Define cmdCopy		1011
#Define txtConstant 	1012
#Define txtPrefix 	1014

#Define swatches 		1200

#Define IDM_MENU				10000
#Define IDM_FILE_EXIT		10001
#Define IDM_HELP_ABOUT		10101

Const As String CRLF = Chr(13) + Chr(10)

Dim Shared hInstance As HMODULE
Dim Shared CommandLine As ZString Ptr
Dim Shared hWnd As HWND

Const ClassName="DLGCLASS"
Const AppName="Dialog as main"
Const AboutMsg=!"FbEdit Dialog as main\13\10Copyright © FbEdit 2007"
'--------------------------------------------------------------------------------------------------------------------
Declare Sub PadNumberString(ByRef txt As String, ByVal amt As UByte = 3)
'--------------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------
#define RGBA_R( c ) ( CUInt( c ) Shr 16 And 255 )
#define RGBA_G( c ) ( CUInt( c ) Shr  8 And 255 )
#define RGBA_B( c ) ( CUInt( c )        And 255 )
'----------------------------------------------------------------------------------------------------------------
Type CColor
	As String Name
	Declare Property ToRGBString() As String
	Declare Property ToRGBHex() As String
	Declare Property ToBGRHex() As String
	Declare Property ToRGBValue() As ULong
	Declare Property ToBGRValue() As ULong
	Declare Sub SplitRGBString(ByRef r As String, ByRef g As String, ByRef b As string)
	As ULong value
End Type
Property CColor.ToRGBString() As String
	'
	Dim As String s, r, g, b
	
	this.SplitRGBString(r, g, b)
	PadNumberString(r)
	PadNumberString(g)
	PadNumberString(b)
	s = r + ", " + g + ", " + b 
	Return s
End Property

Sub CColor.SplitRGBString(ByRef r As String, ByRef g As String, ByRef b As string)
	'
	r = Str(RGBA_R(this.value))
	g = Str(RGBA_G(this.value))
	b = Str(RGBA_B(this.value))
End Sub 

Property CColor.ToRGBHex() As String
	'
	Return Hex(this.value, 8)
End Property
	
Property CColor.ToBGRHex() As String
	'
	Dim As ULong v = this.ToBGRValue
	Return Hex(v, 8)
End Property

Property CColor.ToRGBValue() As ULong
	'
	Return this.value
End Property

Property CColor.ToBGRValue() As ULong
	'
	Return RGBA(RGBA_B(this.value), RGBA_G(this.value),RGBA_R(this.value), 0) 
End Property
'--------------------------------------------------------------------------------------------------------------------
Dim Shared As CColor colors(Any)
'--------------------------------------------------------------------------------------------------------------------
Declare Sub LoadColors()
'--------------------------------------------------------------------------------------------------------------------
Sub LoadColors()
	'
	Dim As Integer n
	Dim As String cName
	Dim As ULong cValue
	
	Restore ColorData
	Read cName, cValue
	While cName <> ""
		Dim As CColor c
		n += 1
		ReDim Preserve colors(1 To n)
		With colors(n)
			.Name = cName
			.value = cValue
		End With
		Read cName, cValue
	Wend 
End Sub
'--------------------------------------------------------------------------------------------------------------------
Sub PadNumberString(ByRef txt As String, ByVal amt As UByte = 3)
	'
	While Len(txt) < amt
		txt = "0" + txt 
	Wend
End Sub

ColorsA.rc:

Code: Select all

#define IDD_DIALOG 1000
#define lstColors 1001
#define scbVert 1003
#define lstRGB 1002
#define IDC_STC1 1004
#define IDC_STC2 1005
#define lstOut 1006
#define cmdAdd 1007
#define cmdRemove 1009
#define cmdExit 1008
#define cmdInsert 1010
#define cmdCopy 1011
#define txtConstant 1012
#define IDC_STC3 1013
#define txtPrefix 1014
#define IDC_STC4 1015

IDD_DIALOG DIALOGEX 87,240,417,265
CAPTION "Color Selector"
FONT 8,"MS Sans Serif",0,0,0
CLASS "DLGCLASS"
STYLE 0x10CF0000
BEGIN
  CONTROL "",lstColors,"ListBox",0x50010949,30,12,135,213,0x00000200
  CONTROL "",scbVert,"ScrollBar",0x50000001,216,12,18,213
  CONTROL "",lstRGB,"ListBox",0x50010949,165,12,51,213,0x00000200
  CONTROL "Color Name",IDC_STC1,"Static",0x50000000,30,3,51,9
  CONTROL "RGB",IDC_STC2,"Static",0x50000000,165,3,24,9
  CONTROL "",lstOut,"ListBox",0x50010949,276,12,135,213,0x00000200
  CONTROL ">>>",cmdAdd,"Button",0x50010000,240,12,30,15
  CONTROL "<<<",cmdRemove,"Button",0x50010000,240,33,30,15
  CONTROL "Exit",cmdExit,"Button",0x50010000,381,240,30,15
  CONTROL "Insert",cmdInsert,"Button",0x58010000,237,240,30,15
  CONTROL "Copy",cmdCopy,"Button",0x50010000,201,240,30,15
  CONTROL "Const As ULong ",txtConstant,"Edit",0x50010800,30,240,57,12,0x00000200
  CONTROL "Prefix",IDC_STC3,"Static",0x50000000,87,231,51,9
  CONTROL "COLOR_",txtPrefix,"Edit",0x50010000,87,240,108,12,0x00000200
  CONTROL "Constant",IDC_STC4,"Static",0x50000000,30,231,33,9
END

ColorData.bi:

Code: Select all

ColorData:
Data "ALICE_BLUE", &HFFF0F8FF
Data "ANTIQUE_WHITE", &HFFFAEBD7
Data "AQUA", &HFF00FFFF
Data "AQUA_MARINE", &HFF7FFFD4
Data "AZURE", &HFFF0FFFF
Data "BEIGE", &HFFF5F5DC
Data "BISQUE", &HFFFFE4C4
Data "BLACK", &HFF000000
Data "BLANCHED_ALMOND", &HFFFFEBCD
Data "BLUE", &HFF0000FF
Data "BLUE_VIOLET", &HFF8A2BE2
Data "BROWN", &HFFA52A2A
Data "BURLY_WOOD", &HFFDEB887
Data "CADET_BLUE", &HFF5F9EA0
Data "CHART_REUSE", &HFF7FFF00
Data "CHOCOLATE", &HFFD2691E
Data "CORAL", &HFFFF7F50
Data "CORN_FLOWER_BLUE", &HFF6495ED
Data "CORN_SILK", &HFFFFF8DC
Data "CRIMSON", &HFFDC143C
Data "CYAN", &HFF00FFFF
Data "DARK_BLUE", &HFF00008B
Data "DARK_CYAN", &HFF008B8B
Data "DARK_GOLDEN_ROD", &HFFB8860B
Data "DARK_DARK_GREY", &HFFA9A9A9
Data "DARK_GREEN", &HFF006400
Data "DARK_KHAKI", &HFFBDB76B
Data "DARK_MAGENTA", &HFF8B008B
Data "DARK_OLIVE_GREEN", &HFF556B2F
Data "DARK_ORANGE", &HFFFF8C00
Data "DARK_ORCHID", &HFF9932CC
Data "DARK_RED", &HFF8B0000
Data "DARK_SALMON", &HFFE9967A
Data "DARK_SEA_GREEN", &HFF8FBC8F
Data "DARK_SLATE_BLUE", &HFF483D8B
Data "DARK_SLATE_GRAY", &HFF2F4F4F
Data "DARK_TURQUOISE", &HFF00CED1
Data "DARK_VIOLET", &HFF9400D3
Data "DEEP_PINK", &HFFFF1493
Data "DEEP_SKY_BLUE", &HFF00BFFF
Data "DIM_GREY", &HFF696969
Data "DODGER_BLUE", &HFF1E90FF
Data "FIREBRICK", &HFFB22222
Data "FLORAL_WHITE", &HFFFFFAF0
Data "FOREST_GREEN", &HFF228B22
Data "GAINSBORO", &HFFDCDCDC
Data "GHOST_WHITE", &HFFF8F8FF
Data "GOLD", &HFFFFD700
Data "GOLDEN_ROD", &HFFDAA520
Data "GRAY", &HFF808080
Data "GREEN", &HFF008000
Data "GREEN_YELLOW", &HFFADFF2F
Data "HONEYDEW", &HFFF0FFF0
Data "HOT_PINK", &HFFFF69B4
Data "INDIAN_RED", &HFFCD5C5C
Data "INDIGO", &HFF4B0082
Data "IVORY", &HFFFFFFF0
Data "KHAKI", &HFFF0E68C
Data "LAVENDER", &HFFE6E6FA
Data "LAVENDER_BLUSH", &HFFFFF0F5
Data "LAWN_GREEN", &HFF7CFC00
Data "LEMON_CHIFFON", &HFFFFFACD
Data "LIGHT_BLUE", &HFFADD8E6
Data "LIGHT_CORAL", &HFFF08080
Data "LIGHT_CYAN", &HFFE0FFFF
Data "LIGHT_GOLD_ROD_YELLOW", &HFFFAFAD2
Data "LIGHT_GREY", &HFFD3D3D3
Data "LIGHT_GREEN", &HFF90EE90
Data "LIGHT_PINK", &HFFFFB6C1
Data "LIGHT_SALMON", &HFFFFA07A
Data "LIGHT_SEA_GREEN", &HFF20B2AA
Data "LIGHT_SKY_BLUE", &HFF87CEFA
Data "LIGHT_SLATE_GRAY", &HFF778899
Data "LIGHT_STEEL_BLUE", &HFFB0C4DE
Data "LIGHT_YELLOW", &HFFFFFFE0
Data "LIME", &HFF00FF00
Data "LIME_GREEN", &HFF32CD32
Data "LINEN", &HFFFAF0E6
Data "MAGENTA", &HFFFF00FF
Data "MAROON", &HFF800000
Data "MEDIUM_AQUA_MARINE", &HFF66CDAA
Data "MEDIUM_BLUE", &HFF0000CD
Data "MEDIUM_ORCHID", &HFFBA55D3
Data "MEDIUM_PURPLE", &HFF9370DB
Data "MEDIUM_SEA_GREEN", &HFF3CB371
Data "MEDIUM_SLATE_BLUE", &HFF7B68EE
Data "MEDIUM_SPRING_GREEN", &HFF00FA9A
Data "MEDIUM_TURQUOISE", &HFF48D1CC
Data "MEDIUM_VIOLET_RED", &HFFC71585
Data "MIDNIGHT_BLUE", &HFF191970
Data "MINT_CREAM", &HFFF5FFFA
Data "MISTY_ROSE", &HFFFFE4E1
Data "MOCCASIN", &HFFFFE4B5
Data "NAVAJO_WHITE", &HFFFFDEAD
Data "NAVY", &HFF000080
Data "OLD_LACE", &HFFFDF5E6
Data "OLIVE", &HFF808000
Data "OLIVE_DRAB", &HFF6B8E23
Data "ORANGE", &HFFFFA500
Data "ORANGE_RED", &HFFFF4500
Data "ORCHID", &HFFDA70D6
Data "PALE_GOLDEN_ROD", &HFFEEE8AA
Data "PALE_GREEN", &HFF98FB98
Data "PALE_TURQUOISE", &HFFAFEEEE
Data "PALE_VIOLET_RED", &HFFDB7093
Data "PAPAYA_WHIP", &HFFFFEFD5
Data "PEACH_PUFF", &HFFFFDAB9
Data "PERU", &HFFCD853F
Data "PINK", &HFFFFC0CB
Data "PLUM", &HFFDDA0DD
Data "POWDER_BLUE", &HFFB0E0E6
Data "PURPLE", &HFF800080
Data "RED", &HFFFF0000
Data "ROSY_BROWN", &HFFBC8F8F
Data "ROYAL_BLUE", &HFF4169E1
Data "SADDLE_BROWN", &HFF8B4513
Data "SALMON", &HFFFA8072
Data "SANDY_BROWN", &HFFF4A460
Data "SEA_GREEN", &HFF2E8B57
Data "SEA_SHELL", &HFFFFF5EE
Data "SIENNA", &HFFA0522D
Data "SILVER", &HFFC0C0C0
Data "SKY_BLUE", &HFF87CEEB
Data "SLATE_BLUE", &HFF6A5ACD
Data "SLATE_GRAY", &HFF708090
Data "SNOW", &HFFFFFAFA
Data "SPRING_GREEN", &HFF00FF7F
Data "STEEL_BLUE", &HFF4682B4
Data "TAN", &HFFD2B48C
Data "TEAL", &HFF008080
Data "THISTLE", &HFFD8BFD8
Data "TOMATO", &HFFFF6347
Data "TURQUOISE", &HFF40E0D0
Data "VIOLET", &HFFEE82EE
Data "WHEAT", &HFFF5DEB3
Data "WHITE", &HFFFFFFFF
Data "WHITE_SMOKE", &HFFF5F5F5
Data "YELLOW", &HFFFFFF00
Data "YELLOW_GREEN", &HFF9ACD32

adele · Post by **adele** » Feb 22, 2017 2:14

Hi Sancho,

I didn´t look too much at the code, but tried immediately the EXE.
It works. Even on my machine (Virtual VMware/WIn10/ver 14393).
For those who know how to write GUIs it might be a good help.

Since the left button of my mouse produces more clicks than me :-) (read: is defect), I noticed
that the "mouse generated" double clicks cause the program to add the currently selected color
values multiple times.
This, of course, would end up in a compiler error "duplicate definition".

Besides that, I like this neat little program. I must have been a lot of work to gather and edit
the impressing bunch of DATA entries. But now, the work is done, and you should be proud of it.

Please, do not try to "optimize" ro "chrome" anything.
"Trucks aint`t designed to be Pretty Kitty". Fix real bugs, if any, that`s all. We need creativity.
Hope you got it.

BTW:

sancho2 wrote:Another IDE Tool (Windows only):
The Edit control that contains the prefix 'Const As ULong' is readonly awaiting an update.
The 'Insert' button is for a later update.

Maybe you have an idea what an "update" might mean. IMO, it is better and more helpful to work on
new ideas, new solutions and new sights of view than to "optimize" things that work.
So just talk about your ideas, maybe someone else has a solution. Even if you think your ideas
sound crazy. Go and try different way, even if habits contradict.

Keep on "trucking" :)

Adi

PS: (If a system is insane, (most) solutions using the system´s rules will be insane too. Just have a look at
the VW Diesel story...)

sancho2 · Post by **sancho2** » Feb 22, 2017 3:53

Thank you for the response Adele.

You are correct, it was a lot of work. I am still very new to the world of Windows API programming. So I look up a function, experiment with some code, then lookup why it didn't work (lol).

One of the things I want to add is code to prevent multiple entries, like you pointed out.
Right now I use the prefix COLOR_ with the colors. This might not fit everyones naming style, so I want to make that editable by the user.
I want ot make an AddIn version for FBEdit IDE. In that version there will be a couple of additional features.

Thanks for trying out the program and the kind words.

sancho2 · Post by **sancho2** » Feb 22, 2017 5:31

Version 1.5.1:

Updated:
Bug fix.
Duplicates are filtered out.
Customizable prefix; I use COLOR_ you can change it to suit your needs.
Mousewheel works on left listboxes and scroll bar.

IDE Tool ColorList

IDE Tool ColorList

Re: IDE Tool ColorList

Re: IDE Tool ColorList

Re: IDE Tool ColorList