منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب - قسم مكتبة أكواد vb6.0

كيفية برمجة لعبة water sort كود

Sat, 14 Jun 2025 09:46:35 +0000

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

هل من مجيب

[VB6] أريد مساعدتكم في كتابة كود برمجي

Sat, 17 Jun 2023 14:36:26 +0000

في الكود التالي : لغة البرمجة VB6

Adodc1.RecordSource = "select * from INFO where name='" & Text1.Text & "' and city='" & Text2.Text & "' and date >= #" & Text3& "# and date <= #" & Text4& "#"
Adodc1.CommandType = adCmdText
Adodc1.Refresh

Text أداة تيكست بوكس
Text1 , text2 , Text3 ,Text4

INFO اسم الجدول
name . city . date اسماء الأعمدة

أرجو مساعدتي في تعديل الكود بحيث تظهر النتائج حسب التصفية في DataGrid كمايلي :
مثلا :
في TEXT1 البحث حسب الاسم عند كتابة اسم احمد ارغب ان تكون التصفية حسب الحرف أ ثم أح ثم أحم ثم أحمد
TEXT2 البحث حسب المدينة . نفس الشيء

سؤال آخر
عند كتابة الكود التالي للبحث بين عمودين رقميين على النحو التالي يظهر الكود بلون أحمر
حاولت عدة مرات معرفة الخطأ ولم أتمكن

Adodc3.RecordSource = " select * from INFO where NUMBER like '" & Combo7 & "*'" And NUMBER2 Like '" & Combo8 & "*'"

لكم الشكر الجزيل

تقرير كل سجل في صفحة

Wed, 14 Dec 2022 19:33:21 +0000

السلام عليكم
صممت نظام كهرباء والآن في أحد العملاء اصر بأن تظهر كل فاتورة في ورقة
فما العمل
حيث وأن انا شغال VB6 , و داتا ريبورت
ارجو الرد مستعجل

تفعيل كود sleep

Sat, 09 Jul 2022 02:32:38 +0000

PHP كود :
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 

او ممكن تجعله public في موديول او كلاس
هذا للتوثيق وليس لانه جديد.
كل عام و انتم بخير.

ارجو المساعدة في كود يبحث عن صورة على الجهاز

Tue, 23 Feb 2021 18:24:53 +0000

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

هل فكرت بتزوير الاكواد؟

Sat, 19 Dec 2020 20:59:28 +0000

PHP كود :
kfyorx ild(71) zh hgirmt
kfyorx ildv(73) zh hgirmt
kfyorx ildm(89) zh hgirmt
kfyorx hfy zwwildh()
ild(9) = "ي"
ild(8) = "و"
ild(7) = "ه"
ild(6) = "ن"
ild(5) = "م"
ild(4) = "ل"
ild(3) = "ك"
ild(2) = "ق"
ild(1) = "ف"
ild(0) = "غ"
ild(89) = "ع"
ild(88) = "ظ"
ild(87) = "ط"
ild(86) = "ض"
ild(85) = "ص"
ild(84) = "ش"
ild(83) = "س"
ild(82) = "ز"
ild(81) = "ر"
ild(80) = "ذ"
ild(79) = "د"
ild(78) = "خ"
ild(77) = "ح"
ild(76) = "ج"
ild(75) = "ث"
ild(74) = "ت"
ild(73) = "ب"
ild(72) = "ا"
vmw hfy

kfyorx hfy zwwildhv()
ildv(9) = "z"
ildv(8) = "y"
ildv(7) = "x"
ildv(6) = "w"
ildv(5) = "v"
ildv(4) = "u"
ildv(3) = "t"
ildv(2) = "s"
ildv(1) = "r"
ildv(0) = "q"
ildv(89) = "p"
ildv(88) = "o"
ildv(87) = "n"
ildv(86) = "m"
ildv(85) = "l"
ildv(84) = "k"
ildv(83) = "j"
ildv(82) = "i"
ildv(81) = "h"
ildv(80) = "g"
ildv(79) = "f"
ildv(78) = "e"
ildv(77) = "d"
ildv(76) = "c"
ildv(75) = "b"
ildv(74) = "a"
vmw hfy

kfyorx hfy zwwildhm()
ildm(9) = "9"
ildm(8) = "8"
ildm(7) = "7"
ildm(6) = "6"
ildm(5) = "5"
ildm(4) = "4"
ildm(3) = "3"
ildm(2) = "2"
ildm(1) = "1"
ildm(0) = "0"
vmw hfy 

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

الموديول السابق هل يمكن اعادته لطبيعته؟

