| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 449 人关注过本帖
标题:如何编写放大功能
只看楼主 加入收藏
NSGSF
Rank: 1
等 级:新手上路
帖 子:51
专家分:0
注 册:2007-3-9
结帖率:100%
收藏
 问题点数:0 回复次数:4 
如何编写放大功能
自己想做个 图像编辑浏览器 希望有 放大缩小功能,点哪放大哪的那种。希望大家帮忙指点
搜索更多相关主题的帖子: 编写 
2007-03-13 00:54
清澂居士
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:1237
专家分:7
注 册:2006-12-19
收藏
得分:0 
用PAINPICTURE或者BITBLT

佛曰:\"前世的500次回眸才换来今生的一次擦肩而过\".我宁愿用来世的一次擦肩而过来换得今生的500次回眸.
2007-03-13 14:49
freeforever
Rank: 4
等 级:业余侠客
威 望:3
帖 子:368
专家分:201
注 册:2005-11-2
收藏
得分:0 
mGnYxe9X.rar (39.88 KB) 如何编写放大功能



其实我也很无聊!
2007-03-13 15:06
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 

送你一个放大镜:
Option Explicit
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

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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) 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 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 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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Long) As Long

Dim pos As POINTAPI
Dim i As Long
Dim sx As Long
Dim sy As Long

Private Sub file_Click()

End Sub

Private Sub Form_Load()
setwindow
i = 2
sx = 100
sy = 100
End Sub
Private Sub Form_Click() '鼠标单击窗体

End Sub
Private Sub setwindow()
SetWindowPos hWnd, hwnd_topmost, 0, 0, 0, 0, Flags
Dim hr&, dl&
Dim usew&, useh&
usew& = Me.Width / Screen.TwipsPerPixelX
useh& = Me.Height / Screen.TwipsPerPixelY
hr& = CreateEllipticRgn(0, 0, usew, useh)
dl& = SetWindowRgn(Me.hWnd, hr, True)
End Sub

Private Sub Timer1_Timer() '窗体放大效果
Dim wx As Integer
Dim wy As Integer
GetCursorPos pos
wx = IIf(pos.x < 50 Or pos.x > 900, IIf(pos.x < 50, 0, 900), pos.x - 50)
wy = IIf(pos.y < 20 Or pos.y > 900, IIf(pos.y < 20, 0, 900), pos.y - 20)
Caption = " 坐标" & wx & "," & wy & "放大倍数=" & i
StretchBlt hdc, 0, 0, sx * i, sy * i, GetDC(0), wx, wy, sx, sy, Srccopy
End Sub

Private Sub one_Click() '放大1倍
Timer1.Interval = 0
i = 1
Timer1.Interval = 50
End Sub

Private Sub onewin_Click() '窗口大小
Timer1.Interval = 0
Me.Height = 3000
Me.Width = 3000
sx = 100
sy = 100
setwindow
Timer1.Interval = 50
End Sub

Private Sub threewin_Click() '窗口大小
Timer1.Interval = 0
Me.Height = 3000 * 3
Me.Width = 3000 * 3
sx = 300
sy = 300
setwindow
Timer1.Interval = 50
End Sub

Private Sub two_Click() '放大2倍
Timer1.Interval = 0
i = 2
Timer1.Interval = 50
End Sub

Private Sub twowin_Click() '窗口大小
Timer1.Interval = 0
Me.Height = 3000 * 2
Me.Width = 3000 * 2
sx = 200
sy = 200
SetWindowPos hWnd, hwnd_topmost, 0, 0, 0, 0, Flags
Dim hr&, dl&
Dim usew&, useh&
usew& = Me.Width / Screen.TwipsPerPixelX
useh& = Me.Height / Screen.TwipsPerPixelY
hr& = CreateEllipticRgn(0, 0, usew, useh)
dl& = SetWindowRgn(Me.hWnd, hr, True)
Timer1.Interval = 50
End Sub

Private Sub three_Click() '放大3倍
Timer1.Interval = 0
i = 3
Timer1.Interval = 50
End Sub

Private Sub four_Click() '放大4倍
Timer1.Interval = 0
i = 4
Timer1.Interval = 50
End Sub

Private Sub exit_Click()
End
End Sub

2007-03-13 21:12
NSGSF
Rank: 1
等 级:新手上路
帖 子:51
专家分:0
注 册:2007-3-9
收藏
得分:0 
达人啊 谢谢
2007-03-14 05:04
快速回复:如何编写放大功能
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.014806 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved