Направить ось Y вверх

По умолчанию, ось Y направлена вниз. Иногда требуется направить ось ординат снизу-вверх. Как правило, перенаправление оси влечет за собой неправильное отображение текста. Нарушается логика определения объектов под курсором. Для исправления ситуации привлекаются аффинные преобразования. Хотя всего этого можно избежать.

Содержание скрыть

Рисуем гистограмму

Направить ось Y вверх

Нормальный текст

GDI+

Правильные координаты

Способ 2: Аффинные преобразования

Послесловие

Скачать

Рисуем гистограмму

Ситуация, когда нужно сменить направление оси Y вверх, встречается, например, когда рисуем графики. Возьмем в качестве графика гистограмму яркости изображения и нарисуем ее без «ручной» конвертации Y-координат. Думаю, все сталкивались с ситуацией, когда необходимо нарисовать так, как будто ось Y направлена вверх и пишем фразы что-то наподобие:

Y := Height — Y

Так вот, делать подобным образом не будем, просто считаем и выводим как есть.

// нарисовать гистограмму
// AHist - данные гистограммы
// AData - возвращаемый массив посчитанных точек
// Возвращает прямоугольник вывода гистограммы
function DrawHist(const ACanvas: TCanvas;
  const AHist: Array of Single;
  var AData: array of TPoint): TRect;
var
  rct: TRect;
  dx: Single;
  i: Integer;
begin
  rct := ACanvas.ClipRect;

  // ужать прямоугольник вывода
  InflateRect(rct,-10,-10*sign(rct.Height));
  // смещение по X
  dx := rct.Width/256;

  with ACanvas do
  begin
    Pen.Color := $00DDDDDD;
    for i := Low(AHist) to High(AHist) do
    begin
      // градировать кисть
      Brush.Color := RGB(i,i,i);
      // расчет координат
      AData[i] := Point(
        // просто как смещение слева
        Round(rct.Left+dx*i),
        // расчет Y, как процент от высоты прямоугольника вывода
        Round(rct.Top + rct.Height*AHist[i]/100)
      );
      // залить прямоугольник
      FillRect(Rect(Adata[i].X, rct.Top,
        Round(rct.Left+dx*(i+1)), AData[i].Y));

    end;

    // обойти лесенкой по внешнему контуру
    Pen.Color := $00555555;
    MoveTo(rct.Left,rct.Top);
    for i := Low(AHist) to High(AHist) do
    begin
      LineTo(AData[i].x, AData[i].y);
      LineTo(Round(rct.Left+dx*(i+1)), AData[i].y);
    end;
  end;

  Result := rct;
end;

// нарисовать гистограмму

// AHist - данные гистограммы

// AData - возвращаемый массив посчитанных точек

// Возвращает прямоугольник вывода гистограммы

function DrawHist(const ACanvas: TCanvas;

const AHist: Array of Single;

var AData: array of TPoint): TRect;

var

rct: TRect;

dx: Single;

i: Integer;

begin

rct := ACanvas.ClipRect;

// ужать прямоугольник вывода

InflateRect(rct,-10,-10*sign(rct.Height));

// смещение по X

dx := rct.Width/256;

with ACanvas do

begin

Pen.Color := $00DDDDDD;

for i := Low(AHist) to High(AHist) do

begin

// градировать кисть

Brush.Color := RGB(i,i,i);

// расчет координат

AData[i] := Point(

// просто как смещение слева

Round(rct.Left+dx*i),

// расчет Y, как процент от высоты прямоугольника вывода

Round(rct.Top + rct.Height*AHist[i]/100)

);

// залить прямоугольник

FillRect(Rect(Adata[i].X, rct.Top,

Round(rct.Left+dx*(i+1)), AData[i].Y));

end;

// обойти лесенкой по внешнему контуру

Pen.Color := $00555555;

MoveTo(rct.Left,rct.Top);

for i := Low(AHist) to High(AHist) do

begin

LineTo(AData[i].x, AData[i].y);

