Список драйвів, FoxPro, Бази даних, статті

У 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 SamplesClasses. "
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

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

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

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


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

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

Ваш отзыв

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

*

*