سلام ببخشید دیر دارم مطلب می نویسم نظرات شرمنده ام کرد دوباره

فقط برنامه های ساختمان داده من برای استاد شکری پور رو آوردم

ترم دیگه کاردانیم تموم می شه انگار همین دیروز بود یادش بخیر ستایش اولین کسی بود که بهم تبریک گفت

Data struc project Link

Link List and student manegment system

http://nasservb.persiangig.com/tree.zip

http://nasservb.persiangig.com/3.zip

مثال خوبی برای لینک لیست تو سی هست برنامه درخت در وی بی هم تو لینک دومیه هست

من تو درس ساختمان 16.5 شدم برگه رو خوب ننوشتم چون با امتحان ریاضی یه روز بود

این برنامه بسیار حرفه ای و شامل بخشهای زیادی برای پخش صوت می باشد

بخشهای این برنامه شامل

برنامه تبدیل فرمت های مختلف

برنامه ایجاد فایل ای وی آی از عکس

برنامه کپی گسترده فایل

برنامه جستجوگر وب و فایل

برنامه پخش صوت وتصویر

برنامه رو با وی بی ۶ نوشتم وتکنیکهایی مثل دی دی ای وآی پی درش بکار رفته

Download

Player Audio & Video

D:\Program Files\Microsoft Visual Studio\Common\Ghraphic

روي خاصيت Custom ليست درختي ( TreeView ) دو با ر كليك كنيد تا كادرش باز شود .سپس
خاصيت اسكرول ليست درختي( TreeView ) را فعال كنيد .و خاصيت ImageList آن را به ImageList1 تنظيم كنيد .
يك كامند ياتون با يه كادر عكس و يه تكست بوكس به فرم اضافه كنيد .خاصيت MultiLine تكست بوكس را به True و خاصيت ScrolBar اون رو به 3 تنظيم كنيد.
فرم و ليست درختي و كادر عكس رو خيلي بزرگ كنيد . و تكست بوكس و دكمه رو زياد بزرگ نكنيد
در كد كليك كامند كد زير رو بنويسيد

CurrentResType = "": CurrentResName = ""
RefreshView: ClearResource
cdlg.Filter = "Executable (dll,exe)|*.dll;*.exe|All files (*.*)|*.*"
cdlg.InitDir = App.Path
cdlg.ShowOpen
If cdlg.FileName <> "" Then
Call FillResTypes(TreeView1, cdlg.FileName, cdlg.FileTitle)
End If

در رويداد Collapse ليست درختي بنويسيد:

RefreshView

در رويداد Expand ليست درختي بنويسيد:

If Node.Child.Text = "Dummy" Then
TreeView1.Nodes.Remove Node.Child.Index
Call FillResNames(TreeView1, Node)
End If

و بلاخره در رويداد NodeClick ليست در ختي كد زير رو كپي كنيد:

Dim ResType As String, ResName As String, ret As Boolean
Text1.Visible = False
RefreshView
CurrentResType = "": CurrentResName = ""
If Node = Node.Root Then Exit Sub
Label1 = "ResType: " & Node.Text
If Node.Key = "" Then
CurrentResType = Node.Text
Else: CurrentResType = Mid(Node.Key, 2)
End If
If Node.Parent = Node.Root Then Exit Sub
MousePointer = vbHourglass
If Node.Parent.Key = "" Then
ResType = Node.Parent.Text
Else: ResType = Mid(Node.Parent.Key, 2)
End If
ResName = Node.Text
If IsNumeric(ResName) Then ResName = "#" & ResName
CurrentResType = ResType: CurrentResName = ResName
Label1 = "ResType: " & Node.Parent.Text & vbCrLf & "ResName: " & ResName & vbCrLf & "ResSize: " & ResSize(ResType, ResName) & " bytes"
Select Case UCase(ResType)
Case "1", "2", "3", "12", "14" '---picture(Icon)
Case "4" 'Menu
Case "5", "17" 'Dialog
ret = ShowDialog(ResName, Picture1)
Case "6" 'String
Case "9" 'Accelerators Table
Case "11" 'Message Table
Case "16" 'version info
Case "23", "HTML" 'Web Page
Case "AVI" '-video
Case "JPG", "JPEG", "GIF", "PNG", "TIF", "TIFF", "WMF", "EMF" - -Picture
End Select
If ret = False Then
If Text1.Visible Then
Text1.Text = Text1.Text & vbNewLine & "Can not load resourse"
Else: Picture1.Print "Can not load resourse"
End If
End If
Picture1.Refresh: MousePointer = vbDefault

فكر كرديدن تموم شد حالا قسمت اصليش مونده .يه ماژول به فرم اضافه كنيد و كد زير رو داخلش كپي كنيد

.حالا برنامه رو اجرا كنيد .بازدن كامند كادر باز مي شه كه مي تونيد براش فايل اجرايي يا دي ال ال انتخاب كنيد تا داخل برنامه باز بشه .

راستي دقت كردين آدم نظر نمي ده چقدر عذاب وجدان مي گيره !!اون هيچي فشار قبر رو چي خدا بخير بگزرونه!!آره فشار قبر

سلام

تا حالا دلتون خاسته يه اسكرين سيور بسازين

من يه برنامه بسيار جالب از اقاي Alexander Anikin به آدرس http://www.poshuk.com/pegas/index.htm دارم كه در اون يه اسكرين سيور بسيار زيبا ايجاد مي شه حالا اگه حوصله كنيد براتون كدش رو توضيح مي دم

دو تا PictureBox با دو تا تايمر ايجاد كنيد .خاصيت Autoredraw دو تا عكس و فرم رو true كنيد

خاصيت Interval تايمر اولي رو1و دومي رو 1000كنيد

در خط اول كد فرم توابع زير ور تعريف كنيد

'Copyright © 2000 by Alexander Anikin

'e-mail: pegas@poshuk.com

'http://www.poshuk.com/pegas/index.htm

Option Explicit

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private 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

Private Declare Function SetWindowPos Lib "user32" ( _

ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _

ByVal x As Long, ByVal y As Long, ByVal cx As Long, _

ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOSIZE = &H1

Private Const SWP_NOMOVE = &H2

Private Const HWND_TOPMOST = -1

Dim a(47) As Integer

Dim b(47) As Integer

Dim xxx As Integer

Dim yyy As Integer

Dim e As Integer

Dim ScrW As Integer, ScrH As Integer

Private Sub TrueOnTop(myForm As Object)

SetWindowPos myForm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE

End Sub

براي اينكه كاربر هر كاري كرد برنامه سريع خارج بشه بايد در رويداد KeyDown-MouseDown بنويسيد

Unload Me

در كد فرم لواد بنويسيد

If App.PrevInstance = True Then Unload Me

Dim x

TrueOnTop Form1

With Picture1(48)

.BorderStyle = 1

.AutoRedraw = True

.Visible = False

End With

Me.AutoRedraw = True

Dim Bo As Boolean

Call BitBlt(hDC, 0, 0, Screen.Width, _

Screen.Height, GetDC(0&), 0, 0, vbSrcCopy)

Picture2.Width = Screen.Width

Picture2.Height = Screen.Height

Picture2 = Image

ScrW = Screen.Width \ 8

ScrH = Screen.Height \ 6

Picture1(48).Width = ScrW

Picture1(48).Height = ScrH

Dim l As Integer, t As Integer

l = 0

t = 0

For e = 0 To 47

Bo = Not Bo

If Bo = True Then

a(e) = 15

b(e) = 15

Else

a(e) = -15

b(e) = -15

End If

Load Picture1(e)

Picture1(e).Left = l

Picture1(e).Top = t

l = l + ScrW: If l > Screen.Width - ScrW Then l = 0: t = t + ScrH: Bo = Not Bo

Picture1(e).PaintPicture Picture2.Picture, 0, 0, ScrW, ScrH, ScrW * xxx, ScrH * yyy, ScrW, ScrH, vbSrcCopy

xxx = xxx + 1: If xxx = 8 Then xxx = 0: yyy = yyy + 1

DoEvents

Next e

For e = 0 To 47

Picture1(e).Visible = True

Next e

x = ShowCursor(False)

Cls

Timer1.Enabled = True

Timer2.Enabled = True

كد MouseMove فرم

Static X0 As Integer, Y0 As Integer '------------------------------

If ((X0 = 0) And (Y0 = 0)) Or _

((Abs(X0 - x) < 45) And (Abs(Y0 - y) < 45)) Then ' small mouse movement...

X0 = x ' Save current x coordinate

Y0 = y ' Save current y coordinate

Exit Sub ' Exit

End If

Unload Me ' Large mouse movement (terminate screensaver)

كد رويداد تايمر تايمر اولي

LockWindowUpdate Me.hwnd

For e = 0 To 47

Picture1(e).Move Picture1(e).Left + a(e), Picture1(e).Top + b(e)

If Picture1(e).Left > Screen.Width - ScrW Then a(e) = -a(e)

If Picture1(e).Left < 0 Then a(e) = -a(e)

If Picture1(e).Top > Screen.Height - ScrH Then b(e) = -b(e)

If Picture1(e).Top < 0 Then b(e) = -b(e)

DoEvents

Next e

LockWindowUpdate False

كد همون رويداد براي تايمر دومي

Enabled = True

Timer2.Enabled = False

و بلاخره كد Form_Unload

Dim x

x = ShowCursor(True)

End

شايد به محض اجرا شدن برنامه از برنامه خارج شويد .شما بايد يك نسخه اجرايي از برنامه روي دكستاپ ايجاد كنيد و بعد برنامه رو اجرا كنيد .اگه بازم به محض ورود از برنامه خارج شديد Unload Me ها رو پاك كنيد ولي يك دكمه براي خروج از فرم ايجاد كنيد.

نكته:براي ايجاد نسخه اجرايي از پروژه از منوي فايل گزينه Make Project1.exe بزنيد .

نظر ندادنتون منو كشته

تو اين پست برنامه اي ميسازيم كه با جابه جا كردنش موقعيتش روي تيتر برنامه نوشته بشه

اين برنامه بدون هيچ تايمري كار مي كنه و معقيت فرم رو ميگه

يه پروژه خالي(به قول تركا كالاه)ايجاد كنيد ويه ماژول و يه فرم بهش اضافه كنيد

كد مربوط به ماژول

'API Types

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

'API Constants
Const WM_MOVING = 534
Const GWL_WNDPROC = (-4)

'API declarations
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long, ByVal dwnewlong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As RECT) As Long
Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim OldhWndProc As Long

