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


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