Delphi Graphics32 прозрачный слой draw line

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, перейдя по ссылке. Я не хочу добавлять его здесь, чтобы вопрос оставался небольшим.

Btw, я уже пытался объявить это для рисования слоя:

Bitmap.DrawMode := dmBlend; 
BL.Bitmap.CombineMode:= cmMerge; 

также это

Bitmap.DrawMode := dmTransparent; 
BL.Bitmap.CombineMode:= cmMerge; 

(BL -> The TBitmapLayer) Без изменений. Когда я создаю BitmapLayer, он сидит поверх предыдущих слоев, как белая бумага, скрывая их. Вопрос в следующем: может ли это быть сделано (сделать слой прозрачным)? Тогда как?

Спасибо

Answer 1

Вот пример кода, основанный на предыдущем тесте. Возможно, на этот раз лучше разместить целую единицу, в том числе и .dfm. Memo и Button являются частью моей обычной тестовой настройки, не требующей демонстрации 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 для растрового изображения слоя, который также работает, но может не всегда быть тем, что вы хотите.