|
;
|
(******************************************************************************
* Знаки на экране
******************************************************************************)
ЗАДАЧА СоздатьУказку;
УКАЗ
ЕСЛИ размерУказки > 0 ТО
CreateCaret(hWnd,0,размерЗнака.x-1,размерУказки);
SetCaretPos(указка.к*размерЗнака.x,(указка.с+1)*размерЗнака.y-размерУказки);
ShowCaret(hWnd)
КОН;
КОН СоздатьУказку;
(******************************************************************************)
ЗАДАЧА УдалитьУказку;
УКАЗ
ЕСЛИ размерУказки > 0 ТО
DestroyCaret
КОН
КОН УдалитьУказку;
(******************************************************************************)
ЗАДАЧА Запятнать(вс,лк,нс,пк:ЦЕЛ);
(* Цель: пометить данную область, как требующую перирисовки
* До: <вс>,<лк>,<нс>,<пк> - границы области *)
ПЕР
rect:RECT;
УКАЗ
rect.Left :=лк*размерЗнака.x;
rect.Top :=вс*размерЗнака.y;
rect.Right :=(пк+1)*размерЗнака.x;
rect.Bottom:=(нс+1)*размерЗнака.y;
InvalidateRect(hWnd,rect,0)
КОН Запятнать;
(******************************************************************************)
ЗАДАЧА Отрисовка;
ПЕР
ps:PAINTSTRUCT;
hdc:ЦЕЛ;
rect:RECT;
нс,нк,с,к,пс,пк:ЦЕЛ; (* начальная, текущая, последняя строка и колонка *)
нx,нy:ЦЕЛ; (* начальные координаты окна *)
цвЗнак:ЦвЗнак.Вид; (* текущий обрабатываемый знак *)
цвет:ЗНАК;
УКАЗ
(* начинаем отрисовку *)
hdc:=BeginPaint(hWnd,ps);
SelectObject(hdc,hfont);
SetTextAlign(hdc,TA_CENTER);
(* границы вывода *)
нс:= ps.rcPaint.Top ДЕЛИТЬ размерЗнака.y;
пс:=(ps.rcPaint.Bottom-1) ДЕЛИТЬ размерЗнака.y;
нк:= ps.rcPaint.Left ДЕЛИТЬ размерЗнака.x;
пк:=(ps.rcPaint.Right-1) ДЕЛИТЬ размерЗнака.x;
нy:=нс*размерЗнака.y;
нx:=нк*размерЗнака.x;
УВЕЛИЧИТЬ(пк); (* барьер *)
цвет:=МАКС(ЗНАК);
(* пробегаем по всем знакам *)
rect.Top:=нy;
ОТ с:=нс ДО пс ВЫП
rect.Left:=нx;
ОТ к:=нк ДО пк ВЫП
цвЗнак:=окно[с][к];
ЕСЛИ цвЗнак.цвет # МАКС(ЗНАК) ТО
ЕСЛИ цвЗнак.цвет # цвет ТО
цвет:=цвЗнак.цвет;
SetTextColor(hdc,КЗСцвета[ВЦЕЛ(цвЗнак.цвет) ОСТАТОК 10H]);
SetBkColor (hdc,КЗСцвета[ВЦЕЛ(цвЗнак.цвет) ДЕЛИТЬ 10H]);
КОН;
rect.Right:=rect.Left+размерЗнака.x;
rect.Bottom:=rect.Top+размерЗнака.y;
ExtTextOut(
hdc, rect.Left+полуширинаЗнака, rect.Top, ETO_OPAQUE+ETO_CLIPPED, rect, цвЗнак.знак, 1,0
)
КОН;
УВЕЛИЧИТЬ(rect.Left,размерЗнака.x)
КОН;
УВЕЛИЧИТЬ(rect.Top,размерЗнака.y)
КОН;
(* заканчиваем отрисовку *)
EndPaint(hWnd,ps)
КОН Отрисовка;
(******************************************************************************)
ЗАДАЧА Клавиши(код,мкод:ЦЕЛ);
ПЕР
состояние:СостояниеКлавиш;
УКАЗ
ЕСЛИ (код = 10H) (* просто шифт - Shift *)
ИЛИ (код = 11H) (* просто контр - Ctrl *)
ИЛИ (код = 12H)
ТО (* просто альт - Alt *)
ВОЗВРАТ
КОН;
отКлавиш.код:=код;
отКлавиш.мкод:=мкод;
отКлавиш.упрКнопки:={};
отКлавиш.упрАльт :=ОТКЛ;
отКлавиш.упрКонтр:=ОТКЛ;
отКлавиш.упрШифт :=ОТКЛ;
GetKeyboardState(состояние);
ToUnicode(код,мкод,состояние,отКлавиш.знак,1,0);
ЕСЛИ состояние[VK_RMENU] < 0 ТО
отКлавиш.упрКнопки:=отКлавиш.упрКнопки+{Ввод.пАльт};
отКлавиш.упрАльт:=ВКЛ
КОН;
ЕСЛИ состояние[VK_LMENU] < 0 ТО
отКлавиш.упрКнопки:=отКлавиш.упрКнопки+{Ввод.лАльт};
отКлавиш.упрАльт:=ВКЛ
КОН;
ЕСЛИ состояние[VK_RCONTROL] < 0 ТО
отКлавиш.упрКнопки:=отКлавиш.упрКнопки+{Ввод.пКонтр};
отКлавиш.упрКонтр:=ВКЛ
КОН;
ЕСЛИ состояние[VK_LCONTROL] < 0 ТО
отКлавиш.упрКнопки:=отКлавиш.упрКнопки+{Ввод.лКонтр};
отКлавиш.упрКонтр:=ВКЛ
КОН;
ЕСЛИ (состояние[VK_RSHIFT] < 0) ИЛИ (состояние[VK_LSHIFT] < 0) ТО
отКлавиш.упрКнопки:=отКлавиш.упрКнопки+{Ввод.шифт};
отКлавиш.упрШифт:=ВКЛ
КОН;
ЕСЛИ НЕ ЧЕТ(состояние[VK_NUMLOCK]) ТО
отКлавиш.упрКнопки:=отКлавиш.упрКнопки+{Ввод.нумЛок}
КОН;
ЕСЛИ НЕ ЧЕТ(состояние[VK_SCROLL]) ТО
отКлавиш.упрКнопки:=отКлавиш.упрКнопки+{Ввод.скролЛок}
КОН;
ЕСЛИ НЕ ЧЕТ(состояние[VK_CAPITAL]) ТО
отКлавиш.упрКнопки:=отКлавиш.упрКнопки+{Ввод.капсЛок}
КОН;
родПосылки:=Ввод.клавиши
КОН Клавиши;
(******************************************************************************)
ЗАДАЧА* ОконнаяЗадача(hWnd,message,wParam,lParam:ЦЕЛ):ЦЕЛ;
(* Вызывается из ОС Win32 *)
ВИД
MINMAXINFOPTR=ДОСТУП К MINMAXINFO;
ПЕР
mmi:MINMAXINFOPTR;
ЗАДАЧА Мышка(кнопки,события:МНОЖ);
УКАЗ
отМышки.кнопки:=кнопки;
отМышки.события:=события;
отМышки.к:=(lParam ОСТАТОК 10000H) ДЕЛИТЬ размерЗнака.x;
отМышки.с:=(lParam ДЕЛИТЬ 10000H) ДЕЛИТЬ размерЗнака.y;
отМышки.упрКнопки:=ОБХОД.Значение(МНОЖ,wParam ОСТАТОК 10000H);
отМышки.прокрут:=wParam ДЕЛИТЬ (10000H*120);
отМышки.отработана:=ОТКЛ;
родПосылки:=Ввод.мышка
КОН Мышка;
УКАЗ
ВЫБРАТЬ message ИЗ
| WM_CREATE: естьОчередь:=ВКЛ
| WM_DESTROY: естьОчередь:=ОТКЛ
| WM_PAINT: Отрисовка
| WM_KEYDOWN,
WM_SYSKEYDOWN: Клавиши(wParam,(lParam ДЕЛИТЬ 10000H) ОСТАТОК 100H)
| WM_TIMER: ЕСЛИ ЗадачаЧасы # ПУСТО ТО
ЗадачаЧасы(wParam)
КОН
| WM_SETFOCUS: СоздатьУказку
| WM_KILLFOCUS: УдалитьУказку
| WM_ERASEBKGND: ВОЗВРАТ 1
| WM_GETMINMAXINFO:
mmi:=ОБХОД.Значение(MINMAXINFOPTR,lParam);
mmi.ptMaxTrackSize:=размерОкна;
mmi.ptMinTrackSize:=размерОкна;
ИНАЧЕ (* большие номера message *)
ВЫБРАТЬ message ИЗ
| WM_LBUTTONDBLCLK: Мышка({ Ввод.левая},{Ввод.щелк2 })
| WM_LBUTTONDOWN: Мышка({ Ввод.левая},{ })
| WM_RBUTTONDBLCLK: Мышка({ Ввод.правая},{Ввод.щелк2 })
| WM_RBUTTONDOWN: Мышка({ Ввод.правая},{ })
| WM_MBUTTONDBLCLK: Мышка({Ввод.средняя},{Ввод.щелк2 })
| WM_MBUTTONDOWN: Мышка({Ввод.средняя},{ })
| WM_MOUSEWHEEL: Мышка({ },{Ввод.прокрут})
| WM_LBUTTONUP,WM_RBUTTONUP,WM_MBUTTONUP:
Мышка({ },{ })
ИНАЧЕ
ВОЗВРАТ DefWindowProc(hWnd,message,wParam,lParam)
КОН
КОН;
ВОЗВРАТ 0
КОН ОконнаяЗадача;
(******************************************************************************)
ЗАДАЧА Подготовить-(имяПриложения-, имяШрифта-:ЦЕПЬ;
размерШрифта:ЦЕЛ;
задачаЧасы:ВидЗадачиЧасы);
ПЕР
hdc:ЦЕЛ;
wndClass:WNDCLASS;
logFont:LOGFONT;
УКАЗ
hInstance:=GetModuleHandle(0);
ЗадачаЧасы:=задачаЧасы;
(* указка *)
размерУказки:=0;
указка.с:=0;
указка.к:=0;
(* красно-зелёно-синий состав цвета *)
КЗСцвета[ 0]:=0000000H;
КЗСцвета[ 1]:=0900000H;
КЗСцвета[ 2]:=0009000H;
КЗСцвета[ 3]:=0909000H;
КЗСцвета[ 4]:=0000090H;
КЗСцвета[ 5]:=0900090H;
КЗСцвета[ 6]:=0009090H;
КЗСцвета[ 7]:=0C0C0C0H;
КЗСцвета[ 8]:=0808080H;
КЗСцвета[ 9]:=0FF0000H;
КЗСцвета[10]:=000FF00H;
КЗСцвета[11]:=0FFFF00H;
КЗСцвета[12]:=00000FFH;
КЗСцвета[13]:=0FF00FFH;
КЗСцвета[14]:=000FFFFH;
КЗСцвета[15]:=0FFFFFFH;
(* прописываем оконный класс *)
wndClass.style:=CS_HREDRAW+CS_VREDRAW;
wndClass.lpfnWndProc:=ОконнаяЗадача;
wndClass.cbClsExtra:=0;
wndClass.cbWndExtra:=0;
wndClass.hInstance:=hInstance;
wndClass.hIcon:=LoadIcon(0,IDI_APPLICATION);
wndClass.hCursor:=LoadCursor(0,IDC_ARROW);
wndClass.hbrBackground:=0;
wndClass.lpszMenuName:=0;
wndClass.lpszClassName:=ОБХОД.ПолучитьАдрес(имяПриложения);
RegisterClass(wndClass);
(* создаём окно *)
размерОкна.x:=200;
размерОкна.y:=200;
hWnd:=CreateWindowEx(0,имяПриложения,имяПриложения,WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,hInstance,0);
(* подбор шрифта *)
ОБНУЛИТЬ(logFont);
logFont.lfPitchAndFamily:=FIXED_PITCH;
logFont.lfHeight:=размерШрифта;
СПИСАТЬ(имяШрифта,logFont.lfFaceName);
(* размер знака и экрана *)
hdc:=GetDC(hWnd);
hfont:=CreateFontIndirect(logFont);
SelectObject(hdc,hfont);
GetTextExtentPoint32(hdc,"А",1,размерЗнака);
полуширинаЗнака:=размерЗнака.x ДЕЛИТЬ 2;
размерЭкрана.с:=(GetDeviceCaps(hdc,VERTRES)+размерЗнака.y-1) ДЕЛИТЬ размерЗнака.y;
размерЭкрана.к:=(GetDeviceCaps(hdc,HORZRES)+размерЗнака.x-1) ДЕЛИТЬ размерЗнака.x;
ReleaseDC(hWnd,hdc);
(* память для знаков и барьера *)
СОЗДАТЬ(окно,размерЭкрана.с,размерЭкрана.к+1);
КОН Подготовить;
(******************************************************************************)
ЗАДАЧА Отработать-;
(* Цель: внутренняя отработка ОС накопившихся посылок *)
ПЕР
msg:MSG;
УКАЗ
ПОКА естьОчередь И (PeekMessage(msg,0,0,0,PM_REMOVE) # 0) ВЫП
DispatchMessage(msg)
КОН
КОН Отработать;
(******************************************************************************)
ЗАДАЧА ПоказатьОкно-;
УКАЗ
ShowWindow(hWnd,SW_SHOWDEFAULT)
КОН ПоказатьОкно;
(******************************************************************************)
ЗАДАЧА СоздатьЧасы-(номер,время:ЦЕЛ):ЦЕЛ;
(* Цель: добавляет новые, или заменяет старые часы
* До: <номер> - опознавательный номер часов
* <время> - время повторения срабатывания данных часов в мс
* Ответ: номер для удаления часов *)
ПЕР
ответ:ЦЕЛ;
УКАЗ
ответ:=SetTimer(hWnd,номер,время,ПУСТО);
ЕСЛИ ответ # 0 ТО
ответ:=номер
КОН;
ВОЗВРАТ ответ
КОН СоздатьЧасы;
(******************************************************************************)
ЗАДАЧА УдалитьЧасы-(часы:ЦЕЛ);
УКАЗ
KillTimer(hWnd,часы)
КОН УдалитьЧасы;
(******************************************************************************)
ЗАДАЧА РазмерЭкрана-(строк+,колонок+:ЦЕЛ);
(* Цель: возвращает размер экрана *)
УКАЗ
строк :=размерЭкрана.с;
колонок:=размерЭкрана.к
КОН РазмерЭкрана;
(******************************************************************************)
ЗАДАЧА ИзменитьРазмерОкна-(строк,колонок:ЦЕЛ);
(* Цель: изменить размер окна *)
ПЕР
rect:RECT;
УКАЗ
ЕСЛИ (строк > РАЗМЕР(окно^,0)) ИЛИ (колонок+1 > РАЗМЕР(окно^,1)) ТО
(* память для знаков и барьера *)
СОЗДАТЬ(окно,строк,колонок+1)
КОН;
rect.Left :=0;
rect.Top :=0;
rect.Right :=колонок*размерЗнака.x;
rect.Bottom:=строк*размерЗнака.y;
AdjustWindowRect(rect,WS_OVERLAPPEDWINDOW,0);
размерОкна.x:=rect.Right-rect.Left;
размерОкна.y:=rect.Bottom-rect.Top;
SetWindowPos(hWnd,0,0,0,размерОкна.x,размерОкна.y,SWP_NOMOVE);
КОН ИзменитьРазмерОкна;
(******************************************************************************)
ЗАДАЧА Опрос-(отКлавиш+:Ввод.ОтКлавиш; отМышки+:Ввод.ОтМышки):ЦЕЛ;
(* Цель: опрос ОС на наличие посылок от пользователя *)
ПЕР
msg:MSG;
УКАЗ
родПосылки:=Ввод.пустой;
ПОКА естьОчередь И (родПосылки = Ввод.пустой) ВЫП
GetMessage(msg,0,0,0);
DispatchMessage(msg)
КОН;
ЕСЛИ НЕ естьОчередь ТО
родПосылки:=Ввод.закрыт
КОН;
ЕСЛИ родПосылки = Ввод.клавиши ТО
отКлавиш:=ГОС.отКлавиш
АЕСЛИ родПосылки = Ввод.мышка ТО
отМышки:=ГОС.отМышки
КОН;
ВОЗВРАТ родПосылки
КОН Опрос;
(******************************************************************************)
ЗАДАЧА ПереместитьУказку-(с,к:ЦЕЛ);
УКАЗ
указка.с:=с;
указка.к:=к;
SetCaretPos(указка.к*размерЗнака.x,(указка.с+1)*размерЗнака.y-размерУказки)
КОН ПереместитьУказку;
(******************************************************************************)
ЗАДАЧА РазмерУказки-(размер:ЦЕЛ);
(* <размер> указывается в процентах,
* при <размер> = 0 указка убирается с экрана *)
УКАЗ
УдалитьУказку;
размерУказки:=УЗК(ВШИРЦЕЛ(размерЗнака.y*размер/100));
СоздатьУказку
КОН РазмерУказки;
(******************************************************************************)
ЗАДАЧА ПисатьЦвет-(с,к:ЦЕЛ; цвет:ЗНАК);
УКАЗ
окно[с][к].цвет:=цвет;
Запятнать(с,к,с,к)
КОН ПисатьЦвет;
(******************************************************************************)
ЗАДАЧА ПисатьЗнак-(с,к:ЦЕЛ; знак:ЗНАК);
УКАЗ
окно[с][к].знак:=знак;
Запятнать(с,к,с,к)
КОН ПисатьЗнак;
(******************************************************************************)
ЗАДАЧА ЧитатьЗнак-(с,к:ЦЕЛ):ЗНАК;
УКАЗ
ВОЗВРАТ окно[с][к].знак
КОН ЧитатьЗнак;
(******************************************************************************)
ЗАДАЧА ЧитатьЦвет-(с,к:ЦЕЛ):ЗНАК;
УКАЗ
ВОЗВРАТ окно[с][к].цвет
КОН ЧитатьЦвет;
(******************************************************************************)
ЗАДАЧА ПисатьСтроку-(цвСтрока-:ЦвЗнак.Строка; с,к,длина:ЦЕЛ);
(* Цель: отрисовка содержимого строки
* До: <с>,<к> - начало строки на экране
* <длина> - длина строки *)
(******************************************************************************)
ПЕР
поз:ЦЕЛ;
УКАЗ
Запятнать(с,к,с,к+длина-1);
ОТ поз:=0 ДО длина-1 ВЫП
окно[с][к]:=цвСтрока[поз];
УВЕЛИЧИТЬ(к)
КОН
КОН ПисатьСтроку;
(******************************************************************************)
ЗАДАЧА Вверх-(вс,лк,нс,пк:ЦЕЛ; новЗнак-:ЦвЗнак.Вид);
(* Цель: сдвиг содержимого заданной области окна вверх
* До: <вс>,<лк>,<нс>,<пк> - границы области
* <новЗнак> - знак для заполнения освободившегося места *)
ПЕР
к,с:ЦЕЛ;
УКАЗ
ОТ с:=вс ДО нс-1 ВЫП
ОТ к:=лк ДО пк ВЫП
окно[с][к]:=окно[с+1][к]
КОН
КОН;
ОТ к:=лк ДО пк ВЫП
окно[нс][к]:=новЗнак
КОН;
Запятнать(вс,лк,нс,пк)
КОН Вверх;
(******************************************************************************)
ЗАДАЧА Вниз-(вс,лк,нс,пк:ЦЕЛ; новЗнак-:ЦвЗнак.Вид);
(* Цель: сдвиг содержимого данной области окна вниз
* До: <вс>,<лк>,<нс>,<пк> - границы области
* <новЗнак> - знак для заполнения освободившегося места *)
ПЕР
к,с:ЦЕЛ;
УКАЗ
ОТ с:=нс ДО вс+1 ПО -1 ВЫП
ОТ к:=лк ДО пк ВЫП
окно[с][к]:=окно[с-1][к]
КОН
КОН;
ОТ к:=лк ДО пк ВЫП
окно[вс][к]:=новЗнак
КОН;
Запятнать(вс,лк,нс,пк)
КОН Вниз;
(******************************************************************************)
УКАЗ
естьОчередь:=ОТКЛ
КОН ГОС.
|
|
Программируем по-русски