分享
 
 
 

雨滴式的显示图片 (cloud 转贴)

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

雨滴式的显示图片

本范例是以一个stdPicture物件来存图形,之後於PictureBox中以特殊效果来显示。

因为我们想显示的只有一个图,所以不想多用另一个PictureBox来存原始图,而後

再画到另一个PictureBox上,那只有用StdPicture 物件来取代PictureBox(存来源图)

,但是BitBlt这个绘图函式需来源与目的的hDc,而StdPicture物件没有hDc,它只有

一个Handle值,以本例来说,这Handle值便是图形的hBitmap值。所以我们只好使用

MemoryDC的方式来做,产生一个MemoryDc後将BitMap图放於其上,之後便可以使用BitBlt来绘图了。'需求一个PictureBox( Named picture2),一个Command按键)

Option Explicit

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 CreateCompatibleDC Lib "gdi32" _

(ByVal hdc As Long) As Long

Private Declare Function SelectObject Lib "gdi32" _

(ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Const SRCCOPY = &HCC0020

Private Picture1 As New StdPicture

Private Sub Command1_Click()

Dim i As Long

Dim j As Long

Dim height5 As Long, width5 As Long

Dim hMemDc As Long

'stdPicture物件的度量单位是Himetric所以要转换成Pixel

height5 = ScaleY(Picture1.Height, vbHimetric, vbPixels)

If height5 > Picture2.ScaleHeight Then

height5 = Picture2.ScaleHeight

End If

width5 = ScaleX(Picture1.Width, vbHimetric, vbPixels)

If width5 > Picture2.ScaleWidth Then

width5 = Picture2.ScaleWidth

End If

'Create Memory DC

hMemDc = CreateCompatibleDC(Picture2.hdc)

'将Picture1的BitMap图指定给hMemDc

Call SelectObject(hMemDc, Picture1.Handle)

For i = height5 To 1 Step -1

Call BitBlt(Picture2.hdc, 0, i, width5, 1, _

hMemDc, 0, i, SRCCOPY)

For j = i - 1 To 1 Step -1

Call BitBlt(Picture2.hdc, 0, j, width5, 1, _

hMemDc, 0, i, SRCCOPY)

Next j

Next

Call DeleteDC(hMemDc)

End Sub

Private Sub Form_Load()

Dim i As Long

Picture2.ScaleMode = 3 '设定成Pixel的度量单位

'设定待Display的图

Set Picture1 = LoadPicture("c:\windows\素还真.bmp")

' ^^^^^^^^^^^^^^^^^^^^^^

' Load the picture we want to show

End Sub

返回

Shrinking Icons Down to Size

Abstract

You can use the Windows application programming interface (API)

BitBlt function to modify the size of an icon. This article explains

how to enlarge or shrink an icon.

Modifying an Icon's Size

You can use the Windows application programming interface (API)

BitBlt function to create an icon that is smaller or larger than the

original icon. The BitBlt function copies a memory device context to

another memory device context. (A memory device context is a block of

memory that represents a display surface, such as an Image or Picture

Box control. See Tip 31: "Creating the Windows Wallpaper Effect for a

complete explanation of the BitBlt function.)

In the example program below, we first load an icon into an Image

control. Then we modify the Image control's Height and Width

properties so the icon becomes 75 percent smaller than its original

size. The BitBlt function is then used to copy the icon stored in the

Image control to the Picture Box control.

Example Program

1. Create a new project in Visual Basic. Form1 is created by default.

2. Add the following Constant and Declare statements to the General

Declarations section of Form1 (note that the Declare statement

must be typed as a single line of code):

Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer,

ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer,

ByVal nHeight As Integer, ByVal hSrcDC As Integer,

ByVal XSrc As Integer, ByVal YSrc As Integer,

ByVal dwRop As Long) As Integer

Const SRCCOPY = &HCC0020

3. Add a Command Button control to Form1. Command1 is created by

default. Set its Caption property to "Shrink Icon".

4. Add the following code to the Click event for Command1:

Private Sub Command1_Click()

Dim X As Integer

Dim Y As Integer

Dim W As Integer

Dim H As Integer

Dim Ret As Integer

Image1 = LoadPicture("c:\vb\icons\misc\binoculr.ico")

Image1.Width = 0.75 * Image1.Width

