منتديات الابداع البرمجي
بسم الله الرحمن الرحيم

اذا كنت مسجل مسبقا في المنتدى نرجوا ان تقوم بتسجيل دخولك للمنتدى وان لم تكن مسجل فتستطيع التسجيل في المنتدى
شكرا



 
الرئيسيةالبوابةس .و .جبحـثقائمة الاعضاءالمجموعاتالتسجيلدخول
شاطر | 
 

 اكواد الفيجوال بيسك 6

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل 
كاتب الموضوعرسالة
Admin
عضو فعال
عضو فعال


عدد المساهمات: 203
نقاط: 2147483647
السٌّمعَة: 9
تاريخ التسجيل: 13/04/2009

مُساهمةموضوع: اكواد الفيجوال بيسك 6   الإثنين أبريل 13, 2009 7:40 pm

اكواد فيجوال بيسك 6


اكواد رياضيات




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

Dim a
A = val(text1.text)
Text2.text = a*a


كود ايجاد مساحة المستطيل والمربع

Dim a,b
A = val (text1.text)
B = val (text2.text)
Text3.text = a*b

كود الة حاسبة
Dim A,B
A=Val(Text1.text)
B=Val(Text2.text)
If Option1.Value=True Then
Text3.Text=A + B
End if
If Option2.Value=True Then
Text3.Text=A - B
End if
If Option3.Value=True Then
Text3.Text=A * B
End if
If Option4.Value=True Then
Text3.Text=A / B
End if


اكواد الكتابة والصور


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

If KeyCode = vbKeyUp Then
Image1.Top = Image1.Top - 10
End If
If KeyCode = vbKeyDown Then
Image1.Top = Image1.Top + 10
End If
If KeyCode = vbKeyRight Then
Image1.Left = Image1.Left + 10
End If
If KeyCode = vbKeyLeft Then
Image1.Left = Image1.Left - 10
End If




كود لتصحيح الاخطاء الكتابية

ملاحظة يجب ان تملك معالج نصوص

Private Sub Command1_Click()

Dim objWord
Dim tmpObjWord
Dim strResults

' Only continue if user has typed text into the text box.
If Len(Text1.Text) < 1 Then Exit Sub

Set tmpObjWord = CreateObject("Word.Application")
' check if there are any spelling errors.
If tmpObjWord.CheckSpelling(Text1.Text) Then
MsgBox "The text spelled correctly"
' free memory
Set tmpObjWord = Nothing
' exit sub - No spelling errors are found.
Exit Sub
End If

'free memory
Set tmpObjWord = Nothing
Set objWord = CreateObject("Word.Application")
With objWord
' hide the Word application
.Visible = False
' Spell checker only works within a document
.Documents.Add

' Put the text in the document
.Selection.TypeText Text1.Text

' disallow grammer checking. To allow it set it to "True"
.Options.CheckGrammarWithSpelling = False
.Options.IgnoreUppercase = False

' Perform the spell checking
.ActiveDocument.CheckSpelling

' Select the new, corrected text
.Selection.WholeStory

' Copy Corrected text to Clipboard
.Selection.Copy

' strResults holds the text after the spell corrections
strResults = .Selection.Text

' close and free memory
.ActiveDocument.Close (0)
.Quit
End With

Set objWord = Nothing
' retrieve the corrected text from the clipboard
Text1.Text = Clipboard.GetText
End Sub




انشاء ملف وورد من برنامج

Private Sub Command1_Click()
Dim objWord As New Word.Application

'-- Show Microsoft Word
' if you want to hide it, replace
' the "True" below with "False"
objWord.Visible = True

'-- Add new Document
objWord.Documents.Add

'-- Add text to Document
objWord.Selection.TypeText "This is the text VB-Town.com"

'-- Select all Text
objWord.Selection.WholeStory

'-- Change Font Size
objWord.Selection.Font.Size = 50

'-- uncomment the following line to change the font color
'objWord.Selection.Font.Color = wdColorRed

'-- uncomment the following line if you want
'-- to prompt the user to save the document
' objWord.Documents.Save

'-- uncomment the following line if you want to
'-- print the document
'objWord.PrintOut
Set objWord = Nothing
End Sub


طباعة صورة

Private Sub Command1_Click()
' replace all "Picture1" below with name of the Picture Box or
' other control that you want to print its picture.
' replace the "0, 0" below with the coordinates of the picture
' on the printed paper. "0, 0" will print the picture in the
' upper left corner. If you want to print the picture where
' the printer's head is currently found, instead of "0, 0"
' use "Printer.CurrentX, Printer.CurrentY" (if you printed text
' and then you'll print the picture with the
' "Printer.CurrentX, Printer.CurrentY" coordinates, the picture
' will be printed immediately after the text).
' If you want to enlarge or to reduce the size of the picture,
' replace the "Picture1.Width, Picture1.Height" with your
' desirable picture width and height.
' for example: "Picture1.Width * 2, Picture1.Height * 2"
' will print the picture in double size, and:
' "Picture1.Width * 0.5, Picture1.Height * 0.5"
' will print the picture in half size.
Printer.PaintPicture Picture1.Picture, 0, 0, _
Picture1.Width, Picture1.Height
' use the EndDoc command if the picture is the last item you want
' to print on the paper
Printer.EndDoc
End Sub