Private Function OnMove(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As RECT) As Long
'Handle the OnMove event
If uMsg = WM_MOVING Then
'The form is moving!!
Form1.Caption = "Left: " & lParam.Left & " ,Top: " & lParam.Top
'Insert your code HERE
End If
'Call the old WindowProc
OnMove = CallWindowProc(OldhWndProc, hWnd, uMsg, wParam, lParam)
End Function

Public Sub InstallOnMovingEvent(frm As Form)
'Install the new WindowProc - SubClassing
OldhWndProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf OnMove)
End Sub

Public Sub RemoveOnMovingEvent(frm As Form)
'Restore the original WindowProc
SetWindowLong frm.hWnd, GWL_WNDPROC, OldhWndProc
End Sub

روي فرم دابل كليك كنيد هر چي نوشته پاك كنيد اينارو بنويسيد

Private Sub Form_Load()
InstallOnMovingEvent Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
RemoveOnMovingEvent Me
End Sub

حالا برنامه رو اجرا بدين تكونش بدين و صفا كنيد

من تو هرپست باد بگم نظر بدين.خوب نظر بدين ديگه

تا حالا زده بسرتون خودتون يه دكمه برا منوي استارت درست كنيد.مثلآ هر موقع برنامه ي شما

اجرا مي شه دكمه استارت تغيير شكل بده !!نميشه؟بشين اينجا جايي نرو تابگم چجوري ميشه

يه كادر عكس به فرم اضافه كنيد ويه عكس توش بندازيد.بعد يه تايمر به فرم اضافه كنيد

خاصيتIntervalتايمر رو روي1 بزاريد بعد توابع زير رو در خط اول كد فرم بنويسيد

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Dim dsktp As Long, St As Long

در ويداد فرم لواد كد زير روبنويسيد

Dim Wind As Long 'Temporary hwnd holder'--Finding the SystemTray Window (hwnd)
Wind = FindWindow("Shell_TrayWnd", "") '--Finding the Start Button Window (hwnd)
Wind = FindWindowEx(Wind, 0, "Button", vbNullString)
St = GetDC(Wind) 'Getting Start Button DC
dsktp = GetDC(Picture1.hwnd)
Timer1.Enabled = True

بقيه اش رو وللش !!شوخي كردم بابا كجا مي ري!! در رويداد تايمر كنترل تايمر كد زير رو بنويسيد

StretchBlt St, 0, 0, 100, 60, dsktp, 40, 1, 1, 40, SRCCOPY

اين نظر كه يادت نمي ره.ايولا گل پسر !!زود باش دير ميشه ها

بعد از باز کردن برنامه از منوی فایل لواداكسپورت بزنيد و فايل رو انتخاب كنيد بعضي از فايل هارو باز نمي كنه ولي اكثر دي ال ال ها رو من با هاش باز كردم

دانلود-14 كلو بايت

نظر كه يادت نمي ره

به جرات می شه گفت یکی از بهترین نوع پخش کنند ه هاست که از مدیا پلیر استفاده می کنه

مجموعه پلیر۴۰۸ کیلو بایت

سورس این مجموعه هم به زودی

دانلود دنیای کلاس و ای پی ای حجم 1.95مگابایت

فقط نظر یادتون نره

منبع دوست عزیزم

كه فقط بايد حوصله كنيد تا ياد بگيريد

افزودني ها

AutoReDraw=True:خاصيت:PictureBox:= 1- Pic3d ,2- picFLR ,3- PicFTB,4- PicXY ,4-PicTop,5- PicSTB

CommandButton:= 1-BUTNOKAY,2- BUTNStart,3-BUTNStop,4-BUTNReset,5-BUTNQuit

TextBox:=TEXTAngle

:Interval=100,Enabled=FalseخاصيتTimer:=Timer1

بعد از افزودن اشياع بالا و تنظيم خاصيت تعريف هاي زير رو به فرم اضافه كنيد

Dim Angle As Double 'The rotation angle
Dim AngleHolder As Double 'holder for previous rotation angle
Dim NumObjectSides As Integer 'Number of sides making up the object

Private Type Point 'The makeup of a point
X As Double 'the X location of the point
Y As Double 'the Y location of the point
Z As Double 'the Z location of the point
End Type
Dim Center As Point 'center of the picboxes

Private Type Verticies 'The verticies of a side
NumPoints As Integer 'The number of points on a line
Points(20) As Point 'the actual endpoints of each line
Normal As Point 'The normal of the Plane
End Type
Dim Sides(50) As Verticies 'the sides of the object
Dim XSides(50) As Verticies 'the X rotation points
Dim YSides(50) As Verticies 'the Y rotation points
Dim ZSides(50) As Verticies 'the Z rotation points
Dim Sides3D(50) As Verticies 'the 3D rotation of points

Dim CosAng(359) As Double 'A lookup table to hold the Cosine Angles
Dim SinAng(359) As Double 'A lookup table to hold the Sine Angles

Private Type POINTAPI 'This is the drawn Points of the
X As Long 'object to fill it and draw it fast
Y As Long 'using a win api function
End Type

