2 sayfadan 1. sayfa

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 02 Tem 2008 17:19
Tarkan VURAL
Benim çok beğendiğim bir efekt aslında.

Kodları UserForm' unuzun kod sayfasına ekleyin ve formu çalıştırın.

Kod: Tümünü seç
Private Declare Function GetActiveWindow Lib "USER32" () As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "USER32" _
(ByVal hWnd As Long, _
ByVal crKey As Integer, _
ByVal bAlpha As Integer, _
ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hWnd            As Long
Dim Transparancy    As Integer
Dim Running         As Boolean

Kod: Tümünü seç
Private Sub UserForm_Activate()
    Running = True
    Call Transparency
End Sub

Kod: Tümünü seç
Private Sub Transparency()
    Dim MyTimer         As Double
    DoEvents
    MyTimer = Timer
    Do
        Do
        Loop While Timer - MyTimer < 0.07
        MyTimer = Timer
        Transparancy = Transparancy - 1
        If Transparancy < 0 Then
            Unload Me
        Else
            Call SemiTransparent(Application.WorksheetFunction.Min(Transparancy, 100))
        End If
        DoEvents
    Loop While Running
End Sub


Kod: Tümünü seç
Private Sub SemiTransparent(ByVal intLevel As Integer)
    Dim lngWinIdx       As Long
    hWnd = GetActiveWindow
    lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
    SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, 0, (255 * intLevel) / 100, LWA_ALPHA
End Sub

Kod: Tümünü seç
Private Sub UserForm_Initialize()
    Transparancy = 120
    Call SemiTransparent(100)
    DoEvents
End Sub


Kod: Tümünü seç
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Running = False
End Sub

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 31 Ağu 2008 12:58
wipex
Güzel efekt Ama Yan Etki Yaptı Galiba Bende Ecxel Yavaşca Silinerek Kayboluyor

Güzel Çalışma Sağol Dostum.

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 31 Ağu 2008 16:27
Tarkan VURAL
Kodları Excel'de WorkBook open olayına yazarsanız uyggulamanız kodlara göre silinip kaybolur. Bu kodu UserForm kod sayfasına yazmanızı tavsiye ediyorum.

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 18 Eyl 2008 10:08
hsayar
Sn. Tarkan Vural, Userformun x saniye sonra kaybolmasını istersek ne gibi değişklikler yapılması gerekir?
60 ve 90 saniye için örenk verirmisiniz.

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 18 Eyl 2008 12:04
Tarkan VURAL
Kod: Tümünü seç
Private Sub UserForm_Activate()
Application.Wait Now + TimeValue("00:00:03")
Unload Me
End Sub


Userformunuzu açtıktan 3 saniye sonra kapatacaktır.

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 18 Eyl 2008 13:44
hsayar
Kod: Tümünü seç
Private Sub UserForm_Initialize()
    Transparancy = 120
    Call SemiTransparent(100)
    DoEvents
End Sub


Hocam dbu kodlardaki 120 ve 100 değerlerinin işlevleri nedir?

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 18 Eyl 2008 14:14
Tarkan VURAL
hsayar yazdı:
Kod: Tümünü seç
Private Sub UserForm_Initialize()
    Transparancy = 120
    Call SemiTransparent(100)
    DoEvents
End Sub


Hocam dbu kodlardaki 120 ve 100 değerlerinin işlevleri nedir?


Görünürlük başlangıç değerleri ile geri sayımda şeffaflık oluşturan sayacın değerleri. Rakamları değiştirerek farklarını anlayabilirsiniz.

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 18 Eyl 2008 14:37
eriliz
harikaa

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 18 Eyl 2008 16:43
Erhan Yavuz
Aramıza hoşgeldiniz Sn. eriliz; merak ettiğiniz hertürlü Excel sorusunu sorabilirsiniz...

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 23 Ekm 2008 16:28
hsayar
Denemeye fırsatım olmadı bu kodları userformun kapanışında çalıştırmak istersek ne yapmalı?
Kapat tuşuna bastık 5 sn içinde kaybolacak.

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 23 Ekm 2008 16:31
Tarkan VURAL
Açılıştaki kodlamayı butonunuza atayıp deneyiniz.

Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 12 Kas 2008 14:12
MAJUHOO
Sn Tarkan bey bu süper bişey. Çok güzel gerçekten elinize sağlık.

Cevap: Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 23 Ekm 2009 13:58
apartura
Merhaba Tarkan Bey,
Bu seferde bu forumda yakaladım sizi:) Google'dan fazla kullanır olduk bu sayfayı sayenizde.
Benim sorum asagidaki kodlari userform code sayfasına direkt kopyalarsak calisir mi?
Yani ben forum sayfasindaki ekleyin dediğiniz 6 farkli pencereyi tek tek tümünü seç diyerek code sayfasına yapıştırdım. Ama user form efekt kazanmadi, sorun nedir sizce?

SAYGILARIMLA

