xpredo script

العودة   نيو حب > منتديات الحاسب والاتصالات > تحميل برامج - برامج كامله - برامج مجانية > شرح البرامج - برامج مشروحه > فيجوال بيسك
التسجيل

تقنيات الرسم باستخدام فيجوال بيسك

فيجوال بيسك

28-04-2006, 05:05 PM
sweety byby
 
Thumbs up تقنيات الرسم باستخدام فيجوال بيسك

الرسم الى نافذه

يفتقد فيجول بيسك كثير من القدرات في مجال الجرافكس … و هذا ما يجعله محدود الامكانات في كثير من الاحيان … و لكن يوجد طريقة للوصول الى قدرات و يندوز في هذا المجال …باستدعاء ما نريده من واجهة برمجة ويندوز API .

فسنستخدم المكتبة الجاهزة لواجهة برمجة تطبيقات ويندوز API لأنها توفر علينا التعريفات التي يجب أن نعلن عنها أولاً … فمن المفروض أن نعرض كل ما يلي (باللون الاحمر) في ملف برمجه module … عموماً اذا لم تكن هذه المكتبة عندك أو أنك تريد أن تعرف بالفعل ما يحدث فالخطوات كما يلي … انشئ ملف برمجة …من قائمة مشروع Project اختر Add module ، و ضع فيه التعريفات التالية:


Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long

Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As Any, ByVal bErase As Long) As Long

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Const SRCCOPY = &HCC0020


لاحظ أنه يمكن الاستغناء عن هذه التعريفات لو استخدمنا مكتبة

‘Win32.tlb

ستحتاج ايضاً الى اطار Form و تضع عليه صندوق صورة Picture Box و صندوق قائمة ListBox

و شريط منزلق افقي Hscroll Box ..كما في الشكل :






اضبط الخاصية ScaleMode من حدول الخصائص للاطار و صندوق الصورة اللذين انشأناهما قبل قليل و أختر القيمة Pixels ، لآن واجهة برمجة و يندوز تعمل على نظام البكسل كنظام وحدات افتراضي لها .

في البداية سنحاول أن نرسم دائرة بالطريقة التي يستخدمها فيجول بيسك … و سنرسم على الاطار و على صندوق الصورة ، بساتخدام الطريقة


Form1.Circle (25, 25), 25
Picture1.Circle (25, 25), 25

و سيظهر لك كما في الشكل



تبدو دائرة عادية

يمكن رسم هذه الدائرة بطريقة أخرى باستخدام واجهة برمجة ويندوز باستخدام وظيفة رسم شكل بيضاوي Ellipse … (يسار و اعلى و يمين و اسفل ) ، لاحظ أن هذه و سوف تمرر للوظيفة الاحداثيات على شكل مستطيل الاحداثيات تعبر عن المستطيل الذي يحيط بالشكل البيضاوي الذي سنرسمه . في البداية نحصل على مقبض النافذة التي سنرسم عليها الآن يمكننا استدعاء Call وظيفة الرسم … (كل التحكمات الظاهرة تعتبر نوافذ) Hdc ،، و بالشكل:


Ellipse Form1.hdc, 0, 10, 50, 60
Ellipse Picture1.hdc, 0, 10, 50, 60


ستلاحظ أنه رسم دائرة أخرى تحت التي رسمناها بالطريقة الاولى

ملاحظة مهمة



استطاعت وظيفة فيجول بيسك أن ترسم دائرة على الاطار و على صندوق الصورة (لأن لها سياق أجهزة dc ضمن VB)… ولكن لن تستطيع أن ترسم على الشريط المنزلق الذي عملناه سابقاً… لكن على النقيض وظيفة رسم الشكل البيضاوي لواجهة برمجه و يندوز يمكنها أن ترسم الى أي شئ يمكن الحصول على مقبضه

MyhDC = GetDC(List1.hWnd) ‘ الحصول على سياق الاجهزة
Ellipse myHDC, 0, 0, 50, 50
Let myHDC = GetDC (HScroll1.hWnd)
Ellipse myHDC, 0, 0, 50, 50


في السطر الاول نستقبل مقبض سياق مرر له مقبض النافذه في المتغير myHDC … بعد الحصول على المقبض نبدأ الرسم ، كذلك بالنسبة للسطر الثالث و الرابع ، مع ملاحظة أنه سيرسم على الشريط المنزلق .

لاحظ أننا استطعنا الرسم الى أي شئ نعرف مقبضه ، بما فيها سطح المكتب ، فلكي نرسم عليه نضع المقبض بالقيمةة صفر … فيكون بالشكل:




