Процедура выводит на Canvas семисегментный индикатор, позволяя управлять включенными сегментами

Delphi , Графика и Игры , Canvas

Автор: Pavel Manzharov
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Процедура выводит на Canvas семисегментный индикатор,
позволяя управлять включенными сегментами

Процедура выводит на Canvas индикатор семисегментного кода
Вход:
SegStr - Строка содержащая символы горящих сегментов(используемые символы ABCDEFGH)
x,y - координаты верхнего левого угла вывода индикатора
Scale - масштаб индикатора от 1 и выше (множитель)
Hndl - Handle Canvas на который выводится изображение

Зависимости: Стандартные
Автор:       Pavel Manzharov, pavel_man@hotmail.com, ICQ:4838921, Москва
Copyright:   Pavel Manzharov
Дата:        25 февраля 2003 г.
***************************************************** }

{Процедура выводит на Canvas индикатор семисегментного кода
Вход:
     SegStr - Строка содержащая символы горящих сегментов
       (используемые символы ABCDEFGH)
     x,y - координаты верхнего левого угла вывода индикатора
     Scale - масштаб индикатора от 1 и выше (множитель)
     Hndl - Handle Canvas на который выводится изображение}

procedure Display7Seg(SegStr: string; x, y: integer; Scale: extended; hndl:
  hdc);
const
  // Цвет горящих сегментов
  ColorOn: Tcolor = clBlue;
  // Цвет погашенных сенментов
  ColorOff: TColor = clltGray;
var
  // Canvas на который выводится изображение
  Canvas1: TCanvas;
  // Координаты выводимого сегмента
  x1, x2, y1, y2: integer;
begin
  // Создаем Canvas
  Canvas1 := TCanvas.Create;
  // Проверяем масштаб и если он меньше 1 присваиваем ему 1
  if Scale < 1 then
    scale := 1;
  // Укажем что вывод осуществляется на Canvas переданный в параметрах
  Canvas1.Handle := Hndl;
  // Установим толщину линий сегментов равной масштабу
  Canvas1.Pen.Width := Trunc(Scale);
  // Пересчитаем координаты вывода с учетом масштаба для всех сегментов
  {A}
  x1 := Trunc(x + 1 * scale);
  x2 := Trunc(x1 + 5 * scale);
  y1 := y;
  y2 := y;
  if StrPos(Pchar(SegStr), 'A') <> nil then
    Canvas1.Pen.Color := ColorOn
  else
    Canvas1.Pen.Color := ColorOff;
  Canvas1.MoveTo(x1, y1);
  Canvas1.LineTo(x2, y2);
  {G}
  y1 := Trunc(y + 6 * Scale);
  y2 := y1;
  if StrPos(Pchar(SegStr), 'G') <> nil then
    Canvas1.Pen.Color := ColorOn
  else
    Canvas1.Pen.Color := ColorOff;
  Canvas1.MoveTo(x1, y1);
  Canvas1.LineTo(x2, y2);
  {D}
  y1 := Trunc(y + 12 * Scale);
  y2 := y1;
  if StrPos(Pchar(SegStr), 'D') <> nil then
    Canvas1.Pen.Color := ColorOn
  else
    Canvas1.Pen.Color := ColorOff;
  Canvas1.MoveTo(x1, y1);
  Canvas1.LineTo(x2, y2);
  {H}
  x1 := Trunc(x + 8 * Scale);
  x2 := x1;
  if StrPos(Pchar(SegStr), 'H') <> nil then
    Canvas1.Pen.Color := ColorOn
  else
    Canvas1.Pen.Color := ColorOff;
  Canvas1.MoveTo(x1, y1);
  Canvas1.LineTo(x2, y2);
  {F}
  x1 := x;
  x2 := x;
  y1 := Trunc(y + 1 * scale);
  y2 := Trunc(y + 5 * scale);
  if StrPos(Pchar(SegStr), 'F') <> nil then
    Canvas1.Pen.Color := ColorOn
  else
    Canvas1.Pen.Color := ColorOff;
  Canvas1.MoveTo(x1, y1);
  Canvas1.LineTo(x2, y2);
  {E}
  y1 := Trunc(y + 7 * scale);
  y2 := Trunc(y + 11 * scale);
  if StrPos(Pchar(SegStr), 'E') <> nil then
    Canvas1.Pen.Color := ColorOn
  else
    Canvas1.Pen.Color := ColorOff;
  Canvas1.MoveTo(x1, y1);
  Canvas1.LineTo(x2, y2);
  {C}
  x1 := Trunc(x + 7 * scale);
  x2 := x1;
  if StrPos(Pchar(SegStr), 'C') <> nil then
    Canvas1.Pen.Color := ColorOn
  else
    Canvas1.Pen.Color := ColorOff;
  Canvas1.MoveTo(x1, y1);
  Canvas1.LineTo(x2, y2);
  {B}
  y1 := Trunc(y + 1 * scale);
  y2 := Trunc(y + 5 * scale);
  if StrPos(Pchar(SegStr), 'B') <> nil then
    Canvas1.Pen.Color := ColorOn
  else
    Canvas1.Pen.Color := ColorOff;
  Canvas1.MoveTo(x1, y1);
  Canvas1.LineTo(x2, y2);
  // После вывода последнего сегмента освободим Canvas
  Canvas1.Free;
end;

Пример использования:

Hndl := Form1.Canvas.Handle;
Display7Seg('ABCDE',100,20,8,Hndl); 

Преобразуем контент в русский язык:

Вот процедура Delphi, называемая Display7Seg, которая отображает семисегментный индикатор на канвасе. Procedure принимает пять параметров:

• SegStr: строка, содержащая символы для отображения на индикаторе (A-G)
• x, y: координаты верхнего левого угла индикатора
• Scale: масштабный фактор для индикатора (должен быть больше 1)
• hndl: handle канваса, на котором нужно нарисовать

Procedure использует объект TCanvas для рисования индикатора и устанавливает цвет кисти в зависимости от включения или отключения каждого сегмента.

Вот шаг за шагом, как работает procedure:

1. Создается новый объект TCanvas и присваивается переменной Canvas1.
2. Проверяется, является ли параметр Scale меньше 1, и если да, то устанавливается в 1.
3. Устанавливается цвет кисти в зависимости от включения или отключения каждого сегмента, поисковая соответствующий символ в строке SegStr.
4. Рисуются каждый сегмент с помощью методов MoveTo и LineTo объекта Canvas1.
5. Наконец, освобождается объект Canvas1, чтобы освободить системные ресурсы.

Пример использования показывает, как вызывать эту procedure с примером ввода:

Hndl  := Form1.Canvas.Handle;
Display7Seg('ABCDE', 100, 20, 8, Hndl);

Это код будет рисовать семисегментный индикатор на канвасе в координатах (100,20) с масштабным фактором 8 и отображать символы 'A', 'B', 'C', 'D' и 'E'.

Procedure хорошо организована и легко понятна, но есть несколько предложений, которые можно сделать для улучшения:

• Рассмотрите возможность использования цикла for вместо повторения кода для каждого сегмента. Это уменьшит количество дублирующегося кода.
• Вам может быть полезно использовать массив или список для хранения координат и цветов для каждого сегмента, а не жестко закодировать их в procedure.
• Наконец, вам может быть полезно добавить обработку ошибок, чтобы обеспечить валидность входных параметров (например, проверка, является ли Scale меньше 1).

Процедура выводит на Canvas семисегментный индикатор, позволяя управлять включенными сегментами.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Canvas ::