LineTo(Round(rct.Left+dx*(i+1)), AData[i].y);

end;

Result := rct;

end;

Шкала нам нужна для контроля за текстом и данными. Рисуем следующей процедурой.

// Нарисовать вертикальную шкалу
procedure DrawVert(const ACanvas: TCanvas; const ARect: TRect);

  function XStep(const AStep, AHeight: Single;
    var dy: Single; var step: Integer): Boolean;
  begin
    dy := ARect.Height / AStep;
    Result := Abs(dy) > AHeight;
    if Result then
      step := Round(100/AStep);
  end;

var
  rct: TRect;
  dy: Single;
  h: Single;
  i, y, step: Integer;
begin
  with ACanvas do
  begin
    h := -1.4 * Font.Height;
    rct := ClipRect;

    if not XStep(10, h, dy, step) then
      if not XStep(4, h, dy, step) then
        if not XStep(2, h, dy, step) then
        begin
          step := 100;
          dy := rct.Height;
        end;

    i := 0;
    y := ARect.Top;

    repeat
      MoveTo(0, y);
      LineTo(4, y);
      TextOut(6, y - TextHeight('9') div 2, IntToStr(i));
      i := i + step;
      y := Round(y + dy);
    until i > 100;
  end;
end;

// Нарисовать вертикальную шкалу

procedure DrawVert(const ACanvas: TCanvas; const ARect: TRect);

function XStep(const AStep, AHeight: Single;

var dy: Single; var step: Integer): Boolean;

begin

dy := ARect.Height / AStep;

Result := Abs(dy) > AHeight;

if Result then

step := Round(100/AStep);

end;

var

rct: TRect;

dy: Single;

h: Single;

i, y, step: Integer;

begin

with ACanvas do

begin

h := -1.4 * Font.Height;

rct := ClipRect;

if not XStep(10, h, dy, step) then

if not XStep(4, h, dy, step) then

if not XStep(2, h, dy, step) then

begin

step := 100;

dy := rct.Height;

end;

i := 0;

y := ARect.Top;

repeat

MoveTo(0, y);

LineTo(4, y);

TextOut(6, y - TextHeight('9') div 2, IntToStr(i));

i := i + step;

y := Round(y + dy);

until i > 100;

end;

Как видим, все достаточно просто. На выходе получаем такую картинку.

График ожидаемо перевернут. Посчитали и вывели данные «честно», как есть, без ручной корректировки Y.

Хочется видеть график в привычном, тетрадном, неперевернутом виде. Так, чтобы 0 находился слева снизу и шкала была снизу вверх. Сейчас сделаем.

Направить ось Y вверх

Имеет смысл ознакомиться с этим материалом. Дата книги, откуда приводится фрагмент, говорит только о том, что все может стремительно меняться, но математика и графика — вечны.

Нас интересует режим MM_ISOTROPIC. Для отрисовки используем обработчик события OnPaint компонента pb: TPaintBox. Ниже фрагмент обработчика, в котором происходит перенаправление оси ординат.

    with bmp.Canvas do
    begin
      rct := ClipRect;
      // направить ось Y вверх для GDI
      if CheckBox1.Checked then
      begin
        // установить режим
        SetMapMode(Handle, MM_ISOTROPIC);
        // назначить "физические" размеры окна
        SetWindowExtEx(Handle, rct.Width, rct.Height, nil);
        // установить соответствие логическим размерам окна
        SetViewportExtEx(Handle, rct.Width, -rct.Height, nil);
        // сместить логической центр координат в левый нижний угол
        SetViewportOrgEx(Handle, 0, rct.Height, nil);
      end;
      //...
   end;

with bmp.Canvas do

begin

rct := ClipRect;

// направить ось Y вверх для GDI

if CheckBox1.Checked then

begin

// установить режим

SetMapMode(Handle, MM_ISOTROPIC);

// назначить "физические" размеры окна

SetWindowExtEx(Handle, rct.Width, rct.Height, nil);

// установить соответствие логическим размерам окна

