我的想法：如果你有原创的，且体积较小的代码，请贴到这里来吧，让大家共享你的喜悦。一点小要求：只贴代码，不发表意见，以免影响阅读。谢谢合作。发贴格式：1、代码的名称或功能简介2、代码（最好带注释）

最容易、最简单的注册OCX或DLL的方法 Private Sub Command1_Click()Dim rc As Doublerc = Shell("regsvr32 f:\prct3260.ocx", vbNormalFocus)End Sub

'产生从1到20的随即数，绝不重复，速度快Private Sub Command1_Click()Dim N As Long, I As LongN = 20 '产生到20，N=20，产生到100，N=100For I = 1 To NList1.AddItem INextDim a As LongFor I = List1.ListCount - 1 To 0 Step -1a = Int(Rnd * (I + 1))Text1.Text = Text1.Text + List1.List(a) + ","List1.RemoveItem aNextEnd Sub

2 回复：→ＶＢ小玩意儿：秀出你的玲珑代码来共享!! 滚动窗口标题——有点像广告字幕 Option Explicit Const Captions As String = "ＶＢ小玩意儿：秀出你的玲珑代码来共享。欢迎您经常来VB贴吧作客，这是一个学习、交流、提高的好地方。" Private Sub Form_Load() Timer1.Interval = 200 End Sub Private Sub Timer1_Timer() Static N As Integer Dim L As Integer, C As String L = Int(Me.Width / 220) '220这个数字你可以随便改，看会发生什么变化 C = String(L, "　") + Captions + String(L, "　") N = N + 1 If N > Len(C) - L Then N = 1 '滚动到文字末部，再重新开始 Me.Caption = Mid(C, N, L) End Sub 作者： yes_no_ok 封 2005-10-17 21:12 　 回复此发言 删除此发言

二楼的抱歉啊，又误删了，所以利用临时文件重新发了一下，最近好象有点晕了

写入注册表操作，让你的程序开机就运行Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As LongPrivate Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPrivate Const REG_SZ = 1 ' Unicode nul terminated stringConst HKEY_LOCAL_MACHINE = &H80000002Private Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)Dim keyHand As LongDim R As LongR = RegCreateKey(hKey, strPath, keyHand)R = RegSetValueEx(keyHand, strValue, 0, REG_SZ, ByVal strData, Len(strData))R = RegCloseKey(keyHand)End SubPrivate Sub Command1_Click()'写入注册表，让程序开机就运行SaveString HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "鼠标中键增强助手", App.Path + "\" + App.EXEName + ".exe"End Sub

刚学会的，BMP转JPG的我感觉的最简单的方法了'窗体上一个按钮，一个imgedit控件Private Sub Command1_Click() If (ImgEdit1.IsClipboardDataAvailable And ImgEdit1.ImageDisplayed) Then '从剪贴板粘贴图象，其参数为Imgedit的显示区域的起始坐标 ImgEdit1.ClipboardPaste 0, 0 ImgEdit1.CompletePaste End If '保存图片为jpg格式 ImgEdit1.SaveAs App.Path & "\" & "mytest.jpg", wiFileTypeJPG, , 6End SubPrivate Sub Form_Load() ImgEdit1.Image = App.Path & "\" & "06.jpg" '先让ImgEdit随便显示一幅图片，不然后面的语句执行时会发生错误 ImgEdit1.DisplayEnd Sub

最快的一键关机，无需API声明 Shell "rundll.exe user.exe,exitwindows", vbHide

几行代码就登陆QQ了...md5.Text = DigestStrToHexStr(Text2.Text)post.Text = "VER=1.0&CMD=Login&SEQ=3&UIN=" + Text1.Text + "&PS=" + md5.Text + "&M5=1&LC=9326B87B234E7235"Call PostInfo$("tqq.tencent.com", "8000", "Content-Type: application/x-www-form-urlencoded", post.Text)MsgBox "login ok!如果没有登陆成功清检查登陆密码!", vbInformation, "ok"Text1.Text = ""Text2.Text = ""具体模块于源码联系QQ就有^_^298854392

10楼的，请把你的 PostInfo() 函数的代码贴出来看看