MyHDC = GetDC(0)

Call Ellipse(myHDC, 0, 0, 50, 50)



اعمل فورم (نموذج) و أضف له مؤقت … و أضف ما يلي

Dim DiskTopDC

Dim MyPoint As POINTAPI

Private Sub Timer1_Timer()

Let myHDC = GetDC(0) ‘ نأخد سياق جهاز سطح المكتب لنرسم اليه

GetCursorPos MyPoint ‘ نحدد موقع المؤشر

Ellipse myHDC, MyPoint.X, MyPoint.Y, MyPoint.X + 50, MyPoint.Y + 50

End Sub


لاحظ أن هذا المثال يشوة سطح المكتب فنحتاج الى تنظيف الشاشة و هذا ما سنشرحه لاحقاً


عمل نسخ لجزء من الشاشة

افترض أنك رسمت صورة و تريد أن تنقل هذه الصورة الى أي جزء من النافذة ، توفر لك واجهة برمجة ويندوز وظيفة قوية لعمل ذلك . تدعى هذه الوظيفة Block Transfer و تختصر بـ blt و تلفظ بليت blit ، فتقوم بتحويل أو تحريك جزء معين من الشاشة في نفس الوقت , الوظيفة التي سنستدعيها هي BitBlt .

هذه الوظيفة تحتاج الى تسعة متغيرات لتمررها اليها ، الستة الاولى تحدد القياس و مكان البداية و النهاية للجزء الذي نريد أن نعمل عليه ، و قد يكون من الاسهل علينا أن نعينها الى متغيرات ليسهل التعامل معها لاحقاً … فنقول


x = 0
y = 0
nWidth = 50
nHeight = 50
xSrc = 0
ySrc = 0


المتغير الآخر الذي سنمرره هو متغير يحدد كيف ستتفاعل الصورة الاصلية بالنسبة للصورة التى نريدها في النهاية ، و في اغلب الاحيان ستكون الصورة النهائية هي نفسها الصورة الاولى ، و من ذلك يمكننا أن نعرف متغير يضم التعريف


dwRop=SRCCOPY

المتغيرين الاخيرين هما مقبض سياق النافذة الوجهة Destination و المصدر

DestDC = Form1.hdc
hSrcDC = GetDC(HScroll1.hWnd)

الآن عرفنا كل المتغيرات التي سنمررها و الآن دور الاستدعاء … بالشكل

BitBlt hDestDC, x, y, nWidth, nHeight, hSrcDC, xSrc, ySrc, wRop
ReleaseDC HScroll1.hWnd, hSrcDC



عندما تلاحظ جيداً في النتيجة .. سوف ترى أنه

تم نسخ الدائرة التي عملناها على الشريط (مصدر) المنزلق و وضعناها على الاطار(الوجهه)

و بامكانك ان تنسخ من أي جزي من النوافذ

و من ضمنها سطح المكتب

في المثال التالي سوف ننسخ الجزء الاعلى من سطح المكتب الى اطار برنامجنا



hSrcDC = GetDC(0)
nWidth = 200
nHeight = 200
BitBlt hDestDC, x, y, nWidth, nHeight,hSrcDC, xSrc, ySrc, dwRop
ReleaseDC 0, MyHDC



مع ملاحظة أننا عرفنا بعض المتغيرات هنا أما الباقية فنكمل و نعرفها كما سبق..

تنظيف الشاشة

عندما تنسخ بعض الصور و تغير أماكنها في ارجاء الشاشة تلاحظ أن مكانها السابق يضل كما كان و تتشوه الشاشة في احيان كثيرة بسبب الكتابة او الرسم على النوافذ … فعندما ينتهي ويندوز من نافذه مثلاً و لكي يزيل النافذه التي عرضها يقوم بنفسه بتنضيف ما عمله أو ما عرضه … ويكون ذلك بارسال رساله بان تنظف النافذة نفسها باستدعاء

InvalidateRect 0,0,0

فتقوم بتنظيف كل النوافذ على الشاشة

تحويل العمليات

يمكن عمل صوره غير مرئية و من ثم ارسالها أو نقلها الى نافذة مرئية و لكي يكون هذا النقل بشكل سلس يجب أن الصورة متوافقة مع سياق النافذة الهدف أو الوجهة فنستخدم الوظيفة CreateCompatibleBitmap ، سوف تخبر الوظيفة ما هو السياق الذي تريد الصورة أن تكون منوافقة معه و ما هو الحجم الذي تريد أن تكون عليه الصورة فيما بعد ، تقوم الوظيفة بانشاء الصورة و ترجع المقبض في متغير لاستخدامه لاحقاً