والفورم ايضا او اكواده التالي

PHP كود :
wrn ild7(71) zh hgirmt
wrn ivm(73) zh hgirmt
wrn ildm7(89) zh hgirmt
wrn ulfmw zh rmgvtvi
wrn vulfmwv zh rmgvtvi
wrn ulfmwm zh rmgvtvi

kirezgv hfy il()
wrn n zh rmgvtvi
n = 9
wrn fy zh rmgvtvi
fy = fylfmw(ild)
wrn oy zh rmgvtvi
oy = oylfmw(ild)
uli r = (fy - 8) gl 9 hgvk -8
ild7(n) = ild(r)
n = n + 8
mvcg
vmw hfy

kirezgv hfy ilv()
wrn n zh rmgvtvi
n = 9
wrn fyv zh rmgvtvi
fyv = fylfmw(ildv)
wrn oy zh rmgvtvi
oy = oylfmw(ildv)
uli r = (fyv - 8) gl 9 hgvk -8
ivm(n) = ildv(r)
n = n + 8
mvcg
vmw hfy

kirezgv hfy ilm()
wrn n zh rmgvtvi
n = 9
wrn fyv zh rmgvtvi
fyv = fylfmw(ildm)
wrn oy zh rmgvtvi
oy = oylfmw(ildm)
uli r = (fyv - 8) gl 9 hgvk -8
ildm7(n) = ildm(r)
n = n + 8
mvcg
vmw hfy

kirezgv ufmxgrlm urmw(u zh hgirmt) zh yllovzm
uli r = 9 gl (fylfmw(ild) - 8)
ru ild(r) = u gsvm
ulfmw = r
urmw = gifv
vcrg uli
vcrg ufmxgrlm
vmw ru
mvcg
vmw ufmxgrlm

kirezgv ufmxgrlm vurmwv(u zh hgirmt) zh yllovzm
uli r = 9 gl (fylfmw(ildv) - 8)
ru ildv(r) = u gsvm
vulfmwv = r
vurmwv = gifv
vcrg uli
vcrg ufmxgrlm
vmw ru
mvcg
vmw ufmxgrlm

kirezgv ufmxgrlm urmwm(u zh hgirmt) zh yllovzm
uli r = 9 gl (fylfmw(ildm) - 8)
ru ildm(r) = u gsvm
ulfmwm = r
urmwm = gifv
vcrg uli
vcrg ufmxgrlm
vmw ru
mvcg
vmw ufmxgrlm

kirezgv hfy xnwzylfg_xorxp()
gvcg8.gvcg = "ÃßÈÎÌ ÙÒÈÞ íÍØÛíÛÇ æíÙÌ ÙÒÈÞ  ÒÕÈ ÐÇ ÌËåÞì ÐÇãÈíÍ æÇÙÎ ÍÎÍ íÍÒÛæ 7987 - 7979 ÛÏÌ íÍÒÕÈÇÉ 78"
vmw hfy

kirezgv hfy xnwx_xorxp()
xorkylziw.xovzi
gvcg8.gvcg = ""
vmw hfy

kirezgv hfy xnwxlkb_xorxp()
ru girn(gvcg8.gvcg) <> "" gsvm
xorkylziw.xovzi
xorkylziw.hvggvcg (gvcg8.gvcg)
vmw ru
vmw hfy

kirezgv hfy xnwkzhgv_xorxp()
ru girn(xorkylziw.tvggvcg) <> "" gsvm
gvcg8.gvcg = xorkylziw.tvggvcg
vmw ru
vmw hfy

kirezgv hfy xnwilgzgv_xorxp()
wrn zoo zh hgirmt
zoo = ""
uli r = 8 gl (ovm(gvcg8.gvcg))
wrn g zh hgirmt
g = nrw(gvcg8.gvcg, r, 8)
ru urmw(g) = gifv gsvm
zoo = zoo & ild7(ulfmw)
vohvru vurmwv(oxzhv(g)) = gifv gsvm
zoo = zoo & ivm(vulfmwv)
vohvru urmwm(g) = gifv gsvm
zoo = zoo & ildm7(ulfmwm)
vohv
zoo = zoo & g
vmw ru
mvcg
gvcg8.gvcg = zoo
vmw hfy

kirezgv hfy ulin_olzw()
ru zkk.kivermhgzmxv = gifv gsvm vmw
xzoo zwwildh
xzoo zwwildhv
xzoo zwwildhm
xzoo il
xzoo ilv
xzoo ilm
vmw hfy 

ماهي الفكرة؟

