نفر بعدي كيه ؟ --------- ( ! يك تاپيك جالب و متفاوت ! )

[unit001]

ها!! خوب شده نگفتیا!!

نکته ی ویژوالی:

بعضی ها برای به دست آوردن آدرس فایل VB از کد App.Path خالی استفاده می کنند در حالی که این آدرس بدون \ در آخر آدرس هست و باید یه دونه \ آخرش بزارید. ولی همیشه بدون \ نیست, مثلا وقتی فایل exe که کامپایل شده توی درایو C باشه آدرس رو به صورت

C:\

نشون می ده که \ آخرش هست. پس بهتره چی کار کنیم؟ مثلا می تونیم از تابع زیر استفاده کنیم!

Public Function GetAppPath() As String

      IIf Right(App.Path,1) = "\", GetAppPath=App.Path, GetAppPath=App.Path & "\"

End Function

وقتی از تابع بالا استفاده کنیم همیشه آدرس فایل Exe رو با \ داریم.

نفر بعدی : نمی دونم شاید یکی از مدیران عزیز باشه

[SlowCode]

نه بابا مدیر کجا بود!

نکته ویژوالی :

با تابع VarType می تونیم نوع متغیر رو بدست بیاریم، مثلا:

s=0.21455

Msgbox VarType(s)

خروجی میشه 5 و با توجه به مقادیر زیر میشه Double:
VbEmpty=0 , VbNull=1 , VbInteger=2 , VbLong=3 , VbSingle=4 , VbDouble=5 , VbCurrency=6 , Vbdate=7 , VbString=8 , VbObject=9 , VbError=10 , VbBoolean=11 , VbVariant=12 , VbDataObject=17
واسه آرایه هم هست ولی متناسب با نوعش هست، یعنی واسه آرایه از نوع integer و String عددش فرق میکنه ولی همشون از 8000 بیشتر هستن.

نفر بعدی: نحوه کار کردن با کلاس Financial رو توضیح بده.

[mehran901]

در اشتباهید من قرار نیست به این مورد بپردازم

نکته ویژوالی :

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

formX.show vbmodal 

استفاده کنین !
نکته ساده و کارآمد

نفر بعدی ..... ممممم....مم... ورزشکاره !! ههه ، آدم با سوادی هم هس

[unit001]

ورزشكاريم كه كم و بيش! با سواديمم كه نمي دونم!

نکته ویژوالی :

مي دونستيد مي شه كنترل فعال روي فرم را با يه كد بدست آورد:

ActiveControl

نفر بعد: اينجوري كه معلومه هيچكس، آخرشم تاپيك از صفحه ي اول مي ره بيرون!

[mehran901]

خیر ! از صفحه اول بیرون نمیره میاد داخل !
نکته ويژوالي :

آیا میدانستید ؟ عمرا نمی دانستید که میشه آدرس یک متغیر عددی رو در ویبی با دستور varptr و متغییر رشته ای رو با strptr به دست آورد

نفر بعد ،دمش گرم ی حال اساسی میخواد بده ...

