unit DDisplayGUI;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
  DDisplayQE;

// ОПИСАНИЕ КЛАССА ДЛЯ ОСЦИЛЛОГРАФА
const CtrlTextStr = '#0.000'; // Макет подписи в коце осциллограммы

type TIQNotify = procedure
                (Sender : TObject; X,Y : integer; Item : TQItem) of object;
type TDDisplay = class(TIQueue)
 private
   // ---------------------------------------
   // ССЫЛКИ
   fDDisplay   : TImage;     // Ссылка на компонент для дисплня
   // УСТАНОВКИ ЦВЕТА
   fDColor     : TColor;     // Display color. Цвет поля дисплея
   fBColor     : TColor;     // Beam color.    Цвет луча
   fGColor     : TColor;     // Grid color.    Цвет сетки координат
   fAColor     : Tcolor;     // Axes color.    Цвет осей координат
   // УСТАНОВКИ ОТОБРАЖЕНИЯ
   fEnHGrid    : boolean;    // Отображать горизонтальные линии сетки
   fEnVGrid    : boolean;    // Отображать вертикальные линии сетки
   fEnCapt     : boolean;    // Отображать подписи значений на осциллограме
   // УСТАНОВКИ МАСШТАБОВ
   fZeroTop    : integer;    // Top - уровень нулевой линии (ось X)
   fGNumX      : integer;    // Число вертикальных линий сетки
   fGNumH      : integer;    // Число горизонтальных линий сетки над осью X
   fSens       : integer;    // Чувствительность (единицы на шаг сетки)
   fScaleY     : double;     // Текущий вертикальный масштаб
   // УСТАНОВКИ АНАЛИЗА
   fMdAlert    : double;     // Пороговая амплитуда сигнала
   // ОБРАБОТЧИКИ СОБЫТИЙ
   fOnDrawItem  : TIQNotify;  // Обработчик события - прорисовка значения
   fOnAlertItem : TIQNotify;  // Обработчик события - сигнал выше порога
   // РАБОЧИЕ
   fXStep      : integer;    // Шаг в пикселях для прорисовки одного значения
   fCount      : integer;    // Счетчик прорисованных значений
   // ---------------------------------------
   // ОСНОВНЫЕ ПРИВАТНЫЕ МЕТОДЫ
   // Полная очистка дисплея и установка параметров для прорисовки
   procedure ClearDisplay(RqFillColor, RqRenColor : TColor);
   // Прорисовка линий сетки
   procedure DrawGridLine();
   // Прорисовка нулевой линии на дисплее (Прорисовка оси Х)
   procedure DrawZeroLine();
   // Преобразовать значение из Item в значение свойства Image.Top
   function  ValueToTop(Item : TQItem) : integer;
   // Вывод текста текущего значения над линией текушего значения
   procedure DrawCurrentCaption(Item : TQItem);
   // Прорисовка линии текущего значения (может инициировать событие)
   procedure DrawCurrentLine(Item : TQItem);
   // Прорисовка линии перехода с текущего значения на следующее значение
   procedure DrawGoToNextLine(Item : TQItem);
   // ---------------------------------------
   // СЕРВИСЫ ДЛЯ ПРОСТЫХ СВОЙСТВ
   // Установка количества отсчетов на дисплее (длина осереди)
   procedure SetDMaxCountProp (RqDMaxCount : integer);
   // ---------------------------------------
   // СЕРВИСЫ ДЛЯ ИНДЕКСНЫХ СВОЙСТВ
   // Запись свойств типа boolean
   procedure SetBooleanProp(RqInd : integer; RqProp : boolean);
   // Чтение свойств типа boolean
   function GetBooleanProp(RqInd : integer) : boolean;
   // ---------------------------------------
   // ИНТЕРФЕЙСЫ ВЫЗОВОВ ОБРАБОТЧИКОВ СОБЫТИЙ
   // Интерфейс обработчика события - прорисовка текущего значения
   procedure RunOnDrawItem(X,Y : integer; Item : TQItem);
   // Интерфейс обработчика события - сигнал выше порога
   procedure RunOnAlertItem(X,Y : integer; Item : TQItem);
   // ---------------------------------------
 public
   constructor Create (RqDisplay : TComponent);
   // ОТОБРАЗИТЬ ОЧЕРЕДЬ В ДИСПЛЕЙ В ВИДЕ ЦИФРОВОГО СИГНАЛА
   // (может инициировать событие)
   procedure ShowItemQueue(); override;
   // ОТОБРАЗИТЬ ОЧЕРЕДЬ В ДИСПЛЕЙ В ВИДЕ АНАЛОГОВОГО СИГНАЛА
   // (может инициировать событие)
   procedure AnalogShowItemQueue(); virtual;
   // ОЧИСТИТЬ ДИСПЛЕЙ
   procedure DisplayClear();
   // ---------------------------------------
   // ПРОСТЫЕ СВОЙСТВА
   property DMaxCount : integer read fMaxCount write SetDMaxCountProp;
   // Управление цветом линий сетки
   property GColor : TColor read fGColor write fGColor;
   // Управление цветом луча
   property BColor : TColor read fBColor write fBColor;
   // Управление цветом дисплея
   property DColor : TColor read fDColor write fDColor;
   // Чувствительность (единицы на шаг сетки)
   property Sens : integer read fSens write fSens;
   // Пороговая амплитуда сигнала
   property MdAlert : double read fMdAlert write fMdAlert;
   // ---------------------------------------
   // ИНДЕКСНЫЕ СВОЙСТВА
   // Отображать горизонтальные линии сетки
   property EnHGrid : boolean index 1 read GetBooleanProp write SetBooleanProp;
   // Отображать вертикальные линии сетки
   property EnVGrid : boolean index 2 read GetBooleanProp write SetBooleanProp;
   // Отображать подписи значений на осциллограме
   property EnCapt : boolean  index 3 read GetBooleanProp write SetBooleanProp;
   // ---------------------------------------
   // СВОЙСТВА ДЛЯ ПОДКЛЮЧЕНИЯ ОБРАБОТЧИКОВ СОБЫТИЙ
   // Обработчик события - прорисовка значения
   property OnDrawItem : TIQNotify read fOnDrawItem write fOnDrawItem;
   // Обработчик события - сигнал выше порога
   property OnAlertItem : TIQNotify read fOnAlertItem write fOnAlertItem;
   // ---------------------------------------
