⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 compressqual.pas

📁 Apprehend Screen Capture Component Version 4.2 A non-visible component to capture images. Freeware w
💻 PAS
字号:
{******************************************************************************}
{*                                                                            *}
{*                        Adirondack Software & Graphics                      *}
{*                           JPEG Compression Quality                         *}
{*                                   Delphi 5                                 *}
{*          (C) Copyright Adirondack Software & Graphics 1996-2001            *}
{*                                                                            *}
{******************************************************************************}

unit CompressQual;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   JPeg, StdCtrls, ExtCtrls, Spin;

type
   TQualityForm = class( TForm )
      GroupBox3: TGroupBox;
      CompressionQuality1: TSpinEdit;
      Button1: TButton;
      Button2: TButton;
      Label1: TLabel;
      Label2: TLabel;
    Panel1: TPanel;
      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

{$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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -