Viết bởi: nguyentung2403 19-11-10, 04:26 PM Chuyên mục: Report - Bài trả lời (3) |
Viết bởi: nguyentung2403 18-11-10, 08:56 PM Chuyên mục: Query - Bài trả lời (4) |
Viết bởi: haquocquan 18-11-10, 01:55 AM Chuyên mục: Thư viện thủ thuật - Bài trả lời (13) |
Option Explicit
Function ToUnicode(txtString As String, Optional isReversed As Boolean = False, Optional isISO As Boolean = False) As String
' This function will do the conversion of text string into unicode
Dim iStr As String, repTxt As String, mText As String
Dim i As Long, j As Long
Dim iUnicode As Variant ' array to keep unicode char set
Dim iTCVN As Variant ' array to keep TCVN char set
Dim iProcList() As String ' array to keep what to convert
'parse the parameter into this local variable
iStr = txtString
mText = txtString
iUnicode = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, _
7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, _
7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, _
7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, _
432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273, 193, 192, 195, _
258, 194, 212, 416, 431, 272)
iTCVN = Array(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, _
201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, _
222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, _
238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, _
174, 193, 192, 195, 161, 162, 164, 165, 166, 167)
' Reenlarge the array
ReDim iProcList(1, 133)
' process the vowel only and covert to asc code
For i = 1 To Len(mText)
repTxt = Mid(mText, i, 1)
If AscW(repTxt) > 122 Then
iStr = Replace(iStr, repTxt, "[" & AscW(repTxt) & "]")
mText = Replace(mText, repTxt, " ")
' write the processed list
iProcList(1, j) = "[" & AscW(repTxt) & "]"
If isISO Then
iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
Else
If isReversed Then
iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
Else
iProcList(0, j) = GetElementNo(AscW(repTxt), iTCVN)
End If
End If
j = j + 1
End If
Next
If j = 0 Then
ToUnicode = txtString
Exit Function
End If
ReDim Preserve iProcList(1, j - 1)
' now convert to unicode
For i = 0 To UBound(iProcList, 2)
If isReversed Then
iStr = Replace(iStr, iProcList(1, i), ChrW(iTCVN(Val(iProcList(0, i)))))
Else
If isISO Then
iStr = Replace(iStr, iProcList(1, i), "&#" & iUnicode(Val(iProcList(0, i))) & ";")
Else
iStr = Replace(iStr, iProcList(1, i), ChrW(iUnicode(Val(iProcList(0, i)))))
End If
End If
Next
fExit:
ToUnicode = iStr
End Function
Private Function GetElementNo(iTxt As Long, iObj As Variant) As String
Dim i As Long
For i = 0 To UBound(iObj)
If iTxt = iObj(i) Then
GetElementNo = CStr(i)
Exit For
End If
Next
End Function
ToUnicode(chuoi)
ToUnicode(chuoi,true)
Viết bởi: haquocquan 18-11-10, 01:07 AM Chuyên mục: Thư viện thủ thuật - Bài trả lời (1) |
Option Compare Database
'Khai bao cac hang
Const SPI_GETNONCLIENTMETRICS = 41
Const SPI_SETNONCLIENTMETRICS = 42
Const SPI_GETICONTITLELOGFONT = 31
Const SPI_SETICONTITLELOGFONT = 34
Const LF_FACESIZE = 32
'Khai bao cac kieu
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 As String * 32
End Type
Private Type NONCLIENTMETRICS
cbSize As Long
iBorderWidth As Long
iScrollWidth As Long
iScrollHeight As Long
iCaptionWidth As Long
iCaptionHeight As Long
lfCaptionFont As LOGFONT
iSMCaptionWidth As Long
iSMCaptionHeight As Long
lfSMCaptionFont As LOGFONT
iMenuWidth As Long
iMenuHeight As Long
lfMenuFont As LOGFONT
lfStatusFont As LOGFONT
lfMessageFont As LOGFONT
End Type
'Khai bao cac bieb thuoc kieu tren
Dim m_nonClientMetrics As NONCLIENTMETRICS
Dim m_logFont As LOGFONT
'Khai bao cac bien chua so do font
Dim m_fontCaption As String * 32
Dim m_fontSmCaption As String * 32
Dim m_fontMenu As String * 32
Dim m_fontMessage As String * 32
Dim m_fontStatus As String * 32
Dim m_fontIcon As String * 32
Dim m_fontHeight As Long, m_fontWeight As Long
'Khai bao ham API can dung
Private Declare Function SystemParametersInfo _
Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, _
ByVal uParam As Long, _
ByRef lpvParam As Any, _
ByVal fuWinIni As Long) As Long
'Thu tuc thiet lap so do font he thong
Public Function SetSysFont(fontName As String)
Dim result As Long
'*****************************
'Truy xuat so do font hien tai
m_nonClientMetrics.cbSize = Len(m_nonClientMetrics)
result = SystemParametersInfo(SPI_GETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_GETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)
'**********************************
'Luu lai cac font he thong hien tai
'Luu lai font hien thi Caption
m_fontCaption = m_nonClientMetrics.lfCaptionFont.lfFaceName
m_fontHeight = m_nonClientMetrics.lfCaptionFont.lfHeight
m_fontWeight = m_nonClientMetrics.lfCaptionFont.lfWeight
'Luu lai font hien thi Caption nho
m_fontSmCaption = m_nonClientMetrics.lfSMCaptionFont.lfFaceName
'Luu lai font hien thi hop thoai thong bao
m_fontMessage = m_nonClientMetrics.lfMessageFont.lfFaceName
'Luu lai font Menu
m_fontMenu = m_nonClientMetrics.lfMenuFont.lfFaceName
'************************************
'Thay doi font
'font hien thi Caption
m_nonClientMetrics.lfCaptionFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfCaptionFont.lfWeight = 700
m_nonClientMetrics.lfCaptionFont.lfHeight = -12
'font hien thi Caption nho
m_nonClientMetrics.lfSMCaptionFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfSMCaptionFont.lfHeight = -12
'font hien thi hop thoai thong bao
m_nonClientMetrics.lfMessageFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfMessageFont.lfHeight = -12
'font hien thi menu
m_nonClientMetrics.lfMenuFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfMenuFont.lfHeight = -12
'thuc hien thay doi
result = SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_SETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)
End Function
'Thu tuc thiet lap lai so do font cu
Public Sub restoreSysFont()
'font hien thi Caption
m_nonClientMetrics.lfCaptionFont.lfFaceName = m_fontCaption
m_nonClientMetrics.lfCaptionFont.lfHeight = m_fontHeight
m_nonClientMetrics.lfCaptionFont.lfWeight = m_fontWeight
'font hien thi Caption nho
m_nonClientMetrics.lfSMCaptionFont.lfFaceName = m_fontSmCaption
m_nonClientMetrics.lfSMCaptionFont.lfHeight = m_fontHeight
'font hien thi hop thoai thong bao
m_nonClientMetrics.lfMessageFont.lfFaceName = m_fontMessage
m_nonClientMetrics.lfMessageFont.lfHeight = m_fontHeight
'font hien thi menu
m_nonClientMetrics.lfMenuFont.lfFaceName = m_fontMenu
m_nonClientMetrics.lfMenuFont.lfHeight = m_fontHeight
'thuc hien thay doi
result = SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_SETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)
End Sub
SetSysFont ("Tahoma")
restoreSysFont()
Viết bởi: Noname 16-11-10, 09:46 PM Chuyên mục: Query - Không có hồi đáp |
ALTER TABLE table {ADD {COLUMN field type[(size)] [NOT NULL] [CONSTRAINT index] |
ALTER COLUMN field type[(size)] |
CONSTRAINT multifieldindex} |
DROP {COLUMN field I CONSTRAINT indexname} }
ALTER TABLE Employees ADD COLUMN Notes TEXT(25)
ALTER TABLE Employees ALTER COLUMN ZipCode TEXT(10)
Chủ đề Mới nhất |
Trợ giúp về Textbox với c... -Chuyên mục: Forms-Đăng bởi lần cuối: Nguyên Thông-Hôm qua, 08:37 PM- » Bài trả lời: 12- » Lượt xem: 5,825 |
khoe 247 chuyen gia cham ... -Chuyên mục: Chuyện bốn phương-Đăng bởi lần cuối: rssellaumlin-15-04-24, 04:42 PM- » Bài trả lời: 0- » Lượt xem: 11 |
In mã vạch tạo từ access ... -Chuyên mục: Forms-Đăng bởi lần cuối: huyhoang22-15-04-24, 11:25 AM- » Bài trả lời: 38- » Lượt xem: 20,760 |
Dòng Thơ Nhạc Trích Đoạn -Chuyên mục: Góc Thơ -Đăng bởi lần cuối: Nguyễn Thành Sáng-11-04-24, 06:04 PM- » Bài trả lời: 2- » Lượt xem: 38 |
Kết nối bảng từ access A ... -Chuyên mục: Thủ thuật VBA-Đăng bởi lần cuối: hieunx-11-04-24, 01:23 PM- » Bài trả lời: 5- » Lượt xem: 70 |
Lấy dữ liệu từ 1 cột của ... -Chuyên mục: Query-Đăng bởi lần cuối: ongke0711-09-04-24, 11:34 AM- » Bài trả lời: 11- » Lượt xem: 463 |
Quản lý kho bằng Accesss -Chuyên mục: Thảo Luận Access-Đăng bởi lần cuối: recca123-07-04-24, 11:27 PM- » Bài trả lời: 38- » Lượt xem: 1,484 |
[Lỗi] Automation error kh... -Chuyên mục: Thành viên giúp nhau-Đăng bởi lần cuối: AnNguyen-05-04-24, 09:30 AM- » Bài trả lời: 4- » Lượt xem: 65 |
Lọc tên vật tư theo nhóm -Chuyên mục: Forms-Đăng bởi lần cuối: ongke0711-02-04-24, 04:00 PM- » Bài trả lời: 1- » Lượt xem: 43 |
Thơ con cóc -Chuyên mục: Góc Thơ -Đăng bởi lần cuối: Xuân Thanh-01-04-24, 06:45 PM- » Bài trả lời: 111- » Lượt xem: 59,001 |
Diễn đàn Thống kê |
» Thành viên: 4,449 » Thành viên mới nhất: Ruslancek » Các chủ đề diễn đàn: 9,857 » Các bài viết diễn: 48,432 Thống kê đầy đủ |