Сравнительный анализ методов определения индекса пожарной опасности по российской и канадской системам
Важность определения показателя пожарной опасности. Анализ российской и канадской систем определения индекса пожарной опасности по условиям погоды на территории Красноярского края. Разработка программного обеспечения на языке программирования Delphi.
| Рубрика | Программирование, компьютеры и кибернетика |
| Вид | дипломная работа |
| Язык | русский |
| Дата добавления | 10.05.2011 |
| Размер файла | 1,2 M |
Отправить свою хорошую работу в базу знаний просто. Используйте форму, расположенную ниже
Студенты, аспиранты, молодые ученые, использующие базу знаний в своей учебе и работе, будут вам очень благодарны.
4. Увлажнение слоя РГМ за счет подъема капиллярной влаги на сырых почвах;
5. Различия в увлажнении осадками в связи с их неравномерным выпадением на территории;
6. Влияние фенологического состояния растительности.
Создание моделей, учитывающих все факторы, вряд ли возможно. Однако существует возможность учета некоторых особенностей развития пожарной опасности в данном районе на основе анализа статистически-закономерных, повторяющихся или не изменяющихся в течение пожароопасного сезона особенностей. Отсюда логично вытекают местные шкалы пожарной опасности, основанные на долгосрочных эмпирических наблюдениях. В России местные шкалы стали использоваться уже с 1955 года [19]. В Канаде местные шкалы были составлены лишь в 1983 году путем анализа региональных данных за 1953-1980 гг. о величине индекса FWI и о горимости лесов. В тоже время предлагаемая в данной работе методика оценки пожарной опасности с помощью спутниковых средств оперирует исходными данными, характеризующими физические параметры непосредственно проводников горения. И часть ограничений, приведенных выше, может быть оценена для каждого конкретного пикселя спутникового изображения данной территории. Таким образом, в предлагаемой методике привязка к местным шкалам пожарной опасности начинается уже на стадии сбора и предварительной обработки исходных данных, что повышает достоверность конечного показателя пожарной опасности.
5. Эксперементальные результаты и обсуждение
5.1 Общая характеристика программы
Разработанная на базе языка Delphi 7 программа "Gerc" предназначена для расчета показателей пожарной опасности по Канадской системе, для проведения корреляционного анализа Российской и Канадской систем определения индекса пожарной опасности. Позволяет провести анализ изменения индекса в течение сезона, выявить закономерности перемещения максимума пожарной опасности на территории Красноярского края.
Минимальные требования к системным ресурсам:
· Операционная система на платформе Windows;
· Процессор Pentium I;
· 128 МБ ОЗУ;
· Видеокарта 16 МБ;
· Свободное место на жёстком диске 50 Мб;
· Монитор с качеством цветопередачи 256 цветов, разрешением 1024* 768.
5.2 Описание программы
Основу программы составляет статистическая база данных (файл формата txt) составленная путем форматирования файла метеоданных и результатов расчета классов пожарной опасности по условиям погоды. (Приложение 1 П1.)
База данных содержит информацию по каждой метеостанции (код, название, географические координаты, показатель ПВ-1, показатель ПВ-2, класс ПО-1, класс ПО-2, температуру, скорость ветра и количество осадков, по данным красноярской авиабазы) на территории Красноярского края за период с 2004 - 2009 год. Программа позволяет рассчитать шесть показателей пожарной опасности по канадской системе, с возможностью сохранения и последующей загрузки посчитанных результатов в формате txt.
Статистическая база данных необходима для проведения корреляционного анализа Российской и Канадской систем расчета индекса пожарной опасности, для построения картосхем распределения индекса пожарной опасности по данным метеорологических станций и космической информации, для проведения анализа изменения индекса в течение сезона и установления закономерностей перемещения максимума пожарной опасности на территории Красноярского края.
Для проведения корреляционного анализа Российской и Канадской систем определения индекса пожарной опасности, в программу была включена возможность построения графической зависимости (ПВ-1, ПВ-2, FFMC, DMC, DC, ISI, FWI, BUI). Построение происходит согласно данным статистической базы и на основе рассчитанных индексов по Канадской системе. Программа допускает построение одновременно только двух графиков (ПВ-1 и DMC, ПВ-2 и DMC, ПВ-1 и BUI, ПВ-2 и BUI), это необходимо для проведения анализа. Дополнительно программа позволяет воссоздать метеорологическую обстановку и поведение метеорологических станций за весь период с 2004 - 2009 год, для этого строится зависимость ?T и ?W, где ?T - сумма температур, ?W - суммарное количество осадков за весь период времени. зависимость позволяет отнести все метеостанции к 5-ти районам:
1) засушливые, с малым количеством осадков;
2) теплые с небольшим количеством осадков;
3) умеренно сухие, со средними осадками;
4) умеренно холодные, со средним количеством осадков;
5) холодные, с большим количеством осадков. Программа допускает построение графиков для большого количества метеорологических станции за указанный период времени одновременно, одному году для каждой метеостанции соответствует один график определенного цвета.
5.3 Сравнение российской и канадской систем оценки индексов пожарной опасности
Было проведено сравнение эффективности работы индексов пожарной опасности, рассчитанных по российской (ПВ-1) и Канадской национальной системе оценки пожароопасного состояния лесов (CFFDRS) за 2009 год.
Результаты наблюдений по ряду метеостанций Красноярского края показали высокую корреляцию между этими индексами. В ряде случаев коэффициенты корреляции близки к 1. При этом стоит отметить, что наиболее подобен российскому индексу ПВ-1 соответствующий индекс канадской системы DMC (Duff Moisture Code), который показывает степень готовности к воспламенению и поддержанию горения в слое подстилки.
Отличие состоит в том, что канадский индекс менее чувствителен к количественному значению выпавших осадков, особенно к низким значениям в диапазоне 0,5 - 5 мм. В ряде случаев (особенно в условиях долгого периода предварительной сушки) такой подход оправдан, так как не приводил к резкому снижению показателя пожарной опасности. В то же время на графиках, представляющих российскую систему оценки пожарной опасности ПВ-1, в соответствующие сроки наблюдений присутствуют более резкие минимумы. Соответствующие иллюстрации приведены ниже (рис.3).
Рис.3. Сравнение российского показателя ПВ-1 и канадского DMC/CFFDRS по данным метеостанции Ярцево, Богучаны, Ванавара, Бор.
а) м/с Ярцево;
б) м/c Богучаны;
в) м/с Ванавара;
г) м/с Бор;
Рис.4. Индекс влагосодержания FFMC верхних тонких слоев ЛГМ канадской системы CFFDRS, рассчитанный для метеостанций Богучаны и Ярцево. 2009 год.
а) м/с Богучаны;
б) м/с Ярцево;
Состояние тонких верхних слоёв лесных горючих материалов в российской системе не анализируется отдельно. В канадской системе CFFDRS существует специальный показатель FFMC (Fine fuel Moisture Code), описывающий динамику влагосодержания данного типа проводников горения. На рис.4 показан пример расчета такого показателя для метеостанций Богучаны и Ярцево в 2009 году. Показатель FFMC канадской системы наиболее чувствителен к выпадению осадков и снижается даже при незначительном их количестве. Таким образом, можно более детально анализировать состояние всего комплекса ЛГМ, в том числе прогнозировать способность к воспламенению и поддержанию горения верхних слоев, что важно при прогнозировании динамики развития пожароопасной ситуации в целом, а также при прогнозировании вспышек массовых лесных пожаров на данной территории.
5.4 Динамика пожарной опасности в течение пожароопасного периода 2009 г
Пожарная опасность лесов, как основной многофакторный показатель вероятности возникновения лесных пожаров, определяется метеорологическими, лесотаксационными, физико-географическими параметрами региона. На примере Красноярского края можно выделить несколько групп районов, где динамика пожароопасного состояния лесов имеет сходный, повторяющийся характер. Это является причиной сходных пожарных режимов на данных территориях. Такое районирование в первую очередь определяется физико-географическими характеристиками районов, что в свою очередь является основополагающим фактором формирования лесных биогеоценозов, а также микроклимата. Анализируя данные за период 2009 года, можно выделить следующие территории в границах Восточно-Сибирского региона:
1. Северные районы Красноярского края (пожароопасная ситуация отслеживалась по данным метеостанций Бор, Ворогово)
2. Северо-восточные районы (м/с Ванавара)
3. Приангарье (м/с Богучаны)
4. Южные районы края (м/с Ермаковское)
Следует отметить, что сезон 2009 года, так же как и 2006 год, был наиболее экстремален для северных территорий Восточной Сибири. Данные территории входят в зону совместной ответственности системы авиационной охраны лесов и спутникового мониторинга.
Северные районы Красноярского края, представленные данными с метеостанций Бор, Ворогово характеризовались периодичностью с 3 максимумами пожароопасного состояния, приходящимися на 1 декаду июня, 3 декаду июня и 2 декаду августа. (Рис.5, а, б). Ситуацию в данном регионе в пожароопасный период 2009 г. можно охарактеризовать как стабильно-напряженную, с преобладанием 4 и 5 классов пожарной опасности.
Рис.5. Динамика пожарной опасности в северных районах Красноярского края в 2009 году
а) по данным м/с Бор, 2009 г.
б) по данным м/с Ворогово, 2009 г.
Период активного высыхания ЛГМ начался в первой декаде июня, что привело к установлению 5 класса пожарной опасности в отдельных районах региона. В июне-июле наблюдаются продолжительные периоды сушки от 15 до 20 дней. Частое выпадение осадков характеризует начало сезона (3 декада мая) и конец лета (3 декада июля - начало августа). Максимальные значения показателя пожарной опасности ПВ-1 5400 (м/с Бор), 5500 (м/с Ворогово).
Северо-восточные районы, представлены данными м/с Ванавара. Статистические наблюдения последних лет показывают, что пожароопасная ситуация в данном регионе и в целом по Эвенкии имеет, как правило, ярко выраженный летний максимум, приходящийся на середину июля. Это определяется особенностями физико-географического расположения региона и условиями климата.
В сезоне 2009 года по данным метеостанций Ванавара можно выделить один летних максимума, с незначительными осадками в течение данного периода. Вследствие чего показатель пожарной опасности достигал величины 3900 ед. (рис.7, а).
Рис.7. Динамика пожарной опасности в северо-восточных районах Красноярского края в 2009 году
а) по данным м/с Ванавара;
Таким образом, пожароопасная ситуация в данном регионе оставалась стабильно напряженной всю вторую половину лета. Анализ пожароопасной обстановки в Приангарье проводился по данным, собранным на метеостанции Богучаны. Данный район традиционно является территорией с высокой и экстремально-высокой пожароопасной ситуацией в пожароопасный период. Это вызвано климатическими особенностями, и, в немалой степени, уровнем хозяйственного освоения данного региона. Здесь наблюдается большое количество лесов, поврежденных пожарами, вырубки, что повышает риск возникновения повторных лесных пожаров по гарям и вырубкам. Наличие развитой дорожной сети позволяет населению достигать удаленных районов, что привносит дополнительный антропогенный фактор источника огня. В данном регионе следует отметить относительно спокойный весенний период, а также продолжительный период сушки с 1 декады июля по 3 декаду июля. Здесь были достигнуты максимально высокие в 2009 году значения показателя ПВ-1, равные 4400 ед. (рис.8).
Рис.8. Динамика пожарной опасности в Приангарье Красноярского края в 2009 году по данным м/с Богучаны.
Южные районы края (м/с Ермаковское)
Рис.10. Динамика пожарной опасности в южных районах Красноярского края по данным м/с Ермаковское, 2009 г.
Сезон 2009 года в южных районах Красноярского края характеризовался высокой периодичностью дней с осадками, вариация количества которых 2-16 мм, а среднее значение 5 мм. Однако осадки, как правило, были вызваны прохождением фронтов и циклонической активностью, что привело к группировке дней с осадками, а, следовательно, к закономерному снижению пожароопасного состояния, что отражено на рис.10. Максимальные значения показателя пожарной опасности не превышают отметки 2400 ед.
Максимум пожароопасного состояния в сезоне в данном районе приходится на 1-2 декады июля, что согласуется с долговременными наблюдениями за данным районом.
6. Результаты
В проделанной работе получены следующие результаты:
· Доказательно применен теплофизический подход, показывающий связь между индексом - суммой радиационных температур и влагосодержанием лесных горючих материалов.
· Разработан алгоритм построения картосхем для распределения индекса пожарной опасности по данным метеорологических станций и космической информации.
· Обработаны данные пожароопасного сезона в Красноярском крае за 2009 г.
· Проведен анализ изменения индекса в течение сезона, установлены закономерности перемещения максимума пожарной опасности на территории Красноярского края.
· Разработано программное обеспечение расчета индексов и визуализации, обнаруженных пожаров совместно с отображением метеорологической обстановки.
· Проведен корреляционный анализ Российской и Канадской систем определения показателя пожарной опасности. В ряде случаев коэффициенты корреляции близки к 1 (принимает значения в промежутке 0,79-0,97). При этом стоит отметить, что наиболее подобен российскому индексу ПВ-1 соответствующий индекс канадской системы DMC (Duff Moisture Code), который показывает степень готовности к воспламенению и поддержанию горения в слое подстилки
7. Выводы
На основе полученных результатов были сделаны следующие выводы:
· Применение теплофизического подхода позволило обосновать связь влагосодержания лесных горючих материалов с аккумулированной температурой поверхности - базового компонента индекса пожарной опасности.
· Был проведен корреляционный анализ изменения индекса в течение сезона по Российской и Канадской системам. Стоит отметить, что наиболее подобен российскому индексу ПВ-1 соответствующий индекс канадской системы DMC (Duff Moisture Code), который показывает степень готовности к воспламенению и поддержанию горения в слое подстилки. В результате анализа было выявлено, что канадский индекс менее чувствителен к количественному значению выпавших осадков, особенно к низким значениям в диапазоне 0,5 - 5 мм. В то же время на графиках, представляющих российскую систему оценки пожарной опасности ПВ-1, в соответствующие сроки наблюдений присутствуют более резкие минимумы.
· Была установлена закономерность перемещения максимума пожарной опасности на территории Красноярского края. Следует отметить, что сезон 2009 года, так же как и 2008 год, был наиболее экстремален для северных территорий Восточной Сибири.
8. Список литературы
1. Сухинин А.И. Веpоятность обнаpужения лесных пожаpов дистанционными методами // сб. Лесные пожаpы и боpьба с ними, изд. ВНИИПОМлесхоз, Кpаснояpск, 1991 стр.56-69
2. Michael Matson, Jeff Dozier. Identification of Subresolution High Temperature Sources Using a Thermal IR Sensor // Photogrammetic Engineering and Remote Sensing №9, 1991 стр.1311-1318
3. Кашкин В.Б., Сухинин А.И. Дистанционное зондирование земли из космоса. Цифровая обработка изображений // М.: "Научный мир", 2000. - С.36-37.
4. Richard Barbieri, Harry Montgomery и др. Algorithm Technical Background Document // MODIS ATBD: THEORETICAL BASIS 1, 1997. - P.27 - 29
5. Коpовин Г.Н., Андpеев Н.А. Авиационная охpана лесов, М., Агpопpомиздат, 1988. - 223 с.
6. Софронов М.А., Волокитина А.В. Пирологическое районирование в таежной зоне. Новосибирск: Наука, 1990. - 205 с.
7. Карслоу Дж., Егер Д. Теплопроводность твердых тел, М.: Наука, 1969. - 340 с.
8. Берлянд М.Е. Распределение солнечной радиации на континентах. Л.: Гидрометеоиздат, 1961. - 260 с.
9. Кондратьев К.Я., Пивоварова З.И., Федорова М.П. Радиационный режим наклонных поверхностей. Л.: Гидрометеоиздат, 1978. - 250 с.
10. Лыков А.В. Теория сушки. М.: Энергия, 1968. - 472 с.
11. Будаговский А.И. Испарение почвенной влаги. М.: Наука, 1964.
12. Коpовин Г.Н., Андpеев Н.А. Авиационная охpана лесов, М., Агpопpомиздат, 1988. - 223 с.
13. Жуковская В.И. Увлажнение и высыхание гигроскопических лесных горючих материалов // Красноярск: ИЛиД, 1970. - С.105-141.
14. Софронов М.А. Система пирологических характеристик и оценок как основа управления пожарами в бореальных лесах // Дисс. в виде научного доклада… Красноярск, 1998. - 60 с.
15. Вонский С.М., Жданко В.А., Корбут В.И., Семенов М.М., Тетюшева Л.В., Завгородняя Л.С. Составление и применение местных шкал пожарной опасности в лесу // Ленинград: ЛенНИИЛХ, 1975. - 57 с.
16. Жданко В.А., Гриценко М.В. Метод анализа лесопожарных сезонов. Практические рекомендации. Ленинград: ЛНИИЛХ, 1980.
17. Софронов М.А., Волокитина А.В., Фомина О.А., Тартаковская Т.М. Методические рекомендации по оценке и прогнозу пожарной опасности на основе карт лесных горючих материалов и метеопрогнозов // Красноярск, 1992. - 47 с.
18. Софронов М.А., Волокитина А.В. Канадская система оценки пожарной опасности в лесах. М.: ВНИИЦлесресурс, 1996. - С.2 - 22.
19. Курбатский Н.П. Пожарная опасность в лесу и ее определение по местным шкалам // В кн.: "Лесные пожары и борьба с ними". М.: Изд. АН СССР, 1963. с.5 - 30.
Приложения
Приложение 1. Текст программы "METEO" на языке программирования DELPHI 7.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Grids, XPMan, ExtCtrls, Math,
StdCtrls, Buttons, ComCtrls;
type
TForm1 = class (TForm)
StringGrid1: TStringGrid;
MainMenu1: TMainMenu;
N1: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
XPManifest1: TXPManifest;
N13: TMenuItem;
N14: TMenuItem;
XT1: TMenuItem;
OpenDialog2: TOpenDialog;
PopupMenu1: TPopupMenu;
N16: TMenuItem;
N17: TMenuItem;
PopupMenu2: TPopupMenu;
N20: TMenuItem;
StringGrid2: TStringGrid;
N21: TMenuItem;
XT2: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
Panel1: TPanel;
Image1: TImage;
Image4: TImage;
Memo1: TMemo;
GroupBox1: TGroupBox;
Label2: TLabel;
Label3: TLabel;
ListBox1: TListBox;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
Edit2: TEdit;
Button4: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
GroupBox2: TGroupBox;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Memo2: TMemo;
GroupBox3: TGroupBox;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
ProgressBar1: TProgressBar;
BitBtn3: TBitBtn;
ListBox2: TListBox;
ListBox3: TListBox;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
SaveDialog1: TSaveDialog;
N5: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
RadioButton4: TRadioButton;
CheckBox1: TCheckBox;
RadioButton5: TRadioButton;
RadioButton6: TRadioButton;
CheckBox2: TCheckBox;
RadioButton7: TRadioButton;
Panel2: TPanel;
Label1: TLabel;
ProgressBar2: TProgressBar;
N10: TMenuItem;
Memo3: TMemo;
N11: TMenuItem;
procedure FormCreate (Sender: TObject);
procedure N7Click (Sender: TObject);
procedure N14Click (Sender: TObject);
procedure Button2Click (Sender: TObject);
procedure Button3Click (Sender: TObject);
procedure Button4Click (Sender: TObject);
procedure Memo2Click (Sender: TObject);
procedure Image4Click (Sender: TObject);
procedure ListBox1Click (Sender: TObject);
procedure RadioButton1Click (Sender: TObject);
procedure N16Click (Sender: TObject);
procedure N17Click (Sender: TObject);
procedure Image1MouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove (Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure N19Click (Sender: TObject);
procedure N20Click (Sender: TObject);
procedure Image1Click (Sender: TObject);
procedure XT1Click (Sender: TObject);
procedure XT2Click (Sender: TObject);
procedure N26Click (Sender: TObject);
procedure N28Click (Sender: TObject);
procedure BitBtn1Click (Sender: TObject);
procedure BitBtn2Click (Sender: TObject);
procedure BitBtn3Click (Sender: TObject);
procedure ListBox3Click (Sender: TObject);
procedure N4Click (Sender: TObject);
procedure ListBox4Click (Sender: TObject);
procedure N8Click (Sender: TObject);
procedure N9Click (Sender: TObject);
procedure CheckBox1Click (Sender: TObject);
procedure CheckBox2Click (Sender: TObject);
procedure FormActivate (Sender: TObject);
procedure N10Click (Sender: TObject);
procedure N11Click (Sender: TObject);
procedure Memo3Click (Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure drawinggraphix1 (a460,b460: integer; pic: tcanvas);
const xp=300;
yp=-600;
bn=-1.2;
x1=0;
y1=0;
x2=500;
y2=722;
var xcarte,ycarte,
xm,ym,xx,yy: integer;
Form1: TForm1;
filename, // имя загруженного файла базы данных
progname: string; // название данной программы
graphix,cartestatus,m,lang, index: byte;
maxpv1,maxpv2,maxt,maxw,maxffmc,maxdmc,maxdc,maxisi,maxbui,maxfwi: real;
pv1,pv2,ffmc,dmc,dc, isi,bui,fwi,t1,w1: array [0.20,1.31,1.12,0.20] of real;
cor: array [0.3,0.20,0.20] of real;
carteload,carte,oldfires: array [0.3] of tbitmap;
mindate,maxdate: string;
implementation
uses Unit7, Unit8;
{$R *. dfm}
// процедура управления видимостью
// базы данных по метеостанциям и некоторых пунктов меню
procedure vis (a: boolean);
var i: integer;
begin
form1. StringGrid1. Visible: =a;
form1. N4. Visible: =a;
form1. N26. Visible: =a;
form1. N10. Visible: =a;
form1. Button2. enabled: =a;
form1. Button3. enabled: =a;
form1. Button4. enabled: =a;
form1. RadioButton1. enabled: =a;
form1. RadioButton2. enabled: =a;
form1. RadioButton3. enabled: =a;
form1. RadioButton4. enabled: =a;
form1. RadioButton5. enabled: =a;
form1. RadioButton6. enabled: =a;
form1. RadioButton7. enabled: =a;
form1. CheckBox1. enabled: =a;
form1. CheckBox2. enabled: =a;
form1. ListBox1. enabled: =a;
if a=true then else
for i: =0 to form1. StringGrid1. ColCount-1 do
form1. StringGrid1. Cells [i,1]: ='';
end;
// процедура управления видимостью
// базы данных по пожарам и некоторых пунктов меню
procedure vis2 (a: boolean);
var i: integer;
begin
form1. StringGrid2. Visible: =a;
form1. N28. Visible: =a;
form1. BitBtn1. enabled: =a;
form1. BitBtn2. enabled: =a;
form1. BitBtn3. enabled: =a;
form1. ProgressBar1. Enabled: =a;
if a=true then else
for i: =0 to form1. StringGrid2. ColCount-1 do
form1. StringGrid2. Cells [i,1]: ='';
end;
// процедура коррекции заголовка окна главной формы
procedure formcaptionstatus;
var s: string;
begin
if filename='' then
if lang=0 then s: ='файл не загружен' else
s: ='file not loaded' else s: =filename;
form1. caption: =progname+' - '+s;
end;
procedure drawcarte (x,y: integer);
begin
form1. image1. canvas. draw (x,y,carte [cartestatus]);
if cartestatus and 1=0 then
if lang=0 then form1. n16. caption: ='Показать сетку' else
form1. n16. caption: ='Show grid' else
if lang=0 then form1. n16. caption: ='Убрать сетку' else
form1. n16. caption: ='Hide grid';
if cartestatus and 2=0 then
if lang=0 then form1. n17. caption: ='Увеличить масштаб' else
form1. n17. caption: ='Big carte' else
if lang=0 then form1. n17. caption: ='Уменьшить масштаб' else
form1. n17. caption: ='Small carte';
end;
procedure shownames;
const maxnames=19;
name: array [0.1,0. maxnames-1] of string= ( // названия колонок базы данных
('Дата',
'Код метеостанции',
'Название метеостанции',
'GRID',
'Широта',
'Долгота',
'Показатель ПВ-1',
'Показатель ПВ-2',
'Класс ПО 1',
'Класс ПО 2',
'T',
'W, мм',
'V',
'FFMC',
'DMC',
'DC',
'ISI',
'BUI',
'FWI'),
('Date',
'Meteostation'+#39+'s code',
'Meteostation'+#39+'s name',
'GRID',
'Latitude',
'Longitude',
'Indicator ПВ-1',
'Indicator ПВ-2',
'Class ПО 1',
'Class ПО 2',
'T',
'W, мм',
'V',
'FFMC',
'DMC',
'DC',
'ISI',
'BUI',
'FWI'));
maxnames1=4;
name1: array [0.1,0. maxnames1-1] of string= (
('Дата','Широта','Долгота','Площадь, м2'),
('Date','Latitude','Longitude','Area, м2'));
var i: integer;
begin
for i: =0 to maxnames-1 do
form1. stringgrid1. cells [i,0]: =name [lang, i]; // отображение названий колонок базы данных
for i: =0 to maxnames1-1 do
form1. stringgrid2. cells [i,0]: =name1 [lang, i]; // отображение названий колонок второй базы данных
end;
// Процедура задания начальных значений
// переменным при запуске программы
procedure TForm1. FormCreate (Sender: TObject);
var i,j,x,y: integer;
sx,sy: string;
p: tbitmap;
begin
lang: =0;
form1. width: =1024;
form1. height: =768;
panel1. top: =0;
panel1. left: =0;
panel1. width: =form1. width;
panel1. height: =form1. height;
panel2. top: = (form1. height-panel2. height) div 2;
panel2. left: = (form1. width-panel2. width) div 2;
image1. top: =0;
image1. left: =0;
image1. width: =450;
image1. height: =form1. height;
image4. width: =569;
image4. height: =481;
memo2. width: =561;
memo2. height: =499;
with image4. canvas do
begin
pen. color: =$e0e0e0;
brush. color: =pen. color;
rectangle (0,0, image4. Width, image4. Height);
end;
progname: =form1. caption;
form1. stringgrid1. align: =alclient;
form1. stringgrid2. align: =alclient;
vis (false);
vis2 (false);
shownames;
formcaptionstatus;
graphix: =0;
for i: =0 to 3 do
begin
carte [i]: =tbitmap. create;
carteload [i]: =tbitmap. create;
oldfires [i]: =tbitmap. create;
end;
for i: =0 to 1 do
begin
carte [i]. width: =512;
carte [i]. height: =730;
carte [i+2]. width: =898;
carte [i+2]. height: =1280;
carteload [i]. width: =512;
carteload [i]. height: =730;
carteload [i+2]. width: =898;
carteload [i+2]. height: =1280;
oldfires [i]. width: =512;
oldfires [i]. height: =730;
oldfires [i+2]. width: =898;
oldfires [i+2]. height: =1280;
end;
p: =tbitmap. create;
p. loadfromfile ('cartesmall. bmp');
carteload [0]. canvas. draw (0,0,p);
carteload [1]. canvas. draw (-512,0,p);
p. loadfromfile ('cartebig. bmp');
carteload [2]. canvas. draw (0,0,p);
carteload [3]. canvas. draw (-898,0,p);
xcarte: =0;
ycarte: =0;
cartestatus: =0;
for i: =0 to 3 do
begin
carte [i]. canvas. draw (0,0,carteload [i]);
oldfires [i]. canvas. draw (0,0,carteload [i]);
end;
drawcarte (xcarte,ycarte);
m: =0;
form1. BitBtn1. caption: ='';
form1. BitBtn2. caption: ='';
form1. BitBtn3. caption: ='';
end;
// Выход из программы по выбору пункта меню "Выход"
procedure TForm1. N7Click (Sender: TObject);
begin
close;
end;
procedure TForm1. N14Click (Sender: TObject);
begin
panel1. show;
end;
procedure TForm1. Button2Click (Sender: TObject);
var a, i,j: integer;
begin
for i: =0 to form1. ListBox2. count-1 do
if form1. ListBox2. Selected [i] then
begin
a: =0;
for j: =0 to form1. ListBox1. count-1 do
if form1. ListBox2. Items [i] =form1. ListBox1. Items [j] then a: =1;
if a=0 then form1. ListBox1. items. add (form1. ListBox2. items [i]);
end;
end;
procedure TForm1. Button3Click (Sender: TObject);
var i: integer;
begin
for i: =form1. ListBox1. count-1 downto 0 do
if form1. ListBox1. Selected [i] then
form1. ListBox1. items. delete (i);
end;
function datetostring (day,month: integer): string;
var s: string;
begin
if day<10 then s: ='0' else s: ='';
s: =s+inttostr (day) +'. ';
if month<10 then s: =s+'0';
s: =s+inttostr (month);
datetostring: =s;
end;
function dateok (date: string): boolean;
var day,month,code: integer;
begin
val (copy (date,1,2),day,code);
val (copy (date,4,2),month,code);
case month of
1,3,5,7,8,10,12: if (day>0) and (day<32) then dateok: =true else dateok: =false;
4,6,9,11: if (day>0) and (day<31) then dateok: =true else dateok: =false;
2: if (day>0) and (day<30) then dateok: =true else dateok: =false;
else dateok: =false;
end;
end;
function distancedates (date1,date2: string): integer;
var d,e,day,day1,day2,month,month1,month2: integer;
begin
d: =0;
e: =0;
val (copy (date1,1,2),day1,day);
val (copy (date1,4,2),month1,month);
val (copy (date2,1,2),day2,day);
val (copy (date2,4,2),month2,month);
for month: =1 to 12 do
for day: =1 to 31 do
begin
if (day=day1) and (month=month1) and (e=0) then
e: =1;
if (e=1) and (dateok (datetostring (day,month))) then d: =d+1;
if (day=day2) and (month=month2) then
e: =2;
end;
distancedates: =d;
end;
function convdata (s: string): string;
begin
convdata: =copy (s,4,2) +copy (s,1,2);
end;
procedure drawinggraphix1 (a460,b460: integer; pic: tcanvas);
const maxcolors=5;
colors: array [0. maxcolors-1] of longword= ($ef7000,$3080a0,$20a000,$c0b000,$909090);
var i,k,day,month,year,n,code: integer;
kt,kw: real;
st,sw,s: string;
p: tbitmap;
procedure drawing (y,max: real; ss: string; vv: byte; p: tbitmap);
var temppencolor,tempbrushcolor,temppenwidth: longword;
begin
if y>0 then
with p. canvas do
begin
lineto (distancedates (form1. edit1. text,datetostring (day,month)) * (b460 div n),a460-round (y/max*a460));
if vv=0 then
rectangle (distancedates (form1. edit1. text,datetostring (day,month)) * (b460 div n) - 2,a460-round (y/max*a460) - 2,distancedates (form1. edit1. text,datetostring (day,month)) * (b460 div n) +2,a460-round (y/max*a460) +2) else
begin
temppencolor: =pen. color;
tempbrushcolor: =brush. color;
temppenwidth: =pen. width;
pen. color: =0;
brush. color: =$ffffff;
pen. width: =1;
ellipse (distancedates (form1. edit1. text,datetostring (day,month)) * (b460 div n) - 3,a460-round (y/max*a460) - 3,distancedates (form1. edit1. text,datetostring (day,month)) * (b460 div n) +3,a460-round (y/max*a460) +3);
pen. color: =temppencolor;
brush. color: =tempbrushcolor;
pen. width: =temppenwidth;
end;
s: =datetostring (day,month) +'. '+form1. ListBox3. items [year];
str (y: 0: 3,st);
form1. memo2. lines. add (s+' '+ss+' = '+st);
end;
end;
begin
if graphix>0 then
if form1. RadioButton1. Checked then
begin
p: =tbitmap. Create;
p. Width: =b460+1;
p. Height: =a460+1;
kt: = (a460 div 10) / (trunc (maxt/10) +1);
kw: = (b460 div 10) / (trunc (maxw/10) +1);
with p. canvas do
begin
pen. style: =pssolid;
for i: =0 to (b460 div 2-1) do
begin
pen. color: =rgb ($f0,$b0+round (i/ (b460 div 2-1) *$40),$b0);
moveto (0,a460);
lineto (i,0);
pen. color: =rgb ($f0-round (i/ (b460 div 2-1) *$40),$f0,$b0);
moveto (0,a460);
lineto (i+ (b460 div 2),0);
end;
for i: =0 to (a460 div 2-1) do
begin
pen. color: =rgb ($b0,$f0,$b0+round (i/ (a460 div 2-1) *$40));
moveto (0,a460);
lineto (b460, i);
pen. color: =rgb ($b0,$f0-round (i/ (a460 div 2-1) *$40),$f0);
moveto (0,a460);
lineto (b460, i+ (a460 div 2));
end;
pen. color: =0;
for i: =0 to 10 do
begin
moveto (i* (b460 div 10),0);
lineto (i* (b460 div 10),10* (b460 div 10));
end;
for i: =0 to 10 do
begin
moveto (0, i* (a460 div 10));
lineto (10* (b460 div 10), i* (a460 div 10));
end;
pen. color: =$9030ff;
moveto (0,a460);
lineto (b460,0);
form1. memo2. clear;
for year: =0 to form1. ListBox3. Items. count-1 do
for k: =0 to form1. ListBox1. Items. count-1 do
begin
if (form1. listbox1. Selected [k]) and
(form1. listbox3. Selected [year]) then
pen. width: =3 else pen. width: =1;
form1. memo2. lines. add (form1. listbox1. items [k] +': ');
pen. color: =colors [k mod maxcolors];
brush. color: =pen. color;
moveto (0,a460);
for month: =1 to 12 do
for day: =1 to 31 do
if (t1 [k,day,month,year] >0) or
(w1 [k,day,month,year] >0) then
begin
lineto (round (w1 [k,day,month,year] *kw),a460-round (t1 [k,day,month,year] *kt));
rectangle (round (w1 [k,day,month,year] *kw) - 2,a460-round (t1 [k,day,month,year] *kt) - 2,round (w1 [k,day,month,year] *kw) +2,a460-round (t1 [k,day,month,year] *kt) +2);
moveto (round (w1 [k,day,month,year] *kw),a460-round (t1 [k,day,month,year] *kt));
s: =datetostring (day,month) +'. '+form1. ListBox3. items [year];
str (t1 [k,day,month,year]: 8: 3,st);
str (w1 [k,day,month,year]: 8: 3,sw);
form1. memo2. lines. add (s+' t = '+st+' w = '+sw);
end;
end;
end;
with pic do
begin
pen. color: =$e0e0e0;
brush. color: =$e0e0e0;
rectangle (0,0,b460*2,a460*2);
draw (58,6,p);
pen. color: =0;
for i: =1 to 10 do
begin
str (i* (a460 div 10) /kt: 0: 0,s);
textout (55-textwidth (s),a460-i* (a460 div 10),s);
str (i* (b460 div 10) /kw: 0: 0,s);
textout (i* (b460 div 10) +58-textwidth (s) div 2,a460+10,s);
end;
brush. style: =bsclear;
textout (59,a460+10,'0');
textout (62,10,'T'+#176+'C');
textout (b460+25,a460-12,'W мм');
brush. style: =bssolid;
end;
end else
begin
p: =tbitmap. Create;
p. Width: =b460+1;
p. Height: =a460+1;
with p. canvas do
begin
pen. style: =pssolid;
pen. color: =$e0e0e0;
brush. color: =pen. color;
rectangle (0,0,p. width,p. height);
pen. color: =$909090;
n: =distancedates (form1. edit1. text,form1. edit2. text);
if n>1 then
begin
for i: =0 to 10 do
begin
moveto (0, i* (a460 div 10));
lineto (n* (b460 div n), i* (a460 div 10));
end;
for i: =0 to n do
begin
moveto (i* (b460 div n),0);
lineto (i* (b460 div n),10* (a460 div 10));
end;
form1. memo2. clear;
for year: =0 to form1. ListBox3. Items. count-1 do
for k: =0 to form1. ListBox1. Items. count-1 do
begin
if (form1. listbox1. Selected [k]) and
(form1. listbox3. Selected [year]) then
pen. width: =3 else pen. width: =1;
pen. color: =colors [k mod maxcolors];
brush. color: =pen. color;
moveto (0,a460);
form1. memo2. lines. add (form1. listbox1. items [k] +': ');
for month: =1 to 12 do
for day: =1 to 31 do
if form1. RadioButton2. Checked then
drawing (pv1 [k,day,month,year],maxpv1,'ПВ1',0,p) else
if form1. RadioButton3. Checked then
drawing (pv2 [k,day,month,year],maxpv2,'ПВ2',0,p) else
if form1. RadioButton4. Checked then
drawing (ffmc [k,day,month,year],maxffmc,'FFMC',0,p) else
if form1. RadioButton5. Checked then
drawing (dc [k,day,month,year],maxdc,'DC',0,p) else
if form1. RadioButton6. Checked then
drawing (isi [k,day,month,year],maxisi,'ISI',0,p) else
if form1. RadioButton7. Checked then
drawing (fwi [k,day,month,year],maxfwi,'FWI',0,p);
if form1. RadioButton2. Checked or form1. RadioButton3. Checked then
begin
moveto (0,a460);
pen. style: =psdashdot;
for month: =1 to 12 do
for day: =1 to 31 do
if form1. checkbox1. Checked then
drawing (dmc [k,day,month,year],maxdmc,'DMC',1,p) else
if form1. checkbox2. Checked then
drawing (bui [k,day,month,year],maxbui,'BUI',1,p);
pen. style: =pssolid;
end;
end;
with pic do
begin
pen. color: =$e0e0e0;
brush. color: =$e0e0e0;
rectangle (0,0,b460*2,a460*2);
draw (58,6,p);
pen. color: =0;
for i: =0 to 10 do
begin
if form1. RadioButton2. Checked then str (maxpv1/10*i: 0: 0,s) else
if form1. RadioButton3. Checked then str (maxpv2/10*i: 0: 0,s) else
if form1. RadioButton4. Checked then str (maxffmc/10*i: 0: 0,s) else
if form1. RadioButton5. Checked then str (maxdc/10*i: 0: 0,s) else
if form1. RadioButton6. Checked then str (maxisi/10*i: 0: 0,s) else
if form1. RadioButton7. Checked then str (maxfwi/10*i: 0: 0,s);
textout (55-textwidth (s),a460-i* (a460 div 10),s);
if form1. checkbox1. checked then
begin
str (maxdmc/10*i: 0: 0,s);
textout (n* (b460 div n) +63,a460-i* (a460 div 10),s);
end;
if form1. checkbox2. checked then
begin
str (maxbui/10*i: 0: 0,s);
textout (n* (b460 div n) +63,a460-i* (a460 div 10),s);
end;
end;
if form1. RadioButton2. Checked then textout (63,0,'ПВ1') else
if form1. RadioButton3. Checked then textout (63,0,'ПВ2') else
if form1. RadioButton4. Checked then textout (63,0,'FFMC') else
if form1. RadioButton5. Checked then textout (63,0,'DC') else
if form1. RadioButton6. Checked then textout (63,0,'ISI') else
if form1. RadioButton7. Checked then textout (63,0,'FWI');
if form1. checkbox1. checked then textout (n* (b460 div n) +30,0,'DMC');
if form1. checkbox2. checked then textout (n* (b460 div n) +30,0,'BUI');
if n<10 then k: =1 else k: =n div 10+1;
for month: =1 to 12 do
for day: =1 to 31 do
if (distancedates (form1. edit1. text,datetostring (day,month)) mod k=0) and (convdata (datetostring (day,month)) >=convdata (form1. edit1. text)) and (convdata (datetostring (day,month)) <=convdata (form1. edit2. text)) then
textout (distancedates (form1. edit1. text,datetostring (day,month)) * (b460 div n) +44,a460+9,datetostring (day,month));
end;
end;
end;
end;
end;
procedure formyears;
var year,year1,year2: integer;
begin
form1. ListBox3. clear;
val (copy (form1. edit1. text,7,4),year1,year);
val (copy (form1. edit2. text,7,4),year2,year);
if (year1>0) and (year2>0) then
for year: =year1 to year2 do
form1. ListBox3. Items. add (inttostr (year));
end;
procedure formdata;
var n,k,day,month,year,year1,year2,code: integer;
s: string;
t,w,temp: real;
begin
maxt: =0;
maxw: =0;
maxpv1: =0;
maxpv2: =0;
maxffmc: =0;
maxdmc: =0;
maxdc: =0;
maxisi: =0;
maxbui: =0;
maxfwi: =0;
val (copy (form1. edit1. text,7,4),year1,code);
val (copy (form1. edit2. text,7,4),year2,code);
for k: =0 to form1. ListBox1. count-1 do
for year: =year1 to year2 do
begin
t: =0;
w: =0;
for month: =1 to 12 do
for day: =1 to 31 do
begin
pv1 [k,day,month,year-year1]: =0;
pv2 [k,day,month,year-year1]: =0;
ffmc [k,day,month,year-year1]: =0;
dmc [k,day,month,year-year1]: =0;
dc [k,day,month,year-year1]: =0;
isi [k,day,month,year-year1]: =0;
bui [k,day,month,year-year1]: =0;
fwi [k,day,month,year-year1]: =0;
t1 [k,day,month,year-year1]: =0;
w1 [k,day,month,year-year1]: =0;
if day<10 then s: ='0' else s: ='';
s: =s+inttostr (day) +'. ';
if month<10 then s: =s+'0';
s: =s+inttostr (month) +'. '+inttostr (year);
if (convdata (s) >=convdata (form1. edit1. text)) and
(convdata (s) <=convdata (form1. edit2. text)) then
begin
n: =1;
while (n<form1. StringGrid1. RowCount)
and not ( (form1. StringGrid1. cells [0,n] =s)
and (form1. StringGrid1. cells [1,n] =copy (form1. ListBox1. items [k],1,5))) do n: =n+1;
if form1. StringGrid1. cells [0,n] =s then
begin
val (form1. StringGrid1. Cells [6,n],pv1 [k,day,month,year-year1],code);
val (form1. StringGrid1. Cells [7,n],pv2 [k,day,month,year-year1],code);
val (form1. StringGrid1. Cells [13,n],ffmc [k,day,month,year-year1],code);
val (form1. StringGrid1. Cells [14,n],dmc [k,day,month,year-year1],code);
val (form1. StringGrid1. Cells [15,n],dc [k,day,month,year-year1],code);
val (form1. StringGrid1. Cells [16,n], isi [k,day,month,year-year1],code);
val (form1. StringGrid1. Cells [17,n],bui [k,day,month,year-year1],code);
val (form1. StringGrid1. Cells [18,n],fwi [k,day,month,year-year1],code);
val (form1. StringGrid1. Cells [10,n],temp,code);
t: =t+temp;
t1 [k,day,month,year-year1]: =t;
val (form1. StringGrid1. Cells [11,n],temp,code);
w: =w+temp;
w1 [k,day,month,year-year1]: =w;
if t1 [k,day,month,year-year1] >maxt then
maxt: =t1 [k,day,month,year-year1];
if w1 [k,day,month,year-year1] >maxw then
maxw: =w1 [k,day,month,year-year1];
if pv1 [k,day,month,year-year1] >maxpv1 then
maxpv1: =pv1 [k,day,month,year-year1];
if pv2 [k,day,month,year-year1] >maxpv2 then
maxpv2: =pv2 [k,day,month,year-year1];
if ffmc [k,day,month,year-year1] >maxffmc then
maxffmc: =ffmc [k,day,month,year-year1];
if dmc [k,day,month,year-year1] >maxdmc then
maxdmc: =dmc [k,day,month,year-year1];
if dc [k,day,month,year-year1] >maxdc then
maxdc: =dc [k,day,month,year-year1];
if isi [k,day,month,year-year1] >maxisi then
maxisi: =isi [k,day,month,year-year1];
if bui [k,day,month,year-year1] >maxbui then
maxbui: =bui [k,day,month,year-year1];
if fwi [k,day,month,year-year1] >maxfwi then
maxfwi: =fwi [k,day,month,year-year1];
end;
end;
end;
end;
end;
procedure formcor;
var k,day,month,year: integer;
srpv1,srpv2,srdmc,srbui: array [0.20,0.20] of real;
npv1,npv2,ndmc,nbui: array [0.20,0.20] of integer;
sumc,sumz1,sumz2: array [0.3,0.20,0.20] of real;
begin
form1. memo3. clear;
for year: =0 to form1. ListBox3. Items. count-1 do
for k: =0 to form1. ListBox1. Items. count-1 do
begin
srpv1 [k,year]: =0;
srpv2 [k,year]: =0;
srdmc [k,year]: =0;
srbui [k,year]: =0;
npv1 [k,year]: =0;
npv2 [k,year]: =0;
ndmc [k,year]: =0;
nbui [k,year]: =0;
for day: =0 to 3 do
begin
sumc [day,k,year]: =0;
sumz1 [day,k,year]: =0;
sumz2 [day,k,year]: =0;
end;
for month: =1 to 12 do
for day: =1 to 31 do
begin
if pv1 [k,day,month,year] >0 then
begin
srpv1 [k,year]: =srpv1 [k,year] +pv1 [k,day,month,year];
npv1 [k,year]: =npv1 [k,year] +1;
end;
if pv2 [k,day,month,year] >0 then
begin
srpv2 [k,year]: =srpv2 [k,year] +pv2 [k,day,month,year];
npv2 [k,year]: =npv2 [k,year] +1;
end;
if dmc [k,day,month,year] >0 then
begin
srdmc [k,year]: =srdmc [k,year] +dmc [k,day,month,year];
ndmc [k,year]: =ndmc [k,year] +1;
end;
if bui [k,day,month,year] >0 then
begin
srbui [k,year]: =srbui [k,year] +bui [k,day,month,year];
nbui [k,year]: =nbui [k,year] +1;
end;
end;
if npv1 [k,year] >0 then
srpv1 [k,year]: =srpv1 [k,year] /npv1 [k,year] else
srpv1 [k,year]: =0;
if npv2 [k,year] >0 then
srpv2 [k,year]: =srpv2 [k,year] /npv2 [k,year] else
srpv2 [k,year]: =0;
if ndmc [k,year] >0 then
srdmc [k,year]: =srdmc [k,year] /ndmc [k,year] else
srdmc [k,year]: =0;
if nbui [k,year] >0 then
srbui [k,year]: =srbui [k,year] /nbui [k,year] else
srbui [k,year]: =0;
for month: =1 to 12 do
for day: =1 to 31 do
begin
if (pv1 [k,day,month,year] >0) or (dmc [k,day,month,year] >0) then
begin
sumc [0,k,year]: =sumc [0,k,year] + (pv1 [k,day,month,year] - srpv1 [k,year]) * (dmc [k,day,month,year] - srdmc [k,year]);
sumz1 [0,k,year]: =sumz1 [0,k,year] +sqr (pv1 [k,day,month,year] - srpv1 [k,year]);
sumz2 [0,k,year]: =sumz2 [0,k,year] +sqr (dmc [k,day,month,year] - srdmc [k,year]);
end;
if (pv1 [k,day,month,year] >0) or (bui [k,day,month,year] >0) then
begin
sumc [1,k,year]: =sumc [1,k,year] + (pv1 [k,day,month,year] - srpv1 [k,year]) * (bui [k,day,month,year] - srbui [k,year]);
sumz1 [1,k,year]: =sumz1 [1,k,year] +sqr (pv1 [k,day,month,year] - srpv1 [k,year]);
sumz2 [1,k,year]: =sumz2 [1,k,year] +sqr (bui [k,day,month,year] - srbui [k,year]);
end;
if (pv2 [k,day,month,year] >0) or (dmc [k,day,month,year] >0) then
begin
sumc [2,k,year]: =sumc [2,k,year] + (pv2 [k,day,month,year] - srpv2 [k,year]) * (dmc [k,day,month,year] - srdmc [k,year]);
sumz1 [2,k,year]: =sumz1 [2,k,year] +sqr (pv2 [k,day,month,year] - srpv2 [k,year]);
sumz2 [2,k,year]: =sumz2 [2,k,year] +sqr (dmc [k,day,month,year] - srdmc [k,year]);
end;
if (pv2 [k,day,month,year] >0) or (bui [k,day,month,year] >0) then
begin
sumc [3,k,year]: =sumc [3,k,year] + (pv2 [k,day,month,year] - srpv2 [k,year]) * (bui [k,day,month,year] - srbui [k,year]);
sumz1 [3,k,year]: =sumz1 [3,k,year] +sqr (pv2 [k,day,month,year] - srpv2 [k,year]);
sumz2 [3,k,year]: =sumz2 [3,k,year] +sqr (bui [k,day,month,year] - srbui [k,year]);
end;
end;
for day: =0 to 3 do
cor [day,k,year]: =sumc [day,k,year] /sqrt (sumz1 [day,k,year] *sumz2 [day,k,year]);
form1. memo3. lines. add (form1. listbox3. items [year] +'. '+#9+form1. listbox1. items [k]);
form1. memo3. lines. add ('ПВ1, DMC: '+#9+floattostr (cor [0,k,year]));
form1. memo3. lines. add ('ПВ1, BUI: '+#9+floattostr (cor [1,k,year]));
form1. memo3. lines. add ('ПВ2, DMC: '+#9+floattostr (cor [2,k,year]));
form1. memo3. lines. add ('ПВ2, BUI: '+#9+floattostr (cor [3,k,year]));
form1. memo3. lines. add ('');
end;
end;
procedure TForm1. Button4Click (Sender: TObject);
var i, ii,k,code: integer;
tt,ww,pv: real;
begin
formyears;
formdata;
formcor;
graphix: =1;
drawinggraphix1 (460,460,form1. image4. canvas);
end;
procedure TForm1. Memo2Click (Sender: TObject);
begin
memo2. hide;
end;
procedure TForm1. Image4Click (Sender: TObject);
begin
memo2. show;
end;
procedure TForm1. ListBox1Click (Sender: TObject);
begin
drawinggraphix1 (460,460,form1. image4. canvas);
end;
procedure TForm1. RadioButton1Click (Sender: TObject);
begin
drawinggraphix1 (460,460,form1. image4. canvas);
end;
procedure TForm1. N16Click (Sender: TObject);
begin
cartestatus: =cartestatus xor 1;
drawcarte (xcarte,ycarte);
end;
procedure TForm1. N17Click (Sender: TObject);
begin
cartestatus: =cartestatus xor 2;
xcarte: =0;
ycarte: =0;
with form1. Image1. canvas do
begin
pen. color: =$ffffff;
brush. color: =pen. color;
rectangle (0,0, image1. width, image1. Height);
end;
drawcarte (xcarte,ycarte);
end;
procedure TForm1. Image1MouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button=mbleft then
begin
xm: =x;
ym: =y;
m: =1;
end;
end;
procedure TForm1. Image1MouseUp (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if m=1 then
begin
m: =0;
xcarte: =xx;
ycarte: =yy;
end;
end;
function precoords (a: real; b,c: byte): string;
var sg,sm: string;
g,m: byte;
begin
g: =trunc (a);
a: = (a-g) *60;
m: =trunc (a);
str (g,sg);
while length (sg) <b do sg: ='0'+sg;
str (m,sm);
while length (sm) <c do sm: ='0'+sm;
precoords: =sg+#176+sm+#39;
end;
// Перевод декартовых координат в полярные
procedure polar (xc,yc: real; m: byte; var r,fi: real);
const xr=645;
yr=-1230;
begin
if m=0 then
begin
xc: =round (xc/0.55);
yc: =round (yc/0.55);
end else
begin
xc: =round (xc/0.961);
yc: =round (yc/0.961);
end;
r: = (8500-sqrt (sqr (xr-xc) +sqr (yr-yc))) /100*20/12.59+72-72.23*20/12.59;
if xr-xc=0 then fi: =0 else fi: =arctan ( (xr-xc) / (yr-yc));
fi: =fi*30*24/11.1+102-1.37*24/11.1;
end;
procedure TForm1. Image1MouseMove (Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var r,fi: real;
i,xc,yc: integer;
begin
xc: =x-xcarte;
yc: =y-ycarte;
if cartestatus<2 then
polar (xc,yc,0,r,fi) else polar (xc,yc,1,r,fi);
if lang=0 then
begin
label4. caption: ='Широта: '+precoords (r,2,2);
label5. caption: ='Долгота: '+precoords (fi,3,2);
end else
begin
label4. caption: ='Latitude: '+precoords (r,2,2);
label5. caption: ='Longitude: '+precoords (fi,3,2);
end;
form1. label6. caption: ='??? ';
for i: =1 to form7. stringgrid1. rowcount-1 do
if (copy (form7. stringgrid1. cells [3, i],1,4) =copy (precoords (r,2,2),1,4)) and
(copy (form7. stringgrid1. cells [4, i],1,5) =copy (precoords (fi,3,2),1,5)) then
form1. label6. caption: =form7. stringgrid1. cells [0, i] +' '+form7. stringgrid1. cells [1, i];
if m=1 then
begin
xx: =xcarte+x-xm;
yy: =ycarte+y-ym;
if xx<form1. image1. width-carte [cartestatus]. width then
xx: =form1. image1. width-carte [cartestatus]. width;
if xx>0 then xx: =0;
if yy<form1. image1. height-carte [cartestatus]. height then
yy: =form1. image1. height-carte [cartestatus]. height;
if yy>0 then yy: =0;
drawcarte (xx,yy);
end;
end;
procedure TForm1. N19Click (Sender: TObject);
begin
form7. ShowModal;
end;
procedure TForm1. N20Click (Sender: TObject);
var i: integer;
begin
form8. Image1. width: =1024;
form8. Image1. height: =768;
form8. listbox1. items: =form1. listbox1. items;
form8. listbox2. items: =form1. listbox3. items;
for i: =0 to form1. listbox1. count-1 do
form8. listbox1. selected [i]: =form1. listbox1. selected [i];
for i: =0 to form1. listbox3. count-1 do
form8. listbox2. selected [i]: =form1. listbox3. selected [i];
drawinggraphix1 (700,890,form8. Image1. canvas);
form8. showmodal;
end;
procedure TForm1. Image1Click (Sender: TObject);
var i: integer;
begin
if length (label6. caption) >3 then
for i: =0 to form1. listbox2. count-1 do
if form1. listbox2. items [i] =label6. caption then
form1. listbox2. Selected [i]: =true else form1. listbox2. Selected [i]: =false;
end;
procedure texttogrid (n: integer; s: shortstring);
var i,j: integer;
q: shortstring;
procedure next;
begin
q: ='';
while (s [i] <>#9) and (i<=length (s)) do
begin
q: =q+s [i];
i: =i+1;
end;
i: =i+1;
end;
begin
i: =1;
next;
form1. StringGrid1. cells [0,n]: =q;
next;
next;
form1. StringGrid1. cells [1,n]: =q;
next;
form1. StringGrid1. cells [10,n]: =q;
next;
next;
form1. StringGrid1. cells [12,n]: =q;
for j: =1 to 3 do next;
form1. StringGrid1. cells [11,n]: =q;
for j: =1 to 3 do next;
form1. StringGrid1. cells [6,n]: =q;
next;
form1. StringGrid1. cells [7,n]: =q;
next;
next;
form1. StringGrid1. cells [8,n]: =q;
next;
form1. StringGrid1. cells [9,n]: =q;
if index=1 then
for j: =13 to 18 do
begin
next;
form1. StringGrid1. cells [j,n]: =q;
end;
end;
// Процедура расчета индексов по канадской системе
procedure canadian;
const h=60;
mm=250;
le: array [1.12] of real= (6.5,7.5,9,12.8,13.9,13.9,12.4,10.9,9.4,8,7,6);
lf: array [1.12] of real= (-1.6,-1.6,-1.6,0.9,3.8,5.8,6.4,5.0,2.4,0.4,-1.6,-1.6);
var i,meteo,day,month,year,year1,year2,code: integer;
t,w,r0,f0,m0,rf,mr,ed,ew,k0,kd,k1,kw,m,ffmc,
k,p0,p,re,b,pr,
d0,v,d,rd,q0,qr,dr,
ff,fw,r,
u,
fd,s1,fm,sf,si,
bui1,fwi1,bb,cc: real;
s: string;
procedure calculateffmc;
begin
m0: =147.2* (101-f0) / (59.5+f0);
if r0>0.5 then
begin
rf: =r0-0.5;
mr: =m0+42.5*rf*exp (-100/ (251-m0)) * (1-exp (-6.93/rf));
if m0>150 then mr: =mr+0.0015*sqr (m0-150) *sqrt (rf);
m0: =mr;
end;
if mr>250 then mr: =250;
ed: =0.942*power (h,0.679) +11*exp ( (h-100) /10) +0.18* (21.1-t) * (1-exp (-0.115*h));
m: =m0;
if m0>ed then
begin
k0: =0.424* (1-power (h/100,1.7)) +0.0694*sqrt (w) * (1-power (h/100,8));
kd: =k0*0.581*exp (0.0365*t);
m: =ed- (m0-ed) *power (10,-kd);
end else
if m0<ed then
begin
ew: =0.618*power (h,0.753) +10*exp ( (h-100) /10) +0.18* (21.1-t) * (1-exp (-0.115*h));
if m0<ew then
begin
k1: =0.424* (1-power ( (100-h) /100,1.7)) +0.0694*sqrt (w) * (1-power ( (100-h) /100,8));
Подобные документы
Охранно–пожарная сигнализация. Принципы работы систем пожарной сигнализации. Блок-схема алгоритма функционирования разработанного устройства. Выбор и обоснование элементной базы. Схема электрической принципиальной и проектирование цифровых устройств.
курсовая работа [786,6 K], добавлен 10.11.2011Характеристика, механизм и назначение кодового и фазового метода определения дальностей. Их сравнительный анализ и значение при различных способах позиционирования. Особенности применения при измерениях кодового и фазового методов определения дальностей.
курсовая работа [79,4 K], добавлен 25.12.2012Возможности среды программирования delphi при разработке приложения с визуальным интерфейсом. Разработка спецификации программного обеспечения и на ее основе кода программного продукта. Отладка программы "трассировкой", ее тестирование и оптимизация.
курсовая работа [501,4 K], добавлен 07.12.2016Понятие и классификация алгоритмов маршрутизации. Основное определение теории графов. Анализ и разработка алгоритмов Дейкстры и Флойда на языке программирования C# для определения наилучшего пути пакетов, передаваемых через сеть. Их сравнительный анализ.
курсовая работа [1,2 M], добавлен 16.05.2015Проведение формализации математической модели и разработка алгоритма программы для определения локальных экстремумов функции средствами Delphi 7.0, Visual C. Создание инсталляционной версии приложения и его тестирование в различных операционных системах.
курсовая работа [2,7 M], добавлен 11.06.2015Возможности среды программирования delphi при разработке приложения с визуальным интерфейсом. Отладка программных модулей с использованием специализированных программных средств. Тестирование программного обеспечения. Оптимизация программного кода.
курсовая работа [974,0 K], добавлен 21.12.2016Разработка программного обеспечения для работы с информацией и ее обработкой на языке программирования Delphi. Описание алгоритмов процедуры работы со стеком - добавление, удаление элементов, редактирование записи. Инструкция по использованию программы.
курсовая работа [2,9 M], добавлен 06.02.2013Особенности разработки приложений для операционной системы с помощью императивного, структурированного, объектно-ориентированного языка программирования Delphi. Формальное начало программы. Выделение конца программного блока. Листинг и описание программы.
курсовая работа [1,2 M], добавлен 04.08.2014Этапы процедуры принятия решений. Разработка математического алгоритма. Блок-схема алгоритма работы программы. Разработка программы на языке программирования С++ в среде разработки MFC. Текст программы определения технического состояния станка с ЧПУ.
курсовая работа [823,0 K], добавлен 18.12.2011Описание вычислительной техники, характеристика операционных систем и языков программирования. Сравнительный анализ аналогов и прототипов. Разработка алгоритма решения задачи. Выбор средств и методов решения задач. Проектирование программного обеспечения.
отчет по практике [1,0 M], добавлен 23.03.2015
