Расширение возможностей VFP за счет WINAPI

Много чего может ФОКС, но встечаются досадные случаи , когда другой продукт что-то может, а у ФОКСА небольшие проблемы. Большая часть таких досадных случаев может быть залатана использование 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]

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