• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Một số cách đóng ứng dụng ngộ nghĩnh

Các thủ thuật liên quan đến việc xử lý ứng dụng, biểu mẫu và control
Hình đại diện của người dùng
clarkkent
Mạnh Thường Quân
Mạnh Thường Quân
Bài viết: 1641
Ngày tham gia: T.Tư 16/04/2008 11:25 am
Đến từ: Chợ Lách - Bến Tre
Been thanked: 31 time
Liên hệ:

Một số cách đóng ứng dụng ngộ nghĩnh

Gửi bàigửi bởi clarkkent » T.Bảy 07/06/2008 3:14 pm

Thủ thuật: Một số cách đóng ứng dụng ngộ nghĩnh
Tác giả: Siêu nhân
Mô tả: Một số cách đóng ứng dụng ngộ nghĩnh... :D


I

Mã: Chọn hết

  1. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2. Top = (Screen.Height - Width) / 1
  3.     Left = (Screen.Width - Height) / 2
  4.     Top = (Screen.Height - Width) / 3
  5.     Left = (Screen.Width - Height) / 4
  6.     Top = (Screen.Height - Width) / 5
  7.     Left = (Screen.Width - Height) / 6
  8.     Top = (Screen.Height - Width) / 7
  9.     Left = (Screen.Width - Height) / 8
  10.     Top = (Screen.Height - Width) / 9
  11.     Top = (Screen.Height - Width) / 10
  12.     Left = (Screen.Width - Height) / 12
  13.     Top = (Screen.Height - Width) / 13
  14.     Left = (Screen.Width - Height) / 14
  15.     Top = (Screen.Height - Width) / 15
  16.     Left = (Screen.Width - Height) / 16
  17.     Top = (Screen.Height - Width) / 17
  18.     Left = (Screen.Width - Height) / 18
  19.     Top = (Screen.Height - Width) / 19
  20.     Left = (Screen.Width - Height) / 20
  21.     Top = (Screen.Height - Width) / 21
  22.     Left = (Screen.Width - Height) / 22
  23.     Top = (Screen.Height - Width) / 23
  24.     Left = (Screen.Width - Height) / 24
  25.     Top = (Screen.Height - Width) / 25
  26.     Left = (Screen.Width - Height) / 26
  27.     Top = (Screen.Height - Width) / 27
  28.     Left = (Screen.Width - Height) / 28
  29.     Top = (Screen.Height - Width) / 29
  30.     Left = (Screen.Width - Height) / 30
  31.     Top = (Screen.Height - Width) / 31
  32.     Left = (Screen.Width - Height) / 32
  33.     Top = (Screen.Height - Width) / 31
  34.     Top = (Screen.Height - Width) / 30
  35.     Left = (Screen.Width - Height) / 29
  36.     Top = (Screen.Height - Width) / 28
  37.     Left = (Screen.Width - Height) / 27
  38.     Top = (Screen.Height - Width) / 26
  39.     Left = (Screen.Width - Height) / 25
  40.     Top = (Screen.Height - Width) / 24
  41.     Left = (Screen.Width - Height) / 23
  42.     Top = (Screen.Height - Width) / 22
  43.     Top = (Screen.Height - Width) / 21
  44.     Left = (Screen.Width - Height) / 20
  45.     Top = (Screen.Height - Width) / 19
  46.     Left = (Screen.Width - Height) / 18
  47.     Top = (Screen.Height - Width) / 17
  48.     Left = (Screen.Width - Height) / 16
  49.     Top = (Screen.Height - Width) / 15
  50.     Left = (Screen.Width - Height) / 14
  51.     Top = (Screen.Height - Width) / 13
  52.     Left = (Screen.Width - Height) / 12
  53.     Top = (Screen.Height - Width) / 11
  54.     Left = (Screen.Width - Height) / 10
  55.     Top = (Screen.Height - Width) / 9
  56.     Left = (Screen.Width - Height) / 8
  57.     Top = (Screen.Height - Width) / 7
  58.     Left = (Screen.Width - Height) / 6
  59.     Top = (Screen.Height - Width) / 5
  60.     Left = (Screen.Width - Height) / 4
  61.     Top = (Screen.Height - Width) / 3
  62.     Left = (Screen.Width - Height) / 2
  63.     Top = (Screen.Width + Height) / 2
  64.     Left = (Screen.Height + Width) / 3
  65.     Top = (Screen.Width + Height) / 4
  66.     Left = (Screen.Height + Width) / 5
  67.     Top = (Screen.Width + Height) / 6
  68.     Left = (Screen.Height + Width) / 7
  69.     Top = (Screen.Width + Height) / 8
  70.     Left = (Screen.Height + Width) / 9
  71.     Top = (Screen.Width + Height) / 10
  72.     Left = (Screen.Height + Width) / 11
  73.     Top = (Screen.Width + Height) / 12
  74.     Left = (Screen.Height + Width) / 13
  75.     Top = (Screen.Width + Height) / 14
  76.     Left = (Screen.Height + Width) / 15
  77.     Top = (Screen.Width + Height) / 16
  78.     Left = (Screen.Height + Width) / 17
  79.     Top = (Screen.Width + Height) / 18
  80.     Left = (Screen.Height + Width) / 19
  81.     Top = (Screen.Width + Height) / 20
  82.     Left = (Screen.Height + Width) / 21
  83.     Top = (Screen.Width + Height) / 22
  84.     Left = (Screen.Height + Width) / 23
  85.     Top = (Screen.Width + Height) / 24
  86.     Left = (Screen.Height + Width) / 25
  87.     Top = (Screen.Width + Height) / 26
  88.     Left = (Screen.Height + Width) / 27
  89.     Top = (Screen.Width + Height) / 28
  90.     Left = (Screen.Height + Width) / 29
  91.     Top = (Screen.Width + Height) / 30
  92.     Left = (Screen.Height + Width) / 31
  93.     Top = (Screen.Width + Height) / 32
  94.     Left = (Screen.Height + Left) / 31
  95.     Top = (Screen.Width + Top) / 30
  96.     Left = (Screen.Height + Left) / 29
  97.     Top = (Screen.Width + Top) / 28
  98.     Left = (Screen.Height + Left) / 27
  99.     Top = (Screen.Width + Top) / 26
  100.     Left = (Screen.Height + Left) / 25
  101.     Top = (Screen.Width + Top) / 24
  102.     Left = (Screen.Height + Left) / 23
  103.     Top = (Screen.Width + Top) / 22
  104.     Left = (Screen.Height + Left) / 21
  105.     Top = (Screen.Width + Top) / 20
  106.     Left = (Screen.Height + Left) / 19
  107.     Top = (Screen.Width + Top) / 18
  108.     Left = (Screen.Height + Left) / 17
  109.     Top = (Screen.Width + Top) / 16
  110.     Left = (Screen.Height + Left) / 15
  111.     Top = (Screen.Width + Top) / 14
  112.     Left = (Screen.Height + Left) / 13
  113.     Top = (Screen.Width + Top) / 12
  114.     Left = (Screen.Height + Left) / 11
  115.     Top = (Screen.Width + Top) / 10
  116.     Left = (Screen.Height + Left) / 9
  117.     Top = (Screen.Width + Top) / 8
  118.     Left = (Screen.Height + Left) / 7
  119.     Top = (Screen.Width + Top) / 6
  120.     Left = (Screen.Height + Left) / 5
  121.     Top = (Screen.Width + Top) / 4
  122.     Left = (Screen.Height + Left) / 3
  123.     Top = (Screen.Width + Top) / 2
  124.     Left = (Screen.Height + Left) / 1
  125.     End