[Mr'Jamshidy]

نه عزیزم میخواستم حال بگیرم، بله میدونستیم

نکته ویژوالی :

با ObjPtr هم همون کار رو برای Object ها میشه انجام داد

نفر بعدی حتما عضو انجمن هست

[AbbasVB]

حالا تا این تاپیک بسته نشده ما هم یک نکته کوچولو بگیم
این که هر کس یه تاپیک رو ایجاد و مدیريت کنه ایده خوبیه

نکته ويژوالي :

آیا می دونستید اگر این کد رو استفاده کنید اگر روی دکمه Close کلیک کنید فرم بسته نمی شه؟

Private Sub Form_Unload(Cancel As Integer)

Cancel = 1

End Sub

نفر بعدی رو هم نمی دونم کیه

[M.T.P]

من نفر بعدی پست قبلی ام

نکته ويژوالي :

خیلی از دوستان این مطلب رو می دونند اما قابل توجه سایر برنامه نویس ها:
فرض کنید یه برنامه NotePad نوشتید و قراره فایل های txt با برنامه شما باز بشه ، یعنی کاربر Open with رو زده و برنامه شما رو برای باز کردن فایل های txt روی سیستمش انتخاب کرده .
خب بعد از انجام مراحل بالا وقتی کاربر روی فایل های txt روی سیستمش کلیک می کنه برنامه شما باز میشه.
اما برنامه شما باید متوجه این موضوع باشه ، یعنی اینکه بفهمه کاربر برنامه شما رو بصورت معمول اجرا نکرده بلکه قراره یک فایل txt تو برنامه شما باز شه ، برای پی بردن به این موضوع از تابع Commands استفاده می کنیم.

برای تست کردن این تابع یه پروژه جدید بسازید.
فرم رو حذف کنید و داخل یه Module بنویسید:

Sub Main()

    MsgBox Command$

End Sub

خب حالا پروژه رو کامپایل کنید.

حالا هربار که یک فایل با این برنامه ای که نوشتیم Open بشه برنامه متوجه مسیر فایل مورد نظر خواهد بود
و شما می تونید اون فایل تو برنامه تون با توجه به مسیرش باز کنید.

یا اینکه می تونید یه فایل رو حالا هر فایل یا پوشه ای رو روی آیکن فایل اجرایی تون با موس درگ کنید و نتیجه رو ببینید.

توجه: دقت داشته باشید که این تابع کلا دستورات ورودی به برنامه رو می گیره و همیشه آدرس فایل نیست ، پس با شرط
همیشه مقدار برگشتی تابع Command رو بررسی کنید .

برای مثال اگه کاربر برنامه شما رو اینطوری Shell کنه:

c:\myApp.exe salam

مقدار برگشتی تابع Command کلمه salam خواهد بود.

نفر بعدی مشتاقانه منتظریم...

[Mr'Jamshidy]

نکته ويژوالي :

غیر فعال کردن دکمه X در ویژوال بیسیک 6

Const MF_BYPOSITION = &H400

Private Declare Function GetSystemMenu Lib "User32" _

(ByVal hWnd As Long, ByVal bRevert _

As Long) As Long

Private Declare Function RemoveMenu Lib "User32" _

(ByVal hMenu As Long, ByVal nPosition _

As Long, ByVal wFlags As Long) As Long

Private Sub Form_Load()

RemoveMenu GetSystemMenu(Me.hWnd, 0), 6, MF_BYPOSITION

End Sub

نفر بعدی شما هستی، آره همونی که داری پست میدی

[AMIN_SG]

نکته ويژوالي :

خاموش کردن مانیتور

Private Declare Function MonTurnOff Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer



MonTurnOff(Me.hwnd, &H112S, &HF170, 2)

نفر بعدی خود Mr'Jamshidy هستش

[meys34]

نه!؟! این منم که پست میدم...

نکته ويژوالي :

روش های بستن دکمه close راه دور زدن داره مثل Alt+F4 یا sendmessage

یه راه خوب داره که مزاحم شات دان شدن کامپیوتر هم نمیشه و خیلی هم راحته...

دکمه فعاله ولی عمل نمیکنه...

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)

If UnloadMode = vbFormControlMenu Then Cancel = True

End Sub

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

میدونم که میدونستید میشه فایل mainifest رو به صورت resource به برنامه اضافه کرد...
اما...
هیچ میدونستید که اندازه فایل manifest درون res (نه اندازه فایل res) باید مضربی از 4 byte باشه تا هنگام کامپایل، فایل درست کامپایل بشه...


نفر بعدی بگه که چرا باید فایل manifest مضربی از 4 byte باشه؟

[saber67]

نکته ويژوالي :

برای اینکه چند خط از کد های ویژوال بیسیک رو یه پله جلو ببرید (مثلا کدهای داخل If, End If) که واضح تر بشن لازم نیست اول همه یه بار دکمه Tab رو بزنین! همه اون متنو انتخاب کنین و یه بار Tab رو فشار بدین همه متن انتخابی به اندازه یه Tab جلو میره

نفر بعدی میگه چه طوری عکس این کارو بکنیم! یعنی چند خط رو با یه دکمه یه پله بیاریم عقب

[saber67]

درست حدس زدم
ای بابا چقد آسون بودا! خودم فهمیدم چه طوری میشه! چرا قبلا به فکرم نرسیده بود؟!

نکته ويژوالي :
برای اینکه توی ویژوال بیسیک متن انتخابی یه پله بیاد عقب دکمه Shift رو پایین نگه دارین و دکمه Tab رو فشار بدین

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

[ra0661]

زود گفتی چون نفر بعدی اون نبود بلکه من بودم


نکته ويژوالي :

اگه دیدی برنامه که وب بروزر توش بردید بکار موقع اجرا سورس خطا داد مشکل از همون iframe.dll هستش که حتما یه چیز جدید ریختید رو سیستمتون با نصب اکسپلورر6 حل میشه (مال من که حل شد)

نفر بعدی احتمالا میخواهد بیاد بگه این چه نکته ای بود که ایشون گفتن !

[SlowCode]

نفر قبلی: نه شاید به درد بعضی از دوستان بخوره.

نکته ويژوالي :

می دونستید با تابع Filter میتونید یه مقدار(حرف، کلمه، عدد) رو داخل یه آرایه جستجو کنید؟
مثلا:

Dim a(5) As String, z() As String

a(0) = "ali"

a(1) = "mohsen"

a(2) = "hassan"

a(3) = "reza"

a(4) = "mohammad"

a(5) = "kambiz"

z = Filter(a, "r")

MsgBox z(0) 'reza

توی آرایه حرف r رو جستجو میکنه و نتیجه رو به آرایه z میریزه، (z(0 اولین عنصر پیدا شده هست.
یا مثلا:

z = Filter(a, "m")

MsgBox z(2) 'kambiz

اینجا هم حرف m رو جستجو میکنه و سومین عنصر پیدا شده رو نشون میده.

نفر بعدی: اگه گفتی چرا روی بعضی سیستم ها گزینه Make project1.exe غیر فعال هست؟

[محسن واژدی]

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

نکته ویژوالی: چون آقای محسن15 عزیز به نکته ای درمورد آرایه ها اشاره کردن بنده هم نکته ای در مورد Array (که معرف حضور هست) عرض می کنم،
شاید برخی اوقات چند آرایه تودرتو با دستور Array ایجاد کرده باشیم، به عنوان مثال:

 Dim arrDat()

 arrDat = Array("1", "2", Array("3-1", Array("3-2-1", "3-2-2", "3-2-3"), "3-3"), "4", "5")

همانطور که مشاهده میکنیم عضو سوم آرایه اول خود شامل یک آرایه دیگه هست و عضو دوم این آرایه هم خود شامل یک آرایه با سه عضو است
در اینجا اگر بخواهیم دستور دریافت مقدار "2-2-3" از آرایه را بنویسیم دستور مشابه زیر میشود:

 MsgBox arrDat(2)(1)(1)

نفر بعدی: حامل یک نکته ویژوالی دیگه

[Dr.Bronx]

بله ...

نکته ويژوالي :

حتما بلوک try.catch داخل vb.net رو دیدید .

این هم مدل vb6 . البته فقط ظاهرش شبیه :)

   'Try

        On Error Goto catchX

...

'Catch

catchX: if err.number then

            ...

            resume resumX

resumX: end if

        On Error Goto outside_catch_label_name

    'End Try

موفق باشید ./

نفر بعدی قطعا نفر بعدی هست . ( bronx قدس سره )

[mehran901]

بعله ، نفر بعدی هم نفربعدی هست! آفرین

دوست عزیز ra0661 :
درضمن مشکل ieframe که در بعضی نسخه ها ی اکسپلورر موقع لود شدن داخل ویبی ارور میده یا برنامه ای که ازش استفاده کرده به ارور برخورد میکنه شما میتونید بجای نصب اکسپلورر 6! برای رفع مشکل ، همین ieframe رو تو رجیستری سرچ بزنین و کلیدی که یک \ آخرش هست وشامل مسیر این فایل هست رو چک کنین با حذف \ بلافاصله مشکل برطرف میشه

نکته ويژوالي :
همه میدونیم در زبان هایی مثل C++‎‎‎‎ برای اضافه کردن " در خروجی از سوییچ "\ استفاده میشه ولی در ویبی معادلش به این صورت هست :

مثال :

MsgBox "A " & """" & "B" & """" & " "

نفر بعدی : یك فرد با اطلاعات

[meys34]

?!?!?!?!?!??!

جالب بود من همیشه از کد

Chr$(34)

استفاده می کردم...

نکته ويژوالي :

هیچ میدونستید جای تابع

Private Declare Function GetLastError Lib "kernel32" () As Long

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

Err.LastDllError

نفر بعدی کسی که فکر میکنه نمیشه با سرویسی که با ویبی نوشته یه برنامه رو تحت user اجرا کنه...

[vbhamed]

چرا اتفاقا ميشه !

نكته ويژوالي :

مي‌دونستيد ويژوال بيسيك به صورت داخلي دو تا تقويم داره، شمسي و قمري

Private Sub Form_Load()



    Dim Miladi$, Ghamari$



    Calendar = vbCalGreg

    Miladi = Date



    Calendar = vbCalHijri

    Ghamari = Date



    MsgBox "ميلادي : " & vbCrLf & Miladi & vbCrLf & vbCrLf & "قمري : " & vbCrLf & Ghamari



End Sub

نفر بعدي ميگه اوووووووه بعد از 1 سال تاپيك بالا اومد !

[CodeKhor]

بله این تاپیک دقیقا بعداز 1 سال و 2 ماه و 10 روز اومده بالا ! چه فعالیت چشم گیری دارن بچه های اینجا

نکته ويژوالي :

میدونستید اگر این کد توی یک تایمر با interval = 1 قرار بدین بعد برنامه رو اجرا کنید اول مجبور میشید کامپیوتر رو ریست کنید بعد هم تا اومدن ویندوز بالا بیاد به خودتون فحش میدید که چرا این کارو کردم ؟؟؟

Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Private Sub Timer1_Timer()

SetCursorPos 1, 1

End Sub

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

[NASA's Spaceman]

کد باحالی بود

نکته ويژوالي :

محاسبه اعداد نجومی LongMath.rar

نفر بعدی عاشق برنامه نویسی هست مثل خودم

[AbbasVB]

بله من عاشق برنامه نویسیم

نكته ويژوال :

توی اين آموزش می خوام بهتون یاد بدم که چه طور مثل ویژال استادیو(نه ورژن 6)دکمه کامپایل(Build) رو اضافه کنید

با یه کلیک می تونید برنامه رو کامپایل کنید

نفر بعدي Setroyd خواهد بود

[setroyd]

نكته ويژوالي

drag و drop کردن فایل بدون api انجام شده

Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, _

  Button As Integer, Shift As Integer, X As Single, Y As Single)



Dim i As Integer

For i = 1 To Data.Files.Count

Text1.Text = Text1.Text & Data.Files(i) & vbCrLf

Next



End Sub

textboxرو قسمت oledropmod رو manual کنید حالا یک فایل را بکشید با موس و بندازید داخل برنامه :) بله ادرس کامل فایل رو میبینید

نفر بعدي فکر کنم میخواد یه کد خاص بزاره !

[vbhamed]

سلام
احتمالا كدش كمي خاص هست

نكته ويژوالي :

همه برنامه هاي باز رو ببنديد، تو يك فرم يك دكمه با عنوان End بزاريد و كد زير رو تو فرم قرار بنويسيد و پروژه رو ذخيره كنيد

بعد براي تست :
1 - برنامه رو اجرا كنيد و دكمه End رو فشار بدين
2 - برنامه رو اجرا كنيد و ضربدر فرم رو بزنيد
3 - برنامه رو اجرا كنيد و با خيال راحت دكمه پاور كيس رو بزنيد

با اين روش راحت مي‌تونيد بفهميد كه بستن برنامه توسط دكمه ضربدر فرم انجام شده يا با كد خودتون يا اينكه سيستم دستور بسته شدن رو به برنامه داده

Private Sub Command1_Click()



    Unload Me



End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)



    MsgBox UnloadMode

    If UnloadMode <> 0 And UnloadMode <> 1 Then Cancel = True: MsgBox UnloadMode



