2

次のようなトリミング ツールを作成しようとしています。

元の画像:

ここに画像の説明を入力

切り抜きツール - これは私が欲しいものです:

ここに画像の説明を入力

トリミング領域には元の色が表示されており、色の周りが薄くなっていることに注意してください。

私がしたことはTShape、私の上TImageにプロパティを配置することです：

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

TShape を使用してサイズ変更/コーピング コントロールを作成する予定です。Delphi では次のように表示されます。

ここに画像の説明を入力

ご覧のとおり、見栄えがよくありません (カラー パレットがディザリングされているように見えます)。TImage 全体を別の TShpae でカバーしようとしましたが、さまざまなPen.Mode組み合わせを試しましたが、良い結果が得られず、私の方法/アプローチが悪いと思います。

望ましい動作を実現する方法について何かアイデアはありますか?

4

1 に答える 1

6

ここには少し欠けている部分がありますが、追加しても問題ないはずです...

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 の上にあるペイントボックスを使用することです。マウス/ダウン/移動によって生成された座標を使用して、半透明のビットマップが作成され、選択した四角形で完全に透明になります。生成後、ペイントボックスにペイントされます。フレーム、アンカー、十字線など、さらにペイントを行うことができます。選択した部分に応じて、ユーザーアクションはすべてマウスダウンでキャッチする必要があります。たとえば、アンカー、四角形のサイズ変更を行うことができます。通常、このような要求には GDI+ を使用したいと思いますが、示されているように、追加のユニットは必要ありません。ソース: http://www.bummisoft.de/download/transparenteauswahl.zip デモ

于 2012-12-03T19:17:47.950 に答える