Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Ekim 2006 Cuma

Eliptik UserForm




'UserForm1

Option Explicit
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim FormhWnd, EliptikHandle As Long
Dim i As Integer
Dim PauseTime, Start
Private Sub UserForm_Initialize()
    On Error Resume Next
    With Me
        .Width = 380
        .Height = 380
        .BackColor = VBA.RGB(0, 0, 255)
        .BorderStyle = fmBorderStyleNone
        .SpecialEffect = fmSpecialEffectFlat
        FormhWnd = FindWindowA(vbNullString, .Caption)
        EliptikHandle = CreateEllipticRgn(110, 100, .Width, .Height)
    End With
    Call SetWindowRgn(FormhWnd, EliptikHandle, True)
End Sub
Private Sub UserForm_Activate()

    On Error Resume Next
    Application.StatusBar = " PBİD ®"
    Call UserForm_Layout
End Sub
Private Sub UserForm_Layout()

    On Error Resume Next
    PauseTime = 1
    Start = VBA.Timer
    Do While ((Start + PauseTime) > VBA.Timer)
        VBA.DoEvents
    Loop
    For i = 1 To 380
        With Me
            .Top = .Top - 1
            .Left = .Left - 1
            .Height = .Height - 1
            .Width = .Width - 1
            .Repaint
        End With
    Next i
    With Me
        .Height = 320
        .Width = 320
        .StartUpPosition = 2
    End With
    Unload Me
    Application.StatusBar = False
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul