Delphi Graphics32 прозрачный слой рисования линии

Question

Я пытаюсь добавить слой в ImgView32, и на этом слое я хочу нарисовать линию. Но я хочу, чтобы этот слой был прозрачным, чтобы он не покрывал все слои, добавленные ранее. Поэтому я хочу получить:

   layer 1 -> image
   layer 2 -> another image
   layer 3 -> draw a line
   layer 4 -> another image

Это следующий вопрос: Delphi Graphics32 Как нарисовать линию с помощью мыши на слое Вы найдете код, который я использую для рисования линии и объявления 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 для растрового изображения слоя, что также работает, но не всегда может быть тем, что вы хотите.