Биоритм / Мой курсрвик / 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.