Биоритм / Мой курсрвик / u_main

unit u_main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls;
type
TBioType = (btPhys, btPsy, btInt);

type
TfrmMain = class(TForm)
Bevel1: TBevel;
Bevel2: TBevel;
DBirth: TDateTimePicker;
lblBDay: TLabel;
lblCDay: TLabel;
Bevel3: TBevel;
btnQuit: TButton;
Bevel4: TBevel;
clbPhy: TColorBox;
clbPsy: TColorBox;
clbInt: TColorBox;
lbColorSelect: TLabel;
lblColorPhy: TLabel;
lblColorPsy: TLabel;
lblColorInt: TLabel;
pbImage: TImage;
btnSave: TButton;
svDialog: TSaveDialog;
Bevel5: TBevel;
lblName: TLabel;
edName: TEdit;
Bevel6: TBevel;
DCalc: TDateTimePicker;
procedure FormCreate(Sender: TObject);
procedure btnQuitClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure ChangeEvent(Sender: TObject);
private
{ Private declarations }
procedure pbImagePaint;

{Функция расчета значения биоритма}
function CalculatePoints(ForDate : TDateTime; BirthDay : TDateTime;
Bio : TBioType) : integer;

{Процедура рисования осей на графике с формированием подписей}
procedure DrawAxis(aBitmap : TBitmap; PixelStep : integer);
{Процедура рисования "Легенды" - что какой цвет на графике обозначает}
procedure DrawLegend(aBitmap : TBitmap);
{Процедура рисования синусоид биоритмов}
procedure DrawBioritm(aBitmap : TBitmap; PixelStep : integer);
{Процедура сохранения графика биоритмов во внешний файл}
procedure ExportPictureToFile;
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation
uses DateUtils, Jpeg, Math;

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
{Для отображения графика при старте программы - получаем текущую дату и...}
DCalc.DateTime := Now;
{... рисуем сам график}
pbImagePaint;
end;

procedure TfrmMain.btnQuitClick(Sender: TObject);
begin
Application.Terminate;
end;

{*******************************************************************************
Процедура ExportPictureToFile
Назначение: Процедура "экспорта" графика во внешний файл
*******************************************************************************}
procedure TfrmMain.ExportPictureToFile;
begin
{Если пользователь ввел имя файла и нажал кнопку "Save"|"Сохранить"...}
if svDialog.Execute then
{... создаем объект типа JpegImage}
with TJpegImage.Create do begin
try
{... передаем ему картинку}
Assign(pbImage.Picture.Bitmap);
{... устанавливаем качество картинки в 100%}
CompressionQuality := 100;
{... сохраняем в файл}
SaveToFile(svDialog.FileName);
finally
{... объект типа TJpegImage нам больше не нужен - уничтожаем его}
Free;
end; {try}
end;{with}
end;

{*******************************************************************************
Функция CalculatePoints
Назначение: Расчет значения биоритма для определенной даты
Параметры:
1. ForDate - дата, для которой требуется расчитать значение биоритма
2. BirthDate - дата дня рождения
3. Bio - тип биоритма, который требуется расчитать
Результат:
Значение биоритма. Возможные значения в диапазоне от -100 до +100
Замечание: Если дата расчета меньше или равна дате рождения, функция возвра-
щает нулевое значение.
*******************************************************************************}
function TfrmMain.CalculatePoints(ForDate: TDateTime; BirthDay : TDateTime;
Bio: TBioType): integer;
var lDays :integer; {Количество полных прожитых дней}
a,b,c : real; {просто для упрощения восприятия основной формулы}
const PhysPeriod = 23.6884; {Период физического цикла}
PsyPeriod = 28.4261; {Период психологического цикла}
IntPeriod = 33.1638; {Период интеллектуального цикла}
begin
a := 2*Pi/PhysPeriod; {просто для упрощения восприятия основной формулы}
b := 2*Pi/PsyPeriod; {просто для упрощения восприятия основной формулы}
c := 2*Pi/IntPeriod; {просто для упрощения восприятия основной формулы}
result := 0;
{...считаем количество прожитых дней}
lDays := DaysBetween(forDate, BirthDay);
{...если дата расчета больше даты рождения, то...}
if (lDays > 0) and (ForDate - BirthDay > 0) then
{считаем :)}
case Bio of
btPhys : result := Round(100*sin(LDays*a));
btPsy : result := Round(100*sin(LDays*b));
btInt : result := Round(100*sin(LDays*c));
end; {case}
{...если нет, то результат у нас уже установлен в 0}
end;

{*******************************************************************************
Процедура DrawLegend
Назначение: Процедура отображения на графике биоритмов "легенды" - описание
значений цветов, используемых для построения синусоид.
Так же выводится дополнительная информация:
1. Имя
2. Дата рождения
3. Дата генерирования
Параметры:
aBitmap - "холст", на котором строим графики
*******************************************************************************}
procedure TfrmMain.DrawLegend(aBitmap : TBitmap);
var svBrushColor : TColor;
svFont : TFont;
NewPosX : integer;
grDay : string;
strText : string;
const
strPhy = 'Физический';
strPsy = 'Психологический';
strInt = 'Интеллектуальный';
begin
with aBitmap do begin
{Сохраняем значения для шрифта и цвета}
svBrushColor := Canvas.Brush.Color;
svFont := Canvas.Font;
{Рисуем легенду}
Canvas.Pen.Color := clBlack;
Canvas.Font.Size := 7;
{Пишем имя и дату расчета}
strText := format('Имя: %s', [edName.Text]);
Canvas.TextOut(2,1,format('Имя: %s', [edName.Text]));
grDay := format('Дата рождения: %s',[DateToStr(DBirth.DateTime)]);
Canvas.TextOut(2,1+Canvas.TextHeight(strText),grDay);
{... если дата рождения больше чем дата расчета,
то не считаем сколько прожито и не выводим на графике}
if DCalc.DateTime > DBirth.DateTime then
Canvas.TextOut(2 + Canvas.TextWidth(grDay)+10,
1+Canvas.TextHeight(strText),
format('Прожито %d дней на дату расчета.',
[DaysBetween(DCalc.DateTime, DBirth.DateTime)]));
strText := DateTimeToStr(Now);
Canvas.Font.Color := clSilver;
Canvas.TextOut(Width - 2 - Canvas.TextWidth(strText),1, strText);
Canvas.Font := svFont;
{...физическая}
{... устанавливаем выбранный цвет заполнения}
Canvas.Brush.Color := clbPhy.Selected;
{... устанавливаем цвет рамки - черным}
Canvas.Font.Color := clBlack;
{... рисуем пряморугольник с заполнением}
Canvas.Rectangle(5, Height - 10, 25, Height - 5);
{... восстанавливаем сохраненные значения заполнения}
Canvas.Brush.Color := svBrushColor;
{... печатаем над прямоугольником значение биоритма на день расчета (в%)}
strText := format('%d%%',
[CalculatePoints(DCalc.DateTime, DBirth.DateTime, btPhys)]);
Canvas.TextOut(5,Height - 10 - Canvas.TextHeight(strText), strText);
Canvas.TextOut(30, Height - 13, strPhy);
NewPosX := 30+Canvas.TextWidth(StrPhy)+10;
{...психологическая}
{... устанавливаем выбранный цвет заполнения}
Canvas.Brush.Color := clbPsy.Selected;
{... рисуем пряморугольник с заполнением}
Canvas.Rectangle(NewPosX, Height - 10, NewPosX + 20, Height - 5);
{... восстанавливаем сохраненные значения заполнения}
Canvas.Brush.Color := svBrushColor;
{... печатаем над прямоугольником значение биоритма на день расчета (в%)}
strText := format('%d%%',
[CalculatePoints(DCalc.DateTime, DBirth.DateTime, btPsy)]);
Canvas.TextOut(NewPosX,Height - 10 - Canvas.TextHeight(strText), strText);
Canvas.TextOut(NewPosX + 25, Height - 13, strPsy);
NewPosX := NewPosX + 25 + Canvas.TextWidth(strPsy) + 10;
{...интеллектуальная}
{... устанавливаем выбранный цвет заполнения}
Canvas.Brush.Color := clbInt.Selected;
{... рисуем пряморугольник с заполнением}
Canvas.Rectangle(NewPosX , Height - 10, NewPosX + 20, Height - 5);
{... восстанавливаем сохраненные значения заполнения}
Canvas.Brush.Color := svBrushColor;
{... печатаем над прямоугольником значение биоритма на день расчета (в%)}
strText := format('%d%%',
[CalculatePoints(DCalc.DateTime, DBirth.DateTime, btInt)]);
Canvas.TextOut(NewPosX,Height - 10 - Canvas.TextHeight(strText), strText);
Canvas.TextOut(NewPosX + 25, Height - 13, strInt);
{Восстанавливаем сохраненные значения шрифта и цвета}
Canvas.Font := svFont;
Canvas.Brush.Color := svBrushColor;
end; {with aBitmap}
end;