II

Mã: Chọn hết

  1. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2.     If Button = vbLeftButton Then
  3.         coolCloseForm Me, 20
  4.     Else
  5.         Dim a As New Form1
  6.         a.Height = a.Height / 2
  7.         a.Width = a.Width / 2
  8.         a.Show
  9.     End If
  10. End Sub
  11. Public Function coolCloseForm(closeForm As Form, speed As Integer)
  12.        If speed = 0 Then
  13.         MsgBox "Speed cannot zero"
  14.         Exit Function
  15.     End If
  16.        On Error Resume Next
  17.             closeForm.ScaleMode = 1
  18.             closeForm.WindowState = 0
  19.         Do Until closeForm.Height <= 405
  20.         DoEvents
  21.             closeForm.Height = closeForm.Height - speed * 10
  22.             closeForm.Top = closeForm.Top + speed * 5
  23.         Loop
  24.            
  25.         Do Until closeForm.Width <= 1680
  26.         DoEvents
  27.             closeForm.Width = closeForm.Width - speed * 10
  28.             closeForm.Left = closeForm.Left + speed * 5
  29.         Loop
  30.             Unload closeForm
  31. End Function
  32.  


III

Mã: Chọn hết

  1. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2.     On Error Resume Next
  3.     Me.WindowState = 0
  4.     Do
  5.         Me.Top = Me.Top + 10
  6.         Me.Left = Me.Left + 10
  7.         Me.Width = Me.Width - 20
  8.         Me.Height = Me.Height - 20
  9.     Loop Until Me.Top >= Screen.Height
  10.     End
  11. End Sub


