C# KOD ÖRNEKLERİ: Mart 2013

25 Mart 2013 Pazartesi

FORM İÇİNDE KONTROL SÜRÜKLEME

Proje Kodlarını indirmek için.............................................TIKLA

Public Class Form1

#Region " SÜRÜKLEME İŞİNİ YAPAN CLASS..."
    Public Class DragInfo
        Public Property Farenin_ilk_Konumu As Point
        Public Property Baslama_Yeri As Point

Public Sub New(ByVal MouseCoords As Point, ByVal Location As Point)
            Farenin_ilk_Konumu = MouseCoords
            Baslama_Yeri = Location
        End Sub

Public Function NewLocation(ByVal MouseCoords As Point) As Point
            Dim yer As New Point(Baslama_Yeri.X + (MouseCoords.X - Farenin_ilk_Konumu.X), Baslama_Yeri.Y + (MouseCoords.Y - Farenin_ilk_Konumu.Y))
            Return yer
        End Function
    End Class
#End Region

#Region " FORM OLAYLARI"

Private Sub Form1_FormClosing(sender As System.Object, e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
        My.Settings.sol = Me.Left
        My.Settings.üst = Me.Top
    End Sub

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        My.Settings.Reload()
        Me.Top = My.Settings.üst
        Me.Left = My.Settings.sol

ComboBox1.Items.Add("ERDOĞAN ASLAN")
        ComboBox1.Items.Add("EGE ERDEM")
        ComboBox1.Items.Add("MAHMUT TÜMER")
        ComboBox1.Items.Add("KADİR FIRAT")
        ComboBox1.SelectedIndex = 0

LinkLabel1.Text = "Bilgisayar Dünyası"
        LinkLabel1.Links.Add(0, LinkLabel1.Text.Length, "http://eraslancemil.blogspot.com/")

SürüklenebilirYap(Button1)
        SürüklenebilirYap(TextBox1)
        SürüklenebilirYap(PictureBox1)
        SürüklenebilirYap(LinkLabel1)
        SürüklenebilirYap(ListBox1)
        SürüklenebilirYap(ComboBox1)
        SürüklenebilirYap(CheckBox2)
    End Sub

Private Sub SürüklenebilirYap(ByVal Control As Control)
        AddHandler Control.MouseDown, Sub(sender As Object, e As MouseEventArgs) StartDrag(Control)
        AddHandler Control.MouseMove, Sub(sender As Object, e As MouseEventArgs) Drag(Control)
        AddHandler Control.MouseUp, Sub(sender As Object, e As MouseEventArgs) StopDrag(Control)
    End Sub

Private Sub StartDrag(ByVal Control As Control)
        If CheckBox1.Checked = True Then Control.Tag = New DragInfo(Form.MousePosition, Control.Location)
    End Sub

Private Sub Drag(ByVal Control As Control)
        If Control.Tag IsNot Nothing AndAlso TypeOf Control.Tag Is DragInfo Then
            Dim Bilgi As DragInfo = CType(Control.Tag, DragInfo)
            Dim Yeni_Yer As Point = Bilgi.NewLocation(Form.MousePosition)
            If Me.ClientRectangle.Contains(New Rectangle(Yeni_Yer, Control.Size)) Then Control.Location = Yeni_Yer
        End If
    End Sub

Private Sub StopDrag(ByVal Control As Control)
        Control.Tag = Nothing
    End Sub

Public Sub ReLoadFrm()
        'Load (RELOAD) olayı çağrılıp form güncelleniyor
        Dim frm As New Form1
        frm.Show()
        Me.Close()
    End Sub

Private Sub Form1_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
        Label1.Visible = False
        Label1.Text = ""
    End Sub

Private Sub TextBox1_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles TextBox1.MouseMove, PictureBox1.MouseMove, ListBox1.MouseMove, Label1.MouseMove, ComboBox1.MouseMove, CheckBox2.MouseMove, Button1.MouseMove
        If CheckBox1.Checked = False Then
            Label1.Visible = True
            Label1.Text = "Sürükleme izini için Chekbox'u işaretle.."
        End If

End Sub
#End Region

#Region " SÜRÜKLENMEYEN Pic2 FORMLA İLGİLİ OLAYLAR..."

Private Sub pic2_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles pic2.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Right Then
            If CheckBox1.Checked = True Then
                Call Büyüt()
            End If
        End If
    End Sub

Private Sub CheckBox1_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles CheckBox1.CheckedChanged
        If CheckBox1.Checked = False Then
            Call ReLoadFrm()
        End If
    End Sub

Private Sub pic2_DoubleClick(sender As System.Object, e As System.EventArgs) Handles pic2.DoubleClick
        Me.pic2.Dock = DockStyle.None
        Call ReLoadFrm()
    End Sub

Private Sub pic2_MouseLeave(sender As System.Object, e As System.EventArgs) Handles pic2.MouseLeave
        Dim tooltip As New ToolTip()
        tooltip.SetToolTip(pic2, "BU KONTROL SÜRÜKLENEMEZ.." & vbCrLf & "Büyütmek içn Sağ fare tuşuna" & vbCrLf & "Çıkmak için ise Çift Tıkla")
    End Sub

Public Sub Büyüt()
        Me.pic2.Dock = DockStyle.Fill
        Me.pic2.SizeMode = PictureBoxSizeMode.StretchImage

Dim en, boy As Integer
        en = Kontrol_Taşıma.My.Resources.Resources.hatn.Size.Width
        boy = Kontrol_Taşıma.My.Resources.Resources.hatn.Size.Height
        Me.Width = en
        Me.Height = boy
    End Sub

#End Region

#Region " LİNKLABEL İLE WEB SAYFASINA ULAŞMA..."
    'labelin ilk bölümü load içinde belirleniyor
    '__________________________________________________
    'LinkLabel1.Text = "Bilgisayar Dünyası"
    ' LinkLabel1.Links.Add(0, LinkLabel1.Text.Length, "http://eraslancemil.blogspot.com/")
    '___________________________________________________
    Private Sub LinkLabel1_LinkClicked(sender As System.Object, e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
        If My.Computer.Network.IsAvailable = False Then
            MsgBox("Bilgisayarınız İnternete Bağlı Değil.")
            Exit Sub
        End If
        System.Diagnostics.Process.Start(e.Link.LinkData)
    End Sub

#End Region

End Class

Açılış (Spalsh) Form Örneği

Splash Form (Açılış Ekran) Örneği 24.Nisan.2018 İNDİR

Projeye iki Form ekleyin. Form1' in FormBorderstyl özelliği None, Transparancekey ve backColor değerlerini Fuchsia yapın.
Form üstüne Bir PictureBox ekleyip özelliklerini SizeMode=sizeAuto ve BackColor=Fuchsia olarak ayarlayın.
Timer1 ve interval=2000 , Timer2 ve interval= 3000 gibi olsun..
Not : Ben burada 100 adet resim kullandım. siz 10 adet kullanacaksanız 109 yerine 10, 10 yerine de 1 sayısını kullanacaksınız.

Açılış"Splash" Form Program Kodlarını.........................................İNDİR
Sadece EXE programını denemek için .........................................İNDİR

Açılış (Splash) Formda Resimler gösterildikten sonra
kapanıp Ana form açılır.

Public Class form1
    Dim x As Integer = 10
    Private mouse_offset As Point

#Region " FORM TAŞIMAK.."

'Private mouse_offset As Point ' BUNUN EKLEMESİDİR
    Private Sub PictureBox1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Right Then
            'burası taşımakla ilgili değil
            Timer2.Stop()
            Form2.Show()
            Me.Close()
            'burası taşımakla ilgili değil
        Else
            mouse_offset = New Point(-e.X, -e.Y)
            If e.Button = Windows.Forms.MouseButtons.Right Then
                Me.Close()

End If
        End If
    End Sub

Private Sub PictureBox1_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        If e.Button = MouseButtons.Left Then
            Dim mousePos As Point = Control.MousePosition
            mousePos.Offset(mouse_offset.X, mouse_offset.Y)
            Location = mousePos
        End If
    End Sub
#End Region

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        form2.Show()
        Me.Close()
        Timer1.Stop()
    End Sub
    Private Sub form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Timer1.Start()

Timer2.Start()
        Timer2.Interval = 350
    End Sub
    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        Dim yol As String = Application.StartupPath
        x = x + 1
        If x = 109 Then x = 1
        Select Case x
            Case 10 To 109
                PictureBox1.Image = Image.FromFile(yol & "\resim" & x & ".jpg")
        End Select
       
    End Sub
   
End Class

Bir Başka Kısa Örnek: İNDİR

ANA FORM KODU

SPLASH (KARŞILAMA) EKRANI KODU

WEB BROWSERDEN RESİM ALMAK

Kodlarını .......................................... İNDİR
Sadece EXE programını.......................İNDİR

Imports System.Runtime.InteropServices
Imports System.IO

'Imports System.Drawing
Imports System.Drawing.Imaging

Public Class Form1
    Private Const WM_DRAWCLIPBOARD As Integer = &H308
    Private Const WM_CHANGECBCHAIN As Integer = &H30D
    Private mNextClipBoardViewerHWnd As IntPtr
    Private Event OnClipboardChanged()

<DllImport("user32")> _
    Private Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr
    End Function

<DllImport("user32")> _
    Private Shared Function ChangeClipboardChain(ByVal hWnd As IntPtr, ByVal hWndNext As IntPtr) As _
    <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

<DllImport("user32")> _
    Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, _
    ByVal lParam As IntPtr) As IntPtr
    End Function
    Protected Overrides Sub WndProc(ByRef m As Message)
        Select Case m.Msg
            Case WM_DRAWCLIPBOARD
                RaiseEvent OnClipboardChanged()
                SendMessage(mNextClipBoardViewerHWnd, m.Msg, m.WParam, m.LParam)

Case WM_CHANGECBCHAIN
                If m.WParam.Equals(mNextClipBoardViewerHWnd) Then
                    mNextClipBoardViewerHWnd = m.LParam
                Else
                    SendMessage(mNextClipBoardViewerHWnd, m.Msg, m.WParam, m.LParam)
                End If
        End Select
        MyBase.WndProc(m)
    End Sub

Private Sub ClipBoardChanged()
        If My.Computer.Clipboard.ContainsText Then
            If Uri.IsWellFormedUriString(My.Computer.Clipboard.GetText, UriKind.Absolute) Then
                TextBox1.Text = My.Computer.Clipboard.GetText
                TextBox1.Focus()
                Me.Activate()

End If
        End If
    End Sub

Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
        ChangeClipboardChain(Me.Handle, mNextClipBoardViewerHWnd)
    End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        mNextClipBoardViewerHWnd = SetClipboardViewer(Me.Handle)
        AddHandler Me.OnClipboardChanged, AddressOf ClipBoardChanged
    End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        PictureBox1.ImageLocation = TextBox1.Text
    End Sub

Private Sub TextBox1_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBox1.TextChanged
        BtnSakla.Enabled = True
        Button1.Enabled = True
        Button1.PerformClick()

End Sub

Private Sub PictureBox1_Resize(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Resize
        EnTxt.Text = PictureBox1.Width
        BoyTxt.Text = PictureBox1.Height
        Panel1.Width = PictureBox1.Width
        Panel1_Resize(sender, e)
        Me.Width = EnTxt.Text.ToString
        Me.Height = BoyTxt.Text.ToString + 100

End Sub

Private Sub BtnSakla_Click(sender As System.Object, e As System.EventArgs) Handles BtnSakla.Click
        Try

Dim saveDLG As SaveFileDialog = New SaveFileDialog
            saveDLG.Filter = "Resim Dosyaları (*.bmp, *.gif, *.jpg,*.png|*.bmp;*.gif;*.jpg;*.png"
            If saveDLG.ShowDialog = DialogResult.OK Then
                If saveDLG.FileName.EndsWith("bmp") Then
                    PictureBox1.Image.Save(saveDLG.FileName, ImageFormat.Bmp)
                ElseIf saveDLG.FileName.EndsWith("gif") Then
                    PictureBox1.Image.Save(saveDLG.FileName, ImageFormat.Gif)
                ElseIf saveDLG.FileName.EndsWith("png") Then
                    PictureBox1.Image.Save(saveDLG.FileName, ImageFormat.Png)
                Else
                    PictureBox1.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 Panel1_Resize(sender As System.Object, e As System.EventArgs) Handles Panel1.Resize
        BtnSakla.Left = Panel1.Width - BtnSakla.Width - 21
        Button1.Left = Panel1.Width - Button1.Width - 21
        TextBox1.Width = Panel1.Width - BtnSakla.Width - 25
    End Sub
End Class

23 Mart 2013 Cumartesi

Web Sayfasının Kodunu Almak

Kodlarını buradan ..... İNDİR

Bu Program Açık iken Web' den ,CTRL+C ile veya mouse sağ tıklayarak çıkan "Copy" menüsünü onaylar onaylamaz otomatikman Panoya alınan Link, Programdaki Link Textine aktarılır. "LinTxt_TextChanged" olayı ile Tıklama düğmesi tetiklenir ve Web Kodları Gösterilir.

Imports System.IO
Imports System.Runtime.InteropServices

<DllImport("user32")> _
    Private Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr
    End Function

<DllImport("user32")> _
    Private Shared Function ChangeClipboardChain(ByVal hWnd As IntPtr, ByVal hWndNext As IntPtr) As _
    <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Dim kaynakkod As String
        Dim data As StreamReader
        Dim webRequest As Net.WebRequest
        Dim webresponse As Net.WebResponse
        webRequest = Net.WebRequest.Create(LinTxt.Text)
        webresponse = webRequest.GetResponse()
        data = New StreamReader(webresponse.GetResponseStream())
        kaynakkod = data.ReadToEnd()
        RTB.Text = kaynakkod
    End Sub

Private Sub ClipBoardChanged()
        If My.Computer.Clipboard.ContainsText Then
            If Uri.IsWellFormedUriString(My.Computer.Clipboard.GetText, UriKind.Absolute) Then
                LinTxt.Text = (My.Computer.Clipboard.GetText)
            End If
        End If
    End Sub
    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        mNextClipBoardViewerHWnd = SetClipboardViewer(Me.Handle)
        AddHandler Me.OnClipboardChanged, AddressOf ClipBoardChanged
    End Sub

Private Sub Form1_FormClosing(sender As System.Object, e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
           ChangeClipboardChain(Me.Handle, mNextClipBoardViewerHWnd)
    End Sub

Private Sub LinTxt_TextChanged(sender As System.Object, e As System.EventArgs) Handles LinTxt.TextChanged
        Try
            Button1.PerformClick()
        Catch ex As Exception
            Debug.WriteLine(ex.Message)
            MessageBox.Show(ex.Message)
            Debug.WriteLine(ex.StackTrace)
        End Try

End Sub
End Class

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

Registere hızlı Ulaşma

RegEditAç_Skinli_EXE.rar İNDİR

RegEditAç_Skinli_KOD.rar İNDİR

Sadece Exe Programını İNDİR Kodlarını İNDİR

RegEdit (KayıtDefteri) ile fazla uğraşanların işini kolaylaştıracak bir araç. Masa Üstündeki PopUp Menüden hemen ulaşma imkanı...İstenilen zaman eklenip kaldırılabilir.Windows başlarken Otomatik bu da başlayabilme seçeneği... 27.03.2013 Güncellendi

Imports Microsoft.Win32 'register için
Public Class Form1

Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        SaveSetting(Application.ProductName, Application.ProductName, "left", Me.Left)
        SaveSetting(Application.ProductName, Application.ProductName, "top", Me.Top)
        SaveSetting(Application.ProductName, Application.ProductName, "Acilista Baslat", AcilistaBaslatChk.Checked)

End Sub

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Me.Left = GetSetting(Application.ProductName, Application.ProductName, "left", 350)
        Me.Top = GetSetting(Application.ProductName, Application.ProductName, "top", 200)
        Me.AcilistaBaslatChk.Image = ImageLst.Images("Windows_Logosu.ico")
        Me.AcilistaBaslatChk.Checked = GetSetting(Application.ProductName, Application.ProductName, "Acilista Baslat", True)
        If Me.AcilistaBaslatChk.Checked = False Then
            Me.Label3.ForeColor = Color.Black
            Me.Label3.Text = "Windowsla BAŞLAMIYOR"
        Else
            Me.Label3.ForeColor = Color.DarkRed
            Me.Label3.Text = "Windowsla BAŞLIYOR"
        End If
        BaglamMenuChk.Checked = GetSetting(Application.ProductName, Application.ProductName, "Bağlam Menüsü", False)

End Sub

Private Sub RegisterAcPic_Click(sender As System.Object, e As System.EventArgs) Handles RegisterAcPic.Click
        System.Diagnostics.Process.Start("C:\Windows\System32\regedt32.exe")
    End Sub

Private Sub Label1_Click(sender As System.Object, e As System.EventArgs) Handles Label1.Click
        RegisterAcPic_Click(sender, e)
    End Sub

Private Sub BaglamMenuChk_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles BaglamMenuChk.CheckedChanged
        If BaglamMenuChk.Checked = True Then
            On Error Resume Next
            BaglamMenuChk.Image = ImageLst.Images("Bağlam_Menu_2.ico")
            BaglamMenuChk.Checked = True

Dim kayit As RegistryKey
            Dim anahtar As String = "DesktopBackground\Shell"  'Masaüstüne boş alana tıklayınca gelmesini istiyorsan regedit te kullanman gereken alan 
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True).CreateSubKey(Application.ProductName) 'Sağ Click menüme programAdinı Oluşturdum.

Dim icoYol As String = (Application.StartupPath & "\" & Application.ProductName & ".exe") '        'MessageBox.Show(icoYol)

kayit.SetValue("Icon", icoYol)

kayit.SetValue("Position", "Top") 'Programın menüdeki pozisyonunu belirledim. Top,center,bottom
            kayit.CreateSubKey("command").SetValue("", Application.StartupPath & "\" & Application.ProductName & ".exe")
            Label2.ForeColor = Color.DarkRed
            Label2.Text = "Masaüstü Menüye Eklendi"

Else
            Call BaglamMenuSil()
            BaglamMenuChk.Image = ImageLst.Images("Bağlam_Menu.ico")
            BaglamMenuChk.Checked = False
        End If
        SaveSetting(Application.ProductName, Application.ProductName, "Bağlam Menüsü", BaglamMenuChk.Checked)

End Sub

Private Sub BaglamMenuSil()

Try
            Dim kayit As RegistryKey
            Dim anahtar As String = "DesktopBackground\Shell"
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True).CreateSubKey(Application.ProductName)
            kayit.DeleteSubKey("command") 'Önce alt menüyü siliiyor 
            'sonra
            '
            kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True)
            kayit.DeleteSubKey(Application.ProductName) 'Sonra bunu siliyor diğeri zaten önce silinmiş
            Label2.ForeColor = Color.Black
            Label2.Text = "Masaüstü Menüsünden Silindi"

Catch ex As Exception
            Debug.WriteLine(ex.Message)
            MessageBox.Show(ex.Message)
            Debug.WriteLine(ex.StackTrace)
        End Try

End Sub

Private Sub BaglamMenuChk_MouseLeave(sender As System.Object, e As System.EventArgs) Handles BaglamMenuChk.MouseLeave
        Dim tooltip As New ToolTip()
        tooltip.SetToolTip(BaglamMenuChk, " Programınızı Masa Üstündeki PopUp Menüye Ekleyin")

End Sub

Private Sub AcilistaBaslatChk_Click(sender As System.Object, e As System.EventArgs) Handles AcilistaBaslatChk.Click
        On Error Resume Next
        If AcilistaBaslatChk.Checked = False Then
            'Açılışta (çalıştırma) kayıt varsa bile sil
            Dim key As Microsoft.Win32.RegistryKey
            key = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True)
            key.DeleteValue("RegEditAç")
            Label3.ForeColor = Color.Black
            Label3.Text = "Windowsla BAŞLAMIYOR"
        Else
            'Açılışta(çalıştır)
            Label3.ForeColor = Color.DarkRed 'System.Drawing.Color.Black
            Label3.Text = "Windowsla BAŞLIYOR"
            My.Computer.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True).SetValue(Application.ProductName, Application.ExecutablePath)
        End If
    End Sub
    Private Sub RegisterAcPic_MouseLeave(sender As System.Object, e As System.EventArgs) Handles RegisterAcPic.MouseLeave
        'Dim tooltip As New ToolTip()
        'tooltip.SetToolTip(RegisterAcPic, " Registeri Aç")