End Sub

نفر بعدي شايد همه حالتهاش رو نديده بود

[talent1]

روش خوبیه مخصوصا وقتی چندتا فرم داشته باشی

نکته ویژوالی :

تاحالا شده بخواین یه سری شی رو با اسکرول ست کنید
که وقتی اسکرول پایین میاد او شی بالا بره و وقتی اسکرول بالا میره اون پایین بیاد
راحت ترین روشش اینجوریه :

Me.Frame1.Top = (-Me.VScroll1.Value)

من چقدر مخم نمیدونستم

نفر بدی شاید اینجوری بشه !

[sa1378]

من از پشت همین تریبون اعلام میکنم نیستم الان

نکته ویژوالی :
من یه روش خودم کشف کردم نمیدونم بقیه بلدن یا نه
اگه تکراریه به بزرگیتون ببخشین
من دیروز داشتم چند تا کد رو کپی میکردم با ctr+c دستم خورد به shift یعنی شد ctr + shift+ c بعد برای هر خطی که انتخاب کردم ' اومد
وقتی میخواین یه متن بزرگ رو ' بزنین بدرد میخوره

نفر بعدی اندکی ویژوال بیسیک بلد است...

[as987498749874]

دقیقا!!!

نکته ویژوالی :

آیا میدونستید عمل بر عکس شده زدن Tab کلید ترکیبی Shift+tab هست!!!! (در محيط كد نويسي ويژوال بيسيك)

