|
-
Apr 30th, 2010, 09:00 AM
#1
Thread Starter
Addicted Member
help convert from VB6 to VB.NET
Code:
Option Explicit
Const AC_SRC_OVER = &H0
Const SW_MINIMIZE = 6
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
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 Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight 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 GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT 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 DeleteDC Lib "gdi32" (ByVal hdc 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 GetForegroundWindow Lib "user32" () As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Dim STDHdc As Long, STDSpec As Long, PicPos As POINTAPI
Dim BufBit As Long, BufHdc As Long
Dim bf As BLENDFUNCTION
Private Sub Command1_Click()
blur 3
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Me.Caption = "Shut Me down"
Me.WindowState = 0
Me.Show
BufHdc = CreateCompatibleDC(0)
BufBit = CreateCompatibleBitmap(GetDC(0), 401, 401)
SelectObject BufHdc, BufBit
STDHdc = CreateCompatibleDC(0)
STDSpec = CreateCompatibleBitmap(GetDC(0), 401, 401)
SelectObject STDHdc, STDSpec
Timer1.Interval = 2000
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteDC STDHdc
DeleteDC BufHdc
DeleteObject BufBit
DeleteObject STDSpec
End
End Sub
Private Sub blur(intensity As Integer)
Dim x As Long, y As Long, SPREAD As Single, LBF As Long
SPREAD = 128
With bf
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = SPREAD
.AlphaFormat = 0
End With
RtlMoveMemory LBF, bf, 4
PicPos.x = 100
PicPos.y = 100
BitBlt STDHdc, 0, 0, 401, 401, _
GetDC(0), PicPos.x - 200, PicPos.y - 200, vbSrcCopy
BitBlt BufHdc, 0, 0, 401, 401, STDHdc, 0, 0, vbSrcCopy
If intensity > 0 Then
For x = 0 To intensity - 1
AlphaBlend BufHdc, 0, 0, 400, 401, _
STDHdc, 1, 0, 400, 401, LBF
BitBlt STDHdc, 0, 0, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
AlphaBlend BufHdc, 1, 0, 400, 401, _
STDHdc, 0, 0, 400, 401, LBF
BitBlt STDHdc, 0, 0, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
AlphaBlend BufHdc, 0, 0, 401, 400, _
STDHdc, 0, 1, 401, 400, LBF
BitBlt STDHdc, 0, 0, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
AlphaBlend BufHdc, 0, 1, 401, 400, _
STDHdc, 0, 0, 401, 400, LBF
BitBlt STDHdc, 0, 0, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
AlphaBlend BufHdc, 0, 0, 400, 400, _
STDHdc, 1, 1, 400, 400, LBF
BitBlt STDHdc, 0, 0, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
AlphaBlend BufHdc, 1, 1, 400, 400, _
STDHdc, 0, 0, 400, 400, LBF
BitBlt STDHdc, 0, 0, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
AlphaBlend BufHdc, 0, 1, 400, 400, _
STDHdc, 1, 0, 400, 400, LBF
BitBlt STDHdc, 0, 0, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
AlphaBlend BufHdc, 1, 0, 400, 400, _
STDHdc, 0, 1, 400, 400, LBF
BitBlt STDHdc, 0, 0, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
Next
End If
BitBlt GetDC(0), PicPos.x - 200, PicPos.y - 200, 401, 401, _
BufHdc, 0, 0, vbSrcCopy
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
End Sub
-
Apr 30th, 2010, 10:00 AM
#2
Re: help convert from VB6 to VB.NET
vb.net Code:
Imports System.Runtime.InteropServices Public Class Form1 Friend WithEvents Command1 As Button Friend WithEvents timer1 As Timer Private Const AC_SRC_OVER As Integer = &H0 Private Const SW_MINIMIZE As Integer = 6 Public Sub New() ' This call is required by the designer. InitializeComponent() ' Add any initialization after the InitializeComponent() call. Me.SuspendLayout() Command1 = New Button timer1 = New Timer With Command1 .Text = "Click" .Width = 250 .Height = 20 .Left = 10 .Top = 10 .Visible = True End With With timer1 .Enabled = False End With Me.Controls.Add(Command1) Me.components.Add(timer1) Me.ResumeLayout() End Sub <StructLayout(LayoutKind.Sequential)> _ Private Structure BLENDFUNCTION Dim BlendOp As Byte Dim BlendFlags As Byte Dim SourceConstantAlpha As Byte Dim AlphaFormat As Byte End Structure <StructLayout(LayoutKind.Sequential)> _ Private Structure BITMAP Dim bmType As Integer Dim bmWidth As Integer Dim bmHeight As Integer Dim bmWidthBytes As Integer Dim bmPlanes As Short Dim bmBitsPixel As Short Dim bmBits As Integer End Structure <StructLayout(LayoutKind.Sequential)> _ Private Structure POINTAPI Dim x As Integer Dim y As Integer End Structure <DllImport("gdi32", CharSet:=CharSet.Auto, setlasterror:=True)> _ Private Shared Function CreateCompatibleBitmap(ByVal hdc As IntPtr, ByVal nWidth As Integer, ByVal nHeight As Integer) As IntPtr End Function <DllImport("gdi32", CharSet:=CharSet.Auto, setlasterror:=True)> _ Private Shared Function CreateCompatibleDC(ByVal hdc As IntPtr) As IntPtr End Function <DllImport("gdi32", CharSet:=CharSet.Auto, setlasterror:=True)> _ Private Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hObject As IntPtr) As Integer End Function <DllImport("gdi32", CharSet:=CharSet.Auto, setlasterror:=True)> _ Private Shared Function GetObject(ByVal hObject As IntPtr, ByVal nCount As Integer, ByVal lpObject As IntPtr) As Integer End Function <DllImport("kernel32.dll", EntryPoint:="RtlMoveMemory", SetLastError:=True, CharSet:=CharSet.Auto)> _ Private Shared Sub RtlMoveMemory(<[In](), MarshalAs(UnmanagedType.I4)> ByVal hpvDest As Int32, <[In](), Out()> ByVal hpvSource() As Byte, ByVal cbCopy As Integer) End Sub <DllImport("gdi32.dll", EntryPoint:="GdiAlphaBlend", setlasterror:=True)> _ Private Shared Function AlphaBlend(ByVal hdcDest As IntPtr, ByVal nXOriginDest As Integer, _ ByVal nYOriginDest As Integer, _ ByVal nWidthDest As Integer, _ ByVal nHeightDest As Integer, _ ByVal hdcSrc As IntPtr, _ ByVal nXOriginSrc As Integer, _ ByVal nYOriginSrc As Integer, _ ByVal nWidthSrc As Integer, _ ByVal nHeightSrc As Integer, _ ByVal blendfunction As BLENDFUNCTION) As Boolean End Function Private Enum TernaryRasterOperations As UInteger ''' <summary>dest = source</summary> SRCCOPY = &HCC0020 ''' <summary>dest = source OR dest</summary> SRCPAINT = &HEE0086 ''' <summary>dest = source AND dest</summary> SRCAND = &H8800C6 ''' <summary>dest = source XOR dest</summary> SRCINVERT = &H660046 ''' <summary>dest = source AND (NOT dest)</summary> SRCERASE = &H440328 ''' <summary>dest = (NOT source)</summary> NOTSRCCOPY = &H330008 ''' <summary>dest = (NOT src) AND (NOT dest)</summary> NOTSRCERASE = &H1100A6 ''' <summary>dest = (source AND pattern)</summary> MERGECOPY = &HC000CA ''' <summary>dest = (NOT source) OR dest</summary> MERGEPAINT = &HBB0226 ''' <summary>dest = pattern</summary> PATCOPY = &HF00021 ''' <summary>dest = DPSnoo</summary> PATPAINT = &HFB0A09 ''' <summary>dest = pattern XOR dest</summary> PATINVERT = &H5A0049 ''' <summary>dest = (NOT dest)</summary> DSTINVERT = &H550009 ''' <summary>dest = BLACK</summary> BLACKNESS = &H42 ''' <summary>dest = WHITE</summary> WHITENESS = &HFF0062 End Enum <DllImport("gdi32.dll", setlasterror:=True)> _ Private Shared Function BitBlt(ByVal hdc As IntPtr, _ ByVal nXDest As Integer, _ ByVal nYDest As Integer, _ ByVal nWidth As Integer, _ ByVal nHeight As Integer, _ ByVal hdcSrc As IntPtr, _ ByVal nXSrc As Integer, _ ByVal nYSrc As Integer, _ ByVal dwRop As TernaryRasterOperations) As Boolean End Function <DllImport("gdi32.dll", setlasterror:=True)> _ Private Shared Function DeleteDC(ByVal hdc As IntPtr) As Integer End Function <DllImport("gdi32.dll", setlasterror:=True)> _ Private Shared Function DeleteObject(ByVal hObject As IntPtr) As Integer End Function <DllImport("user32.dll", setlasterror:=True)> _ Private Shared Function GetDC(ByVal hwnd As IntPtr) As IntPtr End Function <DllImport("user32.dll", setlasterror:=True)> _ Private Shared Function GetForegroundWindow() As IntPtr End Function <DllImport("user32.dll", setlasterror:=True)> _ Private Shared Function ShowWindow(ByVal hwnd As IntPtr, ByVal nCmdShow As Integer) As Integer End Function Dim STDHdc As IntPtr, STDSpec As IntPtr, PicPos As POINTAPI Dim BufBit As IntPtr, BufHdc As IntPtr Dim bf As New BLENDFUNCTION Private Sub Command1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Command1.Click blur(3) End Sub Private Sub Form_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load timer1.Enabled = False Me.Text = "Shut Me down" Me.WindowState = FormWindowState.Normal Me.Show() BufHdc = CreateCompatibleDC(IntPtr.Zero) BufBit = CreateCompatibleBitmap(GetDC(IntPtr.Zero), 401, 401) SelectObject(BufHdc, BufBit) STDHdc = CreateCompatibleDC(IntPtr.Zero) STDSpec = CreateCompatibleBitmap(GetDC(IntPtr.Zero), 401, 401) SelectObject(STDHdc, STDSpec) timer1.Interval = 2000 timer1.Enabled = True End Sub Private Sub Form_Unload(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing DeleteDC(STDHdc) DeleteDC(BufHdc) DeleteObject(BufBit) DeleteObject(STDSpec) End Sub Private Sub blur(ByVal intensity As Short) Dim SPREAD As Byte SPREAD = 128 With bf .BlendOp = AC_SRC_OVER .BlendFlags = 0 .SourceConstantAlpha = SPREAD .AlphaFormat = 0 End With 'RtlMoveMemory(LBF, bf, 4) Not necessary due to the modified declaration PicPos.x = 100 PicPos.y = 100 BitBlt(STDHdc, 0, 0, 401, 401, _ GetDC(IntPtr.Zero), PicPos.x - 200, PicPos.y - 200, TernaryRasterOperations.SRCCOPY) BitBlt(BufHdc, 0, 0, 401, 401, STDHdc, 0, 0, TernaryRasterOperations.SRCCOPY) If intensity > 0 Then For x = 0 To intensity - 1 AlphaBlend(BufHdc, 0, 0, 400, 401, _ STDHdc, 1, 0, 400, 401, bf) BitBlt(STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) AlphaBlend(BufHdc, 1, 0, 400, 401, _ STDHdc, 0, 0, 400, 401, bf) BitBlt(STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) AlphaBlend(BufHdc, 0, 0, 401, 400, _ STDHdc, 0, 1, 401, 400, bf) BitBlt(STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) AlphaBlend(BufHdc, 0, 1, 401, 400, _ STDHdc, 0, 0, 401, 400, bf) BitBlt(STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) AlphaBlend(BufHdc, 0, 0, 400, 400, _ STDHdc, 1, 1, 400, 400, bf) BitBlt(STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) AlphaBlend(BufHdc, 1, 1, 400, 400, _ STDHdc, 0, 0, 400, 400, bf) BitBlt(STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) AlphaBlend(BufHdc, 0, 1, 400, 400, _ STDHdc, 1, 0, 400, 400, bf) BitBlt(STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) AlphaBlend(BufHdc, 1, 0, 400, 400, _ STDHdc, 0, 1, 400, 400, bf) BitBlt(STDHdc, 0, 0, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) Next End If BitBlt(GetDC(IntPtr.Zero), PicPos.x - 200, PicPos.y - 200, 401, 401, _ BufHdc, 0, 0, TernaryRasterOperations.SRCCOPY) End Sub Private Sub Timer1_Timer() Handles timer1.Tick timer1.Enabled = False End Sub End Class
-
Apr 30th, 2010, 10:12 AM
#3
Thread Starter
Addicted Member
Re: help convert from VB6 to VB.NET
thx but it doesnt blur :O
-
Apr 30th, 2010, 10:18 AM
#4
Re: help convert from VB6 to VB.NET
Sorry, but I didn't write this code I merely converted it to VB.Net
-
Apr 30th, 2010, 10:22 AM
#5
Thread Starter
Addicted Member
Re: help convert from VB6 to VB.NET
-
Apr 30th, 2010, 11:09 AM
#6
Re: help convert from VB6 to VB.NET
What is it supposed to do?
-
Apr 30th, 2010, 01:42 PM
#7
Re: help convert from VB6 to VB.NET
Supposedly it should apply a blur filter to an image but I seriously doubt this code is working.
Because there is nowhere a real source device context is selected. Everywhere IntPtr.Zero is given as an argument.
-
May 2nd, 2010, 11:26 AM
#8
Thread Starter
Addicted Member
Re: help convert from VB6 to VB.NET
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|