{*******************************************************************************
Процедура DrawBioritm
Назначение: Процедура рисования синусоид биоритмов
Параметры:
1. aBitmap - "холст", на котором строятся графики
2. PixelStep - расстояние между соседними днями по оси календаря.
Это значение так же используется для ообозначения процентного уровня.
*******************************************************************************}
procedure TfrmMain.DrawBioritm(aBitmap : TBitmap; PixelStep : integer);
var days_count : integer; {для обозначения интервала -/+ от даты расчета}
begin
with aBitmap do begin
{А теперь рисуем графики... самое нудное...}
{Физическая синусоида}
{...устанавливаем цвет в соответствии с выбранным}
Canvas.Pen.Color := clbPhy.Selected;
{...сколько дней брать до даты расчета}
days_count := -7;
{...устанавливаем начальную точку графика на значение биоритма в этот день}
Canvas.MoveTo(0,
(Height div 2) - CalculatePoints(DCalc.DateTime + days_count,
DBirth.DateTime,btPhys));
{...пока не нарисовали последнюю точку на графике}
while (Canvas.PenPos.X < Width) do begin
{...берем следующий день}
inc(days_count);
{...и строим линию от значения в предыдущий день до значения в тек. день}
Canvas.LineTo(Canvas.PenPos.X+PixelStep,
(Height div 2) - CalculatePoints(DCalc.DateTime + days_count,
DBirth.DateTime,btPhys));
end; {end while}
{Психологический}
{...устанавливаем цвет в соответствии с выбранным}
Canvas.Pen.Color := clbPsy.Selected;
{...сколько дней брать до даты расчета}
days_count := -7;
{...устанавливаем начальную точку графика на значение биоритма в этот день}
Canvas.MoveTo(0,
(Height div 2) - CalculatePoints(DCalc.DateTime + days_count,
DBirth.DateTime,btPsy));
{...пока не нарисовали последнюю точку на графике}
while (Canvas.PenPos.X < Width) do begin
{...берем следующий день}
inc(days_count);
{...и строим линию от значения в предыдущий день до значения в тек. день}
Canvas.LineTo(Canvas.PenPos.X+PixelStep,
(Height div 2) - CalculatePoints(DCalc.DateTime + days_count,
DBirth.DateTime,btPsy));
end; {end while}
{Интеллектуальный}
{...устанавливаем цвет в соответствии с выбранным}
Canvas.Pen.Color := clbInt.Selected;
{...сколько дней брать до даты расчета}
days_count := -7;
{...устанавливаем начальную точку графика на значение биоритма в этот день}
Canvas.MoveTo(0,
(Height div 2) - CalculatePoints(DCalc.DateTime + days_count,
DBirth.DateTime,btInt));
{...пока не нарисовали последнюю точку на графике}
while (Canvas.PenPos.X < Width) do begin
{...берем следующий день}
inc(days_count);
{...и строим линию от значения в предыдущий день до значения в тек. день}
Canvas.LineTo(Canvas.PenPos.X+PixelStep,
(Height div 2) - CalculatePoints(DCalc.DateTime + days_count,
DBirth.DateTime,btInt));
end; {end while}
end;{with aBitmap}
end;

