بازم جواب  دو تا نظر

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

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







جوا ب اقاي امیر :

نظر : تست برای ویژال بیسیک داری با جواب اگه داری بهم خبر بده


جواب : اخه اول بگو در چه حدي هستي و چه تستي مي خواهي بعئ ببينيم كه چي ميشه
من در حال حاظر فقط سوالات امتحان كارشناسي ارشد نرم افزار دارم
حتما بگو در چه حدي داري ويژال بيسيك كار مي كني و مهمتر از همه بگو كه باسه
چي مي خواهي مثلا مي خواهي ديپلم بگيري يا باسه فوق ديپلم مي خواي


نظر و سوال اقا جواد : سلام
از اینکه به سوالم پاسخ دادی ممنون هستم.
اگه میشه توضیح بده چه جوری این ستاپ رو تو سی دی بریزم تا تو یه کامپیوتر دیگه نصب
بشه . ممنون


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

خوب برو تو پوشه اي كه ستاپ رو ساختي كه اسم پوشه Package اين پوشه رو
بايد رايتش كني كه اگه تو كامپيوتر كسي گزاشتي بايد وارد پوشه package بشي
و در اون پوشه روي فايل setup.exe كليك كرده تا وارد محيط نصب بشي ونرم افزار
رو نصب كني منظور از نرم افزار برنامه اي كه ساختيه خوب ولي اگه منظورت اينه كه
چه جوري بايد با nero بايد اون رو رايت كرد ... وارد نرم افزار nero كه معروف
ترين نرم افزار رايت در ايرانه
بعد از اين كه وارد نرم افزار نرو شدي يك پنجره ميبيني كه 6 الي بيشتر منو به صورت
ايكني داره مثلا عكس ستاره كه يا عكس يك برگ كاغذه و يا عكس اهنگ و يا غيره
كلا شما مي توني چند نوع رايت داشته باشي مثلا اگه خاستي يك فيلم تا تصوير رو رايت كني
گزينه video يا همون عكس فيلمه رو انتخاب مي كنيم ويا براي رايت هنگ صوتي يا
Mp3 ‌ منوي audio كه عكس اهنگ رو داره رو انتخاب و حالت هاي مختلف رو انتخاب
مي كنيم ولي چون ما مي خواهيم نرم افزار را رايت كنيم نه مي توانيم به صورت تصويري رايت
كنيم و نه به صورت صوتي چون فايل ما يك نه صوتي نه تصويري
ما براي رايت هر نوع اطلاعات فرقي نمي كنه چي باشه ايكن data‌ كه ايكنش شبيه يك وق كاغذه
استفاده مي كنيم يادت باشه كه از اين گزينه براي تصوير و صوت استفاده نكني چون اون وقت دستگاه
صوتي تصويري نمي تونه اون cd رو بخونه از اين گزينه فقط براي رايت نرم افزار استفاده بكن
يك خوبي ديگه هم رايت از نوع data داره اونم اينه كه اگه cd بسوزه مي توني دوباره رايتش كني
و يا دنباله cd هاي كه به صورت data‌ رايت شده دوباره رايت كني
خوب منوي data را انتخاب كن و از ليست باز شده گزينه Make Data Disc را انتخاب كن
خوب بقيه رايت كردن cd رو ديگه حتما بلدي ولي اگه مشكلي داشتي بگو حتما اگه بلد باشم كمكت
مي كنم

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

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




پايان

data1

قبل از همه جواب يك نظر از اقا جواد

نظر : سلام
خسته نباشید بازم از کد هات ممنون.
من به برنامه های گرافیکی و کاربردی خیلی علاقه دارم اگه میشه نحوه درست کردن setup برای برنامه های وی بی رو بگی ممنون میشم. بازم از لطفت ممنونم.
موفق باشی.


جواب : اول عليكم سلام دوم خوب شما مي توانيد با برنامه هاي زيادي براي روژه ها
تون setup بسازيد كه كم هم نيستند من يم روش رو بهتون مي گم كه اين
در زمان نصب ويژال بيسك نصب مي شه اسم برنام
Package and Deployment Wizard

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

Start - all program- Microsoft Visual Studio 6.0- Microsoft Visual Studio 6.0 Tools

حالا در اين قسمت گزينه Package & Deployment Wizard انتخاب كنيد


ويا در مسير نصب نرم افزار مثلا مال من در درايو d:\ نصب است

D:\Microsoft Visual Studio\Common\Tools

حالا در اين صفحه دنبال Package & Deployment Wizard بگرديد

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

بشيد در صفخه ضاهر شده در قسمت project Select روي دكمه Browse كليك كنيد

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

كنيد تا عمل كامپايل صورت گيره ببينه كل پروژه تون پشكل نداره و كل اكتيوس ها و dll هاي كه لازم

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

بعد در پنجره بعد كه نوع پكيج كردن يا Stupe رو بايد انتخاب كنيد گزينه پيش فرض باشه و بدون تغيير

در اين صفحه دكمه next را كليك كنيد تا به صفحه بعد برويد در اين پنجره مي توانيد مسيري كه پكيج

ستاپ ذخيره مي شود را ببينيد روي دكمه next كليك كنيد در بعضي مواقع پيش مي ايد كه نرم افزار

نمي تواند فايل vb6stik.dll را كه بسيار فايل مهمي براي اجرا شدن برنامه شما داره رو نمي تونه پيدا

كنه كه از شما مي خواهد به صورت دستي مسير دهي كنيد كه مي توانيد اسم اين dll را جستجو كرده و

بر روي دسكتاپ بگزاريد و بعد با browse ان را فراخاني كنيد ولي اگر چنين مشكلي پيش نيامد

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

نصبتان اضافه كنيد بعد روي گزينه next كليك كنيد وهمين طور در صفحه هاي بعد اگر لازم دانستيد

تغيير ايجاد كنيد در غيره اين صورت همه صفحه ها رو next ‌كرده تا اخر كه بايد فنيش كنيد تا پكيجتان

در محلي كه پروژهتان است ذخيره شود


پايان





____________________________________________________






كار با data1 براي مبتديان بازم ميگم اين اموزش براي مبتديان و كساني كه تا به حال

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

كاربردي نداره


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

ولي امروز مي خاهم ارتباط از طريق كنترل استاندارد data1 كه در جعبه ابزار خود ويژال به صورت

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

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

اموزش استفاده از كنترل data1


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

مي كنيم چون در پست قبلي طرق ساخت فايل بانك اكسس رو با خود ويژال بيسيك انجام داديم


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

حالا از منوي file گزينه new را انتخاب كنيد

