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

(منتدى Microsoft Visual Basic) الموضوع:ادراج رابط صورة في جدول واستدعائها بواسطة: (ابو حمد) :: (منتدى مبرمجي Microsoft Visual VB.NET) الموضوع:اكبر مكتبة اكواد فى الفيجوال بيسك دوت نت بواسطة: (ابو حمد) :: (منتدى مبرمجي Microsoft Visual VB.NET) الموضوع:مشكلة في كود البحث بواسطة: (ابو حمد) :: (منتدى Microsoft Visual Basic) الموضوع:كيف أضيف صوت للـ Command في الفيجوال بيسك 6 بواسطة: (ابو حمد) :: (منتدى مبرمجي Microsoft Visual VB.NET) الموضوع:Please help me بواسطة: (ابو حمد) :: (قسم الاعلانات) الموضوع:طرق تنظيف الثلاجة بواسطة: (سجيات) :: (منتدى الأكسس) الموضوع:طريقة جديدة تمكنك من البحث عن الصنف واضافتة تلقائى فى الفاتورة مع السعر بواسطة: (xhanyx) :: (منتدى الأكسس) الموضوع:تمكنين المستخدم من تعديل البيانات الخاصة به فقط بواسطة: (xhanyx) :: (قسم الاعلانات) الموضوع:شركة الحافظ المثالي للخدمات المنزلية بواسطة: (خالدعلي) :: (منتدى الأكسس) الموضوع:انشاء برنامج بسيط للمحلات على الاكسس شراء بيع ومخزن وربح بواسطة: (xhanyx) :: (قسم الاعلانات) الموضوع:شركة فارس المستقبل للخدمات المنزلية بواسطة: (خالدعلي) :: (قسم الاعلانات) الموضوع:افضل شركة خدمات منزلية بواسطة: (خالدعلي) :: (قسم الاعلانات) الموضوع:برنامج حسابات عقارات المساعد الفني بواسطة: (مكتب الشروق الفني) :: (قسم الاعلانات) الموضوع:تعرف على طرق الحفاظ على نظافة الثلاجة بواسطة: (amany elsayed) :: (منتدى ADO.NET العام) الموضوع:احتراف أنظمة الشَّبكات سيسكو CCNA بواسطة: (احمدجج) :: (قسم التطوير والاقتراحات) الموضوع:دورة تنمية مهارات الابتكار و الابداع للمديرين بواسطة: (Nermeen metc) :: (قسم الاعلانات) الموضوع:اسعار الدريسنج روم . افضل الاسعار . للاتصال 01207565655 بواسطة: (هند صبرى 100) :: (قسم الاعلانات) الموضوع:تعرف على طرق الصيانة الدورية للثلاجة بواسطة: (amany elsayed) :: (قسم الاعلانات) الموضوع:اشكال دريسنج روم للمساحات الصغيرة . للاتصال 01013843894 بواسطة: (هند صبرى 100) :: (منتدى ADO.NET العام) الموضوع:تنظيف مكافحة حشرات شركة القاهرة بواسطة: (نرجس بينت جده)


راديو القرآن

المواضيع المثبته: (القسم المفتوح) الموضوع:شاهد واشكر ربك على نعمة الاسلام بواسطة: (غزاوية أصيلة) :: (القسم المفتوح) الموضوع:قصص الأنبياء عليهم السلام .جميعا بواسطة: (غزاوية أصيلة) :: (منتدى مبرمجي Microsoft Visual VB.NET) الموضوع:طريقة تخزين أي نوع ملفات في Access DataBase ومشاهدتها وتشغيلها بواسطة: (jbsa) :: (منتدى أنظمة الشبكات وأمنها) الموضوع:أساسيات تصميم الشبكات بواسطة: (مرحبا الساع) :: (منتدى تحليل و تصميم نظم المعلومات) الموضوع:مراحل تحليل النظم لدراسة نظام قائم بواسطة: (jbsa) :: (منتدى الكتب الالكترونية) الموضوع:كتاب لبرامج مصممة بالفيجوال مع أكوادها (الجزء الثاني) بواسطة: (First Star) :: (منتدى Microsoft Excel) الموضوع:دروس إكسل و شرح الدوال و تقنيات متقدمة بواسطة: (صهيب جاويش) :: (Oracle قسم قواعد البيانات أوراكل) الموضوع:E-Business Suite بواسطة: (وليد القدسي) :: (Oracle قسم قواعد البيانات أوراكل) الموضوع:تفقيط الأرقام للغة العربية تحت بيئة oracle pl sql بواسطة: (adnan_som) :: (منتدى Microsoft SQL Server) الموضوع:ما المقصود بتقنية replication بواسطة: (SQL Student) :: (منتدى مبرمجي ASP) الموضوع:برنامج مكتبة إلكترونية بواسطة: (عبدالله جابر شقليه) :: (منتدى أنظمة الشبكات وأمنها) الموضوع:ماهو الـ IPSec بواسطة: (khaled helal) :: (منتدى مبرمجي Microsoft Visual VB.NET) الموضوع:دورة في LINQ To DataSet بواسطة: (jbsa) :: (قسم الدروس و الدورات) الموضوع:تعلم معي البرمجة بالفيجوال بيسك .. بواسطة: (كوثــــــــــــر) :: (قسم الدروس و الدورات) الموضوع:دوره مجانيه لاحتراف الدوت نت بواسطة: (alaa gomaa) :: (Oracle قسم قواعد البيانات أوراكل) الموضوع:اعداد و تنصيب اوراكل 9i ويندز NT/2000/XP بواسطة: (oracle_egypt) :: (منتدى مبرمجي ASP) الموضوع:دورة احترافيه لبناء منتدى على asp بواسطة: (عبدالله جابر شقليه) :: (القسم المفتوح) الموضوع:إلا رسول الله صلى الله عليه وسلم بواسطة: (alanees) :: (قسم الدروس و الدورات) الموضوع:دروس بالفيديو في VB.NET 2005 بواسطة: (HnHn) :: (منتدى مبرمجي Microsoft Visual C#.NET) الموضوع:مكتبة الأمثلة والتطبيقات للغة #C بواسطة: (النور)

عدد الصفحات : 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   > » موضوع مغلق إضافة موضوع جديد



 
الوقت الأن:اليوم,09:47 صباحاً بتوقيت القدس المحتلة

Powered By arabmoheet v3.1

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