SetViewportExtEx(Handle, rct.Width, -rct.Height, nil);

// сместить логической центр координат в левый нижний угол

SetViewportOrgEx(Handle, 0, rct.Height, nil);

end;

//...

end;

В результате (на скрине обратите внимание на галочку Y Up — искомый CheckBox1.Checked) получаем график, который нас устраивает.

Однако, наблюдаем досадное недразумение с текстом.

Текст ожидаемо отзеркален фразой:

        // установить соответствие логическим размерам окна
        SetViewportExtEx(Handle, rct.Width, -rct.Height, nil);

1 2	// установить соответствие логическим размерам окна SetViewportExtEx(Handle, rct.Width, -rct.Height, nil);

Казалось бы, сейчас самое время для аффинного зеркального преобразования. Но не будем торопиться. Аффинные преобразования — это сила и мощь. Но если есть возможность не прибегать к силе, то лучше этого и не делать.

Нормальный текст

Мы просто прибегнем к помощи «продвинутого» графического режима. Помимо того, что этот режим позволяет применять аффинные преобразования, он умеет правильно выводить текст. Устанавливаем режим единственной фразой:

        if CheckBox2.Checked then
          SetGraphicsMode(Handle, GM_ADVANCED);

1 2	if CheckBox2.Checked then SetGraphicsMode(Handle, GM_ADVANCED);

CheckBox2.Checked соответствует галочке GM_ADVANCED в интерфейсе.

GDI+

Но нам нужен GDI+. Потому что любим плюшки, которые он предоставляет. Рассмотрим, как поведет себя GDI+ в условиях, когда ось Y направлена вверх.

Конечно, нужно чуть переписать вывод гистограммы под GDI+. Однако, координатный вывод не трогаем. По прежнему никаких корректировок по Y.

Вывод гистограммы и шкалы в GDI+

// Вывод вертикальной шкалы GDI+
procedure GDIPDrawVert(const ACanvas: TCanvas; const ARect: TRect);

  function XStep(const AStep, AHeight: Single;
    var dy: Single; var step: Integer): Boolean;
  begin
    dy := ARect.Height / AStep;
    Result := Abs(dy) > AHeight;
    if Result then
      step := Round(100/AStep);
  end;

var
  rct: TRect;
  dy: Single;
  h: Single;
  i, y, step: Integer;
  gpg: TGPGraphics;
  pen: TGPPen;
  font: TGPFont;
begin
  rct := ACanvas.ClipRect;
  h := -1.4 * ACanvas.Font.Height;

  gpg := TGPGraphics.Create(ACanvas.Handle);
  pen := TGPPen.Create(MakeColor($55,$55,$55));
  font:= GPFont(ACanvas.Font);

  try
    if not XStep(10, h, dy, step) then
      if not XStep(4, h, dy, step) then
        if not XStep(2, h, dy, step) then
        begin
          step := 100;
          dy := rct.Height;
        end;

    i := 0;
    y := ARect.Top;

    repeat
      gpg.DrawLine(pen, 0, y, 4, y);
      GDIPTextOut(gpg, PointF(6.0, y - ACanvas.TextHeight('9') / 2),
        IntToStr(i), TColor($00555555), font);
      i := i + step;
      y := Round(y + dy);
    until i > 100;

  finally
    FreeAndNil(pen);
    FreeAndNil(gpg);
    FreeAndNil(font);
  end;
end;

// Нарисовать гистограмму в GDI+
function GDIPDrawHist(const ACanvas: TCanvas; const AHist: Array of Single;
  var AData: array of TPoint): TRect;
var
  rct: TRect;
  dx: Single;
  i: Integer;
  gpg: TGPGraphics;
  pen: TGPPen;
  brush: TGPSolidBrush;