hBMP = CreateCompatibleBitmap(Form1.hdc,100,100)
اذا لم تستطع انشاء الصورة سوف تعود برقم صفر

أما في حالة اننا اردنا أن نرسم الى صورة غير مرئية يجب أن نحمله على حامل مسيق و لكن لا يمكننا أن نستخدم الوظيفة GetDC للحصول على سياق الصورة لآن الصورة ليست نافذة فبدل ذلك سوف ننشئ سياق متوافق باستخدام الوظيفة

hDestDC = CreateCompatibleDC(Form1.hdc)

اعط الوظيفة مقبض السياق الذي تريد أن يكون متوافق معه . و سيرجع القيمه صفر اذا لم يستطيع انشاء النافذة

الآن عندنا صورة متوافقة و سياق متوافق لكننا لم نحمل الصورة على السياق ، و لعمل ذلك استخدم الوظيفة SelectObject . و اعط الوظيفة المقبض الخاص السياق و المقبض الخاص بالصورة التي تريد أن تحملها عليه:

SelectObject hDestDC, hBMP

يعمل بالضبط كما لو أنك رسمت على النافذه (رسم للسياق فقط) سواء كانت الوجهة الحقيقية هي نافذة أو صورة . و يمكنك أن تنقل الصور باستخدام الوظيفة BitBlt و الرسم بوظيفة كـ Ellipse كما في الشكل التالي :

hSrcDC = GetDC(0)

BitBlt hDestDC, x, y, nWidth, nHeight, hSrcDC, xSrc, ySrc, dwRop

ReleaseDC 0, hSrcDC

Ellipse hDestDC, 0, 0, 50, 50

ومن الطبيعي أن لا ترى شيئاً حتى الآن ، و لكي تنقل الصورة الغير مرئية الى نافذة . اضبط مقابض السياقات الوجهة و المصدر …كما يلي:

hSrcDC = hDestDC
hDestDC = Form1.hdc
BitBlt hDestDC, x, y, nWidth, nHeight,hSrcDC, xSrc, ySrc, dwRop

الآن يمكنك مشاهدة ما عملت..

ازالة ما عملت

اذا نسيت أن تنهي استخدام المفبض الذي استخدمته ، سوف يكون البرنامج بطئ و يستهلك موارد النظام ، فلا أن تزيل الصورة التي انشأتها و كذلك المسيقات …لذلك نستخدم وظيفة الازالة و نمرر لها مقبض ما نريد انهائه:


DeleteDC hSrcDC
DeleteObject hBMP

امثلة

كما قلنا سابقاً يمكن الاستغناء عن هذه التعريفات (بالاحمر) و استخدام المكتبة أو نعرف كل المتغيرات و الاعلانات عن الوظائف التي سنستخدمها في البرنامج و التي سنستدعيها من واجهة برمجه ويندوز … فنعمل ملف برمجة module و نضع فيه ما يلي :


Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long

Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As Any, ByVal bErase As Long) As Long

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Const SRCCOPY = &HCC0020

و نعمل اطار و نضيف مؤقت و نضيف البرمجة التالية:


Private xMax As Long, yMax As Long

Private xSize As Long, ySize As Long

Private mySDC As Long, mySBM As Long

Private Const xCount = 15, yCount = 15

Private Sub Form_Click()

If Timer1 Then Call InvalidateRect(0, 0, 0)

Timer1 = Not Timer1

End Sub

Private Sub Form_Load()

Dim myDC As Long

MyMsg = MsgBox("اذا بغيت توقفه اضغط على الصوره بالفاره..أوكي؟؟", vbCritical, "خربانه خربانه", 0, ffd)

Let xMax = Screen.Width / Screen.TwipsPerPixelX

Let yMax = Screen.Height / Screen.TwipsPerPixelY

Let xSize = xMax / xCount

Let ySize = yMax / yCount

Let Top = 0

Let Left = 0

Let myDC = GetDC(0)

Let mySDC = CreateCompatibleDC(hdc:=myDC)

Let mySBM = CreateCompatibleBitmap(hdc:=myDC, nWidth:=xMax, nHeight:=yMax)

Call SelectObject(mySDC, mySBM)

