قواعد المشاركة في المنتدى

(منتدى الأكسس) الموضوع:تهنئة بمناسبة عيد الفطر المبارك 2017 بواسطة: (startnet) :: (منتدى الأكسس) الموضوع:مشكلة غريبة جننتنى بواسطة: (startnet) :: (منتدى Microsoft Visual Basic) الموضوع:بنك اكواد المحيط العربي بواسطة: (عبدالعزيز بيروني) :: (منتدى Microsoft Visual Basic) الموضوع:مجاناً - مشروع تخرج نظام المبيعات source code بواسطة: (عبدالعزيز بيروني) :: (قسم الاعلانات) الموضوع:شقق للبيع تمليك جميع احياء مدينة العبور عروس المدن الجديدة للاستلام الفورى بواسطة: (جمعة عللام) :: (قسم الاعلانات) الموضوع:مطلوب اراضى للبيع او مشاركات او ادوار نعلية ونكمتة مبان بواسطة: (جمعة عللام) :: (أخبار التكنولوجيا) الموضوع:شركة تنظيف منازل بابها والرياض0554487606 بواسطة: (فرسان الوادي) :: (قسم الاعلانات) الموضوع:للبيع شقة تمليك حدائق القبة ش بور سعيد مباشرةل بواسطة: (جمعة عللام) :: (قسم الاعلانات) الموضوع:شقق للبيع بمدينة نصر الحى السابع تاصية للاستلام الفورى 155م 150م 125م بواسطة: (جمعة عللام) :: (قسم الاعلانات) الموضوع:شقق للبيع بمدينة نصر الحى السابع تاصية للاستلام الفورى 155م 150م 125م بواسطة: (جمعة عللام) :: (منتدى البرامج) الموضوع:شهادات الايلتس للبيع في قطر 00962790574474 معتمد بواسطة: (ايلتس او توفل) :: (منتدى مبرمجي Microsoft Visual VB.NET) الموضوع:شهادات الايلتس للبيع في الكويت 00962790574474 معتمد بواسطة: (ايلتس او توفل) :: (منتدى الكتب الالكترونية) الموضوع:شهادات ايلتس معتمدة للبيع في سلطنة عمان 00962790574474 بواسطة: (ايلتس او توفل) :: (قسم الاعلانات) الموضوع:للبيع شقق مدينة نصر حى الواحة الحى العاشر 160 م بواسطة: (جمعة عللام) :: (قسم الاعلانات) الموضوع:شهادة ايلتس او توفل معتمدة للبيع في السعودية 00962790574474 اصلي بواسطة: (ايلتس او توفل) :: (أخبار التكنولوجيا) الموضوع:شهادة ايلتس او توفل للبيع معتمدة في الاماررات 00962790574474 اصلي بواسطة: (ايلتس او توفل) :: (قسم الاعلانات) الموضوع:الشركه الدوليه للانشاء وادارة المشروعات نقوم البناء بالتنفيذ والتشطيب بواسطة: (جمعة عللام) :: (منتدى الأبحاث) الموضوع:صور مشبات امريكيه بواسطة: (مصطفى خميس) :: (منتدى الأكسس) الموضوع:انشاء قائمة منسدلة تعتمد عل قائمة اخرى بواسطة الكود بواسطة: (عدي الزرفي) :: (منتدى ADO.NET العام) الموضوع:بايرن ميونيخ بالعربية بواسطة: (شيماء إلحربي)


راديو القرآن

