В программе используется пара control-шаблонов "Button_Help" и "MoveUpDown", которые входят в мой набор шаблонов GSM_Tools. Этот набор шаблонов можно взять со странички "Верстак" нашего сайта http://pisoft.da.ru Естественно, шаблоны нужно положить в подкаталог Template и "зарегистрировать" в вашем Clarion-e.
Хотя этот пример программки "Hints" реализует ее как exe-файл, на самом деле, удобнее реализовать ее в виде DLL. Это позволит интегрировать ее в Вашу программу в виде MDI-окна.
Эта процедура запускается первой при запуске программы, поэтому в ней производятся некоторые инициализируюшие действия. Сначала при помощи функции GetModuleFileName находится путь, откуда был запущен файл Hints.exe. Этот путь дальше используется для поиска файлов базы данных программы и файлов подсистемы помощи. Для задания имен файлов базы данных используется прием, позволяющий переопределить их имена (и пути) через переменные Tips_file и TipGroup_file в файле Hints.ini
! Действительный путь,
откуда запустился Exe-файл:
g:AppFileName = ''
r# = GetModuleFileName( System{PROP:AppInstance}, g:AppFileName, Size(g:AppFileName) )
if r# <> 0
g:ProgPath = sub( g:AppFileName, 1, len(clip(g:AppFileName))-len('Hints.exe') ) !
Вычесть длину строки
else
g:ProgPath = Path()
if sub( g:ProgPath,1,len(clip(g:ProgPath)) ) <> '\'
g:ProgPath = clip(g:ProgPath) & '\'
.
.
! Путь к файлам помощи
g:HelpPath = clip(g:ProgPath) & 'Help\'
g:File = GetIni( 'HINTS', 'Tips_file', '', clip(g:ProgPath) & 'Hints.ini' )
if g:File = ''
Tips_file = clip(g:ProgPath) & 'Tips.tps'
.
g:File = GetIni( 'HINTS', 'TipGroup_file', '', clip(g:ProgPath) & 'Hints.ini' )
if g:File = ''
TipGroup_file = clip(g:ProgPath) & 'TipGroup.tps'
.
if Command('1') = ''
Hints_t
else
HintsEd
.
Код в конце процедуры проверяет
наличие нараметра в командной строке при запуске
программы и запускает, соответственно, либо
процедуру вывода советов Hints_t,
либо Редактор советов HintsEd.
Чтобы сократить себе число нажатий на клавиши и дать возможность в будующем изменить способ хранения "долговременной" информации я "заворачиваю" вызовы getini() и putini() в свои процедуры:
GetI FUNCTION (Section_,Param_,Value_)
return( getini(Section_, Param_, Value_, clip(g:ProgPath) & 'Hints.ini') )
PutI PROCEDURE (Section_,Param_,Value_)
putini( Section_, Param_, Value_, clip(g:ProgPath) & 'Hints.ini' )
В этой процедуре используется скрытая таблица ?Browse:1 для облегчения перемещения между советами.
В самом начале анализируется, не отключен ли вывод советов:
g:DontShow = getINI( 'HINTS', 'DontShow', '', clip(g:ProgPath)
& 'Hints.ini' )
if g:DontShow = True
do ProcedureReturn
.
Этот код, выполняемый после открытия окна,
включает режим "alvas on top"
! Включить
"непотопляемость" окна
POST(Event:Suspend,,1) ! Suspend timer on frame
POST(Event:Restore,,1) ! Restore frame
THIS{PROP:Hide}=FALSE ! Unhide window
THIS{PROP:Active}=TRUE ! Bring to foreground
THIS{PROP:Iconize}=FALSE
Error# = SetForegroundWindow( THIS{Prop:Handle} ) ! Bring to foreground
POST(Event:Resume,,1) ! Resume timer on frame
r# = SetWindowPos( THIS{PROP:Handle},-1,0,0,0,0,bor(1,2) )
Здесь константа THIS
определена в каком то заголовочном файле как
эквивалент цифры 0.
Для перемещения к последнему открываемому совету после открытия окна я использую скрытую таблицу ?Browse:1
! Найти последний
открываемый документ
g:LastNumber = getI( 'HINTS', 'LastNumber', '' )
loc:GroupID = getI( 'HINTS', 'GroupID', '1' )
tgr:GroupID = loc:GroupID
get( TipGroup, tgr:Group_key )
if errorcode() then clear( tgr:Record ) .
loc:GroupDescr = tgr:Description
tip:Tip_Number = getI( 'HINTS', 'Tip_Number', '' )
loop x#=1 to tip:Tip_Number
post( event:ScrollDown, ?Browse:1 )
.
Чтобы кнопки ?Button_Next и ?Button_Prev
работали не только внутри одной группы пришлось
дописать свой код для перехода из одной группы в
другую:
! ?Button_Next.Accepted
tip:GroupID = loc:GroupID
next( Tips )
if errorcode()
! Перейти к первой группе
loc:GroupID = 1
tgr:GroupID = 1
get( TipGroup, tgr:Group_key )
if errorcode() then clear( tgr:Record ) .
loc:GroupDescr = tgr:Description
ForceRefresh = True
do RefreshWindow
elsif tip:GroupID <> loc:GroupID
! Перейти к следующей группе
loc:GroupID = tip:GroupID
tgr:GroupID = tip:GroupID
get( TipGroup, tgr:Group_key )
if errorcode() then clear( tgr:Record ) .
loc:GroupDescr = tgr:Description
ForceRefresh = True
do RefreshWindow
else
post( EVENT:ScrollDown, ?Browse:1 )
.
putI( 'HINTS', 'LastNumber', tip:SysId )
putI( 'HINTS', 'Tip_Number', tip:Tip_Number )
putI( 'HINTS', 'GroupID', tip:GroupID )
Чтобы дать возможность редактировть текст совета не в форме, а прямо в окне с таблицами, пришлось добавить локальную переменную для вывода текста совета loc:Memo и написать несколько строчек кода для вывода текста совета в это поле и сохранения отредактированного текста в файле.
! ?Browse:1.Newselection
do SyncWindow
loc:Memo = tip:Tip
display( ?loc:Memo )
! ?loc:Memo.Accepted
tip:Tip = loc:Memo
put( Tips )
if errorcode()
Message( 'Ошибка=' & error() )
.
display()