IDE Tool ColorList

User projects written in or related to FreeBASIC.
sancho2
Posts: 547
Joined: May 17, 2015 6:41

IDE Tool ColorList

Postby 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/blob/master/ColorList1.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   
Last edited by sancho2 on Feb 23, 2017 3:28, edited 3 times in total.
adele
Posts: 47
Joined: Jun 13, 2015 19:33

Re: IDE Tool ColorList

Postby 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
Posts: 547
Joined: May 17, 2015 6:41

Re: IDE Tool ColorList

Postby 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
Posts: 547
Joined: May 17, 2015 6:41

Re: IDE Tool ColorList

Postby 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.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 7 guests