حالا در سمت راست در ليست ايجاد شده گزينه Blank database... را انتخاب كنيد

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

دكمه Create كليد كنيد تا فايل ذخيره بشه


حالا يك پنجره كه هم نام فايلي كه ذخيره كردين هست ضاهر شده در اين پنجره روي گزينه

Create table in Design view كليكك كنيد اگر چنين گزينه اي نبود در بالاي همين پنجره روي گزينه

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

پنجره كه نام جدولتان است Table1 است كه ما بعدا تغيرش مي دهيم

در پنجره Table1 كه به سه قسمت تقسيم شده


Field Name : كه در اين قسمت بايد نام فيلد هاي تان را بنويسيد مثلا نام يا فاميلي و غيره

Data Type : در اين قسمت نوع فيلد هايتان را مشخص مي كنيد مثلا براي نام كه يك رشه است

نوع text ‌ را انتخاب و براي مثلا شماره تلفن نوع number وبراي مثلا ادرس و يا

توضيحات نوع Memo را انتخاب مي كنيم


Description : در اين قسمت توضيحات اضافه رو مي نويسم اين قسمت هيچ كاربردي در كد


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



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

Name
Family
Tel
Addres

طبق توضيحات بالا در قسمت Field Name به ترتيب نام فيلد ها و در قسمت Data Type

نوع انها را انتخاب مي كنيم در انتخاب نوع فيلد ها خيلي دقت كنيد

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

را با دكمه بالا خود پنجره ببنديد

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

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

من براي خودم نام جدولم من نام جدولم رو تغيير نمي دم مي زارم همون پيش فرض Table1

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

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

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

من در جلوتر توضيحات رو اگه وق بود كاملا براتون مي گم ولي اگه يادتون باشه در پروژه بانك قبلي

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

پس روي دكمه Yes كليك كنيد

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

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

اكسس 97 كنيم چون كنترل data1 نمي تونه فايل هاي جديد اكسس رو بخونه ما مجبوريم

فايل رو تبديل كنيم پس براي اين كار از منوي Tools گزينه atabase Utilities را انتخاب

و به زير منوي Conver&t Database و از گزينه To Access 9&7 File Format... انتخاب مي كنيم


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

شما ديگه با فايل قبلي كاري نداريد مي توانيد فايل قبلي كه ساختيد را پاك كنيد حالا فقط با اين فايل

كه تازه ذخيره كرديد كار داريد


از اكسس خارج شويد و وارد ويژال بيسيك شود

كنترل data1 رو كه در جعبه ابزار ويژال بيسيك وجود داره رو روي فرم بگزاريد

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

كد زير را در قسمت كد نويسي فرمتان پيست كنيد


Data1.DatabaseName = "c:\db2.mdb"
Data1.RecordSource = "table1"


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

اگه اسم جدولتان فرق داره و يا اسم ديگه اي است table1‌ را تغيير دهيد

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

دكمه هاي كنترل و دكمه t را از صفحه كليد بطنيد crt + t

حالا در اين صفحه تيك كنار گزينه Microsoft Data Bound Grid Control 5.0 (SP3) را بزنيد

حالا در جعبه ابزارتان يك كنترل جديد اضافه شد كنترل DBGrid1 را روي فرم بگزاريد

و در قسمت خصوصيات ان مقدار گزينه DataSource را data1 بگزاريد


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


براي اضافه كردن اطلاعات نيز چهار تا تكس باكس روي فرم قرار داده
Text
Text2
Text3
Text4


حالا يك دكمه يا كامند باتون به نام command1 روي فرم بگزاريد و كد زير را در قسمت

كد نويسي فرمتان پيست كنيد



Private Sub Command1_Click()

Data1.Recordset.AddNew
Data1.Recordset.Fields("name") = Text1.Text
Data1.Recordset.Fields("family") = Text2.Text
Data1.Recordset.Fields("tel") = Text3.Text
Data1.Recordset.Fields("addres") = Text4.Text

Data1.UpdateRecord

End Sub



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

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

كد نويسي data1 با adodce1 فرقي براي مبتديان نداره كد ها همونه


فقط يك مطلب مي مونه اونم اينه كه اگه مثلا كنترل DBGrid1 را نداشتيم چطور داخل اطلاعات

Data1 را مي ديديم و استفاده مي كرديم


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

با همون چهار تا تكست باكسي كه روي فرم است

در قسمت خصوصيات همه تكست باكسها در خاصيت DataSource گزينه data1 را انتخاب

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




خوب حالا براي فراخاني اطلاعات از data1‌ به داخل تكس باكس ها كد زير را به قسكت كد نويسي

فرمتان پيست كنيد


Private Sub Form_Activate()

Text1.DataField = "name"
Text2.DataField = "family"
Text3.DataField = "tel"
Text4.DataField = "addres"
End Sub


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

Data1 حركت كنيم راحت تر بگم بتونيم عقب جلو كنيم مثلا اطلاعات قبلي و بعدي رو ببينيم

براي اي كه اطلاعات قبلي و بعدي داخل data1 رو ببينيم دو تا كامند با تون ديگه

Command2
Command3

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

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


Private Sub Command2_Click()
Data1.Recordset.MoveLast
End Sub

Private Sub Command3_Click()
If Data1.Recordset.EOF = False Then
Data1.Recordset.MoveNext
End If

End Sub



خوب من براي كامند 2 گفتم كه يك خانه برگرد عقب ولي براي كامند دو گفتم اگه به

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


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

بگم چكار كنيد







بازم چند تا برنامه







چگونه از اجراي مجدد برنامه در ويژوال بيسيک جلوگيري كنيم يعني اين كه مثلا يك برنامه اي رو

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

كاربر دوباره روي ايكن برنامه ما كليك كنه يك پيقام نشون بده كه نتوان برنامه را دو باره اجرا كرد

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

كد زير را درقسمت كد نويسي فرمتان پيست كنيد



Private Sub Form_Load()
Dim Result As Integer
If App.PrevInstance = True Then

Result = MsgBox("برنامه در حال اجراست", vbInformation, "اختار")
Unload Me
End If
End Sub



پايان





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

توضيح اينه كه مي خاهيم برنامه بنويسيم كه مسير يم فايل رو بگيري فرقي نمي كنه چه نوع فايلي با شه

بعد مسير يك فايل ايكن رو مي گيريم و بعد نوع نشون دادن ايكن رو معلوم مي كنيم مثلا پشت ايكن پر

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

توضيح ديگه بسه در كد پايين كه من مسير يك فايل كه تو كامپيوتر خودمه دادم شما با فايل و مسير خودتون

عوضش كنيد و حالا كدهاي زير را در قسمت كد نويسي فرمتان پيست كنيد


Sub CreateShortCut(File As String, icon As String, iconindex As Long, Target As String)
Dim intFreeFile As Integer
File = File & ".url"
intFreeFile = FreeFile
Open File For Output As intFreeFile
Print #intFreeFile, "[InternetShortcut]"
Print #intFreeFile, "URL=" & Target
Print #intFreeFile, "IconFile=" & icon
Print #intFreeFile, "Iconindex=" & iconindex
Close intFreeFile
End Sub

Private Sub Form_Load()
'CreateShortCut "File","icon","0","File"
CreateShortCut "c:\abbas.txt", "F:\abbas\icon1\8.ico", "0", "c:\abbas.txt"
End Sub




پايان

___________________________________________________________________



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

استفاده منيم توضيح ميخاهيم يك برنامه بنويسيم كه مثلا رزليشن مانيتوئ رو از حالت 1024 700 به

حالت 600 در 800 و يا هر اندازه كه دلتون خاصت ببريد البته مي دونم من در توضيح دادن افتضاح

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

خوب براي شروع ما به چند كنترل نياز داريم كنترل هاي زير را روي فرم بگزاريد

Command1
List1

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



Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32

Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_DISPLAYFLAGS = &H200000
Const DM_DISPLAYFREQUENCY = &H400000

Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpInitData As DEVMODE, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (lpszDeviceName As Any, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Const BITSPIXEL = 12

Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H2
Const CDS_FULLSCREEN = &H4
Const CDS_GLOBAL = &H8
Const CDS_SET_PRIMARY = &H10
Const CDS_RESET = &H40000000
Const CDS_SETRECT = &H20000000
Const CDS_NORESET = &H10000000

' /* Return values for ChangeDisplaySettings */
Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const DISP_CHANGE_FAILED = -1
Const DISP_CHANGE_BADMODE = -2
Const DISP_CHANGE_NOTUPDATED = -3
Const DISP_CHANGE_BADFLAGS = -4
Const DISP_CHANGE_BADPARAM = -5

Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4

Dim D() As DEVMODE, lNumModes As Long

Private Sub Command1_Click()
Dim l As Long, Flags As Long, x As Long
x = List1.ListIndex
D(x).dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
Flags = CDS_UPDATEREGISTRY
l = ChangeDisplaySettings(D(x), Flags)
Select Case l
Case DISP_CHANGE_RESTART
l = MsgBox("This change will not take effect until you reboot the system. Reboot now?", vbYesNo)
If l = vbYes Then
Flags = 0
l = ExitWindowsEx(EWX_REBOOT, Flags)
End If
Case DISP_CHANGE_SUCCESSFUL
Case Else
MsgBox "Error changing resolution! Returned: " & l
End Select
End Sub

Private Sub Form_Load()
Dim l As Long, lMaxModes As Long
Dim lBits As Long, lWidth As Long, lHeight As Long
lBits = GetDeviceCaps(hdc, BITSPIXEL)
lWidth = Screen.Width \ Screen.TwipsPerPixelX
lHeight = Screen.Height \ Screen.TwipsPerPixelY
lMaxModes = 8
ReDim D(0 To lMaxModes) As DEVMODE
lNumModes = 0
l = EnumDisplaySettings(ByVal 0, lNumModes, D(lNumModes))
Do While l
List1.AddItem D(lNumModes).dmPelsWidth & "x" & D(lNumModes).dmPelsHeight & "x" & D(lNumModes).dmBitsPerPel
If lBits = D(lNumModes).dmBitsPerPel And _
lWidth = D(lNumModes).dmPelsWidth And _
lHeight = D(lNumModes).dmPelsHeight Then
List1.ListIndex = List1.NewIndex
End If
lNumModes = lNumModes + 1
If lNumModes > lMaxModes Then
lMaxModes = lMaxModes + 8
ReDim Preserve D(0 To lMaxModes) As DEVMODE
End If
l = EnumDisplaySettings(ByVal 0, lNumModes, D(lNumModes))
Loop
lNumModes = lNumModes - 1
End Sub




حالا برنامه را اجرا كنيد ميبينيد كه در ليست باكس تمامي حالت هاي تفكيك پذيري امده كافي هر كدوم رو

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




پايان

_________________________________________________________________



نمايش پنجره تارن اف يا همون پنجره مال خاموش كردن كامپيوتره اين كد فقط اون پنجره رو احضار

مي كنه كد هاي زير را به قسمت كد نويسي فرمتان پيست كنيد


Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long


Private Sub Form_Load()
SHShutDownDialog 0
End Sub



پايان




بدست اوردن ورژن اينترنت اگسپلورر

براي اين كار كد هاي زير را در قسمت كد نويسي فرمتان پيست كنيد


Option Explicit

Private Type DllVersionInfo
cbSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
End Type


Private Declare Function DllGetVersion _
Lib "Shlwapi.dll" _
(dwVersion As DllVersionInfo) As Long


Public Function IEVersionShort() As Long
Dim udtVersionInfo As DllVersionInfo
udtVersionInfo.cbSize = Len(udtVersionInfo)
Call DllGetVersion(udtVersionInfo)
IEVersionShort = udtVersionInfo.dwMajorVersion
End Function


Public Function IEVersionLong() As String
Dim udtVersionInfo As DllVersionInfo
udtVersionInfo.cbSize = Len(udtVersionInfo)
Call DllGetVersion(udtVersionInfo)
IEVersionLong = "Internet Explorer " & _
udtVersionInfo.dwMajorVersion & "." & _
udtVersionInfo.dwMinorVersion & "." & _
udtVersionInfo.dwBuildNumber
End Function


Prكدهاي زير را در قسمت كد نويسي فرمتان پيست كنيد ivate Sub Form_Activate()
Print IEVersionLong

End Sub



پايان




بدست اوردن هندل دسكتاپ

كدهاي زير را در قسمت كد نويسي فرمتان پيست كنيد

Private Declare Function M_GetDesktopWindow Lib "user32" _
Alias "GetDesktopWindow" () As Long
Function GetDesktopWindow() As Long
Dim xHwnd As Long
xHwnd = M_GetDesktopWindow()
GetDesktopWindow = xHwnd
End Function

Private Sub Form_Activate()
Print GetDesktopWindow

End Sub





پايان





چگونه ايكن هاي روي دسكتاپ را rafresh دهيم


براي اين كار ما نياز به كنترل كامند باتون داريم ابزار زير را روي فرم بگزاريد

Command1


حالا كدهاي زير را در قسمت كد نويسي فرمتان پيست كنيد


Option Explicit
Private Declare Function SendMessageByLong& Lib "user32" Alias _
"SendMessageA" (ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)

Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String)

Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" _
(ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName _
As String, ByVal lpWindowName As String)

Private Const LVM_GETTITEMCOUNT& = (&H1000 + 4)
Private Const LVM_SETITEMPOSITION& = (&H1000 + 15)

Dim hdesk&, i&, icount&, X&, Y&

Public Sub MoveIcons()
hdesk = FindWindow("progman", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "shelldll_defview", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "syslistview32", vbNullString)
'hdesk is the handle of the Desktop's syslistview32

icount = SendMessageByLong(hdesk, LVM_GETTITEMCOUNT, 0, 0)

'0 is "My Computer"
For i = 0 To icount - 1
X = 40 * i: Y = 40 * i 'set the position parameters in pixel
'The wParam must be i
Call SendMessageByLong(hdesk, LVM_SETITEMPOSITION, i, CLng(X + Y * &H10000))
Next
End Sub

Private Sub Command1_Click()
Call MoveIcons
End Sub





پايان





حذف اسپيس هاي اضافي در يك جمله مثل اين كه تمامي كلمات داخل جمله تريم بشن يعني فاصله هاي

اضافي بين دو كلمه برداشته بشه

براي اين كار ما نياز داريم به دو ابزار زير دو كنترل زير را روي فرم بگزاريد

Text1
Command1

حالا كدهاي زير را در قسمت كد نويسي فرمتان پيست كنيد


Public Function TrimALL(ByVal TextIN As String) As String
TrimALL = Trim(TextIN)
While InStr(TrimALL, String(2, " ")) > 0
TrimALL = Replace(TrimALL, String(2, " "), " ")
Wend
End Function

Private Sub Command1_Click()
Text1.Text = TrimALL(Text1.Text)
End Sub



پايان


_______________________________________________________________





help me



سلام اقاي p30ton

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

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

چطوره ايا مي تونه منو ارضا كنه يا اين كه مثل ويژال بيسيك . من كه حدود شيش هفت ماهي شايدم بيشتره

اصلا با ويژال كار نمي كنم تو اين مدت هم رفتم طرف پاسكال خيلي رون تر و بهتر از ويژال بيسيك

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

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

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

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

من كه تابه حال دلفي كار نكردم ولي چند تا پروژه كه از اينترنت دانلود كردم براي تست نگاهي سطحي

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

كدنويسيش فرق داره

من اولين زباني كه بعد از 1 ماه كه كامپيوتر گرفته بودم c++ بود كه براي اين كار يك كتاب خريدم اون

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

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

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

با هزار دوز كلك و ببختي يك كم c++ رو ياد گرفتم اليته حالا خيلي خوشحالم كه اين كارو كردم چون

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

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

چيه اون وقت هم از كل صفحه اگه نصفشو يا مي گرفتم ميرفتم صفحه بعد اصلا الان كه فكرشو ميكنم

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

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

ميرم سراغ c++ بيلدر كه رو سطح ويندوزه دور دلفي رو خط ميكشم


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

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

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

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


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

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

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


سوال


راجع به برنامه نویسی در ورد به کمک ویژوال بیسیك يك مقاله كامل



وب لاگ ايشون

http://p30ton.blogfa.ir/




يكي يك كمك به ما مي ده

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



با تشكر عباس كوتر

بانك اطلاعاتي

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

پيش امد و نشد ولي براي كساني كه تا به حال طريقه ارتباط يك فايل اكسس به ويژال بيسيك رو استفاده

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

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


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


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

نداريد حتما نصب كنيد

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

با استفاده از ويژال بيسيك يك برنامه بنويسيم كه اطلاعاتي مثل نام و فاميلي و تلفن و ادرس رو در

خودش ذخيره كنه اين پروژه كاملا مبتدي و كاربردي براي كساني كه حتي يك بار بانك اطلاتي ساختن

ندارد

براي شروع وارد محيط ويژال بيسيك بشيد

از سربرگ Add-Ins گزينه Visual Data Manager را انتخاب كنيد تا وارد اين پنجره شويد

حالا در پنجره Visual Data Manager از منوي File به زير منوي New رويد و از زير

منو New به زير منوي Microsoft Access رويد و از زير منوي Microsoft Access

زير منوي Version 7.0 mdb را انتخاب كنيد در پنجره باز شده مسيري را براي ذخيره

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

حالا اگر به پنجره Visual Data Manager نگه كنيد مي بينيد كه دو پنجره داخل ان ايجاد شده

در اين جا از پنجره Window Database روي گزينه Properties كليك راست كرده و

گزينه Table New را انخاب كنيد تا وارد پنجره Structure Table شويد

در اين پنجره در باكس روي به روي Name Table نامي را براي جدولتان انخاب كنيد در انتخاب

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

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

با كليك كردن روي دكمه Field Add وارد پنجره Field Add مي شويد در اين پنجره در

باكس Name نامي را براي فيلد تان انتخاب كنيد شما نام فيلد را name بگزاريد و در قسمت

Type گزينه Memo را انخاب كنيد و بعد از ان روي دكمه OK كليك كنيد و دوباره فيلد

ديگه بسازيد ايم فيلد دوم را family و فيلد سوم را tel و فيلد چهارم را addres بگزاريد

خوب بعد از ساختن چهار فيلدي كه بالا گفتيم روي دكمه Close كليك كنيد حالا در پنجره Field Add

شما بايد در قسمت List Field نام هر چهار فيلدي كه گفتم را ببينيد
Name
Family
Tel
Addres

در ضمن دقت كنيد در اين همين پنجره در قسمت تكست باكس name Table نام جدولي كه نوشتيد

باشه اگه نبود دوباره نام جدول را بنويسيد .

حالا براي اين كه جدول و فيلد هاي كه ساختيم در فايل كه ساختيم ذخيره بشه در همين پنجره روي

دكمه Table the Build كليك كنيد . حالا پنجره Visual Data Manager را ببنديد و براي

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

فراخاني اين دو ابزار دكمه هاي CTR + T را بزنيد تا وارد پنجره Components شويد حالا

