首页 VB入门技巧多例4

VB入门技巧多例4

举报
开通vip

VB入门技巧多例410.在状态栏显示无边框窗体图标。PrivateDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"(ByValhWnd_AsLong,ByValnIndexAsLong,ByValdwNewLongAsLong)AsLongPrivateDeclareFunctionGetWindowLongLib"user32"Alias"GetWindowLongA"(ByValhWnd_AsLong,ByValnIndexAsLong)AsLongCons...

VB入门技巧多例4
10.在状态栏显示无边框窗体图标。PrivateDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"(ByValhWnd_AsLong,ByValnIndexAsLong,ByValdwNewLongAsLong)AsLongPrivateDeclareFunctionGetWindowLongLib"user32"Alias"GetWindowLongA"(ByValhWnd_AsLong,ByValnIndexAsLong)AsLongConstGWL_STYLE=(-16&)ConstWS_SYSMENU=&H80000PrivateSubForm_Load()'MakeForm'sIconvisibleinthetaskbarSetWindowLongMe.hWnd,GWL_STYLE,GetWindowLong(Me.hWnd,GWL_STYLE)OrWS_SYSMENUEndSub11.记录窗体的大小及位置和程序中的一些设置PrivateSubForm_Load()Me.Width=GetSetting(App.Title,Me.Name,"Width",7200)Me.Height=GetSetting(App.Title,Me.Name,"Height",6300)Me.Top=GetSetting(App.Title,Me.Name,"Top",100)Me.Left=GetSetting(App.Title,Me.Name,"Left",100)Check1.Value=GetSetting(App.Title,Me.Name,"check1",0)EndSubPrivateSubForm_Unload(CancelAsInteger)CallSaveSetting(App.Title,Me.Name,"Width",Me.Width)CallSaveSetting(App.Title,Me.Name,"Height",Me.Height)CallSaveSetting(App.Title,Me.Name,"Top",Me.Top)CallSaveSetting(App.Title,Me.Name,"Left",Me.Left)CallSaveSetting(App.Title,Me.Name,"check1",Check1.Value)EndSub13.无边框窗体的右键菜单 设计 领导形象设计圆作业设计ao工艺污水处理厂设计附属工程施工组织设计清扫机器人结构设计 无边框窗体时,如果使用菜单编辑器,就会自动改变成有边框的窗体,此时,可以在另外一个窗体中(一般情况下你的程序应该不止一个窗体的吧,如果真的只有一个,可以利用其他人写的类,添加右键)编辑菜单(VISIBLE属性设为FALSE),然后在本窗体中调用。调用形式如下:PrivateSubForm_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)IfButton=2ThenPopupMenuForm2.mymenuEndIfEndSub14.创建圆角无边框窗体PrivateDeclareFunctionCreateRoundRectRgnLib"gdi32"(ByValX1AsInteger,ByValY1_AsInteger,ByValX2AsInteger,ByValY2AsInteger,ByValx3AsInteger,ByValy3As_Integer)AsLongPrivateDeclareFunctionDeleteObjectLib"gdi32"(ByValhObjectAsLong)AsLongPrivateDeclareFunctionSetWindowRgnLib"user32"(ByValhwndAsLong,ByValhrgnAs_Long,ByValbRedrawAsBoolean)AsLongPrivateSubForm_Load()hround=CreateRoundRectRgn(0,0,ScaleX(Form1.ScaleWidth,vbTwips,vbPixels),_ScaleY(Form1.ScaleHeight,vbTwips,vbPixels),20,20)SetWindowRgnMe.hwnd,hround,TrueDeleteObjecthroundEndSub15.拖动没有标题栏的窗体方法一:PrivateDeclareFunctionReleaseCaptureLib"user32"()AsLongPrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwndAs_Long,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLongPrivateConstHTCAPTION=2PrivateConstWM_NCLBUTTONDOWN=&HA1PrivateSubForm_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)DimnclAsLongDimrelAsLongIfButton=1Theni=ReleaseCapture()ncl=SendMessage(hwnd,WM_NCLBUTTONDOWN,HTCAPTION,0)EndIfEndSub方法二:回调 关于工期滞后的函关于工程严重滞后的函关于工程进度滞后的回复函关于征求同志党风廉政意见的函关于征求廉洁自律情况的复函 数'module:PublicConstGWL_WNDPROC=(-4)PublicConstWM_NCHITTEST=&H84PublicConstHTCLIENT=1PublicConstHTCAPTION=2DeclareFunctionCallWindowProcLib"user32"Alias"CallWindowProcA"(ByVal_lpPrevWndFuncAsLong,ByValhWndAsLong,ByValMsgAsLong,ByValwParamAsLong,_ByVallParamAsLong)AsLongDeclareFunctionGetWindowLongLib"user32"Alias"GetWindowLongA"(ByValhWndAs_Long,ByValnIndexAsLong)AsLongDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"(ByValhWndAs_Long,ByValnIndexAsLong,ByValdwNewLongAsLong)AsLongPublicprevWndProcAsLongFunctionWndProc(ByValhWndAsLong,ByValMsgAsLong,ByValwParamAsLong,ByVal_ParamAsLong)AsLongWndProc=CallWindowProc(prevWndProc,hWnd,Msg,wParam,lParam)IfMsg=WM_NCHITTESTAndWndProc=HTCLIENTThenWndProc=HTCAPTIONEndIfEndFunction窗体中:PrivateSubForm_Load()prevWndProc=GetWindowLong(Me.hWnd,GWL_WNDPROC)SetWindowLongMe.hWnd,GWL_WNDPROC,AddressOfWndProcEndSubPrivateSubForm_Unload(CancelAsInteger)SetWindowLongMe.hWnd,GWL_WNDPROC,prevWndProcEndSub16.半透明窗体PrivateDeclareFunctionSetLayeredWindowAttributesLib"user32"(ByValhwndAsLong,_ByValcrKeyAsLong,ByValbAlphaAsByte,ByValdwFlagsAsLong)AsLongPrivateConstWS_EX_LAYERED=&H80000PrivateConstLWA_ALPHA=&H2PrivateConstGWL_EXSTYLE=(-20)PrivateDeclareFunctionGetWindowLongLib"user32"Alias"GetWindowLongA"(ByVal_hwndAsLong,ByValnIndexAsLong)AsLongPrivateDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"(ByVal_hwndAsLong,ByValnIndexAsLong,ByValdwNewLongAsLong)AsLongPrivateSubForm_Load()DimrtnAsLongrtn=GetWindowLong(Me.hwnd,GWL_EXSTYLE)'取的窗口原先的样式rtn=rtnOrWS_EX_LAYERED'使窗体添加上新的样式WS_EX_LAYEREDSetWindowLongMe.hwnd,GWL_EXSTYLE,rtn'把新的样式赋给窗体SetLayeredWindowAttributesMe.hwnd,0,200,LWA_ALPHAEndSub17.开机启动(函数及常数声明略)PrivateSubForm_Load()DimhKeyAsLong,SubKeyAsString,ExeAsStringSubKey="Software\Microsoft\Windows\CurrentVersion\Run"Exe="可执行文件的路径"RegCreateKeyHKEY_CURRENT_USER,SubKey,hKeyRegSetvalueExhKey,"autorun",0,REG_SZ,ByValExe,LenB(StrConv(Exe,vbFromUnicode))+1RegCloseKeyhKeyEndSub18.关闭显示器PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwnd_AsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLongConstWM_SYSCOMMAND=&H112&ConstSC_MONITORPOWER=&HF170&PrivateSubCommand1_Click()SendMessageMe.hwnd,WM_SYSCOMMAND,SC_MONITORPOWER,ByVal2&'关闭显示器EndSubPrivateSubCommand2_Click()SendMessageMe.hwnd,WM_SYSCOMMAND,SC_MONITORPOWER,ByVal-1&'打开显示器EndSub19.在程序结束时自动关闭由SHELL打开的程序。PrivateConstPROCESS_QUERY_INFORMATION=&H400'关闭由SHELL函数打开的文件PrivateConstPROCESS_TERMINATE=&H1PrivateDeclareFunctionOpenProcessLib"kernel32"(ByValdwDesiredAccessAsLong,_ByValbInheritHandleAsLong,ByValdwProcessIdAsLong)AsLongPrivateDeclareFunctionTerminateProcessLib"kernel32"(ByValhProcessAsLong,_ByValuExitCodeAsLong)AsLongDimProcessIdAsLongPrivateSubCommand1_Click()ProcessId=Shell("notepad.exe.",vbNormalFocus)EndSubPrivateSubForm_Unload(CancelAsInteger)DimhProcessAsLonghProcess=OpenProcess(PROCESS_TERMINATEOrPROCESS_QUERY_INFORMATION,False,_ProcessId)CallTerminateProcess(hProcess,3838)EndSub20.关闭、重启计算机PublicDeclareFunctionExitWindowsExLib"user32"Alias"ExitWindowsEx"(ByVal_uFlagsAsLong,ByValdwReservedAsLong)AsLongExitWindowsEx1,0关机ExitWindowsEx0,1重新启动21.显示关机提示框PrivateDeclareFunctionSHRestartSystemMBLib"shell32"Alias"#59"(ByValhOwner_AsLong,ByValsExtraPromptAsString,ByValuFlagsAsLong)AsLongConstEWX_LOGOFF=0ConstEWX_SHUTDOWN=1ConstEWX_REBOOT=2ConstEWX_FORCE=4ConstEWX_POWEROFF=8PrivateSubCommand1_Click()SHRestartSystemMBMe.hWnd,PROMPT,EWX_LOGOFFEndSub右键托盘图标后必须电击他才可以消失,怎么办?CaseWM_RBUTTONUP'鼠标在图标上右击时弹出菜单SetForegroundWindowMe.hwndMe.PopupMenumnuTray加一句SetForegroundWindowMe.hwnd23.将progressbar嵌入statusbar中PrivateDeclareFunctionSetParentLib"user32"(ByValhWndChildAsLong,ByVal_hWndNewParentAsLong)AsLongPrivateSubCommand1_Click()WithProgressBar1.Max=1000DimiAsIntegerFori=1To1000.Value=iNextiEndWithEndSubPrivateSubForm_Load()ProgressBar1.Appearance=ccFlatSetParentProgressBar1.hWnd,StatusBar1.hWndProgressBar1.Left=StatusBar1.Panels(1).LeftProgressBar1.Top=100ProgressBar1.Width=StatusBar1.Panels(1).Width-50ProgressBar1.Height=StatusBar1.Height-150EndSub'相对位置你可以自己再调一下24.使你的程序界面具有XP风格产生一个和你的可执行程序同名的后缀为exe.manifest的文件,并和可执行文件放在同一路径中。代码中加入:PrivateDeclareSubInitCommonControlsLib"comctl32.dll"()PrivateSubForm_Initialize()InitCommonControlsEndSub注意:1工具栏控件一定要用MicrosoftWindowsCommonControls5.0,而不要用MicrosoftWindowsCommonControls6.0。因为此InitCommonControlsAPI函数是位于comctl32.dll(MicrosoftWindowsCommonControls5.0控件的动态链接库中)。2放在FRAME控件中的单远按钮有些“麻烦”!为了解决此问题,可以将单选按钮放在PICTURE控件中(以PICTURE控件作为容器),再将PICTURE控件放在FRAME控件中,就可以了。3必须编译之后才能看到效果exe.manifest文件中的 内容 财务内部控制制度的内容财务内部控制制度的内容人员招聘与配置的内容项目成本控制的内容消防安全演练内容 ,可用notepad编辑。Yourapplicationdescriptionhere.25.如何打印PictureBox中的所有控件添加另外一个PictureBox,然后:PrivateConstWM_PAINT=&HFPrivateConstWM_PRINT=&H317PrivateConstPRF_CLIENT=&H4&PrivateConstPRF_CHILDREN=&H10&PrivateConstPRF_OWNED=&H20&PrivateConstPHYSICALOFFSETXAsLong=112PrivateConstPHYSICALOFFSETYAsLong=113PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwnd_AsLong,ByValwMsgAsLong,ByValwParamAsLong,ByVallParamAsLong)AsLongPrivateDeclareFunctionGetDeviceCapsLib"gdi32"(ByValhdcAsLong,ByValnindex_AsLong)AsLongprivateSubForm_Load()Picture1.AutoRedraw=TruePicture2.AutoRedraw=TruePicture2.BorderStyle=0Picture2.Visible=FalseEndSubPrivateSubCommand2_Click()DimretvalAsLong,xmarginAsSingle,ymarginAsSingleDimxAsSingle,yAsSinglex=1:y=1WithPrinter.ScaleMode=vbInchesxmargin=GetDeviceCaps(.hdc,PHYSICALOFFSETX)xmargin=(xmargin*.TwipsPerPixelX)/1440ymargin=GetDeviceCaps(.hdc,PHYSICALOFFSETY)ymargin=(ymargin*.TwipsPerPixelY)/1440Picture2.Width=Picture1.WidthPicture2.Height=Picture1.HeightDoEventsPicture1.SetFocusretval=SendMessage(Picture1.hwnd,WM_PAINT,Picture2.hdc,0)retval=SendMessage(Picture1.hwnd,WM_PRINT,Picture2.hdc,_PRF_CHILDREN+PRF_CLIENT+PRF_OWNED)DoEventsPrinter.Print"".PaintPicturePicture2.Image,x-xmargin,y-ymargin.EndDocEndWithEndSub26.冒泡排序SubBubbleSort(List()AsDouble)DimFirstAsDouble,LastAsDoubleDimiAsInteger,jAsIntegerDimTempAsDoubleFirst=LBound(List)Last=UBound(List)Fori=FirstToLast-1Forj=i+1ToLastIfList(i)>List(j)ThenTemp=List(j)List(j)=List(i)List(i)=TempEndIfNextjNextiEndSub27.清空回收站PrivateDeclareFunctionSHEmptyRecycleBinLib"shell32.dll"Alias_"SHEmptyRecycleBinA"(ByValhwndAsLong,ByValpszRootPathAsString,_ByValdwFlagsAsLong)AsLongPrivateDeclareFunctionSHUpdateRecycleBinIconLib"shell32.dll"()AsLongPrivateConstSHERB_NOCONFIRMATION=&H1PrivateConstSHERB_NOPROGRESSUI=&H2PrivateConstSHERB_NOSOUND=&H4PrivateSubCommand1_Click()DimretvalAsLong'returnvalueretval=SHEmptyRecycleBin(RecycleBin.hwnd,"",SHERB_NOPROGRESSUI)'清空回收站,确认'若有错误出现,则返回回收站图示Ifretval<>0Then'errorretval=SHUpdateRecycleBinIcon()EndIfEndSubPrivateSubCommand2_Click()DimretvalAsLong'returnvalue'清空回收站,不确认retval=SHEmptyRecycleBin(RecycleBin.hwnd,"",SHERB_NOCONFIRMATION)'若有错误出现,则返回回收站图示Ifretval<>0Then'errorretval=SHUpdateRecycleBinIcon()EndIfCommand1_ClickEndSub28.获得系统文件夹的路径PrivateDeclareFunctionGetSystemDirectoryLib"kernel32"Alias_"GetSystemDirectoryA"(ByVallpBufferAsString,ByValnSizeAsLong)AsLongPrivateSubCommand1_Click()DimsyspathAsStringDimlen5AsLongsyspath=String(255,0)len5=GetSystemDirectory(syspath,256)syspath=Left(syspath,InStr(1,syspath,Chr(0))-1)Debug.Print"SystemPath:";syspathEndSub29.动态增加控件并响应事件OptionExplicit'通过使用WithEvents关键字声明一个对象变量为新的命令按钮PrivateWithEventsNewButtonAsCommandButton'增加控件PrivateSubCommand1_Click()IfNewButtonIsNothingThen'增加新的按钮cmdNewSetNewButton=Controls.Add("VB.CommandButton","cmdNew",Me)'确定新增按钮cmdNew的位置NewButton.MoveCommand1.Left+Command1.Width+240,Command1.TopNewButton.Caption="新增的按钮"NewButton.Visible=TrueEndIfEndSub'删除控件(注:只能删除动态增加的控件)PrivateSubCommand2_Click()IfNewButtonIsNothingThenElseControls.RemoveNewButtonSetNewButton=NothingEndIfEndSub'新增控件的单击事件PrivateSubNewButton_Click()MsgBox"您选中的是动态增加的按钮!"EndSub30.得到磁盘序列号FunctionGetSerialNumber(strDriveAsString)AsLongDimSerialNumAsLongDimResAsLongDimTemp1AsStringDimTemp2AsStringTemp1=String$(255,Chr$(0))Temp2=String$(255,Chr$(0))Res=GetVolumeInformation(strDrive,Temp1,Len(Temp1),SerialNum,0,0,Temp2,_Len(Temp2))GetSerialNumber=SerialNumEndFunction调用形式Label1.Caption=GetSerialNumber("c:\")31.打开屏幕保护PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwnd_AsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLong'我们将要调用的那个消息,在MSDN中搜索WM_SYSCOMMAND就可以找到具体说明ConstWM_SYSCOMMAND=&H112'这个参数指明了我们让系统启动屏幕保护ConstSC_SCREENSAVE=&HF140&PrivateSubCommand1_Click()SendMessageMe.hwnd,WM_SYSCOMMAND,SC_SCREENSAVE,0EndSub32.获得本机IP地址方法一:利用Winsock控件winsockip.localip方法二:PrivateConstMAX_IP=255PrivateTypeIPINFOdwAddrAsLongdwIndexAsLongdwMaskAsLongdwBCastAddrAsLongdwReasmSizeAsLongunused1AsIntegerunused2AsIntegerEndTypePrivateTypeMIB_IPADDRTABLEdEntrysAsLongmIPInfo(MAX_IP)AsIPINFOEndTypePrivateTypeIP_ArraymBufferAsMIB_IPADDRTABLEBufferLenAsLongEndTypePrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(Destination_AsAny,SourceAsAny,ByValLengthAsLong)PrivateDeclareFunctionGetIpAddrTableLib"IPHlpApi"(pIPAdrTableAsByte,_pdwSizeAsLong,ByValSortAsLong)AsLongDimstrIPAsStringPrivateFunctionConvertAddressToString(longAddrAsLong)AsStringDimmyByte(3)AsByteDimCntAsLongCopyMemorymyByte(0),longAddr,4ForCnt=0To3ConvertAddressToString=ConvertAddressToString+CStr(myByte(Cnt))+"."NextCntConvertAddressToString=Left$(ConvertAddressToString,Len(ConvertAddressToString)-1)EndFunctionPublicSubStart()DimRetAsLong,TelAsLongDimbBytes()AsByteDimListingAsMIB_IPADDRTABLEOnErrorGoToEND1GetIpAddrTableByVal0&,Ret,TrueIfRet<=0ThenExitSubReDimbBytes(0ToRet-1)AsByteGetIpAddrTablebBytes(0),Ret,FalseCopyMemoryListing.dEntrys,bBytes(0),4strIP="你机子上有"&Listing.dEntrys&"个IP地址。"&vbCrLfstrIP=strIP&"------------------------------------------------"&vbCrLf&vbCrLfForTel=0ToListing.dEntrys-1CopyMemoryListing.mIPInfo(Tel),bBytes(4+(Tel*Len(Listing.mIPInfo(0)))),Len_(Listing.mIPInfo(Tel))strIP=strIP&"IP地址:"&ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)&vbCrLfNextExitSubEND1:MsgBox"ERROR"EndSubPrivateSubForm_Load()StartMsgBoxstrIPEndSub33.用键盘方向键控制COMBOXPrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"_(ByValhwndAsLong,_ByValwMsgAsLong,_ByValwParamAsLong,_lParamAsAny)AsLongConstCB_SHOWDROPDOWN=&H14FDimbDropAsBooleanPrivateisDoAsBooleanPrivateSubCombo1_Click()IfNotisDoThenisDo=True'<----------回置状态ExitSubElse:MsgBox"safd"EndIfEndSubPrivateSubCombo1_DropDown()bDrop=TrueEndSubPrivateSubCombo1_KeyDown(KeyCodeAsInteger,ShiftAsInteger)IfKeyCode=40ThenisDo=FalseSendMessageCombo1.hwnd,CB_SHOWDROPDOWN,1,0ElseIfKeyCode=38ThenisDo=FalseIfCombo1.ListIndex=0ThenIfbDropThenbDrop=FalseSendMessageCombo1.hwnd,CB_SHOWDROPDOWN,0,0EndIfEndIfEndIfEndSubPrivateSubCombo1_KeyUp(KeyCodeAsInteger,ShiftAsInteger)IfCombo1.Text=Combo1.List(0)ThenisDo=TrueEndIfEndSubPrivateSubForm_Load()isDo=TrueCombo1.AddItem"abcd"Combo1.AddItem"abcd1"Combo1.AddItem"abcd2"Combo1.AddItem"abcd3"EndSub
本文档为【VB入门技巧多例4】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
该文档来自用户分享,如有侵权行为请发邮件ishare@vip.sina.com联系网站客服,我们会及时删除。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。
本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。
网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。
下载需要: 免费 已有0 人下载
最新资料
资料动态
专题动态
个人认证用户
中式烹调师
暂无简介~
格式:doc
大小:126KB
软件:Word
页数:14
分类:互联网
上传时间:2022-05-27
浏览量:0