برنامج اضافي يعمل بشروط معينة او كلاس تطلب المستفيد اضافته وتشغيله!

حبيت اضيف حاجة بسيطة هذا اليوم

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

البحث في المصفوفة vb6.0 (من الصعب الى السهل)

Sun, 08 Nov 2020 00:13:48 +0000

بسم الله الرحمن الرحيم

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

كنت سابقا استخدم:

PHP كود :
Private Function found(uname As String) As Boolean
Dim i As Integer
For i = 0 To UBound(arr)
If arr(i) = uname Then
found = True
Exit Function
End If
Next
found = False
End Function 

لكن الاسهل :

PHP كود :
Private Function find(uname As String) As Boolean
find = InStr(Join(arr), uname)
End Function 

كامل الكود الخاص بالفورم:

PHP كود :
Dim arr(5) As String
Private Function found(uname As String) As Boolean
Dim i As Integer
For i = 0 To UBound(arr)
If arr(i) = uname Then
found = True
Exit Function
End If
Next
found = False
End Function
Private Sub cmdseach_Click()
MsgBox found(Text1.Text)
End Sub
Private Sub Form_Load()
arr(0) = "سعود"
arr(1) = "علي"
arr(2) = "ماضي"
arr(3) = "ناجح"
arr(4) = "عارف"
arr(5) = "hindi"
End Sub
Private Function find(uname As String) As Boolean
find = InStr(Join(arr), uname)
End Function 

طلب كود ضرورى

Tue, 16 Jun 2020 20:31:33 +0000

السلام عليكم

رجاء ... اريد كود عمل برنامج حساب الجمل للاحرف , واكون شاكر لكم .

برمجةالاداة combobox مع الاداة Adodc لللبحث و الاستعراض من قاعدة البيانات

Mon, 04 May 2020 21:23:32 +0000

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

الكود الاول : يتم من خلاله تحميل محتويات حقل معين مثلا UserName من قاعدة البيانات مرتبطة بالاداة Adodc1 الى الاداة Combo1 نضع الكود في حدث form1_load

Do Until Adodc1.Recordset.EOF
Combo1.AddItem Adodc1.Recordset.Fields!UserName
Adodc1.Recordset.MoveNext
Loop
Adodc1.Recordset.MoveFirst

الكود الثاني : يبحث عن المعلومة في قاعدة البيانات حسب الجدول و الحقل من خلال اختيار الاسم من الاداة Combo1 نضع الكود في حدث combo1_click

Dim x As String
x = Combo1.Text

Adodc1.RecordSource = "select * from users where username like '" & x & "%'"
Adodc1.CommandType = adCmdText
Adodc1.Refresh
If Adodc1.Recordset.EOF Then
Adodc1.RecordSource = "select*from users"
Adodc1.CommandType = adCmdText
Adodc1.Refresh
MsgBox "لايوجد مستخدم بهذا الاسم", , "تنبيه"

End If

اخوكم : علاء ابو زينب اللهيبي - العراق- نسألكم الدعاء

فتح وغلق الكتابه فى تكست

Fri, 04 Oct 2019 20:40:38 +0000

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

هذه اولى مشاركاتى فى المنتدى

ارجو ان الكود ينال اعجاب الجميع

بحثت كثيرا على طريقه ولم اجد سوى هذالكود وللعم الكود منقول ولاكن مع بعض التعديلات منى

اتمنا ان يكون هناك تطوير للكود لكى يعمل على جميع الادوات فى الفيجوال

يوجد مثال بسيط ولمن يريد التطوير ارجو ان داخل نفس الموضوع

فتح وغلق الكتابه فى تكست.rar (الحجم : 4.95 ك ب / التحميلات : 93)

A simple Wait Function

Sat, 17 Aug 2019 11:40:28 +0000

كود :
'**************************************

'Windows API/Global Declarations for :A simple Wait Function

'**************************************

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long

كود :
            '**************************************

' Name: A simple Wait Function

' Description:Ur code waits for X seconds without stopping complete VB like most others (incl. Sleep Api)

' By: PrixM (from psc cd)

'

' Assumes:'Set the API Declaration and the Code into a Module

'to use the function Wait(x) x stands for the amount of seconds to wait

'**************************************

Public Function Wait(ByVal TimeToWait As Long) 'Time in seconds

 Dim EndTime As Long

 EndTime = GetTickCount + TimeToWait * 1000 '* 1000 Cause u give seconds and GetTickCount uses Milliseconds

 Do Until GetTickCount > EndTime

DoEvents

 Loop

End Function

A KeyCode to Strings Converter

