Visual Basic Te Ekran Koruyu (Arkadaslar Benim İcin Cok Onemli Yardimlariniyi Bekliorum)

Tahribat.com Forumları
line

Visual Basic - Basic - PicBasic ve Türevleri
line

Visual Basic Te Ekran Koruyu (Arkadaslar Benim İcin Cok Onemli Yardimlariniyi Bekliorum)

26/Nis/09 15:33 Kısayol Şikayet Özel Mesaj

CANDOST06

Kayıt Tarihi: 27/Ocak/2006

arkadaslar bi ise girmem icin ekran koruyucu yapmami istediler bu konuda en ufak bir bilgim yok :( yarina kadar teslim etmem layim. bi tane hazir buldum ama sorun cikti bi yerinde :( yardimlariniyi bekliorum . Option Explicit
Private Const SPI_SCREENSAVERRUNNING = 97
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, IpvParam As Any, ByVal FuWinIni As Long) As Long
Dim metin, fontadi, handleno

Private Const GWL_STYLE = -16
Private Const GWL_HWNDPARENT = -8
Private Const WS_CHILD = &H40000000
Private Const HWND_TOPMOST = -1&
Private Const HWND_TOP = 0&
Private Const SWP_NOZERDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Declare Sub 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)
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByValhWndNewParent As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, IpRect As RECT) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Dim Disprec As RECT

Private Sub form_click()
Unload Me
End Sub

Private Sub Form_DplClick()
   Unload Me
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   Unload Me
End Sub

Private Sub Form_Load()
Timer1.Interval = 100
Timer1.Enabled = False
Timer2.Interval = 100
Timer2.Enabled = False
BorderStyle = 0 'Çerçevesiz form
WindowState = 2 'tam ekran
Caption = "" ' Başlıksız
If App.PrevInstance Then
   Unload Me
   Exit Sub
End If

'/s parametresi. Ekran Koruyucuyu Çalıştır
If Command = "/s" Then
   Timer1.Enabled = True
   'Ekran Koruyucunun Çalışmaya Başladığını Bildir
   SystemParametersInfo SPI_SCREENSAVERRUNNING, 1, ByVal 1&, False
   'formu en üstte tut
   SetWindowPos Form1.hwnd, -1, 0, 0, 0, 0, &H10 Or &H40 Or &H1 Or &H2
   End If

   '/c parametresi. Ayar penceresini göster
   If Left(Command, 2) = "/c" Then
     Form2.Show 'Ayar formunu göster
     Unload Me
   End If

   'p parametresi.Preview yap.
   If Left(Command, 2) = "/p" Then
     Dim yer
     yer = InStr(Command, " ") 'boşluğun yerini bul
     'Preview penceresinin Handle numarasını öğren
     handleno = Val(Mid(Command, yer + 1)) 'Boşlıktan sonraki değer
     Form1.Captiob = "Önizleme"
     Dim Style
     Style = GetWindowLong(Form1.hwnd, GWL_STYLE) 'Form stilini öğren
     Style = Style Or WS_CHILD 'Child özelliğini ver
     SetWindowLong Form1.hwnd, GWL_STYLE, Style 'Yeni özelliği aktif yap
     SetParent Form1.hwnd, handleno 'preview penceresini formumuza parent yap
     SetWindowLong Form1.hwnd, GWL_HWNDPARENT, handleno 'bu değişikliği etkinleştir
     GetClientRect handleno, Disprec 'Preview penceresinin boyutlarını al
     'formumuzu preview penceresine yerleştir.
     SetWindowPos Form1.hwnd, HWND_.Top, 0&, 0&, Disprec.Right, Disprec.Bottom, SWP_NOZERDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
     Timer1.Enable = True
     End If

     metin = GetSetting("BizimEkranKoruyucu", "Ayarlar", "metin", "Ceren SEMERCİ")
     fontadi = GetSettin("BizimEkranKoruyucu", "Ayarlar", "Font", "Times New Roman")
     End Sub

     Private Sub Form_MauseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
       Static ox, oy
       If ((ox = 0) And (oy = 0)) Or (Abs(ox - x) < 5 And (Abs(oy - y) < 5)) Then
       ox = x
       oy = y
       Exit Sub
      Else
       Unload Me
      End If
     End Sub

     Private Sub Form_Unload(cancel As Integer)
     'Ekran koruyucunun bittiğini bildir
     SystemParametersInfo SPI_SCREENSAVERRUNNING, 0, ByVal 1&, False
     End Sub

     Private Sub Timer1_Timer()
       FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
       FillStyle = 0
       Circle (Rnd * Width, Rnd * Height), Rnd * Width, RGB(Rnd * 255, Rnd * 255, Rnd * 255)
       FontName = fontadi
       FontSize = Rnd * 50 + 8
       Print metin
     End Sub

     Private Sub Timer2_Timer()
       Unload Me
     End Sub




End Sub

simdiden tesekkur ederim :)

Alıntı yap
26/Nis/09 16:10 Kısayol Şikayet Özel Mesaj

Lostok

Kayıt Tarihi: 11/Mart/2009

merak etiim ne işi bu yani ne üzerine

Alıntı yap

Toplam Hit: 2031 Toplam Mesaj: 2

Cevapla