Hej hur får man reda på om datorn kör i 255 color.
Behöver veta det för att kunna styra olicka backcolor i mitt prog,

mvh
tobbe

Finns nog i tips & tricks!
/Pelle

Hej Pelle

Jag har letat i Tips&tricks och i böcker, sidor på internet men hittar inte något om hur man får reda på vilket colormode datorn använder.

Något i stil med detta skulle jag vilja använda

if Color = 8 then
Text1.Backcolor = vbRed
else
Text1.Backcolor = vbBlue
end if

Mvh
Tobbe

Kolla in det här:
http://216.26.168.92/vbapi/ref/g/getsystemmetrics.html

Hej

Jag har kollat in länken men kan inte hitta något om hur man kan få reda på om datorn kör med 255 color.

Verkar vara en svår nöt att knäcka? eller så är det att jag är för trött för att hitta den rätta koden.

Mvh
Tobbe

Sorry fel länk :-/
<code>
Public Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, lpDevMode As DEVMODE) As Long

Public Const ENUM_CURRENT_SETTINGS = -1

Public Type DEVMODE
dmDeviceName As String * 32
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * 32
dmUnusedPadding As Integer
dmBitsPerPixel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
' The following only appear in Windows 95, 98, 2000
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmReserved1 As Long
dmReserved2 As Long
' The following only appear in Windows 2000
dmPanningWidth As Long
dmPanningHeight As Long
End Type

Sub CheckDisplay()
Dim scr As DEVMODE
Dim sMessage As String
scr.dmSize = Len(scr)
Call EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, scr)

sMessage = "Din upplösning är för närvarande " & scr.dmPelsWidth & "x" & scr.dmPelsHeight & " med färgdjupet: " & scr.dmBitsPerPixel & "bpp (" & clng(2^scr.dmBitsPerPixel) & " antal färger)"
MsgBox sMessage
End Sub
</code>

Hej
Om du har koll på hur man läser från registret kan du
Kolla på
HKEY_LOCAL_MACHINE Config - 0001 - Display - Settings

raden BitsPerPixel om det står 8 där så betyder det 256 färger
Det normala är väl att man har 16 eller 24 där.

Jag kan skriva ihop en läsare av denna rad om du vill.
Ni som läser detta kan väl kolla om det är ett allmänngiltigt
svar , dvs att Ni har uppgiften på den sökväg jag hänvisar till.

mvh
Sven

Hej
Testa det här
Option Explicit
Private Declare Function RegOpenKeyEx Lib _
"advapi32" Alias "RegOpenKeyExA" _
(ByVal hkey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, _
ByRef phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib _
"advapi32" Alias "RegQueryValueExA" _
(ByVal hkey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, ByRef lpType As Long, _
ByVal lpData As String, ByRef lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib _
"advapi32" (ByVal hkey As Long) As Long
Const HKEY_LOCAL_MACHINE = &H80000002

Private Sub Command1_Click()
Dim rc ' Return Code
Dim hkey ' Handle To An Open Registry Key
Dim KeyVal As String
Dim KeyValType ' Data Type Of A Registry Key
Dim KeyValSize 'Size Of Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Config\0001\Display\Settings", 0, &H1, hkey)
If rc <> 0 Then GoTo GetKeyError
KeyVal = String$(32, 0) ' Allocate Variable Space
KeyValSize = 32 ' Mark Variable Size
'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
' Get/Create Key Value
rc = RegQueryValueEx(hkey, "BitsPerPixel", 0, _
KeyValType, KeyVal, KeyValSize)
' Win95 Adds Null Terminated String...
' Null Found, Extract From String
' WinNT Does NOT Null Terminate String...
' Null Not Found, Extract String Only
On Error Resume Next
If InStr(KeyVal, Chr$(0)) Then _
KeyVal = Left$(KeyVal, _
InStr(KeyVal, Chr$(0)) - 1)
'Ta bort NULL-tecken (Chr$(0)) ******* Visa resultat
If KeyVal = "8" Then
MsgBox "Användarens inställning 256 färger"
Else
MsgBox "Användarens inställning 4000 färger eller mer"
End If
' Close Registry Key
rc = RegCloseKey(hkey)
Exit Sub
GetKeyError: 'Cleanup After An Error Has Occured...
KeyVal = "" 'Set Return Val To Empty String
' Close Registry Key
rc = RegCloseKey(hkey)
On Error GoTo 0
End Sub

mvh
Sven

Sven, värdet kan vara 4 också, och då är det sexton färger.

Hej trash
Oki på det (4),tror knappt att det finns någon dator
kvar i Sverige där användaren kör 16 Color

ha det
Sven

Du har nog rätt, men man skall aldrig vara säker (win95 i felsäkert läge kör på 16 färger).

Väl mött..

Hej Sven

Äntligen något och jobba vidare på, tackar även Trash för visat intresse.

Mvh
Tobbe

Mitt förslag:
<code>
Private Const BITSPIXEL = 12

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Public Function ColorDepth() As Long
Dim ScreenDC As Long
ScreenDC = GetDC(0)
ColorDepth = GetDeviceCaps(ScreenDC, BITSPIXEL)
End Function
</code>

Hej
Kanonlösning Andreas. Åkte i godislådan direkt.

Ha det
Sven