You are not logged in. You can browse in the PowerBASIC Community, but you must click Login (top right) before you can post. If this is your first visit, check out the FAQ or Sign Up.
Announcement
Collapse
Forum Guidelines
This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
Interesting, how to find RGB values for 256-colors palette ?
The default palette does not fill all 256 entries. Usually only about 20 are defined (I seem to recall the exact behavior is driver dependant), and the remaining entries are set by application(s) that alter the system palette.
This function finds "nearest" index for PB/CC COLOR
(initially was done in VB to find "clean" colors and was based on QBColor statement)
Code:
Function QbColorId (RGBComp As Dword) As Long
Local RGBTest As Dword, ss As Quad, s As Quad
Local i As Long, j As Long, ii As Long
Local b1 As Byte Ptr, b2 As Byte Ptr
For i = 0 To 15
Select Case i
Case 0: RgbTest = &H000000
Case 1: RgbTest = &H800000
Case 2: RgbTest = &H008000
Case 3: RgbTest = &H808000
Case 4: RgbTest = &H000080
Case 5: RgbTest = &H800080
Case 6: RgbTest = &H008080
Case 7: RgbTest = &HC0C0C0
Case 8: RgbTest = &H808080
Case 9: RgbTest = &HFF0000
Case 10: RgbTest = &H00FF00
Case 11: RgbTest = &HFFFF00
Case 12: RgbTest = &H0000FF
Case 13: RgbTest = &HFF00FF
Case 14: RgbTest = &H00FFFF
Case 15: RgbTest = &HFFFFFF
End Select
b1 = VarPtr(RGBTest): b2 = VarPtr(RGBComp): s = 0
For j = 1 To 3
s = s + (@b1 - @b2) * (@b1 - @b2)
Incr b1: Incr b2
Next
If (i = 0) Or (ss > s) Then ss = s: ii = i
Next
Function = ii
End Function
Usage for Eric's sample:
MsgBox Str$(QbColorId(ColorSpec.rgbResult)),,"PbCC Color"
Interesting, how to find RGB values for 256-colors pallette ?
Hmmm... Not off the top of my head. The ChooseColor dialog is designed to allow the selection of any valid Windows color, so you probably couldn't restrict the display to 16 colors. So several of the standard color choices won't make sense in the context of a console app.
Or are you asking how you could write a "best match" function that could convert a TrueColor RGB value into the closest valid console color? I've never tried it, but it doesn't sound like it would be too difficult. Has anybody out there written one?
One interesting side note for PB/CC programmers... If your program will be run only on NT or 2000, it is possible to specify "custom colors" for each of the 16 standard COLOR values by editing the registry. But the settings will only take effect the next time your program is run, since Windows only reads the registry when it creates the console. But it can be a useful technique for giving your PB/CC apps a custom look.
This small PB/DLL program demonstrates the use of the ChooseColor common dialog. If you change the two MSGBOX lines to PRINT and add a WAITKEY$ at the end, the program can also be compiled with PB/CC.
Code:
$DIM ALL
$REGISTER NONE
$COMPILE EXE
$INCLUDE "WIN32API.INC"
$INCLUDE "COMDLG32.INC"
FUNCTION PBMain AS LONG
DIM ColorSpec AS LOCAL CHOOSECOLORAPI
DIM lResult AS LOCAL LONG
DIM lCounter AS LOCAL LONG
DIM lCustomColor(15) AS LOCAL LONG 'array
ColorSpec.lStructSize = LEN(ColorSpec)
ColorSpec.hwndOwner = 0 'Handle of owner window. If 0, dialog appears at top/left.
ColorSpec.lpCustColors = VARPTR(lCustomColor(0))
ColorSpec.rgbResult = 255 'set the default color to Red (255,0,0)...
'try these options one by one, for different effects...
'ColorSpec.Flags = ColorSpec.Flags OR %CC_RGBINIT 'tells control to start at default color
'ColorSpec.Flags = ColorSpec.Flags OR %CC_FULLOPEN
'ColorSpec.Flags = ColorSpec.Flags OR %CC_PREVENTFULLOPEN
'create a nice selection of colors for the custom colors (OPTIONAL)...
RANDOMIZE TIMER
FOR lCounter = 0 TO 15
lCustomColor(lCounter) = RND(0,16777215) 'or RGB(lCounter*16,0,(15-lCounter)*16)
NEXT
'(You could also load custom colors from a file, or hard-code them.)
lResult = ChooseColor(ColorSpec)
IF lResult = 0 THEN
MSGBOX "You chose the Cancel button.",,"Color Selection Demo"
ELSE
MSGBOX "You chose color value &h"+HEX$(ColorSpec.rgbResult,6),,"Color Selection Demo"
END IF
'You can also check then values in the lCustomColor() array to see if they've been changed.
FUNCTION = 1
END FUNCTION
We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.
By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.
Leave a comment: