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

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

عوض کردن آدرس اینترنتی در اینترنت اکسپلورر فقط با دو خط :
[TABLE]
[TR]
[TD="class: gutter"]1
2
[/TD]
[TD="class: code"]Set wshshell = CreateObject("WScript.Shell")
wshshell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Start Page", "http://www.Micro-TC.Blogf

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

این کد کارش چک کردن فایل هست که آیا فایلی از قبل وجود داشت یا نه ؟ فکر کنم بدرد کسانی می خوره که کارشون ذخیره فایل های Txt یا عکس هست.
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
[/TD]
[TD="class: code"]Private Function FileExists(FullFileName As String) As Boolean

On Error Goto MakeF
'If file does Not exist, there will be an Error
Open FullFileName For Input As #1
Close #1
'no error, file exists
FileExists = True
Exit Function
MakeF:
'error, file does Not exist
FileExists = False
Exit Function
End Function

Sub Command1_Click ()
msgbox FileExists
End Sub

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

اینم از یک کد دیگه که کارش اینه فایل ها و فولدر های موجود در یک فولدر را براحتی پاک می کنه فقط با چند خط کد نویسی .
یک Command1 به برنامه اضافه کنید و بعد کد زیر را کپی کنید.
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
[/TD]
[TD="class: code"]Public Sub DelAll(ByVal DirtoDelete As Variant)

Dim FSO, FS
Set FSO = CreateObject("Scripting.FileSystemObject")
FS = FSO.DeleteFolder(DirtoDelete, True)
End Sub

'so like

Private Sub Command1_Click()

Call delall("c:\New Folder")
'that would delete the c:\New Folder
End Sub

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

سلام امروز یک کد بسیار ساده برای شما آماده کردم. کد زیر باعث میشه فقط برنامه برای 25 اجرا بشه نه بیشتر یک command1 به فرم اظافه کنید و بعد کد زیر را به برنامه اظافه کنید.
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
[/TD]
[TD="class: code"]Private Sub Form_Load()

' the "A" in getsetting and savesetting
' can be changed to another letter
retvalue = GetSetting("A", "0", "RunCount") ' this returns the value of the registry edit.
Worm$ = Val(retvalue) + 1 ' adds one To the value of the regisrty edit.
SaveSetting "A", "0", "RunCount", Worm$ ' saves the new value


If Worm$ < 25 Then 'put one number higher then it says.
' this is the popup to warn the user how
' many runs have been executed and how man
' y are left.
MsgBox "you have used this program " & Worm$ & " Times. Only " & (25 - Worm$) & " left."
End If

' this is the statement to check whether
' to execute the form load or end program


If Worm$ > 24 Then 'put one number lower then it says.
MsgBox "you have used this program 25 Times, purchase is now required", 16, "Sorry"
' this would send the user to a website
' in their default browser.
Win32Keyword "http://skygazer.net"
Unload Me
End
End If

End Sub



Private Sub Command1_Click()

End
End Sub

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

خیلی از مردم وقتی تازه با وی بی آشنا میشن بعد از کمی کار کردن می خوان بفهمن که چطوری میشه داده های تو یک لیست بوکس را خواند من امروز یک کد در مورد همین اینجا قرار دادم امیدوارم بدرد کسانی که تازه با وی بی آشنا شدن بخوره .
این کد رو بعد از دابل کلیک کردن روی فرم کپی کنید.

یک TextBox با نام Text1 به فرم اظافه کنید.

For a = 0 To List1.ListCount - 1 'Start Loop

List1.Selected(a) = True 'Select part of list

Text1.Text = Text1.Text & List1.Text & " " 'Add selected part of list To text

Next 'End Loop

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

چاپ به صورت باینری...
دیگه لازم نیست توضیح بدم :
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
[/TD]
[TD="class: code"]Public Sub PrintBinary(Num As Long)
Dim j&, i&
j = 128
For i = 8 To 1 Step -1
If (Num And j) = 0 Then
Debug.Print "0";
Else
Debug.Print "1";
End If
j = j / 2
Next
End Sub

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

طراحی آسان در ویژوال بیسیک :
خوب با چند تا کد کوتاه زیر می تونید در وِیژوال بیسیک طراحی کنید. یک پروژه ایجاد کنید و روی فرم دابل کلیک کنید کد های زیر را توش کپی کنید.
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
[/TD]
[TD="class: code"]Private A As Integer: Private B As Integer
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
A = X: B = Y
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Form1.Line (A, B)-(X, Y)
A = X: B = Y
End If
End Sub

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

با این کد می تونید یک فایل txt را بصورت خط به خط بخونید . اگه حجم فایل زیاد باشه کمی طول میکشه ولی با این می تونید خیلی کار ها بکنید، بدردتون میخوره.
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
[/TD]
[TD="class: code"]Sub ReadLineByLine()

