我正在尝试向ImgView32添加一个图层，在该图层上我想绘制一条线。但是，我希望该图层是透明的，因此它不会涵盖之前添加的所有图层。 所以我想获得：
layer 1 -> image
layer 2 -> another image
layer 3 -> draw a line
layer 4 -> another image
以下是问题：Delphi Graphics32 how to draw a line with the mouse on a layer 您将找到我用于绘制线条的代码，并在链接后声明BitmapLayer。我不想在这里添加它，所以问题仍然很小。
顺便说一下，我已经尝试为绘图层声明这个：
Bitmap.DrawMode := dmBlend;
BL.Bitmap.CombineMode:= cmMerge;
也是这个
Bitmap.DrawMode := dmTransparent;
BL.Bitmap.CombineMode:= cmMerge;
（BL - ＆gt; TBitmapLayer） 没变。当我创建BitmapLayer时，它就像白纸一样位于前一层的顶部，隐藏它们。 问题是：可以这样做（使图层透明）？怎么样？
谢谢
答案 0 :(得分：1)
以下是基于之前测试的示例代码。也许这次更好地发布整个单元，包括.dfm。备忘录和按钮只是我通常的测试设置的一部分，不需要演示GR32。
首先是.dfm：
object Form5: TForm5
Left = 0
Top = 0
Caption = 'Form6'
ClientHeight = 239
ClientWidth = 581
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
DesignSize = (
581
239)
PixelsPerInch = 96
TextHeight = 13
object ImgView: TImgView32
Left = 8
Top = 8
Width = 320
Height = 220
Bitmap.ResamplerClassName = 'TNearestResampler'
BitmapAlign = baCustom
Color = clLime
ParentColor = False
Scale = 1.000000000000000000
ScaleMode = smScale
ScrollBars.ShowHandleGrip = True
ScrollBars.Style = rbsDefault
ScrollBars.Size = 17
OverSize = 0
TabOrder = 0
end
object Button1: TButton
Left = 380
Top = 8
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
end
object Memo: TMemo
Left = 380
Top = 39
Width = 185
Height = 187
Anchors = [akLeft, akTop, akRight, akBottom]
ScrollBars = ssVertical
TabOrder = 2
WordWrap = False
ExplicitHeight = 218
end
end
然后是.pas：
unit Unit5;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, GR32, GR32_Image, GR32_Layers, GR32_Backends;
type
TForm5 = class(TForm)
ImgView: TImgView32;
Button1: TButton;
Memo: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FStartPoint, FEndPoint: TPoint;
FDrawingLine: boolean;
bm32: TBitmap32;
BL : TBitmapLayer;
FSelection: TPositionedLayer;
public
{ Public declarations }
procedure AddLineToLayer;
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;
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
var
imwidth: integer;
imheight: 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;
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 := penwidth;
Bitmap.Canvas.Pen.Color := clBlue;
Bitmap.Canvas.FrameRect(Rect(20, 20, imwidth-20, imheight-20));
Bitmap.Canvas.TextOut(15, 12, 'ImgView');
end;
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
BL.Free;
raise;
end;
FDrawingLine := false;
SwapBuffers32;
end;
procedure TForm5.FormDestroy(Sender: TObject);
begin
bm32.Free;
BL.Free;
end;
procedure TForm5.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X, Y);
FDrawingLine := true;
// Memo.Lines.Add(Format('Start at x: %3d, y: %3d',[X, Y]))
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, Y);
// Memo.Lines.Add(Format('Draw at x: %3d, y: %3d',[X, Y]))
end;
end;
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
FDrawingLine := false;
FEndPoint := Point(X, Y);
AddLineToLayer;
SwapBuffers32;
// Memo.Lines.Add(Format('End at x: %3d, y: %3d',[X, Y]))
end;
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
// BitBlt(B.Bitmap.Canvas.Handle, 0, 0, B.Bitmap.Width, B.Bitmap.Height, bm32.Canvas.Handle, 0, 0, SRCCOPY);
// B.Bitmap.Draw(0, 0, bm32);
// bm32.DrawTo(B.Bitmap);
// BL.Bitmap := bm32;
TransparentBlt(
BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;
end.
从.dfm中可以看出，我已将ImgView的背景设置为石灰色。我还画了一个矩形和一些文字来显示透明度。
在SwapBuffers中，我尝试过TransparentBlt，似乎可行。 Outcommented也直接将bm32分配给图层位图，这也适用，但可能并不总是你想要的。