请问如何实现LOGO的渐变?

joeky 2004-05-04 04:18:47
大部分游戏中制作公司的LOGO都是由暗变亮,再由亮变暗,请问在VB中怎么样实现呢?谢谢~~~~~~~~~~
...全文
110 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
ljf88888 2004-05-05
  • 打赏
  • 举报
回复
厉害了。。。
yenight 2004-05-04
  • 打赏
  • 举报
回复
用API函数吧!
两张图片,一张OK的,一张全黑的,黑色的放在上面,然后用API函数改变黑色那张图片的透明度搞定!
我就搞不定!
华芸智森 2004-05-04
  • 打赏
  • 举报
回复
做一个AVI动画。
haipingma 2004-05-04
  • 打赏
  • 举报
回复
flash圖片
joeky 2004-05-04
  • 打赏
  • 举报
回复
大哥,这个办法我早就想过了,就是觉得太傻了才来求教更方便的方法 ^_^
BlueBeer 2004-05-04
  • 打赏
  • 举报
回复
笨办法:)

用PS做多张明暗不同的LOGO图片
程序在显示LOGO时用定时器按顺序不断的变换LOGO图片
BitBlt 2004-05-04
  • 打赏
  • 举报
回复
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

wumy_ld 2004-05-04
  • 打赏
  • 举报
回复
这是一个绘制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 Sub

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