RegisterAcPic.Image = ImageLst.Images("RegisterICO.ico")
    End Sub

Private Sub RegisterAcPic_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles RegisterAcPic.MouseMove
        RegisterAcPic.Image = ImageLst.Images("ReisteriAç_ortak2.ico")
    End Sub

End Class

21 Mart 2013 Perşembe

Yazıcıdan Metin yazdırma Örneği

Program kodlarını indirmek için TIKLA

Yazdırma Sayfa Ayarı

Yazdırmak için Seçilecek yazıcı

Çıktı almadan önce Önizleme sayfası

Yazıcı Foxit Phantom Printer ile alınan çıktı

KODLAR

Kodlara tıkla ve CTRL+C ile kopyala

Public Class Form1

Dim documentChanged As Boolean = False
    Dim filePath As String
    Dim fileName As String
    Public TxtOku As IO.StreamReader
    Public Yaz As IO.StreamWriter

Private Sub DsyAçBtn_Click(sender As System.Object, e As System.EventArgs) Handles DsyAçBtn.Click
        Dim openDLG As New OpenFileDialog
        openDLG.DefaultExt = "rtf"
        openDLG.Filter = "Özel Dosyalar|*.txt;*.rtf|Text Dosyası|*.txt|Rich Text Dosyası|*.rtf|Tüm Dosyalar|*.*"
        openDLG.InitialDirectory = Application.StartupPath 'programın kurulu olduğu dizini açar
        If openDLG.ShowDialog = Windows.Forms.DialogResult.OK Then
            'butonları aktif yap
            SayfaAyarBtn.Enabled = True
            ÖnzleBtn.Enabled = True
            YazdırBtn.Enabled = True