' Variable Declarations
Dim folderName As String
Dim fileName As String
folderName = "C:\Dump\"
fileName = "test.txt"
Open folderName & fileName For Input As #1


Do While Not EOF(1)
Line Input #1, inputdata
MsgBox inputdata ' or txtFile.Text = TxtFile.Text + vbcrlf + Input Data
Loop

Close #1
End Sub

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

با کد های زیر می تونید به دگمه ها یا دیگر شی های موجود در فرم جلوه سه بعدی زیبا بدهید . کد ها را فقط کپی کنید و به فرم خودتون اظافه کنیدو با توجه به توضیحات داده شده در کد برنامه را اجرا کنید.
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
[/TD]
[TD="class: code"]Public Sub SunkenPanel3D(obj As Object)

' Gives the effect of sinking the entire
'
' form or picture box, much like a 3d pi
' cture
' box with border style set to 1 - Fixed
' Single
' Hold the original scale mode
Dim nScaleMode As Integer
' Used for user defined scale only
Dim sngScaleTop As Single
Dim sngScaleLeftAs Single
Dim sngScaleWidthAs Single
Dim sngScaleHeight As Single


If (TypeOf obj Is PictureBox) Or (TypeOf obj Is Form) Then

nScaleMode = obj.ScaleMode



If nScaleMode = 0 Then ' user defined scale
sngScaleTop = obj.ScaleTop
sngScaleLeft = obj.ScaleLeft
sngScaleWidth = obj.ScaleWidth
sngScaleHeight = obj.ScaleHeight
End If

obj.ScaleMode = 3 ' Pixel
obj.Line (2, 2)-(obj.ScaleWidth - 1, 2), vb3DDKShadow
obj.Line (2, 2)-(2, obj.ScaleHeight - 1), vb3DDKShadow
obj.Line (2, obj.ScaleHeight - 2)-(obj.ScaleWidth - 1, obj.ScaleHeight - 2), vb3DHighlight
obj.Line (obj.ScaleWidth - 2, obj.ScaleHeight - 2)-(obj.ScaleWidth - 2, 1), vb3DHighlight

' Set the scale mode back to the same as
' it was
obj.ScaleMode = nScaleMode


If nScaleMode = 0 Then
obj.ScaleTop = sngScaleTop
obj.ScaleWidth = sngScaleWidth
obj.ScaleLeft = sngScaleLeft
obj.ScaleHeight = sngScaleHeight
End If

End If

End Sub

Public Sub RaisedPanel3D(obj As Object)

' Gives the effect of raising the entire
'
' picture box. Much like a 3d Panel
' Hold the original scale mode
Dim nScaleMode As Integer
' Used for user defined scale only
Dim sngScaleTop As Single
Dim sngScaleLeftAs Single
Dim sngScaleWidthAs Single
Dim sngScaleHeight As Single


If (TypeOf obj Is PictureBox) Or (TypeOf obj Is Form) Then

nScaleMode = obj.ScaleMode



If nScaleMode = 0 Then ' user defined scale
sngScaleTop = obj.ScaleTop
sngScaleLeft = obj.ScaleLeft
sngScaleWidth = obj.ScaleWidth
sngScaleHeight = obj.ScaleHeight
End If

obj.ScaleMode = 3 ' Pixel
obj.Line (1, 1)-(obj.ScaleWidth - 1, 1), vb3DHighlight
obj.Line (1, 2)-(1, obj.ScaleHeight), vb3DHighlight
obj.Line (1, obj.ScaleHeight - 1)-(obj.ScaleWidth, obj.ScaleHeight - 1), vb3DShadow
obj.Line (obj.ScaleWidth - 1, obj.ScaleHeight - 2)-(obj.ScaleWidth - 1, 1), vb3DShadow

' Set the scale mode back to the same as
' it was
obj.ScaleMode = nScaleMode


If nScaleMode = 0 Then
obj.ScaleTop = sngScaleTop
obj.ScaleWidth = sngScaleWidth
obj.ScaleLeft = sngScaleLeft
obj.ScaleHeight = sngScaleHeight
End If

End If

End Sub

Public Sub Raised3D(obj As Object)

' Gives the effect of a raised line arou
' nd
' the form or picturebox
' Hold the original scale mode
Dim nScaleMode As Integer
' Used for user defined scale only
Dim sngScaleTop As Single
Dim sngScaleLeftAs Single
Dim sngScaleWidthAs Single
Dim sngScaleHeight As Single


If (TypeOf obj Is PictureBox) Or (TypeOf obj Is Form) Then

nScaleMode = obj.ScaleMode



