image - 图像透明度

Question

通常，我允许我的用户将图像放置在主窗体中。

由于某些图像会引起很大的噪点，因此我想对其进行平滑处理。

我通常会在默认设置的图像中做一些透明处理。

当用户选择新图像或加载新图像时，如何自动执行此操作？

Answer 1

将跟踪栏添加到TOpenPictureDialog派生类中以设置透明度级别：

unit OpenFadedPictureDialog;

interface

uses
  Classes, Controls, ExtDlgs, ComCtrls, StdCtrls, Windows, Graphics, ExtCtrls;

type
  TOpenFadedPictureDialog = class(TOpenPictureDialog)
  private
    FFader: TTrackBar;
    FFaderLabel: TLabel;
    FBlendFunc: BLENDFUNCTION;
    FTimer: TTimer;
    procedure Delayed(Sender: TObject);
    procedure FaderChanged(Sender: TObject);
    procedure UpdateImage;
  protected
    procedure DoShow; override;
    procedure DoSelectionChange; override;
  public
    constructor Create(AOwner: TComponent); override;
    function Picture: TPicture;
    function TransparancyLevel: Byte;
  end;

implementation

{ TOpenFadedPictureDialog }

resourcestring
  SFaderHint = 'Track bar to set image transparancy.';
  SFaderLabelCaption = 'Image transparancy:';

constructor TOpenFadedPictureDialog.Create(AOwner: TComponent);
begin
  inherited Create(Owner);
  FFaderLabel := TLabel.Create(Self);
  FFaderLabel.Name := 'FaderLabel';
  FFaderLabel.Align := alTop;
  FFaderLabel.Caption := SFaderLabelCaption;
  FFader := TTrackBar.Create(Self);
  FFader.Name := 'FaderTrackBar';
  FFader.Align := alTop;
  FFader.Height := 25;
  FFader.TickStyle := tsNone;
  FFader.PageSize := 25;
  FFader.Max := 255;
  FFader.Position := 127;
  FFader.Hint := SFaderHint;
  FFader.OnChange := FaderChanged;
  FBlendFunc.BlendOp := AC_SRC_OVER;
  FBlendFunc.SourceConstantAlpha := 127;
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 100;
  FTimer.OnTimer := Delayed;
end;

procedure TOpenFadedPictureDialog.Delayed(Sender: TObject);
begin
  FTimer.Enabled := False;
  FBlendFunc.SourceConstantAlpha := FFader.Position;
  if (ImageCtrl.Picture <> nil) and (ImageCtrl.Picture.Graphic <> nil) then
    ImageCtrl.Picture.LoadFromFile(FileName);
  UpdateImage;
end;

procedure TOpenFadedPictureDialog.DoSelectionChange;
begin
  inherited DoSelectionChange;
  UpdateImage;
end;

procedure TOpenFadedPictureDialog.DoShow;
begin
  with ImageCtrl do
  begin
    Picture := nil;
    Align := alTop;
    Anchors := [akLeft, akTop, akRight, akBottom];
    Height := Height - FFaderLabel.Height + FFader.Height - 15;
    FFaderLabel.Parent := Parent;
    FFader.Parent := Parent;
  end;
  inherited DoShow;
end;

procedure TOpenFadedPictureDialog.FaderChanged(Sender: TObject);
begin
  FTimer.Enabled := False;
  FTimer.Enabled := True;
end;

function TOpenFadedPictureDialog.Picture: TPicture;
begin
  Result := ImageCtrl.Picture;
end;

function TOpenFadedPictureDialog.TransparancyLevel: Byte;
begin
  Result := FBlendFunc.SourceConstantAlpha;
end;

procedure TOpenFadedPictureDialog.UpdateImage;
var
  Src: TBitmap;
  Dst: TBitmap;
begin
  if (ImageCtrl.Picture <> nil) and (ImageCtrl.Picture.Graphic <> nil) then
  begin
    Src := TBitmap.Create;
    Dst := TBitmap.Create;
    try
      Src.Width := ImageCtrl.Picture.Width;
      Src.Height := ImageCtrl.Picture.Height;
      Dst.Width := Src.Width;
      Dst.Height := Src.Height;
      Src.Canvas.Draw(0, 0, ImageCtrl.Picture.Graphic);
      AlphaBlend(Dst.Canvas.Handle, 0, 0, Dst.Width, Dst.Height,
        Src.Canvas.Handle, 0, 0, Src.Width, Src.Height, FBlendFunc);
      ImageCtrl.Picture.Graphic := Dst;
    finally
      Dst.Free;
      Src.Free;
    end;
  end;
end;

end.

使用 TransparancyLevel函数执行后，创建此对话框以获得用户所需的透明度，或将所选图片分配给主窗体上的图片：

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TOpenFadedPictureDialog.Create(nil) do
    try
      if Execute then
        Image1.Picture := Picture;
    finally
      Free;
    end;
end;

自定义通用对话框的示例图像：