Sat, 17 Aug 2019 11:38:05 +0000

كود :
            '**************************************

' Name: A KeyCode to Strings Converter

' Description:It is a function that converts keycodes like those used in _KeyDown events, to strings like "Ctrl", "Alt", "F", "/", which are recognizable to the end-user. Great for game programmers.

' By: Alexander Chia (from psc cd)

'

' Inputs:KeyCode as Integer

'

' Returns:KeyStr as String

'

' Assumes:If the user presses Shift+3, the function will not return "#", but will return "3" instead. It also uses easily recognizable symbols to represent certain keys, e.g "~" instead of "`", "\" instead of "|", and "Pg Dn", "Enter", "Space", to represent other keys.

'

' Side Effects:If a key inputted does not match with any of the strings listed, the string returned will be "!".

'**************************************

Public Function KeyStr(KeyCode As Integer) As String

 'Copyright Alexander Chia Yan Sheng

 Select Case KeyCode

 Case 65 To 90

KeyStr = Chr(KeyCode)

 Case 48 To 57

KeyStr = Chr(KeyCode)

 Case 13

KeyStr = "Enter"

 Case 9

KeyStr = "Tab"

 Case 112 To 123

KeyStr = "F" & LTrim(Str(KeyCode - 111))

 Case 27

KeyStr = "Esc"

 Case 192

KeyStr = "~"

 Case 187

KeyStr = "="

 Case 189

KeyStr = "-"

 Case 219

KeyStr = "["

 Case 220

KeyStr = "\"

 Case 221

KeyStr = "]"

 Case 186

KeyStr = ";"

 Case 222

KeyStr = "'"

 Case 188

KeyStr = ","

 Case 190

KeyStr = "."

 Case 191

KeyStr = "/"

 Case 16

KeyStr = "Shift"

 Case 20

KeyStr = "Caps Lock"

 Case 144

KeyStr = "Num Lock"

 Case 145

KeyStr = "Scr Lock"

 Case 17

KeyStr = "Ctrl"

 Case 18

KeyStr = "Alt"

 Case 32

KeyStr = "Space"

 Case 45

KeyStr = "Ins"

 Case 46

KeyStr = "Del"

 Case 33

KeyStr = "Pg Up"

 Case 34

KeyStr = "Pg Dn"

 Case 8

KeyStr = "Back"

 Case 36

KeyStr = "Home"

 Case 35

KeyStr = "End"

 Case 37

KeyStr = "Left Arrow"

 Case 38

KeyStr = "Up Arrow"

 Case 39

KeyStr = "Right Arrow"

 Case 40

KeyStr = "Down Arrow"

 Case 106

KeyStr = "* [Num Pad]"

 Case 107

KeyStr = "+ [Num Pad]"

 Case 111

KeyStr = "/ [Num Pad]"

 Case 109

KeyStr = "- [Num Pad]"

 Case Else

KeyStr = "!"

 End Select

End Function

a AutoComplete Very Simple!

Sat, 17 Aug 2019 11:36:50 +0000

كود :
                '**************************************

' Name: a AutoComplete Very Simple!

' Description:VERY SIMPLE cut and paste funtion for the Keypress event of a combobox. Just paste this code into a module or form and call the function from the KeyPress event. KeyAscii = AutoComplete(cboCombobox, KeyAscii,Optional UpperCase)

' By: ( . Y . ) (from psc cd)

'**************************************

Option Explicit

Public Const CB_FINDSTRING = &H14C

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Function AutoComplete(cbCombo As ComboBox, sKeyAscii As Integer, Optional bUpperCase As Boolean = True) As Integer

 Dim lngFind As Long, intPos As Integer, intLength As Integer

 Dim tStr As String

 With cbCombo

 If sKeyAscii = 8 Then

 If .SelStart = 0 Then Exit Function

 .SelStart = .SelStart - 1

 .SelLength = 32000

 .SelText = ""

 Else

 intPos = .SelStart '// save intial cursor position

 tStr = .Text '// save string

 If bUpperCase = True Then

 .SelText = UCase(Chr(sKeyAscii)) '// change string. (uppercase only)

 Else

 .SelText = UCase(Chr(sKeyAscii)) '// change string. (leave case alone)

 End If

 End If

 lngFind = SendMessage(.hwnd, CB_FINDSTRING, 0, ByVal .Text) '// Find string in combobox

 If lngFind = -1 Then '// if string not found

 .Text = tStr '// set old string (used for boxes that require charachter monitoring

 .SelStart = intPos '// set cursor position

 .SelLength = (Len(.Text) - intPos) '// set selected length

 AutoComplete = 0 '// return 0 value to KeyAscii

 Exit Function

 Else '// If string found

 intPos = .SelStart '// save cursor position

 intLength = Len(.List(lngFind)) - Len(.Text) '// save remaining highlighted text length

 .SelText = .SelText & Right(.List(lngFind), intLength) '// change new text in string

 '.Text = .List(lngFind)'// Use this instead of the above .Seltext line to set the text typed to the exact case of the item selected in the combo box.

 .SelStart = intPos '// set cursor position

 .SelLength = intLength '// set selected length

 End If

 End With

