Image-Compressor/ImgComp.pas at main · Raz-js/Image-Compressor · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
// Program by Raz

unit ImgComp;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.ComCtrls, Vcl.Imaging.jpeg, Vcl.Imaging.pngimage;

type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    btnOpenImage: TButton;
    btnCompressImage: TButton;
    btnSaveImage: TButton;
    Label1: TLabel;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    procedure btnOpenImageClick(Sender: TObject);
    procedure btnCompressImageClick(Sender: TObject);
    procedure btnSaveImageClick(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    { Private declarations }
    FOriginalFileName: string;
    FCompressedImage: TPicture;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnOpenImageClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Image1.Picture.LoadFromFile(OpenDialog1.FileName);
    Image3.Picture.LoadFromFile(OpenDialog1.FileName);
    FOriginalFileName := OpenDialog1.FileName;
  end;
end;

procedure TForm1.btnCompressImageClick(Sender: TObject);
var
  PNGImage: TPngImage;
  JPEGImage: TJPEGImage;
  Bitmap: TBitmap;
begin
  if FOriginalFileName = '' then
  begin
    ShowMessage('Please open an image first.');
    Exit;
  end;

  if SameText(ExtractFileExt(FOriginalFileName), '.png') then
  begin
    PNGImage := TPngImage.Create;
    try
      PNGImage.LoadFromFile(FOriginalFileName);
      Image2.Picture.Assign(PNGImage);

      if Assigned(FCompressedImage) then
        FCompressedImage.Free;
      FCompressedImage := TPicture.Create;
      FCompressedImage.Assign(PNGImage);
    finally
      PNGImage.Free;
    end;
  end
  else if SameText(ExtractFileExt(FOriginalFileName), '.jpg') or SameText(ExtractFileExt(FOriginalFileName), '.jpeg') then
  begin
    JPEGImage := TJPEGImage.Create;
    Bitmap := TBitmap.Create;
    try
      Bitmap.LoadFromFile(FOriginalFileName);
      JPEGImage.Assign(Bitmap);
      JPEGImage.CompressionQuality := TrackBar1.Position;
      Image2.Picture.Assign(JPEGImage);

      if Assigned(FCompressedImage) then
        FCompressedImage.Free;
      FCompressedImage := TPicture.Create;
      FCompressedImage.Assign(JPEGImage);
    finally
      JPEGImage.Free;
      Bitmap.Free;
    end;
  end
  else
  begin
    ShowMessage('Unsupported image format. Please use PNG or JPEG.');
    Exit;
  end;
end;

procedure TForm1.btnSaveImageClick(Sender: TObject);
var
  SaveFileName: string;
  Ext: string;
begin
  if FOriginalFileName = '' then
  begin
    ShowMessage('Please open an image first.');
    Exit;
  end;

  if not Assigned(FCompressedImage) then
  begin
    ShowMessage('Please compress the image first.');
    Exit;
  end;

  Ext := ExtractFileExt(FOriginalFileName);
  SaveFileName := ChangeFileExt(FOriginalFileName, '') + '-compressed' + Ext;

  if SameText(Ext, '.png') then
  begin
    FCompressedImage.Graphic.SaveToFile(SaveFileName);
  end
  else if SameText(Ext, '.jpg') or SameText(Ext, '.jpeg') then
  begin
    FCompressedImage.Graphic.SaveToFile(SaveFileName);
  end
  else
  begin
    ShowMessage('Unsupported image format. Please use PNG or JPEG.');
    Exit;
  end;

  ShowMessage('Image saved as: ' + SaveFileName);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Label1.Caption := 'Compression Quality: ' + IntToStr(TrackBar1.Position);
end;

end.