www.pudn.com > yrsCapture.zip > CompressQual.pas

{******************************************************************************} 
{*                                                                            *} 
{*          Adirondack Software & Graphics JPEG Compression Quality           *} 
{*          (C) Copyright Adirondack Software & Graphics 1996-1998            *} 
{*                                                                            *} 
{******************************************************************************} 
 
unit CompressQual; 
 
interface 
 
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  JPeg, StdCtrls, ExtCtrls, Spin, NetGradient; 
 
type 
  TQualityForm = class( TForm ) 
    GroupBox3: TGroupBox; 
    CompressionQuality1: TSpinEdit; 
    Button1: TButton; 
    Button2: TButton; 
    Label1: TLabel; 
    Label2: TLabel; 
    NetGradient1: TNetGradient; 
    procedure Button2Click( Sender: TObject ); 
    procedure Button1Click( Sender: TObject ); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
    Picture: TPicture; 
  end; 
 
var 
  QualityForm: TQualityForm; 
 
implementation 
 
uses Main; 
 
{$R *.DFM} 
 
{==============================================================================} 
procedure TQualityForm.Button2Click( Sender: TObject ); 
{==============================================================================} 
var 
  Temp: Boolean; 
begin 
  Temp := Picture.Graphic is TJPEGImage; 
  if Temp then 
    with TJPEGImage( Picture.Graphic ) do 
      CompressionQuality := 100; 
end; 
 
{==============================================================================} 
procedure TQualityForm.Button1Click( Sender: TObject ); 
{==============================================================================} 
var 
  Temp: Boolean; 
begin 
  Temp := Picture.Graphic is TJPEGImage; 
  if Temp then 
    with TJPEGImage( Picture.Graphic ) do 
      CompressionQuality:= CompressionQuality1.Value; 
end; 
 
{==============================================================================} 
procedure TQualityForm.FormCreate( Sender: TObject ); 
{==============================================================================} 
begin 
   Picture := TPicture.Create; 
end; 
 
{==============================================================================} 
procedure TQualityForm.FormDestroy( Sender: TObject ); 
{==============================================================================} 
begin 
   Picture.Free; 
end; 
 
end.