Delphi Graphics32透明层画线 [英] Delphi Graphics32 transparent layer draw line

查看：538
本文介绍了Delphi Graphics32透明层画线的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在尝试向ImgView32添加图层，而在该图层上，我想绘制一条线。但是，我希望该层是透明的，所以它不会覆盖以前添加的所有图层。
所以我想获得：

 第1层 - > image 
 layer 2  - >另一个图像
第3层 - >画一条线
第4层 - >另一个图像

这是一个以下问题： Delphi Graphics32如何用图层上的鼠标画一条线
您将找到我用于绘制行的代码，并在链接之后声明BitmapLayer。我不想在这里添加，所以问题将保持不变。



Btw，我已经尝试为绘图层声明：

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

这个

 code> Bitmap.DrawMode：= dmTransparent; 
 BL.Bitmap.CombineMode：= cmMerge;

（BL - > TBitmapLayer）
没有变化。当我创建BitmapLayer时，它就像一张白皮书一样坐在上一层的顶部，隐藏着它们。
问题是：可以这样做（使图层透明）吗？那么如何？



谢谢

解决方案

这是一个示例代码，基于以前的测试。也许这次更好的整个单位，包括.dfm。备忘录和按钮只是我通常测试设置的一部分，不需要演示GR32。



首先.dfm：

 对象Form5：TForm5 
 Left = 0 
顶部= 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 
对象ImgView：TImgView32 
左= 8 
顶部= 8 
宽度= 320 
高度= 220 
 Bitmap.ResamplerClassName ='TNearestResampler'
 BitmapAlign = baCustom 
 Color = clLime 
 ParentColor = False 
 Scale = 1.000000000000000000 
 ScaleMode = smScale 
 ScrollBars显示leGrip = True 
 ScrollBars.Style = rbsDefault 
 ScrollBars.Size = 17 
 OverSize = 0 
 TabOrder = 0 
 end 
对象Button1：TButton 
 Left = 380 
顶部= 8 
宽度= 75 
高度= 25 
标题='Button1'
 TabOrder = 1 
 end 
对象备注：TMemo 
左= 380 
顶部= 39 
宽度= 185 
高度= 187 
锚点= [akLeft，akTop，akRight，akBottom] 
 ScrollBars = ssVertical 
 TabOrder = 2 
 WordWrap = False 
 ExplicitHeight = 218 
 end 
 end

然后.pas：

  unit Unit5; 
 
接口
 
使用
 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; 
备注：TMemo; 
 procedure FormCreate（Sender：TObject）; 
 procedure FormDestroy（Sender：TObject）; 
 private 
 {私有声明} 
 FStartPoint，FEndPoint：TPoint; 
 FDrawingLine：boolean; 
 bm32：TBitmap32; 
 BL：TBitmapLayer; 
 FSelection：TPositionedLayer; 
 public 
 {公开声明} 
程序AddLineToLayer; 
程序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）; 
属性选择：TPositionedLayer读取FSelection写SetSelection; 
结束
 
 var 
 Form5：TForm5; 
 
实现
 
 {$ R * .dfm} 
 var 
 imwidth：integer; 
 imheight：integer; 
 const 
 penwidth = 3; 
 pencolor = clBlue; //需要成为VCL颜色！ 
 
 
程序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）; 
结束
 
 procedure TForm5.FormCreate（Sender：TObject）; 
 var 
 P：TPoint; 
 W，H：单; 
 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 
选择：= nil; 
 Layers.Clear; 
比例：= 1; 
缩放：= 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'）; 
结束
 
 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; 
除
 BL.Free; 
加注
结束
 
 FDrawingLine：= false; 
 SwapBuffers32; 
结束
 
 procedure TForm5.FormDestroy（Sender：TObject）; 
 begin 
 bm32.Free; 
 BL.Free; 
结束
 
 procedure TForm5.LayerMouseDown（Sender：TObject; Buttons：TMouseButton; 
 Shift：TShiftState; X，Y：Integer）; 
 begin 
 FStartPoint：= Point（X，Y）; 
 FDrawingLine：= true; 
 // Memo.Lines.Add（Format（'Start from x：％3d，y：％3d'，[X，Y]））
 end; 
 
 procedure TForm5.LayerMouseMove（Sender：TObject; Shift：TShiftState; X，
 Y：Integer）; 
开始
如果FDrawingLine然后
开始
 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; 
结束
 
 procedure TForm5.LayerMouseUp（Sender：TObject; Buttons：TMouseButton; 
 Shift：TShiftState; X，Y：Integer）; 
开始
如果FDrawingLine然后
开始
 FDrawingLine：= false; 
 FEndPoint：=点（X，Y）; 
 AddLineToLayer; 
 SwapBuffers32; 
 // Memo.Lines.Add（Format（'End at x：％3d，y：％3d'，[X，Y]））
 end; 
结束
 
 procedure TForm5.LayerOnPaint（Sender：TObject; Buffer：TBitmap32）; 
 begin 
 SwapBuffers32; 
结束
 
程序TForm5.SetSelection（Value：TPositionedLayer）; 
 begin 
如果Value<> FSelection然后
 begin 
 FSelection：= Value; 
结束
结束
 
程序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。宽度，bm32.Height，clWhite）; 
结束
 
结束。

从.dfm看到，我将ImgView的背景设置为石灰色。我还画了一个矩形和一些文字来显示透明度。



在SwapBuffers中，我尝试了TransparentBlt，似乎工作。外包也是直接分配bm32到层位图，这也可以，但可能不总是你想要的。


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

解决方案

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.

这篇关于Delphi Graphics32透明层画线的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
Delphi最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