Dim tmp() As POINTAPI
'This function is for drawing filled polygons Much faster than anything I wrote
Private Declare Function Polygon Lib "gdi32" _
(ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

خب حالا قدم به قدم جلو مي ريم و توابع زير را نيز در فرم بنويسيد توجه كنيد ما در اين پروژه از ماژول استفاده نكرديم وتمام كدها داخل فرم نوشته مي شن

Private Function DrawShape(shape As Verticies, PicBox As PictureBox, View As String)

' add 75 to all points to center object

'determine view
If View = "FRONT" Then

'create lppoints for the win func call
ReDim tmp(shape.NumPoints) As POINTAPI

'fill in the drawing points tmp.x as the value going in the x dir etc
For i = 0 To shape.NumPoints
tmp(i).X = shape.Points(i).X + 75
tmp(i).Y = shape.Points(i).Y + 75
Next i

'Draw solid polygons

'calculate light value (ambient + Max * (normal of plane * light position)
Colr = 100 + 200 * (shape.Normal.Z)
'Fill object as solid
PicBox.FillStyle = 0
'Choose the color (this way makes a shade of yellow)
PicBox.FillColor = RGB(Colr, Colr, Colr / 2)
'draw the polygon
Polygon PicBox.hdc, tmp(0), shape.NumPoints + 1
'draw rest of objects transparently
PicBox.FillStyle = 1

ElseIf View = "TOP" Then

'creat lppoints for the win func call
ReDim tmp(shape.NumPoints) As POINTAPI

'fill in the drawing points tmp.x as the value going in the x dir etc
For i = 0 To shape.NumPoints
tmp(i).X = shape.Points(i).X + 75
tmp(i).Y = shape.Points(i).Z + 75
Next i

'Draw solid polygons

'calculate light value (ambient + Max * (normal of plane * light position)
Colr = 100 + 200 * (shape.Normal.Y)
'Fill object as solid
PicBox.FillStyle = 0
'Choose the color (this way makes a shade of yellow)
PicBox.FillColor = RGB(Colr, Colr, Colr / 2)
'draw the polygon
Polygon PicBox.hdc, tmp(0), shape.NumPoints + 1
'draw rest of objects transparently
PicBox.FillStyle = 1


ElseIf View = "SIDE" Then
'creat lppoints for the win func call
ReDim tmp(shape.NumPoints) As POINTAPI

'fill in the drawing points tmp.x as the value going in the x dir etc
For i = 0 To shape.NumPoints
tmp(i).X = shape.Points(i).Z + 75
tmp(i).Y = shape.Points(i).Y + 75
Next i

'Draw solid polygons
'calculate color value (ambient + Max * (normal of plane * light position)
Colr = 100 + 200 * (shape.Normal.X)
'Fill object as solid
PicBox.FillStyle = 0
'Choose the color (this way makes a shade of yellow)
PicBox.FillColor = RGB(Colr, Colr, Colr / 2)
'draw the polygon
Polygon PicBox.hdc, tmp(0), shape.NumPoints + 1
'draw rest of objects transparently
PicBox.FillStyle = 1

End If

End Function

Private Function VisiblePlane(shape As Verticies, CameraX As Integer, CameraY As Integer, CameraZ As Integer)
'this function takes the normal of the plane and returns True if visible FALSE if
'not visible

'Camera is the spot the object is being viewed from

'Find the dot product
D = (shape.Normal.X * CameraX) + (shape.Normal.Y * CameraY) + (shape.Normal.Z * CameraZ)

'return true if object is visible
VisiblePlane = D >= 0

End Function

Private Function FindNormals()
'This function finds the normal of each plane

For i = 0 To NumObjectSides
'Find the normal vector
With Sides(i)
' * * * * * * * *
Nx = (.Points(1).Y - .Points(0).Y) * (.Points(.NumPoints).Z - .Points(0).Z) - (.Points(1).Z - .Points(0).Z) * (.Points(.NumPoints).Y - .Points(0).Y)
Ny = (.Points(1).Z - .Points(0).Z) * (.Points(.NumPoints).X - .Points(0).X) - (.Points(1).X - .Points(0).X) * (.Points(.NumPoints).Z - .Points(0).Z)
Nz = (.Points(1).X - .Points(0).X) * (.Points(.NumPoints).Y - .Points(0).Y) - (.Points(1).Y - .Points(0).Y) * (.Points(.NumPoints).X - .Points(0).X)


'Normalize the normal vector (make length of 1)
Length = Sqr(Nx ^ 2 + Ny ^ 2 + Nz ^ 2)

.Normal.X = Nx / Length
.Normal.Y = Ny / Length
.Normal.Z = Nz / Length
End With
Next i

End Function

Private Function CreateTables()
'Create cosine and sine lookup table
For i = 0 To 359
CosAng(i) = Cos(i * (3.14159265358979 / 180)) 'convert degrees to radians
SinAng(i) = Sin(i * (3.14159265358979 / 180)) 'convert degrees to radians
Next i
End Function

Sub Redraw()

'clear the picboxes
PicXY.Cls
PicFRL.Cls
PicTop.Cls
PicFTB.Cls
PicSTB.Cls
Pic3D.Cls


'draw the front of the box in the stationary view
DrawShape Sides(0), PicXY, "FRONT"


'repeat loop 6 times once for each side the rotation of each point must
'be calculated to find the new position of the normal of each side to
'determine if it's visible
For j = 0 To 5
'**************************************************************
'draw the points for a top to bottom rotation (rotation around
'the X axis)
'**************************************************************

For i = 0 To Sides(0).NumPoints
XSides(j).NumPoints = Sides(0).NumPoints

XSides(j).Points(i).X = Sides(j).Points(i).X 'new x value
XSides(j).Points(i).Y = Sides(j).Points(i).Y * CosAng(Angle) - Sides(j).Points(i).Z * SinAng(Angle) 'new y value
XSides(j).Points(i).Z = Sides(j).Points(i).Z * CosAng(Angle) + Sides(j).Points(i).Y * SinAng(Angle) 'new z value

XSides(j).Normal.X = Sides(j).Normal.X
XSides(j).Normal.Y = Sides(j).Normal.Y * CosAng(Angle) - Sides(j).Normal.Z * SinAng(Angle) 'new y value
XSides(j).Normal.Z = Sides(j).Normal.Z * CosAng(Angle) + Sides(j).Normal.Y * SinAng(Angle) 'new z value

Next i

'check to see if plane is visible if so draw it
If VisiblePlane(XSides(j), 0, 0, 1000) Then
'Draw lines in top, top to bottom rotation
DrawShape XSides(j), PicFTB, "FRONT"
End If
If VisiblePlane(XSides(j), 1000, 0, 0) Then
'Draw points in side, top to bottom rotation view
DrawShape XSides(j), PicSTB, "SIDE"
End If



'**************************************************************
'draw the points for a left to right rotation (rotation around
'the Y axis)
'**************************************************************

For i = 0 To Sides(0).NumPoints
YSides(j).NumPoints = Sides(0).NumPoints

YSides(j).Points(i).X = Sides(j).Points(i).X * CosAng(Angle) + Sides(j).Points(i).Z * SinAng(Angle) 'new x value
YSides(j).Points(i).Y = Sides(j).Points(i).Y 'new y value
YSides(j).Points(i).Z = Sides(j).Points(i).Z * CosAng(Angle) - Sides(j).Points(i).X * SinAng(Angle) 'new z value

YSides(j).Normal.X = Sides(j).Normal.X * CosAng(Angle) + Sides(j).Normal.Z * SinAng(Angle) 'new x value
YSides(j).Normal.Y = Sides(j).Normal.Y 'new y value
YSides(j).Normal.Z = Sides(j).Normal.Z * CosAng(Angle) - Sides(j).Normal.X * SinAng(Angle) 'new z value

Next i

'check to see if plane is visible if so draw it
If VisiblePlane(YSides(j), 0, 0, 1000) Then
'Draw lines in front right to left rotation view
DrawShape YSides(j), PicFRL, "FRONT"
End If
If VisiblePlane(YSides(j), 0, 1000, 0) Then
'Draw lines in top right to left rotation view
DrawShape YSides(j), PicTop, "TOP"
End If
'cod Created By:NasserNiazy-Nasservb.blogfa.cm

'Rotate values rotated in X direction in Z direction to make "spinning effect"
For i = 0 To Sides(0).NumPoints
Sides3D(j).NumPoints = Sides(0).NumPoints

Sides3D(j).Points(i).X = XSides(j).Points(i).X * CosAng(Angle) + XSides(j).Points(i).Y * SinAng(Angle) 'new x value
Sides3D(j).Points(i).Y = XSides(j).Points(i).Y * CosAng(Angle) - XSides(j).Points(i).X * SinAng(Angle) 'new y value
Sides3D(j).Points(i).Z = XSides(j).Points(i).Z 'new z value

Sides3D(j).Normal.X = XSides(j).Normal.X * CosAng(Angle) + XSides(j).Normal.Y * SinAng(Angle) 'new x value
Sides3D(j).Normal.Y = XSides(j).Normal.Y * CosAng(Angle) - XSides(j).Normal.X * SinAng(Angle) 'new y value
Sides3D(j).Normal.Z = XSides(j).Normal.Z 'new z value

Next i

'check to see if plane is visible if so draw it
If VisiblePlane(Sides3D(j), 0, 1000, 0) Then
'Draw the 2 direction rotation
DrawShape Sides3D(j), Pic3D, "TOP"
End If
Next j

'draw centerpoint of each picbox in Blue
PicXY.Circle (Center.X, Center.Y), 30, RGB(0, 0, 255)
PicFRL.Circle (Center.X, Center.Y), 30, RGB(0, 0, 255)
PicTop.Circle (Center.X, Center.Y), 30, RGB(0, 0, 255)
PicFTB.Circle (Center.X, Center.Y), 30, RGB(0, 0, 255)
PicSTB.Circle (Center.X, Center.Y), 30, RGB(0, 0, 255)
Pic3D.Circle (Center.X, Center.Y), 30, RGB(0, 0, 255)

End Sub

سعي كردم داخل خود كدها توضيح هر قسمت رو بنويسم

مي پردازيم به كد دكمه ها.كد هاي زير را داخل فرم كپي كنيد

Private Sub BUTNOKAY_Click()
'set the angle and draw the rotation
AngleHolder = AngleHolder + 5 'increment the angle

If AngleHolder = 360 Then 'reset the angle back to 0
AngleHolder = 0
End If

TEXTAngle.Text = AngleHolder 'display the current angle
Angle = AngleHolder 'Set the angle for calculations

Redraw 'refresh the display

End Sub

Private Sub BUTNQuit_Click()
End 'end the program
End Sub

Private Sub BUTNReset_Click()
AngleHolder = 355 'reset so displayed angle will be 0
BUTNOKAY_Click 'set angles and displays, then redraw
End Sub

Private Sub BUTNStart_Click()
Timer1.Enabled = True 'start the autodraw timer
End Sub

Private Sub BUTNStop_Click()
Timer1.Enabled = False 'stop the auto draw timer
End Sub

Private Sub Form_Load()

'Form1.ScaleMode = vbTwips

Angle = 0 'initialize the angles
AngleHolder = 355
Center.X = Pic3D.Width / 2 'set the centers (all coordinates for the picboxes must be equal
Center.Y = Pic3D.Height / 2 'acroos picboxes for this to work)(i.e. the X dimension in left
Center.Z = Pic3D.Width / 2 'to right picbox must equal X dimension in top to bottom picbox)

'set points for rectangle (could be done in a better way loop etc.)
'Also shape does not have to be rectangle can be any shape
'front
Sides(0).Points(0).X = -20: Sides(0).Points(0).Y = -50: Sides(0).Points(0).Z = 20
Sides(0).Points(1).X = 50: Sides(0).Points(1).Y = -50: Sides(0).Points(1).Z = 20
Sides(0).Points(2).X = 50: Sides(0).Points(2).Y = 50: Sides(0).Points(2).Z = 20
Sides(0).Points(3).X = -20: Sides(0).Points(3).Y = 50: Sides(0).Points(3).Z = 20

'back
Sides(1).Points(0).X = 50: Sides(1).Points(0).Y = -50: Sides(1).Points(0).Z = -20
Sides(1).Points(1).X = -20: Sides(1).Points(1).Y = -50: Sides(1).Points(1).Z = -20
Sides(1).Points(2).X = -20: Sides(1).Points(2).Y = 50: Sides(1).Points(2).Z = -20
Sides(1).Points(3).X = 50: Sides(1).Points(3).Y = 50: Sides(1).Points(3).Z = -20

'Top
Sides(2).Points(0).X = -20: Sides(2).Points(0).Y = -50: Sides(2).Points(0).Z = -20
Sides(2).Points(1).X = 50: Sides(2).Points(1).Y = -50: Sides(2).Points(1).Z = -20
Sides(2).Points(2).X = 50: Sides(2).Points(2).Y = -50: Sides(2).Points(2).Z = 20
Sides(2).Points(3).X = -20: Sides(2).Points(3).Y = -50: Sides(2).Points(3).Z = 20

'bottom
Sides(3).Points(0).X = -20: Sides(3).Points(0).Y = 50: Sides(3).Points(0).Z = 20
Sides(3).Points(1).X = 50: Sides(3).Points(1).Y = 50: Sides(3).Points(1).Z = 20
Sides(3).Points(2).X = 50: Sides(3).Points(2).Y = 50: Sides(3).Points(2).Z = -20
Sides(3).Points(3).X = -20: Sides(3).Points(3).Y = 50: Sides(3).Points(3).Z = -20

'Lside
Sides(4).Points(0).X = -20: Sides(4).Points(0).Y = -50: Sides(4).Points(0).Z = -20
Sides(4).Points(1).X = -20: Sides(4).Points(1).Y = -50: Sides(4).Points(1).Z = 20
Sides(4).Points(2).X = -20: Sides(4).Points(2).Y = 50: Sides(4).Points(2).Z = 20
Sides(4).Points(3).X = -20: Sides(4).Points(3).Y = 50: Sides(4).Points(3).Z = -20

'Rside
Sides(5).Points(0).X = 50: Sides(5).Points(0).Y = -50: Sides(5).Points(0).Z = 20
Sides(5).Points(1).X = 50: Sides(5).Points(1).Y = -50: Sides(5).Points(1).Z = -20
Sides(5).Points(2).X = 50: Sides(5).Points(2).Y = 50: Sides(5).Points(2).Z = -20
Sides(5).Points(3).X = 50: Sides(5).Points(3).Y = 50: Sides(5).Points(3).Z = 20

'set the number of edges for each side
For i = 0 To 5
Sides(i).NumPoints = 3
Next i

'set the number of sides the object has
NumObjectSides = 5

'Calculate the Normals
FindNormals

'Create the Lookup table for the Cos and Sin functions.
'This method is much faster than calculating each step
CreateTables

'set angles and displays, then redraw
BUTNOKAY_Click

End Sub
Private Sub Timer1_Timer()
'rotate the rectangle
BUTNOKAY_Click
End Sub

اگه كد هاي بالا رو درست كپي كنيد بازدن دكمه ي استارت مستطيل شروع به گردش در نماهاي مختلف از جمله سه بعدي مي كنه

در Form_Loadكد زير را بنويسيد
TranslucentForm Me, 255
در كد تغييرChangeاسكرول كد زير رابنويسيد
TranslucentForm Me, HScroll1.Value
اين حالت يعني كم رنگ كردن فرم من در جايي نديدم كه استفاده بشه چون بسيار به سيستم فشار مياره.و
تقريبآ يه حالت هنك مانند ايجاد مي كنه

اين سوالات در مقطع كارداني پيوسته سراسري است كه دوم مرداد سال گذشته برگزار شد

از اونجايي كه خود سازمان سنجش اين سوالات رو اينترنتي منتشر نمي كنه پيدا كردنش سخته

علاوه بر اينكه نوشتن فارسي انگليسي سوالات پدرم رو به صورت كامل درآورد مرور خاطره هاي تلخ گذشته نوعي سردرد

عجيب در من ايجاد مي كرد ولي چه كنم كه شايد اگه پارسال منابع بيشتري داشتم الان اين مطالب رو نمي نموشتم وشايد در

موردمخ زني ودختر بازي مي نوشتم ولي يكي بايد اين كار را مي كردم تابقيه (دهاتيا) به سر نوشتم دچار نشوند .مال 84 رو هم دارم اگه خواستين بگين

اگر نمي توانيد بخوانيد از حالت تمام صفحه استفاده كنيد!! بگذريم راستي اين نظر ندادنتون منو كشته

سلام از اونجايي كه تصميم گرفتم پست هام رو با هم بفرستم تا بلكه شما نظر بدين بهش امروز هم دو سه تا پست دارم
يك-مخفي كردن منوي استارت از سري آموزش هاي قبلي
احتياج داريد كه اينگونه تعريف مي شودuser32.dllبراي مخفي كردن منوي استارت به يك تابع از كتابخانه

Option Explicit

Dim hwnd1 As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Const SWP_HIDEWINDOW = &H80

Const SWP_SHOWWINDOW = &H40

ديديد كه تابع درازيه حالا بايددو تا دكمه براي مخفي و آشكار كردن منوي استارت به فرم اضافه كنيد
كد مخفي كردن استارت

Hwnd1=FindWindow("Shell_traywnd","")
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_HIDEWINDOW)

