کافیه یک عدد لیست باکس به فرم اضافه کنید و این کد را داخل فرم بذارید

Private Sub Form_Load()
For I = 1 To Screen.FontCount
    List1.AddItem Screen.Fonts(I)
Next
End Sub

برای اسفاده از فونتها هم از این کد استفاده کنید:

Private Sub List1_Click()
Text1.Font.Name = List1.List(List1.ListIndex)
End Sub

نوشته شده توسط مهدی در پنج شنبه 88/2/24 و ساعت 10:59 عصر | نظرات دیگران()

 متن ماژول:

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapID As Long) As Long
Private Declare Function Delete Lib "gdi32" (ByVal h As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Public Function LoadPicture(sResourceFileName As String, lResourceId As Long) As Picture
Dim hInst As Long
Dim hBmp As Long
Dim Pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID
Dim lRC As Long
hInst = LoadLibrary(sResourceFileName)
If hInst <> 0 Then
hBmp = LoadBitmap(hInst, lResourceId)
If hBmp <> 0 Then
IID_IDispatch.Data1 = &H20400
IID_IDispatch.Data4(0) = &HC0
IID_IDispatch.Data4(7) = &H46
Pic.Size = Len(Pic)
Pic.Type = vbPicTypeBitmap
Pic.hBmp = hBmp
Pic.hPal = 0
lRC = OleCreatePictureIndirect(Pic, _
IID_IDispatch, 1, IPic)
If lRC = 0 Then
Set LoadPicture = IPic
Set IPic = Nothing
Else
Call Delete(hBmp)
End If
End If
Call FreeLibrary(hInst)
hInst = 0
End If
End Function

مثال:

Private Sub Form_Load()
"Try ID 130 in Win98, or 131 in NT
"to see the windows logo...
Set Me.Picture = LoadPicture("shell32.dll", 130)
End Sub 

نوشته شده توسط مهدی در پنج شنبه 88/2/24 و ساعت 10:59 عصر | نظرات دیگران()

تابعی برای تبدیل ثانیه به ، ساعت:دقیقه:ثانیه

Public Function ConvertSeconds(lSeconds As Long) As String

    Dim lTmpMinutes As Long
    Dim lTmpSeconds As Long
    Dim lTmpHours As Long
   
    If lSeconds > 59 Then
        lTmpSeconds = lSeconds Mod 60
        If lSeconds > 3599 Then
            lTmpHours = Fix(lSeconds / 3600)
            lTmpMinutes = lSeconds / 60 - (60 * lTmpHours)
            ConvertSeconds = lTmpHours & ":" & Format _
           (lTmpMinutes, "00") & ":" & Format(lTmpSeconds, "00")
        Else
            lTmpMinutes = Fix(lSeconds / 60)
            ConvertSeconds = lTmpMinutes & ":" & _
            Format(lTmpSeconds, "00")
        End If
    Else
        ConvertSeconds = "0:" & Format(lSeconds, "00")
    End If
End Function

نوشته شده توسط مهدی در پنج شنبه 88/2/24 و ساعت 10:58 عصر | نظرات دیگران()

برای این کار داخل یک ماژول این خط رو اضافه کنید

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const conSwNormal = 1

اینم مثال:

ShellExecute hwnd, "open", "http://vbcode.parsiblog.com", vbNullString, vbNullString, conSwNormal

نوشته شده توسط مهدی در پنج شنبه 88/2/24 و ساعت 10:56 عصر | نظرات دیگران()

 با این کدها برنامه موقعیت فرم اصلی و همچنین طول و عرض آنرا در هنگام بسته شدن برنامه ذخیره می کند

و در اجرای بعدی، فرم را در همان محل و با همان اندازه نمایش می دهد:

Private Sub Form_Load()
    "load settings from the registry
    Me.WindowState = GetSetting(App.Title, Me.Name, "WindowState", Me.WindowState)
    If Me.WindowState = vbNormal Then
        Me.Width = GetSetting(App.Title, Me.Name, "Width", Me.Width)
        Me.Height = GetSetting(App.Title, Me.Name, "Height", Me.Height)
        Me.Left = GetSetting(App.Title, Me.Name, "Left", Me.Left)
        Me.Top = GetSetting(App.Title, Me.Name, "Top", Me.Top)
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    "Save orm dimensions and state in the registry
    SaveSetting App.Title, Me.Name, "WindowState", Me.WindowState
    If Me.WindowState = vbNormal Then
        SaveSetting App.Title, Me.Name, "Height", Me.Height
        SaveSetting App.Title, Me.Name, "Width", Me.Width
        SaveSetting App.Title, Me.Name, "Left", Me.Left
        SaveSetting App.Title, Me.Name, "Top", Me.Top
    End If
End Sub

نوشته شده توسط مهدی در پنج شنبه 88/2/24 و ساعت 10:56 عصر | نظرات دیگران()

Dim intWidth As Integer
Dim intHeight As Integer

intWidth = Screen.Width \ Screen.TwipsPerPixelX
intHeight = Screen.Height \ Screen.TwipsPerPixelY
MsgBox "Screen Resolution:" + vbCrLf + vbCrLf + Str$(intWidth) + " x" + Str$(intHeight), 64, "Info"

نوشته شده توسط مهدی در پنج شنبه 88/2/24 و ساعت 10:53 عصر | نظرات دیگران()

با سلام خدمت دوستان

پس از یک غیبت طولانی دوباره در خدمت شما عزیزان هستم.

نرم افزار محاسبه اوقات شرعی:

اطلاعات این نرم افزار طبق محاسبات مرکز تقویم ایران است (خیالتون راحت باشه می تونید چک کنید)

ضمن اینکه موقع اذان برنامه براتون اذان مؤذن زاده اردبیلی رو پخش می کنه

امیدوارم استفاده کنید و من رو هم دعا کنید.

 در صورت مشاهده هرگونه مشکل لطفا اطلاع دهید.

نوشته شده توسط مهدی در سه شنبه 88/2/22 و ساعت 2:55 عصر | نظرات دیگران()