Call BitBlt(hDestDC:=mySDC, x:=0, y:=0, nWidth:=xMax, nHeight:=yMax, hSrcDC:=myDC, xSrc:=0, ySrc:=0, dwRop:=SRCCOPY)

Call ReleaseDC(0, myDC)

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call InvalidateRect(0, 0, 0)

Call DeleteObject(hObject:=mySBM)

Call DeleteDC(hdc:=mySDC)

End Sub

Private Sub Timer1_Timer()

Dim xStart As Long, yStart As Long

Dim xEnd As Double, yEnd As Double

Dim myDC As Long

Dim i As Long

Let myDC = GetDC(0)

For i = 1 To 20 '`Loop to make run faster

Let xStart = Int(xCount Rnd) xSize

Let yStart = Int(yCount Rnd) ySize

Let xEnd = Int(xCount Rnd) xSize

Let yEnd = Int(yCount Rnd) ySize

Call BitBlt(hDestDC:=myDC, x:=xEnd, y:=yEnd, nWidth:=xSize, nHeight:=ySize, hSrcDC:=mySDC, xSrc:=xStart, ySrc:=yStart, dwRop:=SRCCOPY)

Next i

Call ReleaseDC(0, myDC)

End Sub


شغل البرنامج ثم راقب ما سيحصل

المثال الثاني

الشاشة الذائبة… سيدهشك هذا البرنامج بما سيعمل… انشئ اطار و ضع مؤقت و اضبط الوقت ثم اضف صندوق اختيار Check Box و لا تنسى عمل ملف برمجة كما فعلنا سابقاً و ذلك لاستدعاء وظائف ويندوز …و اخيراً انسخ ما يلي الى برنامجك



Dim xMax As Long, yMax As Long

Dim xSize As Long, ySize As Long

Private Sub Form_Load() 'Convert screen dimensions to pixels

Let xMax = Screen.Width / Screen.TwipsPerPixelX

Let yMax = Screen.Height / Screen.TwipsPerPixelY

Let xSize = xMax / 70 ' تقطيع عرضي

Let ySize = yMax / 1 ' كم من الشاشة تريد

Form1.Top = 0

Form1.Left = 0

End Sub

Private Sub Timer1_Timer()

Dim xStart As Double, yStart As Double

Dim xEnd As Double, yEnd As Double

Dim myDC As Long

Dim i As Long

Let myDC = GetDC(0)

For i = 1 To 200 'Speed things up with an inner loop

Let xStart = xMax Rnd 'Find random starting place

Let yStart = yMax Rnd

Let xEnd = xStart 'Calculate ending place

Let yEnd = yStart + ySize / 1000

If Check1 Then

Call Ellipse(hdc:=myDC, X1:=xStart, Y1:=yStart, X2:=xStart + xSize, Y2:=yStart + ySize)

Else

Call BitBlt(hDestDC:=myDC, x:=xEnd, y:=yEnd, nWidth:=xSize, nHeight:=ySize, hSrcDC:=myDC, xSrc:=xStart, ySrc:=yStart, dwRop:=SRCCOPY)

End If



Next iCall ReleaseDC(0, myDC) ' Give back DC handle

End Sub

Private Sub Form_Click()

‘ اعادة رسم الشاشة

If Timer1 Then Call InvalidateRect(0, 0, 0)

Timer1 = Not Timer1

'Toggle timer's Enabled property

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call InvalidateRect(0, 0, 0) 'Make windows repaint

End Sub


انشاء متصفح خاص


اذا كان متصفح مايكروسوفت من ضمن البرامج الموجودة في جهازك فان فيجول بيسك يوفر لك امكانية عمل متصفح كامل الوظائف بسطر أوامر واحد ، و يحوي التصفح للأمام و الرجوع و أيضاً قائمة بما تمت زيارته





السر وراء عمل المتصفح هي المكتبة SHDOCVW.DLL التي توفر طرق و خصائص يمكن من خلالها عمل متصفحنا

أضف الأدآة "متصفح ويب " و لكي تضيفها الى شريط الادوات … اذهب لقائمة مشروع ثم مكونات

Project->Component …. ثم اختر Microsoft Internet Controls ثم اضغط موافق ، بعدها ستجدها على شريط الادوات

الآن اضغط على هذه الادآة مرتين لاضافتها الى النمودج (الفورم) وستظهر كما يلي



الآن اضغط مرتين على الفورم لنضيف الكود في حدث باية تحميل الفورم Form_Load

و أضف السطر التالي

WebBrowser1.Navigate “www.cnn.com”

طبعاً … يمكنك وضع أي موقع تريد