{*******************************************************************************
Процедура DrawAxis
Назначение: Процедура рисования осей и градуировки шкалы.
Параметры:
1. aBitmap - "холст", на котором строятся графики
2. PixelStep - расстояние между соседними днями по оси календаря.
Это значение так же используется для ообозначения процентного уровня.
*******************************************************************************}
procedure TfrmMain.DrawAxis(aBitmap: TBitmap; PixelStep : integer);
var Days : integer;
svFont : TFont;
svPos : TPoint;
DayName : string;
begin
with aBitmap do begin
{Сохраняем параметры шрифта}
svFont := Canvas.Font;
{Рисуем координатную сетку)
{... вертикальные линии}
Canvas.MoveTo(0,0);
{... используем прерывистую линию}
Canvas.Pen.Style := psDot;
{... в качестве цвета, выбираем серый}
Canvas.Pen.Color := clMedGray;
{... и рисуем слева на право с шагом PixelStep}
while (Canvas.PenPos.X < Width) do begin
{... устанавливем начальную точку линии}
Canvas.MoveTo(Canvas.PenPos.X + PixelStep, PixelStep);
{... и рисуем саму линию}
Canvas.LineTo(Canvas.PenPos.X, Height - PixelStep);
end; {end while}
{... а теперь - горизонтальные линии}
Canvas.MoveTo(0,0);
{... и рисуем сверху вниз с шагом PixelStep}
while (Canvas.PenPos.Y < Width) do begin
{... устанавливем начальную точку линии}
Canvas.MoveTo(2,Canvas.PenPos.Y + PixelStep);
{... и рисуем саму линию}
Canvas.LineTo(Width - 2, Canvas.PenPos.Y);
end; {end while}
{Рисуем горизонтальную ось...}
{... выбираем сплошную линию}
Canvas.Pen.Style := psSolid;
{... устанавливаем черный цвет}
Canvas.Pen.Color := clBlack;
{... устанавливем начальную точку линии}
Canvas.MoveTo(0, Height div 2);
{... и рисуем саму линию}
Canvas.LineTo(Width, Height div 2);
{Рисуем вертикальную ось...}
{... устанавливем начальную точку линии}
Canvas.MoveTo(Width div 2, PixelStep);
{... и рисуем саму линию}
Canvas.LineTo(Width div 2, Height-PixelStep);
{--------------------------------------------------------------------------}
{Подписываем оси...}
Days := -7;
{... сначала - горизонтальную...}
Canvas.MoveTo(0,Height div 2);
{... устанавливаем черный цвет}
Canvas.Pen.Color := clBlack;
{... мелким шрифтом}
Canvas.Font.Size := 7;
while (Canvas.PenPos.X < Width) do begin
svPos := Canvas.PenPos;
{... сначала выводим число (дату)}
Canvas.TextOut(Canvas.PenPos.X +2, Canvas.PenPos.Y - 11,
IntToStr(DayOfTheMonth(DCalc.DateTime + Days)));
Canvas.MoveTo(svPos.X, svPos.Y);
{... а теперь название дня недели}
case DayOfTheWeek(DCalc.DateTime + Days) of
DayMonday : DayName := 'пн';
DayTuesday : DayName := 'вт';
DayWednesday : DayName := 'ср';
DayThursday : DayName := 'чт';
DayFriday : DayName := 'пт';
DaySaturday : DayName := 'сб';
DaySunday : DayName := 'вс';
else
{...а вдруг кто-то/что-то сглючило :)}
DayName := 'Ошибка.'
end;
{... выводим название дня недели на рисунке}
Canvas.TextOut(Canvas.PenPos.X +2, Canvas.PenPos.Y + 1, DayName);
Canvas.MoveTo(svPos.X + PixelStep, Height div 2);
inc(Days);
end;
{... а теперь вертикальную}
Canvas.TextOut(Width div 2 + 3, (Height div 2) - 2*PixelStep + 1, '+50%');
Canvas.TextOut(Width div 2 + 3, (Height div 2) - 4*PixelStep + 1, '+100%');
Canvas.TextOut(Width div 2 + 3,
(Height div 2) + 2*PixelStep - Canvas.TextHeight('-50%'),
'-50%');
Canvas.TextOut(Width div 2 + 3,
(Height div 2) + 4*PixelStep - Canvas.TextHeight('-100%'),
'-100%');
{Восстанавливаем значения шрифта}
Canvas.Font := svFont;
end;{with aBitmap}
end;

{*******************************************************************************
Процедура pbImagePaint
Назначение: Основная процедура создания графиков биоритмов
Параметры:
Нет.
*******************************************************************************}
procedure TfrmMain.pbImagePaint;
var DayToDayPix : integer;
PicBio : TBitmap;
const point_size = 7;
begin
{Создаем "холст", на котором будем рисовать}
PicBio := TBitmap.Create;
try
{устанавливаем размеры "холста"}
{...ширина}
PicBio.Width := pbImage.Width; //350 pix
{...и высота}
PicBio.Height := pbImage.Height; //250 pix
with PicBio do begin
{будем использовать 2-х недельный интервал (14 дней)}
{... расстояние в пикселях между днями на графике}
DayToDayPix := Width div 14;
{Рисуем рамку вокруг графика}
{...рисовать будем сплошной линией}
Canvas.Pen.Style := psSolid;
{...и черным цветом}
Canvas.Pen.Color := clBlack;
{...с использованием примитива "прямоугольник"}
Canvas.Rectangle(0,0,Width,Height);
{------------------------------------------------------------------------}
{Рисуем оси и градуировку}
DrawAxis(PicBio, DayToDayPix);
{Рисуем справочную информацию}
DrawLegend(PicBio);
{Строим сами графики биоритмов }
DrawBioritm(PicBio, DayToDayPix);
{------------------------------------------------------------------------}
end; {end with PicBio}
{Отображаем в окне построенную картинку}
pbImage.Picture.Bitmap.Assign(PicBio);
finally
{Объект "холст" нам больше не нужен - уничтожаем его}
PicBio.Free;
end;{try - finally}
end;

{*******************************************************************************
Процедура btnSaveClick
Назначение: Обработка события при нажатии пользователем кнопки "Сохранить"
*******************************************************************************}
procedure TfrmMain.btnSaveClick(Sender: TObject);
begin
ExportPictureToFile;
end;

{*******************************************************************************
Процедура ChangeEvent
Назначение: Обработка события при изменении пользователем любого из
параметров:
- Имя пользователя
- Дата рождения
- Дата расчета
- Цвета отрисовки синусоид
*******************************************************************************}
procedure TfrmMain.ChangeEvent(Sender: TObject);
begin
pbImagePaint;
end;

end.