پاسخ نفر بعدی 100 درصد یه خصوصیت داره : شمارش 189 هست

[Rasul75]

:|
|:

نکته ویژوالی :

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

 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



Private Const SW_SHOWNORMAL As Long = 1



Private Sub Command1_Click()

    ShellExecute Me.hwnd, "Open", "C:\TEST\", vbNullString, vbNullString, SW_SHOWNORMAL

End Sub

نفر بعد برای زدن تو ذوق من به دنیا اومده.

[Mr.305]

نکته ویژوالی :
از این کد میتونید برای رجیستر کردن فایل هاتون تو ویندوز استفاده کنید به صورت تمام کد و بدون استفاده از regsvr32 یعنی تقریبا کار regsvr32 رو براتون انجام میده

Option Explicit

Private Const CREATE_SUSPENDED = &H4

Private Const INFINITE = &HFFFFFFFF ' Infinite timeout

Private Const STATUS_WAIT_0 = &H0

Private Const STATUS_ABANDONED_WAIT_0 = &H80

Private Const STATUS_TIMEOUT = &H102

Private Const WAIT_FAILED = &HFFFFFFFF

Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)

Private Const WAIT_ABANDONED = ((STATUS_ABANDONED_WAIT_0) + 0)

Private Const WAIT_TIMEOUT = STATUS_TIMEOUT

