Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Ağustos 2005 Pazartesi

Resizable DialogSheet And DialogFrame



'Module1

Option Explicit
Public Resimlik As New Image
Public ÖrnekDS As DialogSheet
Dim Ekran As New Class1

Sub DialogSheet_Open()
On Error Resume Next
Set Resimlik.Picture = LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\MSN.ico")
Application.DisplayAlerts = False
DialogSheets.Add
Set ÖrnekDS = ThisWorkbook.ActiveSheet
With ÖrnekDS
.Name = "ÖrnekDS1"
With .DialogFrame
.Name = "Çerçeve1"
.OnAction = "DialogSheet_Show"
.Caption = "[PBİD®] Resizable DialogSheet..."
End With
.Show
.Delete
End With
Application.DisplayAlerts = True
End Sub
Sub DialogSheet_Show()
On Error Resume Next
Set Ekran.SimgeEkle2 = ÖrnekDS
Set Ekran.Ekran2 = ÖrnekDS
End Sub

'Class1

Option Explicit
'Simge

Private 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
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'Ekran

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) 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 SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
'Simge ve Ekran

Private Pencere As Long, Tercih As Long, FIcon As Long, Tarz As Long, Sonuç As Long
Public Property Set SimgeEkle1(ByVal Ekran As Object) 'UserForm için
On Error Resume Next
FIcon = Ekran.Image1.Picture.Handle
Pencere = FindWindow(vbNullString, Ekran.Caption)
Tercih = SendMessage(Pencere, &H80, 0&, ByVal FIcon)
Tercih = SendMessage(Pencere, &H80, 1&, ByVal FIcon)
Tercih = DrawMenuBar(Pencere)
Tarz = GetWindowLong(Pencere, (-20))
Tarz = Tarz Or &H40000
Sonuç = SetWindowPos(Pencere, 0, 0, 0, 0, 0, &H2 Or &H1 Or &H10 Or &H80)
Sonuç = SetWindowLong(Pencere, (-20), Tarz)
Sonuç = SetWindowPos(Pencere, 0, 0, 0, 0, 0, &H2 Or &H1 Or &H10 Or &H40)
End Property
Public Property Set SimgeEkle2(ByVal Ekran As Object) 'DialogSheet için
On Error Resume Next
FIcon = Resimlik.Picture.Handle
Pencere = FindWindow(vbNullString, Ekran.DialogFrame.Caption)
Tercih = SendMessage(Pencere, &H80, 0&, ByVal FIcon)
Tercih = SendMessage(Pencere, &H80, 1&, ByVal FIcon)
Tercih = DrawMenuBar(Pencere)
Tarz = GetWindowLong(Pencere, (-20))
Tarz = Tarz Or &H40000
Sonuç = SetWindowPos(Pencere, 0, 0, 0, 0, 0, &H2 Or &H1 Or &H10 Or &H80)
Sonuç = SetWindowLong(Pencere, (-20), Tarz)
Sonuç = SetWindowPos(Pencere, 0, 0, 0, 0, 0, &H2 Or &H1 Or &H10 Or &H40)
End Property
Public Property Set Ekran1(ByVal Ekran As Object) 'UserForm için
On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Tarz = GetWindowLong(Pencere, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Pencere, (-16), Tarz
ShowWindow Pencere, 3
DrawMenuBar Pencere
End Property
Public Property Set Ekran2(ByVal Ekran As Object) 'DialogSheet için
On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.DialogFrame.Caption)
Tarz = GetWindowLong(Pencere, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Pencere, (-16), Tarz
ShowWindow Pencere, 5
DrawMenuBar Pencere
End Property

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