در اين پنجره تيك كنار دو گزينه زير را بگزاريد و Apply كنيد و پنجره را ببنديد
Microsoft ADO Data Control 6.0 (OLEDB)
Microsoft DataGrid Control 6.0 (OLEDB

ابزار Adodc1 براي اتصال به بانك اكسس استفاده مي كنيم
ابزار DataGrid1 براي ديدن اطلاعات داخل بانك اكسس به صورت جدولي استفاده مي كنيم

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

ابزار Adodc1 مهم نيست كجا و چه اندازه باشه ولي ابزار DataGrid1 را به اندازه بزگ كنيد تا

براي ديدن اطلاعات نياز به اسكرول نباشه

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

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

Property Adodc را انتخاب مي كنيم تا وارد پنجره Pages Property شويم حالا در اين جا روي

دكمه build كليك مي كنيم تا وارد پنجره ديگري شويم گزينه Microsoft Jet 4.0 OLE DB Provider

را انتخاب كريد و ردي دكمه Next كليك مي كنيم تا وارد پنجره Connection شويم در اين پنجره

روي دكمه كنار تكس باكس گزينه 1. Select or enter a database name: كليك مي كنيم و فايلي

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

درست برقرار شده در همين پنجره روي دكمه Connection Test كليك مي كنيم اگر ارتباط ما

مشكلي نداشت پيغام Test connection succeeded ضاهر مي شود

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

مي كنيم تا دوباره وارد پنجره Pages Property شويم در اين پنجره سربرگ RecordSource را

انتخاب كنيد و در اين پنجره در قسمت Command Type گزينه adCmdTable را انتخاب كنيد

و در قسمت Table or Stored Procedure Name نام كه براي جدولتان انتخاب كرديد را انتخاب كنيد

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

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

DataGrid1 كليك كنيد و در قسمت خصوصيات ان گزينه DataSource را پيدا كرده ودر قسمت

مقدار ان گزينه Adodc1 را انتخاب كنيد خوب كار ارتباطات تمام شد يك بار برنامه را اجرا كنيد

تا فيلد هاي كه ساختيد را ببينيد خوب ديگه نوبت طريقه اضافه كردن و پاك كردن و جستجو و .... براي

بانكي كه ساختيم رسيد

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

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

بگزاريد و يك كامند باتون كه كپشن ان را add بگزاريد


Text1
Text2
Text3
Text4
Command1

Text1 : نام شخص
Text2 : فاميلي
Text3 : تلفن
Text4: ادرس

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


Private Sub Command1_Click()
If Text1.Text <> "" Then
If Text2.Text <> "" Then
If Text3.Text <> "" Then
If Text4.Text <> "" Then

Adodc1.Recordset.Filter = "name='" & Text1.Text & "'"

If Adodc1.Recordset.EOF = True Then
Adodc1.Recordset.AddNew

Adodc1.Recordset.Fields("name") = Text1.Text
Adodc1.Recordset.Fields("family") = Text2.Text
Adodc1.Recordset.Fields("tel") = Text3.Text
Adodc1.Recordset.Fields("addres") = Text4.Text
Adodc1.Recordset.Update

If MsgBox("ليست با موفقيت ذخيره شد ", vbOKOnly + vbQuestion, "زخيره") = vbOK Then
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""

End If

Else
a = MsgBox("نام تكراري است", vbCritical, "اختار")

End If
Adodc1.Recordset.Update

Adodc1.Refresh
End If
End If
End If
End If
End Sub


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

بده تا كاربر اسم ديگري را انتخاب كند

من در كد بالا با كد زير گفتم كه فيلد فاميلي را فيلتر كن


Adodc1.Recordset.Filter = "name='" & Text1.Text & "'"

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

If Adodc1.Recordset.EOF = True Then
Adodc1.Recordset.AddNew


خوب توضيح ديگه بسه حالا يك دكمه يا كامند باتون ديگه روي فرم بگزاريد و كپشن ان را delet

بگزاريد

Cammand2

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

به قسمت كد نويسي فرمتان پيست كنيد

Private Sub Command2_Click()
If MsgBox("ايا مي خاهيد فيلد انتخابي را حذف كنيد ؟ توجع كنيد اگر هيچ فيلدي را انتخاب نكرده باشيد اخرين فيلد حذف خاهد شد", vbOKCancel, "اختار") = vbOK Then
If Adodc1.Recordset.RecordCount <> 0 Then
Adodc1.Recordset.Delete
End If
End If
End Sub


در كد بالا گفتم كه اگه فيلدي وجود داشت ان را پاك كن در غير اين صورت هيچ كاري انجام نده

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

فيلد جدول را پاك مي كند


خوب ما براي بانكي كه ساختيم نياز داريم كه جستجوي بگزاريم خوب براي جستجو يك كامند باتون ديگه

روي فورم بگزاريد و كپشن ان را serch بگزاريد

Command3

كد هاي زير را در قسمت كد نويسي فرمتان پيست كنيد



Private Sub Command3_Click()
If Text1.Text = "" Then
MsgBox ("ÊßÓÊ ãÑ龯 Èå ßÏ ÎÇáí ÇÓÊ ")

Else

Text2.Text = ""
Text3.Text = ""
Text4.Text = ""

Adodc1.Recordset.Filter = "code='" & Text1.Text & " '"
If Adodc1.Recordset.BOF = False Then
Text2.Text = Adodc1.Recordset.Fields("name")
Text3.Text = Adodc1.Recordset.Fields("family")
Text4.Text = Adodc1.Recordset.Fields("tel")

Else
MsgBox (" ßÏ ãæÑÏ äÙÑ ÏÑ ÈÇäß ÇØáÇÚÇÊí ãæÌæÏ äíÓÊ .")
End If
End If

End Sub




نكته : در كد پايين گفتم كه بيا فيلد نام را فيلتر كن


Adodc1.Recordset.Filter = "code='" & Text1.Text & " '"

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

If Adodc1.Recordset.BOF = False Then



حالا نوبت اين رسيده كه اگه مثلا خاصتيم اطلاعات شخصي رو تغيير بديم نياز به ويرايش اطلاعات

اون شخص داريم كه براي اين كار يك كامند باتون ديگه روي فرم بگزاريد و كپشن ان را edit بگزاريد

Command4


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


Private Sub Command4_Click()
If Text1.Text <> "" Then
If Text2.Text <> "" Then
If Text3.Text <> "" Then
If Text4.Text <> "" Then

Adodc1.Recordset.Fields("name") = Text1.Text
Adodc1.Recordset.Fields("family") = Text2.Text
Adodc1.Recordset.Fields("tel") = Text3.Text
Adodc1.Recordset.Fields("addres") = Text4.Text

End If
End If

End If
End If

End Sub


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

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

با كپشن rafresh بگزاريد

Command5

و كدهاي زير را به قسمت كد نويسي فرمتان پيست كنيد


Private Sub Command5_Click()
Adodc1.Refresh
End Sub




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

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

پيست كنيد


Private Sub Text3_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 47 To 57
Case Else
KeyAscii = 0
End Select
End Sub




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

مختص مبتديان بوده و هيچ كاربردي براي كساني كه حتي يك بار هم با بانك اطلاعاتي ساختن كاربرد نداره

كدهاي بالا پر از مشكله كه مهمترينشون اين كه ما نميتونيم يك اطلاعات مثل هم داشته باشيم كه براي حل

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

Aouto number بگزرايد كه راحترين راه حل براي اين مشكله من راحت ميتونستم قبل از ساخت

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

كنيد وفقط كارتون كپي پيست نباشه ولي اگه موفق نشديد تو نظرات بگيد تا بهتون مشكلات كدهاي بالا رو بگم

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

ويژال بيسيك 6

قبل هر چيز يك نظر از اقا جواد

نظر : سلام
کارت خیلی عالیه
میتونی یه سایت برای کد های وی بی معرفی کنی واگه خودت از یه سایت استفاده می کنی اونو معرفی کن .خیلی حرف زدم نه ............چه جوری اینقدر خوب می نویسی ............یه کتابم معرفی کنی خیلی عالیه میشه.
ممنون


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

نوع سايت ها استفاده نمي كنم نمي دونم كدومشون بهتر سوما شما كم حرف هم هستي چهارما

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

كتاب كمكت كنم ولي خواهشن اگه كسي كتاب خوبي در باره ويژال بيسيك مي شناسه تو نظرات بگه تا من

معرفيش كنم كه مشكل اقا جواد ما هم حل شه و بعدشم جواد جون (البته ببخشيد خودموني شدم) بگو در

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

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


_________________________________________________________________


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

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

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


Private Sub Form_Load()
Dim i As Integer
For i = 0 To Me.Controls.Count - 1
Me.Controls(i).Left = Me.Controls(i).Left + 2600
Next i

End Sub



پايان
_____________________________________________________________________




چطور پنجره run را باز كنيم و دستورات را در ان بنويسم . خوب شما حتما دوست داريد كه

در برنامه هاي كه مي نويسيد از دستورات پنجره ران استفاده كنيد با كد هاي پايين مي توانيد پنجره run

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


كد هاي زير را به قسمت كد نويسي فرمتان پيست كنيد


Private Declare Function SHRunDialog Lib "shell32" Alias "#61" (ByVal hwnd _
As Long, ByVal I_dont_know_1 As Long, ByVal I_dont_know_2 As Long, ByVal _
dTitle As String, ByVal dPrompt As String, ByVal uFlags As Long) As Long

Private Sub Form_Load()

SHRunDialog hwnd, 0, 0, "run", "Please enter the program you wish to run ", 2

End Sub


تذكر : اگر در كد بالا به جاي عدد 2 عدد يك را بگزاريد پنجره تغيير يافته run باز مي شود




پايان




ايجاد وقفه در اجراي فرم يا هر پنجره ديگه براي ايجاد وقفه در بارگزاري فرم كد هاي زير را

در قسمت كد نويسي فرمتان پيست كنيد


Sub Pause(interval)
Dim Current
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub

Private Sub Form_Load()
Pause (2)
End Sub




پايان
___________________________________________________________________



چطور يك فرم را با كدنويسي ايجاد كنيم


براي اين كار يك كامند باتون يا دكمه روي فرم بگزاريد و كدهاي زير را به قسمت كد نويسي فرمتان

پيست كنيد

Const WS_EX_STATICEDGE = &H20000
Const WS_EX_TRANSPARENT = &H20&
Const WS_CHILD = &H40000000
Const CW_USEDEFAULT = &H80000000
Const SW_NORMAL = 1
Const WS_EX_DLGMODALFRAME = &H1&
Const WS_CAPTION = &HC00000
Const WS_MAXIMIZEBOX = &H10000
Const WS_MINIMIZEBOX = &H20000
Const WS_SYSMENU = &H80000

Private Type CREATESTRUCT
lpCreateParams As Long
hInstance As Long
hMenu As Long
hWndParent As Long
cy As Long
cx As Long
y As Long
x As Long
style As Long
lpszName As String
lpszClass As String
ExStyle As Long
End Type

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long

Dim m_hWnd As Long

Private Sub Command1_Click()
Dim CS As CREATESTRUCT

m_hWnd = CreateWindowEx(WS_EX_DLGMODALFRAME, "#32770", "abbascooter.blogfa", WS_CAPTION Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SYSMENU, 0, 0, 500, 250, 0, 0, App.hInstance, CS)
ShowWindow m_hWnd, SW_NORMAL
End Sub




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



پايان



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

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

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

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


يك فرم ايجاد كرده و ابزار زير را روي ان بگزاريد

Image1
Timer1
Timer2
Timer3

خوب خصوصيات كنترل ها

Timer1. Interval=10
Timer2. Interval=500
Timer3. Interval=10

Image1 موقييت image1 را گوشه فرم بگزاريد و انتدازه ان را به اندازه دو برابر كامند باتون

كنيد و فرم را نيز به اندازه يك ثانتر بزرگتر از image1 بكنيد در ضمن خاصيت فرم را نيز

مانند زير تغيير دهيد

Form1. BorderStyle= 0 – None

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

Dim hit As Boolean
Dim alan As Integer
Dim lr, ud As Integer
Dim james As Integer
Dim linnegar As Integer
Dim startx As Integer

Private Sub Form_Load()

Me.Show 1
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If hit = False Then
james = -((X - (Me.Width / 2)) / 5)
linnegar = -((Y - (Me.Height / 2)) / 2)
timer2.Enabled = True
hit = True
End If

End Sub

Private Sub Timer1_Timer()

Me.Left = Me.Left + james
Me.Top = Me.Top + linnegar

End Sub

Private Sub Timer3_Timer()

If Me.Top > (Screen.Height - Me.Height) Then
linnegar = -(linnegar / 1.2)
Me.Top = (Screen.Height - Me.Height)
End If

If Me.Top < (Screen.Height - Me.Height) Then
linnegar = linnegar + 5
End If


If Me.Left < 0 Then
james = 100
End If

If Me.Left > (Screen.Width - Me.Width) Then
james = -100
End If
End Sub

Private Sub timer2_Timer()

hit = False
timer2.Enabled = False
End Sub




برنامه را اجرا كنيد و موستان را به طرف فورمتان ببريد



پايان
__________________________________________________________________



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

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

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

خوب براي شروع دو ابزار زير را روي فرم بگزاريد

List1
Text1

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

Option Explicit
Private Declare Function SendMessage Lib "User32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal _
wMsg As Integer, ByVal wParam As Integer, lParam _
As Any) As Long
Const LB_FINDSTRING = &H18F

