Graphics32単純な描画レイヤーのスケーリング

Question

学習目的のために、私はGraphics32のサンプルアプリケーション "ImgView_Layers"と基本的に同じように動作するアプリケーションを構築しようとしています。今、私は単純な描画レイヤの問題に悩まされています。サンプルアプリケーションと同じ方法で作成します。 PaintSimpleDrawingHandlerよりも、デフォルトのらせん以外の図形を描画しようとしています。そして、ここで問題が起こります。 「デフォルト」のスパイラルは画像に合わせてスケーリングされています。ズームアウトするとスパイラルがズームアウトされ、逆も同様です。レイヤーサイズが変更されると、スパイラルのサイズも変更されます。私が他のものを描画する場合、ズームやレイヤーのサイズを変更するときは変わりません。

ここでは、ダイヤモンド、正方形、螺旋の例を示します。スパイラルは「うまくいく」、残りはうまくいきません。

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

、それは変わらない：ここでは完全なソースです。

そして、あなたはズームを使用してオブジェクトのサイズを変更したり、リサイズしていないので、それは次のとおりです。

// 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));