untfadeout.pas

类似雷达图的程序,用delphi写的,

unit untFadeOut;

interface
uses
  Windows, Graphics, SysUtils, Classes;

type
  TFadeThread = class(TThread)
  private
    FBufBmp: TBitmap;
    FBkBmp : TBitmap;

    FCanvas: TCanvas;
    FCurCol: Integer;

    FadeWidth: Integer;

    procedure DrawImage;
    procedure ShowImage;
  
  protected
    procedure Execute; override;

  public
    constructor Create(const aBmp: TBitmap; ACanvas: TCanvas;
                       AWidth: Integer = 20);
    destructor Destroy; override;

  end;

implementation
{ TFadeThread }

constructor TFadeThread.Create(const aBmp: TBitmap; ACanvas: TCanvas;
  AWidth: Integer);
begin
  FBufBmp:= TBitmap.Create;
  FBkBmp := TBitmap.Create;

  FBkBmp.Assign(aBmp);
  FBufBmp.Width := FBkBmp.Width;
  FBufBmp.Height:= FBkBmp.Height;

  FBufBmp.PixelFormat:= pf24bit;
  FBkBmp.PixelFormat := pf24bit;

  FCanvas:= ACanvas;

  FCurCol  := 0;
  FadeWidth:= AWidth;

  inherited Create(false);
end;

destructor TFadeThread.Destroy;
begin
  FreeAndNil(FBkBmp);
  FreeAndNil(FBufBmp);

  inherited;
end;

procedure TFadeThread.DrawImage;
var
  pSrcLine: PByteArray;
  pDstLine: PByteArray;
  nAlpha  : BYTE;
  nStep   : BYTE;
  nTmp    : BYTE;
  nRow, nCol: Integer;
begin
  nStep:= 255 div FadeWidth;

  // Clear old images
  FBufBmp.Canvas.Pen.Color  := clBlack;
  FBufBmp.Canvas.Brush.Color:= clBlack;
  FBufBmp.Canvas.Rectangle(0, 0, FBufBmp.Width, FBufBmp.Height);

  for nRow:= 0 to FBufBmp.Height - 1 do
  begin
    pSrcLine:= FBkBmp.ScanLine[nRow];
    pDstLine:= FBufBmp.ScanLine[nRow];

    nAlpha:= 0;
    for nCol:= FCurCol to FBufBmp.Width - 1 do
    begin
      inc(nAlpha);
      if (nAlpha > FadeWidth) then break;

      if nCol < 0 then continue;

      nTmp:= nStep * nAlpha;
      pDstLine[nCol * 3    ]:= nTmp * pSrcLine[nCol * 3    ] div 255;
      pDstLine[nCol * 3 + 1]:= nTmp * pSrcLine[nCol * 3 + 1] div 255;
      pDstLine[nCol * 3 + 2]:= nTmp * pSrcLine[nCol * 3 + 2] div 255;
    end;
  end;

  inc(FCurCol);

  if (FCurCol > FBufBmp.Width - 1) then FCurCol:= -FadeWidth;
end;

procedure TFadeThread.Execute;
begin
  while (true) do
  begin
    DrawImage;
    Synchronize(ShowImage);
    Sleep(10);
  end;
end;

procedure TFadeThread.ShowImage;
begin
  FCanvas.CopyRect(Rect(0, 0, FBufBmp.Width, FBufBmp.Height),
                   FBufBmp.Canvas,
                   Rect(0, 0, FBufBmp.Width, FBufBmp.Height));
end;

end.