点击TEXT控件后，控件里面的文字都自动选中Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text)End Sub

让你的电脑休息一下……（没有什么实际意义，但是所有程序都一定被挂起。） Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long) Sub Cmd_Click() Sleep 5000 '5秒钟 End Sub

X-Scan搜索IP时的进度条~~~~~~ '添加一个Timer，Interval设为1 '一个PictureBox，名称是P1 ——TZW Dim d As Single Private Sub Form_Load() d = P1.Width / 255 P1.AutoRedraw=TrueEnd Sub Private Sub Timer1_Timer() Static c As Long DrawPic c, d If c <= 0 Then d = P1.Width / 255 If c >= P1.Width Then d = -(P1.Width / 255) End If c = c + d End Sub Sub DrawPic(ByVal Pos As Long, ByVal a As Single) Dim b As Byte b = 255: P1.Cls Do Until b = 0 If Pos <= 0 Then a = P1.Width / 255 If Pos >= P1.Width Then a = -(P1.Width / 255) P1.Line (Pos, 0)-(Pos + a, P1.Height), RGB(b, b, b), BF Pos = Pos + a: b = b - 1 Loop End Sub 　 　 作者： 218.22.218.* 封 2005-12-7 21:31 　 回复此发言 删除

————转帖注明作者！在此主题中发广告的一律封号！！

'应楼主要求,这个代码体积够小了吧.'代码中设定boderstyle还有小学问呢,不信你先不要看,你自己先玩玩.Private Sub Form_Load() Me.BorderStyle = 0 Me.Caption = ""End Sub

如何用VB将十进制转换二进制 　 Public Function DecimalToBinary(DecimalNum As Long) As _ String Dim tmp As String Dim n As Long n = DecimalNum tmp = Trim(Str(n Mod 2)) '转8、16进制只需把2换成8或16 n = n \ 2 Do While n <> 0 tmp = Trim(Str(n Mod 2)) & tmp n = n \ 2 Loop DecimalToBinary = tmp End Function 　 　 作者： blanksoft 2004-3-19 16:45 　 回复此发言

不对！自己添乱了，那句注释是我自己加的，应删去，16进制不能这样转的！8进制还可以！

'移动无规则窗口，并设有保持窗口不移出屏幕的功能Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongSub MoveWindow(Frm As Form)On Error GoTo cccReleaseCaptureSendMessage Frm.hwnd, &HA1, 2, 0If Frm.Top <= 500 Or Frm.Top < 0 Then Frm.Top = 0If Frm.Top >= Screen.Height - Frm.Height Or Frm.Top >= Screen.Height - Frm.Height - 500 Then Frm.Top = Screen.Height - Frm.HeightIf Frm.Left < 0 Or Frm.Left <= 500 Then Frm.Left = 0If Frm.Left >= Screen.Width - Frm.Width Or Frm.Left >= Screen.Width - Frm.Width - 500 Then Frm.Left = Screen.Width - Frm.Widthccc:End Sub'调用时只需在控件的MouseDown事件中加入“MoveWindow 窗体名”即可

将你平凡的控件变成XP样式（仅XP、2003以上系统可用）首先创建一个文件，文件名一定要是这样的格式：“EXE名.Manifest”，其中“EXE名”是你生成EXE后的文件名。如：你生成后的文件是“MyExe.exe”，则你先要在放有“MyExe.exe”文件的同一目录创建一文件“MyExe.exe.manifest”，里面写上以下内容：
WindowsExecutable
然后再在你的程序里面加入以下代码：Private Declare Sub InitCommonControls Lib "comctl32.dll" ()Private Sub Form_Initialize()InitCommonControlsEnd Sub这样你的控件就不再是VB6提供的平凡的模式，而是XP的样式！

模仿QQ信息到时在任务栏闪动Private Declare Function FlashWindow Lib "user32" (ByVal hWnd As Long, ByVal bInvert As Long) As LongPrivate Sub Timer1_Timer()If Me.WindowState = vbMinimized Then FlashWindow Me.hWnd, TrueElse FlashWindow Me.hWnd, FalseEnd IfEnd Sub