Как свойство Align в Delphi XE2 Firemonkey, для которого задано значение alScale, влияет на систему координат?

Как свойство Align в Delphi XE2 Firemonkey, для которого задано значение alScale, влияет на систему координат?

Я изучаю возможности рисования холста Firemonkey и столкнулся с проблемами с системой координат, когда для свойства Align компонента установлено значение alScale. Следующая демонстрационная программа (приложение FM HD) иллюстрирует проблему. Скомпилируйте и запустите пример кода, нарисуйте пару линий, затем измените размер формы, чтобы начались странности. Линии не появляются в ожидаемых местах.

Буду признателен за любые предложения и пояснения! Заранее спасибо.

Основная форма (LineDrawFormUnit.pas):

unit LineDrawFormUnit;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects;

type
  TLineDrawForm = class(TForm)
    Image1: TImageControl;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    lX: TLabel;
    lY: TLabel;
    { These event handlers are set in the IDE's object inspector }
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);

    { This event handler is set/unset with the MouseDown and MouseUp events to capture mouse moves when drawing }
    procedure ImageControl1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure FormCreate(Sender: TObject);

  private
    FSaveBitmap: TBitmap;
    p1, p2: TPointF;    { Start and end points of lines to draw }
  end;

var
  LineDrawForm: TLineDrawForm;

implementation
{$R *.fmx}

procedure TLineDrawForm.FormCreate(Sender: TObject);
begin
  Image1.Bitmap.Create(Round(Image1.Width), Round(Image1.Height));
end;

procedure TLineDrawForm.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
  Y: Single);
begin
  p1.X := X;
  p1.Y := Y;
  lX.Text := FloatToStr(X);
  lY.Text := FloatToStr(Y);
  FSaveBitmap := TBitmap.Create(Image1.Bitmap.Width, Image1.Bitmap.Height);
  FSaveBitmap.Assign(Image1.Bitmap); { Save the current canvas as bitmap }
  Image1.OnMouseMove := ImageControl1MouseMove; { Activate the MouseMove event handler}
end;

procedure TLineDrawForm.ImageControl1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  p2.X := X;
  p2.Y := Y;
  lX.Text := FloatToStr(X);
  lY.Text := FloatToStr(Y);
  Image1.Bitmap.Assign(FSaveBitmap);
  Image1.Bitmap.Canvas.BeginScene;
  try
    Image1.Bitmap.Canvas.Stroke.Color := claGray;
    Image1.Bitmap.Canvas.StrokeThickness := 0.5;
    Image1.Bitmap.Canvas.DrawLine(p1, p2, 1.0);
  finally
    Image1.Bitmap.Canvas.EndScene;
    Image1.Bitmap.BitmapChanged;
  end;
end;

procedure TLineDrawForm.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
  Y: Single);
begin
  p2.X := X;
  p2.Y := Y;
  lX.Text := FloatToStr(X);
  lY.Text := FloatToStr(Y);
  Image1.Bitmap.Canvas.BeginScene;
  try
    Image1.Bitmap.Canvas.Stroke.Color := claBlack;
    Image1.Bitmap.Canvas.StrokeThickness := 2;
    Image1.Bitmap.Canvas.DrawLine(P1, P2, 1.0);
  finally
    Image1.Bitmap.Canvas.EndScene;
    Image1.Bitmap.BitmapChanged;
  end;

  (Sender as TControl).OnMouseMove := nil;
  if FSaveBitmap <> nil then
    FSaveBitmap.Free;

end;

end.

Файл FMX (LineDrawFormUnit.fmx):