كد ظاهر كردن استارت

call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_SHOWWINDOW)

خوب صفا كردين-حالا يه نظر بدن تا بعديشو بگم
دو-چطور مي شه آيكون يك برنامه رو از كالبدش كشيد بيرون وبه صورت فايل آيكون ذخيره كرد
اين آموزش از سري آموزشي كتابخانه قدرتمند شل هست كه قبلآ هم يكي دو تا شو گفتم
يك ماژول به پروژه (اوه كيبردم عجب گردو خاكي گرفته!!) اضافه كنيدوكد زير را داخلش كپي كنيد

Public Const MAX_PATH = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 ' System icon index
Public Const SHGFI_LARGEICON = &H0 ' Large icon
Public Const SHGFI_SMALLICON = &H1 ' Small icon
Public Const ILD_TRANSPARENT = &H1 ' Display transparent
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX
Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE

Public Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type

Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) As Long

Public Declare Function ImageList_Draw Lib "comctl32.dll" _
(ByVal himl&, ByVal i&, ByVal hDCDest& _
,ByVal x&, ByVal y&, ByVal flags&) As Long

Public shinfo As SHFILEINFO
'--------------------------

يه دكمه به برنامه اضافه كنيدImageحالا يك تكست بكس وبادوتا
آدرس فايل اجرايي را داخل تكست بكس بنويسيدودر كد كليك دكمه كد
زير را بنويسيد

Dim hImgSmall As Long
Dim FileName As String
Dim r As Long

FileName$ = Text1.Text

hImgSmall& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)

hImgLarge& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)

Label1.Caption = Left$(shinfo.szDisplayName, InStr(shinfo.szDisplayName, Chr$(0)) - 1)

Label2.Caption = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)

image1.Picture = LoadPicture()
image2.Picture = LoadPicture()

r& = ImageList_Draw(hImgSmall&, shinfo.iIcon, image1.hDC, 0, 0, ILD_TRANSPARENT)
r& = ImageList_Draw(hImgLarge&, shinfo.iIcon, image2.hDC, 0, 0, ILD_TRANSPARENT)

نه خداييش بازم نظر نمي دين حالا اينو داشته باشين
سه-چطور مي شه دكمه بستن پنجره در گوشه فرم رو غير فعال كرد
شايد غير فعال كرد دكمه هاي تمام صفحه و كمينه رو بلد باشين ولي
ديگه فرم خاصيت غير فعال كردن دكمه كلوز رو نداره مگه كنترل بوكس فرم رو
برداريم يا اصلآ فرم رو از نوع بدون منوي بالا وتيتر انتخاب كنيم
ولي با اين كد مي تونين با داشتن تمام كنترل ها فقط دكمه كلوز رو غير فعال كنين
تابع زير رو تعريف كنيد

Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Public Sub DisableXbutton(ByVal frmHwnd As Long)
Dim hMenu As Long
hMenu = GetSystemMenu(frmHwnd, 0&)
If hMenu Then
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
DrawMenuBar (frmHwnd)
End If
End Sub

