Search code examples
delphidelphi-xegraphics32

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


Solution

  • 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.