Dim uzanti As String
            uzanti = System.IO.Path.GetExtension(openDLG.FileName)
            uzanti = uzanti.ToUpper()

Select Case uzanti
                Case ".RTF"
                    RTB.LoadFile(openDLG.FileName, RichTextBoxStreamType.RichText)

Case ".TXT"
                    RTB.Clear()
                    TxtOku = New IO.StreamReader(openDLG.FileName, System.Text.Encoding.Default)
                    RTB.Text = TxtOku.ReadToEnd
                    TxtOku.Close()
                    TxtOku = Nothing
                    RTB.Focus()
                    RTB.SelectionStart = 0
                    RTB.SelectionLength = 0
                    RTB.Modified = False
                Case Else
                    Try
                        System.Diagnostics.Process.Start(openDLG.FileName)
                    Catch ex As Exception
                        MessageBox.Show(uzanti & " 'Uzantılı uygulama Bulunamadı.", "RTE - Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
                    End Try
                    Exit Sub
            End Select

Dim slash As Integer = openDLG.FileName.LastIndexOf("\")
            fileName = openDLG.FileName.Substring(slash + 1)

Me.Text = " DENEME- " & fileName

documentChanged = False
        End If
        documentChanged = False

End Sub
    Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
        Dim DokumanYazdır As New Printing.PrintDocument
        Dim font3 As Font = New Font("Arial", 10, FontStyle.Regular)
        Dim format As New StringFormat
        format.Alignment = StringAlignment.Near '.Center
        e.Graphics.DrawString(RTB.Text, font3, Brushes.Black, New RectangleF(0, 0, e.PageBounds.Width, e.PageBounds.Height), format)
    End Sub

Private Sub ÖnzleBtn_Click(sender As System.Object, e As System.EventArgs) Handles ÖnzleBtn.Click
        Dim ÖnizlemeDLG As New PrintPreviewDialog
        ÖnizlemeDLG.Document = PrintDocument1
        ÖnizlemeDLG.ShowDialog()

End Sub

Private Sub SayfaAyarBtn_Click(sender As System.Object, e As System.EventArgs) Handles SayfaAyarBtn.Click
        Dim SayfaAyarDLG As New PageSetupDialog

SayfaAyarDLG.Document = PrintDocument1
        SayfaAyarDLG.ShowDialog()

End Sub

Private Sub YazdırBtn_Click(sender As System.Object, e As System.EventArgs) Handles YazdırBtn.Click
        Dim YazdırDLG As New PrintDialog
        YazdırDLG.Document = PrintDocument1
        If YazdırDLG.ShowDialog() = Windows.Forms.DialogResult.OK Then
            PrintDocument1.Print()
        End If
    End Sub
End Class

Yazıcıdan CLAS.vb ile Çıktı alma Örneği İNDİR

19 Mart 2013 Salı

ALT DİZİNLERDEN DOSYA ARAMAK VE LİSTEDE GÖSTERMEK

Recursive (Yinelemeli) iiç içe olan dizinlerde arama yapma Fonksiyonuna bir örnek 18.03.2013

KOD İNDİR

Imports System.IO
'Alt Dizinlerde Ara -RECURSIVE
Public Class Form1
#Region "Form işlemleri"
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        TxtBaslamaDizini.Text = My.Settings.BaslamaDizini
        CmbUzanti.Text = My.Settings.Uzanti
        If CmbUzanti.Text = "" Then CmbUzanti.SelectedIndex = 1
        Label6.Visible = False
    End Sub

Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        My.Settings.BaslamaDizini = TxtBaslamaDizini.Text
        My.Settings.Uzanti = CmbUzanti.Text
        My.Settings.Save()
    End Sub

#End Region

#Region "Başlama Dizini Seç"
    Private Sub BtnBaslamaDiziniSec_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBaslamaDiziniSec.Click
        KlasorGosterFBD.SelectedPath = TxtBaslamaDizini.Text
        If (KlasorGosterFBD.ShowDialog() = DialogResult.OK) Then
            TxtBaslamaDizini.Text = KlasorGosterFBD.SelectedPath
        End If
    End Sub
#End Region

#Region "Dosya Arama işlem ve fonksiyonları"

Private Sub btnBul_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBul.Click

DosyaAra(DosyaListesi, TxtBaslamaDizini.Text, CmbUzanti.Text)

End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Me.DosyaListesi.Items.Clear()
    End Sub

Private Sub DosyaAra(ByVal Listemiz As ListBox, ByVal Aramaya_Baslama_Dizini As String, ByVal DsyUzantisi As String)
        Windows.Forms.Cursor.Current = Cursors.AppStarting

Try
         
            DosyaListesi.Items.Clear()
            Dim Uzanti() As String = UzantiVeTirnak(DsyUzantisi)
            Dim Dizin_Yolu As New DirectoryInfo(Aramaya_Baslama_Dizini)
            DizinAra(Listemiz, Dizin_Yolu, Uzanti)
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try
    End Sub
    Private Sub DizinAra(ByVal Listemiz As ListBox, ByVal Dizin_Yolu As DirectoryInfo, ByVal Uzanti() As String)

For Each DsyUzantisi As String In Uzanti
            For Each Dsy_Bilgisi As FileInfo In Dizin_Yolu.GetFiles(DsyUzantisi)
                DosyalariEkle(Listemiz, Dsy_Bilgisi)
            Next Dsy_Bilgisi
        Next DsyUzantisi

' Alt dizinleri ara
        For Each AltDzn_Bilgisi As DirectoryInfo In Dizin_Yolu.GetDirectories()
            DizinAra(Listemiz, AltDzn_Bilgisi, Uzanti)
        Next AltDzn_Bilgisi
    End Sub

Private Sub DosyalariEkle(ByVal Listemiz As ListBox, ByVal Dsy_Bilgisi As FileInfo)

Try
            Listemiz.Items.Add(Dsy_Bilgisi.FullName)

Catch ex As Exception
            MessageBox.Show("Hata işleme dosyası " & Dsy_Bilgisi.FullName & "\n" & ex.Message)
        End Try
        Label6.Visible = True
        Label6.Text = Listemiz.Items.Count.ToString & " Adet Dosya Bulundu.."

End Sub

Private Function UzantiVeTirnak(ByVal pattern_string As String) As String()
        If (pattern_string.Contains("(")) Then
            pattern_string = MetniParantezeAl(pattern_string, "(", ")")
        End If

Dim result() As String = pattern_string.Split(";"c)

For i As Integer = 0 To result.Length - 1
            result(i) = result(i).Trim()
        Next i
        Return result
    End Function

Private Function MetniParantezeAl(ByVal txt As String, ByVal Parantez As String, ByVal delimiter2 As String) As String
        Dim Pozisyon1 As Integer = txt.IndexOf(Parantez)
        Dim Text_Baslangici As Integer = Pozisyon1 + Parantez.Length
        Dim Pozisyon2 As Integer = txt.IndexOf(delimiter2, Text_Baslangici)
        Return txt.Substring(Text_Baslangici, Pozisyon2 - Text_Baslangici)
    End Function
#End Region
  
#Region "Seçilen Dosyayı Çalıştır"

Private Sub DosyaListesi_MouseDoubleClick(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles DosyaListesi.MouseDoubleClick
        ' uygulama çift tıklandığında dosyayı aç.

For Each Secilen_Dsy As String In DosyaListesi.SelectedItems
            System.Diagnostics.Process.Start(Secilen_Dsy)
        Next Secilen_Dsy
    End Sub

#End Region

End Class

18 Mart 2013 Pazartesi

INPUT VE DİZİ ÖRNEKLERİ

KOD İNDİR 18.03.2013

Imports Microsoft.VisualBasic

Public Class Form1

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

Dim kelime As String
        Dim s As String = ""
        Dim i As Integer = 0
        kelime = TextBox1.Text
        ListBox1.Items.Add(kelime)
        Call textsil()
    End Sub
    Public Sub textsil()
        TextBox1.Text = ""
        TextBox1.Focus()
    End Sub

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Call textsil()
    End Sub

Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        ListBox1.Items.Clear()
        Dim gunler(6) As String '' Dizi değişkenini tanımlıyoruz.
        Dim i As Integer '' For Döngüsü için i değişkeni tanımlıyoruz.
        Call textsil()
        gunler(0) = "PAZARTESİ"
        gunler(1) = "SALI"
        gunler(2) = "ÇARŞAMBA"
        gunler(3) = "PERŞEMBE"
        gunler(4) = "CUMA"
        gunler(5) = "CUMARTESİ"
        gunler(6) = "PAZAR"
        For i = 0 To 6
            ListBox1.Items.Add((i + 1 & " .gün - " & gunler(i)))
        Next i
    End Sub

Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        ListBox1.Items.Clear()
        Dim kelime As String
        Dim s As String = ""
        Dim i As Integer = 0
        kelime = TextBox1.Text
        For i = 1 To kelime.Length
            s = Mid(kelime, i, 1)
            ListBox1.Items.Add(s)
        Next
    End Sub

Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
        ListBox1.Items.Clear()
    End Sub

Public dizi() As Integer

Public Sub diziyap()
        'Kendin belirle
        Dim i, a, max, min As Byte
bas:
        i = InputBox("Kaç boyutlu bir dizi istiyorsunuz")
        If i >= 10 Or i < 0 Then
            GoTo bas
        Else
            ReDim Preserve dizi(i)
        End If
        max = UBound(dizi, 1)
        min = LBound(dizi, 1)

For a = min To max
            dizi(a) = InputBox(a)
            ListBox1.Items.Add(dizi(a))
        Next
    End Sub

Private Sub Button5_Click(sender As System.Object, e As System.EventArgs) Handles Button5.Click
        'Örnek Linki :'http://www.yazgelistir.com/makale/vb-nette-diziler

If Me.CheckBox1.Checked = True Then
            Call diziyap()
            Exit Sub
        End If
 
        Dim A() As Integer
        Dim i As Integer
        Dim t As String = ""
        ReDim A(10)
        For i = 0 To 9
            A(i) = Rnd() * 1000
            t = t + CStr(A(i)) & " - "
        Next i
        'Girilen diziyi göster sırasız
        TextBox3.Text = t
       
        ListBox1.Items.Add("Rastgele : " & t)

Call sirala(A, 9)

t = ""
        For i = 0 To 9
            t = t + CStr(A(i)) & " - "
        Next i
        'dizinin sıralanmış hali
        TextBox2.Text = t
        ListBox1.Items.Add("Sıralı        : " & t)
    End Sub

Private Sub sirala(ByVal x() As Integer, ByVal n As Integer)
        Dim i, j, t As Integer
        For i = 0 To n - 1
            For j = i + 1 To n
                If x(i) > x(j) Then
                    t = x(i)
                    x(i) = x(j)
                    x(j) = t
                End If
            Next
        Next
    End Sub

End Class

LİSTVEW ve DİZİ İLE PERSONEL PROGRAM ÖRNEĞİ

ListView Ve Dizi ile ilgili bir VB.NET 2010 Örneği KODİ NDİR

18.03.2013

Imports System.Xml
Imports System.IO
Imports System
Imports System.Text
Public Class Form1
    Public eleman As ListViewItem
    'Global değişkenler tanımlanıyor.
    Structure personel
        Dim Ad As String
        Dim Meslek As String
        Dim BabaAdi As String
        Dim DogumYeri As String
        Dim Bolum As String
    End Structure
    Dim Pers() As personel 'diziyi dinamik olarak tanımla
    Dim dizi_boyutu As Integer 'En son tanımlanan dizinin boyutu
    Dim eleman_say As Integer

Private Sub Form1_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        SaklaBtn.PerformClick()
    End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

dizi_boyutu = 10 'Formun yüklenmseinde (Load olayı) Başlangıçta on elemanlı bir dizi
        eleman_say = 0 ' Dizideki aktif elemanın sayısı
        ReDim Pers(dizi_boyutu) 'Dizi 10 elemanlı olarak yeniden tanımlandı
        Label8.Text = eleman_say
        Label9.Text = dizi_boyutu
        Call ListeYukle()

End Sub

Private Sub ListeYukle()

On Error Resume Next
        LW1.Items.Clear()

Dim XMLoku As New XmlTextReader(My.Application.Info.DirectoryPath & "\" & My.Settings.XmlFileName)

XMLoku.MoveToContent()

Dim ElementName As String = ""
        Dim NextItem As Boolean = True
        Dim objListViewItem As ListViewItem = Nothing

Do While XMLoku.Read
            If NextItem Then
                objListViewItem = New ListViewItem
                NextItem = False
            End If

Select Case XMLoku.NodeType
                Case XmlNodeType.Element
                    ElementName = XMLoku.Name
                Case XmlNodeType.Text
                    If ElementName = "PersonelAdı" Then
                        objListViewItem.Text = XMLoku.Value
                    End If
                    If ElementName = "Mesleği" Then
                        objListViewItem.SubItems.Add(XMLoku.Value)
                        LW1.Items.Add(objListViewItem)

End If
                    If ElementName = "BabaAdı" Then
                        objListViewItem.SubItems.Add(XMLoku.Value)
                        LW1.Items.Add(objListViewItem)

End If
                    If ElementName = "DoğumYeri" Then
                        objListViewItem.SubItems.Add(XMLoku.Value)
                        LW1.Items.Add(objListViewItem)

End If
                    If ElementName = "Bölüm" Then
                        objListViewItem.SubItems.Add(XMLoku.Value)
                        LW1.Items.Add(objListViewItem)
                        NextItem = True
                    End If
            End Select
        Loop
        XMLoku.Close()
    End Sub

Private Sub SaklaBtn_Click(sender As System.Object, e As System.EventArgs) Handles SaklaBtn.Click

Dim XMLyaz As New XmlTextWriter(Application.StartupPath & My.Settings.XmlFileName, System.Text.Encoding.UTF8)
        'Dim XMLyaz As New XmlTextWriter(My.Application.Info.DirectoryPath & "\" & My.Settings.XmlFileName, System.Text.Encoding.UTF8)

With XMLyaz
            .Formatting = Formatting.Indented
            .WriteStartDocument()
            .WriteStartElement("Personel")
            Dim ListViewNesnesi As New ListViewItem
            For Each ListViewNesnesi In LW1.Items
                .WriteStartElement("Personel")
                .WriteElementString("PersonelAdı", ListViewNesnesi.Text)
                .WriteElementString("Mesleği", ListViewNesnesi.SubItems(1).Text)
                .WriteElementString("BabaAdı", ListViewNesnesi.SubItems(2).Text)
                .WriteElementString("DoğumYeri", ListViewNesnesi.SubItems(3).Text)
                .WriteElementString("Bölüm", ListViewNesnesi.SubItems(4).Text)
                .WriteEndElement()
            Next
            .WriteEndElement()
            .WriteEndDocument()
            .Flush()
            .Close()
        End With
        SaklaBtn.Enabled = False
    End Sub
    Public Sub GirişleriSil()
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
        TextBox4.Text = ""
        TextBox5.Text = ""
        Label9.Text = ""
    End Sub

Private Sub EkleBtn_Click(sender As System.Object, e As System.EventArgs) Handles EkleBtn.Click

Dim i
        'Dizi boyutları büyüdükçe yeniden tanımlama işlemi uzun sürer. Bunun için diziye her
        'yeni eleman eklendiğinde dizinin boyutunu arttırmak yerine

If dizi_boyutu = eleman_say Then 'dizi dolduysa
            dizi_boyutu = dizi_boyutu + 10    'Diziye 10 eleman daha ekle
            ReDim Preserve Pers(dizi_boyutu)
            Label9.Text = dizi_boyutu

MsgBox("Dizinin Boyutu Artırılacak: " & dizi_boyutu)
        End If

i = eleman_say
        'Text kutularının içeriklerini diziye ata
        Pers(i).Ad = TextBox1.Text
        Pers(i).Meslek = TextBox2.Text
        Pers(i).BabaAdi = TextBox3.Text
        Pers(i).DogumYeri = TextBox4.Text
        Pers(i).Bolum = TextBox5.Text

eleman_say = eleman_say + 1
        Label8.Text = eleman_say
        Label9.Text = dizi_boyutu

Dim item As New ListViewItem
        item.Text = Pers(i).Ad
        item.SubItems.Add(Pers(i).Meslek)
        item.SubItems.Add(Pers(i).BabaAdi)
        item.SubItems.Add(Pers(i).DogumYeri)
        item.SubItems.Add(Pers(i).Bolum)

'son eklenenin seçildiği yer.
        Me.LW1.Items.Add(item)

Me.LW1.Items(Me.LW1.Items.Count - 1).Selected = True
        Me.LW1.Sorting = SortOrder.Ascending 'indexi bulunduktan sonra liste sıralanı

LW1.Items(LW1.Items.Count - 1).EnsureVisible() 'Eklenen görünür alanda değilse gösterilir
        Me.LW1.Focus() 'seçimin görünür olması için
        SaklaBtn.Enabled = True
    End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        dizi_boyutu = 10 'Formun yüklenmseinde (Load olayı) Başlangıçta on elemanlı bir dizi
        eleman_say = 0 ' Dizideki aktif elemanın sayısı
        ReDim Pers(dizi_boyutu) 'Dizi 10 elemanlı olarak yeniden tanımlandı
        Label8.Text = eleman_say
        Label9.Text = dizi_boyutu
        Call ListeYukle()
    End Sub

Private Sub LW1_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles LW1.KeyDown
        If e.KeyCode = Keys.Delete Then
            SilBtn.PerformClick()
        End If
        If e.KeyCode = Keys.Escape Then
            Me.Close()
        End If
    End Sub

Private Sub SilBtn_Click(sender As System.Object, e As System.EventArgs) Handles SilBtn.Click
        On Error Resume Next
        Dim indexes As ListView.SelectedIndexCollection = LW1.SelectedIndices
        Dim index As Integer

For Each index In indexes
            LW1.Items.RemoveAt(index)
        Next

If index = 0 Then index = 0

index = index - 1

If index = -1 Then index = 0
        eleman = LW1.Items(index)
        eleman.Selected = True
        LW1.Focus()
        SaklaBtn.Enabled = True
    End Sub

Private Sub LW1_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles LW1.SelectedIndexChanged
        Dim sayi As Integer = LW1.Items.Count
        Dim eleman As ListViewItem
        For i As Integer = 0 To sayi - 1
            eleman = LW1.Items(i)

If eleman.Selected Then
                SecilenIndex.Text = i
                LblKayıtSayısı.Text = "(" & sayi & "  Kayıt sayısı)"
                LblSeçilenSatır.Text = "(" & i + 1 & " .Satır seçili)"
            End If
        Next
        SaklaBtn.Enabled = True
    End Sub
End Class

17 Mart 2013 Pazar

Listview' DE ARAMA YAPMAK

Örneğini İNDİR ve incele

16 Mart 2013 Cumartesi

Şeffaf Dijital saat ve takvim

PROJENİN TAMAMINI ............................. İNDİR

Veya alttaki kutuya tıkla seçimi CTRL+C il kopyala

Public Class Form1
    Private takvimgizli As Boolean = False
    Private KYDurdur As Boolean = False

#Region "FORM SÜRÜKLE.."
    'sürükle
    Const i As Integer = &HA1
    Const j As Integer = 2
    Private Sub PictureBox4_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox4.MouseDown, LblTarih.MouseDown, Label3.MouseDown, Label2.MouseDown, Label1.MouseDown
        PictureBox4.Capture = False
        LblTarih.Capture = False
        Label1.Capture = False
        Label2.Capture = False
        Label3.Capture = False
        Dim msg As Message = Message.Create(Me.Handle, i, New IntPtr(j), IntPtr.Zero)
        Me.DefWndProc(msg)
    End Sub
#End Region

Public Shared Sub BaşlangıçtaAç(ByVal Name As String, ByVal Path As String)
        Dim Registry As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser
        Dim Key As Microsoft.Win32.RegistryKey = Registry.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
        Key.SetValue(Name, Path, Microsoft.Win32.RegistryValueKind.String)
    End Sub
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Label1.Text = "Bu Gün " + Date.Now.ToString("dddd ")
        LblTarih.Text = Mid(Date.Today, 1, 2)
        Dim bg As String = LblTarih.Text
        LblTarih.Text = bg  'Mid(Date.Today, 1, 2)
    End Sub

Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        Label2.Text = TimeOfDay

End Sub

Private Sub Timer3_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer3.Tick
        Label3.Text = DateString
    End Sub

Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If (e.KeyCode = Keys.F5) Then
            Me.Show()
        End If
    End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
       
        BaşlangıçtaAç(Me.Text, Application.ExecutablePath)
        ToolTip1.SetToolTip(PictureBox3, " Kayan yazı - Başlat-Durdur ! ")
        ToolTip1.SetToolTip(PictureBox2, " Minimize ")
        ToolTip1.SetToolTip(PictureBox1, " Takvim Göster ")
        ToolTip1.SetToolTip(PictureBox4, " Sağ fare ile Takvimi gizle ")
        ToolTip1.SetToolTip(KapataPic, " Kapat ")
        ToolTip1.SetToolTip(LblTarih, " Sağ Fare Tuşu ile Takvimi Aç-Kapat")
        'Kayan yazı 
        Timer_KYazi.Interval = 100
        Me.Lbl_KayanYazi.Text = "ERDOĞAN   ASLAN " & "  Bugün  " & UCase(DateString) & "  " & UCase(Date.Now.ToString("dddd ")) & Space(60)

Timer_KYazi.Start()
    End Sub

Private Sub NotifyIcon1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseClick

If Me.Visible Then
            Me.Hide()
        Else
            Me.Show()
        End If

End Sub

Private Sub Form1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick
        Me.WindowState = FormWindowState.Maximized
    End Sub

Private Sub ExitToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        Me.Close()
    End Sub

Private Sub PictureBox1_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Click
        MonthCalendar1.Show()
        PictureBox1.Hide()
        PictureBox4.Show()

End Sub

Private Sub PictureBox4_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox4.Click
        MonthCalendar1.Hide()
        PictureBox4.Hide()
        PictureBox1.Show()
    End Sub

Private Sub PictureBox2_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox2.Click
        Me.Hide()
    End Sub

Private Sub PictureBox3_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox3.Click
      
        If KYDurdur = False Then
            Lbl_KayanYazi.Visible = False
            KYDurdur = True
        Else
            KYDurdur = False
            Lbl_KayanYazi.Visible = True
        End If

End Sub

Private Sub KapataPic_Click(sender As System.Object, e As System.EventArgs) Handles KapataPic.Click
        NotifyIcon1.Dispose()
        Me.Close()
    End Sub

Private Sub Timer_KYazi_Tick(sender As System.Object, e As System.EventArgs) Handles Timer_KYazi.Tick

Dim str As String
        Dim i As Integer
        str = ""
        For i = 1 To Me.Lbl_KayanYazi.Text.Length - 1
            str = str + Me.Lbl_KayanYazi.Text(i)
        Next
        Me.Lbl_KayanYazi.Text = str + Me.Lbl_KayanYazi.Text(0)

End Sub

Private Sub LblTarih_MouseClick(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles LblTarih.MouseClick
        If takvimgizli = False Then
            PictureBox1_Click(sender, e)
            takvimgizli = True
        Else
            PictureBox4_Click(sender, e)
            takvimgizli = False
        End If
    End Sub

Private Sub NotifyIcon1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Right Then
            NotifyIcon1.Dispose()
            Me.Close()
        End If

End Sub

Private Sub Lbl_KayanYazi_Click(sender As System.Object, e As System.EventArgs) Handles Lbl_KayanYazi.Click
        If Lbl_KayanYazi.ForeColor = Color.Orange Then
            Lbl_KayanYazi.ForeColor = Color.White
        Else
            Lbl_KayanYazi.ForeColor = Color.Orange
        End If

End Sub

Private Sub Label1_Click(sender As System.Object, e As System.EventArgs) Handles Label1.Click
        If Label1.ForeColor = Color.Orange Then
            Label1.ForeColor = Color.White
        Else
            Label1.ForeColor = Color.Orange
        End If
    End Sub

Private Sub Label2_Click(sender As System.Object, e As System.EventArgs) Handles Label2.Click
        If Label2.ForeColor = Color.Orange Then
            Label2.ForeColor = Color.White
        Else
            Label2.ForeColor = Color.Orange
        End If
    End Sub

Private Sub Label3_Click(sender As System.Object, e As System.EventArgs) Handles Label3.Click
        If Label3.ForeColor = Color.Orange Then
            Label3.ForeColor = Color.White
        Else
            Label3.ForeColor = Color.Orange
        End If
    End Sub

End Class

Sadece Exe Programını................................. İNDİR

14 Mart 2013 Perşembe

WİNDOWS GÖREV YÖNETİCİSİNDEN PROGRAM YÜKLEMEK

Programınız Görev yöneticisinde yüklü değilse Yükler...

Public Class Form1
    Dim ProcessList As System.Diagnostics.Process()
    Dim Proc As System.Diagnostics.Process
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ProcessList = System.Diagnostics.Process.GetProcesses()
        For Each Me.Proc In ProcessList
            ListBox1.Items.Add(Me.Proc.ProcessName)
        Next
        Timer1.Interval = 100
        Timer1.Start()
    End Sub
    'WİNDOWS GÖREV YÖNETİCİSİNDEN PROGRAM YÜKLEMEK
    'Programınız WİNDOWS GÖREV YÖNETİCİSİNDE yüklü değilse (açık değilse) açmak için kod

Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        'write.exe
        '
        If Not Me.Proc.ProcessName = "write.exe" Then
            Dim ac As String
            ac = Shell("c:\Windows\write.exe", 1)
            Timer1.Stop() 'programı bulup çalıştır yoksa her 100 intervalde bir kez daha yükler.

Exit Sub
        End If
        If Not Me.Proc.ProcessName = "notepad.exe" Then
            Dim ac As String
            ac = Shell("c:\Windows\notepad.exe", 1)
            Timer1.Stop() 'programı bulup çalıştır yoksa her 100 intervalde bir kez daha yükler.
        End If

End Sub
End Class

5 Mart 2013 Salı

Açılış Formu (splash) yapmak

Formun FormBorderStyle özelliğini None Yapıyoruz.
Formun üstüne bir adet PictureBox yerleştiriyoruz.
Picture' nin BackColor özelliğini (Fuchsia)
Formun da TransparencyKeys Özelliğini (Fuchsia)
PictureBox' un SizeModu' nu (Normal) yapıyoruz.
Veee .PNG olarak hazırladığıımız (aşağıdaki) resmi Picturenin image özelliğinden ekliyoruz.
form başlıksız kalınca taşıması mümkün olmaz, Kapatabilmek için bir Buton ekleyin ve alttaki kodları kopyalayıp, Projenize yapıştırın.

Resim formun üstünde ve boyutları Dock özelliği ile üst üste örtüştürülmüş durumda..

Bu formun programınızın açılışından önce yüklenmesi için: MyProject özelliğini açın :

gerekli eklemeyi yaptıktan sonra ana formunuz açılmadan bu form çıkacak belli bir süre sonra da ana formunuz açılacaktır.

Proje Kodlarını >> İNDİR
splash_EXE >> İNDİR
Alternatif Link >> İNDİR
_________________________________________________________________________

PopUp Dosya Menüsüne Uygulama Ekleme

MasaÜstünde sağ fare tuşuna basıldığında çıkan Menüye ulaşmak her zaman kolaydır.Buraya Çok sık kullandığınız programlarınızı eklemeniz için VB:NET 2010 ile yapılmış bir örnek

Imports Microsoft.Win32
'Dosya Menüsüne Uygulama Ekleme örneği
'ikon Dosyası>>> %SystemRoot%\system32\SHELL32.dll

Imports vb = Microsoft.VisualBasic
Imports System.IO
Public Class Form1
    Dim programAdi As String
    Dim VarsayilanAdi As String
    Dim programExe As String
    Dim programYolu As String
    Dim uzanti As String
    Dim DizinYolu As String
    Dim UyPozisyonu As String
    Dim Uygulamaikonu As String
    Dim kayit As RegistryKey
 
    Private Sub DsyAçBtn_Click(sender As System.Object, e As System.EventArgs) Handles DsyAçBtn.Click
        Dim openDLG As New OpenFileDialog
        openDLG.InitialDirectory = GetSetting(Application.ProductName, "Ayarlar", "Uygulama Yolu", "C:\Program Files")

openDLG.Multiselect = False
        openDLG.DefaultExt = "exe"
        openDLG.Filter = "Programlar (*.exe)|*.exe"

If openDLG.ShowDialog = DialogResult.OK Then
            If vb.Right((openDLG.FileName), 4) = ".exe" Then
                UyYoluTxt.Text = openDLG.FileName
            Else
                Exit Sub
            End If
            programYolu = Trim(UyYoluTxt.Text)

If Not ikonYoluTxt.Text = "" Then MnEkleBtn.Enabled = True : Call PozisyonYeri()

UygulamaAdıTxt.Text = DosyaAdıBul(DosyaAdıBul(openDLG.FileName))
            programAdi = UygulamaAdıTxt.Text
            UyVarsayılanAdıTxt.Text = DosyaAdıBul(DosyaAdıBul(openDLG.FileName)) & uzanti
            SaveSetting(Application.ProductName, "Ayarlar", "Uygulama Yolu", openDLG.InitialDirectory)
        End If

End Sub
 
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles MnEkleBtn.Click
        On Error Resume Next
        Dim anahtar As String = "DesktopBackground\Shell"  'Masaüstüne boş alana tıklayınca gelmesini istiyorsan regedit te kullanman gereken alan
        kayit = Registry.ClassesRoot.OpenSubKey(anahtar, True).CreateSubKey(programAdi) 'Sağ Click menüme programAdinı Oluşturdum.

If Clipboard.ContainsImage() Then 'picurebox içine panoyu aktar
            ikonPic.Image = Clipboard.GetImage()
        End If
        kayit.SetValue("Icon", ikonYoluTxt.Text)
     
        kayit.SetValue("Position", UyPozisyonu) 'Programın menüdeki pozisyonunu belirledim. Top,center,bottom
        kayit.CreateSubKey("command").SetValue("", programYolu)
        MessageBox.Show("İşlem tamam")
        Exit Sub
        End Sub

Public Function DosyaAdıBul(ByVal DosyaYolu As String) As String
        On Error Resume Next
        Dim SonPozisyon, Yenipozisyon As Integer, Filtre As String
        SonPozisyon = InStr(DosyaYolu, "\")
        Yenipozisyon = SonPozisyon

Do While SonPozisyon > 0
            Yenipozisyon = SonPozisyon
            SonPozisyon = InStr(Yenipozisyon + 1, DosyaYolu, "\")
        Loop
        Filtre = Mid(DosyaYolu, Yenipozisyon + 1)

SonPozisyon = InStr(Filtre, ".")
        Yenipozisyon = SonPozisyon
        Do While SonPozisyon > 0
            Yenipozisyon = SonPozisyon
            SonPozisyon = InStr(Yenipozisyon + 1, Filtre, ".")
        Loop

Filtre = Mid(Filtre, 1, Yenipozisyon - 1)
        Return Filtre
    End Function

Private Sub PictureBox1_MouseLeave(sender As System.Object, e As System.EventArgs) Handles DsyAçBtn.MouseLeave
        Dim tooltip As New ToolTip()
        tooltip.SetToolTip(DsyAçBtn, "Dosya menüsünüe eklenecek Programı seçin")
    End Sub

Private Sub RegisterAcPic_Click(sender As System.Object, e As System.EventArgs) Handles RegisterAcPic.Click
        'regedit 'i açar '        'HKEY_CLASSES_ROOT\"*\shell" BURAYA EKLENİYOR
        System.Diagnostics.Process.Start("C:\Windows\System32\regedt32.exe")
    End Sub

Private Sub RegisterAcPic_MouseLeave(sender As System.Object, e As System.EventArgs) Handles RegisterAcPic.MouseLeave

Dim tooltip As New ToolTip()
        tooltip.SetToolTip(RegisterAcPic, "Kayıtlar >>DesktopBackground\Shell")
    End Sub

Private Sub ikonPic_Click(sender As System.Object, e As System.EventArgs) Handles ikonPic.Click
        Dim openDLG As New OpenFileDialog
        openDLG.Multiselect = False
        openDLG.DefaultExt = "ico"
        openDLG.Filter = "Ikon (*.ico)|*.ico"
        If openDLG.ShowDialog = DialogResult.OK Then
            If vb.Right((openDLG.FileName), 4) = ".ico" Then ikonYoluTxt.Text = openDLG.FileName
            Me.ikonPic.Image = Image.FromFile(openDLG.FileName, True)
            If Not UyYoluTxt.Text = "" Then MnEkleBtn.Enabled = True : Call PozisyonYeri()

End If
    End Sub
  
    Private Sub RBUst_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles RBUst.CheckedChanged
        If RBUst.Checked = False Then Exit Sub
        Me.UyPozisyonuTxt.Text = "top"
        SaveSetting(Application.ProductName, "Ayarlar", "RB", Me.UyPozisyonuTxt.Text)
    End Sub

Private Sub RBOrta_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles RBOrta.CheckedChanged
        If RBOrta.Checked = False Then Exit Sub
        Me.UyPozisyonuTxt.Text = "center"
        SaveSetting(Application.ProductName, "Ayarlar", "RB", Me.UyPozisyonuTxt.Text)
    End Sub

Private Sub RBAlt_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles RBAlt.CheckedChanged
        If RBAlt.Checked = False Then Exit Sub
        Me.UyPozisyonuTxt.Text = "bottom"
        SaveSetting(Application.ProductName, "Ayarlar", "RB", Me.UyPozisyonuTxt.Text)
    End Sub
    Public Sub PozisyonYeri()

UyPozisyonu = GetSetting(Application.ProductName, "Ayarlar", "RB", "top")
        Select Case UyPozisyonu
            Case "top" : RBUst.Checked = True
            Case "center" : RBOrta.Checked = True
            Case "bottom" : RBAlt.Checked = True
        End Select
        Grup1.Enabled = True
    End Sub
  
    Private Sub Button1_Click_1(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        UyYoluTxt.Text = ""
        ikonYoluTxt.Text = ""
        ikonPic.Image = Nothing
        UyPozisyonuTxt.Text = ""
        UygulamaAdıTxt.Text = ""
        UyVarsayılanAdıTxt.Text = ""
        Grup1.Enabled = False
    End Sub
End Class