Розширення можливостей VFP за рахунок WINAPI, FoxPro, Бази даних, статті

Володимир Журавльов

Багато чого може ФОКС, але встечаются прикрі випадки, коли інший продукт щось може, а у ФОКС невеликі проблеми. Велика частина таких прикрих випадків може бути залатані використання WINAPI функцій.
Ось перший приклад.

Список драйвів

У Visual Basic є компонент-список драйвів. Зробимо його для Фокс. Візьмемо combobox і в його подія init покладемо наступний код. І ось у нас є клас-список драйверів
DECLARE SHORT GetDriveType in kernel32.dll STRING @lpR
lp=0
lp1=0
lp2=0
lp3=0
d=0x1
=SetErrorMode(d)
for i=65 to 90
dr=chr(i)+':\'
if GetDriveType(@dr)!=1 and GetDriveType(@dr)!=0
this.additem(dr)
endif
=SetErrorMode(0)
endfor
this.value=sys(5)+'\'

Вставлена ​​чи дискета?

Інший приклад.
Потрібно записати чого небудь на дискету, а не відомо, вставлена ​​вона чи ні.
Лобовий спосіб вирішення цієї проблеми в Фокса – обробка потрібного номера помилки.
Але можна поступити і більш интелегентности. Взяти й створити окремий клас з
методом testdrive і покласти в нього наступний код.
Тепер його можна викликати перед записом чого або на дискету. А якщо він поверне. F., повідомляти користувачу про проблему.
lparameter dr
declare integer GetDiskFreeSpace in kernel32.dll ; string @ lpRootPathName, ;
integer @ lpSectorsPerCluster, ;
integer @ lpBytesPerSector, ;
integer @ lpNumberOfFreeClusters, ;
integer @ lpTotalNumberOfClusters
declare integer GetLastError in kernel32.dll Declare integer SetErrorMode in kernel32.dll integer d
lp=0
lp1=0
lp2=0
lp3=0
d=0x1
=SetErrorMode(d)
if GetDiskFreeSpace(@dr,@lp,@lp1,@lp2,lp3)=1
=SetErrorMode(0)
return .t.
else
=SetErrorMode(0)
return .f.
endif

Cуществованіе директорії

Іноді й на стару буває проруха. Я маю на увазі програміста. Один раз я геть забув, як перевірити існування директорії Фоксовим способом.
А потрібні рядки help все не знаходилися. Тоді я написав в призначеному для користувача класі метод- testdir з наступним кодом
lparameter dr
local cdd, rt
Declare short SetCurrentDirectory in kernel32.dll string d
declare integer GetLastError in kernel32.dll
Declare integer SetErrorMode in kernel32.dll integer d
d=0x1
=SetErrorMode(d)
cdd=sys(5)+sys(2003)
rt=SetCurrentDirectory(dr)
cd (cdd)
if rt=0
return .f.
else
return .t.
endif

Метод друку форм

Хто не мріяв зробити в ФОКС метод друку форм, який є і у Delphi і в кого тільки немає. А у нас немає. Мене це завжди приводило в тихе сказ. Зараз у FoxTalk вже опубліковано кілька способів вирішення цієї проблеми, але все кривуватий. Мені вдалося підглянути, що робить Дельфі всередині себе в методі-print , Коли посилає форму на друк і переписати це для Фокс. Ось що ми можемо зобразити за допомогою winipi.
Зробимо тільки два різних методи, щоб прихопити так званий handle друкувального пристрою. Його можна взяти, поклавши на форму компонент –common dialog (ActiveX) – в тексті він має ім’я olecontrol1 або взяти те ж саме через winipi. Ці дві гілки коду привожу в коментарях. Тому, кому не сподобається commondilaog Викінньте його код і приберіть коментарі.
dimension ss(19)
ss(1) = 66
ss(2) = null
ss(3) = null
ss(4) = null
ss(5) = null
ss(6) = null
ss(7) = 1
ss(8)= 1
ss(9)= null
ss(10) = null
ss(11)= 1
ss(12)= null
ss(13) = null
ss(14)= NULL
ss(15) = NULL
ss(16) = null
ss(17) = null
ss(18) = null
ss(19) = null
* Нижче функція, яка може бути використана замість commondialog щоб
* Прихопити handle друкувального пристрою