Private Const STATUS_PENDING = &H103

Private Const STILL_ACTIVE = STATUS_PENDING

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _

(ByVal lpLibFileName As String) As Long

Private Declare Function FreeLibrary Lib "kernel32" _

(ByVal hLibModule As Long) As Long

Private Declare Function GetProcAddress Lib "kernel32" _

(ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function CreateThread Lib "kernel32" _

(lpThreadAttributes As Any, ByVal dwStackSize As Long, _

lpStartAddress As Long, lpParameter As Any, _

ByVal dwCreationFlags As Long, lpThreadID As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" _

(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _

(ByVal hObject As Long) As Long

Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)

Private Declare Function ResumeThread Lib "kernel32" _

(ByVal hThread As Long) As Long

Private Declare Function GetExitCodeThread Lib "kernel32" _

(ByVal hThread As Long, lpExitCode As Long) As Long

Public Function fVBRegServer(ByVal strFilePath As String, _

Optional ByVal blnRegister = True) As Boolean



Dim lngModuleHandle As Long ' module handle

Dim lngFunctionAdr As Long ' reg/unreg function address

Dim lngThreadID As Long ' dummy var that get's filled

Dim lngThreadHandle As Long ' thread handle

Dim lngExitCode As Long ' thread's exit code if it doesn't finish

Dim blnSuccess As Boolean ' if things worked

'

' Load the file into memory.

'

lngModuleHandle = LoadLibrary(strFilePath)



'

' Get the registration function's address.

'

If blnRegister Then

lngFunctionAdr = GetProcAddress(lngModuleHandle, "DllRegisterServer")

Else

lngFunctionAdr = GetProcAddress(lngModuleHandle, "DllUnregisterServer")

End If



If lngFunctionAdr <> 0 Then

'

' Create an alive thread and execute the function.

'

lngThreadHandle = CreateThread(ByVal 0, 0, ByVal lngFunctionAdr, ByVal 0, 0, lngThreadID)



'

' If we got the thread handle...

'

If lngThreadHandle Then

'

' Wait for the thread to finish.

'

blnSuccess = (WaitForSingleObject(lngThreadHandle, 10000) = WAIT_OBJECT_0)



'

' If it didn't finish...

'

If Not blnSuccess Then

'

' Something happened. Close the thread.

'

Call GetExitCodeThread(lngThreadHandle, lngExitCode)

Call ExitThread(lngExitCode)

End If



'

' Close the thread.

'

Call CloseHandle(lngThreadHandle)

End If

End If



'

' Free the file if we loaded it.

'

If lngModuleHandle Then Call FreeLibrary(lngModuleHandle)



fVBRegServer = blnSuccess



End Function

Public Function IsDLLActiveX(ByVal strDLLPath As String, Optional ByVal RaiseError As Boolean) As Boolean

Dim lngHMod As Long

Dim lngLastDllError As Long



lngHMod = LoadLibrary(strDLLPath)



If lngHMod = 0 Then

If RaiseError Then

lngLastDllError = Err.LastDllError

Err.Raise 10000 + lngLastDllError, "IsDLLActiveX", "LoadLibrary-Error: " & lngLastDllError

End If

End If



IsDLLActiveX = Abs(CBool(GetProcAddress(lngHMod, "DllRegisterServer")))

Call FreeLibrary(lngHMod)

End Function

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

نفر بعدی ی کدی بهتر از مال من میاره

[Rasul75]

نفر بعد باز خودمم :))

نکته ویژوالی :

برای انتخاب فولدر از کد زیر استفاده کنید توجه داشته باشید که فقط انتخاب فولدر نه فایل :

Private Const BIF_RETURNONLYFSDIRS = 1

Private Const BIF_DONTGOBELOWDOMAIN = 2