طباعة نص

Private Sub Command1_Click()
' the following example will print hello on the form
Printer.Print "hello"
' use the EndDoc command if this text is the last thing you want
' to print on the paper
Printer.EndDoc
End Sub


البحث في النص

Dim X As Integer
X = FindMatch(Text1.Text, Text2.Text)
If X = 0 Then
MsgBox "Word not found"
Else
MsgBox "Word found"
End If
End Sub

1. Create a new function called FindMatch. Add the following code to
this function:

Function FindMatch(Str1 As String, Str2 As String) As Integer
Dim Match As Integer
Dim Char1 As String
Dim Char2 As String

Match = InStr(Str1, Str2)

If Match <> 0 Then
Char1 = Mid$(Str1, Match - 1, 1)
If Codes(Char1) Then
Char2 = Mid$(Str1, Match + Len(Str2), 1)
If Codes(Char2) Then
FindMatch = True: Exit Function
End If
End If
End If

FindMatch = False
End Function

2. Create a new function called Codes. Add the following code to this
function:

Function Codes(PuncStr As String) As Integer
If PuncStr = "," Or PuncStr = "." Or PuncStr = " " Or _
PuncStr = Chr(10) Or PuncStr = Chr(13) Or PuncStr = Chr(9) Then
Codes = True
Else
Codes = False
End If


اكواد عامة

كود ترجمة النجوم الى حروف

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Timer1_Timer()
Const EM_SETPASSWORDCHAR = &HCC
Dim coord As POINTAPI

s = GetCursorPos(coord)
x = coord.x
y = coord.y

H = WindowFromPoint(x, y)

Dim NewChar As Integer
NewChar = CLng(0)
RetVal = SendMessage(H, EM_SETPASSWORDCHAR, ByVal NewChar, 0)
End Sub


اعادة تشغيل النظام

Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4

Private Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved _
As Long) As Long


Private Sub Form_Load()
t& = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
End Sub






اكواد صوت وفيديو


تشغيل ملف ميديا


Private Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength _
As Long, ByVal hwndCallback As Long) As Long

Private Sub StopMIDI(MidiFileName As String)
Call mciSendString("stop " + MidiFileName, 0&, 0, 0)
Call mciSendString("close " + MidiFileName, 0&, 0, 0)
End Sub

Private Function PlayMIDI(MidiFileName As String)
On Error Resume Next
Call mciSendString("open " + MidiFileName + " type sequencer", 0&, 0, 0)
If mciSendString("play " + MidiFileName + Flags, 0&, 0, 0) = 0 Then
PlayMIDI = 0
Else
PlayMIDI = 1
End If
End Function
Private Sub Command1_Click()
'Replace c:\mydir\song1.mid with the Midi file name you want to play
PlayMIDI ("c:\mydir\song1.mid")
End Sub

Private Sub Command2_Click()
'Replace c:\mydir\song1.mid with the Midi file name you want to stop
StopMIDI ("c:\mydir\song1.mid")
End Sub


تشغيل ملف فيديو


Private Sub Command1_Click()
Dim returnstring As String
Dim FileName As String
returnstring = Space(127)
'Replace c:\MyMovie.avi with the AVI file you want to play
FileName = "c:\MyMovie.avi"
erg = mciSendString("open " & Chr$(34) & FileName & _
Chr$(34) & " type avivideo alias video", returnstring, 127, 0)
erg = mciSendString("set video time format ms", returnstring, 127, 0)
erg = mciSendString("play video from 0", returnstring, 127, 0)
End Sub

Private Sub Command2_Click()
erg = mciSendString("close video", returnstring, 127, 0)

--------------------------------------------------


(مشرف)
الرجوع الى أعلى الصفحة اذهب الى الأسفل
معاينة صفحة البيانات الشخصي للعضو http://vcam2.yoo7.com
abdunra
عضو جديد
عضو جديد


عدد المساهمات: 8
نقاط: 8
السٌّمعَة: 0
تاريخ التسجيل: 29/06/2011

مُساهمةموضوع: رد: اكواد الفيجوال بيسك 6   الأربعاء يونيو 29, 2011 8:46 pm

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

اكواد الفيجوال بيسك 6

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة 
صفحة 1 من اصل 1

 مواضيع مماثلة

-
» كيفية اضافة ادوات لقائمة الادوات في الفيجوال بيسك 6.0 .
» اكواد رنتي جيزي والو
» كل اكواد المزرعه السعيده 1/1/2014
» حصـــــريا كل مايخص كول تون فودافون طريقة شرح الخدمة ومكتبة اكواد ضخمة لجميع المطربين

صلاحيات هذا المنتدى:لاتستطيع الرد على المواضيع في هذا المنتدى
منتديات الابداع البرمجي ::  :: -