resim üzerine çift tıklayarak müşteri resmi yoksa;müşteri numarasıyla ,hangi formatta olursa olsun seçtiğiniz resmi daha önceden tanımladığınız klasöre bmp formatında kopyalıyor.eğer müşteri resmi varsa irfan view kullanarak resmi açıyor.
sn.Alpekinin paylaşmış olduğu Resim_Formatini_Degistir.rar kodlarını ihtiyacım olan şekilde değiştirerek programıma uyguladım sorunsuz çalışıyor.Kendisine teşekkür ederim.
Kodları aşağıda yazdım:
-------------------------------------
Option Compare Database
Option Explicit
Private Const Irfan1 As String = "C:\Program Files\IrfanView\i_view32.exe"
Dim ctlCurrentControl As Control, strControlName As String
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal _
dwAccess As Long, ByVal fInherit As Integer, ByVal hObject _
As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long
----------------------
-----------------------
Private Sub RESIM_DblClick(Cancel As Integer)
Dim ekocan As String
Dim altan As String
Dim bute As String
Dim r
altan = StrReverse(CurrentDb.Name)
bute = Trim(Mid(altan, 13))
Dim Temppic1 As String
Dim strFilter As String, strInputFileName As String, path1, fso, stAppName As String, newfilename1 As String
Temppic1 = StrReverse(bute) & "resim\1a.jpg"
If RESIM.Picture = StrReverse(bute) & "resim\ARKAPLAN\LOGOB.BMP" Then
r = MsgBox("Müşteri Resmi Kayıtlarımızda Bulunmamaktadır" & Chr(13) & "Eklemek İstermisiniz!", 32 + vbYesNo)
If r = vbYes Then
Set fso = CreateObject("WScript.Shell")
path1 = fso.SpecialFolders("MyDocuments")
strFilter = ahtAddFilterItem(strFilter, "Resim Dosyaları (*.*)", "*.JPG;*.GIF;*.BMP;*.PNG;*.TIF;*.RAW;*.ICO;*.PCX;*.PBM;*.DCM")
strInputFileName = ahtCommonFileOpenSave( _
InitialDir:=path1, Filter:=strFilter, OpenFile:=True, _
DialogTitle:=" Resim Seçiniz", _
Flags:=ahtOFN_HIDEREADONLY)
Me.OriginalPic1 = strInputFileName
FileCopy strInputFileName, Temppic1
Me.RESIM.Picture = Temppic1
Set fso = CreateObject("WScript.Shell")
path1 = fso.SpecialFolders("MyDocuments")
strFilter = ahtAddFilterItem(strFilter, "Image Files (*.*)", "*.*")
strInputFileName = protokol.Value & ".BMP"
stAppName = Irfan1 & " " & Temppic1
If Me.FileTypeCombo = "JPG" Then
If UCase(Right(strInputFileName, 4)) <> ".JPG" Then strInputFileName = strInputFileName & ".JPG"
stAppName = stAppName & " /jpgq=" & Me.Compression0 & " /convert=" & strInputFileName
Else
If UCase(Right(strInputFileName, 4)) <> UCase("." & Me.FileTypeCombo) Then strInputFileName = strInputFileName & "." & Me.FileTypeCombo
stAppName = stAppName & " /convert=" & strInputFileName
End If
LaunchApp32 (stAppName)
End If
Else
ekocan = "C:\Program Files\IrfanView\i_view32.exe " & StrReverse(bute) & "resim\" & Form_musteri.protokol.Value & ".BMP"
Call Shell(ekocan, 1)
Exit Sub
End If
End Sub
---------------------
Function LaunchApp32(MYAppname As String) As Integer
Const SYNCHRONIZE = 1048576
Const INFINITE = -1&
Dim ProcessID&
Dim ProcessHandle&
Dim Ret&
LaunchApp32 = -1
ProcessID = Shell(MYAppname, vbNormalFocus)
If ProcessID <> 0 Then
ProcessHandle = OpenProcess(SYNCHRONIZE, True, ProcessID&)
Ret = WaitForSingleObject(ProcessHandle, INFINITE)
Ret = CloseHandle(ProcessHandle)
Else
MsgBox "ERROR : Unable to start " & MYAppname
LaunchApp32 = 0
End If
End Function
-----------------
umarım ihtiyacı olan arkadaşların işine yarar
hepinize kolay gelsin arkadaşlar.
vetaltan 16-11-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla