三九宝宝网宝宝成长宝宝手工

VB6 0制作放大镜

02月24日 编辑 39baobao.com

[vb6 0软件这样制作电脑机器码查看器]Private Declare Function icePub_machineGetInfo Lib "icePubDll.dll" (ByVal typeFlag As Integer, ByVal strInfo As String) As Integer Dim a2 As Integer Dim str1 As S...+阅读

Option Explicit

Private Type POINTAPI

x As Long

y As Long

End Type

Const Srccopy = &HCC0020

Private Declare Function GetCursorPos Lib "User32" (lpPOINT As POINTAPI) As Long

Private Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long

Dim pos As POINTAPI

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

'上述函数改动

Private Sub Form_Load()

Dim usew&, useh&

usew& = Me.Width / Screen.TwipsPerPixelX

useh& = Me.Height / Screen.TwipsPerPixelY

End Sub

Private Sub Start()

Dim sx As Long

Dim sy As Long

GetCursorPos pos

Dim x, y

sx = IIf(pos.x < 50 Or pos.x > 925, IIf(pos.x < 50, 0, 925), pos.x - 50)

sy = IIf(pos.y < 50 Or pos.y > 680, IIf(pos.y < 50, 0, 680), pos.y - 50)

Caption = " 坐标" & sx & "," & sy & " 放大镜”"

StretchBlt hdc, 0, 0, 200, 200, GetDC(0), sx, sy, 100, 100, Srccopy '改动

End Sub

Private Sub Timer1_Timer()

Start

End Sub

Private Sub Form_DblClick()

Unload Me

End Sub

我用VB做了个放大镜但测试时提示:实时错误453:找不到DLL入

找不到入口点有以下几种情况:

1、没有注意大小写。

在Win32中,DLL的函数和VB的函数中必须大小写相同。

2、没有声明入口函数。

你需要在DLL的*.def文件中 加上入口函数,如:

EXPORTS

SetData 1

GetData 2

这样VB程序就可以访问SetData和GetData函数了。其中1、2是这两个函数的引用序号,通常在VB中不使用。(参考QA003500 "做一个DLL时,不用def文件不行吗"。)

3、采用C++编译方式。

在C++中编译函数时会将函数名进行转换,如将DLL中的kk(double k)转换为_kk8。解决的办法有两种:

(1)如果没有使用C++的类,可以将.cpp文件改名为.c,就不进行这种转换了。

(2)在函数定义前加上extern "c" ,如:

extern "c" void _stdcall kk(double k)

一个vb放大镜出错

Option Explicit Private Declare Function GetCursorPos Lib "user32" Alias "getcursorpos" (ipoint As pointapi) As Long Private Declare Function stretchblt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nwidth As Long, ByVal hsrcdc As Long, ByVal xsrc As Long, ByVal ysrc As Long, ByVal nsrcwidth As Long, ByVal nsrcheight As Long, ByVal dwrop As Long, ByVal dwrop As Long) As Long Private Declare Function getdc Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function strechblt Lib "gdi32" (ByVal hdc As Long, _ ByVal x As Long, ByVal y As Long, ByVal nwidth As Long, _ ByVal nheight As Long, ByVal nwidth As Long, _ ByVal ysrc As Long, ByVal nsrcwidth As Long, ByVal nsrcheight As Long, _ ByVal dwrop As Long) As Long Private Declare Function sendmessage Lib "user32" Alias "sendmessageA" _(ByVal hWnd As Long, ByVal wmsg As Long, _ ByVal wparam As Long, lparam As Any) As Long Private Declare Function releasecapture Lib "user32" () As Long Private Type pointapi x As Long y As Long End Type Const srccopy = &HCC0020 Const swp_nomove = &H2 Const swp_nosize = &H1 Const flags = swp_nomove Or swp_nosize Const hwnd_topmost = -1 Dim pos As pointapi Dim screenw_lng As Long Dim screenh_lng As Long Private Sub form_load() Dim hrgn_lng As Long Dim formw_lng As Long Dim formh_lng As Long screenw_lng = Screen.Width / Screen.TwipsPerPixelX screenh_lng = Screen.Height / Screen.TwipsPerPixelY SetWindowPos hWnd, hwnd_topmost, 0, 0, 0, 0, flags formw_lng = Me.Width / Screen.TwipsPerPixelX formh_lng = Me.Height / Screen.TwipsPerPixelY hrgn_lng = CreateEllipticRgn(0, 0, formw_lng, formh_lng) SetWindowRgn Me.hWnd, hrgn_lng, True End Sub Private Sub getmouseimg() Dim sx As Integer Dim sy As Integer GetCursorPos pos sx = IIf(pos.xscreenw_lng - 50, IIf(pos.xscreenh_lng - 50, IIf(pos.y

推荐阅读
图文推荐