المواضيع المثبته: (Oracle قسم قواعد البيانات أوراكل) الموضوع:دورة قواعد البيانات (( اوراكل للمبتدئين )) بواسطة: (السند العربي) :: (Oracle قسم قواعد البيانات أوراكل) الموضوع:بعض ميزات أوركل 10g بواسطة: (وليد القدسي) :: (منتدى تصميم صفحات الويب) الموضوع:الجافا سكريبت في كتاب بواسطة: (amricost) :: (لغة PHP) الموضوع:دروس php بواسطة: (أحمد إبراهيم شقليه) :: (منتدى برمجة الألعاب) الموضوع:اعلان هام بواسطة: (مصطفي البارودي) :: (منتدى Microsoft Visual Basic) الموضوع:الدليل الأسرع لأبرز المواضيع بواسطة: (HnHn) :: (Oracle قسم قواعد البيانات أوراكل) الموضوع:ما هي أوراكل وماتعرف عنها بواسطة: (وليد القدسي) :: (منتدى برمجة الألعاب) الموضوع:مقدمة في برمجة الـ (3D) الألعاب...جـ2 بواسطة: (NubiaPrince) :: (منتدى مبرمجي ASP) الموضوع:مواقع يعطي سكربتات لكل لغات البرمجة بواسطة: (ahmadtec) :: (منتدى برمجة الشبكات في بيئة الدوت نت) الموضوع:عمل برنامج بسيط مع قاعدة بيانات اكسس على شبكة محلية بواسطة: (allnsh 3) :: (منتدى مبرمجي ASP.NET) الموضوع:كيفية ربط الأوراكل مع asp.net بواسطة: (عبدالله جابر شقليه) :: (منتدى أنظمة الشبكات وأمنها) الموضوع:ماهو الـ IPSec بواسطة: (khaled helal) :: (منتدى Microsoft Excel) الموضوع:تعالوا نتعلم - دروس في الإكسيل بواسطة: (وائل مراد) :: (Oracle قسم قواعد البيانات أوراكل) الموضوع:تفقيط الأرقام للغة العربية تحت بيئة oracle pl sql بواسطة: (adnan_som) :: (منتدى برمجة التقارير) الموضوع:شرح طريقة اضافة تقرير Crystal Reports في الـ ASP.NET بواسطة: (FunctionSys) :: (منتدى مبرمجي ASP.NET) الموضوع:كيفية قرائة الصحف الإلكترونية والكتب والمجلات عبر الانترنت بواسطة: (عبدالله جابر شقليه) :: (منتدى الدعم الفني للماسنجر المحيط العربي) الموضوع:مشاكل ماسنجر المحيط العربي بواسطة: (jbsa) :: (قسم الدروس و الدورات) الموضوع:لتحميل مجموعة امثله على الفيجوال بيسيك دوت نت 2005 بواسطة: (HnHn) :: (منتدى مبرمجي Microsoft Visual C#.NET) الموضوع:موسوعة الأكواد بواسطة: (fmo_82) :: (منتدى مبرمجي ASP) الموضوع:شرح كود موقع شؤون الموظفين النسخة الأولى بواسطة: (alanees)

عدد الصفحات : 10  « < 1  2  3  4  5  6  7  8  9   > » إضافة رد إضافة موضوع جديد

> بنك اكواد المحيط العربي,بنك اكواد المحيط العربي
Bookmark and Share
تقييم الموضوع Label معدل التقيم:0
مشاركةالاثنين,09/رجب/1428 هـ,01:13 مساءً
المشاركة #41

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



'Add 1 Command Button to your form.
'Add reference to Word: From VB menu choose
'Project -> References
'then mark the Microsoft Word X.0 Object
'Library check box and press OK.

'Form Code
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





مهندس / مصطفى الوكيل



--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,01:13 مساءً
المشاركة #42

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



'Add 1 Command Button to your form.
'Add reference to Word: From VB menu choose
'Project -> References
'then mark the Microsoft Word X.0 Object
'Library check box and press OK.

'Form Code
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





مهندس / مصطفى الوكيل



--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,01:20 مساءً
المشاركة #43

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



هذا كود كيف تطبع تقرير أعد فى برنامج أكسيس وتقوم أنت بطباعته من برنامجك



'Add 1 Command Button to your form.
'Add 1 reference to Microsoft Access X.0
'Object Library (From
'VB Menu choose Project -> References...,
'mark the Microsoft Access X.0
'Object Library check box and press OK).

'Form Code
Private Sub Command1_Click()
Dim ac As Access.Application
Set ac = New Access.Application
' open the database.
' replace the "c:\myDir\myDBFileName.mdb" below with your
' database file name
ac.OpenCurrentDatabase ("c:\myDir\myDBFileName.mdb")
' uncomment the line below if you want to see Print Preview
' ac.Visible = True
' replace the acViewNormal below with acViewPreview
' if you want to see Print Preview
ac.DoCmd.OpenReport "Catalog", acViewNormal
' delete the line below if you want to see Print Preview
ac.CloseCurrentDatabase
End Sub




مهندس / مصطفى الوكيل
وصلوا على النبى



--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,02:01 مساءً
المشاركة #44

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



هذا كود يعلمك كيفية إعادة تشغيل النظام restart




 كود
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



مهندس / مصطفى الوكيل
وصلوا على النبى


--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,02:19 مساءً
المشاركة #45

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



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

 كود
'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Insert the following code to your module:

Public Const NV_CLOSEMSGBOX As Long = &H5000&
Public Declare Function SetTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&, _
ByVal uElapse&, ByVal lpTimerFunc&)
Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName$, ByVal lpWindowName$)
Public Declare Function LockWindowUpdate& Lib "user32" (ByVal hwndLock&)
Public Declare Function SetForegroundWindow& Lib "user32" (ByVal hWnd&)
Public Declare Function MessageBox& Lib "user32" Alias "MessageBoxA" _
(ByVal hWnd&, ByVal lpText$, ByVal lpCaption$, ByVal wType&)
Public Declare Function KillTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&)
Public Const API_FALSE As Long = 0&
Public Sub TimerProc(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
KillTimer hWnd, idEvent
Dim hMessageBox&
'Replace 'Self Closing Message Box' with the title you gave to your message box.
hMessageBox = FindWindow("#32770", "Self Closing Message Box")
If hMessageBox Then
Call SetForegroundWindow(hMessageBox)
SendKeys "{enter}"
End If
Call LockWindowUpdate(API_FALSE)
End Sub

'Insert this code to your form:

Private Sub Form_Load()
'Replace the '4000' below with the number of milliseconds the message box
'will appear. 1000 milliseconds = 1 second
SetTimer hWnd, NV_CLOSEMSGBOX, 4000&, AddressOf TimerProc
Call MessageBox(hWnd, "Watch this message box close itself after four seconds", _
"Self Closing Message Box", MB_ICONQUESTION Or MB_TASKMODAL)
End Sub


مهندس / مصطفى الوكيل
وصلوا على النبى



--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,02:24 مساءً
المشاركة #46

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



هذا كود يعلمك كيفية إنشاء قوائم متعددة الأعمدة


 كود
Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

Private Const MF_MENUBARBREAK = &H20& ' columns with a separator line
Private Const MF_MENUBREAK = &H40& ' columns w/o a separator line
Private Const MF_STRING = &H0&
Private Const MF_HELP = &H4000&
Private Const MFS_DEFAULT = &H1000&
Private Const MIIM_ID = &H2
Private Const MIIM_SUBMENU = &H4
Private Const MIIM_TYPE = &H10
Private Const MIIM_DATA = &H20

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

' 1.Open a new Standard EXE Project. Form1 is created by default.
' 2.Add a CommandButton to Form1.
' 3.On the Tools menu, click Menu Editor. Create a menu consisting of at least two top level menus containing at least four submenu items each.
' 4.Add the following code to Form1:

Private Sub Command1_Click()

' Splitting a menu here demonstrates that this can be done dynamically.
Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
Dim BuffStr As String * 80 ' Define as largest possible menu text.

hMenu = GetMenu(Me.hwnd) ' retrieve menu handle.
BuffStr = Space(80)
With mnuItemInfo ' Initialize the UDT.
.cbSize = Len(mnuItemInfo) ' 44
.dwTypeData = BuffStr & Chr(0)
.fType = MF_STRING
.cch = Len(mnuItemInfo.dwTypeData) ' 80
.fState = MFS_DEFAULT
.fMask = MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU
End With

' Use item break point position for the '3' below (zero-based list).
hSubMenu = GetSubMenu(hMenu, 0)
If GetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
MsgBox "GetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
Else
mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
If SetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
End If
End If
DrawMenuBar (Me.hwnd) ' Repaint top level Menu.

End Sub



Private Sub Form_Load()

' This works for either an API-created menu or a native VB Menu.
Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
Dim BuffStr As String * 80 ' Define as largest possible menu text.

hMenu = GetMenu(Me.hwnd) ' Retrieve menu handle.
BuffStr = Space(80)

With mnuItemInfo ' Initialize the UDT
.cbSize = Len(mnuItemInfo) ' 44
.dwTypeData = BuffStr & Chr(0)
.fType = MF_STRING
.cch = Len(mnuItemInfo.dwTypeData) ' 80
.fState = MFS_DEFAULT
.fMask = MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU
End With

' Use item break point position for the '3' below (zero-based list).
hSubMenu = GetSubMenu(hMenu, 1)
If GetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
MsgBox "GetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
Else
mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBREAK
If SetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
End If
End If
DrawMenuBar (Me.hwnd) ' Repaint top level Menu.

End Sub



مهندس / مصطفى الوكيل
وصلوا على النبى




--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,02:31 مساءً
المشاركة #47

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



هذا كود برنامج عقارب الساعة


 كود
'Just one form with one timer: Timer1: Inteval = 50.

'Get time and draw 3 index step by step
Private Sub Run(O As Object)
Const PI As Single = 3.1415
Dim NewTime As Single
Dim GocH As Single, GocM As Single, GocS As Single
Dim H As Single, M As Single, S As Single
Dim r As Single

NewTime = Time

H = Hour(NewTime)
M = Minute(NewTime)
S = Second(NewTime)

GocH = PI * ((H Mod 12) / 6 + M / 360 + S / 4320)
GocM = PI * (M / 30 + S / 1800)
GocS = PI * ((Timer + 1.7) / 30)

O.Cls

If (O.ScaleHeight < O.ScaleWidth) Then r = O.ScaleHeight / 2 Else r = O.ScaleWidth / 2

VeKim O, 3.5 * r / 5, GocH, vbBlue, 6 'Kim gio:Hour index
VeKim O, 5 * r / 6, GocM, vbDesktop, 3 'Kim phut:Min index
VeKim O, r, GocS, vbRed, 1 'Kim giay: Sec index
VeKim O, r / 6, PI + GocS, vbRed, 2 'Duoi kim giay: Tag of Sec index
Me.Caption = Time
End Sub

'Draw index
Private Sub VeKim(O As Object, r As Single, Goc As Single, Mau As Long, Size As Single)
Dim Xo As Single, Yo As Single, X As Single, Y As Single

Xo = O.ScaleWidth / 2
Yo = O.ScaleHeight / 2

X = Xo + r * Sin(Goc)
Y = Yo - r * Cos(Goc)

O.ForeColor = Mau
O.DrawWidth = Size
O.Line (Xo, Yo)-(X, Y)

End Sub

Private Sub Form_Load()
Timer1.Interval = 50
End Sub

Private Sub Form_Resize()
Run Me
End Sub


Private Sub Timer1_Timer()
Run Me
End Sub


مهندس / مصطفى الوكيل
وصلوا على النبى



--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,02:37 مساءً
المشاركة #48

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



هذا كود برنامج يرسم مكعب مجسم ويدور حو نفسه




 كود
'Add 1 Picture Box and 1 Timer Control to your form.
'At Run-Time, Move the mouse to change the rotation speed and direction..
'Insert the following code to your form:

Private X(8) As Integer
Private y(8) As Integer
'Integer arrays that hold the actual 2D coordinates of the
'8 corners of the cube.These are the values used to plot
'the cube on the form after the X,Y,Z coordinates of each cube
'corner have been converted to 2 dimensinal X and Y coordinates.
Private Const Pi = 3.14159265358979
'Constant used to convert degrees to radians
Private CenterX As Integer
Private CenterY As Integer
'The center of the 3 dimensional plane,where it's
'X=0 , Y=0 , Z=0
Private Const SIZE = 250
'The length of the cube achmes,therefore also adjusts the overall size.
Private Radius As Integer
'The radius of the rotation.Each one of the 8 corners of the cube
'rotates around the vertical Y axis with the same angular speed and radius
'of rotation.
Private Angle As Integer
'The value of this variable loops from 0 to 360 and it is passed
'as an argument to the COS and SIN functions (sine and cosine)
'that return the changing Z and X coordinates of each corner
'as the cube rotates around the Y axis
Private CurX As Integer
Private CurY As Integer
'Variables that hold the current mouse position on the form.
Private CubeCorners(1 To 8, 1 To 3) As Integer
'The array that holds the X,Y and Z coordinates of the 8 corners
'The center of the 3D plane is right on the center of the cube.
'So ,if SIZE the length of one achmes,it's:
'CenterCube(1,1) = SIZE/2 ' X coordinate of 1st corner
'CenterCube(1,2) = SIZE/2 ' Y coordinate
'CenterCube(1,3) = SIZE/2 ' Z coordinate
'Actually,we only need to give a value for the Y coordinates
'of each corner since that will never change during the rotation
'as all corners rotate around the Y axis ,with only their Z and X
'coordinates changing periodically.
Private Sub Form_Load()
Me.ScaleMode = 3
Picture1.ScaleMode = 3
Timer1.Interval = 1
'Set here the cube Width and color.
Me.ForeColor = vbBlue
Me.DrawWidth = 3
Picture1.AutoRedraw = True
Show
Picture1.Height = Picture1.Width
Picture1.Move ScaleWidth / 2 - Picture1.ScaleWidth / 2, Picture1.Height
CenterX = ScaleWidth / 2
CenterY = ScaleHeight / 2
'Set the center of the 3D plane to reflect the center of the form.
Angle = 0
Radius = Sqr(2 * (SIZE / 2) ^ 2)
'Give a value to the radius of the rotation.This is
'the Pythagorean theorem that returns the length of the
'hypotenuse of a right triangle as the square root
'of the sum of the other two sides raised to the 2nd power.
CubeCorners(1, 2) = SIZE / 2
CubeCorners(2, 2) = SIZE / 2
CubeCorners(3, 2) = -SIZE / 2
CubeCorners(4, 2) = -SIZE / 2
CubeCorners(5, 2) = SIZE / 2
CubeCorners(6, 2) = SIZE / 2
CubeCorners(7, 2) = -SIZE / 2
CubeCorners(8, 2) = -SIZE / 2
'Assign a value to the Y coordinates of each cube.This
'will never change through out the rotation since the cube
'rotates around the Y axis.Play around with these if you like
'but the 3D prism will no longer resemble a cube...
End Sub

Private Sub DrawCube()
Cls
For i = 1 To 8
X(i) = CenterX + CubeCorners(i, 1) + CubeCorners(i, 3) / 8
y(i) = CenterY + CubeCorners(i, 2) + Sgn(CubeCorners(i, 2)) * CubeCorners(i, 3) / 8
'These two lines contain the algorith that converts the
'coordinates of a point on the 3D plane (x,y,z) ,into 2
'dimensional X and Y coordinates that can be used to plot
'a point on the form.Play around with the 8's and see what happens...
Next
Line (X(3), y(3))-(X(4), y(4))
Line (X(4), y(4))-(X(8), y(8))
Line (X(3), y(3))-(X(7), y(7))
Line (X(7), y(7))-(X(8), y(8))
Line (X(1), y(1))-(X(3), y(3))
Line (X(1), y(1))-(X(2), y(2))
Line (X(5), y(5))-(X(6), y(6))
Line (X(5), y(5))-(X(1), y(1))
Line (X(5), y(5))-(X(7), y(7))
Line (X(6), y(6))-(X(8), y(8))
Line (X(2), y(2))-(X(4), y(4))
Line (X(2), y(2))-(X(6), y(6))
Line (X(1), y(1))-(X(4), y(4))
Line (X(2), y(2))-(X(3), y(3))
Line (X(4), y(4))-(X(8), y(8))
Line (X(3), y(3))-(X(7), y(7))
'The plotting of the cube onto the form.
'We have to draw each achmes seperately and then
' "connect" the bottom square with the top square.
DoEvents
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
CurX = X
CurY = y
'Store the current position of the mouse cursor into
'the variable CurX,CurY.
End Sub

Private Sub Timer1_Timer()
Select Case CurX
Case Is > ScaleWidth / 2
Angle = Angle + Abs(CurX - ScaleWidth / 2) / 20
If Angle = 360 Then Angle = 0
Case Else
Angle = Angle - Abs(CurX - ScaleWidth / 2) / 20
If Angle = 0 Then Angle = 360
End Select
'Change the direction and the angular speed of the rotation
'according to the position of the mouse cursor.If it's near
'the left edge of the form then the rotation will be
'anti-clockwise ,it's near the right edge it will be
'clockwise. The closer to the center of the form the
'cursor is,the slower the cube rotates.
'The angular speed of the rotation is controlled by the
'pace at which 'Angle' (the value that we pass to the
'(COS and SIN functions) increases or decreases (increases
'for anti-clockwise rotation and decreases for clockwise rotation).
For i = 1 To 3 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle) * Pi / 180)
Next
For i = 2 To 4 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 2 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 2 * 45) * Pi / 180)
Next
For i = 5 To 7 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 6 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 6 * 45) * Pi / 180)
Next
For i = 6 To 8 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 4 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 4 * 45) * Pi / 180)
Next
'Give the new values to the X and Z coordinates of each one
'of the 8 cube corners by using the COS and SIN mathematical
'functions.Notice that corners 1 and 3 always have the same
'X and Z coordinates, as well as 2 and 4, 5 and 7,6 & 8.
'Take a look at the little scetch on the top of the form
'to see how this is explained (imagine the cube rotating
'around the Y axis)
DrawCube
End Sub



