'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