Graphics32 简单绘图图层缩放

Question

出于学习目的，我正在尝试构建一个应用程序，它的行为方式与 Graphics32 示例应用程序基本相同 "ImgView_Layers" 并且我正在做一些细微的更改。现在我陷入了简单绘图层的问题。我以与示例应用程序相同的方式创建了一个。在 PaintSimpleDrawingHandler 中，我试图绘制一些其他形状，而不是默认的螺旋形。问题来了。 "default" 螺旋线随图像缩放 - 缩小时，螺旋线也会缩小，反之亦然。当图层大小改变时，螺旋的大小也会改变。如果我画其他东西，缩放或改变图层大小时它保持不变。

这是菱形、正方形和螺旋形的示例。螺旋线"works"好，其他的不行。

procedure TfrmMain.PaintSimpleDrawingHandler(Sender: TObject; Buffer: TBitmap32);
var
  Cx, Cy: Single;
  W2, H2: Single;
  I: Integer;
  yy, xx, yyy, xxx: integer;
const
  CScale = 1 / 200;
begin
  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender).GetAdjustedLocation do
    begin
      W2 := (Right - Left) * 0.5;
      H2 := (Bottom - Top) * 0.5;
      Cx:= Left + W2;
      Cy:= Top + H2;
      W2 := W2 * CScale;
      H2 := H2 * CScale;
      Buffer.PenColor := clGreen32;

    // square
      xx := Round(Cx + W2 - 10);
      yy := Round(Cy + H2 - 10);
      xxx := Round(Cx + W2 + 10);
      yyy := Round(Cy + H2 + 10);

      Buffer.FrameRectS(xx, yy, xxx, yyy, clRoyalBlue32);
    ///square

    // diamond
      Buffer.MoveToF(Cx - 10, Cy);
      Buffer.LineToFS(Cx + W2, Cy + H2 - 10);
      Buffer.MoveToF(Cx, Cy - 10);
      Buffer.LineToFS(Cx + W2 + 10, Cy + H2);
      Buffer.MoveToF(Cx + 10, Cy);
      Buffer.LineToFS(Cx + W2, Cy + H2 + 10);
      Buffer.MoveToF(Cx, Cy + 10);
      Buffer.LineToFS(Cx + W2 - 10, Cy + H2);
    ///diamond

    // spiral
      Buffer.MoveToF(Cx, Cy);
      for I := 0 to 240 do
        Buffer.LineToFS(
          Cx + W2 * I * Cos(I * 0.125),
          Cy + H2 * I * Sin(I * 0.125));

    end;

end;

我尝试了几种不同的形状，不同的绘制方法，但仍然得到相同的结果。谁能解释一下螺旋线和其他螺旋线的区别，并帮助我绘制自定义形状，这些形状将以与螺旋线相同的方式缩放和缩放？

我用的是Delphi XE7。这是完整的来源：

    unit Test;

interface
{$I GR32.inc}

uses
  Windows,
  Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, GR32_Image, Vcl.ExtCtrls,
  AdvToolBar, AdvShapeButton, AdvAppStyler, AdvToolBarStylers, AdvPreviewMenu,
  AdvPreviewMenuStylers, AdvPanel, DataModule, AdvGlassButton, Vcl.StdCtrls,
  AeroButtons, AdvGlowButton, GR32, GR32_Layers, GR32_RangeBars,
  GR32_Filters, GR32_Transforms, GR32_Resamplers, AdvTrackBar;

