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