This VB tutorial builds off the last and demonstrates how you can create more advanced PDF files. It teaches you how to create a multi-page document, ...
Open EmployeeWebService.svc.vb where you will find a stub method, DoWork which you will ... Click OK to add the service reference, and open Page.xaml.vb...
This
sample source code shows you exactly how to create a PDF file from
within your VB application with out having to buy a third party control
or dll. It gives an example of creating a PDF and adding text to it.
This
program converts an integer in the range of 1 through 3999 to its
equivalent in Roman numerals. It also converts a Roman numeral string
to its decimal equivalent.
Would
you like to write your own chat or IM program? This sample demonstrates
how you can use the VB6 Winsock control to build a simple client server
application.
Ever
wanted to write your own scripting language? While this source will get
you started. See how to use dynamic classes to create a runtime class
browser.
If
you want enemies to seek after your player (like ghosts after pacman)
or you want enemies to run from your player (like when pacman eats a
pill) then you must master the AI seeking and fleeing algorithms.
In
any good game we must detect when objects have collided. This turns out
to be pretty simple. See how to do both rectangular and circular
collision detection.
Creating
PDF documents in Visual Basic has always been a difficult task. Many
times people have to purchase controls to do it for them. Not with this
Visual Basic tutorial. PDF documents can be created in a snap using the
mjwPDF class. This is the first in a series of tutorials. It covers the
creation of a basic PDF document.
This
VB tutorial builds off the last and demonstrates how you can create
more advanced PDF files. It teaches you how to create a multi-page
document, with page headers, footers, page numbers, shapes, and images.
This
tutorial explains all the main vb6 string functions that allow you to
manipulate strings including the Len, Mid, Left, Right, UCase, LCase,
Instr, InstrRev, String, Space, Replace, StrReverse, LTrim, RTrim,
Trim, Asc, Chr, and the ASCII table. This Visual Basic tutorial should
meet all your needs.
Visual
Basic combo boxes are like list boxes but they allow you to have a drop
down list and/or be able to type in your own list items instead of only
selecting one of the current items. This VB6 combo box tutorial teaches
you everything you need to know to use combo boxes in your Visual Basic
application.
This
demonstrates a full working application using nothing but DAO code (no
data control) this gives you the advantage of having full control over
everything.
This
tutorial explains the basics to creating a graphical user interface
(GUI) in. It focuses in on some simple GUI elements such as MsgBox,
InputBox, and the Form.
Learn
all the different data types and objects Visual Basic has to offer. It
also explains a standard naming convention that helps keep your code
clean.
The
Visual Basic print method can be used to print information onto forms
or into picture boxes. This tutorial shows you how using a semicolon
separator.
فکر کنم اینا رو یه بار گذاشتم ولی ....
مهندسی نرم افزار۱ (جزوه) حسن علی اکبرپور---------------------------------------------------------------------- دانلود
کاربرد : کار این اکتیوایکس اینه که WebCam یا دوربین های فیلم برداری که به سیستم شما متصل شدن رو شناسایی میکنه و تصویر رو از اونها گرفته و نمایش میده و قابلیت ذخیره کردن به صورت فیلم رو هم روی سیستم داره . مورد استفاده در زمینه ( Image Processing ) یا پردازش تصویر .
» شما میتونید این اکتیوایکس رو که به صورت فایل نصبی همراه با برنامه های نمونه به زبانهای VisualBasic 6 و 6 ++Visual C و کد رجیستر اون از لینک زیر دانلود کنید .
لينك مقاله |13:47 شنبه 11 خرداد1387 - توسط ناصر نيازي
پست جديد آموزش وي بي
سلام در پي نظر دوستم در مورد كي لاگر نويسي بايد بگم كي لاگر برنامه اي كع يه جاي ويندوز مثل سيستم ترا مخفي مي شه و هر كليدي كه در صفحه كليد زديد رو ذخيره كرده و به يه جايي مثل ايميل يا اف تي پي مي فرسته كه در موردش بعدآ يه مطلب كامل مي نويسم فعلآ يه آموزش از يه وبلاگ كپي كردم كه بخونيد ادرس وبلاگ:http://www.blog.shamsoft.ir/?cat=11
-------------
سلام
تو
پست قبلي در مورد برنامه نويسي موبايل صحبت كردم و گفتم كه مي خوام كار
كنم. ولي بازم نتونستم و درگير كار ديگه اي شدم كه اگه در اون زمينه به
نتايجي برسم همينجا يه خورده در موردش مي نويسم
خب
واسه اين پست هم يه برنامه آماده كردم كه با سورس ميزارم واسه دانلود. فكر
نمي كنم برنامه نيازي به توضيح داشته باشه و همه مي دونن كه كارش چيه. ولي
با نمونه هاي مشابه فرق مي كنه و با يه ترفند كارش رو انجام ميده و سورسش
به 20 خط كد هم نميرسه
خب اين مطلبو كه قبلا هم گذاشته بودم توي وبلاگ ولي خب چون اين وبلاگ جديده ندارتش پس بد نيست كه بزارم اينجا هم
گاهي
ممكنه كه قصد داشته باشيد يه مقدار رو جايي ذخيره كنيد كه بعدا هم از اون
استفاده كنيد. خب راه هاي زيادي هست. حالا فرض كنيد كه يه برنامه دو زبانه
(فارسي و انگليسي) داريد. بار اولي كه برنامه اجرا ميشه از كاربر زبان
برنامه را سوال مي كنيد كه مثلا فارسي را انتخاب مي كند. حالا قصد داريد
كه دفعه بعد كه برنامه باز ميشه ديگه اين سوال پرسيده نشه و با زباني كه
بار اول انتخاب كرده برنامه نمايش داده بشه. خب وقتي فرم اصلي برنامه Load
مي شود بايد چك كنيد كه آيا كاربر زباني را انتخاب كرده يا نه كه اگر
انتخاب نكرده باشد فرمي باز مي شود و از كاربر مي خواهد كه زبان را انتخاب
كند. حالا اگر قبلا زبان را انتخاب كرده باشد، ديگه اين فرم نبايد باز
بشود و با زباني كه انتخاب شده اطلاعات را نمايش بدهد. اين كار فقط يك
دستور شرطي مي باشد كه به راحتي ميشه نوشتش. ولي خب ما از كجا بفهميم كه
قبلا زبان را انتخاب كرده يانه! جواب اين سوال سادست. يه جايي بايد مقدار Language را ست كنيم و مقدار Persian يا English را به آن بدهيم. حالا Language را كجا ست كنيم؟ توي ديتابيس MS Access ؟ يه فايل ؟ يا يه جاي بهتر و ساده تر …ما مقدار Language را توي رجيستري مقدار دهي مي كنيم. اما نه با استفاده از توابع API و Module هايي كه براي كار با رجيستري هست بلكه با استفاده از دو تابع SaveSetting و GetSetting …
تابع SaveSettingاين تابع وظيفه ي ذخيره كردن مقدار را دارد و به صورت زير تعريف مي شود:
SaveSetting AppName , Section , Key , Setting
حالا مثلا ما همچين دستوري رو توي VB مي نويسيم و اجرا مي كنيم:
خب حالا يه نگاهي به رجيستري بندازيم ببينيم اين مقاديري كه داديم كجاي رجيستري و به چه صورت ذخيره شده اند:
فكر مي كنم ديگه عكس گوياي همه چيز باشه و نيازي به توضيح نيست.
تابع GetSettingاين تابع وظيفه ي خواندن مقادير را بر عهده دارد و به صورت زير تعريف مي شود:
GetSetting AppName , Section , Key , [default]
كه پارامتر آخر (default)
اختياري مي باشد و اگر مقدار دهي نكنيد مشكلي ندارد. به عنوان مثال كد زير
مقداري را كه قبلا ذخيره كرده ايم را بازيابي مي كند و در يك Textbox نمايش مي دهد:
حالا اون پارامتر اختياري كه نامش default بود واسه چيه؟اگر مقداري در Key مورد نظر وجود نداشته باشد يا اصلا اين Key يا Section وجود نداشته باشد، مقدار default وارد Textbox مي شود.
لينك مقاله |18:50 پنجشنبه 22 فروردین1387 - توسط ناصر نيازي
آموزش دایرکت ایکس
سلام خدمت بينندگان عزيز اين وبلاگ
خب همونطور كه قبلآ قول داده بودم در مورد آموزش سه بعدي امروز يه برنامه رو از صفر با دايركت ايكس 8و وي بي مي سازيم تا شما با چگونگي رسم اشكال سه بعدي ساده (مكعب و استوانه و..) آشنا بشيد.
خب اول از منوي پروژه تو وي بي ريفرنس رو انتخاب كنيد در ليست باز شده تيك DirectX8 For VisoualBasic Librery رو بزنيد تا كتابخونش به پروژتون اضافه بشه .
بعد از منوي پروژه Add Module رو بزنيد تا يه انبار كد يا ماژول به پروژتون اضافه بشه از اين ماژولها برا اين استفاده مي كنن كه
اولآ متغير و يا تابعي كه داخل ماژول نوشته بشه از داخل همه ي فرمها قابل دسترسي و صدا زدنه چون متغيير هاي سطح ماژول بر خلاف فرم به صورت پيش فرض Public هستند
خب داخل ماژول يه ديتا تايپ براي ذخيره سازي اطلاعات تك تك نقطه ها تعريف مي كنيم
Private Type LITVERTEX x As Single y As Single z As Single color As Long specular As Long tu As Single tv As Single End Type
سه تا متغيير آخر كه اسمشون عجيب قريبه هميشه با صفر مقدار دهي مي شن من هم نمي دونم برا چيه ان! سه تاي اول موقعيت نقطه و بعدي رنگ بعد يه ثابت براي اعلان اين ديتا تايپ به دايركت ايكس تعريف مي كنيم اين ثابت فرمت ديتا تايپي كه تعريف كرده ايم را در خود نگه مي دارد.
Const Lit_FVF = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1) Global Const Pi = 3.14159265358979
ثابت پي هم كه براي محاسبه زاويه اي بكار مي رود –چرخش دوربين بعد يه آرايه به تعداد نقطه هايي (ورتكس هايي)كه مي خوايم رسم كنيم تعريف مي كنيم
Public cube(35) As LITVERTEX Public matworld As D3DMATRIX Public matview As D3DMATRIX Public matproj As D3DMATRIX
چون ما مي خوايم يه مكعب مربع رسم كنيم به 36 نقطه نياز داريم كه با آرايه بالا اونو تعريف مي كنيم در سه خط بعد سه تا ماتريس تعريف كرديم كه كل خصوصيات نقاط ما رو داخل خودشون نگه مي دارن كاربرد اونا اينه كه براي تابع چرخش فرستاده مي شن و كل اونا رو دايركت ايكس يه جا مي چرخونه و ديگه نياز به چرخش تك تك اونها نيست ماتريس اول چگونگي قرار گرفتن نقطه ها در فضاي سه بعدي رو نشون مي دن دومين ماتريس نشان مي دهد دور بين در كجا قرار دارد وآخرين ماتريس نشان مي دهد كه دوربين چگونه به صحنه نگاه مي كند بعد متغيير هاي سراسري سطح ماژول رو كد نويسي مي كنيم توجه كنيد تمام كدهاي بالا واين كدها داخل ماژول نوشته مي شن
Public Dx As DirectX8 Public D3D As Direct3D8 Public D3DDevice As Direct3DDevice8 Public DispMode As D3DDISPLAYMODE Public InitG As Boolean Public D3Dwindow As D3DPRESENT_PARAMETERS Public D3DX As D3DX8 Public VBuffer As Direct3DVertexBuffer8
دي ايكس بزرگترين كلاس دايركت ايكس است كه كلاس هاي دايركت ايكس را مديريت مي كند. كلاس دي تري دي براي ايجاد ابزار سه بعدي سازي استفاده مي شه. كلاس D3dDevice براي مديريت ابزار ساخته شده و اجزاي آن استفاده مي شه. كلاس DispMode براي گرفتن موقعيت و خصوصيات كنوني صفحه نمايش شما بكار مي رود. متغير InitG براي گرفتن مقدار برگشتي تابع InitialiseGeometry كه بعدآ تعريف خواهد شد بكار مي رود. كلاس D3Dwindow مستقيمآ با پنجره نمايش ما كار مي كند وبراي تظيم خصوصيات آن از اين كلاس استفاده مي شود. كلاس D3DX براي ايجاد يك بافت و بارگزاري فايل دات ايكس كه فايل حاوي مختصاي نقاط ومشخصات يك شي سه بعدي مي باشد(فايل هاي خروجي 3DSMAX با يك برنامه به اين نوع فايل تبديل مي شوند و داخل دايركت ايكس باز مي شوند)بكار مي رود مثلآ اگر بخواهيد روي يك ديوار يك عكس بيندازيد بايد با اين كلاس آن را بارگذاري كنيد وبا كلاس D3DMaterial8 آن را به ديوار بيندازيد. صرفآ در اين پروژه نيازي به اين كلاس نيست و من اون رو همينجوري تعريف كردم!. كلاس vBuffer براي ايجاد بافر نگه دارنده كل نقاط و تصوير سه بعدي ما استفاده مي شود حالا شروع به نوشتن تابع initialise مي كنيم اين تابع در اكثر پروژه هاي سه بعدي هست و وظيفه اش بارگزاري و مقداردهي اوليه كلاسها و متغيير هاست .
Public Function initialise() As Boolean Set Dx = New DirectX8 '— ايجاد دوباره كلاس دي ايكس Set D3D = Dx.Direct3DCreate '— ايجاد كلاس دي تري دي از كلاس دي ايكس '-- D3DDEVTYPE_REF= رسم نرم افزاري , D3DDEVTYPE_HAL= رسم سخت افزاري '--ممكن است كارت گرافيك شما آن برد باشد كه بايد از هال استفاده كنيد If D3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _ DispMode.Format, D3DUSAGE_DEPTHSTENCIL, D3DRTYPE_SURFACE, D3DFMT_D16) = D3D_OK Then D3Dwindow.AutoDepthStencilFormat = D3DFMT_D16 '16 bit Z-Buffer Debug.Print "yes"
End If '— بررسي اينكه آيا سخت افزار ما قادر به رسم نقاط سه بعدي هست يا نه
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode '— گرفتن خصوصيات كنوني تصوير و ريختن آن در ديتاتايپ ديسپ مود D3Dwindow.Windowed = 1 '— 1 يعني برنامه ما بصورت پنجره ايجاد شود –2=تمام صفحه D3Dwindow.BackBufferFormat = DispMode.Format '— خصوصيات صفحه را كه گرفته ايم به دايركت ايكس مي دهيم '— وبافرنگهدارنده تصوير رابا آن تنظيم مي كنيم D3Dwindow.SwapEffect = D3DSWAPEFFECT_DISCARD D3Dwindow.BackBufferCount = 1 D3Dwindow.BackBufferFormat = DispMode.Format D3Dwindow.BackBufferHeight = DispMode.Height D3Dwindow.BackBufferWidth = DispMode.Width D3Dwindow.hDeviceWindow = Form1.hWnd
'—D3D ايجاد ابزار سه بعدي سازي با مشخصات مقداردهي شده ي بالا از كلاس Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, _ Form1.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3Dwindow) '— مشخص كردن پنجره رسم تصاوير در خط بالا '— پاك كردن ابزار سه بعدي سازي با رنگ سياه (پارامتر آخر خط پايين) D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &H0, 1#, 0 '— دادن ماتريس تعريف شده به دايركت ايكس D3DXMatrixIdentity matworld D3DDevice.SetTransform D3DTS_WORLD, matworld '— تنظيم ماتريس بعدي تعريف شده براي استفاده در چرخش تصوير D3DXMatrixLookAtLH matview, MakeV(0, 5, 9), MakeV(0, 0, 0), MakeV(0, 1, 0) '— تنظيم نماي ديد اوليه به كمك تابع ميك وي كه بعدآ تعريف خواهد شد D3DDevice.SetTransform D3DTS_VIEW, matview '— دادن ماتريس سوم به دايركت ايكس براي تنظيم نماي ديد D3DXMatrixPerspectiveFovLH matproj, Pi / 4, 1, 0.1, 500 '— تنظيم نماي پرسپكتيو با استفاده از عدد پي D3DDevice.SetTransform D3DTS_PROJECTION, matproj '— تنظيم نوع انتقال و جابجايي در محيط سه بعدي D3DDevice.SetVertexShader Lit_FVF '— تنظيم سيستم سايه زني با ديتا تايپي كه تعريف كرده ايم D3DDevice.SetRenderState D3DRS_LIGHTING, False '— سيستم نور پردازي را براي محاسبات راحت تر وساده تر غير فعال مي كنيم InitG = InitialiseGeometry '— تابع بالا را براي مقدار دهي نقطه ها صدا مي زنيم اگر نتيجه '-- اين تابع نادرست باشد مقداردهي انجام نشده است Set VBuffer = D3DDevice.CreateVertexBuffer(Len(cube(0)) * 36, 0, Lit_FVF, D3DPOOL_DEFAULT) '— ايجاد بافر با طول آرايه اي كه تعريف كرده ايم D3DVertexBuffer8SetData VBuffer, 0, Len(cube(0)) * 36, 0, cube(0) '— ريختن آرايه درون بافر If initGt = True Then Initialize = True '— درصورتي كه مقدار برگشتي تابع اي كه صدا زديم درست باشد خروجي اين تابع هم درست است Debug.Print InitG End Function
خب خسته نباشيد حالا دو تابعي كه در بالا صدا زديم و گفتيم بعدآ تعريف مي كنيم را مي نويسيم تابع MakV براي تبديل پامتر هاي عددي به ساختار D3DVECTOR كه ديتا تايپ استاندارد دايركت ايكس است
Private Function MakeV(x As Single, y As Single, z As Single) As D3DVECTOR MakeV.x = x MakeV.y = y MakeV.z = z End Function
بعدي تابع رسم مقدار دهي نقطه ها در فضاي سه بعدي است يعني تابع InitialiseGeometry
Private Function InitialiseGeometry() As Boolean On Error GoTo BOut: Dim color&, DFC! '— تنظيم رنگ نقاط در اينجا رنگ آبي color = RGB(200, 100, 0): DFC = 1
'Front cube(0) = CreateLitVertex(-1, 1, DFC, color, 0, 0, 0) cube(1) = CreateLitVertex(1, 1, DFC, color, 0, 0, 0) cube(2) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0) cube(4) = CreateLitVertex(-1, -1, DFC, color, 0, 0, 0) cube(5) = CreateLitVertex(1, -1, DFC, color, 0, 0, 0) 'Back cube(6) = CreateLitVertex(-1, 1, -DFC, color, 0, 0, 0) cube(7) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0) cube(8) = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0) cube(9) = CreateLitVertex(1, 1, -DFC, color, 0, 0, 0) cube(10) = CreateLitVertex(-1, -1, -DFC, color, 0, 0, 0) cube(11) = CreateLitVertex(1, -1, -DFC, color, 0, 0, 0) 'Right cube(12) = CreateLitVertex(-DFC, 1, -1, color, 0, 0, 0) cube(13) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0) cube(14) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0) cube(15) = CreateLitVertex(-DFC, 1, 1, color, 0, 0, 0) cube(16) = CreateLitVertex(-DFC, -1, -1, color, 0, 0, 0) cube(17) = CreateLitVertex(-DFC, -1, 1, color, 0, 0, 0) 'Left cube(18) = CreateLitVertex(DFC, 1, -1, color, 0, 0, 0) cube(20) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0) cube(21) = CreateLitVertex(DFC, 1, 1, color, 0, 0, 0) cube(22) = CreateLitVertex(DFC, -1, -1, color, 0, 0, 0) cube(23) = CreateLitVertex(DFC, -1, 1, color, 0, 0, 0) 'Top cube(24) = CreateLitVertex(-1, DFC, 1, color, 0, 0, 0) cube(25) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0) cube(26) = CreateLitVertex(-1, DFC, -1, color, 0, 0, 0) cube(27) = CreateLitVertex(1, DFC, 1, color, 0, 0, 0) cube(29) = CreateLitVertex(1, DFC, -1, color, 0, 0, 0) 'Bottom cube(30) = CreateLitVertex(-1, -DFC, 1, color, 0, 0, 0) cube(31) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0) cube(32) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0) cube(33) = CreateLitVertex(1, -DFC, 1, color, 0, 0, 0) cube(34) = CreateLitVertex(-1, -DFC, -1, color, 0, 0, 0) cube(35) = CreateLitVertex(1, -DFC, -1, color, 0, 0, 0) InitialiseGeometry = True Exit Function BOut: InitialiseGeometry = False End Function تابعي كه داخل اين تابع صدا زده شده تابع CreateLitVertex هست كه مشخصات نقطه رو به فرمت استاندارد LITVERTEX تبديل مي كنه .متن اين تابع: Private Function CreateLitVertex(x As Single, y As Single, z As Single, color As Long, specular As Long, tu As Single, tv As Single) As LITVERTEX CreateLitVertex.x = x CreateLitVertex.y = y CreateLitVertex.z = z CreateLitVertex.color = color CreateLitVertex.specular = specular CreateLitVertex.tu = tu CreateLitVertex.tv = tv End Function و تابع اصلي رسم نقاط در فضاي سه بعدي كه در تمامي پروژه هاي سه بعدي اسم اون Render هست. Public Sub Render() '— پاك كردن تصوير قبلي رسم شده با رنگ سياه D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0 '— شروع رسم تصوير سه بعدي D3DDevice.BeginScene '— دادن بافر حاوي نقطه هاي سه بعدي به تابع رسم كننده D3DDevice.SetStreamSource 0, VBuffer, Len(cube(0)) '— رسم نقاط به صورت مثلثي '-- D3DPT_LINELIST رسم خطي '-- D3DPT_LINESTRIP رسم خط چسبيده '-- D3DPT_POINTLIST رسم نقطه اي '-- D3DPT_TRIANGLEFAN رسم مثلثي '--D3DPT_TRIANGLELIST رسم مثلث چسبيده '-- D3DPT_TRIANGLESTRIP رسم درهم بافته D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12 '— پايان رسم تصوير سه بعدي D3DDevice.EndScene '-- تثبيت نقاطه رسم شده D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0 End Sub
خب كد نويسي بخش ماژول تموم شد حالا فرم رو بازكنيد و خط اول كد هاش متغيير زير رو تعريف كنيد
Dim Er As Boolean
بعد در كد Form_KeyDown كد زير را به اينصورت بنويسيد كه كل دستو به اين شكل مي باشد
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Er = True End Sub
با اين دستور وقتي كاربر كليدي را يزند ير نامه تمام مي شود حالا كد مربوط به فرم لود كه بايد توابعي را كه در ماژول تعريف كرديم را داخل يك حلقه بي پايان صدا بزنيم .روي فرم دابل كليك كرده كد زير را بنويسيد
Private Sub Form_Load() Debug.Print "Start" Me.Show Dim RotateAngle As Single'— براي ذخيره ميزان چرخش Dim matTemp As D3DMATRIX '//To hold temporary Call initialise'— صدا زدن تابع براي مقدار دهي اوليه نقاط وايجاد وتنظيم پارامترها While Er = False'— شروع حلقه بي پايان RotateAngle = RotateAngle + 0.1'— يك درجه به چرخش اضافه كن If RotateAngle >= 360 Then RotateAngle = RotateAngle – 360'— اگر يك دور كامل شد برگرد D3DXMatrixIdentity matworld '//Reset our world matrix— تنظيم ماتريس نقاط با چرخش D3DXMatrixIdentity matTemp'— تنظيم محل دوربين با چرخش D3DXMatrixRotationX matTemp, RotateAngle * (Pi / 180)'— گردش افقي دوربين D3DXMatrixMultiply matworld, matworld, matTemp '— دادن سه ماترس مزكور به دايركت ايكس D3DXMatrixIdentity matTemp D3DXMatrixRotationZ matTemp, RotateAngle * (Pi / 180)'— گردش عمقي دوربين D3DXMatrixMultiply matworld, matworld, matTemp'— دادن سه ماترس مزكور به دايركت ايكس D3DDevice.SetTransform D3DTS_WORLD, matworld'— تنظيم محل ديد دوربين Render'— صدا زدن تابع اصلي رسم DoEvents'— همه دستورات را دوباره بررسي كن (داخل حلقه هنك نكن!!) Wend'— پايان حلقه بي پايان End'— بستن برنامه End Sub
دستور End رو داخل Form_Unload هم مي نويسيم كه برنامه بازدن دكمه كلوز خطا نده
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
خب چيزي نموند كه توضيح نداده باشيم براي اينكه برنامه شما رو كامل كرده باشم اگه جايي اشتباه تايپي باشه يا غيره كد كامل برنامه رو هم گزاشتم كه مي تونيد از داخل گوني زير برش داريد.! كدماژول
كد فرم
لينك مقاله |18:0 یکشنبه 26 اسفند1386 - توسط ناصر نيازي
دليل تاخير-مقاله
سلام
اولین چیز سورس پلیره که بعد از این همه وقت گزاشتمش رو وب اوایل ۲۰۰۷ نوشتمش
اون سایته که می گفتم با پی اچ پی تمومش کزدم پی اچ پی با آژاکس چی می شه !! به همتون توصیه می کنم براش هم نمی خاد هاست بگیرید یه آکانت توی Paresehgig.comدر ست كنيد همين
يه تالار ديگه هم بصورت آزمايشي اضافه كردم
فعلآ در گير برنامه يه بانكم .پروژه نمايندگي شركت خودروسازي رو هم گرفتم كه مونده برا بعد عيد
روبوكاپ هم فعلآ تعطيل شده و اينكه يه فرمت تصويري ساختم كه حجم فايلاش نصف تري جي پي هست 100مگ در 15 مگ!!!!! به زودي سرو صداش رو از رسانه ها خاهيد شنيد.
هنوز وقت ثبتش رو پيدا نكردم.
واينكه به زودي كارهام رو با دايركت ايكس و اوپن جي ال رو مي زارم رو وب.
و در انتخابات هم كارشناس رايانه ام
با اين همه كار طبيعيه اين همه تاخير ولي بازم از همه خوانندگان گل اين وبلاگ كه مثل هميشه شرمنده كردن معزرت مي خوام
آقا هادي هم هر وقت آمادگي داشتي وعشقت كشيد بگو تا به عنوان يك نويسنده به وبلاگ اضافت كنم
مقاله1 : آموزش کامل Ftp با تمام ریزه کاریها مقاله2 : ساخت یک پورت اسکنر به زبان Php (نویسنده: شهریار جلایری) پیوند3 :اسکنر Php ساخته شده
Numbers
Standard Port Numbers
مقاله تغیر سطح دسترسی یا همون change permision
سلام اینم مقاله تغیر سطح دسترسی یا همون change permision (برای نصب جوملا یا phpbb یا ...) منبع www.7rah.com
cloning
mac address cloning
BLOG-Hacking
BLOG-Hacking آموزش وبلاگ داری و هک آن
آموزش نصب ipb
آموزش نصب ipb و فارسی کردن آن
نام مقاله : مباحثی پیرامون سرریز در پشته نویسنده : شهریار جلایری «30 صفحه است و مقاله بی نظیریه»
این هم مقاله ایی خوب در زمینه معرفی کتاب های هک شبکه و برنامه نوسی برای هکر های مبتدی.
نام کتاب : اکسپلویتینگ و سوکت نویسی با Php نویسنده : شهریار جلایری
این فایل رو هم ضمیمه می کنم که شک شما بر طرف بشه
لينك مقاله |20:18 چهارشنبه 22 اسفند1386 - توسط ناصر نيازي
New Post
سلام بر همه دوستان که سربه حوایی و بدقولی پیاپی من رو تحمل می کنن خجالت می کشم که اینقدر دیر آپ می کنم
از نظرات که مثل همیشه شرمندم کردن ممنونم
در مورد کار با سه بعدی و سوال امیر حسین عزیز من کتاب dev.irكه تو وبلاگ هست رو پيشنهاد مي كنم برا دايركت ايكس. اموزش ماهم با دايركت ايكس هست
يه ماژول ايجاد كنيد .روي پروژه راست كليك كنيد پروپرتيز برنيد و استارتاپ پروژه رو روي مين ساب
بزارين
حالا كد هاي زير رو براي اجاد صحنه داخل ماژول كپي كنيد
طريقه اجراشدنشم تو پست قبلي گفتم
Sub Main() F = 0.1 Dim Done As Boolean Dim frm As Form Done = False Set frm = New Form1 If Not CreateGLWindow(frm, 1024, 768, 16) Then Done = True
Do While Done = False If (DrawGLScene = False) Then Unload frm Else SwapBuffers (frm.hDC)
DoEvents End If Done = frm.Visible = False Loop Set frm = Nothing End End Sub Public Function CreateGLWindow(frm As Form, Width As Integer, Height As Integer, Bits As Integer) As Boolean Dim PixelFormat As GLuint Dim PFD As PIXELFORMATDESCRIPTOR
PixelFormat = ChoosePixelFormat(frm.hDC, PFD) 'X If PixelFormat = 0 Then KillGLWindow MsgBox "Can't set the:", 16 CreateGLWindow = False End If
If SetPixelFormat(frm.hDC, PixelFormat, PFD) = 0 Then KillGLWindow MsgBox "" 'X CreateGLWindow = False End If
Hrc = wglCreateContext(frm.hDC)
If Hrc = 0 Then KillGLWindow MsgBox "Can't rendering Context:", vbExclamation, "ERROR"
CreateGLWindow = False End If
If wglMakeCurrent(frm.hDC, Hrc) = 0 Then KillGLWindow MsgBox "Can't Active rendering Context:", vbExclamation, "ERROR" CreateGLWindow = False End If frm.Show CreateGLWindow = True
End Function Public Sub KillGLWindow() 'X
If Hrc Then If wglMakeCurrent(0, 0) = 0 Then MsgBox "Rilase DC and RC Failed.", vbInformation, "ShutDownError" 'X End If If wglDeleteContext(Hrc) = 0 Then MsgBox "Failed", vbInformation, "ERROR" 'X End If Hrc = 0 End If
End Sub
اين هم تابع اصلي ترسيم صحنه كه من براشروع يه مكعب رو توش گزاشتم
Public Function DrawGLScene() As Boolean glPolygonMode faceFrontAndBack, pgmFILL ' Here's Where We Do All The Drawing glClear clrColorBufferBit Or clrDepthBufferBit ' Clear Screen And Depth Buffer glLoadIdentity ' Reset The Current Matrix glTranslatef 0#, 0#, 0# ' Move Into The Screen 5 Units glRotatef Xrot, 1#, 0#, 0# ' Rotate On The X Axis glRotatef Yrot, 0#, 1#, 0# ' Rotate On The Y Axis glRotatef Zrot, 0#, 0#, 1# ' Rotate On The Z Axis
glBegin GL_QUADS ' Front Face glNormal3f 0, 0, 0.5 glTexCoord2f 0#, 0#: glVertex3f -0.5, -0.5, 0.5 ' Bottom Left Of The Texture and Quad glTexCoord2f 0.5, 0: glVertex3f 0.5, -0.5, 0.5 ' Bottom Right Of The Texture and Quad glTexCoord2f 0.5, 0.5: glVertex3f 0.5, 0.5, 0.5 ' Top Right Of The Texture and Quad glTexCoord2f 0, 0.5: glVertex3f -0.5, 0.5, 0.5 ' Top Left Of The Texture and Quad ' Back Face glNormal3f 0, 0, -0.5 glTexCoord2f 0.5, 0#: glVertex3f -0.5, -0.5, -0.5 ' Bottom Right Of The Texture and Quad glTexCoord2f 0.5, 0.5: glVertex3f -0.5, 0.5, -0.5 ' Top Right Of The Texture and Quad glTexCoord2f 0#, 0.5: glVertex3f 0.5, 0.5, -0.5 ' Top Left Of The Texture and Quad glTexCoord2f 0#, 0#: glVertex3f 0.5, -0.5, -0.5 ' Bottom Left Of The Texture and Quad ' Top Face glNormal3f 0, 0.5, 0 glTexCoord2f 0#, 0.5: glVertex3f -0.5, 0.5, -0.5 ' Top Left Of The Texture and Quad glTexCoord2f 0#, 0#: glVertex3f -0.5, 0.5, 0.5 ' Bottom Left Of The Texture and Quad glTexCoord2f 0.5, 0#: glVertex3f 0.5, 0.5, 0.5 ' Bottom Right Of The Texture and Quad glTexCoord2f 0.5, 0.5: glVertex3f 0.5, 0.5, -0.5 ' Top Right Of The Texture and Quad ' Bottom Face glNormal3f 0, -0.5, 0 glTexCoord2f 0.5, 0.5: glVertex3f -0.5, -0.5, -0.5 ' Top Right Of The Texture and Quad glTexCoord2f 0#, 0.5: glVertex3f 0.5, -0.5, -0.5 ' Top Left Of The Texture and Quad glTexCoord2f 0#, 0#: glVertex3f 0.5, -0.5, 0.5 ' Bottom Left Of The Texture and Quad glTexCoord2f 0.5, 0#: glVertex3f -0.5, -0.5, 0.5 ' Bottom Right Of The Texture and Quad ' Right face glNormal3f 0.5, 0, 0 glTexCoord2f 0.5, 0#: glVertex3f 0.5, -0.5, -0.5 ' Bottom Right Of The Texture and Quad glTexCoord2f 0.5, 0.5: glVertex3f 0.5, 0.5, -0.5 ' Top Right Of The Texture and Quad glTexCoord2f 0#, 0.5: glVertex3f 0.5, 0.5, 0.5 ' Top Left Of The Texture and Quad glTexCoord2f 0#, 0#: glVertex3f 0.5, -0.5, 0.5 ' Bottom Left Of The Texture and Quad ' Left Face glNormal3f -0.5, 0, 0 glTexCoord2f 0#, 0#: glVertex3f -0.5, -0.5, -0.5 ' Bottom Left Of The Texture and Quad glTexCoord2f 0.5, 0#: glVertex3f -0.5, -0.5, 0.5 ' Bottom Right Of The Texture and Quad glTexCoord2f 0.5, 0.5: glVertex3f -0.5, 0.5, 0.5 ' Top Right Of The Texture and Quad glTexCoord2f 0#, 0.5: glVertex3f -0.5, 0.5, -0.5 ' Top Left Of The Texture and Quad glEnd
كدها خانا و همگي با توضيح هستند فكر كنم براي شرو كافي باشه
امتحان رياضي رو خراب كردم دعا كنيد
براي ديدن سورس هاي سه بعدي براي امير حسين در دايكت ايكس وجي ال وارد اكانت ها پرشين گيگم بشين پست قبلي يه فايل هست كه نحوه استفادش رو گفتم اونو دانلود نكنيد برنامه بالا اجرا نمي شه
لينك مقاله |23:54 پنجشنبه 11 بهمن1386 - توسط ناصر نيازي
شروع سه بعدی سازی با وی بی به کمک جی ال و دایرکت ایکس
ببخشید دیر پست می کنم قراره اگه خدا بخاد یه سری آموزش برنامه نویسی سه بعدی با وی بی بزارم برای شروع این فایل را دانلود کنید
لينك مقاله |0:39 چهارشنبه 3 بهمن1386 - توسط ناصر نيازي
جواب عسل خانمopenGL
سلام
در مورد کنترل سی پی یو و برنامه های باز عسل خانم سوال کرده بودن که یه فایل شامل سه برنامه آپ کردم که لیست برنامه های باز رو می ده و بااستفاده از آپی اونهارو می بنده مخفی می کنه و...
سلام امروز جواب سوال و برنامه محمد حسین عزیز رو آوردم
فقط اینکه من برنامه رو هفته پیش نوشته بودم فقط وقت نشد برا آپلواد
ببخشید دیر دیر پست می کنم کسی هم نمی خاد انگار اینجا مطلب بنویسه و مارو کمک کنه
سوال
سلام و خسته نباشي به شما مي گم چون مي دونم براي ما کم نزاشتي . از پاسخ دادن به سوالات هم ممنونم. امروز سوالاتي داشتم که اگه زحمتي نيست لطف کنيد مثل هميشه ما را شرمنده خودتون کنيد اما سوال .چطوري ميشه تمام تايمرهاي يه فرم رو فعال يا غير فعال کرد .من ميخوام يه برنامه بنويسم که در حين اجرا متن رو در داخل تکست باکس ها ذخيره کنه و يه قسمت جستجو بذارم تا بين اون فايل ها جستجو کنه و اون فايل مورد نظر رو برام پيدا کنه. مثل يه دفترچه تلفن که (در حين اجرا) چند تا اسامي راو با مشخصاتشون ذخيره مي کنه و دکمه دومي باشه که وقي يکي از اون اسامي رو دادم مشخصاتش رو بياره(البته قسمت ذخيره رو بلدم ام اگه بذاري هم رفقاي ديگه استفاده مي کنن) ا وقتي فرم لود شد عمل پرينت اسکرين(عکس انداختن از ويندوز) رو در هر دقيقه انجام بده و خودش برامون در مسير معيني ذخيره کنه(اگه به صورت مخفي ذخيره بشه که عالي ميشه). کامپيتر بارگذاري مجدد يا خاموش بشه. در هر بار روشن شدن ويندوز برنامه اجرا شه. ديده نشه برنامه مورد نظر در task bar برنامه رو نشه خارج کرد. اگه به سوالات بنده که شايد سوالات بساري از دوستان هم باشه جواب بدبد ممنونم اگه هم نخواستس جواب بدي يا به هر دليل ديگه که مي دونم باحالتر از اين حرفا هستي بازم ازت ممنونم . وبلاگت یه کوچولو دیر به روز میشه. ضمناوبلاکتم منو کشته برنامه نویس......
سلام خسته نباشی بازم اومدم برای بازدید وسوال چطوری می تونیم فقط قسمتی از فرم (قسمت وسط-بالا یا پائین) رو رنگ کنم (بدون وجود ابزار مثل برچسب یا ...) ممنون خدا حافظ
از نظرات ستایش عزیز سحر خانوم آقا میلاد استاد مومنی و دکتر محمدی بسیار ممنون
برنامه آقا فروتن هم در حال آماده سازی نهایی است (فرمت فایل مکس و موتور بازی با اوپن جي ال) از همه ممنون
برنامه محمد حسین
لينك مقاله |14:23 جمعه 27 مهر1386 - توسط ناصر نيازي
وی بی
سلام به برو بچه هاي گل برنامه نويس كم كم سرم داره خلوت مي شه برا مقاله نوشتن راستي تو اين ماه مرداد من انقدر پست كردم كه نگو!! يه سري كليك كن تا ببيني لينكا رم دوباره شمردم 510هزار تا شده برا آقايي كه مي گفت من دروغ مي گم كتابام نيم مليون شده تازه تك اينجا نيست كه وبلاگ ديگرم هست سرويس انگليسي هست ديشب يه كامت خوندم بس عجيب از يه نفر به اسم سامورايي!!!به اين مظمون
"سلام بر مدير پر ادعاي اين وبلاگ مسخره !تو فكر كردي خيلي واردي با مطالب مسخره و بيريختت!!اگه خيلي ادعات مي شه يه برنامه بزار كه مثل فتوشاپ رنگ كل تصوير رو تغيير بده .مثل زدن رنگ سبز يا قرمز به كل تصوير.اگه عرضه شو نداشتي خودم ميام جوابشو مي گم"
اول اينكه ما و ادعا!!من يه بچيه دهات خودم ترك (ده بار تو وبلاگ اينا رو گفتم) آخه بي انصاف ما كي ادعامون شده .ولي در مورد سوال اگه واقعآ گير اين سوال بودي مي تونستي طور معمولي مطرح كني با ور كن جوابتو مي گفتم !!!و اما برنامه دو تا تصوير به فرم اضافه كنيد-با يه دكمه .مثل هميشه Autoredrawپيكچرها رو فعال كنيد . اسم پيكچر ها به ترتيبpictTargetPicture-pictSourcePictureبزاريد يه عكس داخل PicsourcePictureبندازيد فرمتش فرق نمي كنه در كد كليك دكمه اين كد رو بنويسيد
در اين دستور ما رنگي كه قرار به تصوير زده بشه رنگ فرم انتخاب كرديم شما مي تونيد براش كد نويسي كنيد كه اصلآ كاربر رنگ تصوير و خود تصوير ور انتخاب كنه خب يه ما ژول به پروژه اضافه كنيد كداي زير رو داخلش كپي كنيد.اميدوارم دوستمون(سامورايي!!)جوابشو گرفته باشه
ادامه مطلب هم کتب امروز هستش
لينك مقاله |9:56 جمعه 9 شهریور1386 - توسط ناصر نيازي
جواب سوال
سلام و عرض خسته نباشيد به آقا ناصر گل. دستت درد نكنه كه اينقدر زحمت مي كشي . يه سوال داشتم چطوري ميشه تو وي بي يه برنامه نوشت كه كار رنگ كردن را انجام بده مثل سطل رنگ تو PAINT يعني FILL COLOR با سپاس مهرداد از اصفهان
با تشکر از مهرداد عزیز من این سوال رو قبلآ جواب دادم هم در کتابم هست هم در سایت ولی یک بار دیگر می گویم
راستي اين رو هم بگم در جواب اون دوست عزيزم كه پرسيده بودند چطور ميشه يه خط بسته رو داخل نقشي رنگ كرد
معادل كاري كه سطل در نقاشي ويندوز و فتوشاپ انجام مي ده بگم يه تابع هست در داخل كتابخانهGDI32كه قبلآ
هم كل توابع اش رو روي سايت گزاشتم هست كه براي همين كار هست .اين تابع اين طور تعريف مي شه
Private Declare Function ExtFloodFill Lib "Gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
قبل از استفاده رنگي را كه مي خواهيد به آن نقطه بخصوص از عكس بزنيد را در داخل خاصيت
FreColorمربوط به عكس قرار دهيد وسپس اينگونه از تابع استفاده كنيد
(Call ExtFloodFill (Picture1.hdc, X, Y, Picture1.Point(X, Y), 1
راستی یه مقاله توپ توی سایت دیگر ما به اسم شاه برنامه نوشتم حتمآ بخونید
لينك مقاله |11:38 شنبه 25 فروردین1386 - توسط ناصر نيازي
عوض کردن عکس دکمه استارت
سلام
تا حالا زده بسرتون خودتون يه دكمه برا منوي استارت درست كنيد.مثلآ هر موقع برنامه ي شما
اجرا مي شه دكمه استارت تغيير شكل بده !!نميشه؟بشين اينجا جايي نرو تابگم چجوري ميشه
يه كادر عكس به فرم اضافه كنيد ويه عكس توش بندازيد.بعد يه تايمر به فرم اضافه كنيد
خاصيتIntervalتايمر رو روي1 بزاريد بعد توابع زير رو در خط اول كد فرم بنويسيد
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source Dim dsktp As Long, St As Long
در ويداد فرم لواد كد زير روبنويسيد
Dim Wind As Long 'Temporary hwnd holder'--Finding the SystemTray Window (hwnd) Wind = FindWindow("Shell_TrayWnd", "") '--Finding the Start Button Window (hwnd) Wind = FindWindowEx(Wind, 0, "Button", vbNullString) St = GetDC(Wind) 'Getting Start Button DC dsktp = GetDC(Picture1.hwnd) Timer1.Enabled = True
بقيه اش رو وللش !!شوخي كردم بابا كجا مي ري!! در رويداد تايمر كنترل تايمر كد زير رو بنويسيد
اين نظر كه يادت نمي ره.ايولا گل پسر !!زود باش دير ميشه ها
لينك مقاله |11:31 شنبه 25 فروردین1386 - توسط ناصر نيازي
گرافیک بسیار زیبا
سلام
بعد از يه مدت معرفي كتاب وقت كردم دوباره يه مقاله بنويسيم
اين برنامه كه امروز مي خام شرح اش بدم باز هم از كلاس گرافيك هست ولي بسيار كار بردي و زيباست
يه پروژه ايجاد كنيد بايه picture بوكس و يه ماژول .مثل هميشه خاصيت AutoRedraw كادر عكس وفرم رو true كنيد و كداي زير رو داخل ماژول كپي كنيد
Public Declare Function AlphaBlending Lib "msimg32.dll" Alias "AlphaBlend" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal BF As Long) As Long
Public Declare Function DrawTransparent Lib "msimg32.dll" Alias "TransparentBlt" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long
Public Function LongToUShort(ULong As Long) As Integer
LongToUShort = CInt(ULong - &H10000)
End Function
خب حالا يه عكس داخل كادر عكس بندازيد و چارتا كامند (دكمه) به فرم اضافه كنيد و انارو دوتا دوتا كنار هم بچينيد يعني دوتاش اينور فرم باشه دوتاش اونور فرم ترجيحآ پايين فرم بزاريد كه جلوي ديد رو نگيره.يه دونه ديگه كامند پايين فرم وسط ايجاد كنيد كه براش كد پاك كردن صفحه رو بنويسيم( Me.Cls ).حالا كد هاي خط اول فرم (جنرال General )رو با هم مي نويسيم
Private Type TRIVERTEX
x As Long
y As Long
Red As Integer
Green As Integer
Blue As Integer
Alpha As Integer
End Type
Private Type GRADIENT_RECT
UpperLeft As Long
LowerRight As Long
End Type
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Const GRADIENT_FILL_RECT_H As Long = &H0
Const GRADIENT_FILL_RECT_V As Long = &H1
Const GRADIENT_FILL_TRIANGLE As Long = &H2
Const GRADIENT_FILL_OP_FLAG As Long = &HFF
Private Type GRADIENT_TRIANGLE
Vertex1 As Long
Vertex2 As Long
Vertex3 As Long
End Type
Private Declare Function GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function GradientFillTri Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Function AlphaBlend(ByVal destHDC As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal destWidth As Long, ByVal destHeight As Long, ByVal srcHDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal AlphaSource As Long) As Long
Private Function TransparentBlt(ByVal destHDC As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal destWidth As Long, ByVal destHeight As Long, ByVal srcHDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal TransparentColor As Long) As Long
من مي تونستم خيلي راحت با روشي كه قبلآ گفتم طيف رنگ مي زدم كه خيلي كد ساده تري داشت براي اين از اين كد استفاده كردم تا شكل استفاده از اين اي پي آي رو ياد بگيريد.
كد دكمه بعدي :ايجاد طرح رنگارنگ طيف در طيف بسيار زيبا.كد دكمه
لينك مقاله |15:10 چهارشنبه 22 فروردین1386 - توسط ناصر نيازي
ساخت یک اکتیو ایکس
سلام مي خوام امروز با هم يه يوزر كنترل بسازيم يه ActiveX
اكتيوايكس چيه:اكتيوايكس يه سري شيئي هستند كه كاربرايي كه خلاق وبا استعداد هستند و به كنترل هاي خود وي بي قانع نيستند مي سازند
مثلآ كنترل كامند باتون رو يه نفر از يه سري عكس و ليبل ساخته.اگه پست من درباره كلاس رو خونده باشيد امروز كارتون يه خورده راحت تر مي شه
براي اينكه يه دفه وارد ساخت بك كنترل تمام اكتيو ايكس نشويم و گام به گام پيش بريم اول يه اكتيوايكس ساده مي سازيم
يه پروژه خالي ايجاد كنيد.از منوي پروژه گزينهAdd User Controlرو بزنيد و در كادر باز شده اوكي رو بزنيد
صفحه كه باز شده شبيه به يه فرم بدون منو هست.اونو كوچيك كنيد كه اندازه يه ليست بوكس بشه بعد يه كامند داخلش بزارين .اسم يوزر كنترل رو به اسم
دلخواهتون تغيير بدين تا در استفاده نام اون كنترل بشه مثلآ اسم Commandاسم مناسبيه
در قسمت كد يوزر كنترل كد هاي زير رو بنويسيد
Option Explicit
'----------تعريف رويداد-----------------
Public Event Click()'x
Public Event Move(Button As Integer,Shift As Integer,X as Single,Y As Single)'x
'--------اگر رويدادي به صورت محلي(Private)تعريف بشه توليد خطا مي كنه
Dim X1!,Y1!,Can As Boolean
'--------تعريف خاصيت(Property)براي فهم دقيق مراجعه شود به پست كلاس چيست
Public Property Let Width1(Value As Integer)'x
'-------Let يعني تعيين كردن اين خاصيت براي تعيين عرض از سوي كاربر مي باشد
If Value >100 then Command1.Width=Value
End Property
Public Property Get Width1() As Integer
'به شكل تعريف اين دو متتد از يك خاصيت توجه كنيد---Getبراي فرستادن مقدار عرض موجود به درخواست كاربر مي باشد
Width1=Command1.Width
End Property
اين خاصيت ها فعلآ در كد نويسي قابل دسترسي مي باشد نمايش آن در پنجره خصوصيات را بعدآ مي گم
Private Sub Command1_MouseDown(Button%,Shift%,X!,Y!)'x
X1=X:Y1=Y:can=True
End Sub
Private Sub Command1_Click()'x
'-------صدا زدن رويدادي كه ايجاد كرديم-------
RaiseEvent Click() 'x
End Sub
Private Sub Command1_MouseMove(Button%,Shift%,X!,Y!)'x
If can=true then call Command1.move((command1.Left+X)-X1,(Command1.Top+Y)-Y1)'x
'-------صدا زدن رويدادي كه ايجاد كرديم-------
RaiseEvent Move(Button,shift,X,Y) 'x
End sub
Private Sub Command1_MouseUp(Button%,Shift%,X!,Y!)'x
Can=False
End sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)'x UserControl.BackColor = Ambient.BackColor '-----Ambientيعني فرمي كه يوزر كنترل روي آن طراحي شده است Command1.BackColor = Ambient.BackColor End Sub
حالا تمام پنجره هاي مر بوط به يوزر كنترل راببنديد.فرم را باز كرده آيكوني كه در انتهاي ليست ابزار مشاهده مي كنيد يوزر كنترل طراحي شده ي شماست
حالا يك عدد از آن را روي فرم درج كنيد و به اندازه ي نصف فرم بزرگش كنيد.
در رويداد moveمريوط به يوزر كنترل كه بالا آن را تعريف كريم كد زير را بنويسيد
Me.Caption = UserControl1.Width1 UserControl1.Width1 = X + 100
حالا اگر تمام مراحل را درست انجام داده با شيد باتكان دادن ماوس روي دكمه سايز آن تغيير مي كند ومي توانيد با كشيدن و رها كردن موقعيتش را تغيير دهيد
براي بهتر شدن اين پروژه بايد روي آن كار كنيد .نظر بدين سوال بپرسين وباي
لينك مقاله |10:47 سه شنبه 7 فروردین1386 - توسط ناصر نيازي
خب ببينم امروز چي داريم يه برنامه براي ايجاد افكت روي عكس يعني وقتي يه عكس داره تبديل مي شه به عكس دومي به شكل
زيبايي محو بشه.خب براي هر چيز قشنگي بايد زحمت كشيد
پس با جديت شروع كنيد تو كادر عكسPictureبه فرم اضافه كنيد سپس
خاصيتAutoReDrawعكس اوليه روTrueودوميه رو Falseكنيد تا تصوير بعد از طراحي باقي بمونه
ويك دكمه كه بايد بازدن اون افكت اجرا بشه.يه ماژول اضافه كنيد و كد زير رو براش بنويسيد
دو تا عكس به سليقه خودتون داخل كادر عكس ها بندازيد سعي كنيد هم اندازه باشند
در خط اول كد هاي فرم كد هاي زير رو بنويسيد
Option Explicit Dim hBrush As Variant Dim PixelSetSequence(64) As Integer Dim DissolveStep As Long Const NumberOfSteps = 8'-------------------------------------- Private Function CreateDissolveBrush(DissolveStep As Long) As Long Dim hCompBitmap As Long Dim BrushBitmapInfo As BITMAPINFO Dim Counter As Integer Dim PixelData As String * 32 Dim Dummy As Long Dim Row As Integer Dim Column As Integer With BrushBitmapInfo.bmiHeader .biSize = 40 .biWidth = 8 .biHeight = 8 .biPlanes = 1 .biBitCount = 1 .biCompression = 0 .biSizeImage = 0 .biXPelsPerMeter = 0 .biYPelsPerMeter = 0 .biClrUsed = 0 .biClrImportant = 0 End With ' Set the color table values for ' the brush to black and white. With BrushBitmapInfo.bmiColors(0) .rgbBlue = 0 .rgbGreen = 0 .rgbRed = 0 .rgbReserved = 0 End With With BrushBitmapInfo.bmiColors(1) .rgbBlue = 255 .rgbGreen = 255 .rgbRed = 255 .rgbReserved = 0 End With ' Initialize brush bitmap pixel data to all white. For Counter = 0 To 7 Mid$(PixelData, Counter * 4 + 1, 1) = Chr$(&HFF) Next Counter ' Set the bits representing the black pixels to 0. For Counter = 1 To DissolveStep * (64 / NumberOfSteps) Row = (PixelSetSequence(Counter) - 1) \ 8 Column = (PixelSetSequence(Counter) - 1) Mod 8 Mid$(PixelData, Row * 4 + 1, 1) = Chr$(Asc(Mid$(PixelData, Row * 4 + 1, 1)) And (Not (2 ^ Column))) Next Counter ' Convert the DIB into a DDB and create the pattern brush. hCompBitmap = CreateDIBitmap(Disolve1.hDC, BrushBitmapInfo.bmiHeader, CBM_INIT, PixelData, BrushBitmapInfo, DIB_RGB_COLORS) CreateDissolveBrush = CreatePatternBrush(hCompBitmap) Dummy = DeleteObject(hCompBitmap) End Function'------------------------------------------------ Private Sub Picture2_Paint() Dim hRgn As Long Dim Dummy As Long Dim hOldBrush As Long hBrush = CreateDissolveBrush(DissolveStep) hOldBrush = SelectObject(Picture2.hDC, hBrush) Dummy = BitBlt(Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hDC, 0, 0, &HAC0744) 'Dummy = StretchBlt%(Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, &HAC0744) Dummy = SelectObject(Picture2.hDC, hOldBrush) Dummy = DeleteObject(hBrush) End Sub'----------------------------------- Private Sub CreatePixelSetSequence() Dim Counter As Integer Dim PixelNumberString As String * 5 Const PixelListFile = 1 Open App.Path & "\PixelLst.TXT" For Input As #PixelListFile For Counter = 1 To 64 Input #PixelListFile, PixelNumberString PixelSetSequence(Counter) = Val(PixelNumberString) Next Counter End Sub'------------------------
حالا يه تايمر به فرم اضافه كنيد و خاصيتIntervalآن را به56وEnabledآن را به Falseتغيير دهيد
وبه ترتيب براي دكمه ها كد هاي زير را بنويسيد
رويداد كليك دكمه
Command1.Enabled = False Timer1.Enabled = True
رويداد لواد فرم
CreatePixelSetSequence DissolveStep = 0
رويداد كليك عكس دومي
If DissolveStep < NumberOfSteps Then DissolveStep = DissolveStep + 1 Picture2_Paint End If
روداد تايمر كنترل تايمر
If DissolveStep < NumberOfSteps Then DissolveStep = DissolveStep + 1 Picture2_Paint Else Timer1.Enabled = False End If End Sub
راستي اين رو هم بگم در جواب اون دوست عزيزم كه پرسيده بودند چطور ميشه يه خط بسته رو داخل نقشي رنگ كرد
معادل كاري كه سطل در نقاشي ويندوز و فتوشاپ انجام مي ده بگم يه تابع هست در داخل كتابخانهGDI32كه قبلآ
هم كل توابع اش رو روي سايت گزاشتم هست كه براي همين كار هست .اين تابع اين طور تعريف مي شه
Private Declare Function ExtFloodFill Lib "Gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
قبل از استفاده رنگي را كه مي خواهيد به آن نقطه بخصوص از عكس بزنيد را در داخل خاصيت
FreColorمربوط به عكس قرار دهيد وسپس اينگونه از تابع استفاده كنيد
Call ExtFloodFill (Picture1.hdc, X, Y, Picture1.Point(X, Y), 1)
ضمن اينكه هيچ وقت در نام گزاري متغيير ها از كلمهRemاستفاده نكنيد چون كلمات
بعد از اين كلمه سبز غيرو فعال مي شن. ضمن اينكه روي هر تابع كليك كنيد وShift+F2بزنيد
به محل اون تابع مي ريد.باي
به نظر ندادنتون عادت كردم
لينك مقاله |15:44 دوشنبه 6 فروردین1386 - توسط ناصر نيازي
توابع ومجموعه ها در وي بي
پست امروز در موردتوابع ومجموعه ها در وي بي هست
در مورد توابع چيزي كه يادم رفته بود بگم اين بود كه مي شه در يك تابع آرگومان اختياري تعريف كرد
يعني كاربر اگه دلش خواست اونو بفرسته يا نفرسته مثال
Private Function Zarb(A%,B%,Optional C%)as integer
در تابع بالا آرگومان سوم اختياري هست يعني كاربر مي تونه اونه مقداردهي بكنه يا نكنه
sum= Zarb(12,13):sum=Zarb(a:=14,B:=44,C:=0
)
تمام صدا زدن هاي بالا درست هست
اما مجموعه ها .اگه يادتون باشه توي پاسكال چيزي داشتيم به اسم مجموعه
در وي بي هم مي شه مجموعه تعريف كرد ولي اكثرآ از ثابت به جاي اون استفاده مي شه
مجموعه تشكيل شده از تعدادي ثابتوبا كلمه ي كليدي Enumتعريف مي شه مثال
Public Enum Rang
Zard=1
Abi=2
Sabz=3
end Enum
در مجموعه ي بالا مجموعه رنگ تعريف شد
شكل استفاده چنين است
me.caption=Zard
اگر عضو بعدي مجموعه از عضو قبلي زياد تفاوت داشت بايد آنرا داخل براكت گزاشت مثال
[
sabz]=#FF456
[
abi]=rgb(0,0,255)
[
zard]=qbcolor(4)
توجه كنيد گزاشتن كل تعريف داخل براكت خطاي كامپايلري خواهد داشت
[
abi=#fe1212]'-Creat Error
نظر يادت نره -در ضمن بگيد درمورد چي بنويسم تا بنويسم!!!باي
لينك مقاله |10:31 جمعه 3 فروردین1386 - توسط ناصر نيازي
تبریک
مقاله ی من در زمینه فرمت فایل ای وی آی و منتخبی از کل مقاله هایم
لينك مقاله |15:31 جمعه 11 اسفند1385 - توسط ناصر نيازي
AVIفرمت فايل
سلام
واقعا كسي كنكور سراسري كامپيوتر قبول نشده!!توي پست قبل كه خاسته بودم حداقل رتبه كشوري
براي قبول شدن رو كسي چيزي ننوشته بود.خواهش مي كنم من به اين اطلاعات براي برنامه ريزي احتياج دارم
پست امروز مربوط به فرمت فايل اي وي آي هست
در ضمن شايد تا مدت نا معلومي نتونم پست كنم
زياد طولش نمي دم كه وبلاگ پر بشه دو تا كلاس و يه ما ژول به پروژه اضافه كنيد واين گوني هارو توش كپي كنيد
يه ليست كه بايد توش رو پر كنيد از آدرس فايل هاي تصويري و يه دكمه براي شروع ذخيره سازي
كد كلاس ها
كد ماژول
كد دكمه ذخيره سازي:توجه-فقط فرمت هاي بي ام پي وجي پگ رو مي تونيد ذخيره كنيد ضمن اين كه يك كادر عكس مخفي هم به فرم اضافه كنيد
Private sub Command1_Click() Dim i%, R% Call ConvertSize(2, Picture1) With Picture1 R = list1.ListCount - 1 For i = 0 To R .Picture = LoadPicture(list1.List(i)) Call .PaintPicture(.Picture, 0, 0, .Width, .Height): Set .Picture = .Image .Refresh: Call SavePicture(.Picture, App.Path + "\Temp\pic" + Str(i) + ".bmp") Me.Caption = "Converting..." + Mid((Str((i * 10) / Val(R / 10))), 2, 5) + " %" DoEvents Next End With list1.Clear For i = 0 To R list1.AddItem (App.Path + "\Temp\pic" + Str(i) + ".bmp") Next Call make_avi(list1) end sub
اگه درست تايپ نكردم ببخشيد نظر كه يادتون نمي ره
لينك مقاله |11:25 چهارشنبه 9 اسفند1385 - توسط ناصر نيازي
فهمیدن خاصیت بدون تایمر
سلام حتمآ با پست قبلي جيگرتون آتيش گرفت.حق دارين از نظراتون معلومه
تو اين پست برنامه اي ميسازيم كه با جابه جا كردنش موقعيتش روي تيتر برنامه نوشته بشه
اين برنامه بدون هيچ تايمري كار مي كنه و معقيت فرم رو ميگه
يه پروژه خالي(به قول تركا كالاه)ايجاد كنيد ويه ماژول و يه فرم بهش اضافه كنيد
كد مربوط به ماژول
'API Types
Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
'API declarations Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long, ByVal dwnewlong As Long) As Long Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As RECT) As Long Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim OldhWndProc As Long
Private Function OnMove(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As RECT) As Long 'Handle the OnMove event If uMsg = WM_MOVING Then 'The form is moving!! Form1.Caption = "Left: " & lParam.Left & " ,Top: " & lParam.Top 'Insert your code HERE End If 'Call the old WindowProc OnMove = CallWindowProc(OldhWndProc, hWnd, uMsg, wParam, lParam) End Function
Public Sub InstallOnMovingEvent(frm As Form) 'Install the new WindowProc - SubClassing OldhWndProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf OnMove) End Sub
Public Sub RemoveOnMovingEvent(frm As Form) 'Restore the original WindowProc SetWindowLong frm.hWnd, GWL_WNDPROC, OldhWndProc End Sub
روي فرم دابل كليك كنيد هر چي نوشته پاك كنيد اينارو بنويسيد
Private Sub Form_Load() InstallOnMovingEvent Me End Sub
Private Sub Form_Unload(Cancel As Integer) RemoveOnMovingEvent Me End Sub
حالا برنامه رو اجرا بدين تكونش بدين و صفا كنيد
من تو هرپست باد بگم نظر بدين.خوب نظر بدين ديگه
لينك مقاله |17:30 سه شنبه 8 اسفند1385 - توسط ناصر نيازي
انتباق عکس بر روی هم
سلام حالتون خوبه با روزگار چطورين به كامه يا نه.روحتون كه چروك نشده اگه چروك شده حتمآ اتوش كنين!!.خوب امروز يه برنامه گرافيكي كوتاه فوق العاده براتون آماده كردم.با اين برنامه مي تونين دو تا تصوير رو روي هم بندازيد و حركت بدين البته تصاويرتون بايدJPGباشه و زياد بزرگ نباشه.دستورات زير رو در قسمت عمومي فرم بنويسيدGeneral
Dim Image1 As IPictureDisp Dim Image2 As IPictureDisp
Private Type Location X As Integer Y As Integer End Type
Dim Image1Move As Integer
Dim Image2MoveX As Integer Dim Image2MoveY As Integer
Dim Image1Local As Location Dim Image2Local As Location
Const Operation = vbSrcAnd
دو تا عكس رو در مسير برنامه كپي كنيد كه فرمت شون جي پگ باشه اسمشون هم1و2باشه به ترتيب ببخشيد اين ضعف در جمله بندي مال ترك بودنمه طبيعيه كه شما هم نتونيد به خوبيه من تركي حرف بزنيد كد زير ماله Form_Loadهست
("Set Image1 = LoadPicture(App.Path & "\Image1.jpg ("Set Image2 = LoadPicture(App.Path & "\Image2.jpg With me .Show Refresh. .AutoRedraw = True .ScaleMode = vbPixels End With
If .X < -me.ScaleWidth Then .X = 0 If .Y < -me.ScaleHeight Then .Y = 0
If .X + me.ScaleWidth > me.ScaleWidth Then .X = -me.ScaleWidth If .Y + me.ScaleHeight > me.ScaleHeight Then .Y = -me.ScaleWidth End With
DoEvents Loop
خب حالا حالتون چطوره!! براي اينكه دستورات بالا داخل يه حلقه بي پايان قرار مي گيره بايد در رويداد كليك فرم بنويسيدEnd فرم رو زياد بزگ نكنيد سعي كنيد تصوير ها هم اندازه باشه وفرم هم اندازه تصوير ها براي اينكه در حركت عكس ها تنوع ايجاد كنيم در رويدادMouseMoveفرم دستور زير رو بنويسيد
اين فتواي نظر ندادن مكروه رو كه شنيدي بجنب نظر بده يالا
لينك مقاله |0:14 شنبه 5 اسفند1385 - توسط ناصر نيازي
سوالات کنکور وی بی 85
همونطور كه قبلآ هم قول داده بودم امروزبراتون سوالات كنكور كامپيوتر سال85 رو آماده كردم
اين سوالات در مقطع كارداني پيوسته سراسري است كه دوم مرداد سال گذشته برگزار شد
از اونجايي كه خود سازمان سنجش اين سوالات رو اينترنتي منتشر نمي كنه پيدا كردنش سخته
علاوه بر اينكه نوشتن فارسي انگليسي سوالات پدرم رو به صورت كامل درآورد مرور خاطره هاي تلخ گذشته نوعي سردرد
عجيب در من ايجاد مي كرد ولي چه كنم كه شايد اگه پارسال منابع بيشتري داشتم الان اين مطالب رو نمي نموشتم وشايد در
موردمخ زني ودختر بازي مي نوشتم ولي يكي بايد اين كار را مي كردم تابقيه (دهاتيا) به سر نوشتم دچار نشوند .مال 84 رو هم دارم اگه خواستين بگين
اگر نمي توانيد بخوانيد از حالت تمام صفحه استفاده كنيد!! بگذريم راستي اين نظر ندادنتون منو كشته
لينك مقاله |0:29 پنجشنبه 3 اسفند1385 - توسط ناصر نيازي
وی بی بازم وی بی
سلام از اونجايي كه تصميم گرفتم پست هام رو با هم بفرستم تا بلكه شما نظر بدين بهش امروز هم دو سه تا پست دارم يك-مخفي كردن منوي استارت از سري آموزش هاي قبلي احتياج داريد كه اينگونه تعريف مي شودuser32.dllبراي مخفي كردن منوي استارت به يك تابع از كتابخانه
Option Explicit
Dim hwnd1 As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _ ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _ ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
ديديد كه تابع درازيه حالا بايددو تا دكمه براي مخفي و آشكار كردن منوي استارت به فرم اضافه كنيد كد مخفي كردن استارت
خوب صفا كردين-حالا يه نظر بدن تا بعديشو بگم دو-چطور مي شه آيكون يك برنامه رو از كالبدش كشيد بيرون وبه صورت فايل آيكون ذخيره كرد اين آموزش از سري آموزشي كتابخانه قدرتمند شل هست كه قبلآ هم يكي دو تا شو گفتم يك ماژول به پروژه (اوه كيبردم عجب گردو خاكي گرفته!!) اضافه كنيدوكد زير را داخلش كپي كنيد
Public Const MAX_PATH = 260 Public Const SHGFI_DISPLAYNAME = &H200 Public Const SHGFI_EXETYPE = &H2000 Public Const SHGFI_SYSICONINDEX = &H4000 ' System icon index Public Const SHGFI_LARGEICON = &H0 ' Large icon Public Const SHGFI_SMALLICON = &H1 ' Small icon Public Const ILD_TRANSPARENT = &H1 ' Display transparent Public Const SHGFI_SHELLICONSIZE = &H4 Public Const SHGFI_TYPENAME = &H400 Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _ Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Public Type SHFILEINFO hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * MAX_PATH szTypeName As String * 80 End Type
Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _ (ByVal pszPath As String, _ ByVal dwFileAttributes As Long, _ psfi As SHFILEINFO, _ ByVal cbSizeFileInfo As Long, _ ByVal uFlags As Long) As Long
Public Declare Function ImageList_Draw Lib "comctl32.dll" _ (ByVal himl&, ByVal i&, ByVal hDCDest& _ ,ByVal x&, ByVal y&, ByVal flags&) As Long
Public shinfo As SHFILEINFO '--------------------------
يه دكمه به برنامه اضافه كنيدImageحالا يك تكست بكس وبادوتا آدرس فايل اجرايي را داخل تكست بكس بنويسيدودر كد كليك دكمه كد زير را بنويسيد
Dim hImgSmall As Long Dim FileName As String Dim r As Long
FileName$ = Text1.Text
hImgSmall& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
hImgLarge& = SHGetFileInfo(FileName$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
نه خداييش بازم نظر نمي دين حالا اينو داشته باشين سه-چطور مي شه دكمه بستن پنجره در گوشه فرم رو غير فعال كرد شايد غير فعال كرد دكمه هاي تمام صفحه و كمينه رو بلد باشين ولي ديگه فرم خاصيت غير فعال كردن دكمه كلوز رو نداره مگه كنترل بوكس فرم رو برداريم يا اصلآ فرم رو از نوع بدون منوي بالا وتيتر انتخاب كنيم ولي با اين كد مي تونين با داشتن تمام كنترل ها فقط دكمه كلوز رو غير فعال كنين تابع زير رو تعريف كنيد
Public Const SC_CLOSE = &HF060 Public Const MF_BYCOMMAND = &H0 Public Declare Function GetSystemMenu Lib "user32" _ (ByVal hwnd As Long, ByVal bRevert As Long) As Long Public Declare Function DeleteMenu Lib "user32" _ (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Sub DisableXbutton(ByVal frmHwnd As Long) Dim hMenu As Long hMenu = GetSystemMenu(frmHwnd, 0&) If hMenu Then Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND) DrawMenuBar (frmHwnd) End If End Sub
بنويسيدForm_Loadحالا كد زير رو داخل
DisableXbutton (Me.hwnd)
ببينم بازم نظر نمي دين
لينك مقاله |0:18 چهارشنبه 2 اسفند1385 - توسط ناصر نيازي
غیر فعال کردن كنترل آلت دليت
امروز مي خوام يه تابع بنويسم كه ديگه وجدانتون بهتون اجازه نده بخونيدو نظر ندين
رو غير فعال كنهCRTL_ALT_Deletاين تابع كه مي گم مي تونه كليد هاي
البته حتمآ بايد سريع به حالت قبل برگردونيد چون موندن اين حالت زياد جالب نيست
طريقه فراخواني
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _ (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97
DesabledوEnabledحالا دو تا كامند به فرم اضافه كنيد به اسم هاي كد دكمه غير فعال كرد ن
Private Sub Disabled_Click()
Dim Ret As Long Dim pOld As Boolean Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
End Sub
نيز فراخواني كنيدUnloadكد فعال سازي اين كليد ها بهتر است اين كد هار در فرم
Private Sub EnableD_Click()
Dim Ret As Long Dim pOld As Boolean Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
End Sub
راستي اين كد رو هم توي پروژه ديگه تست كنيد-تارخ فارسي
با اين تابع مي تونيد آيكون هاي روي دسكتاپ رو مخفي و دوباره ظاهر كنيد
اول فراخواني توابع
Option Explicit Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
بعد سه تا كامند براي ظاهر كردن آيكون ها مخفي كردن آنها و خروج از فرم بنويسيد
كد هر كدام اينطور است
Private Sub cmdDHide_Click() Dim hWnd As Long hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString) ShowWindow hWnd, 0 End Sub'-------------------------------- Private Sub cmdDShow_Click() Dim hWnd As Long hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString) ShowWindow hWnd, 5 End Sub'--------------------------------- Private Sub cmdExit_Click() Me.Hide End End Sub'-------------------------------------
خدايش نظرنداده نرو
لينك مقاله |9:33 سه شنبه 24 بهمن1385 - توسط ناصر نيازي
کلاس ها در وی بی
اول سلام بخش نظرات رو زير هر بخش گذاشتم .مي دونم پرستيج وبلاگو به هم ميزنه ولي چه كنم كه براي عده اي (شما نه!)نظر دادن خيلي سخت به نظر مي ياد
كلاس چيست
كلاس ييك مجموعه اي از كدهاست كه شبيه به يك كنترل هستند فقط شكل ظاهري و طراحي ندارند
كلاس ها شي هستند - يعني خاصيت دارند -كلاس ها مي توانند داخل خود پردازه يا تابع محلي وسراسري داشته باشند
كلاس به چه دردي مي خورد-كلاسها از تكرار كدها جلو گيري مي كنند -كلاس ها خوانايي برنامه را افزايش مي دهندوغيره
كلاس ها مي توانند به صورت خودكار خود را مقدار دهي كنند-يك ماژول كلاس ايجاد كنيد وكدهاي زير را در آن كپي كنيد
-لذت زندگي به پولهايي نيست كه داريم به پولهايي كه خرج مي كنيم
لينك مقاله |10:39 یکشنبه 22 بهمن1385 - توسط ناصر نيازي
درخواست
لينك مقاله |21:8 شنبه 21 بهمن1385 - توسط ناصر نيازي
فایل در وی بی
سلام براي خيلي از ماها كه با وي بي 6 برنامه نويسي مي كنيم
با برنامه ي خود وي بي فايل هاي نصب رو درست مي كنيم
شايد اين(Package & Deployment Wizard) Microsoft Instalshildمساله باشه كه بخوايم برنامه نصب پيش رفته تري بسازيم يك راه استفاده از ست كه توي پك ويژوال شش وجود داره .
ولي اگه بخوايم يه برنامه منحصر به فرد درست كنيم چي براي اين كار مي تونيم از خود وي بي كمك بگيريم
.پلات فرم و طراحي اش به عهده خودتون من فقط ابزارش رو بهتون معرفي مي كنم
.شايد به دردتون خورد
اين تابع دايركتوري سيستم32 ي ويندوز رو برمي گردونه
Private Declare Function GetSystemDirectory Lib "kernel32" _ Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _ ByVal nSize As Long) As Long
اين تابع براي ايجاد فولدر (پوشه)استفاده مي شه
MkDir(FoldeName)
اين تابع براي حذف يك فولدر به كار ميره
RMDir(FolderName)
انتقال يك فابل از يك جا به جاي ديگر -پارامتر اول فايل منبع .دوم جايي كه بايد برود
(Cut) Name "فابل مبدا" To "فايل مقصد"
اين تابع فابل را كپي مي كند پارامتر مانند بالا-برا پوشه هم استفاده مي شود
FileCopy "مبدا" To "مقصد"
اين تابع يك فايل رو از بين مي برد-برا پوشه هم مشود
Kill "FileName" Kill "C:\*.TxT" (ShortCut)
قكر كنم همه چيز رو گفتم به جز يك چيز چگونگي ايجاد يك فايل ميانبر
اون هم اگه نظر بدين توي پست بعدي
لينك مقاله |19:57 شنبه 21 بهمن1385 - توسط ناصر نيازي
2Api بسيار مفيد
بسيار مفيد رو براتون معرفي كنم كه خيلي هم پر كاربردهAPIمي خوام امروز 2
ويندوز رو ظا هر كردBrows Folderچطور مي توان كادر-
اين كادر استفاده ي بسيار زيادي در برنامه هاي كاربردي داره.وموقعي استفاده مي شه كه كار بر بايد يك پوشه رو (مثلآ براي نصب برنامه )انتخاب كنه
يك ماژول ايجاد كنيد و كد هاي زبر رابنويسيد
'------Typing New data For BrowsForm--------------------- Public Type BrowseInfo hWndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type
'---------------Conset For BrowsForm-------------------- Public Const BIF_RETURNONLYFSDIRS = 1 Public Const BIF_DONTGOBELOWDOMAIN = 2 Public Const MAX_PATH = 260
'-----------------------Declareing API------------------------------------------ Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
حال در جايي كه مي خواهيد كادر ظاهر شود كد زير رابنويسيد
Dim lpIDList As Long Dim sBuffer As String Dim szTitle As String Dim tBrowseInfo As BrowseInfo szTitle = "Select Folder... " With tBrowseInfo .hWndOwner = Me.hwnd .lpszTitle = lstrcat(szTitle, "") .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN End With lpIDList = SHBrowseForFolder(tBrowseInfo) If (lpIDList) Then sBuffer = Space(MAX_PATH) SHGetPathFromIDList lpIDList, sBuffer sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) msgbox( sBuffer) End If
در پايان در خط ماقبل آخر بايك پيغام مسير انتخلب شده كاربر اعلام مي شود كه شما عزيزان مي توانيد آنرا به دلخواه تغيير دهيد
را ظا هر كرد(Propertis)چطور مي توان كادر خصوصيات مربوط به يك فايل-
كادر خصوصيات اكثرآ در نوشتن يك كاد آرشيو يا ليست فايل كاربرد دارد كه شما روي نام فايل راست كليك مي كنيد و اين گزينه را معمولآ در انتهاي ليست انتخاب مي كنيد واين كادر ظاهر ميشود نوشتن چنين كد هايي باعث حرفه شدن برنامه ي شما مي گردد
به ماژولمان كد هاي زير را اضافه كنيد
'------Typing New data For Propertis File--------------------- Type SHELLEXECUTEINFO cbSize As Long fMask As Long hwnd As Long lpVerb As String lpFile As String lpParameters As String lpDirectory As String nShow As Long hInstApp As Long lpIDList As Long lpClass As String hkeyClass As Long dwHotKey As Long hIcon As Long hProcess As Long End Type '---------------Conset For Propertis Dialog------------------- Public Const SEE_MASK_INVOKEIDLIST = &HC Public Const SEE_MASK_NOCLOSEPROCESS = &H40 Public Const SEE_MASK_FLAG_NO_UI = &H400 Public Const ATTR_NORMAL = 0 Public Const ATTR_READONLY = 1 Public Const ATTR_HIDDEN = 2 Public Const ATTR_SYSTEM = 4 Public Const ATTR_VOLUME = 8 Public Const ATTR_DIRECTORY = 16 Public Const ATTR_ARCHIVE = 32 '-----------------------Declareing API------------------------------------------ Declare Function ShellExecuteEX Lib "shell32.dll" Alias _ "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
Public Function ShowFileProperties(filename As String, OwnerhWnd As Long) As Long Dim SEI As SHELLEXECUTEINFO With SEI .cbSize = Len(SEI) .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI .hwnd = OwnerhWnd .lpVerb = "properties" .lpFile = filename .lpParameters = vbNullChar .lpDirectory = vbNullChar .nShow = 0 .hInstApp = 0 .lpIDList = 0 End With ShellExecuteEX SEI ShowFileProperties = SEI.hInstApp End Function
حالا هر فايلي را كه مي خواهيد خصوصيياتش نمايش داد شود به اين تابع به صورت زير ارسال كنيد-پاس دهيد
ShowFileProperties(FileName,Me.hwnd)
نظر يادت نره با مرام
لينك مقاله |21:46 سه شنبه 17 بهمن1385 - توسط ناصر نيازي
فرمت فایل ام پی تری MP3
سلام بازم مي خوام براتون از وي بي بگم كه شيرين تر از دلفيه البته اهالي دلفي ناراحت نشيد براي شمام برنامه دارم.فعلآ بپردازيم به مبحث امروز كه ارتباط داره به خواندن اطلاعات اساسي فايل ام پي تري.متغيير هاي زير رو تو اول كد تعريف كنيد
Dim HasTag As Boolean Dim Tagg As String * 3 Dim Songname As String * 30 Dim Artist As String * 30 Dim Album As String * 30 Dim Year As String * 4 Dim Comment As String * 30 Dim Genre As String * 1
البته كد بالا تست شده است مورد كاملش اينهاست ولي نمي دونم جواب بده يانه خودتون امتحان كنيد اگه شد بهم بگيد -فعلآ استفاده نكنيد
Private Type MP3Tag FullName As String ' Filename and filepath of MP3 file FileName As String ' Name of MP3 file Path As String ' Path of MP3 file title As String * 30 artist As String * 30 album As String * 30 Year As String * 4 Comment As String * 30 Genre As String * 20 TagPresent As Boolean MPEGVersion As String * 3 ' Version 1.0, 2.0 or 3.0 Layer As String * 1 ' Layer 1, 2 or 3 Protection As Boolean ' 0=CRC is present, 1=Not Protected BitRate As String * 3 ' Recording bitrate SampleRate As String * 5 ' Sampling Frequency Padding As Integer ' 0=Frame is not padded, 1=(32bits for Layer 1, 8bits for Layer 2/3) PrivateBit As Integer ' Not used. Do what you want with it ChannelMode As String * 12 ' 00=Stereo, 01=Joint Stereo, 10=Dual Channel Stereo, 11=Mono ModeExtension As String * 2 ' Used only for Joint Stereo Copyright As Boolean ' Is file copyrighted? Original As Boolean ' Is file on original media? Emphasis As String * 8 ' Emphasis setting (usually none (00)) FrameLength As Integer ' Calculated from BitRate, SampleRate and Padding TotalFrames As Long ' Filelength/Framelength PlayTime As Single ' Calculated from TotalFrames, SampleRate and Stereo? ValidHeader As Boolean ' True=Valid Header found, False=Not an MP3 file End Type
بعد يك پردازه(پروسيجر)به اين صورت تعريف مي كنيم تاهر وقت بهش يك نام فايل پاس داديم متغيير هامون پر بشه از اطلاعت فايل
Private Sub GetTag(Filename) Open Filename For Binary As #1 Get #1, FileLen(Filename) - 127, Tagg If Not Tagg = "TAG" Then Close #1 HasTag = False Songname = "No Tag Found" Artist = "No Tag Found" Album = "No Tag Found" Year = "None" Comment = "No Tag Found" Genre = "0" Exit Sub End If HasTag = True Get #1, , Songname Get #1, , Artist Get #1, , Album Get #1, , Year Get #1, , Comment Get #1, , Genre Close #1 End Sub
حالا به اين صورت ميشه ازش استفاده كرد
Me.GetTag(MP3 FileName)
به طور معمول وقتي فايل به صورت باينري باز مي شه چيزي جز صفر و يك رو نمشه از توش خواند به همين دليل اين نوع باز كردن فايل رو تصوير آينه وار حافظه مي گن.چون هر چي روي هارد نوشته همون رو دودستي تحويلت مي ده!از اين رو بايد هميشه بعد از خواندن اين نوع فايل ها اونارو از فرمت باينري در آورد با تابع زير كه ازقبل توي وي بي هست
Src(Your Ascii Word)
اگه رشته رو با(String *30)ولي در برنامه بالا چون اندازه رشته رو تعريف كرديم
يك كد اسكي مقدار دهي كنيم خود به خود هنگام چاپ به فرم رشته ي معمولي در مياد
در دستور بالا ما با علامت ضربدر به وي بي مي گوييم كه چه مقدار حافظه را براي متغيير ما نگه دارد ولي اگر اين مورد را استفاده نكنيم وي بي به صورت اتوماتيك سايز رشته رو انتخاب .ميكنه اگه رشته كم باشه كم واگر زياد باشه زياد براش جا نگه مي داره به ازاي هر حرف يك بايت
لينك مقاله |20:39 یکشنبه 15 بهمن1385 - توسط ناصر نيازي
گرافیک در وی بی
سلام دوستان بايد بگم راجع به پست ديروزم كه اشكال داشت واقعآ متاسفم حذف اش كردم چون من مطالبم رو توي ورد مي نويسم و كپي پيست مي كنم گاهي از اين مشكلات پيش ميآد شما ببخشيد پاسخ به سوالات شما
چطور مي توان از دكستاپ عكس گرفت اين خط رو در اولين خط كد فرم بنويسيد-براي مبتدي ها
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
طريقه استفاده
Private Sub Form_load() Dim W, H W = Screen.Width / 15 H = Screen.Height / 15 StretchBlt hdc, 0, 0, W, H, GetDC(0&), 0, 0, W, H, vbSrcCopy End Sub
كشيدن يك دايره روي فرم با كد نويسي-نمودار دايره اي-بيضي
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) PI = 3.14159265 For i = 0 To 161 Step 10 Me.Circle (219, 167), i, RGB(0, 0, 0), 360 * (PI / 180), 360 * (PI / 180), 1 Next End Sub
آنرا به 3 تغيير دهيد.داشتم مي گفتم پارامتر سوم براي شعاع دايره -اندازه آن-پارامتر چهارمscalmode توضيحات: پارامتر اول ودوم مكان ترسيم دايره اگر دايره در فرم شما رسم نشد خاصيت براي رنگ پنجم براي نقطعه شروع وششم براي نقطه ي پايان اين دو تا براي رسم نمودار دايره اي بكار مي روند.پارامتر آخر هم براي رسم بيضي استفاده مي شود
چگونه مي توان يك مداد درست كرد مانند برنامه نقاشي ويندوز كد زير را بنويسيدMouseMoveدر كد
If Button <> vbright Then Me.PSet (X, Y)
چطور مي توان يك قطره چكان درست كرد كه روي هر گزينه رفت رنگ پيش فرض رنگ انجا شود عكس بنويسيدMouseMoveبه فرم اضافه كنيد يك عكس داخل كادر عكس قرار دهيد و كدزير را در رويدادPictureويكLabelيك
Label1.BackColor=Picture1.Point(X,Y)
چطور مي توان يك عكس را معكوس كرد
منظورت ازمعكوس اگه معكوس خود عكس در طراحي باشه كد زير جوابش هست
With Picture1 .PaintPicture .Picture, 0, .Height, .Width, -.Height End With
ولي اگه منظورت معكوس رنگ باشه كد زير جوابش هست
With Picture1 .PaintPicture .Picture, 0, 0, , , , , , , vbDstInvert End With
يراي موقعي به كار مي رود كه از يك اسم زياداستفاده مي كنيم.اسم را جلوي آن مينويسيم وهر وقت يك دات بزنيم قابل استفاده استWithتوضيحات:ِ پارامتر اول يراي عكسي كه ميخواهيم از آن براي ترسيم استفاده كنيم.دوم و سوم براي نقطه شروع ترسيم .چهارم و پنجم براي اندازه تصوير ترسيمي.ششموهفتم براي نقطه پايان ترسيم.هشتم ونهم براي اندازه هاي پاياني ترسيم وپارامتر آخر براي نوع ترسيم
چطور ميشه يك عكس رو روشن تر كرد يا پر رنگ واه! پسر عجب سوالي پرسيدي.ولي از اونجايي كه اينجانب خيلي به ندرت كم مياره اينم جوابت
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Sub CmdBrightness_Click() 'variables for brightness, color calculation, positioning Dim Brightness As Single Dim NewColor As Long Dim x, y As Integer Dim r, g, b As Integer 'change the brightness to a percent Brightness = TxtBrightness / 100 'run a loop through the picture to change every pixel For x = 0 To Picture1.ScaleWidth For y = 0 To Picture1.ScaleHeight 'get the current color value NewColor = GetPixel(Picture1.hDC, x, y) 'extract the R,G,B values from the long returned by GetPixel r = (NewColor Mod 256) b = (Int(NewColor / 65536)) g = ((NewColor - (b * 65536) - r) / 256) 'change the RGB settings to their appropriate brightness r = r * Brightness b = b * Brightness g = g * Brightness 'make sure the new variables aren't too high or too low If r > 255 Then r = 255 If r < 0 Then r = 0 If b > 255 Then b = 255 If b < 0 Then b = 0 If g > 255 Then g = 255 If g < 0 Then g = 0 'set the new pixel SetPixelV Picture1.hDC, x, y, RGB(r, g, b) 'continue through the loop Next y 'refresh the picture box every 10 lines (a nice progress bar effect) If x Mod 10 = 0 Then Picture1.Refresh Next x 'final picture refresh Picture1.Refresh End Sub
احتياج داريد كه متن درون آن به درصد برابر ميزان روشنايي استTxtBrightnessيك كادر متن به نامCmdBrightnessحال كردين با توضيحات كامل-براي كد بالا يك كامند به نام
چگونگي زدن تيف رنگ (مثلآ سبز به سياه) به يك فرم فرم كد زير رابنويسيدLoad.در رويداد
On Error GoTo B Dim r%, F%, Heght%, Wath%, X%, Color$ '--\/\/\/ Set Color Of Form Color = "Red_Black" '----------------تعيين تيف رنگ Heigh = Me.Height + 200: Widt = Me.Width F = Heigh \ 255: r = 0 Select Case Color Case "Red_Black": GoTo 1 Case "With_Red": GoTo 2 Case "Green_Black": GoTo 3 Case "With_Green": GoTo 4 Case "Blue_Black": GoTo 5 Case "With_Blue": GoTo 6 Case "With_Black": GoTo 7 End Select Exit Sub '---------------------------Main-------------------------------------------- 1 For i = 0 To Heigh Step F r = r + 1 If r = 20000 Then Exit For For X = i To F + i Me.Line (0, X)-(Widt, X), RGB(250 - r, 0, 0) Next X Next i: GoTo B 2 '-------------------------------------------------------------------------------- For i = 0 To Heigh Step F r = r + 1 If r = 20000 Then Exit For For X = i To F + i Me.Line (0, X)-(Widt, X), RGB(250, 254 - r, 255 - r) Next X Next i: GoTo B 3 '-------------------------------------------------------------------------------- For i = 0 To Heigh Step F r = r + 1 If r = 20000 Then Exit For For X = i To F + i Me.Line (0, X)-(Widt, X), RGB(0, 250 - r, 0) Next X Next i: GoTo B 4 '-------------------------------------------------------------------------------- For i = 0 To Heigh Step F r = r + 1 If r = 20000 Then Exit For For X = i To F + i Me.Line (0, X)-(Widt, X), RGB(250 - r, 255, 255 - r) Next X Next i: GoTo B 5 '-------------------------------------------------------------------------------- For i = 0 To Heigh Step F r = r + 1 If r = 255 Then Exit For For X = i To F + i Me.Line (0, X)-(Widt, X), RGB(0, 0, 250 - r) Next X Next i: GoTo B 6 '-------------------------------------------------------------------------------- For i = 0 To Heigh Step F r = r + 1 If r = 20000 Then Exit For For X = i To F + i Me.Line (0, X)-(Widt, X), RGB(250 - r, 250 - r, 255) Next X Next i: GoTo B 7 '-------------------------------------------------------------------------------- For i = 0 To Heigh Step F r = r + 1 If r = 9000 Then Exit For For X = i To F + i Me.Line (0, X)-(Widt, X), RGB(250 - r, 250 - r, 250 - r) Next X Next i '-------------------------------------------------------------------------------- B: Set Me.Picture = Me.Image
آه دستم داغون شد عزيزان ميتونيد اين كد رو خيلي كوتاه استفاده كنيد وهرخط چيني كه مربوط به رنگ خودتونه رو نگه داريد بقيه رو حذف كنيد.با كمي دقت مي توانيد رنگ هاي جديد بسازيد
چگونه سا عت ديجيتال بسازيم(كامپيوتري)-ساعت يا كنتور
به فرم اضافه كنيدPictureكوتاهترين راه براي ساخت يك ساعت روش زير است يك
Private Sub Form_Load() Static Score As Long Counter.Show DoEvents Score = 0 For I = 1 To 1265 DisplayNumber 10, Score Score = I DoEvents Next End Sub'------------------------------------------------------------------- Private Sub DisplayNumber(DisplayWidth As Integer, TheNumber As Long) Dim DisplayString As String, Zeros As Integer, GraphicsHeight As Single Dim DigitValue As Integer, NumPosition As Integer '--------------------Start Time--------------- GraphicsHeight = Picture1.ScaleHeight / 2 Zeros = DisplayWidth - Len(Trim(TheNumber)) For I = 0 To Zeros - 1 DisplayString = DisplayString & "0" Next DisplayString = DisplayString & Trim(Str(TheNumber)) For I = 0 To DisplayWidth - 1 DigitValue = Val(Mid(DisplayString, I + 1, 1)) If DigitValue = 0 Then NumPosition = 10 Else NumPosition = DigitValue _ Counter.PaintPicture Picture1.Image, I * (Picture1.ScaleWidth / 10), 0, _ Picture1.ScaleWidth / 10, Picture1.ScaleHeight / 2, (NumPosition - 1) _ * (Picture1.ScaleWidth / 10), GraphicsHeight, Picture1.ScaleWidth / 10, Picture1.ScaleHeight / 2 Next End Sub
Endد ر كد بالا به دلايلي فرم خارج نمي شود بايد يك دكمه براي خروج از فرم تنظيم كنيدودر كد كليك آن بنوسيد
روخاسته بودن "GDI32.Dll"يكي از دوستان ليست تمامي توابع موجود در فايل تورو خدا به من رحم كنيد!!.شوخي كردم به زودي براي امروز ديگه كافيه - فقط نظر يادتون نره
لينك مقاله |0:19 جمعه 13 بهمن1385 - توسط ناصر نيازي
آموزش وی بی
رجيستري چيست ؟
سيستم عامل ويندوز تنظيمات سخت افزاري و نرم افزاري خود را بطور مرکزي در يک بانک اطلاعاتي با ساختار سلسله مراتبي ذخيره مي کند که رجيستري نام دارد . رجيستري جايگزيني براي بسياري از فايلهاي پيکربندي INI ، SYS و COM است که در نسخه هاي اوليه ويندوز موجود بود . رجيستري ، سيستم عامل را با مهيا کردن اطلاعات موردنيز براي اجراي برنامه ها و load شدن component ها ، کنترل مي کند .
رجيستري شامل انواع مختلفي از اطلاعات مي باشد مثل :
- اطلاعات سخت افزارهاي نصب شده روي سيستم - اطلاعات درايورهاي نصب شده روي سيستم - اطلاعات برنامه هاي نصب شده روي سيستم - اطلاعات پروتکلهاي شبکه اي مورد استفاده در سيستم
ساختار رجيستري شامل چندين مجموعه رکورد است که داده هاي اين رکوردها توسط بسياري از برنامه ها و اجزاي سيستم عامل خوانده و يا نوشته مي شود .
اجزاي رجيستري
اجزاي تشکيل دهنده رجيستري عبارتند از :
1 – subtree : Subtree ها همانند folder هاي موجود در ريشه يک درايو هارد هستند . رجستری ويندوز داراي پنج subtree مي باشد : - HKEY_LOCAL_MACHINE : شامل تمام داده هاي پيکربندي براي کامپيوتر مي باشد و شامل 5 key است :Hardware ، SAM ، Security ، Software و System - HKEY_USERS : شامل داده هاي مربوط به تنظيمات سيستم عامل براي هر user است مثل تنظيمات desktop و محيط ويندوز - HKEY_CURRENT_USER : شامل داده هاي کاربر فعلي سيستم - HKEY_CLASSES_ROOT : شامل اطلاعات پيکربندي نرم افزار است مثل داده هاي OLE و داده هاي کلاسهاي متناظر با فايل - HKEY_CURRENT_CONFIG : شامل اطلاعات مورد نياز براي تنظيمات داريورهاي سخت افزاري و غيره
2 – Key : key ها همانند folder ها و subfolder هاي روي هارد هستند . هر key متناظر با object هاي نرم افزاري يا سخت افزاري مي باشد . subkey ها key هايي هستند که درون يکسري key قراردارند .
3 – Entry : هر key داراي يک يا چند entry است . هر entry داراي سه بخش مي باشد : - نام Name - نوع داده اي Data Type : مقدار هر entry يکي از انواع داده هاي زير است :
نکته 1 : براي مشاهده رجيستري و اعمال تغييرات در آن ( لطفاً اگر هيچ تجربه اي در تنظيم کردن رجيستري نداريد اطلاعات آنرا تغيير ندهيد ) ، مي توانيد از برنامه regedit.exe و يا regedt32.exe موجود در ويندوز استفاده کنيد . براي اينکار کافيست نام برنامه را در کادر Run وارد کنيد .
براي کار با رجيستري در ويژوال بيسيک کلاس Registery.bas را مطابق مطالب زير ايجاد کرده و در پروژه هاي خود از آن استفاده کنيد :
1 - تعريف ثابتهاي مورد نياز : براي نوشتن اين کلاس نياز به تعريف چهار دسته ثابت داريم :
- ثابتهاي مربوط به تعريف data type هاي entry هاي رجيستري :
Global Const REG_SZ As Long = 1 Global Const REG_DWORD As Long = 4
- ثابتهاي مربوط به تعريف key هاي رجيستري
Global Const HKEY_CLASSES_ROOT = &H80000000 Global Const HKEY_CURRENT_USER = &H80000001 Global Const HKEY_LOCAL_MACHINE = &H80000002 Global Const HKEY_USERS = &H80000003
- ثابتهاي مربوط به خطاهاي کار با رجيستري
Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1 Global Const ERROR_BADKEY = 2 Global Const ERROR_CANTOPEN = 3 Global Const ERROR_CANTREAD = 4 Global Const ERROR_CANTWRITE = 5 Global Const ERROR_OUTOFMEMORY = 6 Global Const ERROR_INVALID_PARAMETER = 7 Global Const ERROR_ACCESS_DENIED = 8 Global Const ERROR_INVALID_PARAMETERS = 87 Global Const ERROR_NO_MORE_ITEMS = 259
- ثابتهاي متفرقه
Global Const KEY_ALL_ACCESS = &H3F Global Const REG_OPTION_NON_VOLATILE = 0
2 - Declare کردن Api هاي مورد نياز : براي کار با رجيستري از توابع کتابخانه Advapi32.dll استفاده مي کنيم . اين توابع عبارتند از :
- تابع RegCloseKey : آزاد کردن handle مربوط به يک key Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long - تابع RegCreateKeyEx : ساخت يک key در رجيستري ( اگر key قبلاً وجود داشته باشد ، اين تابع آنرا باز مي کند ) :
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
- تابع RegOpenKeyEx : باز کردن يک key
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
- تابع RegQueryValueExLong : استخراج type و data ي يک نام متناظر با يک key باز شده
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
- تابع RegSetValueEx : ذخيره يک مقدار در فيلد value يک کليد باز
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
- تابع RegDeleteKey : پاک کردن يک کليد و کليه اطلاعات مرتبط با آن
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
- تابع RegDeleteValue : حذف مقدار يک key
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
3 - توابع کمکي : براي نوشتن توابع اصلي کار با رجيستري نياز به نوشتن توابع کمکي زير است : - تابع SetValueEx : با توجه به نوع داده يک کليد ، مقدار موجود در آنرا در يک متغير ذخيره مي کند :
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long Dim lValue As Long Dim sValue As String Select Case lType Case REG_SZ ' type of value is string sValue = vValue SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))x Case REG_DWORD ' type of value is Double word lValue = vValue SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)x End Select End Function
- تابع QueryValueEx : سايز و نوع داده اي يک داده را که بايد خوانده شود مشخص مي کند .
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long Dim cch As Long Dim lrc As Long Dim lType As Long Dim lValue As Long Dim sValue As String lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)x Select Case lType ' For strings Case REG_SZ: sValue = String(cch, 0)x lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)x If lrc = ERROR_NONE Then vValue = Left$(sValue, cch)x Else vValue = Empty End If ' For DWORDS Case REG_DWORD: lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)x If lrc = ERROR_NONE Then vValue = lValue Case Else 'all other data types not supported lrc = -1 End Select QueryValueExExit: QueryValueEx = lrc Exit Function QueryValueExError: Resume QueryValueExExit End Function
4 - توابع اصلي : توابع مربوط به پاک کردن يک کليد از رجيستري ، ساخت يک کليد جديد در رجيستري و مقداردهي به يک کليد :
- تابع DeleteKey : اين تابع يک کليد از رجيستري را حذف مي کند . داراي دو پارامتر ورودي است : Location که يکي از مقادير HKEY_CLASSES_ROOT ، HKEY_CURRENT_USER ، HKEY_LOCAL_MACHINE و يا HKEY_USERS است . KeyName که نام کليدي است که بايد از رجيستري حذف شود . اين کليد ممکنست شامل subkey هايي نيز باشد مثلاً Key1\SubKey1
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)x Dim lRetVal As Long lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)x DeleteKey = lRetVal ' return function value
End Function
- تابع DeleteValue : اين تابع يک entry را از کليد حذف مي کند . داراي سه پارامتر ورودي است : Location ، KeyName و ValueName که نام آن value را مشخص مي کند .
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)x Dim lRetVal As Long Dim hKey As Long lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x lRetVal = RegDeleteValue(hKey, sValueName)x RegCloseKey (hKey)x DeleteValue = lRetVal End Function
- تابع CreateNewKey : اين تابع يک کليد جديد ايجاد مي کند . داراي دو پارامتر ورودي است : Location و KeyName
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)x Dim hNewKey As Long Dim lRetVal As Long lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)x RegCloseKey (hNewKey)x CreateNewKey = lRetVal End Function
- تابع SetKeyValue : اين تابع پارامتر data يک entry را تنظيم مي کند . داراي 5 پارامتر ورودي است : Location ، KeyName ، ValueName ، ValueSetting و ValueType
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)x Dim lRetVal As Long Dim hKey As Long lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)x RegCloseKey (hKey)x SetKeyValue = lRetVal End Function
- تابع QueryValue : اين تابع فيلد داده يک entry را برمي گرداند . داراي سه پارامتر ورودي است : Location ، KeyName و ValueName
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)x Dim lRetVal As Long Dim hKey As Long Dim vValue As Variant lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x lRetVal = QueryValueEx(hKey, sValueName, vValue)x QueryValue = vValue RegCloseKey (hKey)x End Function
ساخت يک انتصاب فايل يا File Association به يک برنامه
در اين درس می خواهم با استفاده از کلاسی که در درس قبل معرفی شد تابعی بسازيم که توسط آن بتوانيم فايلهای با پسوندی مشخص را به يک برنامه اختصاص دهيم . بعبارت ديگر تابعی بنويسيم که اطلاعات لازم برای باز شدن فايلهايی با پسوند xxx را توسط برنامه MyApp.exe در رجيستری ثبت کند .
اجرا شدن يک برنامه در هنگام راه اندازی سيستم فرض کنيد می خواهيم برنامه ای بنويسيم که هر بار در هنگام راه اندازي سيستم بطور خودكار اجرا شود. البته نمي خواهم در startup ويندوز ديده شود . براي اين كار بايد برنامه موردنظر را در StartUp رجيستري قرار دهيم . به اين ترتيب كه در يكي از كليدهاي زير يك مقدار رشته اي جديد(String Value) ايجاد کنيم و آدرس برنامه را در آن وارد كنيم :
نکته : البته دو تا راه ديگر برای اينکار وجود دارد که برخی تروجان ها هم از اين روشها استفاده می کنند تا روی سيستم باقی بمانند : يكي استفاده از win.ini و نوشتن نام فايل جلوي = run و ديگري استفاده از system.ini و نوشتن نام برنامه جلوي خط explorer.exe .
Prdev.com -از
لينك مقاله |15:20 دوشنبه 11 دی1385 - توسط ناصر نيازي
آموزش وي بي
WindowsMediaPlayerکنترل
کنترل مديا پلير ايکس پي که توسط کتابخانه قدرتمندي پشتيباني مي شودرا مي توان در تمام انواع ويندوز ايکس پي استفاده کرد.درويندوز 98 کنترل
مديا پليرقديمي استفاده مي شد که البته در ويندوز ايکس پي نيز قابل استفاده است
شاخه ي ويندوز\program files\WindowsMediaplayer\
البته از نسخه 10 به بعد مديا پلير قبلي حذف شد
Components\WindowsMediaPlayerنحوه ي استفاده از کنترل مديا پلير-روي کنترل ها راست کليک کرده در منوي باز شده گزينه
نيز به انتخاب هايتان اضافه کنيدMicrosoftCommonDialogرا (معمولآ در ته ليست )انتخاب مي کنيم.قبل از اينکه آن کادر را ببنديد يک کنترل
بگزاريدسپس در کد کليک دکمه کد زير رابنويسيدCMDOpenيک دکمه ويک مدياپليربه فرمتان اضافه کنيد و نام دکمه را
CommonDialog1.ShowOpen
WindowsMediaPlayer1.URL=CommDialog1.FileName
مشاهده مي کنيد که کادر فايل باز شده و فايل انتخاب شده پخش مي شود.اگر مي خواهيد شکل دکمه ها را خودتان طراحي کنيد بايد دکمه هايي کاملآ به به آنها بگزاريد.سپس کدهاي زير را بنويسيدPause,Stop,Playيکدست توسط فتوشاپ طراحي کنيد.سه دکمه به فرم اضافه کرده ونامهاي
private sub Play_Click()
WindowsMediaPlayer1.Controls.Play()
End Sub
'------------------------
Prrivate Sub Stop_Click()
WindowsMediaPlayer1.Controls.Stop()
End Sub
'------------------------
Private Sub Pause_Click()
WindowsMediaPlayer1.Pause()
End Sub
تايمر را به50 تنظيم کنيد.روي تايمر دوبار کليک کنيد وکد زير را بنويسيدIntervalبه فرم اضافه کنيد.يک تايمر هم به فرم اضافه کنيد خاصيت HScroll1بعد از تست کد هاي بالا يک
ناصرنيازي :
با سلام به وبلاگ من خوش آمديد ، در اين وبلاگ هر گونه آموزش برنامه نويسي و دلفي انجام مي شود. جهت استفاده بيهنه از اين وبلاگ به آرشيو وبلاگ نيز سري بزنيد .بيش ازنيم مليون كتاب برنامه نويسي خارجي و10 هزاركتاب فارسي در اينجا و وبلاگ ديگر ما وتالار گفتگو شماره اس ام اس09189151266.با تشکر