declare INTEGER PrintDlg in comdlg32.dll INTEGER @ss[19]
* The code before is dedicated , if common dialog activex is not available on your computer
dimension sz(5)
sz(1)=20
sz(2)=0
sz(3)=0
sz(4)=0
sz(5)=0
declare INTEGER GetForegroundWindow in user32.dll
declare INTEGER GetActiveWindow in user32.dll
declare INTEGER GetWindowDC in user32.dll INTEGER HDC
declare INTEGER DeleteDC in gdi32.dll INTEGER HDC
declare INTEGER GetDC in user32.dll INTEGER HDC
declare INTEGER ReleaseDC in user32.dll INTEGER HDC,INTEGER HWD
declare INTEGER StartDoc in gdi32.dll integer hdcPrint, integer @sz[5], ;
integer fn, integer ou , integer dt, integer fw
declare integer StartPage in gdi32.dll integer hdcprint
declare integer EndPage in gdi32.dll integer hdcprint
declare integer EndDoc in gdi32.dll integer hdcprint
declare integer GetDeviceCaps in gdi32.dll integer i, integer ii
declare SHORT BitBlt in gdi32.dll INTEGER HDC, ;
INTEGER nXDest, ;
INTEGER nYDest, ;
INTEGER nWidth, ;
INTEGER nHeight,;
INTEGER hdcSrc, ;
INTEGER nXSrc, ;
INTEGER nYSrc, ;
INTEGER dwRop
hd=GetForegroundWindow()
* Беремо handle фоксового вікна
hwd=GetDC(hd)
hd1=GetACTIVEWindow()
hwd1=GetWindowDC(hd1)
* Нижче код з використанням commondialog / * покладеного на форму
thisform.olecontrol1.flags=256
* some printers require thisform.olecontrol1.flags=512
* check out hdc<>0

thisform.olecontrol1.flags=256
thisform.olecontrol1.showprinter()
thisform.olecontrol1.flags=256
phd=thisform.olecontrol1.hdc
*********************************************** * in case common dialog is not available on your computer
* use the following code instead of the calling common dialog before

ss(1) = 66
ss(2) = hd
ss(3) = 0
ss(4) = 0
ss(5) = 0
ss(6) = 0x100
ss(7) = 1
ss(8)= 1
ss(9)= 0
ss(10) = 0
ss(11)= 1
ss(12)= 0
ss(13) = 0
ss(14)= NULL
ss(15) = NULL
ss(16) = null
ss(17) = null
ss(18) = 0
ss(19) = 0
=PrintDlg(@ss)
phd=ss[5]
*************************************************
if phd<=0
wait window 'Printer is not ready or not selected'
endif
*!* if getdevicecaps(phd,0x2)!=2
*!* * look technology parameter in win32api.txt
*!* wait window 'Your printer does not support raster copy '
*!* return
*!* endif'
* Нижче закоментірованний код-це задачка тим хто захоче
* Довести справу до кінця і зробити якісний друк
*!* if (2*int(getdevicecaps(phd,38)/2)-getdevicecaps(phd,38))=0
*!* * look capability parameter in win32api.txt
*!* wait window 'Your printer does not support BITS transfer operation'
*!* return
*!* endif

if StartDoc(phd,@sz)<=0
wait window 'Some problems with printer'
return
endif
=startPage(phd)
thisform.text1.value=BitBlt(phd,10,10,5 ,thisform.width,5,thisform.height,hwd ,thisform.left,thisform.top,0xCC0020)
* for those who has luck, it will make nice copy of the form on the printer, much better than printscreen
=ReleaseDc(hd,hwd)
=ReleaseDc(hd1,hwd1)
=EndPage(phd)
=EndDoc(phd)
=DeleteDC(phd)