Private Const MAX_PATH = 260





Private Declare Function SHBrowseForFolder Lib "shell32" _

(lpbi As BrowseInfo) As Long





Private Declare Function SHGetPathFromIDList Lib "shell32" _

(ByVal pidList As Long, _

ByVal lpBuffer As String) As Long





Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _

(ByVal lpString1 As String, ByVal _

lpString2 As String) As Long





Private 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





Private Sub Command1_Click()

'Opens a Treeview control that displays the directories in a computer





Dim lpIDList As Long

Dim sBuffer As String

Dim szTitle As String

Dim tBrowseInfo As BrowseInfo





szTitle = "This is the title"

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)

Text1.Text = sBuffer

End If

end sub

نفر بعد رو کن ببینم چی داری؟؟

[vbhamed]

سلام
اولین اولین پست این تاپیک در سال 1394 رو میزارم

نکته ویژوالی :

یک کد گذاشتم برای غیر فعال و فعال کردن Clipboard
Open غیر فعال و Close فعالش میکنه، اگر غیر فعال کنید دیگه هیچ طوری نمی‌تونید چیزی در Clipboard ذخیره کنید، حتی کلیدهای Ctrl+C, Ctrl+X و ... هم کار نمی‌کنه

Private Declare Function CloseClipboard Lib "user32" () As Long

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



Private Sub Form_Load()



    'Disable Clipboard

    OpenClipboard Me.hwnd



    'Enable Clipboard

    CloseClipboard



End Sub

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

[roo.row]

چشم پست جالب میزارم

نکته ویژوالی :
نمی خواستم اینو بزارم ولی خوب چیزی به ذهنم نرسید امیدوارم جدید باشه

Shell "attrib +h +s +r c:\virus1.exe"

با این کد برنامه شما به صورت exe که در میاد ناپدید میشه و حتی سایزش رو هم سیستم نشون نمیده در این کد +h هیدن می کنه +s به عنوان فایل سیستمی هیدن میکنه(غیر قابل حذف) +r فقط قابل خوانش

لازم به ذکر هست که این کد با فراخوانی خط فرمان دستور Attrib که یکی توابع اون هست رو اجرا میکنه .

نفر بعدی کسی است که فکرشم نمی کرد اینجا پست بده

[mehran901]

اره احتمالا همین طوره ...
بعد از سال ها سر زدم به این انجمن و خاطرات قشنگش .... آخرین پست من اینجا مربوط به بهمن سال 91 هست
چقدر زود میگذره

نکته ویژوالی :
با کد زیر اطلاعات داخل تمام تکست باکس ها رو در لود برنامه حذف کنین

 Dim Contrl As Control

 For Each Contrl In Form1.Controls

 If (TypeOf Contrl Is TextBox) Then Contrl.Text = ""

 

Next Contrl

نفر بعد تلاششو فقط برای زنده نگه داشتن تاپیک بکنه .... حتی اگه نکته عجیب غریبی نداره

[محسن واژدی]

سلام
ان شاا... همین پست تاپیکو زنده نگهداره

نکته ویژوالی:
برای ایجاد کردن یک کلاس لزوما نیاز به تعریف یک متغیر جداگانه نیست میتوان آنرا بصورت دیگری هم اعلان کرد، در این شیوه فرض را بر این گذاشته ایم که از With برای دسترسی سریعتر به اعضای کلاس استفاده کرده ایم، در اینجا برخلاف باور بسیاری از کاربران عزیز که حتما بایستی برای استفاده از کلاس در With آنرا در یک متغیر جداگانه ایجاد کرد، میتوانیم مستقیما کلاس مورد نظر را در دستور With ایجاد کنیم، یعنی نوشتن دستورات زیر به هر دو صورت صحیح است:

Private Sub Command1_Click()

    Dim CSmplItems As New Collection



    With CSmplItems

        .Add "ItemA"

        .Add "ItemB"

        For i = 1 To .Count

            MsgBox "Cur Item: " & .Item(i)

        Next 'i

    End With

End Sub

یا

Private Sub Command1_Click()



    With New Collection

        .Add "ItemA"

        .Add "ItemB"

        For i = 1 To .Count

            MsgBox "Cur Item: " & .Item(i)

        Next 'i

    End With



End Sub

البته دوستان توجه داشته باشند که این شیوه صرفا برای ایجاد و دسترسی سریع به اعضای کلاس است و محدودیت هایی در ارجاع و ... دارد.

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

[vbhamed]

سلام

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

نکته ویژوالی :

دستورات انتسابی زیر رو ببینید، با این دستورات محتویات فیلدهای یک Ado به Ado دوم در یک فرم خاص منتقل میشه

