This program has several years, now I revised it and adapted to PBWIN 9.00.
Perhaps can be useful to some people.
Perhaps can be useful to some people.
Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' ChooseC.bas by Jordi Vallès version 1c 22/11/2008 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Color picker program. ' Call the standard Windows Common Dialog CHOOSECOLOR but using extensively the ' Hook facility provided and pointed in CHOOSECOLORAPI structure in order to ' add some facilities that can be used by programmers. ' ' Information about the CHOOSECOLOR program and how can be used and customized ' and how the Hook can be enabled, including some color theory, can be found on: ' [URL="http://msdn.microsoft.com/en-us/library/ms646375%28VS.85%29.aspx"](MSDN Color Dialog Box)[/URL] ' ' Due that this program is a Hook the code must be in SDK style but the measures ' used by the CHOOSECOLOR are in Dialog Units. To solve this apparent problem I ' convert the sizes and positions to pixels using the second method explained ' on: [URL="http://support.microsoft.com/kb/145994"]How to calculate dialog box units[/URL] ' This method seems appropriate. Program tested on several screen resolutions ' with succes. Also tested with Windows XP SP3. ' ' Facilities added by this program: ' - Entire set of Windows System Colors with current colors. ' - ToolTips added to all controls. ' - Percentage of current color selected. ' - Current selected color in hexadecimal. ' - Output color area expanded. ' - Click over output color shows contrast with some text. ' - Accept or Enter key set current information on ClipBoard and terminates. ' - Three styles of data when save information on ClipBoard. ' - Remember style between sessions. ' - Save/restore all 16 custom colors ' - Luminiscence bar more wide. ' - Save/restore window position. ' - Starts with last color selected. ' ' An INI file is created dynamically on same folder of this executable program ' to save and pass information between sessions. ' ' Part of source and/or information used here comes from: ' Bob Houle, Gafny Jacob, Eric Pearson, Erik Christensen and others. ' ' Program PB WinSpy++ by Borje Hagsten has been used intensely to obtain the ' needed internal information about ChooseColor program. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - Program developed, compiled and tested with PowerBASIC for Windows 9.00 on ' a PC HP Pavilion m7760 1.80 GHz with Windows Vista Home Premium SP1. ' - Code posted here is released to Public Domain. Use at your own risk. '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' SED_PBWIN #COMPILE EXE "ChooseC.exe" #REGISTER NONE #DIM ALL #INCLUDE "WIN32API.INC" #INCLUDE "COMMCTRL.INC" #INCLUDE "COMDLG32.INC" '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ %ID_SYSBASE = 2000 %ID_SYSCOLOR00 = %ID_SYSBASE %ID_SYSCOLOR30 = %ID_SYSBASE + 30 %ID_TXTHEX = 2201 %ID_TXTRGB = 2202 %ID_TXTDEC = 2203 %ID_TXTPR = 2211 %ID_TXTPG = 2212 %ID_TXTPB = 2213 %ID_TXTHEXR = 2221 %ID_TXTHEXG = 2222 %ID_TXTHEXB = 2223 %ID_INFOR = 2231 %ID_INFOG = 2232 %ID_INFOB = 2233 %ID_INFORGB = 2241 %ID_INFOHEX = 2242 %ID_INFODEC = 2243 %ID_INFOBRGB = 2251 %ID_INFOBHEX = 2252 %ID_INFOBDEC = 2253 '======= Do not change these values, are used by CHOOSECOLOR API ======= '======== Information obtained using PBWinSpy of Borje Hagsten ========= %ID_ACCEPT = 1 'accept button === %ID_CANCEL = 2 'cancel button === %ID_AREA702 = 702 'luminosity area, vertical bar === %ID_EDIT703 = 703 'H in HSL area === %ID_EDIT704 = 704 'S " " " === %ID_EDIT705 = 705 'L " " " === %ID_EDIT706 = 706 'R in decimal area === %ID_EDIT707 = 707 'G " " === %ID_EDIT708 = 708 'B " " === %ID_AREA709 = 709 'output color area === %ID_ADDCOLOR = 712 'add custom colors button === %ID_BUTTON719 = 719 'button nullified === %ID_STATIC730 = 730 'label nullified === %ID_STATIC731 = 731 'label nullified === %ID_HELP = 1038 'help button === '======= information verified on Windows Vista SP1 and XP SP3 ========== '======================================================================= $TITLE = "ChooseColor Extended" '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GLOBAL ghToolTip AS DWORD 'tooltip handler GLOBAL gSColors() AS LONG 'system colors RGB array (0 to 30) GLOBAL gBrushes() AS LONG 'system colors RGB array (0 to 30) GLOBAL gIniFile AS ASCIIZ * 256 'ini filename GLOBAL gFirstTime AS LONG 'used if INI not found GLOBAL gToolTipTxt AS ASCIIZ * 256 'tooltip text GLOBAL gBaseX, gBaseY AS LONG 'horizontal and vertical dialog base units GLOBAL gR, gG, gB AS LONG 'current color selected GLOBAL gRc AS RECT 'window size and position GLOBAL gStyleClip AS LONG 'clipboard style preference GLOBAL gWebSafe AS LONG 'web safe indicator '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION WINMAIN(BYVAL hInstance AS DWORD, _ BYVAL hPrevInstance AS DWORD, _ BYVAL lpCmdLine AS ASCIIZ PTR, _ BYVAL iCmdShow AS LONG) AS LONG LOCAL ColorSpec AS CHOOSECOLORAPI LOCAL j, lRes, lIniNew AS LONG LOCAL szText AS ASCIIZ * 100 LOCAL InString AS ASCIIZ * %MAX_PATH DIM lCustomColor(15) AS LONG 'only one instance of this program is allowed szText = $TITLE + $TITLE + $TITLE IF CreateMutex(BYVAL 0, 1, szText) THEN IF GetLastError = %ERROR_ALREADY_EXISTS THEN EXIT FUNCTION END IF 'check the existence of .INI file gIniFile = EXE.PATH$ + EXE.NAME$ + ".INI" IF ISFILE(gIniFile) THEN FOR j = 0 TO 15 'get custom colors from previous session lCustomColor(j) = GetPrivateProfileInt("Custom Colors", "Color" & FORMAT$(j,"00"), 0, gIniFile) NEXT ColorSpec.rgbResult = GetPrivateProfileInt("Custom Colors", "LastSelected", 0, gIniFile) ELSE gFirstTime = %TRUE RANDOMIZE TIMER FOR j = 0 TO 15 lCustomColor(j) = RND(0,16777215) 'create at random 16 colors NEXT ColorSpec.rgbResult = RGB(255,128,64) 'set the default color END IF ColorSpec.lStructSize = LEN(ColorSpec) ColorSpec.hwndOwner = hPrevInstance ColorSpec.lpCustColors = VARPTR(lCustomColor(0)) ColorSpec.lpfnHook = CODEPTR(ColorHookProc) ColorSpec.Flags = %CC_RGBINIT OR %CC_FULLOPEN OR %CC_ENABLEHOOK OR %CC_SHOWHELP 'obtain system colors and fill arrays with colors and brushes GetSystemColors lRes = ChooseColor(ColorSpec) '<==== call main dialog ===== IF lRes = 0 THEN 'MSGBOX "You chose the Cancel button.",,$TITLE ELSE szText = FORMAT$(ColorSpec.rgbResult) WritePrivateProfileString "Custom Colors", "LastSelected", szText, gIniFile szText = FORMAT$(gStyleClip) WritePrivateProfileString "Placement", "StyleClip", szText, gIniFile FOR j = 0 TO 15 'save custom colors to next session szText = FORMAT$(lCustomColor(j)) WritePrivateProfileString "Custom Colors", "Color" & FORMAT$(j,"00"), szText, gIniFile NEXT END IF FUNCTION = 1 END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION ColorHookProc(BYVAL hWnd AS LONG, BYVAL wMsg AS DWORD, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS DWORD 'Hook procedure for color picker dialog LOCAL cxDlg, cyDlg, posi AS LONG LOCAL sTemp AS STRING LOCAL tRc AS RECT LOCAL tDrawItem AS DRAWITEMSTRUCT PTR STATIC hDC, Colour, OldStyle, hFnt AS DWORD STATIC lpsz AS ASCIIZ * 10 SELECT CASE wMsg CASE %WM_INITDIALOG 'sets caption text and icon SendMessage hWnd, %WM_SETICON, %ICON_BIG, LoadIcon(%NULL, BYVAL %IDI_APPLICATION) SetWindowText hWnd, $TITLE 'get dialog base unit values using the second method 'described in [URL]http://support.microsoft.com/kb/145994[/URL] SetRect tRc, 0, 0, 4, 8 MapDialogRect hWnd, tRc gBaseX = tRc.nRight gBaseY = tRc.nBottom 'expand the existing window GetWindowRect hWnd, gRc gRc.nRight = gRc.nRight + (134*gBaseX)/4 MoveWindow hWnd, gRc.nLeft, gRc.nTop, gRc.nRight, gRc.nBottom, %TRUE 'if first time centers the window, else use last position saved on INI file IF gFirstTime THEN cxDlg = gRc.nRight - gRc.nLeft cyDlg = gRc.nBottom - gRc.nTop SetWindowPos hWnd, %HWND_TOP, (GetSystemMetrics(%SM_CXSCREEN) \ 2) - (cxDlg \ 2), _ (GetSystemMetrics(%SM_CYSCREEN) \ 2) - (cyDlg \ 2), 0, 0, %SWP_NOSIZE ELSE RestoreWindowPosition hWnd SetWindowPos hWnd, %HWND_TOP, gRc.nLeft, gRc.nTop, 0, 0, %SWP_NOSIZE END IF 'fill window with new buttons, labels, etc... CreateControls hWnd 'prepare tooltips text CreateToolTips hWnd 'set ClipBoard format, RGB as default IF gFirstTime THEN gStyleClip = 0 ELSE gStyleClip = GetPrivateProfileInt("Placement", "StyleClip", 1, gIniFile) END IF SendMessage GetDlgItem(hWnd, %ID_INFOBRGB + gStyleClip), %BM_SETCHECK, %BST_CHECKED, 0 'add %SS_NOTIFY style to output color area to generate a %WM_COMMAND when click here OldStyle = GetWindowLong(GetDlgItem(hWnd, %ID_AREA709), %GWL_STYLE) SetWindowLong GetDlgItem(hWnd, %ID_AREA709), %GWL_STYLE, OldStyle OR %SS_NOTIFY lpSz = "abcABC" hDC = GetDC(hWnd) 'get DC of color output area hFnt = GetStockObject(%ANSI_VAR_FONT) SelectObject hDC, hFnt ShowColorData hWnd CASE %WM_SIZE 'nullify some controls not used MoveWindow GetDlgItem(hWnd, %ID_BUTTON719), 0, 0, 0, 0, %FALSE MoveWindow GetDlgItem(hWnd, %ID_STATIC730), 0, 0, 0, 0, %FALSE MoveWindow GetDlgItem(hWnd, %ID_STATIC731), 0, 0, 0, 0, %FALSE 'change size output color area MoveWindow GetDlgItem(hWnd, %ID_AREA709), (152*gBaseX)/4, (124*gBaseY)/8, (40*gBaseX)/4, (39*gBaseY)/8, %TRUE 'change width of luminosity bar MoveWindow GetDlgItem(hWnd, %ID_AREA702), (276*gBaseX)/4, (4*gBaseY)/8, (12*gBaseX)/4, (117*gBaseY)/8, %TRUE CASE %WM_DRAWITEM 'fill new buttons with system colors tDrawItem = lparam SELECT CASE @tDrawItem.CtlID CASE %ID_SYSCOLOR00 TO %ID_SYSCOLOR30 posi = @tDrawItem.CtlID - %ID_SYSBASE 'make index FillRect @tDrawItem.hDc, @tDrawItem.rcItem, gBrushes(posi) DrawEdge @tDrawItem.hDC, @tDrawItem.rcItem, %EDGE_SUNKEN, %BF_RECT IF (@tDrawItem.itemState AND %ODS_FOCUS) THEN InflateRect @tDrawItem.RcItem, -3, -3 DrawFocusRect @tDrawItem.hDC, @tDrawItem.rcItem END IF FUNCTION = %FALSE CASE ELSE FUNCTION = %TRUE END SELECT CASE %WM_COMMAND SELECT CASE LOWRD(wParam) CASE %ID_SYSCOLOR00 TO %ID_SYSCOLOR30 posi = LOWRD(wParam) - %ID_SYSBASE 'make index MoveColorData hWnd, posi CASE %ID_EDIT706 TO %ID_EDIT708 SELECT CASE LOWRD(wParam) CASE %ID_EDIT706 sTemp = GetStringText(hWnd, %ID_EDIT706) gR = VAL(sTemp) CASE %ID_EDIT707 sTemp = GetStringText(hWnd, %ID_EDIT707) gG = VAL(sTemp) CASE %ID_EDIT708 sTemp = GetStringText(hWnd, %ID_EDIT708) gB = VAL(sTemp) END SELECT ShowColorData hWnd FUNCTION = %FALSE CASE %ID_AREA709 'mouse clicked on output color area due %SS_NOTIFY added previously IF HI(WORD, wParam) = %STN_CLICKED THEN Colour = gR + gG * 256 + gB * 65536 SetBkColor hDC, Colour SetTextColor hDC, %BLACK 'text in black TextOut hDC, (159*gBaseX)/4, (127*gBaseY)/8, lpSz, BYVAL LEN(lpSz) SetTextColor hDC, %WHITE 'text in white TextOut hDC, (159*gBaseX)/4, (139*gBaseY)/8, lpSz, BYVAL LEN(lpSz) SetTextColor hDC, %RED 'text in red TextOut hDC, (159*gBaseX)/4, (152*gBaseY)/8, lpSz, BYVAL LEN(lpSz) END IF FUNCTION = %TRUE CASE %ID_ACCEPT IF SendMessage(GetDlgItem(hWnd, %ID_INFOBRGB), %BM_GETCHECK, 0, 0) THEN sTemp = GetStringText(hWnd, %ID_TXTRGB) sTemp = "RGB(" + sTemp + ")" gStyleClip = 0 ELSEIF SendMessage(GetDlgItem(hWnd, %ID_INFOBHEX), %BM_GETCHECK, 0, 0) THEN sTemp = GetStringText(hWnd, %ID_TXTHEX) sTemp = "&h" + sTemp + "???" gStyleClip = 1 ELSEIF SendMessage(GetDlgItem(hWnd, %ID_INFOBDEC), %BM_GETCHECK, 0, 0) THEN sTemp = GetStringText(hWnd, %ID_TXTDEC) gStyleClip = 2 END IF ClipBoardSetText hWnd, sTemp FUNCTION = 0 CASE %ID_CANCEL FUNCTION = 0 CASE %ID_HELP ShowHelpText FUNCTION = 0 END SELECT CASE %WM_DESTROY SaveWindowPosition hWnd END SELECT END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION GetStringText(BYVAL hWnd AS DWORD, BYVAL areaid AS INTEGER) AS STRING LOCAL sTemp AS STRING LOCAL sLen AS LONG sLen = SendMessage(GetDlgItem(hWnd, areaid), %WM_GETTEXTLENGTH, 0, 0) sTemp = SPACE$(sLen) SendMessage(GetDlgItem(hWnd, areaid), %WM_GETTEXT, sLen+1, STRPTR(sTemp)) FUNCTION = sTemp END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB ShowColorData(hWnd AS DWORD) LOCAL sTemp AS STRING sTemp = FORMAT$(gR / 255 * 100) SendMessage GetDlgItem(hWnd, %ID_TXTPR), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = FORMAT$(gG / 255 * 100) SendMessage GetDlgItem(hWnd, %ID_TXTPG), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = FORMAT$(gB / 255 * 100) SendMessage GetDlgItem(hWnd, %ID_TXTPB), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = HEX$(gB, 2) + HEX$(gG, 2) + HEX$(gR, 2) SendMessage GetDlgItem(hWnd, %ID_TXTHEX), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = FORMAT$(gR, "000") + "," + FORMAT$(gG, "000") + "," + FORMAT$(gB, "000") SendMessage GetDlgItem(hWnd, %ID_TXTRGB), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = FORMAT$(gR + gG * 256 + gB * 65536) SendMessage GetDlgItem(hWnd, %ID_TXTDEC), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = HEX$(gR, 2) SendMessage GetDlgItem(hWnd, %ID_TXTHEXR), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = HEX$(gG, 2) SendMessage GetDlgItem(hWnd, %ID_TXTHEXG), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = HEX$(gB, 2) SendMessage GetDlgItem(hWnd, %ID_TXTHEXB), %WM_SETTEXT, 0, STRPTR(sTemp) END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB MoveColorData(hWnd AS DWORD, posi AS LONG) LOCAL sTemp AS STRING LOCAL dTemp AS DWORD dTemp = gSColors(posi) gR = LOBYT(LOWRD(dTemp)) gG = HIBYT(LOWRD(dTemp)) gB = LOBYT(HIWRD(dTemp)) sTemp = FORMAT$(gR) SendMessage GetDlgItem(hWnd, %ID_EDIT706), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = FORMAT$(gG) SendMessage GetDlgItem(hWnd, %ID_EDIT707), %WM_SETTEXT, 0, STRPTR(sTemp) sTemp = FORMAT$(gB) SendMessage GetDlgItem(hWnd, %ID_EDIT708), %WM_SETTEXT, 0, STRPTR(sTemp) END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB GetSystemColors() REGISTER j AS LONG LOCAL Lb AS LOGBRUSH REDIM gSColors(0 TO 30), gBrushes(0 TO 30) AS LONG Lb.lbStyle = %BS_SOLID FOR j = 0 TO 30 'system colors (31) gSColors(j) = GetSysColor(j) Lb.lbColor = gSColors(j) gBrushes(j) = CreateBrushIndirect(Lb) NEXT j END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB SaveWindowPosition(BYVAL hWnd AS DWORD) 'save last window position on INI file LOCAL rc AS RECT LOCAL buffer AS STRING GetWindowRect hWnd, rc IF rc.nleft < 0 THEN rc.nleft = 0 IF rc.ntop < 0 THEN rc.ntop = 0 buffer = FORMAT$(rc.nleft) + "," + FORMAT$(rc.ntop) WritePrivateProfileString "Placement", "Position", BYCOPY buffer, gIniFile END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB RestoreWindowPosition(BYVAL hWnd AS DWORD) 'restore values for window to last position LOCAL szText AS ASCIIZ * %MAX_PATH GetPrivateProfileString "Placement", "Position", szText, szText, SIZEOF(szText), gIniFile gRc.nLeft = VAL(PARSE$(szText, 1)) gRc.nTop = VAL(PARSE$(szText, 2)) END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION ClipBoardSetText(hWnd AS DWORD, BYVAL sText AS STRING) AS LONG LOCAL hData, hGlob AS DWORD hData = GlobalAlloc(%GMEM_MOVEABLE OR %GMEM_DDESHARE, LEN(sText)+1) hGlob = GlobalLock(hData) POKE$ hGlob, sText + CHR$(0) GlobalUnlock hData IF ISFALSE(OpenClipboard(%NULL)) THEN 'open the clipboard GlobalFree hData EXIT FUNCTION END IF EmptyClipboard 'paste the data into the clipboard FUNCTION = SetClipboardData(%CF_TEXT, hData) CloseClipboard END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB CreateToolTips(hWnd AS DWORD) ghToolTip = CreateWindowEx(BYVAL 0, "tooltips_class32", "", %TTS_ALWAYSTIP, _ 'OR %TTS_BALLOON, _ 0, 0, 0, 0, BYVAL hWnd, BYVAL 0, GetModuleHandle(BYVAL %NULL), BYVAL 0) SendMessage ghToolTip, %TTM_SETMAXTIPWIDTH, 0, 220 '220 seems appropriate Sendmessage ghToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 2000 '2000 = 2 seconds '--- tooltip texts --- SetToolTipText ghToolTip, %ID_SYSBASE, "%COLOR_SCROLLBAR" SetToolTipText ghToolTip, %ID_SYSBASE+01, "%COLOR_BACKGROUND" + $CRLF + _ "%COLOR_DESKTOP " SetToolTipText ghToolTip, %ID_SYSBASE+02, "%COLOR_ACTIVECAPTION" SetToolTipText ghToolTip, %ID_SYSBASE+03, "%COLOR_INACTIVECAPTION" SetToolTipText ghToolTip, %ID_SYSBASE+04, "%COLOR_MENU" + $CRLF + _ "%COLOR_MSGBOX" SetToolTipText ghToolTip, %ID_SYSBASE+05, "%COLOR_WINDOW" SetToolTipText ghToolTip, %ID_SYSBASE+06, "%COLOR_WINDOWFRAME" SetToolTipText ghToolTip, %ID_SYSBASE+07, "%COLOR_MENUTEXT" + $CRLF + _ "%COLOR_MSGBOXTEXT" SetToolTipText ghToolTip, %ID_SYSBASE+08, "%COLOR_WINDOWTEXT" SetToolTipText ghToolTip, %ID_SYSBASE+09, "%COLOR_CAPTIONTEXT" SetToolTipText ghToolTip, %ID_SYSBASE+10, "%COLOR_ACTIVEBORDER" SetToolTipText ghToolTip, %ID_SYSBASE+11, "%COLOR_INACTIVEBORDER" SetToolTipText ghToolTip, %ID_SYSBASE+12, "%COLOR_APPWORKSPACE" SetToolTipText ghToolTip, %ID_SYSBASE+13, "%COLOR_HIGHLIGHT" SetToolTipText ghToolTip, %ID_SYSBASE+14, "%COLOR_HIGHLIGHTTEXT" SetToolTipText ghToolTip, %ID_SYSBASE+15, "%COLOR_BTNFACE" + $CRLF + _ "%COLOR_3DFACE" SetToolTipText ghToolTip, %ID_SYSBASE+16, "%COLOR_BTNSHADOW" + $CRLF + _ "%COLOR_3DSHADOW" SetToolTipText ghToolTip, %ID_SYSBASE+17, "%COLOR_GRAYTEXT" SetToolTipText ghToolTip, %ID_SYSBASE+18, "%COLOR_BTNTEXT" SetToolTipText ghToolTip, %ID_SYSBASE+19, "%COLOR_INACTIVECAPTIONTEXT" SetToolTipText ghToolTip, %ID_SYSBASE+20, "%COLOR_BTNHIGHLIGHT" + $CRLF + _ "%COLOR_3DHIGHLIGHT" + $CRLF + _ "%COLOR_3DHILIGHT" + $CRLF + _ "%COLOR_BTNHILIGHT" SetToolTipText ghToolTip, %ID_SYSBASE+21, "%COLOR_3DDKSHADOW" SetToolTipText ghToolTip, %ID_SYSBASE+22, "%COLOR_3DLIGHT" SetToolTipText ghToolTip, %ID_SYSBASE+23, "%COLOR_INFOTEXT" SetToolTipText ghToolTip, %ID_SYSBASE+24, "%COLOR_INFOBK" SetToolTipText ghToolTip, %ID_SYSBASE+25, " ? " SetToolTipText ghToolTip, %ID_SYSBASE+26, "%COLOR_HOTLIGHT" SetToolTipText ghToolTip, %ID_SYSBASE+27, "%COLOR_GRADIENTACTIVECAPTION" SetToolTipText ghToolTip, %ID_SYSBASE+28, "%COLOR_GRADIENTINACTIVECAPTION" SetToolTipText ghToolTip, %ID_SYSBASE+29, "%COLOR_MENUHILIGHT" SetToolTipText ghToolTip, %ID_SYSBASE+30, "%COLOR_MENUBAR" SetToolTipText ghToolTip, %ID_ACCEPT, "Set current color on ClipBoard and terminates" SetToolTipText ghToolTip, %ID_HELP, "Help button" + $CRLF + "To be defined" SetToolTipText ghToolTip, %ID_CANCEL, "Cancel all operation and terminates" SetToolTipText ghToolTip, %ID_ADDCOLOR, "Add current color to Custom Colors" SetToolTipText ghToolTip, %ID_AREA709, "Click here to see text contrast ..." SetToolTipText ghToolTip, %ID_EDIT703, "Hue" SetToolTipText ghToolTip, %ID_EDIT704, "Saturation" SetToolTipText ghToolTip, %ID_EDIT705, "Lightness" SetToolTipText ghToolTip, %ID_EDIT706, "Amount of Red" SetToolTipText ghToolTip, %ID_EDIT707, "Amount of Green" SetToolTipText ghToolTip, %ID_EDIT708, "Amount of Blue" SetToolTipText ghToolTip, %ID_TXTPR, "Amount of Red in %" SetToolTipText ghToolTip, %ID_TXTPG, "Amount of Green in %" SetToolTipText ghToolTip, %ID_TXTPB, "Amount of Blue in %" SetToolTipText ghToolTip, %ID_TXTRGB, "Color in RGB format" SetToolTipText ghToolTip, %ID_TXTHEX, "Color in Hex format" SetToolTipText ghToolTip, %ID_TXTDEC, "Color in Decimal format" SetToolTipText ghToolTip, %ID_INFOBRGB, "Color in RGB format" SetToolTipText ghToolTip, %ID_INFOBHEX, "Color in Hex format" SetToolTipText ghToolTip, %ID_INFOBDEC, "Color in Decimal format" END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB SetToolTipText(BYVAL hWnd AS DWORD, BYVAL ID AS LONG, BYVAL Txt AS STRING) LOCAL hLocalDlg AS DWORD LOCAL ti AS TOOLINFO gToolTipTxt = Txt hLocalDlg = GetParent(ghToolTip) ti.cbSize = LEN(ti) ti.uFlags = %TTF_SUBCLASS OR %TTF_IDISHWND ti.hWnd = hLocalDlg ti.uId = GetDlgItem(hLocalDlg, ID) ti.lpszText = VARPTR(gToolTipTxt) SendMessage hWnd, %TTM_ADDTOOL, 0, VARPTR(ti) END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB CreateControls(BYVAL hWnd AS DWORD) LOCAL hCtl, hFnt AS DWORD LOCAL i, j, k, w, h AS LONG hFnt = GetStockObject(%ANSI_VAR_FONT) hCtl = CreateWindowEx(%WS_EX_NOPARENTNOTIFY, "Static", "Current system colors:", %WS_CHILD OR %WS_VISIBLE, _ (303*gBaseX)/4, (4*gBaseY)/8, (140*gBaseX)/4, (9*gBaseY)/8, hWnd, -1, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 '--- system colors buttons --- w = (13*gBaseX)/4 'to avoid repetitive operations h = (11*gBaseY)/8 ' " " " FOR i = 0 TO 3 'rows FOR j = 0 TO 7 'columns hCtl = CreateWindowEx(0, "Button", BYVAL %NULL, %WS_CHILD OR %WS_VISIBLE OR %BS_OWNERDRAW, _ ((303+j*16)*gBaseX)/4, ((16+i*14)*gBaseY)/8, w, h, hWnd, %ID_SYSBASE + k, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 INCR k NEXT j NEXT i '--- percentage indicators --- hCtl = CreateWindowEx(0, "Static", "/ 255 = ( )%", %WS_CHILD OR %WS_VISIBLE, _ (309*gBaseX)/4, (126*gBaseY)/8, (87*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFOR, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(0, "Static", "/ 255 = ( )%", %WS_CHILD OR %WS_VISIBLE, _ (309*gBaseX)/4, (140*gBaseY)/8, (87*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFOG, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(0, "Static", "/ 255 = ( )%", %WS_CHILD OR %WS_VISIBLE, _ (309*gBaseX)/4, (154*gBaseY)/8, (87*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFOB, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 '--- percent edit boxes hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "333", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (339*gBaseX)/4, (124*gBaseY)/8, (18*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTPR, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "255", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (339*gBaseX)/4, (138*gBaseY)/8, (18*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTPG, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "255", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (339*gBaseX)/4, (152*gBaseY)/8, (18*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTPB, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 '--- current value in hexa hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "00", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (292*gBaseX)/4, (124*gBaseY)/8, (13*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTHEXR, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "84", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (292*gBaseX)/4, (138*gBaseY)/8, (13*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTHEXG, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "EF", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (292*gBaseX)/4, (152*gBaseY)/8, (13*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTHEXB, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 '--- format in clipboard --- hCtl = CreateWindowEx(0, "Static", "Clipboard style preference:", %WS_CHILD OR %WS_VISIBLE, _ (303*gBaseX)/4, (70*gBaseY)/8, (140*gBaseX)/4, (9*gBaseY)/8, hWnd, -2, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 '--- radio buttons --- hCtl = CreateWindowEx(0, "Button", " ", %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %BS_AUTORADIOBUTTON, _ (327*gBaseX)/4, (82*gBaseY)/8, (7*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFOBRGB, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(0, "Button", " ", %WS_CHILD OR %WS_VISIBLE OR %BS_AUTORADIOBUTTON, _ (327*gBaseX)/4, (96*gBaseY)/8, (7*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFOBHEX, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(0, "Button", " ", %WS_CHILD OR %WS_VISIBLE OR %BS_AUTORADIOBUTTON, _ (327*gBaseX)/4, (110*gBaseY)/8, (7*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFOBDEC, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 '--- static labels --- hCtl = CreateWindowEx(0, "Static", "RGB ( )", %WS_CHILD OR %WS_VISIBLE, _ (340*gBaseX)/4, (82*gBaseY)/8, (87*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFORGB, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(0, "Static", "&&h ???", %WS_CHILD OR %WS_VISIBLE, _ (340*gBaseX)/4, (96*gBaseY)/8, (87*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFOHEX, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(0, "Static", " ", %WS_CHILD OR %WS_VISIBLE, _ (340*gBaseX)/4, (110*gBaseY)/8, (87*gBaseX)/4, (9*gBaseY)/8, hWnd, %ID_INFODEC, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 '--- info edit boxes hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "255,255,255", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (361*gBaseX)/4, (81*gBaseY)/8, (45*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTRGB, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "ABCDEF", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (349*gBaseX)/4, (94*gBaseY)/8, (32*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTHEX, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE OR %WS_EX_NOPARENTNOTIFY, "Edit", "0", _ %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR %ES_READONLY, _ (339*gBaseX)/4, (108*gBaseY)/8, (39*gBaseX)/4, (12*gBaseY)/8, hWnd, %ID_TXTDEC, GetModuleHandle(""), BYVAL %NULL) SendMessage hCtl, %WM_SETFONT, hFnt, 0 END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB ShowHelpText() LOCAL txt AS STRING txt = "ChooseColor Extended" + $CRLF txt += "Version 1c" + $CRLF txt += "November 2008" + $CRLF + $CRLF txt += "Uses the standard Windows Common Dialog CHOOSECOLOR" + $CRLF txt += "but utilizing extensively the Hook facility provided and pointed" + $CRLF txt += "on CHOOSECOLORAPI structure." + $CRLF + $CRLF txt += "Facilities added:" + $CRLF txt += " - Entire set of Windows System Colors with current colors." + $CRLF txt += " - ToolTips added to all controls." + $CRLF txt += " - Percentage of current color selected." + $CRLF txt += " - Current selected color in hexadecimal." + $CRLF txt += " - Output color area expanded." + $CRLF txt += " - Click over output color shows contrast with some text." + $CRLF txt += " - Accept or Enter key set current information on ClipBoard" + $CRLF txt += " and terminates." + $CRLF txt += " - Three styles of data when save information on ClipBoard." + $CRLF txt += " - Remember style between sessions." + $CRLF txt += " - Save/restore all 16 custom colors." + $CRLF txt += " - Luminiscence bar more wide." + $CRLF txt += " - Save/restore window position." + $CRLF txt += " - Starts with last color selected." + $CRLF + $CRLF txt += " Information saved/restored in a INI file created dynamically" + $CRLF txt += " on same folder of this executable program." MSGBOX txt, %MB_ICONINFORMATION OR %MB_OK OR %MB_SYSTEMMODAL, $Title END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ 'eof
Comment