ðÒÏÉÚ×ÏÄÉÔÅÌØÎÏÓÔØ ÔÒÕÄÁ [2/3]
Vladimir Tokarev
* в RU.FOXPRO
* в RU.VISUAL.FOXPRO
**-- ("Program" pad)
* Добавлено 'Compile \<All'
DEFINE BAR _MPR_DO OF _MPROG PROMPT '\<Do...'
DEFINE BAR _MPR_CANCL OF _MPROG PROMPT '\<Cancel'
DEFINE BAR _MPR_RESUM OF _MPROG PROMPT '\<Resume'
DEFINE BAR _MPR_SUSPEND OF _MPROG PROMPT '\<Suspend'
DEFINE BAR _MPR_SP100 OF _MPROG PROMPT '\-'
DEFINE BAR _MPR_COMPL OF _MPROG PROMPT 'Co\<mpile'
* DEFINE BAR _MPR_GENER OF _MPROG PROMPT '\<Generate'
* DEFINE BAR _MPR_DOCUM OF _MPROG PROMPT 'Fo\<xDoc' && 2.X, 3.0
* DEFINE BAR _MPR_GRAPH OF _MPROG PROMPT 'Fox\<Graph...' && 2.X, 3.0
DEFINE BAR 1 OF _MPROG PROMPT 'Compile \<All' ;
AFTER -22779
ON SELECTION BAR 1 OF _MPROG DO (phile_compile)
**-- ("DBF" pad) 2.X - "Database" pad
* Вызов Browse сделан на Ctrl+B
* 'Reinde\<x' -> 'Re\<index'
DEFINE PAD _MSM_DATA of _msysmenu prompt 'DBF' KEY ALT-D ;
AFTER _MSM_PROG ;
SKIP for "DATABASE DESIGNER" $ UPPER(wontop())
on pad _MSM_DATA of _msysmenu activate popup _MDATA
DEFINE POPUP _MDATA MARGIN RELATIVE && FONT 'Arial',10 STYLE 'B'
DEFINE BAR _MDA_SETUP OF _MDATA prompt 'Set\<up...'
DEFINE BAR _MDA_BROW OF _MDATA prompt '\<Browse' ;
KEY Ctrl-B, 'Ctrl+B'
DEFINE BAR _MDA_SP100 OF _MDATA prompt '\-'
DEFINE BAR _MDA_APPND OF _MDATA prompt '\<Append From...'
DEFINE BAR _MDA_COPY OF _MDATA prompt '\<Copy To...'
DEFINE BAR _MDA_SORT OF _MDATA prompt '\<Sort...'
DEFINE BAR _MDA_TOTAL OF _MDATA prompt '\<Total...'
DEFINE BAR _MDA_SP200 OF _MDATA prompt '\-'
DEFINE BAR _MDA_AVG OF _MDATA prompt 'A\<verage...'
DEFINE BAR _MDA_COUNT OF _MDATA prompt 'C\<ount...'
DEFINE BAR _MDA_SUM OF _MDATA prompt 'Su\<m...'
DEFINE BAR _MDA_CALC OF _MDATA prompt 'Calculat\<e...'
DEFINE BAR _MDA_REPRT OF _MDATA prompt '\<Report...'
DEFINE BAR _MDA_LABEL OF _MDATA prompt '\<Label...'
DEFINE BAR _MDA_SP300 OF _MDATA prompt '\-'
DEFINE BAR _MDA_PACK OF _MDATA prompt '\<Pack'
* DEFINE BAR _MDA_RINDX OF _MDATA prompt 'Reinde\<x' && 2.X
DEFINE BAR _MDA_RINDX OF _MDATA prompt 'Re\<index'
**-- ("Record" pad) 2.X - "Record" pad
* Добавлено 6 операций с таблицами
DEFINE PAD _MSM_RECRD of _msysmenu prompt 'Record' KEY ALT-R ;
BEFORE _MSM_WINDO ;
SKIP for "REPORT DESIGNER" $ UPPER(wontop())
on pad _MSM_RECRD of _msysmenu activate popup _MRECORD
DEFINE POPUP _MRECORD MARGIN RELATIVE && FONT 'Arial',10 STYLE 'B'
DEFINE BAR _MRC_APPND OF _MRECORD prompt '\<Append'
DEFINE BAR _MRC_CHNGE OF _MRECORD prompt 'Chang\<e'
DEFINE BAR _MRC_SP100 OF _MRECORD prompt '\-'
DEFINE BAR _MRC_GOTO OF _MRECORD prompt '\<Goto...'
DEFINE BAR _MRC_LOCAT OF _MRECORD prompt '\<Locate...'
DEFINE BAR _MRC_CONT OF _MRECORD prompt '\<Continue'
DEFINE BAR _MRC_SEEK OF _MRECORD prompt '\<Seek...'
DEFINE BAR _MRC_SP200 OF _MRECORD prompt '\-'
DEFINE BAR _MRC_REPL OF _MRECORD prompt 'Re\<place...'
DEFINE BAR _MRC_DELET OF _MRECORD prompt '\<Delete...'
DEFINE BAR _MRC_RECAL OF _MRECORD prompt '\<Recall...'
**-- дополнение Record - меню пунктами по работе с БД
DEFINE BAR 1 OF _MRECORD PROMPT '\-'
DEFINE BAR 2 OF _MRECORD PROMPT 'Вставка записи' ;
KEY alt-ins, 'Alt+Ins' ;
skip for !used()
DEFINE BAR 3 OF _MRECORD PROMPT 'Верх Таблицы' ;
KEY alt-home, 'Alt+Home' ;
skip for recno()=1 .or. bof() .or. !used() && 2.X 'Верх БД'
DEFINE BAR 4 OF _MRECORD PROMPT 'Средняя запись' ;
KEY alt-0, 'Alt+Hоль' ;
skip for reccount() < 4
DEFINE BAR 5 OF _MRECORD PROMPT 'Hиз Таблицы' ;
KEY Alt-End, 'Alt+End' ;
skip for recno()=reccount() .or. eof() .or. !used() && 2.X 'Hиз БД'
DEFINE BAR 6 OF _MRECORD PROMPT 'Delete\Recall to EOF' ;
KEY Alt-Del, 'Alt+Del' ;
SKIP FOR type('phile_del') <> 'C' .or. ;
(!file (phile_del+'.prg') and !file (phile_del+'.fxp')) .or. ;
!used()
DEFINE BAR 7 OF _MRECORD PROMPT 'Delete\Recall to BOF' ;
KEY Alt-BackSpace, 'Alt+BS' ;
SKIP FOR type('phile_del') <> 'C' .or. ;
(!file (phile_del+'.prg') and !file (phile_del+'.fxp')) .or. ;
!used()
ON SELECTION BAR 2 OF _MRECORD INSERT
ON SELECTION BAR 3 OF _MRECORD GO TOP
ON SELECTION BAR 4 OF _MRECORD GO (reccount()/2)
ON SELECTION BAR 5 OF _MRECORD GO BOTTOM
ON SELECTION BAR 6 OF _MRECORD DO (phile_del) WITH 1
ON SELECTION BAR 7 OF _MRECORD DO (phile_del) WITH 2
**-- ("Window" pad)
* Восстановлены '\<Minimize' и '\<Zoom' , как в 2.Х
* Дисплей 25 <-> 50 строк
DEFINE BAR _MWI_ARRAN OF _MWINDOW prompt '\<Arrange All'
DEFINE BAR _MWI_SP100 OF _MWINDOW prompt '\-'
DEFINE BAR _MWI_HIDE OF _MWINDOW prompt '\<Hide'
DEFINE BAR _MWI_CLEAR OF _MWINDOW prompt 'Clea\<r'
DEFINE BAR _MWI_ROTAT OF _MWINDOW prompt 'Cycl\<e'
DEFINE BAR _MWI_MIN OF _MWINDOW prompt '\<Minimize' ;
KEY Ctrl-F9, 'Ctrl+F9' ;
AFTER -22525
DEFINE BAR _MWI_ZOOM OF _MWINDOW prompt '\<Zoom' ;
KEY Ctrl-F10, '^F10' ;
AFTER -22525
DEFINE BAR _MWI_SP200 OF _MWINDOW prompt '\-'
DEFINE BAR _MWI_CMD OF _MWINDOW prompt '\<Command'
DEFINE BAR _MWI_VIEW OF _MWINDOW prompt '\<View'
**-- дополнение WINDOW - меню пунктами по дисплею
DEFINE BAR 1 OF _mwindow PROMPT '\-'
DEFINE BAR 2 OF _mwindow PROMPT '25 строк ' ;
KEY Alt-1, 'Alt+1' ;
skip for srows()<40
DEFINE BAR 3 OF _mwindow PROMPT '50 строк ' ;
KEY Alt-2, 'Alt+2' ;
skip for srows()>40
*for 2.X
*DEFINE BAR _MWI_DEBUG OF _MWINDOW PROMPT "Debu\<g" KEY Alt-G
*DEFINE BAR _MWI_TRACE OF _MWINDOW PROMPT "\<Trace" KEY Alt-T
*DEFINE BAR 1 OF _mwindow PROMPT '\-'
*DEFINE BAR 2 OF _mwindow PROMPT '25 строк ' KEY Alt-1 skip for srows()=25
*DEFINE BAR 3 OF _mwindow PROMPT '50 строк ' KEY Alt-2 ;
* skip for srows()>25 .or. not 'VGA/Color'$sys(2006)
ON SELECTION BAR 2 OF _mwindow SET DISPLAY TO VGA25
ON SELECTION BAR 3 OF _mwindow SET DISPLAY TO VGA50
**-- ("Help" pad)
* 'MicroSoft Visual FoxPro Help Topics F1' -> (MSDN)
* Hа F1 грузится (быстрее) только часть про Фокс, а не весь MSDN
* Добавлен вызов Knowledge Base
* Ряд имен остался от ФоксПро 2.Х (_MST_PUZZL и другие).
* Большинство из них в _MSYSTEM PopUp незадействовано - нереагирует,
* error 1001 или skip for .t.
* Совместимость продукта сверху вниз, так сказать...
* (..._SP100, ..._SP200, ..._SP300, _HELPWEBFILLER1 :-/)
* Hижние 2 работают
* DEFINE BAR _MST_CALCU OF _msystem PROMPT 'Калькулятор'
* DEFINE BAR _MST_DIARY OF _msystem PROMPT 'Календарь'
**-- удаление опций из вертикального меню
* _MST_HPSCH - 'MicroSoft Visual FoxPro Help Topics F1' (MSDN)
RELEASE BAR _MST_HPSCH OF _MSYSTEM
RELEASE BAR _MST_SP100 OF _MSYSTEM && separator N1
RELEASE BAR _MST_MSDNC OF _MSYSTEM && MSDN - contents
RELEASE BAR _MST_MSDNI OF _MSYSTEM && MSDN - index
RELEASE BAR _MST_MSDNS OF _MSYSTEM && MSDN - search
RELEASE BAR _MST_SP200 OF _MSYSTEM && separator N2
RELEASE BAR _MST_TECHS OF _MSYSTEM && technical support
RELEASE BAR _MST_ABOUT OF _MSYSTEM && About FoxPro...
* RELEASE BAR _MST_SP300 OF _MSYSTEM && separator N3 (no in 6.0)
RELEASE BAR _MST_SP200 OF _MSYSTEM && delete separator N3 (bug?)
* Какая-то мура... так удаляет 'MicroSoft on the Web'
RELEASE BAR _HELPWEBVFPFREESTUFF OF _MSYSTEM
* а так 'Free Stuff'
* RELEASE BAR _HELPWEBVFPFREESTUFF OF _WEBMENU
* for 2.X
* DEFINE BAR _MST_FILER OF _MSYSTEM PROMPT "\<Filer" KEY Alt-F2
* DEFINE BAR _MST_ASCII OF _MSYSTEM PROMPT "ASC\<II Chart" KEY Alt-A
* RELEASE BAR _MST_PUZZL OF _MSYSTEM && Puzzle
**-- дополнение SYSTEM - меню
DEFINE BAR _MST_HPSCH OF _msystem PROMPT 'MSDN'
DEFINE BAR 1 OF _msystem PROMPT 'FoxPro Help (MSDN 1999)' ;
KEY F1 ;
SKIP FOR TYPE('phile_msdn') <> 'C' .or. ;
!(file (phile_msdn+'.prg') .or. file (phile_msdn+'.fxp'))
DEFINE BAR 2 OF _msystem PROMPT 'FoxPro Help (MSDN 2001)' ;
SKIP FOR TYPE('phile_msdn') <> 'C' .or. ;
!(file (phile_msdn+'.prg') .or. file (phile_msdn+'.fxp'))
DEFINE BAR 3 OF _msystem PROMPT 'KB FoxPro (1999)' ;
SKIP FOR TYPE('phile_msdn') <> 'C' .or. ;
!(file (phile_msdn+'.prg') .or. file (phile_msdn+'.fxp'))
DEFINE BAR 4 OF _msystem PROMPT 'KB FoxPro (2001)' ;
SKIP FOR TYPE('phile_msdn') <> 'C' .or. ;
!(file (phile_msdn+'.prg') .or. file (phile_msdn+'.fxp'))
DEFINE BAR 5 OF _msystem PROMPT 'Помощь ' ;
KEY Alt-F1, 'Alt+F1' ;
SKIP FOR TYPE('phile_hlp') <> 'C' .or. ;
!(file (phile_hlp+'.prg') .or. file (phile_hlp+'.fxp'))
ON SELECTION BAR 1 OF _msystem DO (phile_msdn) WITH 1
ON SELECTION BAR 2 OF _msystem DO (phile_msdn) WITH 2
ON SELECTION BAR 3 OF _msystem DO (phile_msdn) WITH 3
ON SELECTION BAR 4 OF _msystem DO (phile_msdn) WITH 4
ON SELECTION BAR 5 OF _msystem DO (phile_hlp)
* release lcCurrSafety
RETURN
************************************************************
********************************************
* Просмотр номеров "баров" в системном меню
* *cPopup = '_medit'
* cPopup = '_mtools'
* For i=1 to CntBar(cPopup)
* ? PRMBAR(cPopup, GETBAR(cPopup, i))
* ? GETBAR(cPopup, i)
* Endfor
****************************************
* Просмотр имен "пэдов" в системном меню
* cMenu = '_msysmenu'
* For i=1 to CntPad(cMenu)
* ? PRMPAD(cMenu, GETPAD(cMenu, i))
* ? GETPAD(cMenu, i)
* Endfor
* eof: _system.txt
********************
*********************
*> File: _startup.prg
*
* Этот код запускается через переменную _startup в config.fpw
IF TYPE('_oBrowser') <> 'O'
IF DOW(DATE(), 2) = 1 && понедельник
USE (HOME() + 'Browser')
SCAN for Updated < GOMONTH(DATE(), -3) AND ;
NOT UPPER(TRIM(type)) == 'ADDIN' AND ;
NOT UPPER(TRIM(id)) == 'BROWSER'
DELETE
ENDSCAN
PACK
USE in Browser
ENDIF && DOW(DATE(), 2) = 1 && понедельник
ENDIF && IF TYPE('_oBrowser') <> 'O'
* Восстановление буфера (см. _quit.txt , _default.txt)
IF FILE('_cliptext.TMP') AND FDATE('_cliptext.TMP') > DATE() - 7
_cliptext = FileToStr('_cliptext.TMP')
ENDIF
* В файле _last.TMP записаны гор.ключи запуска последнего класса в
* браузере и в дизайнере классов.
* См. файлы _quit.txt , _default.txt
IF FILE('_last.TMP') AND FDATE('_last.TMP') > DATE() - 7
DO _last.TMP
ENDIF
IF NOT FILE('_quit.txt')
set func 10 to 'QUIT;'
ENDIF
IF NOT FILE('_default.txt')
set func 11 to
ENDIF
IF NOT FILE('_system.txt')
* Этот фокус сделан, чтобы успела пройти команда COMMAND=DO _system.txt в
* config.fpw. В конфиге _STARTUP= и COMMAND= должны идти одна за другой.
ON ERROR *
KEYBOARD "on error" + chr(13)
ENDIF
* eof: _startup.prg
********************
*********************
*> File: _default.txt
***- Этот модуль запускается из оболочки FoxPro по F11 для создания среды
***- разрабатываемой системы. Определение F11 производится в config.fp(w)
***- (см. определение функциональных клавиш в config и в конце start_file)
SET TALK OFF
***- <<<<<<<<<< start_file - имя головного файла задачи >>>>>>>>>>
***- Hастройка: start_file писать с расширением, если не *.prg
***- start_file пишется, также, в config.fpw
*start_file = 'StartUp.PRG'
*start_file = 'Main.PRG'
start_file = '' && для _default.txt, находящегося в каталоге ФоксПро
***------------------------------------------------------------------------
on error *
close all
set procedure to
set library to
set classlib to
set help on
*set help to foxhelp && for 2.X
set device to screen
*set printer off
*set printer to PRN:
deactivate window all
clear dlls
clear windows
clear popups
*clear prompt
on error
set udfparms to values
set sysmenu to
set sysmenu to default
*set color to W+/B,W+/BG,n/n
activate screen
clear
_cliptext = ''
IF FILE('_cliptext.TMP')
DELETE FILE _cliptext.TMP
ENDIF
IF FILE('_last.TMP')
DELETE FILE _last.TMP
ON KEY LABEL Alt+L
ON KEY LABEL Shift+F3
ON KEY LABEL Shift+F4
ENDIF
on key label F1
on key label F2
on key label F3
on key label F4
on key label F5
on key label F6
on key label F7
on key label F8
on key label F9
on key label F10
on key label F12
private f_2,f_3,f_4,f_5,f_6,f_7,f_8,f_9,f_10,f_11,f_12
private d_1,d_2,d_3,d_4,d_5,d_6,d_7,d_8,d_9,d_10 && для f12
private i, j, txt12, save_0, lc_0, com1, com2, com3, str
* установки для функциональных клавиш такие же и в config.fp(w)
* переопределение f2-f10 делается из-за их использования в задаче
* f11 идет из config.fp(w)
set func 2 to 'use ?;'
set func 3 to 'modify structure ;'
set func 4 to 'modify command ?;'
set func 5 to 'display structure ;'
set func 6 to 'display status ;'
set func 7 to 'display memory ;'
set func 8 to 'display objects ;'
set func 9 to 'dir *.* ;'
set func 10 to 'do _quit.txt;'
txt12 = 'on error *;deactivate menu all;clear menus;cancel program;' + ;
'clear program;clear all;on error;' + ;
IIF(Empty(start_file), '', 'do '+start_file+';')
set func 12 to (txt12)
******
if file('_system.txt')
* настройка среды и системного меню FoxPro данной задачи
DO _system.txt
else
if file(home() + '_system.txt') && default
*= sys(2002)
SET CURSOR OFF
str = 'Стартует ' + home() + '_system.txt'
wait window str timeout(2)
DO (home() + '_system.txt')
endif
endif
******
* Перенос в переменные памяти (f_2 - f_12) текстов команд, закрепленных
* за функциональными клавишами, для выдачи информации об ФК на дисплей
* только для клавиш f2-f11 с одним знаком ";" , т.к. он закрывает get
* Для f12 имеется свой кусок кода
* кол-во знаков ";" в f12 за минусом 1 работает ниже в for/endfor
* {код для f1-f11 используется в c:\foxpro\_help.prg (наша помощь)}
*
*= sys(2002)
SET CURSOR OFF
* save_0 = SET("color") && save the system's color setting.
* цвет фона
* lc_0=trim(chrtran(substr(save_0,at('/',save_0)+1,2) ,","," "))
* чтобы не видеть get
* com1='SET COLOR TO '+lc_0+'/'+lc_0+','+lc_0+'/'+lc_0
* &com1
clear
clear typeahead
store space(80) to f_2,f_3,f_4,f_5,f_6,f_7,f_8,f_9,f_10,f_11,f_12
store space(80) to d_1,d_2,d_3,d_4,d_5,d_6,d_7,d_8,d_9,d_10 && для f12
FOR i=2 to 12
* get`ы для keyboard`ов
com1="@ "+ltrim(str(i-1))+",0 get f_"+ltrim(str(i))
&com1
IF i=12
* кол-во знаков ";" в f12 за минусом 1
FOR j=1 to OCCURS(';', txt12) - 1
* дополнительные get`ы для f12
com2="@ "+ltrim(str(i-1+j))+",0 get d_"+ltrim(str(j))
&com2
ENDFOR
ENDIF
* keyboard '{Fxx}' в цикле
com3="keyboard '{f"+ltrim(str(i))+"}'"
&com3
ENDFOR
READ && закрывает read последний знак ";"
clear typeahead
* SET color to &save_0 && restore the system's color
clear
* infomation about FK to display
* @ 2,5 say iif(empty(on('key','rightmouse')),"","RightMouse - "+ ;
* lower(on('key','rightmouse')))
* @ 3,5 say iif(empty(on('key','alt+f4')),"" ,"Alt + F4 - "+ ;
* lower(on('key','alt+f4')))
* @ 5,5 say 'Функциональные клавиши:'
@ 3,5 say 'Функциональные клавиши:' font 'Courier',10
FOR i=2 to 12
com1="@ "+ltrim(str(3+i))+",5 say 'F"+ltrim(str(i))+"'"
com2="@ "+ltrim(str(3+i))+",10 say '- '+lower(f_"+ltrim(str(i))+")"
&com1
&com2
IF i=12
for j=1 to OCCURS(';', txt12) - 1 && та же цифра, что и выше
com3="@ "+ltrim(str(3+i+j))+",13 say lower(d_"+ltrim(str(j))+")"
&com3
endfor
ENDIF
ENDFOR
*****
*= sys(2002, 1)
SET CURSOR ON
return
* eof: _default.txt
*******************