بنويسيدForm_Loadحالا كد زير رو داخل

DisableXbutton (Me.hwnd)

ببينم بازم نظر نمي دين

رو غير فعال كنهCRTL_ALT_Deletاين تابع كه مي گم مي تونه كليد هاي

البته حتمآ بايد سريع به حالت قبل برگردونيد چون موندن اين حالت زياد جالب نيست

طريقه فراخواني

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

Private Const SPI_SCREENSAVERRUNNING = 97

DesabledوEnabledحالا دو تا كامند به فرم اضافه كنيد به اسم هاي
كد دكمه غير فعال كرد ن

Private Sub Disabled_Click()

Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)

End Sub

نيز فراخواني كنيدUnloadكد فعال سازي اين كليد ها بهتر است اين كد هار در فرم

Private Sub EnableD_Click()

Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)

End Sub

راستي اين كد رو هم توي پروژه ديگه تست كنيد-تارخ فارسي

MsgBox WeekdayName(Weekday(Date), False, vbSunday) & ", " & VBA.MonthName(VBA.Month(Date)) & " " & Day(Date) & ", " & VBA.Year(Date), vbOKOnly + vbInformation, "The date"

موفق باشيد

ويندوز رو ظا هر كردBrows Folderچطور مي توان كادر-

اين كادر استفاده ي بسيار زيادي در برنامه هاي كاربردي داره.وموقعي استفاده مي شه كه كار بر بايد يك پوشه رو (مثلآ براي نصب برنامه )انتخاب كنه

يك ماژول ايجاد كنيد و كد هاي زبر رابنويسيد

'------Typing New data For BrowsForm---------------------
Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

'---------------Conset For BrowsForm--------------------
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260

'-----------------------Declareing API------------------------------------------
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

حال در جايي كه مي خواهيد كادر ظاهر شود كد زير رابنويسيد

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "Select Folder... "
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
msgbox( sBuffer)
End If

در پايان در خط ماقبل آخر بايك پيغام مسير انتخلب شده كاربر اعلام مي شود كه شما عزيزان مي توانيد آنرا به دلخواه تغيير دهيد

را ظا هر كرد(Propertis)چطور مي توان كادر خصوصيات مربوط به يك فايل-

كادر خصوصيات اكثرآ در نوشتن يك كاد آرشيو يا ليست فايل كاربرد دارد كه شما روي نام فايل راست كليك مي كنيد و اين گزينه را معمولآ در انتهاي ليست انتخاب مي كنيد واين كادر ظاهر ميشود نوشتن چنين كد هايي باعث حرفه شدن برنامه ي شما مي گردد

به ماژولمان كد هاي زير را اضافه كنيد

'------Typing New data For Propertis File---------------------
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
'---------------Conset For Propertis Dialog-------------------
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Public Const ATTR_NORMAL = 0
Public Const ATTR_READONLY = 1
Public Const ATTR_HIDDEN = 2
Public Const ATTR_SYSTEM = 4
Public Const ATTR_VOLUME = 8
Public Const ATTR_DIRECTORY = 16
Public Const ATTR_ARCHIVE = 32
'-----------------------Declareing API------------------------------------------
Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
"ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

'-----------------------------------------------------------------------------------------

Public Function ShowFileProperties(filename As String, OwnerhWnd As Long) As Long
Dim SEI As SHELLEXECUTEINFO
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
ShellExecuteEX SEI
ShowFileProperties = SEI.hInstApp
End Function

حالا هر فايلي را كه مي خواهيد خصوصيياتش نمايش داد شود به اين تابع به صورت زير ارسال كنيد-پاس دهيد

ShowFileProperties(FileName,Me.hwnd)

نظر يادت نره با مرام

چطور ميتوان سطل آشغال ويندوز رو خالي كرد

اگه بخوايد يك برنامه تقويت ويندوز بنويسيد به گزينه خالي كردن سطل آشغال ويندوز نياز خواهيد داشت

سري قبل اين اموزش رو در مورد كنترل سي پي يو (تاكس منيگر)ويندوز نوشتم

براي اين كار بايد از تابعي موجود در كتابخانه قدرتمند شل كه در آرشيو اموزشهاي زيادي راجع به اين كتابخانه هست استفاده كنيد

شيوه ي تعريف كتابخانه

Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hWnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Const SHERB_NOPROGRESSUI = &H2

شيوه ي استفاده

Private Sub Command1_Click()
Dim retvaL
retvaL = SHEmptyRecycleBin(Form1.hWnd, "", SHERB_NOPROGRESSUI)
End Sub

عزيزان توجه كنيد خالي كرد سطل آشغال بدون اجازه كابر مي تونه خيلي ناخوشايند باشه.ويعضي از كاربران مبتدي اون رو نوعي حافظه و درايو جدا حساب ميكنن وبعضي چيز هاشون رو اونجا مخفي مي كنند

موفق باشيد

تا بگم بعدش چي كار كنيدHScrollيه فرم ايجاد كنيد وفعلآ الل حساب يه هف هشتا ليبل بزارين روش با يه تايمر و يه

مربوط به اسكرول رو روي100 بزارينMaxخاصيت

تايمر رو روي 50 بزارينIntervalخاصيت

اين كدها رو اولين خط فرم بنويسيد

'----------Type New Data For Memory------------------
Private Type MEMORYSTATUS
dwlength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type '------------------Declear API Of Kernal Windows Librery-------------
Private Declare Sub GlobalMemoryStatus Lib "KERNEL32" (lpBuffer As MEMORYSTATUS)
Dim Mem As MEMORYSTATUS

روي تايمر دابل كليك كنيد و كد زير را بنويسيد

GlobalMemoryStatus Mem
Me.Caption = Mem.dwMemoryLoad & "% used"
Label1.Caption = "Memory used: " & Mem.dwMemoryLoad & "%"
Label2.Caption = "Total Physical Memory: " & Mem.dwTotalPhys
Label3.Caption = "Available Physical Memory: " & Mem.dwAvailPhys
Label4.Caption = "Page File Bytes: " & Mem.dwTotalPageFile
Label5.Caption = "Available bytes of Page File: " & Mem.dwAvailPageFile
Label6.Caption = "Total Virtual bytes: " & Mem.dwTotalVirtual
Label7.Caption = "Available Virtual Bytes: " & Mem.dwAvailVirtual
HScroll1.Value = Mem.dwMemoryLoad

با كداي بالا مي تونين كاركرد سي پي يو ورم رو مشاهده كنيد مثل تكس منيگر خود ويندوز

نظر كه يادت هست آفرين ايوللا بجنب

چطور مي توان از دكستاپ عكس گرفت
اين خط رو در اولين خط كد فرم بنويسيد-براي مبتدي ها

Private 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
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

طريقه استفاده

Private Sub Form_load()
Dim W, H
W = Screen.Width / 15
H = Screen.Height / 15
StretchBlt hdc, 0, 0, W, H, GetDC(0&), 0, 0, W, H, vbSrcCopy
End Sub

كشيدن يك دايره روي فرم با كد نويسي-نمودار دايره اي-بيضي

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
PI = 3.14159265
For i = 0 To 161 Step 10
Me.Circle (219, 167), i, RGB(0, 0, 0), 360 * (PI / 180), 360 * (PI / 180), 1
Next
End Sub

آنرا به 3 تغيير دهيد.داشتم مي گفتم پارامتر سوم براي شعاع دايره -اندازه آن-پارامتر چهارمscalmode توضيحات: پارامتر اول ودوم مكان ترسيم دايره اگر دايره در فرم شما رسم نشد خاصيت
براي رنگ پنجم براي نقطعه شروع وششم براي نقطه ي پايان اين دو تا براي رسم نمودار دايره اي بكار مي روند.پارامتر آخر هم براي رسم بيضي استفاده مي شود

چگونه مي توان يك مداد درست كرد مانند برنامه نقاشي ويندوز
كد زير را بنويسيدMouseMoveدر كد

If Button <> vbright Then Me.PSet (X, Y)

چطور مي توان يك قطره چكان درست كرد كه روي هر گزينه رفت رنگ پيش فرض رنگ انجا شود
عكس بنويسيدMouseMoveبه فرم اضافه كنيد يك عكس داخل كادر عكس قرار دهيد و كدزير را در رويدادPictureويكLabelيك

Label1.BackColor=Picture1.Point(X,Y)

چطور مي توان يك عكس را معكوس كرد

منظورت ازمعكوس اگه معكوس خود عكس در طراحي باشه كد زير جوابش هست

With Picture1
.PaintPicture .Picture, 0, .Height, .Width, -.Height
End With

ولي اگه منظورت معكوس رنگ باشه كد زير جوابش هست

With Picture1
.PaintPicture .Picture, 0, 0, , , , , , , vbDstInvert
End With

