تابع ChooseFont

تابع ChooseFont : 

یک کادر محاوره ای فونت ایجاد می کند که به کاربر امکان می دهد ویژگیهای یک فونت منطقی را انتخاب کند. این ویژگیها شامل یک خانواده فونت و سبک فونت مرتبط ، اندازه نقطه ، جلوه ها ( زیر خط ، خط روی کاراکتر و رنگ متن ) یک اسکریپت ( یا مجموعه کاراکتر ) است.

Boolean : 

ChooseFont(lpcf)

lpcf :

نشانگری به ساختار CHOOSEFONT که حاوی اطلاعاتی است که برای مقداردهی اولیه کادر محاوره ای استفاده می شود. هنگامیکه ChooseFont بر می گرداند. این ساختار حاوی اطلاعاتی در مورد انتخاب فونت کاربر است.

Comdlg32.lib

استراکچر CHOOSEFONTA :

حاوی اطلاعاتی است که تابع ChooseFont برای مقداردهی اولیه کادر محاوره ای فونت استفاده می کند. پس از بستن کادر محاوره ای توسط کاربر ، سیستم اطلاعات مربوط به انتخاب کاربر در این ساختار را بر می گرداند

Type FONTSTRUC

lStructSize As Long

hwndOwner As LongPtr

hdc As LongPtr

lpLogFont As LongPtr

iPointSize As Long ' 10 * size in points of selected font flags As Long

rgbColors As Long

lCustData As LongPtr 

 lpfnHook As LongPtr ' ptr. to hook function

hInstance As LongPtr ' instance handle of.EXE that ' contains cust. dlg. template

lpszStyle As String ' return the style field here ' must be LF_FACESIZE or bigger

nFontType As Integer ' same value reported to the EnumFonts ' call back with the extra FONTTYPE_ ' bits added MISSING_ALIGNMENT As Integer

nSizeMin As Long ' minimum pt size allowed & nSizeMax As Long ' max pt size allowed if ' CF_LIMITSIZE is used

End Type

HWND :

دستگیره یا پل ارتباطی به پنجره ای که مالک کادر محاوره ایست ، این عضو می تواند هر دستگیره پنجره معتبری باشد ، یا اگر کادر محاوره ای مالکی نداشته باشد، می تواند NULL باشد.

-متد Application.hWndAccessApp :

استفاده از متد hWndAccessApp برای تعیین دستگیره معین شده توسط ویندوز به پنجره اصلی مایکروسافت اکسس

hDC :

این عضو توسط تابع ChooseFont نادیده گرفته می شود.

استراکچر LOGFONTA :

تعیین ویژگیهای یک فونت 

Private Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
  lfFaceName(LF_FACESIZE) As Byte
End Type

تابع MulDiv :

دو مقدار 32 بیتی را ضرب می کند و سپس نتیجه 64 بیتی را بر یک مقدار 32 بیتی سوم تقسیم می کند. نتیجه نهایی به نزدیکترین عدد صحیح گرد می شود.

int MulDiv( [in] int nNumber, [in] int nNumerator, [in] int nDenominator );

Kernel32.lib

Private Function MulDiv(In1 As Long, In2 As Long, In3 As Long) As Long

Dim lngTemp As Long

On Error GoTo MulDiv_err

If In3 <> 0 Then

دو مقدار 32 بیتی را ضرب می کند :

lngTemp = In1 * In2

نتیجه 64 بیتی را بر یک مقدار 32 بیتی سوم تقسیم می کند :

lngTemp = lngTemp / In3

Else

lngTemp = -1

End If

MulDiv_end:

MulDiv = lngTemp

Exit Function

MulDiv_err:

lngTemp = -1

Resume MulDiv_err

End Function 

تابع GetDeviceCaps : 

اطلاعات مربوط به دستگاه ( Device ) را برای دستگاه مشخص شده بازیابی می کند.

int GetDeviceCaps( [in] HDC hdc, [in] int index );

Gdi32.lib

LOGPIXELSY

Number of pixels per logical inch along the screen height. In a system with multiple display monitors, this value is the same for all monitors

LF.lfHeight = -MulDiv(CLng(f.Height), GetDeviceCaps(GetDC(hWndOwner), LOGPIXELSY), 72)

StringToByte(f.Name, LF.lfFaceName()) 

Private Sub StringToByte(InString As String, ByteArray() As Byte) Dim intLbound As Long Dim intUbound As Long Dim intLen As Long Dim intX As Long intLbound = LBound(ByteArray) intUbound = UBound(ByteArray) intLen = LenB(InString) If intLen > intUbound - intLbound Then intLen = intUbound - intLbound For intX = 1 To intLen ByteArray(intX - 1 + intLbound) = AscB(MidB(InString, intX, 1)) Next End Sub 

Dim abData() As Byte Dim Str As String Dim i As Long Str = "Hello world!" ' Convert string to bytes abData = StrConv(Str, vbFromUnicode) For i = 0 To UBound(abData) Debug.Print Hex(abData(i)); "='" & Chr(abData(i)) & "'" Next ' Convert bytes to string Str = StrConv(abData, vbUnicode) Debug.Print "'" & Str & "'"

Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long

Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr

Private Declare PtrSafe Function MonitorFromWindow Lib "user32" _ (ByVal hWnd As LongPtr, ByVal dwFlags As Long) As LongPtr

Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" _ (ByVal hMonitor As LongPtr, ByRef lpMI As MONITORINFOEX) As Boolean 

Private Declare PtrSafe Function CreateDC Lib "gdi32" Alias "CreateDCA" _ (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As LongPtr) As LongPtr

Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As Long