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