Private Sub Form_Load()
With List1
.Clear
.AddItem "abbas"
.AddItem "ali"
.AddItem "reza"
.AddItem "scooter"
.AddItem "mohammad"
.AddItem "jamshed"
.AddItem "babak"
End With
End Sub

Private Sub Text1_Change()
List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, -1, ByVal Text1.Text)

Text1.Text = List1.Text
End Sub


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

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



پايان



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

پس ديگه من هيچ توضيحي نميدم براي توضيح روش كار برنامه پروژه بالا رو بخونيد توضيحات

داده شده


خوب ابزار زير را روي فرم بگزاريد

Combo1

بعد چند تا اسم را بهش اد يا راحت تر بگم اضافه كنيد


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


Private miSelStart As Integer
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 46 Then KeyCode = 0

miSelStart = Combo1.SelStart
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
Dim lCnt As Long
Dim lMax As Long
Dim sComboItem As String
Dim sComboText As String
Dim sText As String

With Combo1
lMax = .ListCount - 1
sComboText = .Text
sText = Left(sComboText, miSelStart) & Chr(KeyAscii)

KeyAscii = 0

For lCnt = 0 To lMax
sComboItem = .List(lCnt)

If UCase(sText) = UCase(Left(sComboItem, _
Len(sText))) Then
.ListIndex = lCnt
.Text = sComboItem
.SelStart = Len(sText)
.SelLength = Len(sComboItem) - (Len(sText))