حتى لو صفحة أو ملف على الجهاز

الآن شغل البرنامج و لاحظ

لقد تم عرض الصفحة

الآن نريد أن نضيف صندوق يضيف فيه المستخدم العناوين و أيضاً تضم ما تمت زيارته في السابق




أضف ادآة قائمة كمبو Combo

الآن سنضيف كود لحادثة النقر على هذه الادآة Combo1_Click لاتاحة الاختيار للمستخدم منها

فاذا اختر احدها نأخذ العنوان الموجود في القائمة و نجعل أدآة مستعرض الويب أن تفتحها

Private Sub Combo1_Click()

WebBrowser1.Navigate (Combo1.Text)

End Sub

لكن لاحظ أنه بعض الاحيان يكتب المستخدم ما يريد ثم يضغط مفتاح الادخال لكي يتم عرضه . و لكي نفعل ذلك … اذا ضغط المستخدم مفتاح الادخال (على الكمبو) فنأخذ المدخلات على نص الكمبو و نمررها لأدآة المستعرض … كما يلي:

Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Combo1_Click
End If
End Sub
و أخيراً… سوف نضيف الكود الذي يضع المواقع التي تمت زيارتها في القائمة. فعندما تعرض أدآة المستعرض أي صفحة نطبق حدث قبل الاستعراض …كما يلي

Private Sub WebBrowser1_BeforeNavigate(ByVal URL As String, _
ByVal Flags As Long, ByVal TargetFrameName As String, _
PostData As Variant, ByVal Headers As String, Cancel As Boolean)

Dim strURL As String
strURL = URL
Dim bFound As Boolean
Dim i As Integer

For i = 0 To Combo1.ListCount - 1
If Combo1.List(i) = strURL Then
bFound = True
Exit For
End If
Next i

If Not bFound Then
Combo1.AddItem strURL
End If

Combo1.Text = strURL

End Sub






نريد الآن أن نضيف زرين للرجوع للخلف للصفحة التي تم عرضها آخر مرة و الآخر للصفحة التالية و توفر أدآة الاستعراض خطوتين Procedure لعمل ذلك GoBack و GoForward … فنضيف زرين كما يلي:

ففي كود زر التقدم للامام نضيف ما يلي

WebBrowser1.GoForward

و زر العودة للخلف

WebBrowser1.GoBack

هذا كل ما في الامر و تستطيع أن تضيف لمساتك الخاصة له و أيضاً قد تعمل متصفح بشروط خاصة كأن توزعه مع منتج و لا يعرض هذا المتصفح الا موقعك أو حتى متصفح لا يعرض بعض الصفحات التي يوجد بها بعض الكلمات الغير مرغوب بها … و كهذا


===========================
====================
=============

كيف أضع متغير في ملف؟

ان وضع متغير في ملف في عرف بعض المبرمجين هي طريقة غير عمليه ولكن في الواقع ان هذا الأسلوب قد يفي بالعديدمن الأغراض ومنها على سبيل المثال حفظ اعدادت الواجهه واستعادتها في التشغيل القادم للبرنامج.

وفي نظام ويندوز ظهرت ملفات الإعدادات ini وللتبسيط سنذكر مثالا بسيطا لوضع متغير في ملف

dim MyVar as Integer

Open MyFile for output as #1

print #1,MyVar

close #1
من مواضيع : sweety byby سلسلة تعليم الفيجوال بيسك كيفية تحريك الاشياء فى بيئة فجوال بيسك
حيل للفيجوال بيسك
شرح واجهة المستخدم لفيجوال بيسك 6
سلسلة تعليم الفيجوال بيسيك ضبط محتويات الفورمة من حيث موقعها بواسطة الكود
الفيجوال بيسك ودورة التحكم
01-01-2010, 08:02 PM
الأهلاوي دائما
 
شكرا
من مواضيع : الأهلاوي دائما
 

الكلمات الدلالية (Tags)
الرسم, باستخدام, بيزك, تقنيات, فيجوال

أدوات الموضوع

الانتقال السريع

المواضيع المتشابهه
دروس تعليم الرسم على الزجاج.........( عندما يذوب الضوء عشقاً فى الألوان)
دروس فيجوال بيسيك للمبتدئين
رسم الجداريات....شرح لم يشرحه أحد قبلى . حصرياً
الرسم وسيلة تواصل عند الأطفال
ادوات الرسم وكيفية استخدامها

تقنيات الرسم باستخدام فيجوال بيسك

الساعة الآن 07:28 PM.