Delphi Graphics32 transparent layer draw line

Question

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

Tom Brunberg · Accepted Answer · 2015-02-16T17:10:17.137

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.

Works ok. However, the lines are not ok where they are drawn. If you enlarge your form (and ImgView) and you go beyond 800x600 with it, you will see that the lines get clipped in the right side, because the drawing layer is located at (0,0). If I move it's location to... say (200,200) you will notice that, the location of the lines go crazy. Can you reproduce this and give me a solution? (just resize your form on runtime(not on design time) I've been trying to solve this positioning thing since yesterday evening (havent slept yet) — user1137313, Feb 16 '15 at 14:05
@user I noticed that sometimes some spurious lines appear, if the mouse down happens outside of the layer, but mouse up occurs inside. This can be avoided by adding `if FDrawingLine then` condition to the code in `LayerMouseUp`. I edited my answer. — Tom Brunberg, Feb 16 '15 at 17:11
@user It is expected that lines get clipped or misplaced if the coordinate system of any participating entity (or a union they form) is exceeded. If you change any of those, you must do proper conversions when copying from one system to another. Also, if you allow the user to resize the ImgView, you may also need to resize the buffer bitmap and layer, but note that TBitmaps loose their content when resized. To manage the coordinate systems, you need to consider ImgView scrollbars, BitmapLayer location offsets, buffer bitmap coordinates and mouse coordinates. That is however off topic. — Tom Brunberg, Feb 16 '15 at 17:14
Yes you are right. However, my exact case is: onCreate, my form goes to wsMaximize. The ImgView is anchored to all sides. Also, I select the size of the final image (like A3, A4, A5 and so on), so the size of the ImgView Bitmap is not a constant. Anyway, my destination Bitmap is centered inside the ImgView, so it is not starting in the left/top corner. So when I want to draw something... I want it to appear on that bitmap, but since the whole ImgView Bitmap is centered (away from the left:0 and the top:0) my question is, how can I make the lines appear also there? — user1137313, Feb 16 '15 at 19:00
For nothing more than keeping the BL.Location centered and adjusting drawing coordinates accordingly: 2 integers, OffsX and OffY. In ImgView OnResize calculate `OffsX := (ImgView.ClientWidth - imwidth) div 2;` and similar for OffY. In same procedure relocate BL.Location to OffsX, OffsY, imwidth+OffsX, imheight+OffsY. In the three Mouse procs adjust the X and Y **arguments** only to become X-OffsX and Y-OffsY. This assumes imwidth and imheight set to fixed value at start up. Otherwise recalculate and resize also bm32. — Tom Brunberg, Feb 16 '15 at 20:06
Here, I placed it in another question: http://stackoverflow.com/questions/28550072/delphi-graphics32-relative-mouse-position-to-the-layer — user1137313, Feb 16 '15 at 20:49
I placed there a test unit based on your recomendations... It is still not going ok... — user1137313, Feb 16 '15 at 21:03
I think we can close this question regarding drawing lines on a transparent layer, don't we? — Tom Brunberg, Feb 16 '15 at 22:36

Delphi Graphics32 transparent layer draw line

1 Answers1

Linked