end;

implementation

// -----------------------------------------------------------------------
//   РЕАЛИЗАЦИЯ КЛАССА TDDisplay
// -----------------------------------------------------------------------
// КОНСТРУКТОР
constructor TDDisplay.Create (RqDisplay : TComponent);
begin
  if (RqDisplay is TImage)
  then begin
     inherited Create(RqDisplay);  // Вызов конструктора из класса TIQueue
     // ССЫЛКИ
     fDDisplay := (RqDisplay as TImage);
     // УСТАНОВКИ ЦВЕТА
     fDColor   := clBackground;    // Display color. Цвет поля дисплея
     fBColor   := clLime;          // Beam color.    Цвет луча
     fGColor   := clBtnShadow;     // Grid color.    Цвет сетки координат
     fAColor   := clBtnHighlight;  // Axes color.    Цвет осей координат
     // УСТАНОВКИ ОТОБРАЖЕНИЯ
     fEnHGrid  := True;            // Отображать горизонтальные линии сетки
     fEnVGrid  := True;            // Отображать вертикальные линии сетки
     fEnCapt   := True;            // Отображать подписи значений
     // УСТАНОВКИ МАСШТАБОВ
     fGNumX  := MaxCount;          // Число линий сетки по оси Х
     fGNumH  := 5;                 // Число горизонтальных линий сетки над осью X
     fSens   := 10;                // Чувствительность (единицы на шаг сетки)
     // УСТАНОВКИ АНАЛИЗА
     fMdAlert := -1;               // Пороговая амплитуда сигнала (отключено)
  end;