begin
  rct := ACanvas.ClipRect;
  gpg := TGPGraphics.Create(ACanvas.Handle);
  pen := TGPPen.Create(MakeColor($DD,$DD,$DD));
  brush := TGPSolidBrush.Create(MakeColor($55,$55,$55));

  try
    InflateRect(rct,-10,-10*sign(rct.Height));
    dx := rct.Width/256;

    for i := Low(AHist) to High(AHist) do
    begin
      Brush.SetColor(MakeColor(i,i,i));
      AData[i] := Point(Round(rct.Left+dx*i),
        Round(rct.Top + rct.Height*AHist[i]/100));

      if rct.Height < 0 then
        gpg.FillRectangle(brush, Adata[i].X, Adata[i].Y,
          dx, abs(AData[i].Y - rct.Top))
      else
        gpg.FillRectangle(brush, Adata[i].X, rct.Top,
          dx, AData[i].Y - rct.Top);

    end;

    pen.SetColor(MakeColor($55,$55,$55));
    for i := Low(AData)+1 to High(AData) do
    begin
      gpg.DrawLine(pen, AData[i].x, AData[i-1].y,
        AData[i].x, AData[i].y);
      gpg.DrawLine(pen, AData[i].x, AData[i].y,
        rct.Left+dx*(i+1), AData[i].y);
    end;

  finally
    FreeAndNil(brush);
    FreeAndNil(pen);
    FreeAndNil(gpg);
    Result := rct;
  end;
end;

100

101

102

103

104

105

106

// Вывод вертикальной шкалы GDI+

procedure GDIPDrawVert(const ACanvas: TCanvas; const ARect: TRect);

function XStep(const AStep, AHeight: Single;

var dy: Single; var step: Integer): Boolean;

begin

dy := ARect.Height / AStep;

Result := Abs(dy) > AHeight;

if Result then

step := Round(100/AStep);

end;

var

rct: TRect;

dy: Single;

h: Single;

i, y, step: Integer;

gpg: TGPGraphics;

pen: TGPPen;

font: TGPFont;

begin

rct := ACanvas.ClipRect;

h := -1.4 * ACanvas.Font.Height;

gpg := TGPGraphics.Create(ACanvas.Handle);

pen := TGPPen.Create(MakeColor($55,$55,$55));

font:= GPFont(ACanvas.Font);

try

if not XStep(10, h, dy, step) then

if not XStep(4, h, dy, step) then

if not XStep(2, h, dy, step) then

begin

step := 100;

dy := rct.Height;

end;

i := 0;

y := ARect.Top;

repeat

gpg.DrawLine(pen, 0, y, 4, y);

GDIPTextOut(gpg, PointF(6.0, y - ACanvas.TextHeight('9') / 2),

IntToStr(i), TColor($00555555), font);

i := i + step;

y := Round(y + dy);

until i > 100;

finally

FreeAndNil(pen);

FreeAndNil(gpg);

FreeAndNil(font);

end;

// Нарисовать гистограмму в GDI+

function GDIPDrawHist(const ACanvas: TCanvas; const AHist: Array of Single;

var AData: array of TPoint): TRect;

var

rct: TRect;

dx: Single;

i: Integer;

gpg: TGPGraphics;

pen: TGPPen;

brush: TGPSolidBrush;

begin

rct := ACanvas.ClipRect;

gpg := TGPGraphics.Create(ACanvas.Handle);

pen := TGPPen.Create(MakeColor($DD,$DD,$DD));

brush := TGPSolidBrush.Create(MakeColor($55,$55,$55));

try

InflateRect(rct,-10,-10*sign(rct.Height));

dx := rct.Width/256;

for i := Low(AHist) to High(AHist) do

begin

Brush.SetColor(MakeColor(i,i,i));

AData[i] := Point(Round(rct.Left+dx*i),

Round(rct.Top + rct.Height*AHist[i]/100));

if rct.Height < 0 then

gpg.FillRectangle(brush, Adata[i].X, Adata[i].Y,

dx, abs(AData[i].Y - rct.Top))

else

gpg.FillRectangle(brush, Adata[i].X, rct.Top,

dx, AData[i].Y - rct.Top);

end;

pen.SetColor(MakeColor($55,$55,$55));

for i := Low(AData)+1 to High(AData) do

begin

