注册 登录
编程论坛 VB6论坛

如何用vb语言 实现制作一个桌面小程序(小盒子,无窗口,类似于QQ宠物)呢?

mywind123 发布于 2014-12-10 20:14, 2770 次点击
如题,初学者求大概思路,各位大神走过路过千万不要错过啊!多谢了!
11 回复
#2
风吹过b2014-12-10 23:45
QQ宠物,不是没有窗口。而是它的窗口是不规则的。

你去搜索一下,不规则的窗口是如何生成的。
都是使用 API 把正常的窗口剪切成的。
依稀记的有二种方法。
一种是 描边界法生成区域法,一个是 掩模法(把不要显示的地方透明掉)。 QQ宠物应该是后一种。
#3
mywind1232014-12-11 19:38
回复 2楼 风吹过b
如果我想搞一个无窗口的三维礼物盒,无窗口,该怎么实现呢?
#4
yangfrancis2014-12-11 22:54
貌似需要引用directx,创建directdraw对象。设置透明背景色等玩意儿,具体怎么弄的记不得了。但我记得那个代码起码得有四五十行
#5
风吹过b2014-12-11 23:25
不规律图形的窗体,建议使用第二次,你百度一下吧。我只知道有这两种方法,没去用过。
#6
xzlxzlxzl2014-12-12 16:37
用窗体透明解决,就是活用几个api函数,很简单的。用于透明的图像最好使用bmp格式,否则边缘会不干净。
只有本站会员才能查看附件,请 登录

只有本站会员才能查看附件,请 登录


[ 本帖最后由 xzlxzlxzl 于 2014-12-12 16:39 编辑 ]
#7
zhengang10262014-12-14 10:35
回复 6楼 xzlxzlxzl
做的好,真棒!
#8
zhengang10262014-12-14 11:09
在xzlxzlxzl版主的代码中增添以下代码,即可移动窗体了。
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim oldX As Long, oldY As Long
Dim x1 As Long, y1 As Long
If Button = 1 Then
x1 = X - oldX: y1 = Y - oldY
oldX = X: oldY = Y
 Me.Left = Me.Left + x1 - Me.Width / 2
 Me.Top = Me.Top + y1 - Me.Height / 2
 End If
End Sub
#9
xzlxzlxzl2014-12-14 13:14
'Dim oldX As Long, oldY As Long纯粹画蛇添足,作为局部变量永远为零,下述代码即可移动

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
    Me.Left = Me.Left + X - Me.Width / 2
    Me.Top = Me.Top + Y - Me.Height / 2
  End If
End Sub



[ 本帖最后由 xzlxzlxzl 于 2014-12-14 13:16 编辑 ]
#10
kaifener2014-12-15 13:31
我没有用那个3D的图片,随便换了张灰色背景的图片,发现背景颜色去不掉了,求指点,谢谢
#11
xzlxzlxzl2014-12-15 14:20
'如果左上角点恒为背景色,则代码修改如下即可

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Sub Command1_Click()
  End
End Sub

Private Sub Form_Load()
  '以左上角点为背景色透明窗体
  Dim rtn As Long
  Me.AutoRedraw = True
  rtn = GetWindowLong(hwnd, -20)
  rtn = rtn Or &H80000
  SetWindowLong hwnd, -20, rtn
  SetLayeredWindowAttributes hwnd, Me.Point(15, 15), 0, 1
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  '移动窗体
  If Button = 1 Then
    Me.Left = Me.Left + X - Me.Width / 2
    Me.Top = Me.Top + Y - Me.Height / 2
  End If
End Sub

[ 本帖最后由 xzlxzlxzl 于 2014-12-17 03:14 编辑 ]
#12
zhengang10262014-12-15 17:12
回复 9楼 xzlxzlxzl
果然一样!当时没想那么多,只是想将每点移动前的座标存起来与移动后的座标作比较。还是人老了脑子不够用啊
1