end;

// -----------------------------------------------------------------------
// СЕРВИСЫ ДЛЯ СВОЙСТВ
// -----------------------------------------------------------------------
// Запись свойств типа boolean
procedure TDDisplay.SetBooleanProp(RqInd : integer; RqProp : boolean);
begin
  case RqInd of
  1 : fEnHGrid  := RqProp;    // Отображать горизонтальные линии сетки
  2 : fEnVGrid  := RqProp;    // Отображать вертикальные линии сетки
  3 : fEnCapt   := RqProp;    // Отображать подписи значений
  end;
end;
// Чтение свойств типа boolean
function TDDisplay.GetBooleanProp(RqInd : integer) : boolean;
begin
  Result := False;
  case RqInd of
  1 : Result := fEnHGrid;    // Отображать горизонтальные линии сетки
  2 : Result := fEnVGrid;    // Отображать вертикальные линии сетки
  3 : Result := fEnCapt;     // Отображать подписи значений
  end;
end;

// Установка количества отсчетов на дисплее (длина осереди)
procedure TDDisplay.SetDMaxCountProp (RqDMaxCount : integer);
begin
   if RqDMaxCount > 2
   then begin
     MaxCount := RqDMaxCount;         //Новая длина очереди
     fGNumX   := MaxCount;            // Число линий сетки по оси Х
     ClearDisplay(fDColor, fBColor);  // Очистить дисплай
   end;
end;

// -----------------------------------------------------------------------
// ИНТЕРФЕЙСЫ ДЛЯ ВЫЗОВА ОБРАБОТЧИКОВ СОБЫТИЙ
// -----------------------------------------------------------------------
// Интерфейс обработчика события - прорисовка текущего значения
procedure TDDisplay.RunOnDrawItem(X,Y : integer; Item : TQItem);
begin
  if Assigned(fOnDrawItem)
  then begin
    fOnDrawItem(Self, X, Y, Item);
  end;
end;
// -----------------------------------------------------------------------
// Интерфейс обработчика события - сигнал выше порога
procedure TDDisplay.RunOnAlertItem(X,Y : integer; Item : TQItem);
begin
  if Assigned(fOnAlertItem)
  then begin
    fOnAlertItem(Self, X, Y, Item);
  end;
end;

// -----------------------------------------------------------------------
// ОСНОВНЫЕ МЕТОДЫ
// -----------------------------------------------------------------------
// Преобразовать значение из Item в значение свойства Image.Top
function TDDisplay.ValueToTop(Item : TQItem) : integer;
begin
  Result := fZeroTop;  // Top - уровень нулевой линии (ось X)
  if Assigned(Item)
  then begin
    Result := fZeroTop - Trunc(fScaleY * Item.RData);
  end;
end;
// -----------------------------------------------------------------------
// Полная очистка дисплея и установка параметров для прорисовки
procedure TDDisplay.ClearDisplay(RqFillColor, RqRenColor : TColor);
begin
  if (fDisplay is TImage)
  then begin
     with fDDisplay do
     begin
        // Top - уровень нулевой линии осциллограммы
        fZeroTop := Height div 2;
        // Вертикальная чувствительность осциллографа
        fScaleY  := fZeroTop / (fSens * fGNumH);
        // Очистить переменные для прорисовки графика
        Canvas.Font.Size := 7;
        fXStep := (Width - Canvas.TextWidth(CtrlTextStr)) div fGNumX;
        fCount := 0;
        // Установить цвет поля дисплея
        Canvas.Brush.Style := bsSolid;
        Canvas.Brush.Color := RqFillColor;
        // Очистить поле экрана
        Canvas.FillRect(Rect(0, 0, Width, Height));
        // Прорисовка линий сетки на дисплее
        DrawGridLine();
        // Прорисовать нулевую линию
        DrawZeroLine();
        // Установить цвет пера для осциллограммы
        Canvas.Pen.Color := RqRenColor;
     end;
  end;
