[h=2]برنامه نمونه دفترچه یادداشت - مبتدی – معرفی برنامه[/h] خب؛ من می خواستم اول از همه یکمی با محیط وی بی 6 آشنا بشیم. بنابراین طرف دیتابیس و مفاهیم پیشرفته نرفتم. یک برنامه ساده دفترچه یادداشت طراحی می کنیم و می نویسیم. فکر میکنم هر کسی این برنامه رو بتونه بنویسه، منتها نخواستم در ابتدا بریم طرف مفاهیم پیشرفته. هدفهای کلی: - آشنایی با محیط وی بی 6 - آشنایی با کنترل های استاندارد وی بی 6 - آشنایی با کامپوننت Microsoft Common Dialog - آشنایی با مفاهیم فایل و کار با آن - طراحی یک اینترفیس کاربر پسند (user-friendly)
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال ما میخوایم یک دفترچه یادداشت کاملا ساده شبیه به NotePad ویندوز بسازیم. خب شروع میکنیم: - یک فولدر در یک جایی از هارد به اسم MyNotes0.1 می سازیم. - وی بی 6 رو باز می کنیم، از صفحه New Project که ظاهر میشه - قابل دسترسی از منوی File Standard EXE رو انتخاب میکنیم و بعد Open! - Project1 رو به mynotes تغییر نام میدیم. فرم پیش فرض رو هم از Form1 به frmNotes تغییر نام میدیم. - Caption فرم رو به MyNotes تغییر نام میدیم. - دکمه Save رو میزنیم و همه فایلهای برنامه رو توی فولدر MyNotes0.1 ذخیره میکنیم. خب! ما الان یک فرم خالی داریم که میخوایم یک چیزی شبیه به NotePad بشه! یه TextBox به فرم اضافه میکنیم با این خصوصیات: کد: Name: txtNotes Left: 0 Top: 0 Multiline: True ScrollBars: 3-Both Font: Tahoma , size: 12 , Bold خصوصیت Text رو هم که الان برابر Text1 هست، پاک میکنیم. بر روی فرم رفته و دابل کلیک میکنیم تا کد ادیتور ظاهر بشه ویا F7 رو میزنیم. ابتدا به قسمت General Declarations با تنظیم دو منوی داخل ادیتور، میریم و کلمه کلیدی و مهم Option Explicit رو تایپ می کنیم. این دستور باعث میشه که ما بعدا در هنگام اجرا خیالمون از بابت تعریف شده بودن متغییر ها راحت باشه چون در غیر این صورت خطای زمان اجرا میگیریم و یا با مقادیر اشتباهی دست و پنجه نرم می کنیم. بسیاری از باگهای یک برنامه وی بی، بخاطر تناقض و یا نبودن متغییرهای صحیح هست. همونطور که میدونیم اگر متغییری در وی بی 6 تعریف نشه، از نوع Variant در نظر گرفته میشه که این ممکن هست ایجاد مشکل کنه و اگر هم مشکلی بوجود نیاد حداقل حافظه بیشتری مصرف شده. وارد جزئیات ماجرا نمیشیم، اینکه حالا بماند!.... خب، کجا بودیم؟ Option Explicit رو تایپ میکنیم. حالا Form رو از منوی Object (اولی از چپ) در ادیتور کد انتخاب میکنیم و سپس Resize رو از منوی Procedure انتخاب میکنیم. حالا ساب (پروسیجر) Form_Resize ساخته شد. کد زیر رو داخلش تایپ می کنیم: کد: Private Sub Form_Resize() txtNotes.Width = frmNotes.ScaleWidth txtNotes.Height = frmNotes.ScaleHeight End Sub چه کار کردیم؟ این ساب که در واقع یک event (رخداد) از خوده فرم (frmNotes) هست با کوچکترین تغییر اندازه فرم صدا زده میشه. ما میخوایم که txtNotes با تغییر اندازه فرم تغییر کنه و خودش رو کیپ به کیپ اندازه فرم نگه داره. پس اونرو به همون اندازه فرم در میارم. اگر هم قبلا توجه کرده باشید Left و Top کنترل تکست باکس مون صفر هست، پس اگر پهنا و درازای اون رو مساوی با پهنا و درازای فرم قرار بدیم، کافیه. البته "frmNotes." ها در این کد اضافی هستند. چون در خود فرم کد رو مینویسیم لازم نیست برای صدا زدن خصوصیاتش از "frmNotes." استفاده کنیم. چرا از ScaleWidth, ScaleHeight بجای Width, Height استفاده کردیم؟ خب، Width و Height اندازه فرم + عنوان و گوشه های فرم رو برمیگردونه. یعنی همه جای پنجره یک فرم، ولی ScaleWidth و ScaleHeight فقط اندازه قسمت داخلی فرم (خاکستری) برمی گردونه. تکست باکس ما فقط در همون محیط میتونه باشه، پس ما هم از همون مقادیر استفاده کردیم. برنامه رو اجرا می کنیم (F5) ... خب این خیلی ساده بود، نه؟ پس تا برنامه بعد! در قسمت بعدی منو و امکانات دیگر رو بهش اضافه می کنیم. حالا تا اون موقع ابتدا سورس رو مرور می کنیم: کد: Option Explicit Private Sub Form_Resize() txtNotes.Width = ScaleWidth txtNotes.Height = ScaleHeight End Sub از منوی File گزینه Make mynotes.exe رو انتخاب می کنیم. بعد از ساخت exe برنامه رو ذخیره میکنیم. همونطور که گفتم در مباحث بعدی این برنامه رو بهینه می کنیم و امکان ذخیره و بازیابی از فایلها رو هم به برنامه اضافه می کنیم.
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال عرض کنم که، البته قرار هست در همین برنامه بعدا یک Toolbar هم بگذارم. ببینید، طول و عرض کامبوباکس ها که تغییر نمی کنه؟ مکانشون هم در بالا بصورت افقی کنار هم در فرم ثابته؟ اگر اینطور باشه. اونها رو در design mode در جای مناسب روی فرم قرار میدیم. حالا ریچ تکست میمونه که باید کلیه فضای باقی مونده رو بگیره. خب، اگر Left تکست باکس صفر باشه، می تونید پهناش رو پهنای فرم قرار بدید: کد: rich1.Width=ScaleWidth اگر تکست باکس رو در زیر سه کومبو بگذارید، بمقدار Top تا باید از ScaleHieght کم کنید که تا پایین فرم بیاد و بیرون از اون نره، اگر کم نکنید از پایین فرم بیشتر میشه: کد: rich1.Height=ScaleHieght - rich1.Top (ادیت: من اسکرین شات رو ندیده بودم.)
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال برای این اسکرین شات: کد: rich1.Height=ScaleHeight - rich1.Top - rich1.Left rich1.Width=ScaleWidth - rich1.Left * 2
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال من براي اينكه كومبوباكس ها در(( سايزهاي مختلف فرم)) ، پخش بشوند( هر چند كه شايد اگر پخش نشوند در عرض فرم ، كاري منطقي تر باشه.) از فرمول زير استفاده كردم. براي دو كامند باتم هم ديگه ننوشتم. چون فكر كنم بايد اين كارها در تولبار باشه. پس ديگر بحث نمي كنم . چون تولبار علمي تر است. و منطقي تر. ولي راجع به اين قسمت ، كاملا برام جا افتاد. Private Sub Form_Resize() Text1.Height = ScaleHeight - Text1.Top Text1.Width = ScaleWidth a = Form1.ScaleWidth Combo1.Left = 1 * (a / 10) Combo2.Left = 4 * (a / 10) Combo3.Left = 7.5 * (a / 10) End Sub.
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال حالا میخوایم برنامه MyNotes رو گسترش بدیم. ابتدا از فولدر قبلی یک کپی بگیرید و اسمش رو به MyNotes0.2 تغییر بدید. خب پروژه رو در وی بی 6 باز کنید. ما میخوایم menu به برنامه اضافه کنیم. سه تا منو اضافه می کنیم؛ از منوهای استانداری که در اکثر برنامه های ویندوز دیده میشه. File, Edit و Help فرم رو در وی بی باز می کنیم و از تولبار آیکونه Menu Editor رو انتخاب می کنیم و یا Ctrl+E همونطور که می دونیم برای هر آیتمی در یک منو یک Caption و یک Name لازم هست. من ساختار منو رو در زیر میگذارم. شما موقع ساختن منو کلمه ای رو که داخل [] گذاشتم برای Caption و دیگری رو برای Name استفاده بکنید. ... در این ساختار به معنی زیرشاخه بودن آیتم هست که در ادیتور توسط دکمه های جهت نما بوجود میان؛ و البته برای اضافه کردن آیتم جدید از دکمه Next و Insert استفاده میکنیم. کد: mnuFile [&File] … mnuNew [&New] … mnuSep1 [-] … mnuOpen [&Open…] … mnuSave [&Save…] … mnuSep2 [-] mnuExit [E&xit] mnuEdit [&Edit] … mnuCut [Cu&t] … mnuCopy [&Copy] … mnuPaste [&Paste] … mnuSep3 [-] … mnuSelAll [Select &All] mnuHelp [&Help] … mnuAbout [&About…] خب این از منو اگر اشتباهی نکرده باشیم در صورت زدن OK منوی برنامه ساخته خواهد شد. حالا موقع کد نویسی برای هر آیتم هست... روی منو رفته و New رو انتخاب کنید تا رخداد مربوطه ایجاد بشه. حالا کد زیر رو توش می نویسیم: کد: Private Sub mnuNew_Click() txtNotes.Text = "" End Sub فکر کنم به حد کافی ساده باشه. فعلا به Open و Save کاری نداریم. برای Exit هم همین کار رو می کنیم: کد: Private Sub mnuExit_Click() Unload Me End Sub حالا میرسیم به Cut و Copy و Paste و Select All: کد: Private Sub mnuCut_Click() If txtNotes.SelText <> "" Then Clipboard.Clear Clipboard.SetText txtNotes.SelText txtNotes.SelText = "" End If End Sub Private Sub mnuCopy_Click() If txtNotes.SelText <> "" Then Clipboard.Clear Clipboard.SetText txtNotes.SelText End If End Sub Private Sub mnuPaste_Click() If Clipboard.GetFormat(vbCFText) = True Then txtNotes.SelText = Clipboard.GetText(vbCFText) End If End Sub Private Sub mnuSelAll_Click() If Len(txtNotes.Text) > 0 Then txtNotes.SelStart = 0 txtNotes.SelLength = Len(txtNotes.Text) End If End Sub چه کار کردیم؟ برای Cut ما ابتدا چک کردیم که در تکست باکس چیزی انتخاب شده یا نه؟ بعد کلیپ برد رو پاک کردیم و مقدارش رو برابر متن انتخاب شده قرار دادیم. و در انتها متن انتخاب شده رو پاک کردیم. برای Copy از روش مشابهی رو استفاده کردیم بجز اینکه دیگه متن رو پاک نمی کنیم. برای Paste ابتدا چک می کنیم که آیا متنی از نوع تکست خام vbCFText در کلیپ برد ویندوز وجود داره یا نه؟ اگر بود پس ما می تونیم ازش استفاده کنیم و بجای متن انتخاب شده قرار میدیم. برای Select All ابتدا برای اینکه خطایی در زمان اجرا نبینیم از وجود داشتن متن در تکست باکس مطمئن میشیم و بعد کل متن رو انتخاب می کنیم. حالا آیتم About رو از منوی Help انتخاب می کنیم: کد: Private Sub mnuAbout_Click() MsgBox "Learning VB6 - MyNotes" & vbNewLine & "PersianTools Forum Topic: http://forum.persiantools.com/showthread.php?t=31711", vbInformation End Sub حالا فقط دو آیتم باز کردن و ذخیره کردن متن باقی موند. برای این کار به کد نویسی بیشتری احتیاج هست. ما باید فایلها رو باز و بسته کنیم... برای استفاده از هر فایلی چه برای خواندن یا نوشتن در وی بی 6، باید ابتدا فایل رو باز بکنیم. برای این کار دستور Open وجود داره. نوع های مختلفی برای باز کردن یک فایل وجود داره: Binary, Random, Input, Output, Append برای باز کردن فایلهای ASCII خام همانند متونی که ما داریم که یکی از متداول ترین پسوندهاش txt میباشد، از دستورهای Random, Input و Append استفاده می کنیم. برای باز کردن کلیه فایلها شامل کداسکی خام یا هر نوع دیگه به هر دلیلی بطور مثال exe ها، میشه از Binary استفاده کرد. ما متن اسکی خام داریم، پس از سه نوع اول استفاده میکنیم. برای اینکه یک فایل رو برای خواندن و نوشتن باز کنیم می تونیم از Random استفاده کنیم. در این صورت میتونیم رکورد هم تعریف کنیم. منتها ما در یک زمان واحد فقط یا میخوایم بخونیم یا بنویسیم پس: برای باز کردن فایل و خوندن محتویاتش در برنامه، از مد Input استفاده می کنیم. برای نوشتن داخل یک فایل از Output استفاده می کنیم. بعد از انجام کار با فایل، فایل رو با دستور Close میبندیم. برگردیم به برنامه ما یک ساب پروسیجر جدید خودمون میسازیم که اسم یک فایل رو بگیره ، محتویاتش رو بخونه و داخل تکست باکس بریزه: کد: Sub open_file(strFilename As String) On Error GoTo errs1 Dim f As Integer Dim tmp As String f = FreeFile Open strFilename For Input As #f tmp = Input(LOF(f), #f) Close #f txtNotes.Text = tmp Exit Sub errs1: MsgBox "Error: Can not open file '" & strFilename & "'.", vbExclamation Close #f End Sub چه کار کردیم؟ ابتدا برای گرفتن خطاهای احتمالی از قبیل در دسترس نبودن فایل، از On Error GoTo استفاده کردیم. یک متغییر به نام f برای نگهداری شماره فایلی که باز میکنیم گذاشتیم. با دستور FreeFile یک شماره فایل براش اختصاص دادیم. فایل رو برای خواندن باز کردیم. کلیه محتویات فایل رو در یک متغییر ریختیم. فایل رو بستیم و تکست باکس رو با متن داخل فایل پر کردیم. دستور LOF به معنی: Length of File اندازه فایل به بایت رو برمیگردونه. دستور Input – منظور تابع هست نه نوع فایل، دو ورودی داره، تعداد بایتی که باید خونده بشه و شماره فایلی که باید ازش بخونیم. ما این دو رو بهش دادیم و در برگشت کل متن داخل فایل رو در یک متغییر ریختیم. حالا میریم برای ذخیره کردن هم یک ساب بسازیم: کد: Sub save_file(strFilename As String) On Error GoTo errs1 Dim f As Integer Dim tmp As String f = FreeFile Open strFilename For Output As #f Print #f, txtNotes.Text Close #f MsgBox "File saved successful.", vbInformation Exit Sub errs1: MsgBox "Error: Can not save file '" & strFilename & "'.", vbExclamation Close #f End Sub چه کار کردیم؟ فایل رو از نوع Output برای نوشتن باز میکنیم. در لحظه باز کردن با این نوع، در صورت وجود داشتن فایل کلیه محتوای اون پاک میشه و اندازش صفر بایت خواهد شد. در صورت وجود نداشتن، یک فایل صفر بایتی ساخته خواهد شد. سپس توسط دستور # Print که دستوری مخصوص فایلها هست؛ محتوای کل تکست باکس رو داخل فایل ریختیم و در انتها؛ فایل رو بستیم. خب، حالا تقریبا همه چیز برای استفاده آمادست. ما برای انتخاب یک نام برای فایلها در برنامه به روندی احتیاج داریم. بهترین کار استفاده از Common Dialog در وی بی 6 هست که به ما این قابلیت رو میده که بتونیم یک نام برای فایلها همانند روشی که در کلیه برنامه های ویندوز دیده میشه ، انتخاب کنیم، یعنی نمایش یک دیالوگ Open یا Save و انتخاب یک فایل. برای استفاده از کامپوننت کامان دیالوگ در برنامه، به منوی Project در ویبی رفته و Components رو کلیک می کنیم از لیست Microsoft Common Dialog 6.0 رو انتخاب و تیک میزنیم و بعد OK . از روی تولبار ویبی یک کنترل CommonDialog روی فرم میگذاریم با این مشخصات: کد: Name: cdlgDialog Filter: *.txt|*.txt Flags: 6 حالا از منوی File آیتم Open رو انتخاب میکنیم: کد: Private Sub mnuOpen_Click() On Error GoTo errs1 cdlgDialog.CancelError = True cdlgDialog.ShowOpen If cdlgDialog.FileName <> "" Then open_file cdlgDialog.FileName End If errs1: End Sub ابتدا CancelError رو برابر True قرار میدیم. این کار باعث میشه که در صورتی که کاربر بر روی Cancel کلیک بکنه یک خطا رخ بده. ما این خطا رو میگیریم و می فهمیم که کاربر منصرف شده و فایلی رو انتخاب نکرده پس از ساب میریم بیرون. در صورتی که فایلی رو انتخاب کرده باشه اون فایل رو توسط ساب open_file که ساختیم باز میکنیم. برای Save از منوی File هم: کد: Private Sub mnuSave_Click() On Error GoTo errs1 cdlgDialog.CancelError = True cdlgDialog.ShowSave If cdlgDialog.FileName <> "" Then save_file cdlgDialog.FileName End If errs1: End Sub همون کار رو کردیم منتها برای نمایش دایالوگ Save از ShowSave استفاده و برای ذخیره به اسم فایلی که انتخاب میشه از save_file استفاده کردیم. خب اینم از این ورژن از برنامه. جالب بود نه؟ پس تا برنامه بعد!!! سورس ورژن جدید: کد: Option Explicit Private Sub Form_Resize() txtNotes.Width = ScaleWidth txtNotes.Height = ScaleHeight End Sub Private Sub mnuAbout_Click() MsgBox "Learning VB6 - MyNotes" & vbNewLine & "PersianTools Forum Topic: http://forum.persiantools.com/showthread.php?t=31711", vbInformation End Sub Private Sub mnuCut_Click() If txtNotes.SelText <> "" Then Clipboard.Clear Clipboard.SetText txtNotes.SelText txtNotes.SelText = "" End If End Sub Private Sub mnuCopy_Click() If txtNotes.SelText <> "" Then Clipboard.Clear Clipboard.SetText txtNotes.SelText End If End Sub Private Sub mnuOpen_Click() On Error GoTo errs1 cdlgDialog.CancelError = True cdlgDialog.ShowOpen If cdlgDialog.FileName <> "" Then open_file cdlgDialog.FileName End If errs1: End Sub Private Sub mnuSave_Click() On Error GoTo errs1 cdlgDialog.CancelError = True cdlgDialog.ShowSave If cdlgDialog.FileName <> "" Then save_file cdlgDialog.FileName End If errs1: End Sub Private Sub mnuPaste_Click() If Clipboard.GetFormat(vbCFText) = True Then txtNotes.SelText = Clipboard.GetText(vbCFText) End If End Sub Private Sub mnuSelAll_Click() If Len(txtNotes.Text) > 0 Then txtNotes.SelStart = 0 txtNotes.SelLength = Len(txtNotes.Text) End If End Sub Private Sub mnuExit_Click() Unload Me End Sub Private Sub mnuNew_Click() txtNotes.Text = "" End Sub Sub open_file(strFilename As String) On Error GoTo errs1 Dim f As Integer Dim tmp As String f = FreeFile Open strFilename For Input As #f tmp = Input(LOF(f), #f) Close #f txtNotes.Text = tmp Exit Sub errs1: MsgBox "Error: Can not open file '" & strFilename & "'.", vbExclamation Close #f End Sub Sub save_file(strFilename As String) On Error GoTo errs1 Dim f As Integer Dim tmp As String f = FreeFile Open strFilename For Output As #f Print #f, txtNotes.Text Close #f MsgBox "File saved successful.", vbInformation Exit Sub errs1: MsgBox "Error: Can not save file '" & strFilename & "'.", vbExclamation Close #f End Sub در قسمت بعدی، امکانات بیشتری به برنامه اضافه میکنیم... تا بعد! ادیت: برنامه دیباگ شد. Clipboard.SetText txtNotes.SelText صحیح است. MsgBox "Error: Can not save file صحیح است.
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال خب ما به اهداف کلی برنامه رسیدیم. از دوستان هم چندتا سوال در مورد آرایش فرم داشتیم، کمی بیشتر برنامه رو پیشرفته میکنیم. حالا میخوایم با برخی از کنترلهای Microsoft Windows Common Controls هم آشنا بشیم. یک کپی از فولدر ورژن 0.2 میگیریم به نام MyNotes0.3 و پروژه رو باز می کنیم... از منوی Project گزینه Components رو انتخاب میکنیم و از لیست: Microsoft Windows Common Controls 6.0 رو تیک میزنیم. ما میخوایم یک Toolbar به برنامه اضافه کنیم. روی فرم یک کنترل Toolbar میکشیم که خود به خود بالای فرم می چسبه. یک ImageList هم اضافه میکنیم... خصوصیات شون رو به این صورت تنظیم میکنیم: Toolbar: کد: Name: tbrStandard Allow Customize: False Style: 1- tbrFlat ImageList: کد: Name: imgList خب؛ برای دکمه های تولبار ما به چندتا آیکون احتیاج داریم که من اتچشون کردم. imgList رو انتخاب میکنیم و Custom رو از پراپرتیهاش انتخاب میکنیم. بعد به تب (صفحه) Images میریم. با استفاده از Insert Picture به ترتیب این آیکنها رو اضافه میکنیم: کد: New.ico Open.ico Save.ico Cut.ico Copy.ico Paste.ico حالا OK رو میزنیم. tbrStandard رو انتخاب و به فرم Custom میریم برای ImageList و DisabledImageList و HotImageList گزینه imgList رو انتخاب میکنیم. با این کار ما کنترل ایمیج باکسمون رو به این تولبار متصل میکنیم که آیکونهامون رو برای دکمه هاش استفاده کنیم. حالا تب Buttons رو میاریم: اولین دکمه رو با استفاده از Insert Button میسازیم: Caption: New Image: 1 دومین با استفاده از Insert Button: Caption: Open Image: 2 و سومی: Caption: Save Image: 3 حالا یک جدا کننده روی تولبار ایجاد میکنیم: اول Insert Button بعد Style: 3- tbrSeparator حالا دکمه بعدی: Caption: Cut Image: 4 و Caption: Copy Image: 5 و آخری: Caption: Paste Image: 6 خب، حالا OK رو میزنیم و تولبار ما آماده شد. کدنویسیش مونده دابل کلیک میکنیم روی تولبار تا ساب مربوطه ساخته بشه و این کد رو توش مینویسیم: کد: Private Sub tbrStandard_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Index Case 1 'new mnuNew_Click Case 2 'open mnuOpen_Click Case 3 'save mnuSave_Click Case 4 'separator 'nothing Case 5 'cut mnuCut_Click Case 6 'copy mnuCopy_Click Case 7 'paste mnuPaste_Click End Select End Sub چه کار کردیم؟ خب ما در این ساب/ایونت یک ورودی داریم به اسم Button که خصوصیات دکمه فشرده شده رو برمیگردونه. قبلا هم که کلی کد برای منوها نوشتیم؟ ما Index هر دکمه رو چک می کنیم و ساب پروسیجر منوی مناسب رو صدا میزنیم. حالا یک تغییر کوچک هم در ایونت Resize فرم لازم داریم. ما الان یک تولبار بالای فرم گذاشتیم، باید تکست باکسمون رو بیاریم پایین و از طرفی، اندازه درازاش رو هم تنظیم کنیم، ساب Form_Resize جدید اینطوری خواهد بود: کد: Private Sub Form_Resize() On Error Resume Next txtNotes.Width = ScaleWidth txtNotes.Top = tbrStandard.Height txtNotes.Height = ScaleHeight - tbrStandard.Height End Sub برای چی از on error استفاده کردیم؟ اگر نمیگذاشتیم، در موقع اجرای برنامه اگر فرم رو بیش از حد از نظر درازا کوچک میکردیم، یعنی از خود تکست باکس بالاتر ، مقدار ScaleHeight – tbrStandard.Height منفی میشد و خطا میگرفتیم. راحتترین کار اینکه این خطا رو در نظر نگیریم.
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال یواش یواش این دفترچه هم به پایان برسونیم که حکایت همچنان باقیست!شایان به نکته خوبی اشاره کرد، موقع ذخیره کردن و یا بستن برنامه باید کنترلی داشته باشیم که آیا متن تغییر کرده و اگر تغییر کرده امکان ذخیرش رو بدیم. خب مثل همیشه یک کپی از فولدر پروژه قبل میگیریم، به نام MyNotes0.4 و پروژه رو باز میکنیم. ما میخوایم بدونیم که اگر تغییری در متن بوجود اومده، حتما امکان ذخیره تغییرات قبل از خروج از برنامه باشه و گرنه ممکن هست که اطلاعات از بین بره. قبلا گفتم با بیت ماسک میشه همچین چیزی رو کنترل کرد، این مورد بسیار ساده هست، متن ما یا ذخیره شده یا ذخیره نشده و همچنین ما یا نامی برای فایل گذاشتیم یا نگذاشتیم. با ترکیب های مختلف بیت ماسک ها اینها رو کنترل میکنیم. اول یک شمارنده در قسمت جنرال میسازیم که شامل بیت ماسکهای ما هست: کد: Enum enumTextStatus NoChange = &H0 TextChanged = &H2 TextSaved = &H4 End Enum بیت ماسک اول بنام NoChange وقتی هست که ما هیچ تغییری نداریم. مثلا هنگام متن جدید یا باز کردن یک متن یا درست بعد از ذخیره متن. بیت ماسک دوم بنام TextChanged وقتی هست که کوچکترین تغییری در متن بوجود میاد. بیت ماسک سوم بنام TextSaved وقتی هست که متن ما حداقل یکبار در دیسک ذخیره شده پس حتما یک نام برای خودش داره. خب، اینها رو هم به جنرال اضافه میکنیم: کد: Dim lastFilename As String Dim TextStatus As enumTextStatus یک متغییر که اسم فایل رو نگه داره و یک متغییر که بیت ماسک ها مون رو کنترل کنیم. بیت ماسک ها رو در موقع لزوم اضافه و یا حذف میکنیم. ما می تونیم بیت ماسک ها رو با عملیات منطقی تنظیم کنیم. میتونم اونها رو or ، and و یا xor کنیم. اگر ما بخواهیم بگیم که تغییر کرده "یا" ذخیره شده: کد: TextStatus= TextChanged or TextSaved و اقسام احتمال های مختلف که در این برنامه البته خیلی کم هستند. فقط این رو بدونیم که برای اضافه کردن یک احتمال/بیت ماسک به یک متغییر اون رو or میکنیم: کد: TextStatus= TextChanged TextStatus= TextStatus OR TextSaved برای پاک کردن از یک متغییر، برای مثال اگر مقدار متغییر زیر برابر دستور بالا باشه. یعنی هم TextChanged و هم TextSaved باشه و بخواهیم TextSaved رو از متغییر پاک کنیم، یعنی مقدارش فقط TextChanged بشه: کد: TextStatus= TextStatus AND NOT(TextSaved) و موقع چک کردن وجود یک بیت ماسک در یک متغییر مثالا در شرطها، از and استفاده میکنیم: کد: If TextStatus AND TextSaved Then … یعنی اگر TextSavedی وجود داشت سپس... و یک نکته مهم این هست در تعریف بیت ماسکها باید بیت ماسک بعدی حداقل دو برابر از قبلی باشه. یعنی اگر در مبنای هگزادسیمال تعریف میکنیم: &H0, &H1, &H2, &H4, &H8, &H10, &H20,… که البته &H0 یک استثنا هستش، ولی خب چون میخواهیم and و or بکنیم، باید در انتها حداقل یک بیت تفاوت بین هر حالت باشه. خب، بر میگردیم به برنامه و استفاده عملی از بیت ماسک ها: ساب mnuNew رو به این صورت تغییر میدیم: کد: Private Sub mnuNew_Click() If TextStatus And TextChanged Then Dim res As VbMsgBoxResult res = MsgBox("Text has changed, Do you want to save changes?", vbYesNoCancel + vbExclamation) If res = vbCancel Then Exit Sub If res = vbYes Then mnuSave_Click End If TextStatus = NoChange lastFilename = "" txtNotes.Text = "" End Sub اگر تغییری در متن وجود داشته باشه، ساب mnuSave_Click رو که بعدا میگذارم، صدا میزنیم وگرنه بیت ماسک رو NoChange میکنیم و نام فایل رو هم پاک میکنیم. اینجا یک تغییر در mnuSave بوجود اومده: ما یک منوی جدید به نام mnuSaveAs و کپشن Save As میسازیم. که در واقع جای mnuSave قدیمی رو میگیره: کد: Private Sub mnuSaveAs_Click() On Error GoTo errs1 cdlgDialog.CancelError = True cdlgDialog.ShowSave If cdlgDialog.FileName <> "" Then save_file cdlgDialog.FileName End If errs1: End Sub خب، این همون mnuSave_Click قدیمی هست با نام جدید mnuSaveAs_Click. حالا کد جدیده mnuSave_Click کد: Private Sub mnuSave_Click() If TextStatus And TextSaved Then save_file lastFilename Else mnuSaveAs_Click End If End Sub اگر بیت ماسک TextSaved وجود داشته باشه. فایل ما یک نام خواهد داشت، پس فقط اونرو ذخیره میکنیم. ولی اگر بیت ماسک رو نداشته باشه، باید mnuSaveAs_Click رو صدا بزنیم تا یک نام براش بگذاریم. حالا ممکن بگید پس کجا ما این TextSaved و TextChanged رو به متغییر دادیم؟ خب: ما در رخداد Changed از تکست باکسمون میگذاریم: کد: Private Sub txtNotes_Change() TextStatus = TextStatus Or TextChanged End Sub یعنی با کوچکترین تغییر بیت ماسک TextChanged رو به متغییر اضافه میکنیم. توجه داشته باشید که ما متغییر رو برابر با بیت ماسک قرار نمیدیم بلکه به اون اضافه میکنیم چون شاید در جایی دیگه که در زیر میبینم، ما بیت ماسک دیگه ای هم در متغییر داشته باشیم. دستورات جدید رو به خطوط آخر save_file اضافه میکنیم: کد: Sub save_file(strFilename As String) On Error GoTo errs1 Dim f As Integer Dim tmp As String f = FreeFile Open strFilename For Output As #f Print #f, txtNotes.Text Close #f MsgBox "File saved successful.", vbInformation TextStatus = NoChange Or TextSaved lastFilename = strFilename Exit Sub errs1: MsgBox "Error: Can not save file '" & strFilename & "'.", vbExclamation Close #f End Sub درست بعد از مسیج باکس، میگیم که فایل ذخیره شده و همچنین دیگه تغییری وجود نداره. و اسم فایل هم در متغییر دیگه ای ذخیره می کنیم. ساب open_file: کد: Sub open_file(strFilename As String) On Error GoTo errs1 Dim f As Integer Dim tmp As String f = FreeFile Open strFilename For Input As #f tmp = Input(LOF(f), #f) Close #f txtNotes.Text = tmp TextStatus = NoChange Or TextSaved lastFilename = strFilename Exit Sub errs1: MsgBox "Error: Can not open file '" & strFilename & "'.", vbExclamation Close #f End Sub بعد از نشان دادن متن در تکست باکس، میکیم که فایل ذخیره شده (در واقع ما فایل ذخیره شده ای رو باز کردیم) و تغییری در متن وجود نداره. و اسم فایل هم ذخیره میکنیم. همونطور که قبلا دیدید، این متغییر های جدید در mnuSave_Click و mnuNew_Click هم چک و هم تغییر کردند. حالا اگر از برنامه بدون ذخیره کردن متن خارج بشیم، متن تغییر کرده از بین میره، پس: کد: Private Sub Form_Unload(Cancel As Integer) If TextStatus And TextChanged Then Dim res As VbMsgBoxResult res = MsgBox("Text has changed, Do you want to save changes?", vbYesNoCancel + vbExclamation) If res = vbCancel Then Cancel = True If res = vbYes Then mnuSave_Click End If End Sub این هم از استفاده از بیت ماسک برای کنترل تغییرات متن.
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال [h=2]برنامه نمونه مرورگر تصویر - برنامه[/h] خب، برنامه رو شروع میکنیم. ابتدا کدهای ریسایز شدن کنترلها رو می نویسیم: کد: Private Sub Form_Resize() On Error Resume Next picArea.Width = ScaleWidth - picArea.Left - VScroll1.Width VScroll1.Left = ScaleWidth - VScroll1.Width picArea.Height = ScaleHeight - picArea.Top - HScroll1.Height HScroll1.Top = ScaleHeight - HScroll1.Height VScroll1.Height = picArea.Height HScroll1.Width = picArea.Width VScroll1_Change HScroll1_Change End Sub Private Sub VScroll1_Change() On Error Resume Next Dim vl As Double vl = ((picPicture.Height - picArea.ScaleHeight) * VScroll1.Value) / VScroll1.Max picPicture.Top = -vl End Sub Private Sub HScroll1_Change() On Error Resume Next Dim vl As Double vl = ((picPicture.Width - picArea.ScaleWidth) * HScroll1.Value) / HScroll1.Max picPicture.Left = -vl End Sub چه کار کردیم؟ ما با محاسبه اندازه تصویر picPicture و تناسب بستن کاری می کنیم که با تغییر اسکرولها، تصویرمون قابل پیمایش باشه. همچنین محل قرار گیری و اندازه های کنترلها رو هم در ایونت ریسلز کنترل میکنیم. حالا برای نشون دادن فایلهای تصویری: کد: Private Sub Dir1_Change() On Error Resume Next File1 = Dir1 End Sub Private Sub Drive1_Change() On Error Resume Next Dir1 = Drive1 End Sub Private Sub File1_Click() On Error GoTo errs1 Dim tmp As String picPicture.AutoSize = True tmp = File1.Path If Right(tmp, 1) <> "\" Then tmp = tmp & "\" tmp = tmp & File1.FileName Set picPicture.Picture = LoadPicture(tmp) VScroll1.Value = 0 HScroll1.Value = 0 VScroll1_Change HScroll1_Change Exit Sub errs1: MsgBox "Can not display the picture. Error: " & Err.Description, vbExclamation End Sub اول کدی رو نوشتیم که اگر درایو و پوشه ها تغییر کردن، متناسب با اون لیست فایلها هم تغییر کنه. فیلتر/یا همون الگویی که برای اسم فایلهامون گذاشتیم *.gif;*.bmp;*.jpg هست که باعث میشه فقط فایلهای تصویری ساپورت شده لیست بشن. در ایونت File1_Click ابتدا مسیر کامل تا فایل انتخاب شده رو درست میکنیم و بعد او تصویر رو توی کنترل picPicture لود میکنیم و اسکلر بارها رو ریست میکنیم. بگذارید کد خروج و ذخیره تصویر رو هم بنویسیم: کد: Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdSave_Click() On Error GoTo errs2 Dim t$ t$ = InputBox("Type a name for file:", "Save as", "bitmap.bmp") If t$ <> "" Then Dim tmp As String tmp = File1.Path If Right(tmp, 1) <> "\" Then tmp = tmp & "\" tmp = tmp & t$ If InStrRev(LCase(tmp), ".bmp") <> Len(tmp) - 3 Then tmp = tmp & ".bmp" SavePicture picPicture.Picture, tmp File1.Refresh MsgBox tmp & " saved!", vbInformation End If Exit Sub errs2: MsgBox "Can not save picture. Error: " & Err.Description, vbExclamation End Sub فکر کنم کاملا واضح باشه، با دستور SavePicture میتونیم تصویر داخل یک پیکچرباکس رو بصورت بیت مپ ذخیره کنیم. حالا از API کمک میگیریم تا یه اسکرین شات از دسکتاپ بگیریم. برای این کار از توابع و مقادیر ثابتی API استفاده میکنیم. از منوی ویژوال بیسیک ، در start منوی ویندوز برنامه API Viewer رو اجرا و فایل WIN32API.txt رو لود کنید. در اینجا یک لیست تقریبا کامل از توابع ، نوعها و ثباتهایی وجود داره که بهشون میگیم API یا Application Programming Interface. این ثبات رو انتخاب میکنیم: SRCCOPY و بعد این توابع رو: BitBlt، GetDesktopWindow و GetDC حالا در قسمت جنرال برنامه اونهارو کپی میکنیم: کد: Option Explicit Private Const SRCCOPY = &HCC0020 Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long BitBlt تابعی برای کپی کردن بیتمپ هستش. GetDesktopWindow هندلر دسکتاپ رو برمیگردونه و با GetDC شماره دیوایس اون هندلر رو برای استفاده در تابع BitBlt بدست میاریم. حالا کد گرفتن یک اسکرین شات از دسک تاپ: کد: Private Sub cmdCapture_Click() Dim oldWS As Integer Set picPicture.Picture = Nothing picPicture.AutoRedraw = True picPicture.Width = Screen.Width picPicture.Height = Screen.Height oldWS = WindowState WindowState = 1 DoEvents Refresh Dim hDCDesktop As Long hDCDesktop = GetDC(GetDesktopWindow) BitBlt picPicture.hDC, 0, 0, Screen.Width * Screen.TwipsPerPixelX, Screen.Height * Screen.TwipsPerPixelY, hDCDesktop, 0, 0, SRCCOPY Set picPicture.Picture = picPicture.Image picPicture.AutoRedraw = False WindowState = oldWS End Sub چه کار کردیم؟ ابتدا تصویر داخل پیکچرباکس رو پاک و اونرو به اندازه کل صفحه نمایش در آوردیم. ما AutoRedraw رو True کردیم. اگر این خاصیت True باشه، پس از انداخت یک تصویر در پیکچر باکس، اون تصویر در حافظه ذخیره میشه، و اگر حتی پنجره دیگه ای روی اون تصویر بیاد، بعد از برداشتن اون بخاطر ذخیره شدنش در حافظه بازسازی خواهد شد. البته این کار حافظه اضافه از منابع سیستم میگیره و به همین خاطر، حالت پیش فرض False هست ولی چون الان با بلت کردن میخوایم تصویری رو داخل پیکچرباکس بریزیم، باید از اون استفاده کنیم. بعد موقعیت پنجره برنامه رو داخل یک متغییر ضبط میکنیم و پنجره برنامه رو مینیمایز میکنیم تا در اسکرین شات دیده نشه. با DoEvents و Refresh مطمئن میشین که قبلا از گرفت تصویر، حتما پنجره کوچیک شده باشه. حالا کار اصلی رو انجام میدیم. ابتدا hDC (هندلر دستگاه) دسکتاپ رو با برگردوندن شماره هندلر دسکتاپ به داخل تابع GetDC میگیریم و سپس با BitBlt از دستگاه منبع که دسکتاپ هست به مقصد یک بیتمپ به اندازه کل صفحه نمایشگر میگیریم. توجه داشته باشید که در API به جای تویپ از پیکسل استفاده میشه پس ما هم Screen.Width و Screen.Height رو در TiwpsPerPixelX و Y ضرب کردیم تا مقدار پیکسل رو بدست بیاریم. خب حالا یک تصویر داریم که اون رو با Set کردن به Picture در حافظه پیکچرباکس مون ذخیره میکنیم. و دیگه لازم نیست که AutoRedraw روشن باشه. در انتها هم پنجره برنامه رو به حالت اولش بر میگردونیم.
پاسخ : نمونه برنامه های VB6 -آموزش از روی مثال [h=2]برنامه نمونه دفترچه یادداشت - پیشرفته – قسمت پنچم[/h] خب، همونطور که دوستان خواستن، این برنامه رو پیشرفته ترش می کنیم، اصلا شاید اسمشم عوض کردیم گذاشتیم Bala Word 2006 ، و دادیمش مایکروسافت ازش توی ویستا استفاده کنه! توی این قسمت، ما تکست باکس معمولی رو با یه نسخه پیشرفته تر، که امکانات بیشتری داره عوض میکیم. ریچ تکست باکس یکی از کامپونتهایی وی بی 6 هست که امکانات گسترده تری از قبیل آرایش متن و تغییر خصوصیات متن رو داره. برنامه رو شروع میکنم: از فولدر برنامه قبلی یه کپی میگیریم به اسم MyNotes 0.5 ، و در وی بی 6 بازش میکنیم. حالا از منوی Project گزینه Components رو انتخاب میکنیم. حالا از لیست، Microsoft Rich Textbox Control 6.0 رو انتخاب میکنیم. خوشبختانه اکثر پراپرتی ها و ایونت های تکس باکسی که در برنامه هست با پراپرتی ها و ایونت های یک ریچ تکست باکس هم خونی دارن. پس کد ما از این بابت زیاد تغییر نمیکنه. تکست باکس قدیمی رو از روی فرم انتخاب و پاک میکنم و یک ریچ تکست باکس با همون اسم روی فرم میگذاریم. فقط مطمئن بشید که Left کنترل صفر باشه، چون توی کد تنظیمش نمیکنیم. حالا یه تولبار دیگه هم میسازیم به اسم tbrFont درست زیر tbrStandard . ولی قبل از اینکه دکمه ای روش بگذاریم: ما چندتا آیکون جدید داریم که باید به imgListمون اضافه کنیم. به ترتیب: کد: Prop.ico Bld.ico Itl.ico Undrln.ico Lft.ico Ctr.ico Rt.ico خب حالا میتونیم دکمه های جدیدمون رو اضافه کنیم، tbrFont رو انتخاب میکنیم و پراپتی Custom رو انتخاب میکنیم به تب دوم میریم و به ترتیب با دکمه Insert Button اینها رو اضافه میکنیم: کد: Index: 1 Caption: Font Image: 7 Index: 2 Style: 3 Index: 3 Caption: Bold Style: 1 Image: 8 Index: 4 Caption: Italic Style: 1 Image: 9 Index: 5 Caption: Underline Style: 1 Image: 10 Index: 6 Style: 3 Index: 7 Caption: Left Style: 2 Image: 11 Index: 8 Caption: Center Style: 2 Image: 12 Index: 9 Caption: Right Style: 2 Image: 13 خب، این قضیه Style چیه؟ با استایل 3 آشنا هستیم، این همون جدا کننده هست، ولی استایل 1 به ما این قابلیت رو میده که از دکمه بصورت یک Checkbox استفاده کنیم، یعنی دو حالت. استایل 2 به ما این قابلیت رو میده که از دکمه بصورت یک Optionbox استفاده کنیم، یعنی دو حالت برای فقط یک دکمه در آن واحد. حالا دابل کلیک میکنیم روی تولبار و این کد ها رو مینویسیم: کد: Private Sub tbrFont_ButtonClick(ByVal Button As MSComctlLib.Button) On Local Error Resume Next Select Case Button.Index Case 1 'font cdlgDialog.FontName = txtNotes.SelFontName cdlgDialog.FontSize = txtNotes.SelFontSize cdlgDialog.FontBold = txtNotes.SelBold cdlgDialog.FontItalic = txtNotes.SelItalic cdlgDialog.FontUnderline = txtNotes.SelUnderline cdlgDialog.ShowFont txtNotes.SelFontName = cdlgDialog.FontName txtNotes.SelFontSize = cdlgDialog.FontSize txtNotes.SelBold = cdlgDialog.FontBold txtNotes.SelItalic = cdlgDialog.FontItalic txtNotes.SelUnderline = cdlgDialog.FontUnderline Case 2 'separator 'nothing Case 3 'bold txtNotes.SelBold = Button.Value Case 4 'italic txtNotes.SelItalic = Button.Value Case 5 'underline txtNotes.SelUnderline = Button.Value Case 6 'separator 'nothing Case 7 'left txtNotes.SelAlignment = rtfLeft Case 8 'center txtNotes.SelAlignment = rtfCenter Case 9 'right txtNotes.SelAlignment = rtfRight End Select End Sub این کد خیلی سادست، در کیس 2 ما ابتدا خصوصیات فونت حاضر رو به کامان دیالوگ میدیم و با ShowFont امکان تغییرشون رو میدیم و بعد خصوصیات جدید رو به ریچ تکست باکس برمیگردونیم. در کیسهای 3 و 4 و 5 ، bold یا italic یا underline بودن متن انتخاب شده رو بنا به مقدار دکمه روی تولبار (true / false ) تغییر میدیم. در کیسهای 7 و 8 و 9 هم جهت متن رو تغییر میدیم. حالا برای اینکه تغییرات روی دکمه های تولبار هم انجام بشه، یعنی اگر از یک قسمتی که bold بود به یک قسمت دیگه رفتیم که نبود، و این تغییر روی تولبار هم ظاهر بشه، این کدها رو هم توی ایونت SelChange ریچ تکست باکسمون می نویسیم: کد: Private Sub txtNotes_SelChange() If txtNotes.SelBold Then tbrFont.Buttons(3).Value = tbrPressed Else tbrFont.Buttons(3).Value = tbrUnpressed End If If txtNotes.SelItalic Then tbrFont.Buttons(4).Value = tbrPressed Else tbrFont.Buttons(4).Value = tbrUnpressed End If If txtNotes.SelUnderline Then tbrFont.Buttons(5).Value = tbrPressed Else tbrFont.Buttons(5).Value = tbrUnpressed End If Select Case txtNotes.SelAlignment Case rtfLeft tbrFont.Buttons(7).Value = tbrPressed Case rtfCenter tbrFont.Buttons(8).Value = tbrPressed Case rtfRight tbrFont.Buttons(9).Value = tbrPressed End Select End Sub هر خصوصیت رو با یک شرط یا کیس بررسی میکنیم و تغییرات رو روی دکمه ها هم اعمال میکنیم. ما یک تولبار به فرم اضافه کردیم، پس محل قرار گیری ریچ تکست باکسمون هم تغییر میکنه بصورت زیر: کد: Private Sub Form_Resize() On Error Resume Next txtNotes.Width = ScaleWidth txtNotes.Top = tbrFont.Height + tbrFont.Top txtNotes.Height = ScaleHeight - tbrFont.Height - tbrFont.Top End Sub خوب، ریچ تکست باکس، فرمت خاص خودش رو برای ذخیره متن داره، تا بتونه خصوصیات متن رو هم ذخیره کنه، این فرمت اسمش هست Rich Text Format با پسوند rtf. روی cdlgDialog در فرم کلیک کنید و Filter رو به این صورت تغییر بدید: کد: *rtf (Rich Text Format)|*.rtf این کنترل توابع آماده و خاص خودش رو برای ذخیره متن داره که کار ما رو خیلی ساده میکنه، ما دو تابع ساخته بودیم که متن معمولی رو ذخیره می کرد، حالا اونها رو هم تغییر میدیم به صورت زیر: کد: Sub open_file(strFilename As String) On Error GoTo errs1 'Dim f As Integer 'Dim tmp As String ' 'f = FreeFile 'Open strFilename For Input As #f 'tmp = Input(LOF(f), #f) 'Close #f ' 'txtNotes.Text = tmp txtNotes.LoadFile strFilename TextStatus = NoChange Or TextSaved lastFilename = strFilename Exit Sub errs1: MsgBox "Error: Can not open file '" & strFilename & "'.", vbExclamation 'Close #f End Sub Sub save_file(strFilename As String) On Error GoTo errs1 'Dim f As Integer 'Dim tmp As String ' 'f = FreeFile 'Open strFilename For Output As #f 'Print #f, txtNotes.Text 'Close #f txtNotes.SaveFile strFilename MsgBox "File saved successful.", vbInformation TextStatus = NoChange Or TextSaved lastFilename = strFilename Exit Sub errs1: MsgBox "Error: Can not save file '" & strFilename & "'.", vbExclamation 'Close #f End Sub همونطور که میبینید، دو تابع آماده LoadFile و SaveFile کاری کرد که اکثر کدهای قدیمی کامنت بخورن و در حقیقت میتونیم اونها رو از کد برنامه پاک کنیم.