type
  TfrmMain = class(TForm)
    pnlMain: TPanel;
    AdvToolBarPager1: TAdvToolBarPager;
    AdvToolBarPager11: TAdvPage;
    AdvToolBarPager12: TAdvPage;
    AdvToolBarPager13: TAdvPage;
    pnlMainRight: TAdvPanel;
    pnlMainLeft: TAdvPanel;
    pnlMainCenter: TAdvPanel;
    AdvShapeButton1: TAdvShapeButton;
    pnlMainBottom: TAdvPanel;
    iwMain: TImgView32;
    btManImgPick: TAdvGlowButton;
    tbZoom: TAdvTrackBar;
    btZoom: TAdvGlowButton;
    btAddMark: TAdvGlowButton;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btManImgPickClick(Sender: TObject);
    procedure OpenImage(const FileName: string);
    procedure iwMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure iwMainMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure iwMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure iwMainResize(Sender: TObject);
    procedure tbZoomChange(Sender: TObject);
    procedure btZoomClick(Sender: TObject);
    procedure iwMainMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure iwMainMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure btAddMarkClick(Sender: TObject);
  private
    FSelection: TPositionedLayer;
    FDragging: Boolean;
    FFrom: TPoint;
    procedure SetSelection(Value: TPositionedLayer);
  public
    property Selection: TPositionedLayer read FSelection write SetSelection;
  protected
    RBLayer: TRubberbandLayer;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure RBResizing(Sender: TObject; const OldLocation: TFloatRect;
      var NewLocation: TFloatRect; DragState: TRBDragState; Shift: TShiftState);
    procedure LayerDblClick(Sender: TObject);
    procedure iwAutofit;
    function CreatePositionedLayer: TPositionedLayer;
    procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintSimpleDrawingHandler(Sender: TObject; Buffer: TBitmap32);
    procedure drawMark();
  end;

var
  frmTest: TfrmMain;
  DataModule: TDataModule;
implementation

{$R *.dfm}

uses
  JPEG,
  NewImageUnit, RGBALoaderUnit, Math, Printers, GR32_LowLevel, GR32_Paths,
  GR32_VectorUtils, GR32_Backends, GR32_Text_VCL, GR32_ColorGradients,
  GR32_Polygons, GR32_Geometry;

procedure TfrmMain.OpenImage(const FileName: string);
begin
  with iwMain do
  try
    Selection := nil;
    RBLayer := nil;
    Layers.Clear;
    Scale := 1;
    Bitmap.LoadFromFile(FileName);
  finally
    //pnlImage.Visible := not Bitmap.Empty;
  end;
end;

procedure TfrmMain.PaintSimpleDrawingHandler(Sender: TObject;
  Buffer: TBitmap32);
var
  Cx, Cy: Single;
  W2, H2: Single;
  I: Integer;
  yy, xx, yyy, xxx: integer;
const
  CScale = 1 / 200;
begin
  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender).GetAdjustedLocation do
    begin
      W2 := (Right - Left) * 0.5;
      H2 := (Bottom - Top) * 0.5;
      Cx:= Left + W2;
      Cy:= Top + H2;
      W2 := W2 * CScale;
      H2 := H2 * CScale;
      Buffer.PenColor := clGreen32;

      xx := Round(Cx + W2 - 10);
      yy := Round(Cy + H2 - 10);
      xxx := Round(Cx + W2 + 10);
      yyy := Round(Cy + H2 + 10);

      Buffer.FrameRectS(xx, yy, xxx, yyy, clRoyalBlue32);

      Buffer.MoveToF(Cx - 10, Cy);
      Buffer.LineToFS(Cx + W2, Cy + H2 - 10);
      Buffer.MoveToF(Cx, Cy - 10);
      Buffer.LineToFS(Cx + W2 + 10, Cy + H2);
      Buffer.MoveToF(Cx + 10, Cy);
      Buffer.LineToFS(Cx + W2, Cy + H2 + 10);
      Buffer.MoveToF(Cx, Cy + 10);
      Buffer.LineToFS(Cx + W2 - 10, Cy + H2);


      Buffer.MoveToF(Cx, Cy);
      for I := 0 to 240 do
        Buffer.LineToFS(
          Cx + W2 * I * Cos(I * 0.125),
          Cy + H2 * I * Sin(I * 0.125));

    end;
end;

procedure TfrmMain.RBResizing(Sender: TObject;
  const OldLocation: TFloatRect; var NewLocation: TFloatRect;
  DragState: TRBDragState; Shift: TShiftState);
var
  w, h, cx, cy: Single;
  nw, nh: Single;