Tarkan VURAL yazdı:Benim çok beğendiğim bir efekt aslında.
Kodları UserForm' unuzun kod sayfasına ekleyin ve formu çalıştırın.

Kod: Tümünü seç
Private Declare Function GetActiveWindow Lib "USER32" () As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "USER32" _
(ByVal hWnd As Long, _
ByVal crKey As Integer, _
ByVal bAlpha As Integer, _
ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hWnd            As Long
Dim Transparancy    As Integer
Dim Running         As Boolean

Kod: Tümünü seç
Private Sub UserForm_Activate()
    Running = True
    Call Transparency
End Sub

Kod: Tümünü seç
Private Sub Transparency()
    Dim MyTimer         As Double
    DoEvents
    MyTimer = Timer
    Do
        Do
        Loop While Timer - MyTimer < 0.07
        MyTimer = Timer
        Transparancy = Transparancy - 1
        If Transparancy < 0 Then
            Unload Me
        Else
            Call SemiTransparent(Application.WorksheetFunction.Min(Transparancy, 100))
        End If
        DoEvents
    Loop While Running
End Sub


Kod: Tümünü seç
Private Sub SemiTransparent(ByVal intLevel As Integer)
    Dim lngWinIdx       As Long
    hWnd = GetActiveWindow
    lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
    SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, 0, (255 * intLevel) / 100, LWA_ALPHA
End Sub

Kod: Tümünü seç
Private Sub UserForm_Initialize()
    Transparancy = 120
    Call SemiTransparent(100)
    DoEvents
End Sub


Kod: Tümünü seç
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Running = False
End Sub

Cevap: Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 23 Ekm 2009 14:52
Tarkan VURAL
Bende denediğimde sorun olmuyor. [ilginc]

Cevap: Cevap: Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 23 Ekm 2009 15:17
apartura
Şimdi oldu, müthişş. Ellerinize sağlık.

Tarkan VURAL yazdı:Bende denediğimde sorun olmuyor. [ilginc]

Cevap: Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 26 Oca 2010 18:22
bdilekci
Sayın Üstadlarım,
Ben denedim fakat farklı bir sonuca ulaştım.Kod sayfasına kodları yerleştirdim.Daha sonra programı çalıştırdığımda ise programı kullanamadan program saydamlaşıyor maalesef.Benim düşündüğüm ise programı kapatınca saydamlaşarak kapanması.Bu konuda yardımcı olabilirmisiniz?

Cevap: Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 27 Oca 2010 11:08
Tarkan VURAL
UserForm1 kod sayfasına şu şekilde yazın ve çarpı tuşuna basıp inceleyin.

Kod: Tümünü seç
Private Declare Function GetActiveWindow Lib "USER32" () As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "USER32" _
(ByVal hWnd As Long, _
ByVal crKey As Integer, _
ByVal bAlpha As Integer, _
ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hWnd            As Long
Dim Transparancy    As Integer
Dim Running         As Boolean

Private Sub Transparency()
    Dim MyTimer         As Double
    DoEvents
    MyTimer = Timer
    Do
        Do
        Loop While Timer - MyTimer < 0.05
        MyTimer = Timer
        Transparancy = Transparancy - 1
        If Transparancy < 0 Then
            Unload Me
        Else
            Call SemiTransparent(Application.WorksheetFunction.Min(Transparancy, 100))
        End If
        DoEvents
    Loop While Transparancy > 0
        Running = False
    End
End Sub

Private Sub SemiTransparent(ByVal intLevel As Integer)
    Dim lngWinIdx       As Long
    hWnd = GetActiveWindow
    lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
    SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, 0, (255 * intLevel) / 100, LWA_ALPHA
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Transparancy = 120
    Call SemiTransparent(100)
    DoEvents
    Running = True
    Call Transparency
End Sub

Cevap: Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 27 Oca 2010 21:59
bdilekci
Tarkan Bey,çok teşekkürler.

Cevap: Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 10 Ekm 2010 18:16
Fethi34
Bir örnekte ben eklemek istedim.

Kod: Tümünü seç
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, _
        ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags 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 FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
        ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2


Kod: Tümünü seç
Private Sub CommandButton1_Click()
        Dim xl As Long
        hWndForm = FindWindow("ThunderDFrame", Me.Caption)
        Dim rtn As Long
        rtn = GetWindowLong(hWndForm, GWL_EXSTYLE)
        rtn = rtn Or WS_EX_LAYERED
        SetWindowLong hWndForm, GWL_EXSTYLE, rtn
        For i = 255 To 0 Step -5
            SetLayeredWindowAttributes hWndForm, 0, i, LWA_ALPHA
            Sleep 20
            DoEvents
            DrawMenuBar hWndForm
            SetFocus hWndForm
        Next i
        Unload Me
        MsgBox "Kapandı", vbCritical, "ExcelVBA.Net"
End Sub

Cevap: Yavaşça Silinerek Kaybolan Transparan UserForm

İletiTarih: 21 Ekm 2010 00:54
Murat OSMA
Poyraz, senin kodları kullanarak formlar arasında geçişi denedim güzel oldu.