作用:
給控制項加上背景圖片
Converts an OLE_COLOR type to a COLORREF.
Copy Code
STDAPI OleTranslateColor (
OLE_COLOR clr, //Color to be converted into a COLORREF
HPALETTE hpal, //Palette used for conversion
COLORREF *pcolorref //Pointer to the caller's variable that
// receives the converted result
以下為VB加TREEVIEW背景示例
Standard Module modSubclass.bas:
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (lpDest As Any, lpSrc As Any, _
ByVal dwLen As Long)
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetProp Lib "user32" Alias _
"GetPropA" (ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias _
"SetPropA" (ByVal hWnd As Long, _
ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias _
"RemovePropA" (ByVal hWnd As Long, _
ByVal lpString As String) As Long
Public Sub Subclass(frm As Form, tv As TreeView)
'Subclass the TreeView and store an object
'pointer to the form.
Dim lProc As Long
If GetProp(tv.hWnd, "VBTWndProc") <> 0 Then
Exit Sub
End If
lProc = GetWindowLong(tv.hWnd, GWL_WNDPROC)
SetProp tv.hWnd, "VBTWndProc", lProc
SetProp tv.hWnd, "VBTWndPtr", ObjPtr(frm)
SetWindowLong tv.hWnd, GWL_WNDPROC, _
AddressOf WndProcTV
End Sub
Public Sub UnSubclass(tv As TreeView)
Dim lProc As Long
lProc = GetProp(tv.hWnd, "VBTWndProc")
If lProc = 0 Then
Exit Sub
End If
SetWindowLong tv.hWnd, GWL_WNDPROC, lProc
RemoveProp tv.hWnd, "VBTWndProc"
RemoveProp tv.hWnd, "VBTWndPtr"
End Sub
Public Function WndProcTV(ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
On Error Resume Next
Dim lProc As Long
Dim lPtr As Long
Dim tmpForm As Form
Dim bUseRetVal As Boolean
Dim lRetVal As Long
bUseRetVal = False
lProc = GetProp(hWnd, "VBTWndProc")
lPtr = GetProp(hWnd, "VBTWndPtr")
'Copy the form's object pointer into an
'object variable and call the message handler.
CopyMemory tmpForm, lPtr, 4
tmpForm.TreeViewMessage hWnd, wMsg, wParam, lParam, _
lRetVal, bUseRetVal
CopyMemory tmpForm, 0&, 4
'我將以上三句中的"tmpForm" 替換成"frmMain"後才能運行。
If bUseRetVal = True Then
'Use the return value from the form's
'handler
WndProcTV = lRetVal
Else
'Pass on to original wndproc
WndProcTV = CallWindowProc(lProc, hWnd, wMsg, _
wParam, lParam)
End If
End Function
'--end block--'
Standard Module Paint.bas:
Option Explicit
'================================================
'Paint.bas
'Visual Basic Thunder
'http://www.vbthunder.com
'
'These routines taken (and later modified) from
'Microsoft's Visual Basic 5.0 Owner's Area.
'================================================
'Halftone created for default palette use
Private m_hpalHalftone As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CreateSolidBrush Lib "gdi32" _
(ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" _
(ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hDC As Long, _
ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" _
(ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" _
(ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal nPlanes As Long, ByVal nBitCount As Long, _
lpBits As Any) As Long
Private Declare Function GetBkColor Lib "gdi32" _
(ByVal hDC As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" _
(ByVal hDC As Long) As Long
Private Declare Function SelectPalette Lib "gdi32" _
(ByVal hDC As Long, ByVal hPalette As Long, _
ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" _
(ByVal hDC As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" _
(ByVal lOleColor As Long, ByVal lHPalette As Long, _
lColorRef As Long) As Long
Private Declare Function DrawIconEx Lib "user32" _
(ByVal hDC As Long, ByVal xLeft As Long, _
ByVal yTop As Long, ByVal hIcon As Long, _
ByVal cxWidth As Long, ByVal cyHeight As Long, _
ByVal istepIfAniCur As Long, _
ByVal hbrFlickerFreeDraw As Long, _
ByVal diFlags As Long) As Long
Private Declare Function FillRect Lib "user32" _
(ByVal hDC As Long, lpRect As RECT, _
ByVal hBrush As Long) As Long
'DrawIconEx Flags
Private Const DI_MASK = &H1
Private Const DI_IMAGE = &H2
Private Const DI_NORMAL = &H3
Private Const DI_COMPAT = &H4
Private Const DI_DEFAULTSIZE = &H8
'Raster Operation Codes
Private Const DSna = &H220326 '0x00220326
'VB Errors
Private Const giINVALID_PICTURE As Integer = 481
Public Function TranslateColor(inCol As Long) As Long
'A simple wrapper for OleTranslateColor
Dim retCol As Long
OleTranslateColor inCol, 0&, retCol
TranslateColor = retCol
End Function
Public Sub PaintNormalStdPic(ByVal hdcDest As Long, _
ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal width As Long, _
ByVal Height As Long, _
ByVal picSource As Picture, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
Optional ByVal hPal As Long = 0)
Dim hdcTemp As Long
Dim hPalOld As Long
Dim hbmMemSrcOld As Long
Dim hdcScreen As Long
Dim hbmMemSrc As Long
'Validate that a bitmap was passed in
If picSource Is Nothing Then GoTo PaintNormalStdPic_InvalidParam
Select Case picSource.Type
Case vbPicTypeBitmap
If hPal = 0 Then
hPal = m_hpalHalftone
End If
hdcScreen = GetDC(0&)
'Create a DC to select bitmap into
hdcTemp = CreateCompatibleDC(hdcScreen)
hPalOld = SelectPalette(hdcTemp, hPal, True)
RealizePalette hdcTemp
'Select bitmap into DC
hbmMemSrcOld = SelectObject(hdcTemp, picSource.Handle)
'Copy to destination DC
BitBlt hdcDest, xDest, yDest, width, Height, hdcTemp, xSrc, ySrc, vbSrcCopy
'Cleanup
SelectObject hdcTemp, hbmMemSrcOld
SelectPalette hdcTemp, hPalOld, True
RealizePalette hdcTemp
DeleteDC hdcTemp
ReleaseDC 0&, hdcScreen
Case vbPicTypeIcon
'Create a bitmap and select it into an DC
'Draw Icon onto DC
DrawIconEx hdcDest, xDest, yDest, picSource.Handle, 0, 0, 0&, 0&, DI_NORMAL
Case Else
GoTo PaintNormalStdPic_InvalidParam
End Select
Exit Sub
PaintNormalStdPic_InvalidParam:
Err.Raise giINVALID_PICTURE
End Sub
Public Sub PaintTransparentDC(ByVal hdcDest As Long, _
ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal width As Long, _
ByVal Height As Long, _
ByVal hdcSrc As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal clrMask As OLE_COLOR, _
Optional ByVal hPal As Long = 0)
Dim hdcMask As Long 'HDC of the created mask image
Dim hdcColor As Long 'HDC of the created color image
Dim hbmMask As Long 'Bitmap handle to the mask image
Dim hbmColor As Long 'Bitmap handle to the color image
Dim hbmColorOld As Long
Dim hbmMaskOld As Long
Dim hPalOld As Long
Dim hdcScreen As Long
Dim hdcScnBuffer As Long 'Buffer to do all work on
Dim hbmScnBuffer As Long
Dim hbmScnBufferOld As Long
Dim hPalBufferOld As Long
Dim lMaskColor As Long
hdcScreen = GetDC(0&)
'Validate palette
If hPal = 0 Then
hPal = m_hpalHalftone
End If
OleTranslateColor clrMask, hPal, lMaskColor
'Create a color bitmap to server as a copy of the destination
'Do all work on this bitmap and then copy it back over the destination
'when it's done.
hbmScnBuffer = CreateCompatibleBitmap(hdcScreen, width, Height)
'Create DC for screen buffer
hdcScnBuffer = CreateCompatibleDC(hdcScreen)
hbmScnBufferOld = SelectObject(hdcScnBuffer, hbmScnBuffer)
hPalBufferOld = SelectPalette(hdcScnBuffer, hPal, True)
RealizePalette hdcScnBuffer
'Copy the destination to the screen buffer
BitBlt hdcScnBuffer, 0, 0, width, Height, hdcDest, xDest, yDest, vbSrcCopy
'Create a (color) bitmap for the cover (can't use CompatibleBitmap with
'hdcSrc, because this will create a DIB section if the original bitmap
'is a DIB section)
hbmColor = CreateCompatibleBitmap(hdcScreen, width, Height)
'Now create a monochrome bitmap for the mask
hbmMask = CreateBitmap(width, Height, 1, 1, ByVal 0&)
'First, blt the source bitmap onto the cover. We do this first
'and then use it instead of the source bitmap
'because the source bitmap may be
'a DIB section, which behaves differently than a bitmap.
'(Specifically, copying from a DIB section to a monochrome bitmap
'does a nearest-color selection rather than painting based on the
'backcolor and forecolor.
hdcColor = CreateCompatibleDC(hdcScreen)
hbmColorOld = SelectObject(hdcColor, hbmColor)
hPalOld = SelectPalette(hdcColor, hPal, True)
RealizePalette hdcColor
'In case hdcSrc contains a monochrome bitmap, we must set the destination
'foreground/background colors according to those currently set in hdcSrc
'(because Windows will associate these colors with the two monochrome colors)
SetBkColor hdcColor, GetBkColor(hdcSrc)
SetTextColor hdcColor, GetTextColor(hdcSrc)
BitBlt hdcColor, 0, 0, width, Height, hdcSrc, xSrc, ySrc, vbSrcCopy
'Paint the mask. What we want is white at the transparent color
'from the source, and black everywhere else.
hdcMask = CreateCompatibleDC(hdcScreen)
hbmMaskOld = SelectObject(hdcMask, hbmMask)
'When bitblt'ing from color to monochrome, Windows sets to 1
'all pixels that match the background color of the source DC. All
'other bits are set to 0.
SetBkColor hdcColor, lMaskColor
SetTextColor hdcColor, vbWhite
BitBlt hdcMask, 0, 0, width, Height, hdcColor, 0, 0, vbSrcCopy
'Paint the rest of the cover bitmap.
'
'What we want here is black at the transparent color, and
'the original colors everywhere else. To do this, we first
'paint the original onto the cover (which we already did), then we
'AND the inverse of the mask onto that using the DSna ternary raster
'operation (0x00220326 - see Win32 SDK reference, Appendix, "Raster
'Operation Codes", "Ternary Raster Operations", or search in MSDN
'for 00220326). DSna [reverse polish] means "(not SRC) and DEST".
'
'When bitblt'ing from monochrome to color, Windows transforms all white
'bits (1) to the background color of the destination hdc. All black (0)
'bits are transformed to the foreground color.
SetTextColor hdcColor, vbBlack
SetBkColor hdcColor, vbWhite
BitBlt hdcColor, 0, 0, width, Height, hdcMask, 0, 0, DSna
'Paint the Mask to the Screen buffer
BitBlt hdcScnBuffer, 0, 0, width, Height, hdcMask, 0, 0, vbSrcAnd
'Paint the Color to the Screen buffer
BitBlt hdcScnBuffer, 0, 0, width, Height, hdcColor, 0, 0, vbSrcPaint
'Copy the screen buffer to the screen
BitBlt hdcDest, xDest, yDest, width, Height, hdcScnBuffer, 0, 0, vbSrcCopy
'All done!
DeleteObject SelectObject(hdcColor, hbmColorOld)
SelectPalette hdcColor, hPalOld, True
RealizePalette hdcColor
DeleteDC hdcColor
DeleteObject SelectObject(hdcScnBuffer, hbmScnBufferOld)
SelectPalette hdcScnBuffer, hPalBufferOld, True
RealizePalette hdcScnBuffer
DeleteDC hdcScnBuffer
DeleteObject SelectObject(hdcMask, hbmMaskOld)
DeleteDC hdcMask
ReleaseDC 0&, hdcScreen
End Sub
Public Sub PaintTransparentStdPic(ByVal hdcDest As Long, _
ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal width As Long, _
ByVal Height As Long, _
ByVal picSource As Picture, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal clrMask As OLE_COLOR, _
Optional ByVal hPal As Long = 0)
Dim hdcSrc As Long 'HDC that the source bitmap is selected into
Dim hbmMemSrcOld As Long
Dim hbmMemSrc As Long
Dim udtRect As RECT
Dim hbrMask As Long
Dim lMaskColor As Long
Dim hdcScreen As Long
Dim hPalOld As Long
'Verify that the passed picture is a Bitmap
If picSource Is Nothing Then
GoTo PaintTransparentStdPic_InvalidParam
End If
Select Case picSource.Type
Case vbPicTypeBitmap
hdcScreen = GetDC(0&)
'Validate palette
If hPal = 0 Then
hPal = m_hpalHalftone
End If
'Select passed picture into an HDC
hdcSrc = CreateCompatibleDC(hdcScreen)
hbmMemSrcOld = SelectObject(hdcSrc, picSource.Handle)
hPalOld = SelectPalette(hdcSrc, hPal, True)
RealizePalette hdcSrc
'Draw the bitmap
PaintTransparentDC hdcDest, xDest, yDest, width, Height, hdcSrc, xSrc, ySrc, clrMask, hPal
SelectObject hdcSrc, hbmMemSrcOld
SelectPalette hdcSrc, hPalOld, True
RealizePalette hdcSrc
DeleteDC hdcSrc
ReleaseDC 0&, hdcScreen
Case vbPicTypeIcon
'Create a bitmap and select it into an DC
hdcScreen = GetDC(0&)
'Validate palette
If hPal = 0 Then
hPal = m_hpalHalftone
End If
hdcSrc = CreateCompatibleDC(hdcScreen)
hbmMemSrc = CreateCompatibleBitmap(hdcScreen, width, Height)
hbmMemSrcOld = SelectObject(hdcSrc, hbmMemSrc)
hPalOld = SelectPalette(hdcSrc, hPal, True)
RealizePalette hdcSrc
'Draw Icon onto DC
udtRect.Bottom = Height
udtRect.Right = width
OleTranslateColor clrMask, 0&, lMaskColor
hbrMask = CreateSolidBrush(lMaskColor)
FillRect hdcSrc, udtRect, hbrMask
DeleteObject hbrMask
DrawIconEx hdcSrc, 0, 0, picSource.Handle, 0, 0, 0, 0, DI_NORMAL
'Draw Transparent image
PaintTransparentDC hdcDest, xDest, yDest, width, Height, hdcSrc, 0, 0, lMaskColor, hPal
'Clean up
DeleteObject SelectObject(hdcSrc, hbmMemSrcOld)
SelectPalette hdcSrc, hPalOld, True
RealizePalette hdcSrc
DeleteDC hdcSrc
ReleaseDC 0&, hdcScreen
Case Else
GoTo PaintTransparentStdPic_InvalidParam
End Select
Exit Sub
PaintTransparentStdPic_InvalidParam:
'Err.Raise giINVALID_PICTURE
Exit Sub
End Sub
'--end block--'
Form frmMain.frm
For this example you will need:
- A TreeView control named tvBG
- An Image control named img
Set the Picture property of img to a bitmap that is
conducive to tiling. (Or any old bitmap, if you really want!)
Once the bitmap is in place, it's time to insert the code:
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type PAINTSTRUCT
hDC As Long
fErase As Long
rcPaint As RECT
fRestore As Long
fIncUpdate As Long
rgbReserved As Byte
End Type
Private Declare Function BeginPaint Lib "user32" _
(ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function EndPaint Lib "user32" _
(ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hDC As Long, ByVal nWidth As Long, _
ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Long, ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function InvalidateRect Lib "user32" _
(ByVal hWnd As Long, ByVal lpRect As Long, _
ByVal bErase As Long) As Long
Private Const WM_PAINT = &HF
Private Const WM_ERASEBKGND = &H14
Private Const WM_HSCROLL = &H114
Private Const WM_VSCROLL = &H115
Private Const WM_MOUSEWHEEL = &H20A
Private Sub Form_Load()
'Subclass the TreeView to trap messages
'that we'll need to respond to
Subclass Me, tvBG
Dim Root As Node
'Add some items
With tvBG.Nodes
Set Root = .Add(, , , "Top-level Node #1")
.Add Root.Index, tvwChild, , "Child Node #1"
.Add Root.Index, tvwChild, , "Child Node #2"
.Add Root.Index, tvwChild, , "Child Node #3"
Set Root = .Add(, , , "Top-level Node #2")
.Add Root.Index, tvwChild, , "Child Node #1"
.Add Root.Index, tvwChild, , "Child Node #2"
.Add Root.Index, tvwChild, , "Child Node #3"
Set Root = .Add(, , , "Top-level Node #3")
.Add Root.Index, tvwChild, , "Child Node #1"
.Add Root.Index, tvwChild, , "Child Node #2"
.Add Root.Index, tvwChild, , "Child Node #3"
Set Root = .Add(, , , "Top-level Node #4")
.Add Root.Index, tvwChild, , "Child Node #1"
.Add Root.Index, tvwChild, , "Child Node #2"
.Add Root.Index, tvwChild, , "Child Node #3"
End With
End Sub
Public Sub TreeViewMessage(ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long, RetVal As Long, _
UseRetVal As Boolean)
'Prevent recursion with this variable
Static InProc As Boolean
Dim ps As PAINTSTRUCT
Dim TVDC As Long, drawDC1 As Long, drawDC2 As Long
Dim oldBMP1 As Long, drawBMP1 As Long
Dim oldBMP2 As Long, drawBMP2 As Long
Dim x As Long, y As Long, w As Long, h As Long
Dim TVWidth As Long, TVHeight As Long
If wMsg = WM_PAINT Then
If InProc = True Then
Exit Sub
End If
InProc = True
'Prepare some variables we'll use
TVWidth = tvBG.width \ Screen.TwipsPerPixelX
TVHeight = tvBG.Height \ Screen.TwipsPerPixelY
w = ScaleX(img.Picture.width, vbHimetric, vbPixels)
h = ScaleY(img.Picture.Height, vbHimetric, vbPixels)
'Begin painting. This API must be called in
'response to the WM_PAINT message or you'll see
'some odd visual effects :-)
Call BeginPaint(hWnd, ps)
TVDC = ps.hDC
'Create a few canvases in memory to
'draw on
drawDC1 = CreateCompatibleDC(TVDC)
drawBMP1 = CreateCompatibleBitmap(TVDC, TVWidth, TVHeight)
oldBMP1 = SelectObject(drawDC1, drawBMP1)
drawDC2 = CreateCompatibleDC(TVDC)
drawBMP2 = CreateCompatibleBitmap(TVDC, TVWidth, TVHeight)
oldBMP2 = SelectObject(drawDC2, drawBMP2)
'This actually causes the TreeView to paint
'itself onto our memory DC!
SendMessage hWnd, WM_PAINT, drawDC1, ByVal 0&
'Tile the bitmap and draw the TreeView
'over it transparently
For y = 0 To TVHeight Step h
For x = 0 To TVWidth Step w
PaintNormalStdPic drawDC2, x, y, w, h, _
img.Picture, 0, 0
Next
Next
PaintTransparentDC drawDC2, 0, 0, TVWidth, TVHeight, _
drawDC1, 0, 0, TranslateColor(vbWindowBackground)
'Draw to the target DC
BitBlt TVDC, 0, 0, TVWidth, TVHeight, _
drawDC2, 0, 0, vbSrcCopy
'Cleanup
SelectObject drawDC1, oldBMP1
SelectObject drawDC2, oldBMP2
DeleteObject drawBMP1
DeleteObject drawBMP2
EndPaint hWnd, ps
RetVal = 0
UseRetVal = True
InProc = False
ElseIf wMsg = WM_ERASEBKGND Then
'Return TRUE
RetVal = 1
UseRetVal = True
ElseIf wMsg = WM_HSCROLL Or wMsg = WM_VSCROLL Or wMsg = WM_MOUSEWHEEL Then
'Force a repaint to keep the bitmap
'tiles lined up
InvalidateRect hWnd, 0, 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Kill subclassing routine for exit
UnSubclass tvBG
End Sub
'--end block--'
);
Parameters
clr
[in] The OLE color to be converted into a COLORREF.
hpal
[in] Palette used as a basis for the conversion.
pcolorref
[out] Pointer to the caller's variable that receives the converted COLORREF result. This can be NULL, indicating that the caller wants only to verify that a converted color exists.
Return Values
This function supports the standard return values E_INVALIDARG and E_UNEXPECTED, as well as the following:
S_OK
The color was translated successfully.
Remarks
The following table describes the color conversion:
OLE_COLOR hPal Resulting COLORREF
invalid
Undefined (E_INVALIDARG)
0x800000xx, xx is not a valid Win32 GetSysColor index
Undefined (E_INVALIDARG)
invalid
Undefined (E_INVALIDARG)
0x0100iiii, iiii is not a valid palette index
valid palette
Undefined (E_INVALIDARG)
0x800000xx, xx is a valid GetSysColor index
NULL
0x00bbggrr
0x0100iiii, iiii is a valid palette index
NULL
0x0100iiii
0x02bbggrr (palette relative)
NULL
0x02bbggrr
0x00bbggrr
NULL
0x00bbggrr
0x800000xx, xx is a valid GetSysColor index
valid palette
0x00bbggrr
0x0100iiii, iiii is a valid palette index in hPal
valid palette
0x0100iiii
0x02bbggrr (palette relative)
valid palette
0x02bbggrr
0x00bbggrr
valid palette
0x02bbggrr
Requirements
For an explanation of the requirement values, see Requirements (COM).
Windows NT/2000/XP: Requires Windows NT 4.0 or later.
Windows 95/98: Requires Windows 95 or later.
Header: Declared in olectl.h.
Library: Included as a resource in olepro32.dll.
VB聲明:
private declare function oletranslatecolor lib "oleaut32.dll" _
(byval lolecolor as long, byval lhpalette as long, _
lcolorref as long) as long
