mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 11:56:08 +02:00
Examples: Add new jpeg demo ("jpeg_more") for the properties added in r59051 #c0c477a971-55
git-svn-id: trunk@59056 -
This commit is contained in:
wp
parent
4d63f89b51
commit
7b7dceaf6d
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -6394,6 +6394,10 @@ examples/jpeg/jpegexample.lpr svneol=native#text/pascal
|
||||
examples/jpeg/lazarus.jpg -text svneol=unset#image/jpeg
|
||||
examples/jpeg/mainform.lfm svneol=native#text/plain
|
||||
examples/jpeg/mainform.pas svneol=native#text/pascal
|
||||
examples/jpeg_more/jpeg_test.lpi svneol=native#text/plain
|
||||
examples/jpeg_more/jpeg_test.lpr svneol=native#text/plain
|
||||
examples/jpeg_more/main.lfm svneol=native#text/plain
|
||||
examples/jpeg_more/main.pas svneol=native#text/plain
|
||||
examples/lazfreetype/lazfreetypetest.ico -text
|
||||
examples/lazfreetype/lazfreetypetest.lpi svneol=native#text/plain
|
||||
examples/lazfreetype/lazfreetypetest.lpr svneol=native#text/plain
|
||||
|
||||
79
examples/jpeg_more/jpeg_test.lpi
Normal file
79
examples/jpeg_more/jpeg_test.lpi
Normal file
@ -0,0 +1,79 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="jpeg_test"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="jpeg_test.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="jpeg_test"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
22
examples/jpeg_more/jpeg_test.lpr
Normal file
22
examples/jpeg_more/jpeg_test.lpr
Normal file
@ -0,0 +1,22 @@
|
||||
program jpeg_test;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, main
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Scaled:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
430
examples/jpeg_more/main.lfm
Normal file
430
examples/jpeg_more/main.lfm
Normal file
@ -0,0 +1,430 @@
|
||||
object Form1: TForm1
|
||||
Left = 348
|
||||
Height = 620
|
||||
Top = 131
|
||||
Width = 684
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 620
|
||||
ClientWidth = 684
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '2.1.0.0'
|
||||
object PageControl: TPageControl
|
||||
Left = 4
|
||||
Height = 585
|
||||
Top = 31
|
||||
Width = 676
|
||||
ActivePage = PgRead
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 4
|
||||
TabIndex = 0
|
||||
TabOrder = 0
|
||||
object PgRead: TTabSheet
|
||||
Caption = 'Read'
|
||||
ClientHeight = 557
|
||||
ClientWidth = 668
|
||||
object ScrollBox1: TScrollBox
|
||||
AnchorSideLeft.Control = PgRead
|
||||
AnchorSideTop.Control = PgRead
|
||||
AnchorSideRight.Control = PgRead
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Panel1
|
||||
Left = 0
|
||||
Height = 445
|
||||
Top = 0
|
||||
Width = 668
|
||||
HorzScrollBar.Page = 553
|
||||
HorzScrollBar.Tracking = True
|
||||
VertScrollBar.Increment = 37
|
||||
VertScrollBar.Page = 370
|
||||
VertScrollBar.Smooth = True
|
||||
VertScrollBar.Tracking = True
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
ClientHeight = 441
|
||||
ClientWidth = 664
|
||||
TabOrder = 0
|
||||
object Image1: TImage
|
||||
Left = 0
|
||||
Height = 370
|
||||
Top = 0
|
||||
Width = 553
|
||||
end
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 4
|
||||
Height = 104
|
||||
Top = 449
|
||||
Width = 660
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 4
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 104
|
||||
ClientWidth = 660
|
||||
TabOrder = 1
|
||||
object RgScale: TRadioGroup
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = Panel1
|
||||
Left = 0
|
||||
Height = 104
|
||||
Top = 0
|
||||
Width = 84
|
||||
AutoFill = True
|
||||
AutoSize = True
|
||||
Caption = 'Scale'
|
||||
ChildSizing.LeftRightSpacing = 6
|
||||
ChildSizing.TopBottomSpacing = 4
|
||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 1
|
||||
ClientHeight = 84
|
||||
ClientWidth = 80
|
||||
ItemIndex = 2
|
||||
Items.Strings = (
|
||||
'jsFullSize'
|
||||
'jsHalf'
|
||||
'jsQuarter'
|
||||
'jsEighth'
|
||||
)
|
||||
TabOrder = 0
|
||||
end
|
||||
object RgPerformance: TRadioGroup
|
||||
AnchorSideLeft.Control = RgScale
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Panel1
|
||||
Left = 100
|
||||
Height = 66
|
||||
Top = 0
|
||||
Width = 106
|
||||
AutoFill = True
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 16
|
||||
Caption = 'Performance'
|
||||
ChildSizing.LeftRightSpacing = 6
|
||||
ChildSizing.TopBottomSpacing = 4
|
||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 1
|
||||
ClientHeight = 46
|
||||
ClientWidth = 102
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'jpBestQuality'
|
||||
'jpBestSpeed'
|
||||
)
|
||||
TabOrder = 1
|
||||
end
|
||||
object CbSmoothing: TCheckBox
|
||||
AnchorSideLeft.Control = RgPerformance
|
||||
AnchorSideTop.Control = RgScale
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideBottom.Control = RgScale
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 100
|
||||
Height = 19
|
||||
Top = 85
|
||||
Width = 79
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Smoothing'
|
||||
TabOrder = 2
|
||||
end
|
||||
object BtnRead: TButton
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Panel1
|
||||
AnchorSideRight.Control = Panel1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Panel1
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 585
|
||||
Height = 68
|
||||
Top = 36
|
||||
Width = 75
|
||||
Anchors = [akRight, akBottom]
|
||||
BorderSpacing.Left = 16
|
||||
Caption = 'Read'
|
||||
OnClick = BtnReadClick
|
||||
TabOrder = 3
|
||||
end
|
||||
object LblSpeed: TLabel
|
||||
AnchorSideLeft.Control = CbApplyMinSize
|
||||
AnchorSideTop.Control = RgPerformance
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideBottom.Control = Panel1
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 222
|
||||
Height = 15
|
||||
Top = 89
|
||||
Width = 32
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Top = 4
|
||||
Caption = 'Speed'
|
||||
ParentColor = False
|
||||
end
|
||||
object CbApplyMinSize: TCheckBox
|
||||
AnchorSideLeft.Control = RgPerformance
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = EdMinWidth
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 222
|
||||
Height = 19
|
||||
Top = 4
|
||||
Width = 175
|
||||
BorderSpacing.Left = 16
|
||||
Caption = 'Apply min size: Min width'
|
||||
TabOrder = 4
|
||||
end
|
||||
object EdMinWidth: TSpinEdit
|
||||
AnchorSideLeft.Control = CbApplyMinSize
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Panel1
|
||||
Left = 405
|
||||
Height = 23
|
||||
Top = 2
|
||||
Width = 81
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 2
|
||||
MaxValue = 65535
|
||||
TabOrder = 5
|
||||
Value = 200
|
||||
end
|
||||
object EdMinHeight: TSpinEdit
|
||||
AnchorSideLeft.Control = EdMinWidth
|
||||
AnchorSideTop.Control = EdMinWidth
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 405
|
||||
Height = 23
|
||||
Top = 33
|
||||
Width = 81
|
||||
BorderSpacing.Top = 8
|
||||
MaxValue = 65535
|
||||
TabOrder = 6
|
||||
Value = 200
|
||||
end
|
||||
object LblSizeInfo: TLabel
|
||||
AnchorSideLeft.Control = CbApplyMinSize
|
||||
AnchorSideTop.Control = LblSpeed
|
||||
AnchorSideBottom.Control = LblSpeed
|
||||
Left = 222
|
||||
Height = 15
|
||||
Top = 70
|
||||
Width = 20
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Size'
|
||||
ParentColor = False
|
||||
end
|
||||
object LblMinHeight: TLabel
|
||||
AnchorSideTop.Control = EdMinHeight
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = EdMinHeight
|
||||
Left = 339
|
||||
Height = 15
|
||||
Top = 37
|
||||
Width = 58
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'Min height'
|
||||
ParentColor = False
|
||||
end
|
||||
object LblProgressive: TLabel
|
||||
AnchorSideLeft.Control = LblSizeInfo
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = LblSizeInfo
|
||||
Left = 258
|
||||
Height = 15
|
||||
Top = 70
|
||||
Width = 56
|
||||
BorderSpacing.Left = 16
|
||||
Caption = 'Progessive'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
end
|
||||
object PgWrite: TTabSheet
|
||||
Caption = 'Write'
|
||||
ClientHeight = 557
|
||||
ClientWidth = 668
|
||||
object ScrollBox2: TScrollBox
|
||||
AnchorSideLeft.Control = PgWrite
|
||||
AnchorSideTop.Control = PgWrite
|
||||
AnchorSideRight.Control = PgWrite
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Panel2
|
||||
Left = 0
|
||||
Height = 481
|
||||
Top = 0
|
||||
Width = 668
|
||||
HorzScrollBar.Page = 553
|
||||
HorzScrollBar.Tracking = True
|
||||
VertScrollBar.Increment = 36
|
||||
VertScrollBar.Page = 369
|
||||
VertScrollBar.Smooth = True
|
||||
VertScrollBar.Tracking = True
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
ClientHeight = 477
|
||||
ClientWidth = 664
|
||||
TabOrder = 0
|
||||
object Image2: TImage
|
||||
Left = 0
|
||||
Height = 370
|
||||
Top = -1
|
||||
Width = 553
|
||||
end
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Left = 4
|
||||
Height = 68
|
||||
Top = 485
|
||||
Width = 660
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 4
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 68
|
||||
ClientWidth = 660
|
||||
TabOrder = 1
|
||||
object CbGrayscale: TCheckBox
|
||||
AnchorSideLeft.Control = Panel2
|
||||
AnchorSideTop.Control = SbQuality
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 19
|
||||
Top = 48
|
||||
Width = 70
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Grayscale'
|
||||
TabOrder = 0
|
||||
end
|
||||
object SbQuality: TScrollBar
|
||||
AnchorSideLeft.Control = Panel2
|
||||
AnchorSideTop.Control = LblQuality
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 17
|
||||
Top = 23
|
||||
Width = 329
|
||||
BorderSpacing.Top = 8
|
||||
Min = 1
|
||||
PageSize = 0
|
||||
Position = 10
|
||||
TabOrder = 1
|
||||
OnChange = SbQualityChange
|
||||
end
|
||||
object BtnWrite: TButton
|
||||
AnchorSideRight.Control = Panel2
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Panel2
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 585
|
||||
Height = 68
|
||||
Top = 0
|
||||
Width = 75
|
||||
Anchors = [akRight, akBottom]
|
||||
Caption = 'Write'
|
||||
OnClick = BtnWriteClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object LblQuality: TLabel
|
||||
AnchorSideLeft.Control = Panel2
|
||||
AnchorSideTop.Control = Panel2
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 0
|
||||
Width = 38
|
||||
Caption = 'Quality'
|
||||
ParentColor = False
|
||||
end
|
||||
object LblQualityLevel: TLabel
|
||||
AnchorSideLeft.Control = SbQuality
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = LblQuality
|
||||
Left = 152
|
||||
Height = 15
|
||||
Top = 0
|
||||
Width = 24
|
||||
Caption = ' '
|
||||
ParentColor = False
|
||||
end
|
||||
object CbProgressive: TCheckBox
|
||||
AnchorSideLeft.Control = CbGrayscale
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = CbGrayscale
|
||||
Left = 86
|
||||
Height = 19
|
||||
Top = 48
|
||||
Width = 133
|
||||
BorderSpacing.Left = 16
|
||||
Caption = 'Progressive encoding'
|
||||
TabOrder = 3
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object FilenamePanel: TPanel
|
||||
Left = 4
|
||||
Height = 23
|
||||
Top = 4
|
||||
Width = 676
|
||||
Align = alTop
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 4
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 23
|
||||
ClientWidth = 676
|
||||
TabOrder = 1
|
||||
object RbUseCheetah: TRadioButton
|
||||
AnchorSideLeft.Control = FilenamePanel
|
||||
AnchorSideTop.Control = EdFileName
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 4
|
||||
Height = 19
|
||||
Top = 2
|
||||
Width = 104
|
||||
BorderSpacing.Left = 4
|
||||
Caption = 'Lazarus cheetah'
|
||||
Checked = True
|
||||
TabOrder = 2
|
||||
TabStop = True
|
||||
end
|
||||
object RbOtherFile: TRadioButton
|
||||
AnchorSideLeft.Control = RbUseCheetah
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = EdFileName
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 120
|
||||
Height = 19
|
||||
Top = 2
|
||||
Width = 75
|
||||
BorderSpacing.Left = 12
|
||||
Caption = 'Other file: '
|
||||
TabOrder = 0
|
||||
end
|
||||
object EdFileName: TFileNameEdit
|
||||
AnchorSideLeft.Control = RbOtherFile
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = FilenamePanel
|
||||
AnchorSideRight.Control = FilenamePanel
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 199
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 473
|
||||
OnAcceptFileName = EdFileNameAcceptFileName
|
||||
FilterIndex = 0
|
||||
HideDirectories = False
|
||||
ButtonWidth = 23
|
||||
NumGlyphs = 1
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Right = 4
|
||||
MaxLength = 0
|
||||
TabOrder = 1
|
||||
OnButtonClick = EdFileNameButtonClick
|
||||
end
|
||||
end
|
||||
end
|
||||
188
examples/jpeg_more/main.pas
Normal file
188
examples/jpeg_more/main.pas
Normal file
@ -0,0 +1,188 @@
|
||||
unit main;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
|
||||
ComCtrls, Spin, EditBtn, FPReadJpeg;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
BtnWrite: TButton;
|
||||
BtnRead: TButton;
|
||||
CbApplyMinSize: TCheckBox;
|
||||
CbGrayscale: TCheckBox;
|
||||
LblProgressive: TLabel;
|
||||
RbOtherFile: TRadioButton;
|
||||
CbProgressive: TCheckBox;
|
||||
CbSmoothing: TCheckBox;
|
||||
EdFileName: TFileNameEdit;
|
||||
RbUseCheetah: TRadioButton;
|
||||
EdMinWidth: TSpinEdit;
|
||||
EdMinHeight: TSpinEdit;
|
||||
FilenamePanel: TPanel;
|
||||
Image1: TImage;
|
||||
Image2: TImage;
|
||||
LblMinHeight: TLabel;
|
||||
LblQualityLevel: TLabel;
|
||||
LblSpeed: TLabel;
|
||||
LblQuality: TLabel;
|
||||
LblSizeInfo: TLabel;
|
||||
PageControl: TPageControl;
|
||||
Panel1: TPanel;
|
||||
Panel2: TPanel;
|
||||
RgScale: TRadioGroup;
|
||||
RgPerformance: TRadioGroup;
|
||||
SbQuality: TScrollBar;
|
||||
ScrollBox1: TScrollBox;
|
||||
ScrollBox2: TScrollBox;
|
||||
PgRead: TTabSheet;
|
||||
PgWrite: TTabSheet;
|
||||
procedure BtnReadClick(Sender: TObject);
|
||||
procedure BtnWriteClick(Sender: TObject);
|
||||
procedure EdFileNameAcceptFileName(Sender: TObject; var Value: String);
|
||||
procedure EdFileNameButtonClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure SbQualityChange(Sender: TObject);
|
||||
private
|
||||
function GetFileName: String;
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
const
|
||||
CHEETAH_FILENAME = '../../images\splash_source/cheetah.jpg';
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.BtnReadClick(Sender: TObject);
|
||||
var
|
||||
filename: String;
|
||||
jpeg: TJpegImage;
|
||||
t: TDateTime;
|
||||
begin
|
||||
fileName := GetFileName;
|
||||
if fileName = '' then begin
|
||||
MessageDlg('No filename', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
if not FileExists(filename) then begin
|
||||
MessageDlg(Format('File "%s" not found.', [filename]), mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
LblSpeed.Caption := 'Time to load: ...';
|
||||
LblSpeed.Refresh;
|
||||
|
||||
jpeg := TJpegImage.Create;
|
||||
try
|
||||
t := now;
|
||||
jpeg.Scale := TJPEGScale(RgScale.ItemIndex);
|
||||
jpeg.Smoothing := CbSmoothing.Checked;
|
||||
jpeg.Performance := TJPEGPerformance(RgPerformance.ItemIndex);
|
||||
if CbApplyMinSize.Checked then begin
|
||||
jpeg.MinWidth := EdMinWidth.Value;
|
||||
jpeg.MinHeight := EdMinHeight.Value;
|
||||
end;
|
||||
jpeg.LoadFromFile(FILENAME);
|
||||
t := now - t;
|
||||
Image1.Picture.Assign(jpeg);
|
||||
Image1.Width := Image1.Picture.Width;
|
||||
Image1.Height := Image1.Picture.Height;
|
||||
LblSizeInfo.Caption := Format('Size %d x %d', [jpeg.Width, jpeg.Height]);
|
||||
LblSpeed.Caption := 'Time to load: ' + FormatDateTime('s.zzz', t) + ' s';
|
||||
if jpeg.ProgressiveEncoding then
|
||||
LblProgressive.Caption := 'Progressive encoding'
|
||||
else
|
||||
LblProgressive.Caption := '';
|
||||
finally
|
||||
jpeg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.BtnWriteClick(Sender: TObject);
|
||||
var
|
||||
jpeg: TJpegImage;
|
||||
fileName: String;
|
||||
newFileName: String;
|
||||
begin
|
||||
fileName := GetFileName;
|
||||
if fileName = '' then begin
|
||||
MessageDlg('No filename', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
if not FileExists(filename) then begin
|
||||
MessageDlg(Format('File "%s" not found.', [filename]), mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
newFileName := ChangeFileExt(filename, '') + '_mod.jpg';
|
||||
|
||||
jpeg := TJpegImage.Create;
|
||||
try
|
||||
jpeg.LoadFromFile(filename);
|
||||
jpeg.CompressionQuality := SbQuality.Position;
|
||||
jpeg.GrayScale := CbGrayScale.Checked;
|
||||
jpeg.ProgressiveEncoding := CbProgressive.Checked;
|
||||
jpeg.SaveToFile(newFileName);
|
||||
finally
|
||||
jpeg.Free;
|
||||
end;
|
||||
|
||||
jpeg := TJpegImage.Create;
|
||||
try
|
||||
jpeg.LoadFromFile(newFileName);
|
||||
Image2.Picture.Assign(jpeg);
|
||||
Image2.Width := Image2.Picture.Width;
|
||||
Image2.Height := Image2.Picture.Height;
|
||||
finally
|
||||
jpeg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.EdFileNameAcceptFileName(Sender: TObject; var Value: String);
|
||||
begin
|
||||
RbOtherFile.Checked := true;
|
||||
end;
|
||||
|
||||
procedure TForm1.EdFileNameButtonClick(Sender: TObject);
|
||||
begin
|
||||
if EdFileName.FileName <> '' then
|
||||
EdFileName.InitialDir := ExtractFileDir(EdFilename.Filename);
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
LblProgressive.Caption := '';
|
||||
BtnReadClick(nil);
|
||||
SbQualityChange(nil);
|
||||
end;
|
||||
|
||||
function TForm1.GetFileName: String;
|
||||
begin
|
||||
if RbUseCheetah.Checked then
|
||||
Result := CHEETAH_FILENAME
|
||||
else
|
||||
Result := EdFileName.FileName;
|
||||
end;
|
||||
|
||||
procedure TForm1.SbQualityChange(Sender: TObject);
|
||||
begin
|
||||
LblQualityLevel.Caption := IntToStr(SbQuality.Position);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user