For a learning purpose, I am trying to build an application, that behaves basically the same way, as a Graphics32 example application "ImgView_Layers" and than I am making slight changes. Now I am stuck on a problem with simple drawing layers. I create one the same way, as in the sample app. Than in the PaintSimpleDrawingHandler, I am trying to draw some other shapes, than the default spiral. And here comes the problem. The "default" spiral, is being scaled with the image - when zoomed out, the spiral is being zoomed out and vice versa. When the layer size is changed, the size of the spiral is changed as well. If I draw anything else, it remains unchanged when zooming, or changing the size of the layer.
Here is an example of a diamond, square and a spiral. The spiral "works" fine, the rest does not.
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;
I tried a few different shapes, different ways to draw them, but still get the same result. Can someone please try to explain the difference between the spiral and the rest, and help me to draw custom shapes, that will be zoomed and scaled the same way as the spiral?
I use Delphi XE7. Here is the complete source:
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.
If I draw anything else, it remains unchanged when zooming, or changing the size of the layer.
And that is because you don't change the size of your objects with the zooming or resizing:
// 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);
The size of the rectangle is defined by the constants -10 and +10 (Cx+W2 and Cy+H2 defines the center point). Try, for example, this instead:
xx := Round(Cx + W2 *(- 2));
yy := Round(Cy + H2 *(- 2));
xxx := Round(Cx + W2 *(+ 2));
yyy := Round(Cy + H2 *(+ 2));