begin
  if DragState = dsMove then Exit; // we are interested only in scale operations
  if Shift = [] then Exit; // special processing is not required

  if ssCtrl in Shift then
  begin
    { make changes symmetrical }

    with OldLocation do
    begin
      cx := (Left + Right) / 2;
      cy := (Top + Bottom) / 2;
      w := Right - Left;
      h := Bottom - Top;
    end;

    with NewLocation do
    begin
      nw := w / 2;
      nh := h / 2;
      case DragState of
        dsSizeL: nw := cx - Left;
        dsSizeT: nh := cy - Top;
        dsSizeR: nw := Right - cx;
        dsSizeB: nh := Bottom - cy;
        dsSizeTL: begin nw := cx - Left; nh := cy - Top; end;
        dsSizeTR: begin nw := Right - cx; nh := cy - Top; end;
        dsSizeBL: begin nw := cx - Left; nh := Bottom - cy; end;
        dsSizeBR: begin nw := Right - cx; nh := Bottom - cy; end;
      end;
      if nw < 2 then nw := 2;
      if nh < 2 then nh := 2;

      Left := cx - nw;
      Right := cx + nw;
      Top := cy - nh;
      Bottom := cy + nh;
    end;
  end;
end;

procedure TfrmMain.SetSelection(Value: TPositionedLayer);
begin
  if Value <> FSelection then
  begin
    if RBLayer <> nil then
    begin
      RBLayer.ChildLayer := nil;
      RBLayer.LayerOptions := LOB_NO_UPDATE;
      //pnlBitmapLayer.Visible := False;
      //pnlButtonMockup.Visible := False;
      //pnlMagnification.Visible := False;
      iwMain.Invalidate;
    end;

    FSelection := Value;

    if Value <> nil then
    begin
      if RBLayer = nil then
      begin
        RBLayer := TRubberBandLayer.Create(iwMain.Layers);
        RBLayer.MinHeight := 1;
        RBLayer.MinWidth := 1;
      end
      else
        RBLayer.BringToFront;
      RBLayer.ChildLayer := Value;
      RBLayer.LayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS or LOB_NO_UPDATE;
      RBLayer.OnResizing := RBResizing;
      RBLayer.OnDblClick := LayerDblClick;

      if Value is TBitmapLayer then
        with TBitmapLayer(Value) do
        begin
          //pnlBitmapLayer.Visible := True;
          //GbrLayerOpacity.Position := Bitmap.MasterAlpha;
          //CbxLayerInterpolate.Checked := Bitmap.Resampler.ClassType = TDraftResampler;
        end
      else if Value.Tag = 2 then
      begin
        // tag = 2 for button mockup
        //pnlButtonMockup.Visible := True;
      end
      else if Value.Tag = 3 then
      begin
        // tag = 3 for magnifiers
        //pnlMagnification.Visible := True;
      end;
    end;
  end;
end;

procedure TfrmMain.tbZoomChange(Sender: TObject);
begin
  iwMain.Scale:= tbZoom.Position / 10;
  btZoom.Caption:= FloatToStr(tbZoom.Position / 10 * 100) + '%';
end;

procedure TfrmMain.btAddMarkClick(Sender: TObject);
begin
  drawMark();
end;

procedure TfrmMain.btManImgPickClick(Sender: TObject);
var jpg : TJPEGImage;
    //bcImage : TBacmedImage;
    //Center : Coordinant;
begin
  with DataModule1.OpenPictureDialog do
    if Execute then
    begin
      jpg:=TJPEGImage.Create;
      jpg.LoadFromFile(FileName);
      //Center.x:=round(jpg.Width/2);
      //Center.y:=round(jpg.Height/2);
      //bcImage:=TBacmedImage.Create(jpg,100,'AAA',1,Center,jpg.Width,23.83);
      OpenImage(FileName);
    end;
    iwAutofit();
end;

procedure TfrmMain.btZoomClick(Sender: TObject);
begin
  iwAutofit();
end;

function TfrmMain.CreatePositionedLayer: TPositionedLayer;
var
  P: TPoint;
begin
  // get coordinates of the center of viewport
  with iwMain.GetViewportRect do
    P := iwMain.ControlToBitmap(GR32.Point((Right + Left) div 2, (Top + Bottom) div 2));

  Result := TPositionedLayer.Create(iwMain.Layers);
  Result.Location := FloatRect(P.X - 32, P.Y - 32, P.X + 32, P.Y + 32);
  Result.Scaled := True;
  Result.MouseEvents := True;
  Result.OnMouseDown := LayerMouseDown;
  Result.OnDblClick := LayerDblClick;
end;

procedure TfrmMain.drawMark;
var
  L: TPositionedLayer;
