gpt4 book ai didi

delphi - 显示部分变暗的 TImage

转载 作者:行者123 更新时间:2023-12-02 08:43:01 26 4
gpt4 key购买 nike

我正在尝试制作一个如下所示的裁剪工具:

原始图片:

enter image description here

裁剪工具 - 这就是我想要的:

enter image description here

请注意,裁剪区域显示的是原始颜色,而周围的颜色较暗。

<小时/>

我所做的就是在我的 TImage 上放置一个 TShape ,其属性如下:

object Shape1: TShape
Brush.Color = clSilver
Pen.Mode = pmMask
Pen.Style = psDot
end

我计划使用 TShape 来进行调整大小/应对控制。这是它在 Delphi 中的样子:

enter image description here

如您所见,它看起来不太好(调色板看起来抖动),但主要问题是我需要暗淡区域位于裁剪区域周围,而不是位于中心。我尝试用另一个 TShpae 覆盖整个 TImage,尝试了不同的 Pen.Mode 组合,但没有好的结果,我认为我的方法/途径很糟糕。

您对如何实现所需的行为有什么想法吗?

最佳答案

这里缺少一小部分,但添加应该不是问题......

unit Unit3;
// 20121108 by Thomas Wassermann
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, jpeg;

type
TForm3 = class(TForm)
Image1: TImage;
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
{ Private-Deklarationen }
FDownPoint, FCurrentPoint: TPoint;
public
{ Public-Deklarationen }
end;

var
Form3: TForm3;

implementation

uses Math;
{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
PaintBox1.BringToFront;
end;

type
pRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = ARRAY [0 .. $EFFFFFF] OF TRGBQuad;

Procedure SetAlpha(bmp: TBitMap; Alpha: Byte; R: TRect);
var
pscanLine32: pRGBQuadArray;
i, j: Integer;
begin
bmp.PixelFormat := pf32Bit;
bmp.HandleType := bmDIB;
bmp.ignorepalette := true;
bmp.alphaformat := afDefined;
for i := 0 to bmp.Height - 1 do
begin
pscanLine32 := bmp.Scanline[i];
for j := 0 to bmp.Width - 1 do
begin
if (j >= R.Left) and (j <= R.Right) and (i >= R.Top) and (i <= R.Bottom) then
begin
pscanLine32[j].rgbReserved := 0;
pscanLine32[j].rgbBlue := 0;
pscanLine32[j].rgbRed := 0;
pscanLine32[j].rgbGreen := 0;
end
else
begin
pscanLine32[j].rgbReserved := Alpha;
pscanLine32[j].rgbBlue := Alpha;
pscanLine32[j].rgbRed := Alpha;
pscanLine32[j].rgbGreen := Alpha;
end;
end;
end;
end;

procedure TForm3.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FDownPoint.X := X;
FDownPoint.Y := Y;
FCurrentPoint := FDownPoint;
PaintBox1.Invalidate;
end;

procedure TForm3.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift then
begin
FCurrentPoint.X := X;
FCurrentPoint.Y := Y;
PaintBox1.Invalidate;
end;
end;

procedure TForm3.PaintBox1Paint(Sender: TObject);
var
bmp: TBitMap;
SelRect: TRect;
begin
bmp := TBitMap.Create;
try
bmp.Width := PaintBox1.Width;
bmp.Height := PaintBox1.Height;
if (FCurrentPoint.X = FDownPoint.X) and (FCurrentPoint.Y = FDownPoint.Y) then
SelRect := PaintBox1.BoundsRect
else
begin
SelRect.Left := Min(FCurrentPoint.X, FDownPoint.X);
SelRect.Top := Min(FCurrentPoint.Y, FDownPoint.Y);
SelRect.Right := Max(FCurrentPoint.X, FDownPoint.X);
SelRect.Bottom := Max(FCurrentPoint.Y, FDownPoint.Y);
end;
SetAlpha(bmp, 140, SelRect);
PaintBox1.Canvas.Draw(0, 0, bmp);
finally
bmp.Free;
end;
end;

end.

此解决方案的尝试是使用覆盖的油漆盒(与图像相同的客户端矩形)进行所有绘图和选择。通过使用鼠标/向下/移动生成的坐标,创建半透明位图,该位图在选定的矩形中是完全透明的。生成后,将其绘制在颜料盒上。可以在那里进行进一步的绘画,例如框架、 anchor 、十字准线。任何用户操作都必须在 mousedown 中捕获,具体取决于所选部分,例如可以完成矩形尺寸的锚定。通常我更喜欢 GDI+ 来处理这样的请求,但如图所示,不需要额外的单元。来源:http://www.bummisoft.de/download/transparenteauswahl.zip Demo

关于delphi - 显示部分变暗的 TImage,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/13689732/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com