IV
Thêm 1 Timer

Mã: Chọn hết

  1. Private Sub Form_Load()
  2.     Timer1.Interval = 25
  3.     Timer1.Enabled = False
  4. End Sub
  5.  
  6. Private Sub Timer1_Timer()
  7.     On Error Resume Next
  8.     Form1.Width = Form1.Width - 200
  9.         Form1.Left = Form1.Left + 100
  10.             Form1.Height = Form1.Height - 200
  11.                 Form1.Top = Form1.Top + 100
  12.                     If Form1.Width < 150 And Form1.Height < 150 Then
  13.                          End
  14.                     End If
  15.                 End Sub
  16.  
  17. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  18.     Timer1.Enabled = True
  19. End Sub


Vâng ! Cám ơn bác TrungDung1977

V
Module

Mã: Chọn hết

  1. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  2. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  3. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  4. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  5. Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  6. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  7. Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
  8. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  9. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  10. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  11. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  12. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  13. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  14. Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
  15. Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
  16. Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
  17. Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
  18. Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
  19. 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
  20. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  21. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  22. Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  23. Public 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
  24. Private Type PALETTEENTRY
  25.     peRed As Byte
  26.     peGreen As Byte
  27.     peBlue As Byte
  28.     peFlags As Byte
  29. End Type
  30. Private Type LOGPALETTE
  31.     palVersion As Integer
  32.     palNumEntries As Integer
  33.     palPalEntry(255) As PALETTEENTRY
  34. End Type
  35. Private Type PicBmp
  36.     Size As Long
  37.     Type As Long
  38.     hBmp As Long
  39.     hPal As Long
  40.     Reserved As Long
  41. End Type
  42. Private Type GUID
  43.     Data1 As Long
  44.     Data2 As Integer
  45.     Data3 As Integer
  46.     Data4(7) As Byte
  47. End Type
  48.  
  49. Private Const RASTERCAPS As Long = 38
  50. Private Const RC_PALETTE As Long = &H100
  51. Private Const SIZEPALETTE As Long = 104
  52. Private Const HWND_TOPMOST = -1
  53. Private Const SWP_NOMOVE = &H2
  54. Private Const SWP_NOSIZE = &H1
  55. Private Const flags = SWP_NOMOVE Or SWP_NOSIZE
  56. Private Const GWL_EXSTYLE = (-20)
  57. Private Const WS_EX_LAYERED = &H80000
  58. Private Const WS_EX_TRANSPARENT = &H20&
  59. Private Const LWA_ALPHA = &H2&
  60.  
  61. Global Frm(1 To 12) As FrmCoolClose
  62. Global Frm2(1 To 12) As FrmCoolClose
  63.  
  64. Private Sub HideForm(TheFrm As Form)
  65.     Const RGN_DIFF = 4
  66.     Const RGN_OR = 2
  67.     Dim outer_rgn As Long
  68.     Dim inner_rgn As Long
  69.     Dim wid As Single
  70.     Dim hgt As Single
  71.     Dim border_width As Single
  72.     Dim title_height As Single
  73.     Dim ctl_left As Single
  74.     Dim ctl_top As Single
  75.     Dim ctl_right As Single
  76.     Dim ctl_bottom As Single
  77.     Dim control_rgn As Long
  78.     Dim combined_rgn As Long
  79.     Dim ctl As Control
  80.     If TheFrm.WindowState = vbMinimized Then Exit Sub
  81.     wid = TheFrm.ScaleX(TheFrm.Width, vbTwips, vbPixels)
  82.     hgt = TheFrm.ScaleY(TheFrm.Height, vbTwips, vbPixels)
  83.     outer_rgn = CreateRectRgn(0, 0, wid, hgt)
  84.     border_width = (wid - TheFrm.ScaleWidth) / 2
  85.     title_height = hgt - border_width - TheFrm.ScaleHeight
  86.     inner_rgn = CreateRectRgn( _
  87.     border_width, _
  88.     title_height, _
  89.     wid - border_width, _
  90.     hgt - border_width)
  91.     combined_rgn = CreateRectRgn(0, 0, 0, 0)
  92.     CombineRgn combined_rgn, outer_rgn, _
  93.     inner_rgn, RGN_DIFF
  94.     SetWindowRgn TheFrm.hwnd, combined_rgn, True
  95. End Sub
  96. Public Sub TransForm(TheForm As Form, TheAlpha As Byte)
  97.     Dim NormalWindowStyle As Long
  98.     Dim HWD As Long
  99.     NormalWindowStyle = GetWindowLong(HWD, GWL_EXSTYLE)
  100.     SetWindowLong TheForm.hwnd, GWL_EXSTYLE, NormalWindowStyle Or WS_EX_LAYERED
  101.     SetLayeredWindowAttributes TheForm.hwnd, 0, TheAlpha, LWA_ALPHA
  102. End Sub
  103.  
  104. Public Function DoCoolClose(TargetForm As Form)
  105.     TargetForm.Show
  106.     Dim TW As Long
  107.     Dim TL As Long
  108.     TW = TargetForm.Width / 4
  109.     TL = TargetForm.Height / 4
  110.     For i = 1 To 12
  111.         DoEvents
  112.         Set Frm(i) = New FrmCoolClose
  113.         Frm(i).Show
  114.         Frm(i).Width = TW
  115.         Frm(i).Height = TW
  116.         If i = 1 Then
  117.             Frm(i).Top = TargetForm.Top
  118.             Frm(i).Left = TargetForm.Left
  119.         Else
  120.             If i = 2 Or i = 3 Or i = 4 Then
  121.                 Frm(i).Top = TargetForm.Top
  122.             End If
  123.             If i = 5 Or i = 6 Or i = 7 Or i = 8 Then
  124.                 Frm(i).Top = (Frm(1).Top + Frm(1).Height)
  125.             End If
  126.             If i = 9 Or i = 10 Or i = 11 Or i = 12 Then
  127.                 Frm(i).Top = (Frm(1).Top + (Frm(1).Height * 2))
  128.             End If
  129.             If i = 1 Or i = 5 Or i = 9 Then
  130.                 Frm(i).Left = TargetForm.Left
  131.             Else
  132.                 Frm(i).Left = (Frm(i - 1).Left + TW)
  133.             End If
  134.         End If
  135.         Frm(i).Refresh
  136.         Frm(i).Show
  137.         StayOnTop Frm(i)
  138.         HideForm Frm(i)
  139.         Frm(i).Refresh
  140.     Next i
  141.  
  142.     For i = 1 To 12
  143.         DoEvents
  144.         Set Frm2(i) = New FrmCoolClose
  145.         Frm2(i).Width = TW
  146.         Frm2(i).Height = TW
  147.         If i = 1 Then
  148.             Frm2(i).Top = TargetForm.Top
  149.             Frm2(i).Left = TargetForm.Left
  150.         Else
  151.             If i = 2 Or i = 3 Or i = 4 Then
  152.                 Frm2(i).Top = TargetForm.Top
  153.             End If
  154.             If i = 5 Or i = 6 Or i = 7 Or i = 8 Then
  155.                 Frm2(i).Top = (Frm2(1).Top + Frm2(1).Height)
  156.             End If
  157.             If i = 9 Or i = 10 Or i = 11 Or i = 12 Then
  158.                 Frm2(i).Top = (Frm2(1).Top + (Frm2(1).Height * 2))
  159.             End If
  160.             If i = 1 Or i = 5 Or i = 9 Then
  161.                 Frm2(i).Left = TargetForm.Left
  162.             Else
  163.                 Frm2(i).Left = (Frm2(i - 1).Left + TW)
  164.             End If
  165.         End If
  166.         Set Frm2(i).Picture = CaptureForm(Frm(i))
  167.         StayOnTop Frm2(i)
  168.         Frm2(i).Refresh
  169.     Next i
  170.    
  171.     For i = 1 To 12
  172.         DoEvents
  173.         Frm2(i).Show
  174.     Next i
  175.    
  176.  
  177.    
  178.     Unload TargetForm
  179.     TI = 1
  180.     For i = 1 To 12
  181.         Frm2(i).Timer1.Interval = TI
  182.         Frm2(i).Timer2.Enabled = True
  183.         Frm2(i).Tag = i
  184.         TI = TI + 10
  185.     Next i
  186. End Function
  187.  
  188. Public Function GetRandomNumber(StartNumber As Integer, EndNumber As Integer) As Integer
  189.     Randomize Timer
  190.     GetRandomNumber = Int(Rnd * (EndNumber - StartNumber)) + StartNumber
  191. End Function
  192.  
  193. Private Function CaptureForm(TheForm As Form) As Picture
  194.     Set CaptureForm = CaptureWindow(TheForm.hwnd, False, 0, 0, TheForm.ScaleX(TheForm.Width, vbTwips, vbPixels), TheForm.ScaleY(TheForm.Height, vbTwips, vbPixels))
  195. End Function
  196.  
  197. Private Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
  198.     Dim hDCMemory As Long
  199.     Dim hBmp As Long
  200.     Dim hBmpPrev As Long
  201.     Dim hDCSrc As Long
  202.     Dim hPal As Long
  203.     Dim hPalPrev As Long
  204.     Dim RasterCapsScrn As Long
  205.     Dim HasPaletteScrn As Long
  206.     Dim PaletteSizeScrn As Long
  207.     Dim LogPal As LOGPALETTE
  208.     If Client Then
  209.         hDCSrc = GetDC(hWndSrc)
  210.     Else
  211.         hDCSrc = GetWindowDC(hWndSrc)
  212.     End If
  213.     hDCMemory = CreateCompatibleDC(hDCSrc)
  214.     hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
  215.     hBmpPrev = SelectObject(hDCMemory, hBmp)
  216.     RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
  217.     HasPaletteScrn = RasterCapsScrn And RC_PALETTE
  218.     PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
  219.     If HasPaletteScrn And (PaletteSizeScrn = 256) Then
  220.         LogPal.palVersion = &H300
  221.         LogPal.palNumEntries = 256
  222.         r = GetSystemPaletteEntries(hDCSrc, 0, 256, _
  223.         LogPal.palPalEntry(0))
  224.         hPal = CreatePalette(LogPal)
  225.         hPalPrev = SelectPalette(hDCMemory, hPal, 0)
  226.         r = RealizePalette(hDCMemory)
  227.     End If
  228.     Call BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, _
  229.     LeftSrc, TopSrc, vbSrcCopy)
  230.     hBmp = SelectObject(hDCMemory, hBmpPrev)
  231.     If HasPaletteScrn And (PaletteSizeScrn = 256) Then
  232.         hPal = SelectPalette(hDCMemory, hPalPrev, 0)
  233.     End If
  234.     Call DeleteDC(hDCMemory)
  235.     Call ReleaseDC(hWndSrc, hDCSrc)
  236.     Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
  237. End Function
  238.  
  239. Private Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
  240.     Dim Pic As PicBmp
  241.     Dim IPic As IPicture
  242.     Dim IID_IDispatch As GUID
  243.     With IID_IDispatch
  244.         .Data1 = &H20400
  245.         .Data4(0) = &HC0
  246.         .Data4(7) = &H46
  247.     End With
  248.     With Pic
  249.         .Size = Len(Pic)
  250.         .Type = vbPicTypeBitmap
  251.         .hBmp = hBmp
  252.         .hPal = hPal
  253.     End With
  254.     Call OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
  255.     Set CreateBitmapPicture = IPic
  256. End Function
  257. Private Sub StayOnTop(the As Form)
  258. Dim SetWinOnTop
  259. SetWinOnTop = SetWindowPos(the.hwnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
  260. End Sub
  261.  


Form với 2 Timer : Timer2, Timer2

Mã: Chọn hết

  1. Dim TheA As Byte
  2. Dim TheL As Long
  3. Dim TheT As Long
  4. Dim TheDimAmt As Long
  5.  
  6. Private Sub Form_Load()
  7.     TheDimAmt = GetRandomNumber(5, 20)
  8.     TheL = GetRandomNumber(-200, 200)
  9.     TheT = GetRandomNumber(-200, 200)
  10.     TheA = 255
  11. End Sub
  12.  
  13. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  14. DoCoolClose Me
  15. End Sub
  16.  
  17. Private Sub Timer1_Timer()
  18.     DoEvents
  19.     Dim TMPL As Long
  20.     TransForm Me, TheA
  21.     TMPL = TheA - TheDimAmt
  22.     Me.Top = Me.Top + TheT
  23.     Me.Left = Me.Left + TheL
  24.     If TMPL <= 0 Then
  25.         Me.Timer1.Enabled = False
  26.         DoCLose
  27.     Else
  28.         TheA = TMPL
  29.     End If
  30. End Sub
  31.  
  32. Private Sub Timer2_Timer()
  33.     Me.Timer1.Enabled = True
  34.     Me.Timer2.Enabled = False
  35. End Sub
  36.  
  37.  
  38. Private Sub DoCLose()
  39.     For i = 1 To 12
  40.         If i <> Me.Tag Then
  41.             If Frm2(i).Visible = True Then
  42.                 Unload Me
  43.                 Exit Sub
  44.             End If
  45.         End If
  46.     Next i
  47.     End
  48. End Sub
  49.  


VI
Form nhảy múa trên TaskBar trước khi thoát... :D

Mã: Chọn hết

  1. Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  2. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  3. Private Type RECT
  4.     Left As Long
  5.     Top As Long
  6.     Right As Long
  7.     Bottom As Long
  8.     End Type
  9.     Dim What As RECT
  10.  
  11. Private Sub Form_Unload(Cancel As Integer)
  12.     If Me.WindowState <> 0 Then
  13.         Me.WindowState = 0
  14.     End If
  15.     Cancel = -1
  16.     Dim HeightOfStartMenu As Long
  17.     Dim Speed As Long
  18.     Dim StartAt As Long
  19.  
  20.     For I = 1 To 999
  21.         z$ = Space$(128)
  22.         Y = GetClassName(I, z$, 128)
  23.         X = Left$(z$, Y)
  24.         If LCase(X) = "shell_traywnd" Then
  25.             GoTo JumpOut:
  26.         End If
  27.     Next I
  28. JumpOut:
  29.     GetWindowRect I, What
  30.    
  31.     HeightOfStartMenu = What.Top * 15
  32.  
  33.     If HeightOfStartMenu <= 0 Then
  34.         HeightOfStartMenu = Screen.Height
  35.     End If
  36.     StartAt = HeightOfStartMenu - 4000
  37.     If StartAt < Me.Top Then
  38.         StartAt = Me.Top
  39.     End If
  40.     Speed = 100
  41.     Me.Height = 0
  42.     Me.Width = 4000
  43. GoAgain:
  44.     Do Until Me.Top >= HeightOfStartMenu
  45.         DoEvents
  46.             Me.Top = Me.Top + Speed
  47.             Me.Left = Me.Left + 15
  48.         Loop
  49.         Do Until Me.Top <= StartAt
  50.             DoEvents
  51.                 Me.Top = Me.Top - Speed
  52.                 Me.Left = Me.Left + 15
  53.             Loop
  54.             If StartAt >= 10000 And Me.Top >= HeightOfStartMenu Then
  55.                 Do Until Me.Top >= HeightOfStartMenu + 15000
  56.                     Me.Top = Me.Top + Speed
  57.                 Loop
  58.                 End
  59.                 Exit Sub
  60.             End If
  61.             StartAt = StartAt + 1000
  62.             Speed = Speed - 5
  63.             If Speed <= 0 Then
  64.                 Speed = 5
  65.                
  66.             End If
  67.             GoTo GoAgain:
  68.         End Sub
  69.  
Sửa lần cuối bởi clarkkent vào ngày T.Bảy 07/06/2008 3:28 pm với 1 lần sửa.


• Hôm bây: www.tinsoftware.com ^ ^
Cố gắng lên...

TrungDung1977
Thành viên chính thức
Thành viên chính thức
Bài viết: 44
Ngày tham gia: T.Ba 15/08/2006 11:19 pm
Đến từ: TPHCM

Re: Một số cách đóng ứng dụng ngộ nghĩnh

Gửi bàigửi bởi TrungDung1977 » T.Bảy 07/06/2008 3:58 pm

Qua cách số 1 thì tui thấy rằng máy tính của bạn phải là máy cùi bắp lắm :) (thì mới kịp thấy hiệu ứng của nó)

Tui phải chèn thêm mấy chục cái Sleep 200 mới thấy được cái gì diễn ra.
Cách 2 ,3 tạm được

alicias21
Bài viết: 1
Ngày tham gia: T.Năm 17/05/2012 2:53 pm
Has thanked: 1 time

Re: Một số cách đóng ứng dụng ngộ nghĩnh

Gửi bàigửi bởi alicias21 » T.Năm 17/05/2012 2:57 pm

mấy bạn ơi, cái screen.height và screen.width sao mình dùng ko dc
nó báo lỗi height với width ko có trong system.windows.forms.screen

p/s: mình đang dùng ado.net
ko chỉ bài này, mà bài nào mình sử dụng nó cũng đều báo thiếu này thiếu nọ cả
sr, mình mới học vb thôi _ _!


Quay về “[VB] Ứng dụng - Form và Control”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.2 khách