end;
// -----------------------------------------------------------------------
// Очистить дисплей
procedure TDDisplay.DisplayClear();
begin
  ClearQueue;
  ClearDisplay(fDColor, fBColor);
end;
// -----------------------------------------------------------------------
// Прорисовка линий сетки
procedure TDDisplay.DrawGridLine();
var Step, Count : integer;
begin
  with fDDisplay do
  begin
    // Прорисовка горизонтальных линий сетки
    if fEnHGrid
    then begin
       Step := fZeroTop div fGNumH;
       Canvas.Pen.Color := fGColor;
       for Count := 0 to fGNumH do
       begin
          // Прорисовка линий сетки над нулевой линией
          Canvas.MoveTo ( 0,     fZeroTop - Count * Step);
          Canvas.LineTo ( Width, fZeroTop - Count * Step);
          // Прорисовка линий сетки под нулевой линией
          Canvas.MoveTo ( 0,     fZeroTop + Count * Step);
          Canvas.LineTo ( Width, fZeroTop + Count * Step);
       end;
    end;
    // Прорисовка вертикальных линий сетки
    if fEnVGrid
    then begin
       Canvas.Pen.Color := fGColor;
       for Count := 0 to fGNumX do
       begin
         Canvas.MoveTo ( Count * fXStep, 0);
         Canvas.LineTo ( Count * fXStep, Height);
       end;
    end;
  end; // of with fDDisplay
end;
// -----------------------------------------------------------------------
// Прорисовка нулевой линии на дисплее (Прорисовка оси Х)
procedure TDDisplay.DrawZeroLine();
var Count : integer;
begin
  with fDDisplay do
  begin
    // Прорисовать нулевую линию
    Canvas.Pen.Color := fAColor;
    Canvas.MoveTo(0, fZeroTop);
    Canvas.LineTo(Width, fZeroTop);
    // Прорисовать деления на нулевой линии
    //Step := Width div fGNumX;
    for Count := 0 to fGNumX do
    begin
      Canvas.MoveTo ( Count * fXStep, fZeroTop - 3);
      Canvas.LineTo ( Count * fXStep, fZeroTop + 3);
    end;
  end;
end;
// -----------------------------------------------------------------------
// Вывод текста текущего значения над линией текушего значения
procedure TDDisplay.DrawCurrentCaption(Item : TQItem);
begin
  with fDDisplay do
  begin
     // Установить цвет подписей на экране
     if (fMdAlert > 0) and (fMdAlert < Abs(Item.RData))
     then Canvas.Font.Color := RGB(255,0,0)     // Сигнал превысил порог
     else Canvas.Font.Color := fBColor;
     // Вывод подписи текущего значения
     if fEnCapt
     then begin
        Canvas.TextOut ( fCount * fXStep + 1,
              ValueToTop(Item) - Canvas.TextHeight('Y'),
              FormatFloat('#0.', Item.RData) );
     end;
  end;
end;
// -----------------------------------------------------------------------
// Прорисовка линии текущего значения
procedure TDDisplay.DrawCurrentLine(Item : TQItem);
begin
  with fDDisplay do
  begin
    DrawCurrentCaption(Item);
    // fCount * fXStep определяет текущую позицию по Х
    // fZeroTop определяет Y нулевой линии
    // fZeroTop - RqValue определяет текущую позицию по Y
    Canvas.MoveTo(fCount * fXStep, ValueToTop(Item));
    fCount := fCount + 1;
    Canvas.LineTo(fCount * fXStep, ValueToTop(Item));
    // ВЫЗОВ ИНТЕРФЕЙСА ОБРАБОТЧИКА СОБЫТИЙ
    RunOnDrawItem(fCount * fXStep, ValueToTop(Item), Item);
  end;
end;
// -----------------------------------------------------------------------
// Прорисовка линии перехода с текущего значения на следующее значение
procedure TDDisplay.DrawGoToNextLine(Item : TQItem);
begin
  with fDDisplay do
  begin
    Canvas.LineTo(fCount * fXStep, ValueToTop(Item));
  end;
