У меня есть ImgView32, привязанный ко всем полям формы. Форма максимизируется.Delphi Graphics32 относительная позиция мыши (для слоя)
Растровое из ImgView не фиксируется (это может быть разных размеров)
Я пытаюсь нарисовать линию на прозрачном слое, используя þér код из этого вопроса: Drawing lines on layer
Теперь проблема что, используя этот точный код, я могу рисовать только в верхнем левом углу, как на этом изображении: 
Как вы можете видеть, линии можно рисовать только в левом верхнем углу. Если я попытаюсь добавить какое-то значение в начальную и конечную точки, все это сойдет с ума. Поэтому я должен найти способ перевести точки таким образом, чтобы пользователь мог рисовать только внутри центрального прямоугольника (видимого на картинке)
У меня нет идей.
Пожалуйста, помогите
Здесь весь блок:
unit MainU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,GR32, GR32_Image, GR32_Layers, GR32_Backends, GR32_PNG, StdCtrls,
ExtCtrls;
type
TForm5 = class(TForm)
ImgView: TImgView32;
Button1: TButton;
Memo: TMemo;
Edit3: TEdit;
Button2: TButton;
RadioGroup1: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
StageNum: Cardinal);
procedure ImgViewResize(Sender: TObject);
private
{ Private declarations }
FStartPoint, FEndPoint: TPoint;
FDrawingLine: boolean;
bm32: TBitmap32;
BL : TBitmapLayer;
FSelection: TPositionedLayer;
public
{ Public declarations }
procedure AddLineToLayer;
procedure AddCircleToLayer;
procedure SwapBuffers32;
procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure LayerMouseUp(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure LayerMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
procedure LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
procedure SetSelection(Value: TPositionedLayer);
property Selection: TPositionedLayer read FSelection write SetSelection;
Procedure SelectGraficLayer(idu:string);
procedure AddTransparentPNGlayer;
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
var
imwidth: integer;
imheight: integer;
OffsX, OffsY: Integer;
const
penwidth = 3;
pencolor = clBlue; // Needs to be a VCL color!
procedure TForm5.AddLineToLayer;
begin
bm32.Canvas.Pen.Color := pencolor;
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
procedure TForm5.FormCreate(Sender: TObject);
var
P: TPoint;
W, H: Single;
begin
imwidth := Form5.ImgView.Width;
imheight := Form5.ImgView.Height;
with ImgView.PaintStages[0]^ do
begin
if Stage = PST_CLEAR_BACKGND then Stage := PST_CUSTOM;
end;
bm32 := TBitmap32.Create;
bm32.DrawMode := dmTransparent;
bm32.SetSize(imwidth,imheight);
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.Pen.Color := pencolor;
with ImgView do
begin
Selection := nil;
Layers.Clear;
Scale := 1;
Scaled := True;
Bitmap.DrawMode := dmTransparent;
Bitmap.SetSize(imwidth, imheight);
Bitmap.Canvas.Pen.Width := 4;//penwidth;
Bitmap.Canvas.Pen.Color := clBlue;
Bitmap.Canvas.FrameRect(Rect(20, 20, imwidth-20, imheight-20));
Bitmap.Canvas.TextOut(15, 32, 'ImgView');
end;
AddTransparentPNGLayer;
BL := TBitmapLayer.Create(ImgView.Layers);
try
BL.Bitmap.DrawMode := dmTransparent;
BL.Bitmap.SetSize(imwidth,imheight);
BL.Bitmap.Canvas.Pen.Width := penwidth;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Location := GR32.FloatRect(0, 0, imwidth, imheight);
BL.Scaled := False;
BL.OnMouseDown := LayerMouseDown;
BL.OnMouseUp := LayerMouseUp;
BL.OnMouseMove := LayerMouseMove;
BL.OnPaint := LayerOnPaint;
except
Edit3.Text:=IntToStr(BL.Index);
BL.Free;
raise;
end;
FDrawingLine := false;
SwapBuffers32;
end;
procedure TForm5.FormDestroy(Sender: TObject);
begin
bm32.Free;
BL.Free;
end;
procedure TForm5.ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
StageNum: Cardinal);
const //0..1
Colors: array [Boolean] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
var
R: TRect;
I, J: Integer;
OddY: Integer;
TilesHorz, TilesVert: Integer;
TileX, TileY: Integer;
TileHeight, TileWidth: Integer;
begin
TileHeight := 13;
TileWidth := 13;
TilesHorz := Buffer.Width div TileWidth;
TilesVert := Buffer.Height div TileHeight;
TileY := 0;
for J := 0 to TilesVert do
begin
TileX := 0;
OddY := J and $1;
for I := 0 to TilesHorz do
begin
R.Left := TileX;
R.Top := TileY;
R.Right := TileX + TileWidth;
R.Bottom := TileY + TileHeight;
Buffer.FillRectS(R, Colors[I and $1 = OddY]);
Inc(TileX, TileWidth);
end;
Inc(TileY, TileHeight);
end;
end;
procedure TForm5.ImgViewResize(Sender: TObject);
begin
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
procedure TForm5.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X-OffsX, Y-OffsY);
FDrawingLine := true;
end;
procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X-OffsX, FStartPoint.Y-OffsY);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end;
end;
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end;
procedure TForm5.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
SwapBuffers32;
end;
procedure TForm5.SetSelection(Value: TPositionedLayer);
begin
if Value <> FSelection then
begin
FSelection := Value;
end;
end;
procedure TForm5.SwapBuffers32;
begin
TransparentBlt(
BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;
procedure TForm5.AddTransparentPNGlayer;
var
mypng:TPortableNetworkGraphic32;
B : TBitmapLayer;
P: TPoint;
W, H: Single;
begin
try
mypng := TPortableNetworkGraphic32.Create;
mypng.LoadFromFile('C:\Location\Of\ATransparentPNGFile.png');
B := TBitmapLayer.Create(ImgView.Layers);
with B do
try
mypng.AssignTo(B.Bitmap);
Bitmap.DrawMode := dmBlend;
with ImgView.GetViewportRect do
P := ImgView.ControlToBitmap(GR32.Point((Right + Left) div 2, (Top + Bottom) div 2));
W := Bitmap.Width * 0.5;
H := Bitmap.Height * 0.5;
Location := GR32.FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);
Scaled := True;
OnMouseDown := LayerMouseDown;
except
Free;
raise;
end;
Selection := B;
Edit3.Text:=IntToStr(B.Index);
finally
mypng.Free;
end;
end;
end.
Что я делаю неправильно? Пожалуйста, проверьте устройство выше, чтобы понять, что я имею в виду. Не забудьте добавить ImgView и закрепить его на все поля, а затем во время выполнения, максимизировать форму и попытаться нарисовать линии ...
EDIT
В зеленом изображении выше, есть прямоугольник, больше похоже на квадрат посередине (не очень заметный), но вы можете увидеть его, если внимательно присмотритесь.
Поскольку моя проблема может быть неправильно понят, пожалуйста, обратите внимание на следующее изображение 
мне нужно, чтобы быть в состоянии сделать только в белом прямоугольнике (Bitmap) в середине ImgView. Я не знаю, как лучше объяснить.
Это не решение для меня, чтобы прямоугольник/растровое изображение соответствовало точному ImgView, потому что это не пункт моего проекта.
Взгляните на Paint.net и представьте, что мой проект делает то же самое (кроме того, что это не так сложно). Но принцип тот же: вы определяете размер своего документа/изображения при запуске нового проекта, затем добавляете разные изображения в виде слоев, масштабируете и вращаете их, и теперь я хочу разрешить пользователям рисовать строки внутри специальный слой (слой рисования) Но все происходит внутри границ этого размера документа. Как, например, в приведенном выше изображении, размер документа составляет A5 (100dpi), масштабированный на 83%.
Так что моя проблема в том, что я не могу позволить пользователям рисовать линии за пределами белого прямоугольника (в середине экрана). Поэтому их линии могут начинаться в этих границах и заканчиваться там.
Я знаю, что мой испытательный блок не совсем чист. Я вставил некоторые функции, используемые в основном проекте, и быстро удалил некоторые части из них, которые не имеют отношения к этому примеру. Процедура AddTransparentPng предназначена только для проверки возможности добавления прозрачного изображения в ImgView, чтобы я мог проверить, не накрывает ли слой рисования другой возможный латиратор.
(масштабированное свойство принадлежит к слою (В) он находится под «с» B заявлением. Я снял с «ImgView.Bitmap ... Location» заявление, так что бы не беспокоить вас больше :))
В любом случае, пожалуйста, не обращайте внимания на код, который не влияет на чертеж линий. Этот код требует внимания.
EDIT Если установить слой Чешуйчатого истинный (Чешуйчатый: = истину), то это портит все вверх, как на картинке ниже: 
Я до сих пор использовать коррекции, но немного по-другому
Спасибо
Увеличьте размер TBitmapLayer (используя BL.Location), чтобы охватить весь ImgView и увеличить также размер растрового изображения фона (bm23 в предыдущем вопросе/ответе) соответственно. На изображении выше нет центрального прямоугольника. –
Прежде всего, прекратите использовать выражения 'with'! Вы тратите больше времени на поиск ошибок, чем вы сохраняете при наборе текста. Например. в 'AddtransparentPNGLayer', около середины proc, строка' с ImgView.Bitmap do Location: = GR32.Floatrect (...); ', кто является собственностью, вы думаете, что' Location'is? Это * НЕ * свойство 'ImgView.Bitmap'! Это свойство 'B', на которое вы ссылаетесь в инструкции' with B do ... ', так почему вы писали' с помощью ImgView.Bitmap do'? Другой, кто является собственностью 'Scaled' на следующей строке? Это свойство Form5! Это звучит как harsch, но на самом деле: удалите все инструкции 'with' из кода. –
Далее, на всякий случай, в выражении 'with ImgView.Bitmap do' нет ничего другого, связанного с растровым изображением. –