مهندس / مصطفى الوكيل
وصلوا على النبى






--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,02:42 مساءً
المشاركة #49

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



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





 كود
Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer

Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000

Public Function Get_File(sURLFileName As String, sSaveFileName As String) As Boolean

Dim lRet As Long
On Error GoTo err_Fix

lRet = InternetOpen("", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
lRet = URLDownloadToFile(0, sURLFileName, sSaveFileName, 0, 0)
Get_File = True
Exit Function
err_Fix:
Debug.Print Err.LastDllError, lRet
Err.Clear
Get_File = False
End Function

'ÖÚ åÐÇ ÇáßæÏ Ýí ÇáÝæÑã
Option Explicit


Private Sub Form_Load()
txtFrom.Text = http://www.vb4arab.com/pix/book.zip"
txtTo.Text = "c:\VBbook.zip"
End Sub

Private Sub cmdDownload_Click()
Dim obj As clsDownload
Set obj = New clsDownload
Dim bRet As Boolean

Screen.MousePointer = vbHourglass
bRet = obj.Get_File(Trim(Me.txtFrom.Text), Trim(Me.txtTo.Text))
If bRet = False Then Me.txtTo.Text = "Error downloading!"
Screen.MousePointer = vbDefault
Set obj = Nothing
MsgBox "Done", vbInformation
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub



مهندس / مصطفى الوكيل
وصلوا على النبى



--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة
مشاركةالاثنين,09/رجب/1428 هـ,02:47 مساءً
المشاركة #50

الرتبة في المنتدى:رقيب

أيقونة المجموعة

المجموعة: الأعضاء
المشاركات: 29
سجل في:الأربعاء,04/رجب/1428 هـ,02:18 مساءً
الدولة:مصر
رقم العضوية: 30725



إخوانى أعضاء هذا المنتدى الكريم

أسألكم الدعاء لتفريج همى وكربى وتيسير أمرى لعل منكم من يتسجاب له

وأسألكم الصلاة على النبى محمد ولو 10 مرات فقط وهو ثمن هذه الأكواد

(وقل ربى زدنى علما ) ... صدق الله العظيم

وإلى لقاء آخر إن شاء الله


--------------------
مهندس / مصطفى الوكيل
darsh@usa.com
=====================
الشمس تشرق من أجلك ياأمى
-----------------------------------

للأعلىأبلغ المشرف عن هذه المشاركة
لتعقيب على هذه المشاركة مباشرة

    

عدد المتصفحين لهذا المنتدى «1»: (الضيوف «1» - المتخفون «0»)
الأعضاء «0»: .

عدد الصفحات : 10  « < 1  2  3  4  5  6  7  8  9   > » إضافة رد جديد إضافة موضوع جديد



 
الوقت الأن:اليوم,08:23 مساءً بتوقيت القدس المحتلة

Powered By arabmoheet v3.1

منتديات المحيط العربي  -  راسلنا  -   أعلى
X   رسالة المنتدى
(سوف يتم اغلاق هذه النافذة بعد 2 ثانية)
X   رسالة المنتدى
(سوف يتم اغلاق هذه النافذة بعد 2 ثانية)