Trang Chính
truyen hay
Calendar
Trợ giúp
Tìm kiếm
Thành viên
Nhóm
Đăng ký
Đăng Nhập
Ban quản trị
- Chủng tộc : SONGOKU
Tổng số bài gửi : 41075
Độ nổi tiếng : 847
Join date : 14/11/2011
Age : 26 
giãn ảnh VB
on Thu Jan 03, 2013 5:19 pm
- Code:
Private Sub Zoom(ByVal factor As Double)
Dim img_ As Image
img_ = PictureBox1.Image
Dim srcbtm As New Bitmap(img_)
Dim destbtm As New Bitmap(CInt(srcbtm.Width * factor), _
CInt(srcbtm.Height * factor))
Dim destGraphic As Graphics = Graphics.FromImage(destbtm)
destGraphic.DrawImage(srcbtm, 0, 0, destbtm.Width + 1, _
destbtm.Height + 1)
PictureBox1.Image = destbtm
End Sub
๑۩۞۩๑[♥๑۩۞۩๑ (¯`•♥Truyện hay♥•´¯) ๑۩۞۩๑[♥๑۩۞۩๑ ๑۩۞۩๑[♥๑۩۞۩๑ (¯`•♥Forumi.com♥•´¯) ๑۩۞۩๑[♥๑۩۞۩๑
Đăng nhập để có 1 link download đúng
- Ban quản trị
- Chủng tộc : SONGOKU
Tổng số bài gửi : 41075
Độ nổi tiếng : 847
Join date : 14/11/2011
Age : 26
Re: giãn ảnh VB
on Thu Jan 03, 2013 5:22 pm
- Code:
Imports System.Linq
Imports System.Windows
Imports System.Windows.Input
Imports System.Windows.Media
Namespace MapTest
Public Partial Class Window1
Inherits Window
Private origin As Point
Private start As Point
Public Sub New()
InitializeComponent()
Dim group As New TransformGroup()
Dim xform As New ScaleTransform()
group.Children.Add(xform)
Dim tt As New TranslateTransform()
group.Children.Add(tt)
image.RenderTransform = group
image.MouseWheel += image_MouseWheel
image.MouseLeftButtonDown += image_MouseLeftButtonDown
image.MouseLeftButtonUp += image_MouseLeftButtonUp
image.MouseMove += image_MouseMove
End Sub
Private Sub image_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs)
image.ReleaseMouseCapture()
End Sub
Private Sub image_MouseMove(sender As Object, e As MouseEventArgs)
If Not image.IsMouseCaptured Then
Return
End If
Dim tt As var = DirectCast(DirectCast(image.RenderTransform, TransformGroup).Children.First(Function(tr As ) TypeOf tr Is TranslateTransform), TranslateTransform)
Dim v As Vector = start - e.GetPosition(border)
tt.X = origin.X - v.X
tt.Y = origin.Y - v.Y
End Sub
Private Sub image_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs)
image.CaptureMouse()
Dim tt As var = DirectCast(DirectCast(image.RenderTransform, TransformGroup).Children.First(Function(tr As ) TypeOf tr Is TranslateTransform), TranslateTransform)
start = e.GetPosition(border)
origin = New Point(tt.X, tt.Y)
End Sub
Private Sub image_MouseWheel(sender As Object, e As MouseWheelEventArgs)
Dim transformGroup As TransformGroup = DirectCast(image.RenderTransform, TransformGroup)
Dim transform As ScaleTransform = DirectCast(transformGroup.Children(0), ScaleTransform)
Dim zoom As Double = If(e.Delta > 0, 0.2, -0.2)
transform.ScaleX += zoom
transform.ScaleY += zoom
End Sub
End Class
End Namespace
๑۩۞۩๑[♥๑۩۞۩๑ (¯`•♥Truyện hay♥•´¯) ๑۩۞۩๑[♥๑۩۞۩๑ ๑۩۞۩๑[♥๑۩۞۩๑ (¯`•♥Forumi.com♥•´¯) ๑۩۞۩๑[♥๑۩۞۩๑
Đăng nhập để có 1 link download đúng
Permissions in this forum:
Bạn không có quyền trả lời bài viết|
|
|