Якщо все це зобразити, то копія форми буде надрукована. Але вона буде маленька. Просте її пропорційне збільшення дасть погана якість. Крім того не вирішена проблема кольору передачі з кольорового на чорно-біле.
Частина закоментірованного коду і оголошені в коді функції запросто вирішують цю проблему. Прелагают бажаючим довести справу до кінця.

Визначення типу сервера

У прикладах ФОКС є цікава бібліотека класів, що дозволяє копати в віндовском реєстрі. У мене кілька разів бували і бувають завдання, коли потрібно написати абстрактний код на невідомий сервер-то на Оракл, чи то на MS SQL толі InterBase.
Звичайно у кожного сервера повно своєї спіціфікі і всі однаково не напишеш. Але все ж таки дуже хочеться до цього прагне.
Вото як за допомогою коду winipi який нам дають у прикладах можна визначити по імені ОДБС – Оракл це чи ні
LPARAMETERS dsname
DIMENSION aODBCData[1]
this.getodbcinfo(.f.,@aODBCData)
LOCAL i
FOR i =1 to alen(aODBCData,1)
IF(upper(alltrim(aODBCData[i,1])))=upper(alltrim(dsname)) ;
and 'ORACLE'$upper(aODBCData[i,2])
Release aODBCData
RETURN .t.
ENDIF
ENDFOR
Release aODBCData
RETURN .f.
* Нижче код з registry.vcx Який вище викликається під ім'ям getodbcinfo
PARAMETER lODBCType,aODBCData
#DEFINE ERROR_SUCCESS 0
#DEFINE C_EXTNOFOUND_LOC "No information available for selected application."
#DEFINE C_NOREGFILE_LOC "The REGISTRY.PRG file needed for this sample could not be found in \Samples\Classes."
LOCAL oReg,regfile,nErrNum,lDrivers
*!* PUBLIC aODBCData
lDrivers = .F.
IF PARAMETERS()=1 AND TYPE("m.lODBCType")="L" AND m.lODBCType
m.lDrivers = .T.
ENDIF
regfile = "registry.prg"
IF !FILE(m.regfile)
MESSAGEBOX(C_NOREGFILE_LOC )
RETURN
ENDIF
SET PROCEDURE TO (m.regfile) ADDITIVE
oReg = CreateObject("ODBCReg")
*!* DIMENSION aODBCData[1]
IF m.lDrivers
m.nErrNum = oReg.GetODBCDrvrs(@aODBCData)
ELSE m.nErrNum = oReg.GetODBCDrvrs(@aODBCData,.T.)
ENDIF

Завжди працюємо на потрібному національною мовою

Ось досить типова ситуація. Користувач запускає програму і набирає пароль А регістр Російська. Природно його відшивають. І не завжди він швидко зрозуміє, в чому справа. Далі набрав пароль і хвацько, не дивлячись на екран почав набирати. А так роблять більшість хороших операторів в хороших торгових фірмах. Клієнт з грошима не чекатиме А регістр то Англійська. Ось і доводиться все знову набирати. Ось як завжди можна поставити потрібну мову з використанням winipi Вже куди покласти код в формах вводу-справа смаку. Можна і в таймерний об’єкт.

DECLARE SHORT GetKeyboardLayoutName IN user32.dll STRING @lpR
lpr=' '
=GetKeyboardLayoutName(@lpr)
DECLARE SHORT ActivateKeyboardLayout IN user32.dll INTEGER HKL , INTEGER flags
if not '419' $lpr
=ActivateKeyboardLayout(1,0)
endif

Ну от. Заздалегідь прошу вибачення у тих, хто що небудь або все з вище написаного знає. Пишу тільки для тих, хто не знає.

З повагою до всіх – Володимир Журавльов boba@synapse.ru

Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*