If nScaleMode = 0 Then ' user defined scale
sngScaleTop = obj.ScaleTop
sngScaleLeft = obj.ScaleLeft
sngScaleWidth = obj.ScaleWidth
sngScaleHeight = obj.ScaleHeight
End If

obj.ScaleMode = 3 ' Pixel
obj.Line (1, 1)-(obj.ScaleWidth - 1, 1), vb3DHighlight
obj.Line (1, 2)-(obj.ScaleWidth, 2), vb3DShadow
obj.Line (1, 2)-(1, obj.ScaleHeight), vb3DHighlight
obj.Line (2, 2)-(2, obj.ScaleHeight), vb3DShadow
obj.Line (1, obj.ScaleHeight - 2)-(obj.ScaleWidth, obj.ScaleHeight - 2), vb3DHighlight
obj.Line (1, obj.ScaleHeight - 1)-(obj.ScaleWidth, obj.ScaleHeight - 1), vb3DShadow
obj.Line (obj.ScaleWidth - 2, obj.ScaleHeight - 2)-(obj.ScaleWidth - 2, 1), vb3DHighlight
obj.Line (obj.ScaleWidth - 1, obj.ScaleHeight - 2)-(obj.ScaleWidth - 1, 1), vb3DShadow

' Set the scale mode back to the same as
' it was
obj.ScaleMode = nScaleMode


If nScaleMode = 0 Then
obj.ScaleTop = sngScaleTop
obj.ScaleWidth = sngScaleWidth
obj.ScaleLeft = sngScaleLeft
obj.ScaleHeight = sngScaleHeight
End If

End If

End Sub



Public Sub Etched3D(obj As Object)

' Gives the effect of an eteched line ar
' ound the
' form or picture box.
' Hold the original scale mode
Dim nScaleMode As Integer
' Used for user defined scale only
Dim sngScaleTop As Single
Dim sngScaleLeftAs Single
Dim sngScaleWidthAs Single
Dim sngScaleHeight As Single

If (TypeOf obj Is PictureBox) Or (TypeOf obj Is Form) Then

nScaleMode = obj.ScaleMode

If nScaleMode = 0 Then ' user defined scale
sngScaleTop = obj.ScaleTop
sngScaleLeft = obj.ScaleLeft
sngScaleWidth = obj.ScaleWidth
sngScaleHeight = obj.ScaleHeight
End If

obj.ScaleMode = 3 ' Pixel
obj.Line (1, 1)-(obj.ScaleWidth - 1, 1), vb3DShadow
obj.Line (1, 2)-(obj.ScaleWidth, 2), vb3DHighlight
obj.Line (1, 2)-(1, obj.ScaleHeight), vb3DShadow
obj.Line (2, 2)-(2, obj.ScaleHeight), vb3DHighlight
obj.Line (1, obj.ScaleHeight - 2)-(obj.ScaleWidth, obj.ScaleHeight - 2), vb3DShadow
obj.Line (1, obj.ScaleHeight - 1)-(obj.ScaleWidth, obj.ScaleHeight - 1), vb3DHighlight
obj.Line (obj.ScaleWidth - 2, obj.ScaleHeight - 2)-(obj.ScaleWidth - 2, 1), vb3DShadow
obj.Line (obj.ScaleWidth - 1, obj.ScaleHeight - 2)-(obj.ScaleWidth - 1, 1), vb3DHighlight

' Set the scale mode back to the same as
' it was
obj.ScaleMode = nScaleMode


If nScaleMode = 0 Then
obj.ScaleTop = sngScaleTop
obj.ScaleWidth = sngScaleWidth
obj.ScaleLeft = sngScaleLeft
obj.ScaleHeight = sngScaleHeight
End If

End If


End Sub

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

با سه خط زیر می تونید یک فایل WAV را اجرا و قطع کنید بدون نیاز به هیچ گونه کد اضافی و هیچگونه dll , ocx.

کد زیر را به فرم خود اظافه کنید.
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
[/TD]
[TD="class: code"]Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
Const SND_LOOP = &H8
Const SND_NOSTOP = &H10

'----------PLAY WAVE SOUND--------

Private Sub PlayWaveSound_Click()

soundfile$ = "c:/TheCustomSoundIWant.wav"
wFlags% = SND_ASYNC Or SND_NODEFAULT
HaHa = sndPlaySound(soundfile$, wFlags%)
End Sub

'-------STOP WAVE SOUND-------

Private Sub StopTheSound_Click()
StopTheSoundNOW = sndPlaySound(soundfile$, wFlags%)
End Sub
'Replace "c:/TheCustomSoundIWant.wav" wi
' th your sound

[/TD]
[/TR]
[/TABLE]