我有一个ImgView32,它固定在所有表格边距上。表格最大化。
ImgView的位图不是固定的(它可以是不同的大小)
我正在尝试使用此问题中的代码在透明图层上绘制一条线: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并将其锚定到所有边距,然后在运行时,最大化表单并尝试绘制线条......
修改
在上面的绿色图片中,有一个矩形,更像是中间的一个正方形(不是很明显),但如果仔细观察就可以看到它。
由于我的问题可能会被误解,请查看以下图片
我需要能够在ImgView中间的白色矩形(Bitmap)中绘制。我不知道如何更好地解释。
对于我来说,使矩形/位图完全适合ImgView不是一个解决方案,因为这不是我的项目的重点。
看一下Paint.net,想象一下我的项目也是如此(除了它并不复杂)。但原理是一样的:当你开始一个新项目时,你决定你的文档/图像的大小,然后你添加不同的图像作为图层,你缩放和旋转它们,现在我想让用户在内部绘制线条特殊图层(绘图图层) 但一切都发生在该文档大小的边界内。例如在上面的图像中,文档的大小为A5(100dpi),缩放为83%。
所以我的问题是我不允许用户在白色矩形(屏幕中间)之外画线。所以他们的线条可以从那些边界开始并在那里结束。
我知道我的测试单元不是很干净。我粘贴了主项目中使用的一些函数,并快速删除了与此示例无关的部分函数。 AddTransparentPng过程只允许测试向ImgView添加透明图像,因此我可以测试绘图层是否覆盖另一个可能的latyer。
(Scaled属性属于'B'语句下的图层(B)。我删除了'ImgView.Bitmap ... Location'语句,所以它不会打扰你了:))
无论如何,请不要注意不影响线条绘制的代码。该代码是需要注意的。
修改 如果我将图层的缩放设置为true(Scaled:= true),那么它会混淆一切,如下图所示:
我仍然需要使用偏移但有点不同
谢谢
答案 0 :(得分:4)
错误一
在LayerMouseMove()中,从BL.Bitmap.Canvas.MoveTo()中的FStartPoint中减去OffsX和OffsY。 FStartPoint已在LayerMouseDown()中进行了调整。我告诉你“在三个鼠标触发器中调整X和Y参数只能成为X-OffsX和Y-OffsY。”注意arguments only
这里更正了LayerMouseMove():
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.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end;
end;
错误二
我还告诉你将if FDrawingLine then ...
条件添加到LayerMouseUp()以避免在鼠标向下发生在图层外部时发生虚假行,但鼠标向上发生。更正后的LayerMouseUp():
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end;
end;
错误三
发布的代码无法显示第一张图片。该图像看起来像您在ImgViewResize()中已经过了评论行BL.Location := ...
。可能是因为Error one
而这样做了。无论如何,ImgViewResize如下,以及上面的其他修正,我得到的结果如下图所示。
procedure TForm5.ImgViewResize(Sender: TObject);
begin
// centering the drawing area
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
变量imwidth
和imheight
定义绘图区域的大小。如果您更改这些内容,则需要重新计算OffsX
和OffsY
,并且还需要调整后备缓冲区bm32
的大小。
角落中的线条表示窗口中间的绘图区域(由宽度和高度定义)的范围。当窗口最大化时,它也保持不变。
答案 1 :(得分:0)
好的,我解决了。这是最终(相关)代码:
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.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.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, FStartPoint.Y);
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.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;
使用此代码,一切都按预期工作。线条的绘制只能在边界内进行
谢谢