end;
// -----------------------------------------------------------------------
// ОТОБРАЗИТЬ ОЧЕРЕДЬ В ДИСПЛЕЙ В ВИДЕ ЦИФРОВОГО СИГНАЛА
procedure TDDisplay.ShowItemQueue();
begin
    with fDDisplay do
    begin
      // Очистить дисплай
      ClearDisplay(fDColor, fBColor);
      // Прорисовать осциллограмму
      if (fICount > 0) and Assigned(fPHead) and Assigned(fPTail)
      then begin
         fPBuf := fPHead;
         repeat
            // Прорисовать линию текущего значения
            DrawCurrentLine(fPBuf);
            // Выборка из очереди следующего элемента
            fPBuf := fPBuf.PNext;
            if Assigned(fPBuf)
            then begin
              // Прорисовать линию перехода на следующее значение
              DrawGoToNextLine(fPBuf);
            end;
         // Продолжать пока очередь не станет пустой
         until not Assigned(fPBuf);
         // Анализ последнего значения и вывод подписи
         fPBuf := fPTail;
         if (fMdAlert > 0) and (fMdAlert < Abs(fPBuf.RData))
         then begin
             // Вызов интерфейса обработчика события - сигнал выше порога
             RunOnAlertItem((fGNumX -1) * fXStep,
                           ValueToTop(fPBuf), fPBuf);
             // Установить цвет подписей на экране
             Canvas.Font.Color := RGB(255,0,0);
         end
         else Canvas.Font.Color := fBColor;
         Canvas.TextOut ( fCount * fXStep,
                          ValueToTop(fPBuf) - Canvas.TextHeight('Y') - 4,
                          FormatFloat(CtrlTextStr, fPBuf.RData));
      end;
    end;
end;
// -----------------------------------------------------------------------
// ОТОБРАЗИТЬ ОЧЕРЕДЬ В ДИСПЛЕЙ В ВИДЕ АНАЛОГОВОГО СИГНАЛА
procedure TDDisplay.AnalogShowItemQueue();
begin
    with fDDisplay do
    begin
       // Очистить дисплай
       ClearDisplay(fDColor, fBColor);
       // Прорисовать осциллограмму
       if (fICount > 0) and Assigned(fPHead) and Assigned(fPTail)
       then begin
          fPBuf := fPHead;
          // fCount * fXStep определяет текущую позицию по Х
          Canvas.MoveTo(fCount * fXStep, ValueToTop(fPBuf));
          fCount := fCount + 1;
          Canvas.LineTo(fCount * fXStep, ValueToTop(fPBuf));
          repeat
              fPBuf := fPBuf.PNext;
              if Assigned(fPBuf)
              then begin
                  fCount := fCount + 1;
                  Canvas.LineTo(fCount * fXStep, ValueToTop(fPBuf));
                  // ВЫЗОВ ИНТЕРФЕЙСА ОБРАБОТЧИКА СОБЫТИЙ
                  RunOnDrawItem(fCount * fXStep, ValueToTop(fPBuf), fPBuf);
              end;
          // Продолжать пока очередь не станет пустой
          until not Assigned(fPBuf);
          // Вывод подписи последнего значения
          if fEnCapt
          then begin
             // Анализ последнего значения и вывод подписи
             fPBuf := fPTail;
             if (fMdAlert > 0) and (fMdAlert < Abs(fPBuf.RData))
             then begin
                // Вызов интерфейса обработчика события - сигнал выше порога
                RunOnAlertItem((fGNumX -1) * fXStep,
                                ValueToTop(fPBuf), fPBuf);
                 // Установить цвет подписей на экране
                 Canvas.Font.Color := RGB(255,0,0);
             end
             else Canvas.Font.Color := fBColor;
             Canvas.TextOut ( fCount * fXStep,
                              ValueToTop(fPBuf) - Canvas.TextHeight('Y') - 4,
                              FormatFloat(CtrlTextStr, fPBuf.RData));
          end;
       end;
    end;
end;

// -----------------------------------------------------------------------
end.

