作用:

给控件加上背景图片

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