طلب مساعده في اكمال برنامج الالوان

الله المستعان

الاخت زهره والاخوات مشرفين المنتدي

وعليكم السلام اخي الفاضل

اكسس لا يمكنه ان "ياتي لي بعدد الالون المتواجده بالصوره" :(

اكسس برنامج قاعدة بيانات :)

ولكن ، لأن اكسس يملك قوة في VBA ، لذا فانه بامكاننا استخدام برامج اخرى تملك خاصية commandline بها ،

فمثلاً ، http://www.irfanview.com/ ، يملك هذه الخاصية (خاصية command line) ،

ولمعرفة عدد الوان الصورة 1.jpg المرفقة مع مثالك ، فالامر يكون هكذا من داخل برنامج الاكسس:

Dim a As String
a = "C:\Program Files\IrfanView\i_view32.exe" & " "
a = a & "c:\1.jpg /info=c:\test.txt"
ShellWait (a)

بحيث ان هذا الامر ينشئ ملف باسم test.txt ، ومحتوى هذا الملف:

[1.jpg]
File name = 1.jpg
Directory = 
Compression = JPEG, quality: 72, subsampling ON (2x2)
Resolution = 0 x 0 DPI
Image dimensions = 225 x 225  Pixels (1.00)
Print size = 7.9 x 7.9 cm; 3.1 x 3.1 inches
Color depth = 16,7 Million   (24 BitsPerPixel)
Number of unique colors = 18932
Disk size = 6.33 KB (6,481 Bytes)
Current memory size = 148.57  KB (152,140 Bytes)
File date/time = 07-Jan-14 / 20:09:28

والسطر المهم بالنسبة لك هو:

Number of unique colors = 18932

وبما ان الملف هو بصيغة txt ، فبامكانك ان تفتحه عن طريق اكسس وقراءة هذا السطر ، ومن ثم وضع عدد الالوان المتواجدة في الصورة 18932 ، في مربع نص :)

وهذا رابط الدلة  ShellWait:

http://access.mvps.org/access/api/api0004.htm

جعفر

اخير الكريم بارك الله فيك على المداخله 

اين لي ان اضع هذه الاكواد وفي اي مكان وحدات نمطيه ام في الفورم نفسه بارك الله فيك

ما شاء الله عليك ، مثل ما يقولون : ردك كان فرّيره :)

ضع ShellWait في module ،

بينما كود الاربعة اسطر والذي يبدأ بـ Dim a As String ، ضعه في النموذج :)

جعفر

عفوا اخي هل لي بان توضح لي على المثال المرفق بارك الله فيك حيث انني جربته ولم يفلح معي بارك الله فيك

هل نصبت البرنامج irfan view من الرابط الذي اعطيتك؟

اخي الكريم جعفر بارك الله بك جاري تحميل الملف irfan view

بعد التنصيب ، يمكنك ان تعمل نسخة من i_view32.exe وتضعه في اي مجلد ، ومن ثم استخدامه في اي كمبيوتر بدون تنصيب البرنامج كاملاً :)

للعلم ، انا استخدم هذا البرنامج منذ اكثر من 14 سنة ، ولا يوجد كمبيوتر استخدمه ، إلا وانصب هذا البرنامج عليه ، وذلك لإمكانياته الجبّارة :)

جعفر

نعم اخي تم بالفعل

عفوا ما فهمت قصدك :(

تم تحميل البرنامج ومن ثم تنم تنصيبه بتلك الصوره

ثم ظهر لي هذا الخطاء

بارك الله بك

اخي جعفر لماذا هذا الخطاء

تفضل :)

كما ان هناك برنامج آخر يخبرك عن عدد كل لون في الصورة ، ولكني لم اتعامل معه ، واليك رابطه وطريقة عرضه:

جعفر

120.amir.zip

هذا الخطأ بارك الله فيك ، لأنك لم تتبع خطواتي في المشاركة رقم 6 ، وانما خلطت الكودين في اماكن خطأ :(

استاذنا الفاضل : جعفر

السلام عليكم ورحمة الله وبركاته

وحياك الله بعد كل هذه الغيبة

سؤال موجه للأخ أمير

ما فائدة هذه الحقول في البرنامج الخاص بك !!!!

هل تريد فيما بعد استخراج رقم اللون عندما تضغط على اي لون في الصوره ؟؟؟؟

نرجو التوضيح

بالتوفيق

اهلاً بيك اختنا الفاضلة الدكتورة أم عهود :)

