var DC : HDC;

      Bmp : TBitmap;

      rc : TRect;

      png : TPngObject;

begin

  DC := GetDC(form1.Handle);

  GetClipBox(DC,rc);

  Bmp := Tbitmap.Create;

  Bmp.Width := rc.right - rc.left;

  Bmp.Height := rc.Bottom - rc.Top;

  Bitblt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,DC,0,0,SRCCOPY);

  ReleaseDC(form1.Handle,DC);

  Png := TPngObject.Create;

  Png.Assign(Bmp);

  Png.SaveToFile('a.png');

  Bmp.Free;

  Png.Free;

end;

  png.Assign(Bitmap);

  png.CreateAlpha;

  for i := 0 to png.Header.Height - 1 do

  begin

    pData := Bitmap.ScanLine[i];

    for j := 0 to png.Header.Width - 1 do

      png.AlphaScanline[i]^[j] := pData[j * 4 + 3];

  end;

  procedure SaveTofile(Bitmap : TBitmap;aExt : string);

  var Gpbmp : TGpBitmap;

      CLSID : TGUID;

      Parameters: TEncoderParameters;

      Quality: Integer;

  begin

    if GetEncoderClsid('Image/' + aExt,CLSID) then

    begin

      Gpbmp := TGpBitmap.Create(Bitmap.Handle,Bitmap.Palette);

      Parameters.Count := 1;

      Parameters.Parameter[0].NumberOfValues := 1;

      Quality := 100;

      Parameters.Parameter[0].Value := @Quality;

      Gpbmp.Save(aFile,CLSID,@Parameters);

      FreeandNil(Gpbmp);

    end;

  end;