frmIRANCustomers.adoIRANCustomerList.Recordset!MNa  me = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M  Name

frmIRANCustomers.adoIRANCustomerList.Recordset!Fam  lily = frmIRANCustomers.adoIRANCustomerBackup.Recordset!F  amlily

frmIRANCustomers.adoIRANCustomerList.Recordset!Com  ment = frmIRANCustomers.adoIRANCustomerBackup.Recordset!C  omment

frmIRANCustomers.adoIRANCustomerList.Recordset!Pho  ne = frmIRANCustomers.adoIRANCustomerBackup.Recordset!P  hone

frmIRANCustomers.adoIRANCustomerList.Recordset!Ema  il = frmIRANCustomers.adoIRANCustomerBackup.Recordset!E  mail

frmIRANCustomers.adoIRANCustomerList.Recordset!Add  ress = frmIRANCustomers.adoIRANCustomerBackup.Recordset!A  ddress

frmIRANCustomers.adoIRANCustomerList.Recordset!Cod  e = frmIRANCustomers.adoIRANCustomerBackup.Recordset!C  ode

frmIRANCustomers.adoIRANCustomerList.Recordset!Mob  ile = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M  obile

frmIRANCustomers.adoIRANCustomerList.Recordset!Per  sonal = frmIRANCustomers.adoIRANCustomerBackup.Recordset!P  ersonal

frmIRANCustomers.adoIRANCustomerList.Recordset!Wei  ght = frmIRANCustomers.adoIRANCustomerBackup.Recordset!W  eight

frmIRANCustomers.adoIRANCustomerList.Recordset!Old = frmIRANCustomers.adoIRANCustomerBackup.Recordset!O  ld

frmIRANCustomers.adoIRANCustomerList.Recordset!Bir  thday = frmIRANCustomers.adoIRANCustomerBackup.Recordset!B  irthday

frmIRANCustomers.adoIRANCustomerList.Recordset!Fat  her = frmIRANCustomers.adoIRANCustomerBackup.Recordset!F  ather

frmIRANCustomers.adoIRANCustomerList.Recordset!Mel  liCode = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M  elliCode

frmIRANCustomers.adoIRANCustomerList.Recordset!Sal  ary = frmIRANCustomers.adoIRANCustomerBackup.Recordset!S  alary

frmIRANCustomers.adoIRANCustomerList.Recordset!Web  site = frmIRANCustomers.adoIRANCustomerBackup.Recordset!W  ebsite

خب دستورات طولانی و نسبتا ناخوانایی شده و میشه یه مقدار با With مختصرش کرد به شکل زیر

    With frmIRANCustomers.adoIRANCustomerList.Recordset

        !MName = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M  Name

        !Famlily = frmIRANCustomers.adoIRANCustomerBackup.Recordset!F  amlily

        !Comment = frmIRANCustomers.adoIRANCustomerBackup.Recordset!C  omment

        !Phone = frmIRANCustomers.adoIRANCustomerBackup.Recordset!P  hone

        !Email = frmIRANCustomers.adoIRANCustomerBackup.Recordset!E  mail

        !Address = frmIRANCustomers.adoIRANCustomerBackup.Recordset!A  ddress

        !Code = frmIRANCustomers.adoIRANCustomerBackup.Recordset!C  ode

        !Mobile = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M  obile

        !Personal = frmIRANCustomers.adoIRANCustomerBackup.Recordset!P  ersonal

        !Weight = frmIRANCustomers.adoIRANCustomerBackup.Recordset!W  eight

        !Old = frmIRANCustomers.adoIRANCustomerBackup.Recordset!O  ld

        !Birthday = frmIRANCustomers.adoIRANCustomerBackup.Recordset!B  irthday

        !Father = frmIRANCustomers.adoIRANCustomerBackup.Recordset!F  ather

        !MelliCode = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M  elliCode

        !Salary = frmIRANCustomers.adoIRANCustomerBackup.Recordset!S  alary

        !Website = frmIRANCustomers.adoIRANCustomerBackup.Recordset!W  ebsite

    End With

الان بهتر شد ولی هنوزم اون عبارت بزرگ و تکراری وجود داره، ولی خب ویژوال بیسیک 6 رو دست کم نگیرید

    Dim rs As Recordset

    Set rs = frmIRANCustomers.adoIRANCustomerBackup.Recordset



    With frmIRANCustomers.adoIRANCustomerList.Recordset

        !MName = rs!MName

        !Famlily = rs!Famlily

        !Comment = rs!Comment

        !Phone = rs!Phone

        !Email = rs!Email

        !Address = rs!Address

        !Code = rs!Code

        !Mobile = rs!Mobile

        !Personal = rs!Personal

        !Weight = rs!Weight

        !Old = rs!Old

        !Birthday = rs!Birthday

        !Father = rs!Father

        !MelliCode = rs!MelliCode

        !Salary = rs!Salary

        !Website = rs!Website

    End With

