Delphi World - Процедура выводит на Canvas семисегментный индикатор, позволяя управлять включенными сегментами
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Процедура выводит на 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 World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования