-Музыка

 -Подписка по e-mail

 

 -Поиск по дневнику

Поиск сообщений в xpackpackax

 -Статистика

Статистика LiveInternet.ru: показано количество хитов и посетителей
Создан: 09.01.2009
Записей:
Комментариев:
Написано: 1835


Без заголовка

Четверг, 10 Сентября 2009 г. 17:09 + в цитатник
Строка статуса

В следующей программе создается строка статуса, содержание которой зависит от установленного контекста подсказки (определяется значением поля TProgram.HelpCtx). В зависимости от действий пользователя эта строка будет содержать текст

Esc Выход F1 Сменить контекст на 1

Однажды в студеную, зимнюю пору

либо

ESC Выход F2 Сменить контекст на 0

Я из лесу вышел. Был сильный мороз...

Переключение строки осуществляется клавишами F1 и F2, для выхода из программы используется клавиша Esc.

Uses Objects,App,Menus,Drivers,Views;

type

PMyStatusLine = TMyStatusLine;

TMyStatusLine = object (TStatusLine)

Function Hint(Cntx: Word): String; Virtual;

end;

MyApp = object (TApplication)

StatLine: PMyStatusLine;

Constructor Init;

Procedure InitStatusLine; Virtual;

Procedure HandleEvent(var Event: Tevent); Virtual;

end;

const

cmCntxl =200;

cmCntx2 = 201;

{-----------------}

Constructor MyApp.Init ;

begin

Inherited Init;

Insert (StatLine) {Использовать нестандартную строку статуса}

end {MyApp .Init} ;

Procedure MyApp. Ini tstatusLine ;

{Инициация нестандартного поля MyApp. StatLine}

var

R: Trect;

begin

GetExtent (R) ;

R.A.Y := pred(R.B.Y) ;

StatLine := New(PMyStatusLine, Init(R,

NewStatusDef (0, 0, {Первый вариант строки}

NewStatusKey ( ' ~Esc~ Выход1 , kbEsc, cmQuit,

NewStatusKey (' ~F1~ Сменить контекст на 1', kbF1 , cmCntxl , NIL) ) ,

NewStatusDef (1, 1, {Второй вариант строки}

NewStatusKey (' ~Esc~ Выход ', kbEsc, cmQuit,

NewStatusKey (' ~F2~ Сменить контекст на 0 ' , kbF2 , cmCntx2 , NIL)) ,

NIL) ) ) ) ; end {MyApp. Ini tstatusLine} ;

{--------------------}

Procedure MyApp. HandleEvent;

{Переключение контекста и обновление строки статуса}

begin

Inherited HandleEvent (Event) ;

case Event . Command of

cmCntxl: HelpCtx := 1;

cmCntx2: HelpCtx := 0;

else

ClearEvent (Event) ;

end;

if Event. What <> evNothing then

begin

StatLine. Update;

ClearEvent (Event)

end

end {MyApp . HandleEvent } ;

{---------------------}

Function TMyStatusLine. Hint (Cntx: Word):String;

{Переключение поля подсказки}

const

Prompt: array [0..1] of String =(

'Однажды в студеную, зимнюю пору',

'Я из лесу вышел. Был сильный мороз...');

begin

Hint : = Prompt [Cntx]

end {TMyStatusLine.Hint} ;

{---------------------}

var

P : MyApp ;

begin

P.Init;

P . Run ;

P . Done

end .

 

Добавить комментарий:
Текст комментария: смайлики

Проверка орфографии: (найти ошибки)

Прикрепить картинку:

 Переводить URL в ссылку
 Подписаться на комментарии
 Подписать картинку