Delphi Graphics32透明图层画线

Question

我正在尝试向 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 -> TBitmapLayer) 不用找了。当我创建 BitmapLayer 时，它就像一张白纸一样位于先前图层的顶部，将它们隐藏起来。 问题是：这可以做到（使图层透明）吗？那怎么办？

谢谢

Answer 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 分配给层位图，这也有效，但可能并不总是您想要的。