Fazla anlatmıcağım, Ekran cozunurluğunu bulup kendini sağ aşşagıya saatin uzerine alıyor. Ben cozunurluk değişince pozisyonunu kendi ayarlasın diye timera bagladım siz değiştirebilirsiniz.
Video :
http://www.youtube.com/embed/Ij9xsVPD0is
Alıntı:
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As RECT, ByVal fuWinIni As Long) As Long
Private Const SPI_GETWORKAREA = 48
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
'
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const PBM_SETBARCOLOR As Long = &H409
Private Const PBM_SETBKCOLOR As Long = &H2001
Private Const PROGBAR_DEF_COLOR = &HFF000000 '&H8000000D
Private Const RGN_OR = 2
Private m_Value As Single
Private Const BAR_HGT As Integer = 4
' Move to the lower right corner.
Private Sub Form_Load()
' Make the window's regions.
App.Title = ""
App.TaskVisible = False
' Move the form.
LowerRight Me
' Set scale so (0, 0) is in the lower left corner
' and (1, 100) is in the upper right.
End Sub
Private Sub MakeBarRegions()
Dim i As Integer
Dim all_rgn As Long
Dim new_rgn As Long
Dim all_rect As RECT
' Make the form 200 pixels tall.
Me.Height = ScaleY(200, vbPixels, vbTwips)
' Make the first rectanglular region.
all_rgn = CreateRectRgn(0, 0, Me.ScaleWidth, BAR_HGT)
' Make the other rectangular regions.
Me.ScaleMode = vbPixels
For i = BAR_HGT * 2 To Me.ScaleHeight Step BAR_HGT * 2
new_rgn = CreateRectRgn(0, i, Me.ScaleWidth, i + BAR_HGT)
CombineRgn all_rgn, all_rgn, new_rgn, RGN_OR
Next i
' Set the form's region.
SetWindowRgn Me.hwnd, all_rgn, True
End Sub
Private Sub DrawBar()
Me.Cls
Me.Line (0, 0)-(1, m_Value), vbBlue, BF
End Sub
' Move the form to the lower right corner
' taking the task bar into account.
Private Sub LowerRight(ByVal frm As Form)
Const GAP As Integer = 120
Dim wa_info As RECT
Dim wa_wid As Single
Dim wa_hgt As Single
Dim wa_left As Single
Dim wa_top As Single
If SystemParametersInfo(SPI_GETWORKAREA, 0, wa_info, 0) 0 Then
' We got the work area bounds.
' Position the form in the work area.
wa_wid = ScaleX(wa_info.Right, vbPixels, vbTwips)
wa_hgt = ScaleY(wa_info.Bottom, vbPixels, vbTwips)
wa_left = ScaleX(wa_info.Left, vbPixels, vbTwips)
wa_top = ScaleY(wa_info.Top, vbPixels, vbTwips)
Else
' We did not get the work area bounds.
' Position the form on the whole screen.
wa_wid = Screen.Width
wa_hgt = Screen.Height
End If
' Move the form.
frm.Move wa_left + wa_wid - Width - GAP, _
wa_top + wa_hgt - Height - GAP
End Sub
Private Sub Timer1_Timer()
LowerRight Me
End Sub
Private Sub Timer2_Timer()
Call SendMessageLong(pb1.hwnd, PBM_SETBARCOLOR, 0&, ByVal 49152) 'Red
pb1.Value = pb1 + 1
If pb1.Value = 100 Then
Timer2.Enabled = False
MsgBox "Coded By BuraK.anL ", vbInformation, "HackShield Pro"
End
End If
End Sub
__________________
Sağ aşşağı Ve Renkli Progress bar [ Hack shield tasarım ]
Programlama0 Mesaj
●24 Görüntüleme
- ReadBull.net
- Programlama ve Yazılım
- Programlama
- Sağ aşşağı Ve Renkli Progress bar [ Hack shield tasarım ]