顯示一個的TImage部分昏暗

Question

我試圖做一個裁剪工具，它看起來如下：

原始圖像：

裁剪工具 - 這是我想要的：

注意裁剪區域顯示原始顏色，並且顏色變暗。

---

我所做的是將一個TShape在我TImage與性能：

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

我打算使用T形，以使調整大小/應對控制。 這是它的外觀在德爾福：

正如你所看到的，它並沒有看起來不錯（顏色調色板看起來抖動），但我需要的昏暗區域的主要問題是圍繞作物區域，不在中心。我試圖用另一個TShpae覆蓋整個TImage，嘗試了不同的Pen.Mode組合，但沒有好的結果，而且我認爲我的方法/方法很糟糕。

對於如何達到預期的行爲你有什麼想法嗎？

Answer 1

一小部分是缺少在這裏，但不應該添加一個問題...

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. 

這個解決方案的嘗試使用覆顏料盒，同樣clientrect的圖像，對於所有的繪圖和選擇。通過使用mouse/down/move生成的座標，創建一個半透明的位圖，它在選定的矩形中是完全透明的。生成後，它被塗在油漆盒上。進一步的繪畫可以在那裏完成。框架，錨，十字準線。任何用戶操作都必須以mousedown捕捉，具體取決於所選部分，例如。一個錨的大小可以完成。 通常我更喜歡GDI +這樣的請求，但如圖所示，不需要額外的單位。來源：http://www.bummisoft.de/download/transparenteauswahl.zip