请问如何实现LOGO的渐变？
大部分游戏中制作公司的LOGO都是由暗变亮，再由亮变暗，请问在VB中怎么样实现呢？谢谢~~~~~~~~~~ 问题点数：0、回复次数：8Top
1 楼BlueBeer（1win）回复于 2004-05-04 04:34:42 得分 0
笨办法：）
用PS做多张明暗不同的LOGO图片
程序在显示LOGO时用定时器按顺序不断的变换LOGO图片Top
2 楼joeky（）回复于 2004-05-04 04:59:57 得分 0
大哥，这个办法我早就想过了，就是觉得太傻了才来求教更方便的方法 ^_^Top
3 楼haipingma（今天你过得快乐吗?）回复于 2004-05-04 09:05:57 得分 0
flash圖片Top
4 楼MSTOP（陈建华）回复于 2004-05-04 11:49:54 得分 0
做一个AVI动画。Top
5 楼yenight（抵制日货 利国利民 能不买日货,尽量不买）回复于 2004-05-04 12:39:34 得分 0
用API函数吧!
两张图片,一张OK的,一张全黑的,黑色的放在上面,然后用API函数改变黑色那张图片的透明度搞定!
我就搞不定!Top
6 楼kissoflife（明月高楼休独倚，酒入愁肠，化作相思泪！）回复于 2004-05-04 13:10:17 得分 0
这是一个绘制logo的函数：
Friend Sub DrawLogo(hwnd As Long)
Dim aDC As Long ' Device context of the MDIClient area
Dim rcClient As RECT ' RECT structure with dimension of MDIClient area
Dim aPic As StdPicture ' Logo picture for center of MDIClient area
Dim aMask As StdPicture ' Mask image so we can draw the logo transparent
Dim picDC As Long ' temporary DC to hold the picture image in
Dim maskDC As Long ' temporary DC to hold the mask image in
Dim oldBmp1 As Long ' original 1x1 bitmap for the temporary picDC
Dim oldBmp2 As Long ' original 1x1 bitmap for the temporary maskDC
Dim backDC As Long ' back buffer device context.
Dim backBmp As Long ' back buffer bitmap
Dim aBmp As BITMAP ' bitmap used to get the picture's dimensions
Dim abrush As Long ' Brush used to paint the background of the MDIClient area
Dim x As Long ' X location for drawing our logo picture
Dim Y As Long ' Y location for drawing our logo picture
' Get the MDIClient area's device context
aDC = GetDC(hwnd)
' Get the MDIClient dimensions
GetWindowRect hwnd, rcClient
' shift the origin to 0,0
rcClient.right = rcClient.right - rcClient.left
rcClient.bottom = rcClient.bottom - rcClient.top
rcClient.top = 0
rcClient.left = 0
' Create a backbuffer so we can draw in memory first, then transfer the
' background to the MDIClient area all at once.
backDC = CreateCompatibleDC(aDC)
backBmp = CreateCompatibleBitmap(aDC, rcClient.right, rcClient.bottom)
DeleteObject SelectObject(backDC, backBmp)
'Paint window background
If chkBGTexture.Value = 0 Then
' Use the system setting for application workspace
abrush = CreateSolidBrush(GetSysColor(12))
Else
' Create a pattern brush using the background texture
abrush = CreatePatternBrush(imgBG.Picture.Handle)
End If
' Fill the backbuffer with the selected brush
FillRect backDC, rcClient, abrush
' Clean up our brush object
DeleteObject abrush
' Do logo, if that has been selected.
If chkLogo.Value = 1 Then
Set aPic = imgLogo.Picture
Set aMask = imgLogoMask.Picture
' Get logo's dimensions - overkill? Probably, but I HATE screwing around
' with himetric units. They make me want to kick something really really
' hard. And you wouldn't want me to break my toe, would you? :-p
GetObject aPic.Handle, Len(aBmp), aBmp
' Create some compatible device contexts to hold our logo pics in
picDC = CreateCompatibleDC(aDC)
maskDC = CreateCompatibleDC(aDC)
' Select our pictures into the temporary DCs, and keep a reference to
' the original 1x1 bitmaps so we can replace them later, freeing our logo images.
oldBmp1 = SelectObject(picDC, aPic.Handle)
oldBmp2 = SelectObject(maskDC, aMask.Handle)
' Calculate the x and y location for our logo
x = (rcClient.right - aBmp.bmWidth) \ 2
Y = (rcClient.bottom - aBmp.bmHeight) \ 2
' punch the hole for our logo
BitBlt backDC, x, Y, aBmp.bmWidth, aBmp.bmHeight, maskDC, 0, 0, vbMergePaint
' draw the logo
BitBlt backDC, x, Y, aBmp.bmWidth, aBmp.bmHeight, picDC, 0, 0, vbSrcAnd
' Replace the original 1x1 bitmaps (which frees our logo pictures)
SelectObject picDC, oldBmp1
SelectObject maskDC, oldBmp2
' Clean up the graphics objects
DeleteDC picDC
DeleteObject oldBmp1
DeleteDC maskDC
DeleteObject oldBmp2
End If
' blt from backbuffer into client rectangle - Transfers the entire thing at once.
BitBlt aDC, 0, 0, rcClient.right, rcClient.bottom, backDC, 0, 0, vbSrcCopy
' Clean up our backbuffer objects
DeleteDC backDC
DeleteObject backBmp
' Release our hold on the device context
ReleaseDC hwnd, aDC
End SubTop
7 楼BitBlt（Raster Operater）回复于 2004-05-04 14:02:45 得分 0
P1中放一幅图，并设为隐藏。
Option Explicit
Private Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
Dim lTime As Integer, Flag As Integer
Sub ShowTransparency(cSrc As PictureBox, cDest As PictureBox, ByVal nLevel As Byte)
cDest.Cls
With cSrc
AlphaBlend cDest.hDC, 0, 0, .ScaleWidth, .ScaleHeight, .hDC, 0, 0, .ScaleWidth, .ScaleHeight, nLevel * &H10000
End With
cDest.Refresh
End Sub
Private Sub Command1_Click()
Flag = 1
If lTime < 255 Then Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
Flag = -1
If lTime > 0 Then Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
lTime = lTime + Flag * 5
If lTime > 255 Or lTime < 0 Then
Timer1.Enabled = False
Exit Sub
End If
ShowTransparency P1, P2, lTime
End Sub
Top
8 楼ljf88888（feng）回复于 2004-05-05 12:04:30 得分 0
厉害了。。。Top
