Programalama > VISUAL BASIC

Etiketler: program, açma, program, kaydetme

Ort. 0
Puan ver:
'BURDAN İTİBAREN KOPYALA
'Bu programı yapmak için View sekmesinden Objeckt sekmesine tıklayınız
'Daha sonra form'a 3 command button,1 layer ve 1 de textbox ekleyiniz
'Eklemiş olduklarınızı forma yerleştirip istediğiniz değişiklikleri yaptıktan sonra
'Viev sekmesinden code sekmesini seçiniz
'Aşağıdaki tüm kodları ekleyiniz.

Option Explicit
Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type
Private Type GOPENFILENAME
        DosyaTamAdi As String
        DosyaAdi As String
        Filitre As String
        FilitreNo As Long
        BaşlangiçDizini As String
        Başlik As String
        Bayrak As Long
        DefaultUzanti As String
End Type
Private Type tChooseColor
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        rgbResult As Long
        lpCustColors As String
        flags As Long
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type
Private Dialog As GOPENFILENAME

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
'Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As tChooseColor) As Long


Sub DosyaKaydet(frmhandle)
    Dim GDialog As OPENFILENAME
    Dim lResult As Long, iDelim As Integer
    Dialog.DosyaAdi = ""
    Dialog.DosyaTamAdi = ""
    GDialog.flags = Dialog.Bayrak
    GDialog.lpstrFilter = Dialog.Filitre
    GDialog.nFilterIndex = 1
    GDialog.lpstrTitle = Dialog.Başlik
    GDialog.lpstrDefExt = Dialog.DefaultUzanti
    GDialog.lpstrInitialDir = Dialog.BaşlangiçDizini
    GDialog.lStructSize = Len(GDialog)
    GDialog.hwndOwner = frmhandle
    GDialog.lpstrFile = String$(255, 0)
    GDialog.nMaxFile = 255
    GDialog.lpstrFileTitle = String$(255, 0)
    GDialog.nMaxFileTitle = 255
    
    lResult = GetSaveFileName(GDialog)
    If lResult <> 0 Then
        iDelim = InStr(GDialog.lpstrFileTitle, Chr$(0))
        If iDelim > 0 Then
            Dialog.DosyaAdi = Left$(GDialog.lpstrFileTitle, iDelim - 1)
        End If
        iDelim = InStr(GDialog.lpstrFile, Chr$(0))
        If iDelim > 0 Then
            Dialog.DosyaTamAdi = Left$(GDialog.lpstrFile, iDelim - 1)
        End If
    End If
End Sub

Sub DosyaAç(frmhandle)
    Dim GDialog As OPENFILENAME
    Dim lResult As Long, iDelim As Integer
    '
    GDialog.lpstrFile = String$(255, 0)
    '
    Dialog.DosyaAdi = ""
    Dialog.DosyaTamAdi = ""
    GDialog.flags = Dialog.Bayrak
    GDialog.lpstrFilter = Dialog.Filitre
    GDialog.nFilterIndex = 1
    GDialog.lpstrTitle = Dialog.Başlik
    GDialog.lpstrDefExt = Dialog.DefaultUzanti
    GDialog.lpstrInitialDir = Dialog.BaşlangiçDizini
    GDialog.lStructSize = Len(GDialog)
    GDialog.hwndOwner = frmhandle
    GDialog.nMaxFile = 255
    GDialog.lpstrFileTitle = String$(255, 0)
    GDialog.nMaxFileTitle = 255
    lResult = GetOpenFileName(GDialog)
    If lResult <> 0 Then
        iDelim = InStr(GDialog.lpstrFileTitle, Chr$(0))
        If iDelim > 0 Then
            Dialog.DosyaAdi = Left$(GDialog.lpstrFileTitle, iDelim - 1)
        End If
        iDelim = InStr(GDialog.lpstrFile, Chr$(0))
        If iDelim > 0 Then
            Dialog.DosyaTamAdi = Left$(GDialog.lpstrFile, iDelim - 1)
        End If
    End If
End Sub



Private Sub Command1_Click(Index As Integer)
Dim x As Long, n As Byte
With Dialog
        '.DefaultUzanti = "Mid"
        .Filitre = "Resim dosyaları *.gif;*.jpg" + Chr(0) + "*.gif;*.jpg" + Chr$(0) + "Tüm Dosyalar (*.*)" + Chr(0) + "*.*" + Chr$(0) + Chr$(0)
        .Bayrak = &H1000 + 4 + &H800
End With
If Index = 0 Then
    DosyaAç hWnd
    Text1.Text = Dialog.DosyaTamAdi
ElseIf Index = 1 Then
    DosyaKaydet hWnd
Else
    Dim renk As tChooseColor
    Dim CustomColours() As Byte
    ReDim CustomColours(0 To 63) As Byte
    'For n = 0 To 63
    '        CustomColours(n) = n * 4
    'Next
    renk.lpCustColors = StrConv(CustomColours, vbUnicode)
    renk.hwndOwner = Me.hWnd
    renk.flags = 0&
    renk.lStructSize = Len(renk)
    x = CHOOSECOLOR(renk)
    If x Then Me.BackColor = renk.rgbResult
End If
End Sub


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.