Exit For
End If
Next
End With
End Sub




روش كار همانند پروژه بالاي



پايان




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

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

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

براي شروع تعداي textbox روي فرم بگزاريد


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

Public Sub ClearTextBoxes(frmClearMe As Form)

Dim txt As Control

For Each txt In frmClearMe

If TypeOf txt Is TextBox Then txt.Text = ""

Next

End Sub

Private Sub Form_Load()
ClearTextBoxes Me
End Sub



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




پايان
____________________________________________________________________




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

خوب براي اين كار در قسمت كد نويسي فرمتان پيست كنيد


Sub Startrek(frm As Form)

GotoVal = frm.Height / 2
For Gointo = 1 To GotoVal
DoEvents
frm.Height = frm.Height - 100
frm.Top = (Screen.Height - frm.Height) \ 2
If frm.Height <= 500 Then Exit For
Next

End Sub

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


حالا پنجره را با دكمه بالا ان ببنديد . افكت قشنگي



پايان
__________________________________________________________________



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

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

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

خوب كدهاي زير را به قسمت كد نويسي فرمتان پيست كنيد


ByVal hWndInsertAfter As Long, ByVal x As Long, y, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Private Sub MakeNormal(lngHwnd As Long)
SetWindowPos lngHwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End Sub

Private Sub MakeTopMost(lngHwnd As Long)
SetWindowPos lngHwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End Sub


Private Sub Form_Load()
MakeTopMost Me.hwnd
End Sub



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

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

MakeNormal Me.hwnd




پايان
_______________________________________________________________



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

فقط كافي كدهاي زير را به قسمت كد نويسي فرمتان پيست كنيد


Private Sub Form_Activate()
Shell ("rundll32 diskcopy.dll, DiskCopyRunDll")

End Sub



پايان
________________________________________________________________

vb 6

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

جواب چند تا نظر و سوال

سوال 1 : استشو بخوای من یه برنامه می خواستم که به اون تاریخ و ساعت تولدت رو بدی .
اونم بهت بگه چند ثانیه و چند دقیقه و چند ساعت و چند روز و چند ماه و چند سال از عمرت گذشته .
به هجری شمسی باشه .