حتما قبول دارید که تا اینجا خیلی بهتر و خواناتر شده و خیلی جاها به همین شکل باید استفاده بشه، ولی به نظرتون بازم میشه مختصر ترش کرد ؟

    Dim r1 As Recordset, r2 As Recordset

    Set r1 = frmIRANCustomers.adoIRANCustomerList.Recordset: Set r2 = frmIRANCustomers.adoIRANCustomerBackup.Recordset



    For i = 0 To r1.Fields.Count - 1

        r2.Fields(i) = r1.Fields(i)

    Next

در اینجا با یک حلقه همه انتساب ها رو انجام دادیم و دیگه هر چی تعداد فیلدها زیاد بشه کد برنامه همین ثابته و مثل بالایی ها اضافه نمیشه


اما آیا به نظر شما باز هم میشه مختصر کرد ؟!! نظرتون راجع به این چیه

Set frmIRANCustomers.adoIRANCustomerBackup.Recordset = frmIRANCustomers.adoIRANCustomerList.Recordset

این روش رو با روش اول مقایسه کنید !، خیلی کارها رو میشه تو وی بی با این روش ها مختصر کرد و مطمئنا خوانایی برنامه خیلی افزایش پیدا میکنه، این روش آخر برای کلیه آرایه ها قابل انجامه، نمونه زیر رو تست کنید

 Dim a1(10), a2(), i%



For i = 0 To 10

a1(i) = i

Next



a2 = a1

نفر بعدی لطفا مطلبی بزار که تو کاربردهای روزمره مفید باشه

[golbafan]

سلام
اولین پست من در تالارهای ویبی هست :O)
انشاالله مفید باشه

نکته ویژوالی:
همونطور که میدونید دستورات ویبی بصورت تک خطی هستند
اما شما میتونید از آندرلاین ( _ ) برای ایجاد دستورات چند خطی استفاده کنید:

cmd.CommandText =     "SELECT * FROM Titles JOIN Publishers " _

    & "ON Publishers.PubId = Titles.PubID " _

    & "WHERE Publishers.State = 'CA'"

همچنین برای نوشتن چند دستور در یک خط از ( :) استفاده میشه کرد:

text1.Text = "Hello" : text1.BackColor = VbRed

نفر بعدی کارش درسته

[vbhamed]

سلام
کی فکرشو میکرد این تاپیک بعد از 6 سال بالا بیاد !!!!!

نکته ویژوالی:
ای کسانی که ترک vb6 کردین میدونید همین الان در سال 1401 میتونید با vb6 برای کل مجموعه آفیس، فتوشاپ، CorelDraw و ... برنامه و پلاگین بنویسید و کارهاتون رو تو این نرم افزارها اتوماتیک کنید ؟ چون این نرم افزارها همه بر پایه VBA که همون vb6 خودمونه تقریبا کار میکنن

ضمنا زبان ASP هم خیلی تشابه به VB6 داره، همچنین ماکرونویسی در ویندوز


نفر بعدی اصلا این تاپیک رو میبینه ؟ !

[adib202]

عجب تاپیک ماندگاری شده
برنامه هایی که حدود 15 سال هست تو بازار برای مشاغل و شرکت ها نوشتم داره براشون کار میده.
فکر کنم لااقل تا زمانی که پلتفرم ویندوز فایل اجرایی exe رو ساپورت کنه
دلم نمیاد از vb6 به محیط دیگه سوییچ کنم

نکته ویژوالی:

با اين كد ميشه عددي تصادفي بين 1 تا 6 پيدا كرد.

MyValue  = CInt(Int((6 * Rnd()) + 1))

نفر بعدی احتمالا یه فرازمینی باشه

[shahryari]

سلام و عرض ادب
بله بنده از کره مریخ آمده ام چون بعد از مدتها دوری از vb6 و کار با دات نت، مجددا آمدم سراغش ، انگار غریبه بودیم باهم

نکته ویژوالی:

تابع CreateObject از vb6 اومده و در vb.net هم هنوز در دسترسه و کارهای زیادی میشه باهاش کرد
بعنوان مثال حذف تمامی فایل های موجود در یک فولدر..

Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")

FSO.DeleteFolder "C:\MyFolder\*.*", True

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