يراي موقعي به كار مي رود كه از يك اسم زياداستفاده مي كنيم.اسم را جلوي آن مينويسيم وهر وقت يك دات بزنيم قابل استفاده استWithتوضيحات:ِ
پارامتر اول يراي عكسي كه ميخواهيم از آن براي ترسيم استفاده كنيم.دوم و سوم براي نقطه شروع ترسيم .چهارم و پنجم براي اندازه تصوير ترسيمي.ششموهفتم براي نقطه پايان ترسيم.هشتم ونهم براي اندازه هاي پاياني ترسيم وپارامتر آخر براي نوع ترسيم

چطور ميشه يك عكس رو روشن تر كرد يا پر رنگ
واه! پسر عجب سوالي پرسيدي.ولي از اونجايي كه اينجانب خيلي به ندرت كم مياره اينم جوابت

Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long

Private Sub CmdBrightness_Click()
'variables for brightness, color calculation, positioning
Dim Brightness As Single
Dim NewColor As Long
Dim x, y As Integer
Dim r, g, b As Integer
'change the brightness to a percent
Brightness = TxtBrightness / 100
'run a loop through the picture to change every pixel
For x = 0 To Picture1.ScaleWidth
For y = 0 To Picture1.ScaleHeight
'get the current color value
NewColor = GetPixel(Picture1.hDC, x, y)
'extract the R,G,B values from the long returned by GetPixel
r = (NewColor Mod 256)
b = (Int(NewColor / 65536))
g = ((NewColor - (b * 65536) - r) / 256)
'change the RGB settings to their appropriate brightness
r = r * Brightness
b = b * Brightness
g = g * Brightness
'make sure the new variables aren't too high or too low
If r > 255 Then r = 255
If r < 0 Then r = 0
If b > 255 Then b = 255
If b < 0 Then b = 0
If g > 255 Then g = 255
If g < 0 Then g = 0
'set the new pixel
SetPixelV Picture1.hDC, x, y, RGB(r, g, b)
'continue through the loop
Next y
'refresh the picture box every 10 lines (a nice progress bar effect)
If x Mod 10 = 0 Then Picture1.Refresh
Next x
'final picture refresh
Picture1.Refresh
End Sub

احتياج داريد كه متن درون آن به درصد برابر ميزان روشنايي استTxtBrightnessيك كادر متن به نامCmdBrightnessحال كردين با توضيحات كامل-براي كد بالا يك كامند به نام

چگونگي زدن تيف رنگ (مثلآ سبز به سياه) به يك فرم
فرم كد زير رابنويسيدLoad.در رويداد

On Error GoTo B
Dim r%, F%, Heght%, Wath%, X%, Color$ '--\/\/\/ Set Color Of Form
Color = "Red_Black" '----------------تعيين تيف رنگ
Heigh = Me.Height + 200: Widt = Me.Width
F = Heigh \ 255: r = 0
Select Case Color
Case "Red_Black": GoTo 1
Case "With_Red": GoTo 2
Case "Green_Black": GoTo 3
Case "With_Green": GoTo 4
Case "Blue_Black": GoTo 5
Case "With_Blue": GoTo 6
Case "With_Black": GoTo 7
End Select
Exit Sub '---------------------------Main--------------------------------------------
1
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 0, 0)
Next X
Next i: GoTo B
2 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250, 254 - r, 255 - r)
Next X
Next i: GoTo B
3 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(0, 250 - r, 0)
Next X
Next i: GoTo B
4 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 255, 255 - r)
Next X
Next i: GoTo B
5 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 255 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(0, 0, 250 - r)
Next X
Next i: GoTo B
6 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 20000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 250 - r, 255)
Next X
Next i: GoTo B
7 '--------------------------------------------------------------------------------
For i = 0 To Heigh Step F
r = r + 1
If r = 9000 Then Exit For
For X = i To F + i
Me.Line (0, X)-(Widt, X), RGB(250 - r, 250 - r, 250 - r)
Next X
Next i '--------------------------------------------------------------------------------
B:
Set Me.Picture = Me.Image

آه دستم داغون شد عزيزان ميتونيد اين كد رو خيلي كوتاه استفاده كنيد وهرخط چيني كه مربوط به رنگ خودتونه رو نگه داريد بقيه رو حذف كنيد.با كمي دقت مي توانيد رنگ هاي جديد بسازيد

چگونه سا عت ديجيتال بسازيم(كامپيوتري)-ساعت يا كنتور

به فرم اضافه كنيدPictureكوتاهترين راه براي ساخت يك ساعت روش زير است يك

Private Sub Form_Load()
Static Score As Long
Counter.Show
DoEvents
Score = 0
For I = 1 To 1265
DisplayNumber 10, Score
Score = I
DoEvents
Next
End Sub'-------------------------------------------------------------------
Private Sub DisplayNumber(DisplayWidth As Integer, TheNumber As Long)
Dim DisplayString As String, Zeros As Integer, GraphicsHeight As Single
Dim DigitValue As Integer, NumPosition As Integer
'--------------------Start Time---------------
GraphicsHeight = Picture1.ScaleHeight / 2
Zeros = DisplayWidth - Len(Trim(TheNumber))
For I = 0 To Zeros - 1
DisplayString = DisplayString & "0"
Next
DisplayString = DisplayString & Trim(Str(TheNumber))
For I = 0 To DisplayWidth - 1
DigitValue = Val(Mid(DisplayString, I + 1, 1))
If DigitValue = 0 Then NumPosition = 10 Else NumPosition = DigitValue _
Counter.PaintPicture Picture1.Image, I * (Picture1.ScaleWidth / 10), 0, _
Picture1.ScaleWidth / 10, Picture1.ScaleHeight / 2, (NumPosition - 1) _
* (Picture1.ScaleWidth / 10), GraphicsHeight, Picture1.ScaleWidth / 10, Picture1.ScaleHeight / 2
Next
End Sub

Endد ر كد بالا به دلايلي فرم خارج نمي شود بايد يك دكمه براي خروج از فرم تنظيم كنيدودر كد كليك آن بنوسيد

روخاسته بودن "GDI32.Dll"يكي از دوستان ليست تمامي توابع موجود در فايل
تورو خدا به من رحم كنيد!!.شوخي كردم به زودي
براي امروز ديگه كافيه - فقط نظر يادتون نره

درست كنيمM3Uبا پسوندPlayList چطور يك فايل

SavePlaylistگاهي وقتي عده ي زيادي فايل را در مدا پلير يا وينمپ باز مي كنيم يك گزينه به نام

مي بينيم كه براي ضخيره كردن آن ليست در يك فايل استفاده مي شود.اگر يك برنامه ي پخش صوت يا تصوير باكنترل مديا پلير نيز بنويسيد براي پخش هم زمان چندين فايل به مشكل برخواهيد خورد .درچنين مواقعي مي توانيم با ذخيره ليست در يك فايل ام تري يو وباز كردن آن در كنترل مديا پلير چندين فايل را با هم پخش كرد .شايد شما بتوانيد فايل هايتان را مستقيمآ به ليست مديا پلير احتياج به دانستن فرمت فايل ام تري يو داريدPlayListاضافه كنيد ولي باز هم براي ذخيره

با اين تابع اين كار را انجام دهيد

Public Sub SaveList(OutPath As String,Lst as ListBox)
On Error Resume Next '--------------------------------------------------
Dim T3 As String, T2, strans As String, L As Single, i As Integer
T3 = "": T2 = ""
If Lst.List(1) = "" Then
strans = MsgBox("File Not Found!", vbCritical)
Exit Sub '------------------------------------------------------
End If
If UCase(Right(OutPath, 3)) <> "M3U" Then Exit Sub
Open OutPath For Output As #1
Print #1, "#EXTM3U:"
For i = 1 To Lst.ListCount '----------------------------
Print #1, "#EXTNIF:"
Print #1, Lst.List(i)
Next i '------------------------------------------------------
Close #1
End Sub

حال براي زخيره كردن فايل هاي صوتي و تصويري موجود در يك ليست تنها به دستور زير نياز داريد

SaveList "C:\1.M3U",List1

نظردادن يادتون نره

كنترل خطا

مثلمآ هيچيك از ما دوست نداريم جلوي دوستامون يا مدير مدرسه يا معلم برنامه مون با يك خطاي مهلك مثلآ سينتكس متوقف بشه هميشه دوست داريم

برنامه هامون بدون خطا اجرا بشه.آيا ممكنه برنامه اي نوشت كه اصلآ خطا نكنه.هيچ برنامه نويسي نمي تونه تمام رويداد هاي ممكن وحالت هاي مختلف

رو پيش بيني كنه ولي روش هايي براي جلو گيري از اعلام خطا وجود داره

ON Errorدستور

اين دستور در ابتداي يك رويداد نوشته مي شه و به برنامه مي گه وقتي خطا شد چي كار كنه .معمولآ به صورتهاي زير استفاده مي شه

On Error Resume Next---On Error GoTo Label Name

در حالت سمت چپ به برنامه مي گيم اگه خطا شد ازش صرف نظر كن وبه دستور بعدي برو