gpg.DrawLine(pen, AData[i].x, AData[i-1].y,

AData[i].x, AData[i].y);

gpg.DrawLine(pen, AData[i].x, AData[i].y,

rct.Left+dx*(i+1), AData[i].y);

end;

finally

FreeAndNil(brush);

FreeAndNil(pen);

FreeAndNil(gpg);

Result := rct;

end;

[свернуть]

Это ровно то же самое, что было написано для GDI.

Рис.5. GDI+ сам по себе продвинутый режим

GDI+ является надстройкой над GDI. И если мы применили какие-то эпические действия к контексту устройства, то они явным образом перетекают в GDI+. Никаких действий с текстом производить не требуется. Мы просто вначале направили ось Y вверх, затем создали на этом контексте TGPGraphics.

Галка на GM_ADVANCED никак не влияет на вывод. GDI+ сам по себе продвинутый режим.

Правильные координаты

Часто необходимо по координатам мыши определять объект под курсором, перемещать по нажатию и т.д. Что делать в ситуации, когда привычный мир перевернут. Можно считать руками конечно. Но лучше использовать специальные функции для этого. Такие функции есть и в GDI, и в GDI+, и в Direct2D.

Для GDI это пара функций DPtoLP и LPtoDP. Нас интересует первая. Так как функция работает на контексте устройства, чуть изменим привычный алгоритм отрисовки. Битмап, на котором рисуем в обработчике OnPaint, освобождать не будем. А будем запоминать его:

  try
    // рисуем на bmp.Canvas

  finally
    pbx.Canvas.Draw(0,0,bmp);
    FBitmap := bmp;
//    FreeAndNil(bmp);

  end;

try

// рисуем на bmp.Canvas

finally

pbx.Canvas.Draw(0,0,bmp);

FBitmap := bmp;

// FreeAndNil(bmp);

end;

А в обработчике OnMouseMove компонента pb: TPaintBox будем выводить реальные и логические координаты.

procedure TFmMain.pbMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  pnt: TPoint;
begin
  FCurrIndex := IndexOfData(FData, X, Y);
  FMousePoint := Point(X,Y);
  pbPaint(pb);

  if Assigned(FBitmap) then
  begin
    pnt := FMousePoint;
    DPtoLP(FBitmap.Canvas.Handle, pnt, 1);
    Label1.Caption := IntToStr(FMousePoint.X)+':'+
      IntToStr(FMousePoint.Y) + ' (' +
      IntToStr(pnt.X)+':'+ IntToStr(pnt.Y) + ') ';
  end;
end;

procedure TFmMain.pbMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

var

pnt: TPoint;

begin

FCurrIndex := IndexOfData(FData, X, Y);

FMousePoint := Point(X,Y);

pbPaint(pb);

if Assigned(FBitmap) then

begin

pnt := FMousePoint;

DPtoLP(FBitmap.Canvas.Handle, pnt, 1);

Label1.Caption := IntToStr(FMousePoint.X)+':'+

IntToStr(FMousePoint.Y) + ' (' +

IntToStr(pnt.X)+':'+ IntToStr(pnt.Y) + ') ';

end;

На рисунке 5 можно видеть результат в правом нижнем углу окна. Происходит вывод реальных координат и в скобках — логических.

Способ 2: Аффинные преобразования

Не могу обойти вниманием свои любимые аффинные преобразования. Рассмотрим сразу для GDI+. У нас есть контекст устройства, не тронутый никакими преобразованиями. Создадим на нем TGPGraphics. Чтобы направить ось Y вверх, установим аффинное преобразование.

       mx := TGPMatrix.Create;
       mx.SetElements(1.0, 0, 0, -1.0, 0, bmp.Height);
       gpg.SetTransform(mx);

mx := TGPMatrix.Create;

mx.SetElements(1.0, 0, 0, -1.0, 0, bmp.Height);

gpg.SetTransform(mx);

Получим перевернутый мир, где ось Y смотрит вверх. Проблему с зеркальным текстом решаем отдельной процедурой вывода.