object LineDrawForm: TLineDrawForm
  Left = 0
  Top = 0
  Caption = 'Polygon Form'
  ClientHeight = 513
  ClientWidth = 650
  Visible = False
  OnCreate = FormCreate
  StyleLookup = 'backgroundstyle'
  object Image1: TImageControl
    Align = alScale
    Position.Point = '(18,21)'
    Width = 620.000000000000000000
    Height = 452.000000000000000000
    OnMouseDown = Image1MouseDown
    OnMouseUp = Image1MouseUp
    TabOrder = 0
  end
  object Panel1: TPanel
    Align = alBottom
    Position.Point = '(0,480)'
    Width = 650.000000000000000000
    Height = 33.000000000000000000
    TabOrder = 2
    object Label1: TLabel
      Position.Point = '(16,8)'
      Width = 25.000000000000000000
      Height = 15.000000000000000000
      TabOrder = 1
      Text = 'X:'
    end
    object Label2: TLabel
      Position.Point = '(384,8)'
      Width = 25.000000000000000000
      Height = 15.000000000000000000
      TabOrder = 2
      Text = 'Y:'
    end
    object lX: TLabel
      Position.Point = '(32,8)'
      Width = 313.000000000000000000
      Height = 15.000000000000000000
      TabOrder = 3
      Text = '0'
    end
    object lY: TLabel
      Position.Point = '(424,8)'
      Width = 209.000000000000000000
      Height = 15.000000000000000000
      TabOrder = 4
      Text = '0'
    end
  end
end

person user998198    schedule 26.08.2012    source источник
comment
P.S. Первоначально я забыл избавиться от неиспользуемого PolygonUnit в предложении Uses интерфейса, теперь исправлено.   -  person user998198    schedule 27.08.2012
comment
Image1.Bitmap не масштабируется, когда Image1 увеличивается вместе с формой. Однако он уменьшается в размере, когда Image1 сжимается вместе с формой, и снова увеличивается до исходного размера, когда форма расширяется. Установка обработчика OnResize для формы позволяет настроить размер Image1.Bitmap в соответствии с его контейнером, но он очищается. Растровое изображение сжимается и снова увеличивается до исходного размера, когда размер формы уменьшается и расширяется. Должен быть способ без потерь изменить размер TBitmap без очистки его содержимого. В противном случае пришлось бы прибегать к использованию функции TBitmap.ScanLine.   -  person user998198    schedule 27.08.2012
comment
P.S. Увеличение растрового изображения сделает его зернистым, поэтому разумно, что растровое изображение сжимается и возвращается к исходному размеру, а не к большему. Все еще нужно выяснить, как это внутренне выполняется фреймворком.   -  person user998198    schedule 27.08.2012
comment
Я не думаю, что это имеет какое-то отношение к свойству Align (кстати, оно также воспроизводимо со свойством alClient). Проблема вызвана тем, что размер элемента управления изображением изменяется, а его растровое изображение — нет, поэтому оно масштабируется. При создании FSaveBitmap вы должны создать его с размером элемента управления изображением, а не с его внутренним растровым изображением (в противном случае вы не отражаете измененный размер элемента управления и вызываете масштабирование).   -  person Ondrej Kelle    schedule 27.08.2012
comment
Спасибо TOndrej. Я попробую ваши предложения.   -  person user998198    schedule 28.08.2012


Ответы (1)


Свойство align влияет на потомков TShapes, TControl и т. д., но не на содержимое Bitmap.

Кажется, вы буферизуете некоторые пользовательские рисунки на TBitmap, а затем назначаете их элементу управления. FMX не сможет повторно выровнять пользовательские рисунки, потому что они не инкапсулированы в выравниваемый класс (это всего лишь несколько пикселей).

Вы можете перерисовать «буфер» при изменении размера элемента управления и переназначить его «хозяину», чтобы адаптировать рисунки к вашим пожеланиям. Или, может быть, не освобождать «буферизованные рисунки» и преобразовывать/переназначать их при изменении размера формы.

Но лучший способ сделать это, который будет соответствовать тому, как предполагается использовать FMX HD, - это использовать систему форм, выравнивание будет автоматическим. Поэтому вместо рисования линии создайте TLine внутри родительского объекта и наложите выравнивание этой новой линии в соответствии с родительским элементом управления.

person az01    schedule 27.08.2012
comment
Спасибо за ответ. Сейчас я использую аналогичный подход, используя объект TPath. Это сильно облегчило жизнь. Кроме того, события MouseDown уже очень эффективно проверяют наличие точки в многоугольнике. Самый простой способ создать данные для объекта пути, который я нашел, — это нарисовать фигуры в Illustrator/InkScape, сохранить файл в формате SVG и извлечь соответствующую информацию о пути из файла с помощью текстового редактора. Я бы очень хотел, чтобы у FireMonkey была лучшая документация. - person user998198; 28.08.2012