On Error GoTo Label Name ولي هميشه توصيه مي شه از حالت سمت چپ استفاده شود.در مدل

مي نويسيم Label Name ما بايد يك برچسپ به هر نامي كه مي خواهيم ايجاد مي كنيم ونام انرا به جاي
مثال

Private Sub Form_Load()

On Error GoTo MyName

Int D=12 \ 0

Exit Sub

MyName:

MsgBox "Division By Zero Is Invalid!!"

End sub

مثال ساده اي بود از رسيدگي به خطاي تقسيم بر صفر.دقت كنيد در اين برنامه هر گاه خطا اجرا شود دستورات بعداز نام برچسب اجرا مي شودو اگر عبارت

را ننويسيد در هر بار كه برنامه اجرا شود دستورات برچسب اجرا مي شود حالExit Sub
را با هم بهOn Errorچه خطا رخ دهد چه رخ ندهد. مي توانيد در يك رويداد چندين دستور

كا رببريد وبراي هر كدام يك برچسب رسيدگي درست كنيد .مي توانيد از يك برچسب براي همه استفاده كنيد و خطاها را با شماه اش تشخيص دهيد .مثال

Private Sub Form_Load()

On Error GoTo MyName

Int D=12 \ 0

Exit Sub

MyName:

select case Err.Number

Case 11: MsgBox "Division By Zero Is Invalid!!"

End Select

End sub

اطلا عات خطا را در خود نگاه ميدارد .در برنامه بالا مي توانيد هر خطا را به Errشي

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

براي اينكار بايد خطي كه مي خواهيد برنامه از انجا ادامه پيدا كند را شماره گزاري كنيد يا زير يك برچسب بنويسيد واز اين

Resume LabelName Or Line Numberعبارت استفاده كنيد

بنويسيد برنامه از هرجا كه خطاResume Nextاگر اول يك خط يك شماره بنويسيد آن خط را شماره گزاري كرده ايد.اگر

نظر يادتون نره.Errشده ادامه مي دهد.توضيحات شي

تنظيم ابعاد نمايش ويندوز براي يك برنامه اختصاصي

برنامه هاي سه بعدي از فضا نمي آيند توسط همين وي بي -دلفي واكثرآ سي پلاس پلاس طراحي مي شن وقتي يك بازي سه بعدي روباز مي كنيم ويك دفعه يك صفحه با گرافيكي كه تا حالا نديديم يه صورت زيبا بالا مي آد اكثر ما -بيشتر خودم- خيلي كف ميكنيم كه اين برنامه ها چطور ساخته مي شن-با چي ساخته مي شن

امروز مي خوام تنظيم ابعاد صفحه نمايش ويندوز رو با ابعاد دلخواه خودمون بگم كه گام اول طراحي سه بعديه اگه بشه شايد مراحل بعديش رو هم بزارم روي سايت كه مونده به ياري شما .بانظراتتون و خدا با توفيقش

ابتدا متغيير هاي اول فرم

Dim Dx As New DirectX7
Dim Dd As DirectDraw4
Dim clip As DirectDrawClipper

البته بعد از نوشتن كد بالا به منوي پروژه رفته گزينه ريفرنس رو انتخاب كنيد در منوي باز شده تيك گزينه ي دايركت ايكس 7 رو بزنيد

تا كد هاتون اجرا بشه روي فرم دابل كلاك كنيد و كد زير رو بنويسيد

Set Dd = Dx.DirectDraw4Create("")
Set clip = Dd.CreateClipper(0)
clip.SetHWnd Me.hWnd
' screen mode
Dd.SetDisplayMode 800, 600, 32, 0, DDSDM_DEFAULT

بااين كد صفحه نمايش به مد 800*600و حالت 32بايتي ميره اگه مدي ديگري رو مي خوايد بايد جاي اين گزينه ها بنويسيد

