Delphi Graphics32 transparent layer draw line

问题

I am trying to add a layer to an ImgView32, and on that layer I want to draw a line. But, I want that layer to be transparent, so it wont cover all the layers added previously. So I want to obtain:

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

This is a following to question: Delphi Graphics32 how to draw a line with the mouse on a layer You will find the code that I use for drawing the line and declaring the BitmapLayer following the link. I do not want to add it here so the question will remain small.

Btw, I already tried to declare this for the drawing layer:

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

also this

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

(BL -> The TBitmapLayer) No change. When I create the BitmapLayer, it sits ontop of the previous layers just like a white paper, hiding them. The question is: can this be done (making the layer transparent)? Then how?

Thank you

回答1:

Here's a sample code, based on previous test. Maybe better post whole unit this time, including also the .dfm. The Memo and Button are just part of my usual test setup, not needed to demonstrate GR32.

First the .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

And then the .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.

As you see from the .dfm, I have set the background of ImgView to lime color. I also drew a rectangle and some text to show the transparency.

In SwapBuffers I tried TransparentBlt and seems to work. Outcommented is also direct assigning of bm32 to the layer bitmap, which also works, but may not always be what you want.

来源：https://stackoverflow.com/questions/28534892/delphi-graphics32-transparent-layer-draw-line

标签

Delphi

delphi-xe

graphics32