جواب 1: راستش من اين برنامه رو تو پست هاي قبلي نوشتم كه اگه به ارشيو من يك نگاه كني حتما
مي تواني پيداش كني البته اين برنامه و سوالي كه پرسيدي خيلي ابتداي است من فقط براي
اين كه بتوني تاريخ ميلادي رو تبديل به تاريخ شمسي كني يك روش بسيار ساده برات ميزارم
كه اين كدي كه من برات مي زارم رو يك بار نگاه كني راحت مي توني خودت بنويسيش
و بقيه محاصبات رو هم خودت مي توني انجام بدي
يك كمك به تو ( هر 1 دقيقه 60 ثانيه - هر 1 ساعت 60 دقيقه و هر يك روز از 24 ساعت تشكيل شده
و هر 1 سال 8640 ساعت هشتش ..... بقيش با خودت خيلي ساده است

كد تبديل تاريخ ميلادي به شمسي

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

Dim mm, yy, dd, m, d, y
Dim roz_f, mat_f As String
Dim changedate


Private Sub Form_Load()
Me.AutoRedraw = True
Dim a(1 To 12) As Integer
Dim b(1 To 12) As Integer

a(1) = 10
b(1) = 30
a(2) = 11
b(2) = 30
a(3) = 9
b(3) = 29
a(4) = 11
b(4) = 31
a(5) = 10
b(5) = 31
a(6) = 10
b(6) = 31
a(7) = 9
b(7) = 31
a(8) = 9
b(8) = 31
a(9) = 9
b(9) = 31
a(10) = 8
b(10) = 30
a(11) = 9
b(11) = 30
a(12) = 9
b(12) = 30

y = InputBox("2007")



m = InputBox("12")

d = InputBox("31")

yy = y - 621


If ((y Mod 4) = 0) And (m = 3) And (d < 21) Then

a(3) = a(3) + 1
b(3) = b(3) + 1
End If


mm = m + 9

dd = d + a(m)

If (dd > b(m)) Then

dd = dd - b(m)
mm = mm + 1
End If

If mm > 12 Then mm = mm - 12
If (mm = 10) And (dd > 10) Then
yy = yy - 1
End If
If mm = 11 Then yy = yy - 1
If mm = 12 Then yy = yy - 1

Select Case mm

Case 1: mat_f = "1"
Case 2: mat_f = "2"
Case 3: mat_f = "3"
Case 4: mat_f = "4"
Case 5: mat_f = "5"
Case 6: mat_f = "6"
Case 7: mat_f = "7"
Case 8: mat_f = "8"
Case 9: mat_f = "9"
Case 10: mat_f = "10"
Case 11: mat_f = "11"
Case 12: mat_f = "12"
End Select

Str (yy)
Str (s)
roz_f = s

Str (dd)
Str (s)

roz_f = (roz_f + s)

changedate = roz_f


Print yy, mm, dd

End Sub




پايان




سوال دوم : خيلي پروپا قرص هستم اونم ازون ترفدارات
من يه سوال كوچول موچول داشتم اونم اينه كه چجوري ميشه درون يك
(Progressbar)
يك تايم قراردهيم تا با پرشدن اون تايم ما هم به 100 برسه ؟

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



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


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

Private Sub Timer1_Timer()
If ProgressBar1.Value < 100 Then
ProgressBar1.Value = ProgressBar1.Value + 1
Me.Caption = ProgressBar1.Value
Else
Timer1.Enabled = False
End If
End Sub




پايان سوال اولت

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

اول يک فايل متني از نوع Text در دسکتاپ خود درست کنيد و اين کدها را داخلش
پيست كن


<?xml version="1.0" encoding="UTF-8" standalone="yes"?>

<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">

<assemblyIdentity type="win32" processorArchitecture="*" version="6.0.0.0" name="mash"/>

<description>Enter your Description Here</description>

<dependency>

<dependentAssembly>

<assemblyIdentity

type="win32"

name="Microsoft.Windows.Common-Controls" version="6.0.0.0"

language="*"

processorArchitecture="*"

publicKeyToken="6595b64144ccf1df"

/>

</dependentAssembly>

</dependency>

</assembly>


و سپس ان را با نام vb6.exe.MANIFEST ذخيره کنيد

نکته : بعد از ذخيره کردن فايل به قسمت my computer برو و از منوي Tools زير منوي Folder Option را اجرا کن و وارد زبانه View شو و در قسمت پايين علامت عبارت hide Extensions for known file types را بردار و سپس پنجره را ببند و به دسکتاپ برگرد و روي نام فايلي که ساخته بودي فقط کليک کن و عبارت .txt را از قسمت اخر نام فايل پاک کن و اينتر کنيد خوب حالا قسمت اخر کار که بايد اين فايل رو در جايي که ويژوال بيسيک را نصب کرديد يعني در Program files\Microsoft Visual Studio\VB98\ کپي کن حالا ويژوال بيسک رو اجرا کن و حالش رو ببر



پايان


جواب قسمت نظرت : اولا مچكرم دوما چرا فكر مي كني پر حرفي كردي بابا من نظراتي دارم كه
چهار ساعت طول ميكشه تا بخونمش دوما در مورد خودم چي بگم راستش
اسمن من عباس هست و 20 سالمه و اهل گرگان هستم رشته من هم اي تي
است قدر من 170 و اندي و وزن من هم 90 كيلو رنگ شوار من ابي
بيشتر كفش اسپرت مي پوشم موهاي من هم گاهي بلنده گاهي هم خيلي كوتاه
رنگ موهام سياه ديپلم الگتروتكنيك دارم تو زندگيم درس نخودم يادم نمي ياد
حتي يك با هم كتابامو خونده باشم البته كتاباي قير درسي زياد مي خونم تا دلت بخواد
در حال حاظر هم پشت كامپيوتر نشستم و دارم توي ورد جواب سوالات و نظرت
رو مي دم در حال حاظر شلوارك پامه و دارم يكي از اهنگ هاي هيچكس رو گوش
مي دم و نكته ديگه كه يادم اومد اينه كه من بيشتر پاسكال كار مي كنم تا ويژال
و نكته مهم تر اينه كه من دارم ميرم چون دارن سدام ميكنند كه چهار خونه شروع شده
..............................................................................
و يك نكته ديگه اگه مي خواهي وب لاگ يا سايت تو رو تو قسمت پيوند ها بزارم بگو




پايان



نظر سوم : سلام این وبمه :www.azitasepahi.blogfa.com , اینم آیدیمه اگه وقت کردی یه سر بزن خوشحال می شم یه سوال هم ازت دارم


جواب : سوالي نپرسيدي كه من جوابتو بدم قبل از اين كه اين پست رو اپلود كنم به وبلاگت ميام

نظر چهارم : سلام. تبادل لینک با وبلاگ .برنامه های یک برنامه نویس.
اگه خواستی تبادل لینک داشته باشیم عنوان و آدرس وبلاگت رو توی نظرات وبلاگ من بنویس. . موفق باشی


جواب : اگه مي خواهي وبلاگتو تو پيوندام بزارم فقط يك ندا بده و يك توضيحي هم در باره وب لاگت برام
بزار تا وب لاگتو تو پيوندام بزارم




نظر پنجم : سلام
اون وبلاگ گروه نرم افزار رینوسافت وبلاگ منه بوده
. لی حذفش کردم (میتوه امتحان کنی)
آدرس جدید من در وب سایت مشخص هست
لطفا تصحیح اش کن
با تشکر
راستی زودتر آپ کن
بای

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



پايان




چطور يك فرم سه بعدي بسازيم

براي اين كار يك فرم جديد ايجاد كرده و در قسمت خصوصيات ان
BorderStyle ان را رو گزينه 0 يا اول بگزاريد (بدون نوار عنوان )


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


Private Sub Form_Load()
Const cPi = 3.1415926
Dim intLineWidth As Integer
intLineWidth = 10

Dim intSaveScaleMode As Integer
intSaveScaleMode = frmForm.ScaleMode
frmForm.ScaleMode = 3
Dim intScaleWidth As Integer
Dim intScaleHeight As Integer
intScaleWidth = frmForm.ScaleWidth
intScaleHeight = frmForm.ScaleHeight


frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF
frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF

frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, intScaleHeight), &H808080, BF
frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, intScaleHeight), &H808080, BF

Dim intCircleWidth As Integer
intCircleWidth = Sqr(intLineWidth * intLineWidth + intLineWidth * intLineWidth)
frmForm.FillStyle = 0
frmForm.FillColor = QBColor(15)
frmForm.Circle (intLineWidth, intScaleHeight - intLineWidth), intCircleWidth, QBColor(15), _
-3.1415926, -3.90953745777778
frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), intCircleWidth, QBColor(15), _
-0.78539815, -1.5707963

frmForm.Line (0, intScaleHeight)-(0, 0), 0
frmForm.Line (0, 0)-(intScaleWidth - 1, 0), 0
frmForm.Line (intScaleWidth - 1, 0)-(intScaleWidth - 1, intScaleHeight - 1), 0
frmForm.Line (0, intScaleHeight - 1)-(intScaleWidth - 1, intScaleHeight - 1), 0
frmForm.ScaleMode = intSaveScaleMode
End Sub




پايان




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

خالص تر بوده و جايگزين كد قبلي كنيد

خوب براي شروع اول در خصمت خصوصيات فرم را مثل پايين تغيير دهيد

OLEDropMode = 1

خصوصيت OLEDropMod اون رو روي 1 بگزاريد


حالا كدهاي زير را قسمت كد نويسي فرمتان پيست كنيد


Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.Picture = LoadPicture(Data.Files(1))
End Sub



حالا برنامه رو اجرا كرده و يك عكس را با درگ كردن روي فرم بگزاريد



پاپان