كنت مسافر ورجعت :)

راجعي هذا الرابط /index.php/topic/281848-%D9%85%D8%B3%D8%A7%D8%B9%D8%AF%D8%A9-%D9%81%D9%8A-%D8%A8%D9%86%D8%A7%D8%A1-%D9%87%D8%B0%D8%A7-%D8%A7%D9%84%D8%A8%D8%B1%D9%86%D8%A7%D9%85%D8%AC/

جعفر

نعم الاخت زهره عند الضغط على اي ماكن بالصورة توضح لي درجة اللون بارك الله بكم على تعاونكم معنا وجزاكم الله خير الجزاء

تفضل اخي الكريم

عند الضغط على اي مكان في الصوره ستظهر ارقام  RGB في اماكنها المخصصة حسب الكود التالي

Private Sub ImageFrame1_Click()
  On Error Resume Next
   Dim a As Long
   a = GetCursorPos(p)
   Me.Text1 = GetPixel(GetDC(0), p.X, p.y)
 
'احمر
   Me.Text24 = Me.Text1 Mod 256
'اخضر
   Me.Text26 = Int(Me.Text1 / 256) Mod 256
'ازرق
  Text28 = Int(Me.Text1 / 256 / 256)
End Sub

za-Amir.rar

بالتوفيق

انا بجد مش عارف اقول لحضرتك ايه غير ان ربنا يجعله في ميزان حسناتك  وياااااااااااااااارب يحفظك لينا

الاخت الفاضله تم التجربه بالفعل ونجاح المطلوب ولكن يوجد شيء بسيط جدا وهوا لماذا لم تفعلي 

Hue:

Sat:

Lum:

هل هذا الكود اضعه لجلب HSL

Private Sub ImageFrame1_Click()
  On Error Resume Next
   Dim a As Long
   a = GetCursorPos(p)
   Me.Text1 = GetPixel(GetDC(0), p.X, p.y)
 
'احمر
   Me.Text24 = Me.Text1 Mod 256
'اخضر
   Me.Text26 = Int(Me.Text1 / 256) Mod 256
'ازرق
  Text28 = Int(Me.Text1 / 256 / 256)
End Sub

amir_adam87 كتب:

 

هل هذا الكود اضعه لجلب HSL

Private Sub ImageFrame1_Click()
  On Error Resume Next
   Dim a As Long
   a = GetCursorPos(p)
   Me.Text1 = GetPixel(GetDC(0), p.X, p.y)
 
'احمر
   Me.Text24 = Me.Text1 Mod 256
'اخضر
   Me.Text26 = Int(Me.Text1 / 256) Mod 256
'ازرق
  Text28 = Int(Me.Text1 / 256 / 256)
End Sub

لا يا أخي الكريم

الـ  HSL هي عبارة عن الصفات الأساسية للون مثل (صبغة اللون -  صفاء اللون - اضاءة اللون - سطوع اللون - اشباع اللون  )  وليس اللون نفسه

H =  Hue  صبغة اللون

S = Saturation  صفاء اللون

L = Luminance  اضاءة اللون 

وهذه القيم تستخرج بمعادلات معقدة تم وضعها لك في الوحدة النمطية ويتم استدعاؤها بهذا الشكل

Private Sub ImageFrame1_Click()
  On Error Resume Next
   Dim a As Long
   Dim n As HSLCol
   a = GetCursorPos(p)
   Me.Text1 = GetPixel(GetDC(0), p.X, p.Y)
 
'أحمر
   Me.Text24 = Me.Text1 Mod 256
'أخضر
   Me.Text26 = Int(Me.Text1 / 256) Mod 256
'ازرق
  Text28 = Int(Me.Text1 / 256 / 256)
 
    n = RGBtoHSL(RGB(Me.Text24, Me.Text26, Me.Text28))
'Hue صبغة اللون
    Me.Text16 = n.Hue
'Luminance اضاءة اللون
    Me.Text20 = n.Lum
'Saturation صفاء اللون
    Me.Text22 = n.Sat
End Sub