procedure MirrorText(const ACanvas: TGPGraphics; const APoint: TPointF;
  const AText: String);
var
  mx1, mx2, mx3: TGPMatrix;
begin
  mx1 := TGPMatrix.Create;
  mx2 := nil;
  mx3 := TGPMatrix.Create;

  try
    // получить текущее преобразование холста
    ACanvas.GetTransform(mx1);
    // получить дубль преобразования
    mx2 := mx1.Clone;
    // создать матрицу зеркального отражения по Y
    mx3.SetElements(1.0, 0, 0, -1.0, APoint.x, APoint.y);
    // добавить к текущему преобразованию
    mx2.Multiply(mx3);
    // назначить новое преобразование холсту
    ACanvas.SetTransform(mx2);
    // вывод текста по координатам 0,0
    GDIPTextOut(ACanvas, PointF(0,0), AText, $00555555);
    // вернуть старое преобразование, которое было до этого
    ACanvas.SetTransform(mx1);

  finally
    FreeAndNil(mx1);
    FreeAndNil(mx2);
    FreeAndNil(mx3);
  end;
end;

procedure MirrorText(const ACanvas: TGPGraphics; const APoint: TPointF;

const AText: String);

var

mx1, mx2, mx3: TGPMatrix;

begin

mx1 := TGPMatrix.Create;

mx2 := nil;

mx3 := TGPMatrix.Create;

try

// получить текущее преобразование холста

ACanvas.GetTransform(mx1);

// получить дубль преобразования

mx2 := mx1.Clone;

// создать матрицу зеркального отражения по Y

mx3.SetElements(1.0, 0, 0, -1.0, APoint.x, APoint.y);

// добавить к текущему преобразованию

mx2.Multiply(mx3);

// назначить новое преобразование холсту

ACanvas.SetTransform(mx2);

// вывод текста по координатам 0,0

GDIPTextOut(ACanvas, PointF(0,0), AText, $00555555);

// вернуть старое преобразование, которое было до этого

ACanvas.SetTransform(mx1);

finally

FreeAndNil(mx1);

FreeAndNil(mx2);

FreeAndNil(mx3);

end;

Нахождением логических координат по реальным занимается метод TransformPoints матрицы преобразования. Получает массив точек, считает и возвращает в него же результат. Как бы это выглядело в обработчике OnMouseMove.

procedure TForm1.pbMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  pnt: TGPPointF;
begin
  Label1.Caption := IntToStr(X)+':'+IntToStr(Y);
  pnt := MakePoint(0.0+X, Y);
  FMatrix.TransformPoints(PGPPointF(@pnt), 1);
  Label2.Caption := IntToStr(Round(pnt.X))+':'+IntToStr(Round(pnt.Y));

end;

procedure TForm1.pbMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

var

pnt: TGPPointF;

begin

Label1.Caption := IntToStr(X)+':'+IntToStr(Y);

pnt := MakePoint(0.0+X, Y);

FMatrix.TransformPoints(PGPPointF(@pnt), 1);

Label2.Caption := IntToStr(Round(pnt.X))+':'+IntToStr(Round(pnt.Y));

end;

Label1 — реальные координаты. Label2 — логические, которые можно использовать для нахождения объектов, границ и каких-то других операций.

Послесловие

Для полноты картины привожу полный текст обработчика OnPaint.

Направить ось Y вверх

procedure TFmMain.pbPaint(Sender: TObject);
var
  bmp: TBitmap;
  rct: TRect;
  pbx: TPaintBox;