Image1.Height = 0.75 * Image1.Height

Picture1.Width = Image1.Width

Picture1.Height = Image1.Height

X = Image1.Left / Screen.TwipsPerPixelX

Y = Image1.Top / Screen.TwipsPerPixelY

W = Picture1.Width / Screen.TwipsPerPixelX

H = Picture1.Height / Screen.TwipsPerPixelY

Ret = BitBlt(Picture1.hDC, 0, 0, W, H, Form1.hDC, X, Y, SRCCOPY)

Picture1.Refresh

End Sub

5. Add an Image control to Form1. Image1 is created by default. Set

its Stretch property to True.

6. Add a Picture Box control to Form1. Picture1 is created by

default. Set its AutoRedraw property to True.

返回

获得位图文件的信息

在Form中添加一个Picture控件和一个CommandButton控件,在Picture控件中加入一个位图文件,将下面代码加入其中:

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _

(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) _

As Long

Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, _

ByVal dwCount As Long, lpBits As Any) As Long

Private Type BITMAP

bmType As Long

bmWidth As Long

bmHeight As Long

bmWidthBytes As Long

bmPlanes As Integer

bmBitsPixel As Integer

bmBits As Long

End Type

Private Sub Command1_Click()

Dim hBitmap As Long

Dim res As Long

Dim bmp As BITMAP

Dim byteAry() As Byte

Dim totbyte As Long, i As Long

hBitmap = Picture1.Picture.Handle

res = GetObject(hBitmap, Len(bmp), bmp) '取得BITMAP的结构

totbyte = bmp.bmWidthBytes * bmp.bmHeight '总共要多少BYTE来存图

ReDim byteAry(totbyte - 1)

'将Picture1中的图信息存到ByteAry

res = GetBitmapBits(hBitmap, totbyte, byteAry(0))

Debug.Print "Total Bytes Copied :"; res

Debug.Print "bmp.bmBits "; bmp.bmBits

Debug.Print "bmp.bmBitsPixel "; bmp.bmBitsPixel '每相素位数

Debug.Print "bmp.bmHeight "; bmp.bmHeight '以相素计算图象高度

Debug.Print "bmp.bmPlanes "; bmp.bmPlanes

Debug.Print "bmp.bmType "; bmp.bmType

Debug.Print "bmp.bmWidth "; bmp.bmWidth '以相素计算图形宽度

Debug.Print "bmp.bmWidthBytes "; bmp.bmWidthBytes '以字节计算的每扫描线长度

End Sub

返回

放置“透明”的图片

在 VB 中,如果你试着把一只有鸟的图片放到背景的一棵树上,你就会发现树会被鸟遮住一个矩形的区域(即鸟的图片矩形)。我们可以通过以下方法使图片上非鸟的其它部分变透明:

我们可以利用一个 WinAPI 函数 BitBlt 对图形进行一系列的位操作来达到此目的。

函数声明:

Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (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

参数解释:

目标环境:hDestDC——目标设备环境;x——左上角;y——顶端;nWidth——宽;nHeight——高

源环境:hSrcDC——源设备环境;xSrc——源左上角;ySrc——源顶端;

dwRop——位处理操作,如 vbSrcAnd;vbSrcAnd;vbSrcCopy;vbSrcErase;vbSrcInvert 等

(目标环境或源环境只能是 Picture, Form 或 Printer 对象。各单位为象素。)

进行处理之前,我们需要对鸟的图片进行处理:先复制一份相同的图形,将其应该透明之处(鸟的背景)设置为黑色(设此图为sPic),再将另一图做以下处理:要复制的地方(鸟)设置为黑色,其余地方设置(鸟的背景)为白色(设此图为Mask)。

设树的图形为名dPic。

最后,请加入以下代码:

R=BitBlt(dPic.hdc,0,0,sPic.Width,sPic.Height,Mask.hdc,0,0,vbScrCopy)

R=BitBlt(dPic.hdc,0,0,sPic.Width,sPic.Height,sPic.hdc,0,0,vbScrInvert)

后记:

1、VB 中的 PaintPicture 方法提供类似功能,但速度不及此方法;

2、在此方法上稍微加入一些代码,就不难实现动画的显示。

3、VB 例子中的 CallDlls 就使用此方法。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有