begin
  L := CreatePositionedLayer;
  L.OnPaint := PaintSimpleDrawingHandler;
  L.Tag := 1;
  Selection := L;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  DataModule:= TDataModule.Create(self);
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
  //pnlMainRight.Width:= round(frmTest.Width / 5);
end;

procedure TfrmMain.iwAutofit;
begin
  if iwMain.Bitmap.Height > 0 then //jednoducha cesta jak checknout neprirazeny obrazek. Pokud je neprirazeny, nezoomovat.
  begin
    tbZoom.Position:= Round(iwMain.Height / iwMain.Bitmap.Height * 10);
    btZoom.Caption:= IntToStr(Round(iwMain.Height / iwMain.Bitmap.Height * 100)) + '%';
    iwMain.Scale:= iwMain.Height / iwMain.Bitmap.Height;
  end;
end;

procedure TfrmMain.iwMainMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  if Button = mbMiddle then
  begin
    FDragging := True;
    iwMain.Cursor:= crDrag;
    FFrom := Point(X, Y);
  end;
end;

procedure TfrmMain.iwMainMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer; Layer: TCustomLayer);
begin
  if FDragging then
  begin
    iwMain.Scroll(FFrom.X - X, FFrom.Y - Y);
    FFrom.X:= X;
    FFrom.Y:= Y;
  end;

end;

procedure TfrmMain.iwMainMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  if Button = mbMiddle then
  begin
    FDragging := False;
    iwMain.Cursor:= crDefault;
    iwMain.SetFocus;
  end;
end;

procedure TfrmMain.iwMainMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  tbZoom.Position:= tbZoom.Position - 1;
end;

procedure TfrmMain.iwMainMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  tbZoom.Position:= tbZoom.Position + 1;
end;

procedure TfrmMain.iwMainResize(Sender: TObject);
begin
  iwAutofit();
end;

procedure TfrmMain.LayerDblClick(Sender: TObject);
begin
  if Sender is TRubberbandLayer then
    TRubberbandLayer(Sender).Quantize;
end;

procedure TfrmMain.LayerMouseDown(Sender: TObject;
  Buttons: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Sender <> nil then Selection := TPositionedLayer(Sender);
end;

procedure TfrmMain.WMNCHitTest(var Message: TWMNCHitTest);
const
  EDGEDETECT = 7; // adjust
var
  deltaRect: TRect;
begin
  inherited;
  if BorderStyle = TFormBorderStyle(0) then
    with Message, deltaRect do
    begin
      Left := XPos - BoundsRect.Left;
      Right := BoundsRect.Right - XPos;
      Top := YPos - BoundsRect.Top;
      Bottom := BoundsRect.Bottom - YPos;
      if (Top < EDGEDETECT) and (Left < EDGEDETECT) then
        Result := HTTOPLEFT
      else if (Top < EDGEDETECT) and (Right < EDGEDETECT) then
        Result := HTTOPRIGHT
      else if (Bottom < EDGEDETECT) and (Left < EDGEDETECT) then
        Result := HTBOTTOMLEFT
      else if (Bottom < EDGEDETECT) and (Right < EDGEDETECT) then
        Result := HTBOTTOMRIGHT
      else if (Top < EDGEDETECT) then
        Result := HTTOP
      else if (Left < EDGEDETECT) then
        Result := HTLEFT
      else if (Bottom < EDGEDETECT) then
        Result := HTBOTTOM
      else if (Right < EDGEDETECT) then
        Result := HTRIGHT
    end;
end;

end.

Answer 1

If I draw anything else, it remains unchanged when zooming, or changing the size of the layer.

那是因为您不会通过缩放或调整大小来更改对象的大小：

  // square
  xx := Round(Cx + W2 - 10);
  yy := Round(Cy + H2 - 10);
  xxx := Round(Cx + W2 + 10);
  yyy := Round(Cy + H2 + 10);

  Buffer.FrameRectS(xx, yy, xxx, yyy, clRoyalBlue32);

矩形的大小由常量 -10 和 +10 定义（Cx+W2 和 Cy+H2 定义中心点）。例如，试试这个：

  xx  := Round(Cx + W2 *(- 2));
  yy  := Round(Cy + H2 *(- 2));
  xxx := Round(Cx + W2 *(+ 2));
  yyy := Round(Cy + H2 *(+ 2));

Graphics32 简单绘图图层缩放

Graphics32 Simple drawing layer scaling

delphi

graphics32