begin
  if not FAlreadyPrepared then
  begin
    MakeHistogram(Image1.Picture.Graphic, FHist);
    FAlreadyPrepared := True;
  end;

  if Sender is TPaintBox then
    pbx := Sender as TPaintBox
  else
    pbx := pb;

  rct := pbx.ClientRect;
  FreeAndNil(FBitmap);
  bmp := CreateBmpRect(rct);

  try
    with bmp.Canvas do
    begin
      Font.Assign(pbx.Font);
      rct := ClipRect;
      Pen.Color := $00555555;

      // направить ось Y вверх для GDI
      if CheckBox1.Checked then
      begin
        // установить режим
        SetMapMode(Handle, MM_ISOTROPIC);
        // назначить "физические" размеры окна
        SetWindowExtEx(Handle, rct.Width, rct.Height, nil);
        // установить соответствие логическим размерам окна 
        SetViewportExtEx(Handle, rct.Width, -rct.Height, nil);
        // сместить логической центр координат в левый нижний угол
        SetViewportOrgEx(Handle, 0, rct.Height, nil);
      end;


      // Если указано, установить продвинутый режим 
      if CheckBox2.Checked then
        SetGraphicsMode(Handle, GM_ADVANCED);

      rct := ClipRect;
      Brush.Color := clWhite;
      FillRect(rct);

      
      // Нарисовать гистограмму и шкалу
      if CheckBox3.Checked then
      begin// указано рисовать в GDI+
        rct := GDIPDrawHist(bmp.Canvas, FHist, FData);
        GDIPDrawVert(bmp.Canvas, rct);
      end else
      begin
        rct := DrawHist(bmp.Canvas, FHist, FData);
        DrawVert(bmp.Canvas, rct);
      end;


      // Нарисовать синий маркер   
      if FCurrIndex > -1 then
      begin
        Brush.Color := clWebSteelBlue;
        rct := Rect(FData[FCurrIndex].X, rct.Top,
          Round(FData[FCurrIndex].X + rct.Width/256), FData[FCurrIndex].Y);
        FillRect(rct);

        Brush.Style := bsClear;
        Font.Color := clWebSteelBlue;
        Font.Style := [fsBold];

        if CheckBox3.Checked then
          // указано рисовать в GDI+
          GDIPTextOut(bmp.Canvas, PointF(rct.Left+4, rct.Bottom),
            FormatFloat('##0.#',FHist[FCurrIndex]))
        else
          TextOut(rct.Left+4, rct.Bottom, 
            FormatFloat('##0.#',FHist[FCurrIndex]));
      end;


      // Рамка 
      Brush.Style := bsClear;
      rct := ClipRect;
      Rectangle(rct);
    end;

  finally
    pbx.Canvas.Draw(0,0,bmp);
    FBitmap := bmp;
  end;
end;

procedure TFmMain.pbPaint(Sender: TObject);

var

bmp: TBitmap;

rct: TRect;

pbx: TPaintBox;

begin

if not FAlreadyPrepared then

begin

MakeHistogram(Image1.Picture.Graphic, FHist);

FAlreadyPrepared := True;

end;

if Sender is TPaintBox then

pbx := Sender as TPaintBox

else

pbx := pb;

rct := pbx.ClientRect;

FreeAndNil(FBitmap);

bmp := CreateBmpRect(rct);

try

with bmp.Canvas do

begin

Font.Assign(pbx.Font);

rct := ClipRect;

Pen.Color := $00555555;

// направить ось Y вверх для GDI

if CheckBox1.Checked then

begin

// установить режим

SetMapMode(Handle, MM_ISOTROPIC);

// назначить "физические" размеры окна

SetWindowExtEx(Handle, rct.Width, rct.Height, nil);

// установить соответствие логическим размерам окна

SetViewportExtEx(Handle, rct.Width, -rct.Height, nil);

// сместить логической центр координат в левый нижний угол

SetViewportOrgEx(Handle, 0, rct.Height, nil);

end;

// Если указано, установить продвинутый режим

if CheckBox2.Checked then

SetGraphicsMode(Handle, GM_ADVANCED);

rct := ClipRect;

Brush.Color := clWhite;

FillRect(rct);

// Нарисовать гистограмму и шкалу

if CheckBox3.Checked then

begin// указано рисовать в GDI+

rct := GDIPDrawHist(bmp.Canvas, FHist, FData);

GDIPDrawVert(bmp.Canvas, rct);

end else

begin

