Resim Kırpma

             Kodlarını indirmek için Tıkla                                                             İNDİR

 

Imports System.Drawing Imports System.Drawing.Imaging Public Class Form1 Inherits System.Windows.Forms.Form Dim ResmiKırp As Bitmap Dim KrpYeriX As Integer Dim KrpYeriY As Integer Dim KrpGenişliği As Integer Dim KrpBoyu As Integer Public KırpBelirleCizgisi As Pen Public KırpCizgiBoyu As Integer = 0.5 '2 Public KırpmaStili As Drawing2D.DashStyle = Drawing2D.DashStyle.Solid Public KırpmaStiliRengi As Color = Color.Aquamarine Public c As Cursors Private Sub btnCrop_Click(sender As System.Object, e As System.EventArgs) Handles BtnKırp.Click Try If KrpGenişliği < 1 Then MessageBox.Show("Önce kırpılacak yeri seç.", " Kırpma koordinatı yok!", MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End If Dim rect As Rectangle = New Rectangle(KrpYeriX, KrpYeriY, KrpGenişliği, KrpBoyu) Dim bit As Bitmap = New Bitmap(p.Image, p.Width, p.Height) ResmiKırp = New Bitmap(KrpGenişliği, KrpBoyu) Dim g As Graphics = Graphics.FromImage(ResmiKırp) g.DrawImage(bit, 0, 0, rect, GraphicsUnit.Pixel) KırpılanPic.Image = ResmiKırp BtnKırp.Enabled = False BtnKırp.ForeColor = Color.Black BtnKırp.BackColor = System.Drawing.Color.FromName("Control") BtnSakla.Enabled = True Catch exc As Exception MessageBox.Show(exc.Message, " Hata", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub Private Sub p_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles p.MouseDown Try If e.Button = Windows.Forms.MouseButtons.Right Then BtnKırp.Enabled = False BtnKırp.ForeColor = Color.Black BtnKırp.BackColor = System.Drawing.Color.FromName("Control") TxtGenislik.Text = 100 txtYukseklik.Text = 100 BtnKırp.Enabled = False p.Refresh() KırpılanPic.Image = Nothing Exit Sub Else KrpYeriX = e.X KrpYeriY = e.Y KırpBelirleCizgisi = New Pen(KırpmaStiliRengi, KırpCizgiBoyu) KırpBelirleCizgisi.DashStyle = KırpmaStili Cursor = Cursors.Cross End If p.Refresh() Catch exc As Exception MessageBox.Show(exc.Message, " Hata", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub Private Sub p_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles p.MouseMove Try If p.Image Is Nothing Then Exit Sub If e.Button = MouseButtons.Left Then p.Refresh() KrpGenişliği = e.X - KrpYeriX KrpBoyu = e.Y - KrpYeriY p.CreateGraphics.DrawRectangle(KırpBelirleCizgisi, KrpYeriX, KrpYeriY, KrpGenişliği, KrpBoyu) TxtKonumX.Text = KrpYeriX TxtKonumY.Text = KrpYeriY TxtGenislik.Text = KrpGenişliği txtYukseklik.Text = KrpBoyu End If GC.Collect() LblMesaj.Text = "Kırpma Yerini Ve Kırpılanı iptal için Sağ Fare tuşuna basın" Catch exc As Exception If Err.Number = 5 Then Exit Sub MessageBox.Show(exc.Message, " Hata", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub Private Sub p_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles p.MouseUp Try Cursor = Cursors.Default If Not txtYukseklik.Text.ToString = "100" Then BtnKırp.Enabled = True BtnKırp.ForeColor = Color.White BtnKırp.BackColor = Color.Red End If Catch exc As Exception MessageBox.Show(exc.Message, " Hata", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub Private Sub btnOpen_Click(sender As System.Object, e As System.EventArgs) Handles BtnAç.Click Try Dim openDLG As New OpenFileDialog openDLG.Filter = "resim dosyaları (*.bmp, *.gif, *.jpg)|*.bmp;*.gif;*.jpg" If openDLG.ShowDialog = DialogResult.OK Then p.Image = Image.FromFile(openDLG.FileName, True) End If Catch exc As Exception MessageBox.Show(exc.Message, " Hata", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles BtnSakla.Click Try If KırpılanPic.Image Is Nothing Then MessageBox.Show("Görüntü Orjinal ve düzenlenebilir değil", " Hata", MessageBoxButtons.OK, MessageBoxIcon.Information) Exit Sub End If Dim saveDLG As SaveFileDialog = New SaveFileDialog saveDLG.Filter = "Resim Dosyaları (*.bmp, *.gif, *.jpg|*.bmp;*.gif;*.jpg" If saveDLG.ShowDialog = DialogResult.OK Then If saveDLG.FileName.EndsWith("bmp") Then KırpılanPic.Image.Save(saveDLG.FileName, ImageFormat.Bmp) ElseIf saveDLG.FileName.EndsWith("gif") Then KırpılanPic.Image.Save(saveDLG.FileName, ImageFormat.Gif) Else KırpılanPic.Image.Save(saveDLG.FileName, ImageFormat.Jpeg) End If saveDLG.Dispose() End If Catch exc As Exception MessageBox.Show(exc.Message, " Hata", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub Private Sub btnDraw_Click(sender As System.Object, e As System.EventArgs) Handles BtnSecimiGör.Click Try KrpYeriX = Convert.ToInt32(TxtKonumX.Text) KrpYeriY = Convert.ToInt32(TxtKonumY.Text) KrpGenişliği = Convert.ToInt32(TxtGenislik.Text) KrpBoyu = Convert.ToInt32(txtYukseklik.Text) p.Refresh() Dim g As Graphics = p.CreateGraphics KırpBelirleCizgisi = New Pen(KırpmaStiliRengi, KırpCizgiBoyu) KırpBelirleCizgisi.DashStyle = KırpmaStili g.DrawRectangle(KırpBelirleCizgisi, KrpYeriX, KrpYeriY, KrpGenişliği, KrpBoyu) Catch exc As Exception MessageBox.Show(exc.Message, " Hata", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub Private Sub p_MouseLeave(sender As System.Object, e As System.EventArgs) Handles p.MouseLeave LblMesaj.Text = "" End Sub Private Sub btnDraw_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles BtnSecimiGör.MouseMove LblMesaj.Text = " Seçili Kırpma yerini Görmek için buraya basın" End Sub Private Sub btnDraw_MouseLeave(sender As System.Object, e As System.EventArgs) Handles BtnSecimiGör.MouseLeave p_MouseLeave(sender, e) End Sub Private Sub btnOpen_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles BtnAç.MouseMove LblMesaj.Text = " Resim Dosyası Yükleyin" End Sub Private Sub btnOpen_MouseLeave(sender As System.Object, e As System.EventArgs) Handles BtnAç.MouseLeave p_MouseLeave(sender, e) End Sub Private Sub btnSave_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles BtnSakla.MouseMove LblMesaj.Text = " Kırpılan Resimi Saklayın" End Sub Private Sub btnSave_MouseLeave(sender As System.Object, e As System.EventArgs) Handles BtnSakla.MouseLeave p_MouseLeave(sender, e) End Sub End Class