سلام
امروز می خوام براتون از بعضی خواص فرم ها بگم
1-appearance =این خاصیت مشخص میکند که فرم به صورت سه بعدی (3D) باشد یا تخت (flat)
2-Back Color=این خاصیت رنگ زمینه فرم را مشخص میکند
3-Border style=این خاصیت اگر بر روی(0-None)باشد فرم را بدون حاشیه و دکمه های مینیمایز و ماکسیمایز وبستن نشان میدهد و کاربر نمی تواند آن را تغییر اندازه بدهد و اگر بر روی(1-Fixed single)باشد فرم را با حاشیه و دکمه بستن نشان میدهد و کاربر نمی تواند آن را تغییر اندازه بدهد و اگر بر روی(2-Sizable) باشد تمام دکمه ها و حاشیه فرم را نشان میدهد.
4-Icon=این خاصیت آیکون برنامه را مشخص می کند
5-Max button=این خاصیت فعال یا غیر فعال بودن دکمه ماکسیمایز را مشخص می کند
6- Min button=این خاصیت فعال یا غیر فعال بودن دکمه مینیمایز را مشخص می کند
7-Mouse icon=این خاصیت شکل نشانگر موس را تعیین می کند
8-Mouse Pointer=این خاصیت نوع شکل نشانگر موس را مشخص می کند مثل ساعت شنی یا دست شدن نشانگر
9-Movable=این خاصیت مشخص میکند که آیا کاربر اجازه دارد که فرم را جابجا کند یا نه
10-Picture=عکس زمینه فرم را مشخص می کند
11-ShowIn Taskbar=مشخص می کند که برنامه در تسکبار دیده شود یا نه
12-Startup position=محل قرار گرفتن فرم در هنگام شروع برنامه را مشخص می کند
13-Window state=نوع نمایش پنجره در هنگام شروع برنامه(مینیمایز/ماکسیمایز/نرمال

توسط اين دستور مي تونيد فايلي را در وي بي اجرا كنيد .آدرسي كه جلوي اين دستور نوشته مي شه اجرا ميشه .شكل اين دستور به اين صورت است:ِ

Shell ProgramPath,RunModel

در آرگومان اول مسير فايل نوشته مي شود ودر آرگومان دوم مدلي كه برنامه بايد اجرا شود.در اين ارگومان از آرگومان هاي زير استفاده مي گردد

vbHide=0 vbMaximizedFocus=1 vbMinimizedFocus=2 vbMinimizedNoFocus=3 vbNormalFocus=4 vbNormalNoFocus=5

در مدل صفر برنامه به صورت پنهان ظاهر مي شود.براي مواقعي كه مي خواهيم عمل اجرا را از ديد كاربر پنهان كنيم .در مدل 2 برنامه اجرا مي شود به صورت كمينه(روي منوي استارت-مينيمايز شده)وفاكس هم روي ان مي رود يعني اين كه بعد از اجرا هي زرد و آبي مي شود تا كار بر روي آن كليك كند.مدل 3برنامه به

صورت ينيمايز -كمينه اجرا مي شود زرد وآبي نمي شود (معمولي-فاكس رويش نمي رود).مدل 1برنامه به صورت تمام صفحه اجرا شده فاكس هم روي آن مي رود(زرد و ابي مي شود).در مدل 4برنامه با اندازه پيش فرض اجرا مي شودوفاكس را هم مي گيرد.درمدل 5برنامه با اندازه معمولي اجرا شده و فاكس نمي گيرد

كار برد مهم ديگر شل اجرا فايل هاي معمولي با يك برنامه اجرايي است مثل اجراي يك متن در نت پد.براي اين كار نام فايل را بايك فاصله از نام فايل مي نويسيم

Shell "NotPath.Exe"+" C:\Text1.txt" ,4

توجه داشته باشيد كه براي اجراي فايل بايد نام ومسير فيل را با يك كاراكتر فاصله بنويسيد

اگر فاصله ندهيد قطعآ خطا انجام مي شود.اگر فايلي در مسير برنامه تان كپي كرده ايد اين كد را بنويسيد

shell "notpath.exe"+(app.path+"\"+"your File Name")

كلاسي است كه به برنامه اشاره مي كند ومي توان اطلاعات برنامه مانند مسير-نام فايل اجرائي-كمپاني وغيرهapp

براي نوتپد ويندوز چون در درايو ويندوز قرار دارد احتياج به تايپ مسير كامل نيست همچنين اگر شما فايلي را از پوشه

اجرا كنيد به مسير كامل نياز نيست برنامه اي مانند كامند پرامپت بازي ها واسكرين سيور ها در اين پوشه system32

است.مثال

shell "cmd.exe",4

اجراي يك فولدر با شل

واقع در درايو ويندوز را به همراه نام فيل اجرا مي كنيمexplorer.exeبراي اين كار فايل اجرائي

shell "explorer.exe"+" c:\windows" ,3

با اجراي اين برنامه پوشه ويندوز اجرا مي شود روش بالا در سي دي هاي اتوران استفاده ي زيادي دارد

Shell "rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl "كادر حذف برنامه ها
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl"كادر تغيير پس زمينه
Shell "rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl"كادر اينتر نت
Shell "rundll32.exe shell32.dll,Control_RunDLL modem.cpl"كادر مودم
Shell "rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl"كادر صدا
Shell "rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl"كادر شبكه
Shell "rundll32.exe shell32.dll,Control_RunDLL powercfg.cpl"كادر پاور-برق
Shell "rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl"كادر سيستم
Shell "rundll32.exe shell32.dll,Control_RunDLL telephon.cpl"كادر تلفن
Shell "rundll32.exe shell32.dll,Control_RunDLL timedate.cpl"كادر ساعت

كتابخانه وسيع شل

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal_ lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal_ nShowCmd As Long) As Long

كد هاي زير را هر جا استفاده كنيد جواب مي دهدالبته بهد از اينكه كد بالا را در اولين خط فرم نوشتيد

به من چه خودتون امتحان كنيد ببينيد چيه !پدر دستم دراومد!!ِ

Shell "arp"
Shell "drvspace"
Shell "drwatson"
Shell "explorer"براي my document
Shell "freecell"
Shell "ftp"براي تنظيم اف تي پي
Shell "ipconfig"كادر آي پي
Shell "mplayer"مديا پلير
Shell "mshearts"
Shell "nbtstat"
Shell "netstat"
Shell "calc"ماشين حساب
Shell "notepad"نوت پد
Shell "packager"
Shell "pbrush"نقاشي
Shell "ping"
Shell "regedit"ريجيستري
Shell "route"روت
Shell "scandskw"اسكن ديسك
Shell "scanregw"اسكن رگ
Shell "setdebug"كخك تري تنظيم ويندوز
Shell "sigverif"
Shell "cdplayer"سي دي پلير
Shell "sndrec32"ضبط صدا
Shell "sndvol32"تنظيم ولوم صدا
Shell "sol"همون سول
Shell "taskman"وضعيت سي پي يو
Shell "telnet"تلفن
Shell "vcmui"
Shell "winfile"
Shell "winipcfg"
Shell "winmine"
Shell "winrep"
Shell "charmap"كاراكتر مپ
Shell "winver"
Shell "write"وورد پد
Shell "wscript"
Shell "cleanmgr"كلنر پاك كننده اشغال درايو
Shell "control"كنترل پنل
Shell "cvt1"
Shell "defrag"دفراگمنت
Shell "drvspace" فضاي خالي ديسك

اجراي فايل اينترنت با شل

shell "Explorer.exe"+" http://www.tcvb.blogfa.com"رفتن به يك سايت

shell "explorer.exe"+" maileto:Nasser_tcvb@yahoo.com"كادر ارسال ايميل

shell "explorer.exe"+" yor HTML File.html"كادر اجراي يك فايل اينترنت از حافظه

shell "explorer.exe"+" file://www.سايت شما.com/11.zip"كادردانلود يك فايل از اينتر نت

Type Of اپراتور

اين اپراتور براي تشخيص نوع كنترل به كار مي رود.روش استفاده از ان به شكل زير است

TypeOf ControlName Is ControlType

مثال:كنترلي از نوع فايل بوكس رابه تايع زير مي فرستيم يراي تعيين عضو انتخاب شده

Private Function GetSelectItem(LST as Contol) as String

if TypeOf lst is listbox then

GetselectItem=Lst.text:Exit Function

else :GetselectItem=Lst.FileName:Exit Sub

End if

در خط يك تابع با آرگومان يك ليست از نوع كنترل تعريف مي شود خروجي تايپ آف به صورت يك منو مانند تعريف متغيير هنگام كد نويسي ظاهر مي شود كه شما مي توانيد نو ع كنترل خود را از داخل آن انتخاب كنيد.توجه كنيد بين تايپ و آف نبايد فاصله بيفتد واگر نه با خطاي كامپايل مواجه مي شويد.

DoEventsاپراتور

اين اپراتور براي ارجاع تمام عملييات به سي پي يو براي انجام مي باشد.اكثرآ از اين اپراتور براي مواقعي استفاده مي گردد كه يك عمليات وقتگير در حال انجام است مانند اعمال افكت روي تصوير و حلقه هاي تكرار طولاني. اين اپراتور در درون حلقه قرار گرفته و كامپايل نمي شود مانند رهنمود ها در پاسكال عمل مي كندوبه سي پي يو مي گويد تمام كارهيت را به صورت يكسان انجام بده واز اولويت ها صرف نظر كن .در برنامه هايي كه يك عمليات در درون يك حلقه هر دور انجام مي شود آكثرآ باعث هنك كردن آن برنامه تا پايان عمليات مي شود.چون برنامه بين واكنش به تكان خوردن موس -جابه جاكردن برنامه يا بزرگ و كوچك كردن برنامه وپردازش روي عمليات مورد نظر(مثلآ كپي فايل)عمليياتي كه داراي اولويت پردازش است را انتخاب مي كند.اين اپراتور در چنين مواقعي بسيار مفيد است وباعث مي شود كاربر گمان نكند كه برنامه هنك كرده و آن را ببندد.مثال:ِ

For i=0 to list1.listCount -1

if list1.list(i)<>"" then call Copy(list1.list(i),App.path+"\")

DoEvents

Next

در خط اول حلقه اي از صفر تا تعداد اعناصر موجود در ليست اغازمي شودو در هر درو فايل درون ليست در صورت وجود كپي مي شود .اگر فايل هاي مازياد باشد DoEventsو اپراتور را ننويسيم حتمآ برنامه ما هنك مي كند.بايد ياد آور شد استفاده نابجا و بيش از اندازه اين اپراتور موجب كاهش سرعت برنامه مي شود.ِالبته

استفاده مي كنندSleepبه نام APIباعث كاركرد زياد وشديد سي پي يو مي شود وبرخي ترجيح مي دهند از آن استفاده نكنند ويه جاي ان از يك

فرق مي كند. اسليپ باعث ميشود سي پي يو تمام كار هاي در حال اجرا را رها كند وبه مدت زماني كه جلويDoEventsبايد گفت كاركرد اسليپ به طور كلي با

آن نوشته مي شود به استراحت بپردازد.ِ

sleep با توجه به زماني كه براش تعيين ميكني در وسط كار برنامه مكث ايجاد ميكنه و در آن زمان هيچ خطي از كد برنامه اجرا نميشه و همان طور كه از اسم تابع .مشخصه برنامه در آن زمان به خواب ميره
اسليپ زماني كه با محيط خارج از برنامه در ارتباطي خيلي مفيده. چون معمولا وقتي دستوري در وي بي مثل اجراي فلان فايل مدتي طول مي كشد و تو اين مدت دستورات بعدي سريع اجرا مي شوند كه ممكن است نتيجه اش به اجاي فايل بستگي داشته با شه.اسليپ باعث ميشه به ويندوز فرصت بدي ساير دستورات فرستاده شده به خارج برنامه رو اجرا كنه. البته گاهي اوقات هم نميدونيم چند ثانيه مكث كنيم و ممكنه مجبور شيم براي احتياط زمان زيادي مكث كنيم كه سرعت برنامه مياد پايين پس تا مي تونيم از دستورات خود وي بي استفاده كنيم تا بر نامه هاي خارجي.ِ

Shellدستور

توسط اين دستور مي تونيد فايلي را در وي بي اجرا كنيد .آدرسي كه جلوي اين دستور نوشته مي شه اجرا ميشه .شكل اين دستور به اين صورت است:ِ

Shell ProgramPath,RunModel

در آرگومان اول مسير فايل نوشته مي شود ودر آرگومان دوم مدلي كه برنامه بايد اجرا شود.در اين ارگومان از آرگومان هاي زير استفاده مي گردد

vbHide=0 vbMaximizedFocus=1 vbMinimizedFocus=2 vbMinimizedNoFocus=3 vbNormalFocus=4 vbNormalNoFocus=5

در مدل صفر برنامه به صورت پنهان ظاهر مي شود.براي مواقعي كه مي خواهيم عمل اجرا را از ديد كاربر پنهان كنيم .در مدل 2 برنامه اجرا مي شود به صورت كمينه(روي منوي استارت-مينيمايز شده)وفاكس هم روي ان مي رود يعني اين كه بعد از اجرا هي زرد و آبي مي شود تا كار بر روي آن كليك كند.مدل 3برنامه به

صورت ينيمايز -كمينه اجرا مي شود زرد وآبي نمي شود (معمولي-فاكس رويش نمي رود).مدل 1برنامه به صورت تمام صفحه اجرا شده فاكس هم روي آن مي رود(زرد و ابي مي شود).در مدل 4برنامه با اندازه پيش فرض اجرا مي شودوفاكس را هم مي گيرد.درمدل 5برنامه با اندازه معمولي اجرا شده و فاكس نمي گيرد

كار برد مهم ديگر شل اجرا فايل هاي معمولي با يك برنامه اجرايي است مثل اجراي يك متن در نت پد.براي اين كار نام فايل را بايك فاصله از نام فايل مي نويسيم

Shell "NotPath.Exe"+" C:\Text1.txt" ,4