rct := DrawHist(bmp.Canvas, FHist, FData);

DrawVert(bmp.Canvas, rct);

end;

// Нарисовать синий маркер

if FCurrIndex > -1 then

begin

Brush.Color := clWebSteelBlue;

rct := Rect(FData[FCurrIndex].X, rct.Top,

Round(FData[FCurrIndex].X + rct.Width/256), FData[FCurrIndex].Y);

FillRect(rct);

Brush.Style := bsClear;

Font.Color := clWebSteelBlue;

Font.Style := [fsBold];

if CheckBox3.Checked then

// указано рисовать в GDI+

GDIPTextOut(bmp.Canvas, PointF(rct.Left+4, rct.Bottom),

FormatFloat('##0.#',FHist[FCurrIndex]))

else

TextOut(rct.Left+4, rct.Bottom,

FormatFloat('##0.#',FHist[FCurrIndex]));

end;

// Рамка

Brush.Style := bsClear;

rct := ClipRect;

Rectangle(rct);

end;

finally

pbx.Canvas.Draw(0,0,bmp);

FBitmap := bmp;

end;

[свернуть]

Для нахождения гистограммы используется следующая функция

Нахождение гистограммы яркости изображения

procedure MakeHistogram(AGraphic: TGraphic; var AHist: array of Single);
var
  bmp: TBitmap;
  cnt: Integer;
  val: Byte;
  mx: Single;
  p: PRGBQuad;
  i: Integer;
begin
  bmp := LoadBitmapFromGraphic(AGraphic, pf32bit);

  try
    ZeroMemory(@AHist[0], SizeOf(AHist));
    // рассчитать гистограмму
    p := bmp.ScanLine[bmp.Height-1];
    cnt := bmp.Width * bmp.Height;
    for i := 0 to cnt - 1 do
    begin
      val := GrayScaleByte(p);
      AHist[val] := AHist[val] + 1;
      inc(p);
    end;

    // найти максимум
    mx := 0;
    for i := Low(AHist) to High(AHist) do
      if AHist[i] > mx then
        mx := AHist[i];

    // пересчитать в процентах от максимума
    if mx > 0 then
      for i := Low(AHist) to High(AHist) do
        AHist[i] := 100 * AHist[i]/mx;

  finally
    FreeAndNil(bmp);
  end;
end;

procedure MakeHistogram(AGraphic: TGraphic; var AHist: array of Single);

var

bmp: TBitmap;

cnt: Integer;

val: Byte;

mx: Single;

p: PRGBQuad;

i: Integer;

begin

bmp := LoadBitmapFromGraphic(AGraphic, pf32bit);

try

ZeroMemory(@AHist[0], SizeOf(AHist));

// рассчитать гистограмму

p := bmp.ScanLine[bmp.Height-1];

cnt := bmp.Width * bmp.Height;

for i := 0 to cnt - 1 do

begin

val := GrayScaleByte(p);

AHist[val] := AHist[val] + 1;

inc(p);

end;

// найти максимум

mx := 0;

for i := Low(AHist) to High(AHist) do

if AHist[i] > mx then

mx := AHist[i];

// пересчитать в процентах от максимума

if mx > 0 then

for i := Low(AHist) to High(AHist) do

AHist[i] := 100 * AHist[i]/mx;

finally

FreeAndNil(bmp);

end;

[свернуть]

Рисовать текст в GDI+ достаточно геморное занятие, поэтому вся рутинная работа с GDI+ сосредоточена в модуле IP76.GDIPRoutines. Также, дополнительно используются модули IP76.DrawUtils и IP76.ColorUtils.

Скачать

Cпасибо за внимание!

Надеюсь, материал был полезен.

Не пропустите новых «интересностей», подписывайтесь на телегу.

Если есть вопросы, с удовольствием отвечу.

Исходники (Delphi XE 7-10) 527 Кб

Исполняемый файл (zip) 1.43 Мб

5 4 голоса

Рейтинг статьи

0 комментариев

Межтекстовые Отзывы

Посмотреть все комментарии