Delphi Graphics32透明图层画线
Delphi Graphics32 transparent layer draw line
我正在尝试向 ImgView32 添加一个图层，我想在该图层上画一条线。但是，我希望该层是透明的，所以它不会覆盖之前添加的所有层。
所以我想获得：
layer 1 -> image
layer 2 -> another image
layer 3 -> draw a line
layer 4 -> another image
下面是问题：
您将找到我用于绘制线条并在 link 之后声明 BitmapLayer 的代码。我不想在这里添加它，所以问题将保持小。
顺便说一句，我已经尝试为绘图层声明它：
Bitmap.DrawMode := dmBlend;
BL.Bitmap.CombineMode:= cmMerge;
还有这个
Bitmap.DrawMode := dmTransparent;
BL.Bitmap.CombineMode:= cmMerge;
(BL -> TBitmapLayer)
没变。当我创建 BitmapLayer 时，它就像一张白纸一样位于前面的图层之上，将它们隐藏起来。
问题是：这可以做到吗（使图层透明）？那怎么办？
谢谢
这是基于之前测试的示例代码。这次可能更好 post 整个单元，包括 .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 分配给层位图，这也有效，但可能并不总是你想要的。
我正在尝试向 ImgView32 添加一个图层，我想在该图层上画一条线。但是，我希望该层是透明的，所以它不会覆盖之前添加的所有层。 所以我想获得：
layer 1 -> image
layer 2 -> another image
layer 3 -> draw a line
layer 4 -> another image
下面是问题：
顺便说一句，我已经尝试为绘图层声明它：
Bitmap.DrawMode := dmBlend;
BL.Bitmap.CombineMode:= cmMerge;
还有这个
Bitmap.DrawMode := dmTransparent;
BL.Bitmap.CombineMode:= cmMerge;
(BL -> TBitmapLayer) 没变。当我创建 BitmapLayer 时，它就像一张白纸一样位于前面的图层之上，将它们隐藏起来。 问题是：这可以做到吗（使图层透明）？那怎么办？
谢谢
这是基于之前测试的示例代码。这次可能更好 post 整个单元，包括 .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 分配给层位图，这也有效，但可能并不总是你想要的。