End Function

vb6.0 App_path and filename

Wed, 17 Jul 2019 20:04:58 +0000

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

PHP كود :
Private Function App_path(fpath As String) As String
Dim pn As Integer
pn = InStrRev(fpath, "\")
If pn > 0 Then
App_path = Left$(fpath, pn)
End If
End Function
Private Function GFilename(fpath As String) As String
Dim pn As Integer
pn = InStrRev(fpath, "\")
If pn > 0 Then
GFilename = Replace(fpath, Left$(fpath, pn), "")
End If
End Function 

فقط للتذكير والتدوين.
تحيااتي

ااااااااخ بس الامر ابسط من كذا بكثييير بس بشوية تفكير .

عمل رسالة بالفيجوال بيسك واذا كان فيه زرين كيف عمل لهم كود برمجي

Fri, 27 Jul 2018 22:46:29 +0000

كود عمل رسالة بالفيجوال بيسك
msgbox ("الرسالة",نوع الرسالة,"عنوان الرسالة")
حط مكان نوع الرسالة اي نوع من االلي جايين دول
انواع الرسائل
vbAbortRetryIgnore اي تضع لك بالرسالة ثلاث ازرار هم احباط واعادة محاولة و الغاء الامر
vbApplicationModal اي تضع لك الرسالة على نمط البرنامج ( اي ليس لها علاقة بالويندوز)
vbCritical وهي لوضع ايقونة خطأ اي × في رسالتك
vbDefaultButton1 لجعل الزر الافتراضي الذي يكون محدد فور ظهور السالة هو الزر الاول
vbDefaultButton2 لجعل الزر الافتراضي الذي يكون محدد فور ظهور السالة هو الزر الثاني ( لكن بالطبع يجب ان يكون عندك رسالة فيها اكثر من زرين)
vbDefaultButton3 لجعل الزر الافتراضي الذي يكون محدد فور ظهور السالة هو الزر الثالث ( لكن بالطبع يجب ان يكون عندك بالرسالة فيها اكثر من 3 ازرار)
vbDefaultButton4 لجعل الزر الافتراضي الذي يكون محدد فور ظهور السالة هو الزر الرابع ( لكن بالطبع يجب ان يكون عندك بالرسالة فيها اربع ازرار حصراً )
vbExclamation وهي لوضع ايقونة تحذير التي تأتي بمثلث اصفر وفيها ! في رسالتك
vbInformation وهي لوضع ايقونة معلومات الي تأتي بدائرة زرقاء وفيها ! في رسالتك
vbMsgBoxHelpButton اي لتضع لك بالرسالة زر المساعدة "Help" وانت تحدد الكود الذي يظهر عند الضغط عليه ....الخ
vbMsgBoxRight يجعل نص الرسالة من اليمين الى اليسار
vbMsgBoxRtlReading تجعل الازرار و زر × على اليسار
vbMsgBoxSetForeground وهي لجعل صندوق ال رسالة في المقدمة
vbOKCancel تجعل في رسالتك زرين هما موافق و الغاء الامر
vbOKOnly تجعل في رسالتك زر واحد فقط وهو موافق
vbQuestion وهي لوضع ايقونة استفهام التي تاتي في دائرة زرقاء وفيها ؟ في رسالتك
vbRetryCancel تجعل في رسالتك زرين هما اعادة المحاولة و الغاء الامر
vbSystemModal تجعل الرسالة على مستوى النظام
vbYesNo تجعل في رسالتك زرين هما نعم ولا
vbYesNoCancel تجعل في رسالتك ثلاث ازرار هم نعم ولا
وتقدر تشيل علامتين التنصيص بس تحط نص عنصر زي مثلا textbox1.text
طبعا هتقولي ازاي هحط كود برمجي لو كان عندي زرارين
سهلة تقول
if msgbox.a then b
ضع مكان a في النص البرمجي السابق الزر اللي لو انت ضغط عليه حيصل B
وB حتحط الحدث اللي هيحصل لو ضغط علي a

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