Form Üzerinden Resim Ekleme Hakkında Her Şey
(05-10-2019, 17:39)e.karamanoglu demiş ki: selamlar fotoğraf ekledikten sonra resim klasörüne onu kopyaladığı esnada standart bir boyutta küçülterek kopyalamasını sağlayabilir miyiz

Merhaba..

Mümkündür.. Resmi kopyalama işlemini yaptığınız kod blokunu ve hangi ölçülerde küçülmesini istediğinizi paylaşırsanız yardımcı olurum..



  Alıntı
Bu mesajı beğenenler:
(05-10-2019, 18:31)Taruz demiş ki:
(05-10-2019, 17:39)e.karamanoglu demiş ki: selamlar fotoğraf ekledikten sonra resim klasörüne onu kopyaladığı esnada standart bir boyutta küçülterek kopyalamasını sağlayabilir miyiz

Merhaba..

Mümkündür.. Resmi kopyalama işlemini yaptığınız kod blokunu ve hangi ölçülerde küçülmesini istediğinizi paylaşırsanız yardımcı olurum..
Visual Basic
  1. Function ResimEkle(alanadi As String, cerceveadi As String)
  2. Dim gzt As FileDialog
  3. Dim DosyaAdi As String
  4. Dim SeciliNesne As Variant
  5. Set trz = Application.FileDialog(msoFileDialogFilePicker)
  6. With trz
  7.    .AllowMultiSelect = False
  8.    .ButtonName = "Resim Seç"
  9.    .Filters.Add "Resimler", _
  10.                  "*.gif; *.jpg; *.jpeg; *.bmp; *.png"
  11.    .FilterIndex = 0
  12.    .InitialFileName = Environ("UserProfile") & "\My Documents\"
  13.    .InitialView = msoFileDialogViewThumbnail
  14.    .Title = "Resim Seç..."
  15.        If .Show = True Then
  16.            For Each SeciliNesne In .SelectedItems
  17.            DosyaAdi = SeciliNesne
  18.            Next SeciliNesne
  19.            Controls(alanadi) = DosyaAdi
  20.            Controls(cerceveadi).Picture = DosyaAdi
  21.        End If
  22. End With
  23.  
  24.  
  25. On Error Resume Next
  26.  
  27. asil = Controls(alanadi)
  28.  
  29. kopya = CurrentProject.Path & _
  30. "\\resim\" _
  31. & Me.PersonelNo & Me.Ad & Right(cerceveadi, 1) _
  32. & Right(Dir(asil), 4) 'Buradaki alan isimlerini kendinize göre güncelleyiniz..
  33.  
  34. Dim aa
  35. Set aa = CreateObject("Scripting.FileSystemObject")
  36.  
  37. aa.CopyFile asil, kopya
  38. Controls(alanadi) = kopya
  39. Controls(cerceveadi).Picture = kopya
  40. If MsgBox("Resim klasöre kopyalandı.. " _
  41. & "İlk dosyayı silmek ister misiniz?", vbYesNo, "Uyarı") = vbYes Then
  42. Kill asil
  43. End If
  44.  
  45. End Function





1366X768 PİKSEL E ÇEVİRİP KAYDETMESİNİ İSTİYORUM



  Alıntı
Bu mesajı beğenenler:
(05-10-2019, 19:46)e.karamanoglu demiş ki: 1366X768 PİKSEL E ÇEVİRİP KAYDETMESİNİ İSTİYORUM



İlk prosedürün bulunduğu kod sayfasına bu fonksiyonu haricen ekleyiniz:

Visual Basic
  1. Function ResmiBoyutlandir(DosyaYolu)
  2. Dim YResim As WIA.ImageFile, _
  3. trz As WIA.ImageProcess, Kopya As String
  4.  
  5. Kopya = DosyaYolu
  6. Set YResim = CreateObject("WIA.ImageFile")
  7. Set trz = CreateObject("WIA.ImageProcess")
  8.  
  9. YResim.LoadFile (Kopya)
  10. trz.Filters.Add (trz.FilterInfos("Scale").FilterID)
  11. trz.Filters(1).Properties("MaximumWidth").Value = 1366 'Genişlik
  12. trz.Filters(1).Properties("MaximumHeight").Value = 768 'Yükseklik
  13. Set YResim = trz.Apply(YResim)
  14.  
  15. If Not Dir(Kopya) = vbNullString Then Kill Kopya
  16. YResim.SaveFile (Kopya)
  17.  
  18. End Function




Editör menüsünden Tools-References- Microsoft Windows Image Acquisition Library vX.X seçeneğini klikleyiniz..

İlk prosedürün ilgili kısmında da fonksiyonu çağırabiliriz..:

Visual Basic
  1. '........
  2. '................
  3. '........................
  4.            Next SeciliNesne
  5.            Controls(alanadi) = DosyaAdi
  6.            Call ResmiBoyutlandir(DosyaAdi) 'BU KISMI İLAVE ETMELİSİNİZ..
  7.          Me.cerceve.Picture = DosyaAdi
  8.        End If
  9. End With
  10.  
  11. '........
  12. '................
  13. '........................




İlaveten şu bilgiyi de vereyim.. Metot istediğimiz yüksekliği baz alarak genişliği otomatik belirler..  Örneğin; resim 3264 x 2448 boyutlarındaysa 1366 x 768 e değil 1024 x 768 e küçültür..



  Alıntı
Bu mesajı beğenenler:
Teşekkür ederim emeğinize sağlık



  Alıntı
Bu mesajı beğenenler:


Benzer Konular...
Konu: Yazar Cevaplar: Gösterim: Son Mesaj
  Resim Dosya EkleME Saklama ve Gösterme (Sıfır kodla birkaç tıkla Form ve Rapor) Mehmet Eser 12 15.673 24-07-2014, 20:56
Son Mesaj: mengene
  Access açılırken resim belirlemek onur_can 4 2.392 15-07-2014, 22:25
Son Mesaj: mengene
  Sade Şık bir AVT için Alt Form yerine form üst bilgisi kullanımı Yeni Tasarım Mehmet Eser 2 2.500 02-06-2012, 08:01
Son Mesaj: furkan_68200

Foruma Git:


Bu konuyu görüntüleyen kullanıcı(lar): 4 Ziyaretçi