- Initial import from internal repository
This commit is contained in:
commit
c0a125042b
|
|
@ -0,0 +1,2 @@
|
||||||
|
syntax: regexp
|
||||||
|
^.*[.](?!((pas)|(lfm)|(lpr)|(lpi)|(inc)))[^.]+$
|
||||||
|
|
@ -0,0 +1,246 @@
|
||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<PathDelim Value="/"/>
|
||||||
|
<Version Value="6"/>
|
||||||
|
<General>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<IconPath Value="./"/>
|
||||||
|
<TargetFileExt Value=".exe"/>
|
||||||
|
</General>
|
||||||
|
<VersionInfo>
|
||||||
|
<ProjectVersion Value=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="4">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="virtualtreeview_package"/>
|
||||||
|
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="lnetvisual"/>
|
||||||
|
<MinVersion Minor="5" Release="3" Valid="True"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="LazOpenGLContext"/>
|
||||||
|
<MinVersion Valid="True"/>
|
||||||
|
</Item4>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="24">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="CentrED.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="CentrED"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="UfrmMain.pas"/>
|
||||||
|
<ComponentName Value="frmMain"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmMain.lrs"/>
|
||||||
|
<UnitName Value="UfrmMain"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="UdmNetwork.pas"/>
|
||||||
|
<ComponentName Value="dmNetwork"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UdmNetwork.lrs"/>
|
||||||
|
<UnitName Value="UdmNetwork"/>
|
||||||
|
</Unit2>
|
||||||
|
<Unit3>
|
||||||
|
<Filename Value="UfrmLogin.pas"/>
|
||||||
|
<ComponentName Value="frmLogin"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmLogin.lrs"/>
|
||||||
|
<UnitName Value="UfrmLogin"/>
|
||||||
|
</Unit3>
|
||||||
|
<Unit4>
|
||||||
|
<Filename Value="UfrmInitialize.pas"/>
|
||||||
|
<ComponentName Value="frmInitialize"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmInitialize.lrs"/>
|
||||||
|
<UnitName Value="UfrmInitialize"/>
|
||||||
|
</Unit4>
|
||||||
|
<Unit5>
|
||||||
|
<Filename Value="UOpenGLUI.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="UOpenGLUI"/>
|
||||||
|
</Unit5>
|
||||||
|
<Unit6>
|
||||||
|
<Filename Value="UfrmAccountControl.pas"/>
|
||||||
|
<ComponentName Value="frmAccountControl"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmAccountControl.lrs"/>
|
||||||
|
<UnitName Value="UfrmAccountControl"/>
|
||||||
|
</Unit6>
|
||||||
|
<Unit7>
|
||||||
|
<Filename Value="UfrmEditAccount.pas"/>
|
||||||
|
<ComponentName Value="frmEditAccount"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmEditAccount.lrs"/>
|
||||||
|
<UnitName Value="UfrmEditAccount"/>
|
||||||
|
</Unit7>
|
||||||
|
<Unit8>
|
||||||
|
<Filename Value="Tools/UfrmDrawSettings.pas"/>
|
||||||
|
<ComponentName Value="frmDrawSettings"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Tools/UfrmDrawSettings.lrs"/>
|
||||||
|
<UnitName Value="UfrmDrawSettings"/>
|
||||||
|
</Unit8>
|
||||||
|
<Unit9>
|
||||||
|
<Filename Value="Tools/UfrmBoundaries.pas"/>
|
||||||
|
<ComponentName Value="frmBoundaries"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Tools/UfrmBoundaries.lrs"/>
|
||||||
|
<UnitName Value="UfrmBoundaries"/>
|
||||||
|
</Unit9>
|
||||||
|
<Unit10>
|
||||||
|
<Filename Value="Tools/UfrmElevateSettings.pas"/>
|
||||||
|
<ComponentName Value="frmElevateSettings"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Tools/UfrmElevateSettings.lrs"/>
|
||||||
|
<UnitName Value="UfrmElevateSettings"/>
|
||||||
|
</Unit10>
|
||||||
|
<Unit11>
|
||||||
|
<Filename Value="UOverlayUI.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="UOverlayUI"/>
|
||||||
|
</Unit11>
|
||||||
|
<Unit12>
|
||||||
|
<Filename Value="UResourceManager.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="UResourceManager"/>
|
||||||
|
</Unit12>
|
||||||
|
<Unit13>
|
||||||
|
<Filename Value="Tools/UfrmConfirmation.pas"/>
|
||||||
|
<ComponentName Value="frmConfirmation"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Tools/UfrmConfirmation.lrs"/>
|
||||||
|
<UnitName Value="UfrmConfirmation"/>
|
||||||
|
</Unit13>
|
||||||
|
<Unit14>
|
||||||
|
<Filename Value="Tools/UfrmMoveSettings.pas"/>
|
||||||
|
<ComponentName Value="frmMoveSettings"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Tools/UfrmMoveSettings.lrs"/>
|
||||||
|
<UnitName Value="UfrmMoveSettings"/>
|
||||||
|
</Unit14>
|
||||||
|
<Unit15>
|
||||||
|
<Filename Value="UfrmAbout.pas"/>
|
||||||
|
<ComponentName Value="frmAbout"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmAbout.lrs"/>
|
||||||
|
<UnitName Value="UfrmAbout"/>
|
||||||
|
</Unit15>
|
||||||
|
<Unit16>
|
||||||
|
<Filename Value="Tools/UfrmHueSettings.pas"/>
|
||||||
|
<ComponentName Value="frmHueSettings"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Tools/UfrmHueSettings.lrs"/>
|
||||||
|
<UnitName Value="UfrmHueSettings"/>
|
||||||
|
</Unit16>
|
||||||
|
<Unit17>
|
||||||
|
<Filename Value="UfrmRadar.pas"/>
|
||||||
|
<ComponentName Value="frmRadarMap"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmRadar.lrs"/>
|
||||||
|
<UnitName Value="UfrmRadar"/>
|
||||||
|
</Unit17>
|
||||||
|
<Unit18>
|
||||||
|
<Filename Value="UfrmLargeScaleCommand.pas"/>
|
||||||
|
<ComponentName Value="frmLargeScaleCommand"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmLargeScaleCommand.lrs"/>
|
||||||
|
<UnitName Value="UfrmLargeScaleCommand"/>
|
||||||
|
</Unit18>
|
||||||
|
<Unit19>
|
||||||
|
<Filename Value="Tools/UfrmVirtualLayer.pas"/>
|
||||||
|
<ComponentName Value="frmVirtualLayer"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Tools/UfrmVirtualLayer.lrs"/>
|
||||||
|
<UnitName Value="UfrmVirtualLayer"/>
|
||||||
|
</Unit19>
|
||||||
|
<Unit20>
|
||||||
|
<Filename Value="Tools/UfrmFilter.pas"/>
|
||||||
|
<ComponentName Value="frmFilter"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="Tools/UfrmFilter.lrs"/>
|
||||||
|
<UnitName Value="UfrmFilter"/>
|
||||||
|
</Unit20>
|
||||||
|
<Unit21>
|
||||||
|
<Filename Value="UfrmTileInfo.pas"/>
|
||||||
|
<ComponentName Value="frmTileInfo"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ResourceFilename Value="UfrmTileInfo.lrs"/>
|
||||||
|
<UnitName Value="UfrmTileInfo"/>
|
||||||
|
</Unit21>
|
||||||
|
<Unit22>
|
||||||
|
<Filename Value="UGUIPlatformUtils.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="UGUIPlatformUtils"/>
|
||||||
|
</Unit22>
|
||||||
|
<Unit23>
|
||||||
|
<Filename Value="UPlatformTypes.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="UPlatformTypes"/>
|
||||||
|
</Unit23>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="5"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="../bin/CentrED"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="../Imaging/;../"/>
|
||||||
|
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/>
|
||||||
|
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
|
||||||
|
<LCLWidgetType Value="gtk"/>
|
||||||
|
<SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/;../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Parsing>
|
||||||
|
<SyntaxOptions>
|
||||||
|
<UseAnsiStrings Value="True"/>
|
||||||
|
</SyntaxOptions>
|
||||||
|
</Parsing>
|
||||||
|
<CodeGeneration>
|
||||||
|
<SmartLinkUnit Value="True"/>
|
||||||
|
<Generate Value="Faster"/>
|
||||||
|
<TargetCPU Value="i386"/>
|
||||||
|
<Optimizations>
|
||||||
|
<OptimizationLevel Value="3"/>
|
||||||
|
</Optimizations>
|
||||||
|
<TargetOS Value="Linux"/>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Linking>
|
||||||
|
<Debugging>
|
||||||
|
<UseLineInfoUnit Value="False"/>
|
||||||
|
<StripSymbols Value="True"/>
|
||||||
|
</Debugging>
|
||||||
|
<LinkSmart Value="True"/>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CustomOptions Value="-FE..\bin\
|
||||||
|
"/>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
</CONFIG>
|
||||||
|
|
@ -0,0 +1,53 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
program CentrED;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms, lnetvisual, LazOpenGLContext,
|
||||||
|
UdmNetwork, UfrmMain, UfrmLogin, UfrmInitialize, UfrmAccountControl,
|
||||||
|
virtualtreeview_package, UfrmEditAccount, UfrmDrawSettings, UfrmBoundaries,
|
||||||
|
UfrmElevateSettings, UOverlayUI, UResourceManager, UfrmConfirmation,
|
||||||
|
UfrmMoveSettings, UfrmAbout, UfrmHueSettings, UfrmRadar,
|
||||||
|
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
|
||||||
|
UGUIPlatformUtils, UPlatformTypes;
|
||||||
|
|
||||||
|
{$IFDEF Windows}
|
||||||
|
{$R *.res}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TdmNetwork, dmNetwork);
|
||||||
|
//Application.CreateForm(TfrmMain, frmMain);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,3 @@
|
||||||
|
Overlay/LeftTopArrow.tga
|
||||||
|
Overlay/TopArrow.tga
|
||||||
|
Overlay/VirtualLayer.tga
|
||||||
|
|
@ -0,0 +1,82 @@
|
||||||
|
object frmBoundaries: TfrmBoundaries
|
||||||
|
Left = 290
|
||||||
|
Height = 105
|
||||||
|
Top = 171
|
||||||
|
Width = 187
|
||||||
|
HorzScrollBar.Page = 186
|
||||||
|
VertScrollBar.Page = 104
|
||||||
|
ActiveControl = tbMinZ
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsToolWindow
|
||||||
|
Caption = 'Boundaries'
|
||||||
|
ClientHeight = 105
|
||||||
|
ClientWidth = 187
|
||||||
|
OnClose = FormClose
|
||||||
|
OnDeactivate = FormDeactivate
|
||||||
|
object lblMinZ: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 16
|
||||||
|
Top = 8
|
||||||
|
Width = 67
|
||||||
|
Caption = 'Minimum Z:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblMaxZ: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 16
|
||||||
|
Top = 56
|
||||||
|
Width = 68
|
||||||
|
Caption = 'Maximum Z:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object tbMinZ: TTrackBar
|
||||||
|
Left = 8
|
||||||
|
Height = 17
|
||||||
|
Top = 32
|
||||||
|
Width = 172
|
||||||
|
Frequency = 10
|
||||||
|
Max = 127
|
||||||
|
Min = -128
|
||||||
|
OnChange = tbMinZChange
|
||||||
|
PageSize = 1
|
||||||
|
Position = -128
|
||||||
|
ScalePos = trTop
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object tbMaxZ: TTrackBar
|
||||||
|
Left = 8
|
||||||
|
Height = 16
|
||||||
|
Top = 80
|
||||||
|
Width = 172
|
||||||
|
Frequency = 10
|
||||||
|
Max = 127
|
||||||
|
Min = -128
|
||||||
|
OnChange = tbMaxZChange
|
||||||
|
PageSize = 1
|
||||||
|
Position = 127
|
||||||
|
ScalePos = trTop
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object seMinZ: TSpinEdit
|
||||||
|
Left = 128
|
||||||
|
Height = 23
|
||||||
|
Top = 4
|
||||||
|
Width = 50
|
||||||
|
MaxValue = 127
|
||||||
|
MinValue = -128
|
||||||
|
OnChange = seMinZChange
|
||||||
|
TabOrder = 2
|
||||||
|
Value = -128
|
||||||
|
end
|
||||||
|
object seMaxZ: TSpinEdit
|
||||||
|
Left = 128
|
||||||
|
Height = 23
|
||||||
|
Top = 52
|
||||||
|
Width = 50
|
||||||
|
MaxValue = 127
|
||||||
|
MinValue = -128
|
||||||
|
OnChange = seMaxZChange
|
||||||
|
TabOrder = 3
|
||||||
|
Value = 127
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,107 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmBoundaries;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LMessages,
|
||||||
|
LCLIntf, StdCtrls, ComCtrls, Spin;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmBoundaries }
|
||||||
|
|
||||||
|
TfrmBoundaries = class(TForm)
|
||||||
|
lblMinZ: TLabel;
|
||||||
|
lblMaxZ: TLabel;
|
||||||
|
seMinZ: TSpinEdit;
|
||||||
|
seMaxZ: TSpinEdit;
|
||||||
|
tbMinZ: TTrackBar;
|
||||||
|
tbMaxZ: TTrackBar;
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormDeactivate(Sender: TObject);
|
||||||
|
procedure seMaxZChange(Sender: TObject);
|
||||||
|
procedure seMinZChange(Sender: TObject);
|
||||||
|
procedure tbMaxZChange(Sender: TObject);
|
||||||
|
procedure tbMinZChange(Sender: TObject);
|
||||||
|
protected
|
||||||
|
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmBoundaries: TfrmBoundaries;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TfrmBoundaries }
|
||||||
|
|
||||||
|
procedure TfrmBoundaries.FormClose(Sender: TObject;
|
||||||
|
var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmBoundaries.FormDeactivate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmBoundaries.seMaxZChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
tbMaxZ.Position := seMaxZ.Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmBoundaries.seMinZChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
tbMinZ.Position := seMinZ.Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmBoundaries.tbMaxZChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
seMaxZ.Value := tbMaxZ.Position;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmBoundaries.tbMinZChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
seMinZ.Value := tbMinZ.Position;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmBoundaries.MouseLeave(var msg: TLMessage);
|
||||||
|
begin
|
||||||
|
if not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)) then
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmBoundaries.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,35 @@
|
||||||
|
object frmConfirmation: TfrmConfirmation
|
||||||
|
Left = 290
|
||||||
|
Height = 43
|
||||||
|
Top = 171
|
||||||
|
Width = 108
|
||||||
|
HorzScrollBar.Page = 107
|
||||||
|
VertScrollBar.Page = 42
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsToolWindow
|
||||||
|
Caption = 'Apply?'
|
||||||
|
ClientHeight = 43
|
||||||
|
ClientWidth = 108
|
||||||
|
object btnYes: TButton
|
||||||
|
Left = 8
|
||||||
|
Height = 25
|
||||||
|
Top = 8
|
||||||
|
Width = 40
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = 'Yes'
|
||||||
|
Default = True
|
||||||
|
ModalResult = 6
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object btnNo: TButton
|
||||||
|
Left = 56
|
||||||
|
Height = 25
|
||||||
|
Top = 8
|
||||||
|
Width = 40
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Cancel = True
|
||||||
|
Caption = 'No'
|
||||||
|
ModalResult = 7
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,57 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmConfirmation;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmConfirmation }
|
||||||
|
|
||||||
|
TfrmConfirmation = class(TForm)
|
||||||
|
btnYes: TButton;
|
||||||
|
btnNo: TButton;
|
||||||
|
private
|
||||||
|
{ private declarations }
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmConfirmation: TfrmConfirmation;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmConfirmation.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,74 @@
|
||||||
|
object frmDrawSettings: TfrmDrawSettings
|
||||||
|
Left = 290
|
||||||
|
Height = 138
|
||||||
|
Top = 171
|
||||||
|
Width = 186
|
||||||
|
HorzScrollBar.Page = 185
|
||||||
|
VertScrollBar.Page = 137
|
||||||
|
ActiveControl = rbTileList
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsToolWindow
|
||||||
|
Caption = 'Draw settings'
|
||||||
|
ClientHeight = 138
|
||||||
|
ClientWidth = 186
|
||||||
|
FormStyle = fsStayOnTop
|
||||||
|
OnClose = FormClose
|
||||||
|
OnDeactivate = FormDeactivate
|
||||||
|
OnShow = FormShow
|
||||||
|
object rbTileList: TRadioButton
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 8
|
||||||
|
Width = 113
|
||||||
|
Caption = 'Use tile from the list'
|
||||||
|
Checked = True
|
||||||
|
State = cbChecked
|
||||||
|
TabOrder = 0
|
||||||
|
UseOnChange = True
|
||||||
|
end
|
||||||
|
object rbRandom: TRadioButton
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 32
|
||||||
|
Width = 164
|
||||||
|
Caption = 'Use tiles from the random pool'
|
||||||
|
TabOrder = 1
|
||||||
|
UseOnChange = True
|
||||||
|
end
|
||||||
|
object cbForceAltitude: TCheckBox
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 60
|
||||||
|
Width = 89
|
||||||
|
Caption = 'Force altitude:'
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object seForceAltitude: TSpinEdit
|
||||||
|
Left = 104
|
||||||
|
Height = 23
|
||||||
|
Top = 56
|
||||||
|
Width = 50
|
||||||
|
MaxValue = 127
|
||||||
|
MinValue = -128
|
||||||
|
OnChange = seForceAltitudeChange
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object gbHue: TGroupBox
|
||||||
|
Height = 49
|
||||||
|
Top = 88
|
||||||
|
Width = 185
|
||||||
|
Caption = 'Hue (Statics only)'
|
||||||
|
ClientHeight = 31
|
||||||
|
ClientWidth = 181
|
||||||
|
TabOrder = 4
|
||||||
|
object pbHue: TPaintBox
|
||||||
|
Cursor = crHandPoint
|
||||||
|
Left = 6
|
||||||
|
Height = 16
|
||||||
|
Top = 1
|
||||||
|
Width = 169
|
||||||
|
OnClick = pbHueClick
|
||||||
|
OnPaint = pbHuePaint
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,132 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmDrawSettings;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
Spin, ExtCtrls, LMessages, LCLIntf;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmDrawSettings }
|
||||||
|
|
||||||
|
TfrmDrawSettings = class(TForm)
|
||||||
|
cbForceAltitude: TCheckBox;
|
||||||
|
gbHue: TGroupBox;
|
||||||
|
pbHue: TPaintBox;
|
||||||
|
rbRandom: TRadioButton;
|
||||||
|
rbTileList: TRadioButton;
|
||||||
|
seForceAltitude: TSpinEdit;
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormDeactivate(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure pbHueClick(Sender: TObject);
|
||||||
|
procedure pbHuePaint(Sender: TObject);
|
||||||
|
procedure seForceAltitudeChange(Sender: TObject);
|
||||||
|
protected
|
||||||
|
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmDrawSettings: TfrmDrawSettings;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UGameResources, UHue, UfrmHueSettings;
|
||||||
|
|
||||||
|
{ TfrmDrawSettings }
|
||||||
|
|
||||||
|
procedure TfrmDrawSettings.FormClose(Sender: TObject;
|
||||||
|
var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmDrawSettings.FormDeactivate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if not frmHueSettings.Visible then
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmDrawSettings.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Left := Mouse.CursorPos.x - 8;
|
||||||
|
Top := Mouse.CursorPos.y - 8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
msg: TLMessage;
|
||||||
|
begin
|
||||||
|
frmHueSettings.Left := Mouse.CursorPos.x - 8;
|
||||||
|
frmHueSettings.Top := Mouse.CursorPos.y - 8;
|
||||||
|
frmHueSettings.ShowModal;
|
||||||
|
pbHue.Repaint;
|
||||||
|
MouseLeave(msg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
|
||||||
|
var
|
||||||
|
hue: THue;
|
||||||
|
begin
|
||||||
|
if frmHueSettings <> nil then
|
||||||
|
begin
|
||||||
|
if frmHueSettings.lbHue.ItemIndex > 0 then
|
||||||
|
hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
|
||||||
|
else
|
||||||
|
hue := nil;
|
||||||
|
TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect,
|
||||||
|
frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
cbForceAltitude.Checked := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmDrawSettings.MouseLeave(var msg: TLMessage);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
if (not frmHueSettings.Visible) and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
|
||||||
|
Close;
|
||||||
|
except
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmDrawSettings.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,52 @@
|
||||||
|
object frmElevateSettings: TfrmElevateSettings
|
||||||
|
Left = 290
|
||||||
|
Height = 59
|
||||||
|
Top = 171
|
||||||
|
Width = 131
|
||||||
|
HorzScrollBar.Page = 130
|
||||||
|
VertScrollBar.Page = 58
|
||||||
|
ActiveControl = rbRaise
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsToolWindow
|
||||||
|
Caption = 'Elevate'
|
||||||
|
ClientHeight = 59
|
||||||
|
ClientWidth = 131
|
||||||
|
OnClose = FormClose
|
||||||
|
OnDeactivate = FormDeactivate
|
||||||
|
object rbRaise: TRadioButton
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 8
|
||||||
|
Width = 49
|
||||||
|
Caption = 'Raise'
|
||||||
|
Checked = True
|
||||||
|
State = cbChecked
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object rbLower: TRadioButton
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 24
|
||||||
|
Width = 51
|
||||||
|
Caption = 'Lower'
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object seZ: TSpinEdit
|
||||||
|
Left = 72
|
||||||
|
Height = 23
|
||||||
|
Top = 20
|
||||||
|
Width = 50
|
||||||
|
MaxValue = 127
|
||||||
|
MinValue = -128
|
||||||
|
TabOrder = 3
|
||||||
|
Value = 1
|
||||||
|
end
|
||||||
|
object rbSet: TRadioButton
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 40
|
||||||
|
Width = 38
|
||||||
|
Caption = 'Set'
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,81 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmElevateSettings;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LMessages,
|
||||||
|
LCLIntf, StdCtrls, Spin;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmElevateSettings }
|
||||||
|
|
||||||
|
TfrmElevateSettings = class(TForm)
|
||||||
|
rbSet: TRadioButton;
|
||||||
|
rbRaise: TRadioButton;
|
||||||
|
rbLower: TRadioButton;
|
||||||
|
seZ: TSpinEdit;
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormDeactivate(Sender: TObject);
|
||||||
|
protected
|
||||||
|
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmElevateSettings: TfrmElevateSettings;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TfrmElevateSettings }
|
||||||
|
|
||||||
|
procedure TfrmElevateSettings.FormClose(Sender: TObject;
|
||||||
|
var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmElevateSettings.FormDeactivate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmElevateSettings.MouseLeave(var msg: TLMessage);
|
||||||
|
begin
|
||||||
|
if not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)) then
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmElevateSettings.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,374 @@
|
||||||
|
object frmFilter: TfrmFilter
|
||||||
|
Left = 290
|
||||||
|
Height = 491
|
||||||
|
Top = 171
|
||||||
|
Width = 236
|
||||||
|
HorzScrollBar.Page = 235
|
||||||
|
VertScrollBar.Page = 490
|
||||||
|
ActiveControl = rgFilterType
|
||||||
|
BorderIcons = [biSystemMenu, biMinimize]
|
||||||
|
BorderStyle = bsToolWindow
|
||||||
|
Caption = 'Filter'
|
||||||
|
ClientHeight = 491
|
||||||
|
ClientWidth = 236
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnShow = FormShow
|
||||||
|
object rgFilterType: TRadioGroup
|
||||||
|
Left = 4
|
||||||
|
Height = 40
|
||||||
|
Top = 4
|
||||||
|
Width = 228
|
||||||
|
Align = alTop
|
||||||
|
AutoFill = True
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
Caption = 'Filter rule'
|
||||||
|
ChildSizing.LeftRightSpacing = 6
|
||||||
|
ChildSizing.TopBottomSpacing = 6
|
||||||
|
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||||
|
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||||
|
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||||
|
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||||
|
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||||
|
ChildSizing.ControlsPerLine = 2
|
||||||
|
ClientHeight = 18
|
||||||
|
ClientWidth = 222
|
||||||
|
Columns = 2
|
||||||
|
ItemIndex = 0
|
||||||
|
Items.Strings = (
|
||||||
|
'Exclusive'
|
||||||
|
'Inclusive'
|
||||||
|
)
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object GroupBox1: TGroupBox
|
||||||
|
Left = 4
|
||||||
|
Height = 258
|
||||||
|
Top = 48
|
||||||
|
Width = 228
|
||||||
|
Align = alClient
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
Caption = 'Tile filter'
|
||||||
|
ClientHeight = 236
|
||||||
|
ClientWidth = 222
|
||||||
|
TabOrder = 1
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 4
|
||||||
|
Height = 25
|
||||||
|
Top = 32
|
||||||
|
Width = 214
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object vdtFilter: TVirtualDrawTree
|
||||||
|
Tag = 1
|
||||||
|
Left = 4
|
||||||
|
Height = 145
|
||||||
|
Top = 61
|
||||||
|
Width = 214
|
||||||
|
Align = alClient
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
BorderStyle = bsSingle
|
||||||
|
DefaultNodeHeight = 44
|
||||||
|
DragType = dtVCL
|
||||||
|
Header.Options = [hoColumnResize, hoDrag, hoVisible]
|
||||||
|
Header.Style = hsFlatButtons
|
||||||
|
TabOrder = 0
|
||||||
|
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||||
|
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
|
||||||
|
OnDragOver = vdtFilterDragOver
|
||||||
|
OnDragDrop = vdtFilterDragDrop
|
||||||
|
OnDrawNode = vdtFilterDrawNode
|
||||||
|
Columns = <
|
||||||
|
item
|
||||||
|
WideText = 'ID'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Position = 1
|
||||||
|
Width = 44
|
||||||
|
WideText = 'Tile'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Position = 2
|
||||||
|
Width = 100
|
||||||
|
WideText = 'Name'
|
||||||
|
end>
|
||||||
|
end
|
||||||
|
object pnlControls: TPanel
|
||||||
|
Left = 4
|
||||||
|
Height = 22
|
||||||
|
Top = 210
|
||||||
|
Width = 214
|
||||||
|
Align = alBottom
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 22
|
||||||
|
ClientWidth = 214
|
||||||
|
TabOrder = 1
|
||||||
|
object btnDelete: TSpeedButton
|
||||||
|
Left = 84
|
||||||
|
Height = 22
|
||||||
|
Hint = 'Delete'
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
810900002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A223136203136203131332032222C0A222E2E2063204E6F
|
||||||
|
6E65222C0A222E2C20632023444436413638222C0A222E2D2063202344433634
|
||||||
|
3633222C0A222E2A20632023444136343631222C0A222E612063202344393633
|
||||||
|
3544222C0A222E6220632023444636413641222C0A222E632063202345443933
|
||||||
|
3845222C0A222E6420632023463843334245222C0A222E652063202346394433
|
||||||
|
4343222C0A222E6620632023463943424334222C0A222E672063202346344234
|
||||||
|
4141222C0A222E6820632023453237303636222C0A222E692063202344313545
|
||||||
|
3533222C0A222E6A20632023453036393641222C0A222E6B2063202346324144
|
||||||
|
4141222C0A222E6C20632023464444434438222C0A222E6D2063202346414241
|
||||||
|
4145222C0A222E6E20632023464141333931222C0A222E6F2063202346413944
|
||||||
|
3842222C0A222E7020632023464241393943222C0A222E712063202346434337
|
||||||
|
4241222C0A222E7220632023453937423730222C0A222E732063202343433542
|
||||||
|
3443222C0A222E7420632023463341374133222C0A222E752063202346444442
|
||||||
|
4434222C0A222E7620632023464139413837222C0A222E772063202346303931
|
||||||
|
3746222C0A222E7820632023463138453741222C0A222E792063202346383934
|
||||||
|
3746222C0A222E7A20632023463939323745222C0A222E412063202346383843
|
||||||
|
3736222C0A222E4220632023463842364138222C0A222E432063202345333645
|
||||||
|
3633222C0A222E4420632023433735373435222C0A222E452063202345413833
|
||||||
|
3744222C0A222E4620632023464344344344222C0A222E472063202346373933
|
||||||
|
3745222C0A222E4820632023454538413735222C0A222E492063202346363834
|
||||||
|
3643222C0A222E4A20632023463337393633222C0A222E4B2063202346384146
|
||||||
|
4134222C0A222E4C20632023443034463345222C0A222E4D2063202344453641
|
||||||
|
3637222C0A222E4E20632023463541464135222C0A222E4F2063202346414142
|
||||||
|
3944222C0A222E5020632023463038433737222C0A222E512063202345433546
|
||||||
|
3534222C0A222E5220632023463237373633222C0A222E532063202346343845
|
||||||
|
3831222C0A222E5420632023453937463738222C0A222E552063202343303533
|
||||||
|
3341222C0A222E5620632023444236393634222C0A222E572063202346394239
|
||||||
|
4146222C0A222E5820632023464139333746222C0A222E592063202346303835
|
||||||
|
3730222C0A222E5A20632023464646464646222C0A222E302063202345393539
|
||||||
|
3444222C0A222E3120632023454536413545222C0A222E322063202346313944
|
||||||
|
3936222C0A222E3320632023424534463336222C0A222E342063202344413633
|
||||||
|
3546222C0A222E3520632023463741424131222C0A222E362063202346383836
|
||||||
|
3730222C0A222E3720632023463638323638222C0A222E382063202345413636
|
||||||
|
3543222C0A222E3920632023463139433936222C0A222E402063202342433530
|
||||||
|
3332222C0A222E2320632023443736323543222C0A222E3B2063202345453843
|
||||||
|
3831222C0A222E3A20632023463739313745222C0A222E3D2063202346333733
|
||||||
|
3544222C0A222E2B20632023453935423446222C0A222E252063202346303833
|
||||||
|
3742222C0A222E2420632023453237423735222C0A222E282063202342413442
|
||||||
|
3245222C0A222E2920632023444235363442222C0A222E5B2063202346364142
|
||||||
|
4132222C0A222E5D20632023463036343536222C0A222C2E2063202345453636
|
||||||
|
3532222C0A222C2C20632023453635383443222C0A222C2D2063202345363541
|
||||||
|
3532222C0A222C2A20632023463541333946222C0A222C612063202343343530
|
||||||
|
3334222C0A222C6220632023434636313533222C0A222C632063202345333642
|
||||||
|
3631222C0A222C6420632023463541434131222C0A222C652063202345413543
|
||||||
|
3530222C0A222C6620632023453635393445222C0A222C672063202345363536
|
||||||
|
3443222C0A222C6820632023453635363530222C0A222C692063202346344132
|
||||||
|
3945222C0A222C6A20632023443636303534222C0A222C6B2063202342383441
|
||||||
|
3241222C0A222C6C20632023434235393439222C0A222C6D2063202345303635
|
||||||
|
3543222C0A222C6E20632023463541364131222C0A222C6F2063202345463836
|
||||||
|
3745222C0A222C7020632023453936333542222C0A222C712063202345373544
|
||||||
|
3539222C0A222C7220632023454538343744222C0A222C732063202346344130
|
||||||
|
3945222C0A222C7420632023443735443531222C0A222C752063202342373441
|
||||||
|
3242222C0A222C7620632023433635353432222C0A222C772063202343433532
|
||||||
|
3343222C0A222C7820632023453837413735222C0A222C792063202345453932
|
||||||
|
3846222C0A222C7A20632023453437383731222C0A222C412063202343313444
|
||||||
|
3333222C0A222C4220632023424535333338222C0A222C432063202342443531
|
||||||
|
3335222C0A222C4420632023424334423330222C0A222C452063202342383445
|
||||||
|
3245222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2C2E2D2E2A2E612E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E622E632E642E652E66
|
||||||
|
2E672E682E692E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E6A2E6B2E6C2E6D
|
||||||
|
2E6E2E6F2E702E712E722E732E2E2E2E2E2E222C0A222E2E2E2E2E6A2E742E75
|
||||||
|
2E762E772E782E792E7A2E412E422E432E442E2E2E2E222C0A222E2E2E2E2E45
|
||||||
|
2E462E6F2E472E482E492E492E492E492E4A2E4B2E4C2E2E2E2E222C0A222E2E
|
||||||
|
2E4D2E4E2E4F2E502E512E512E512E512E512E512E522E532E542E552E2E222C
|
||||||
|
0A222E2E2E562E572E582E592E5A2E5A2E5A2E5A2E5A2E5A2E302E312E322E33
|
||||||
|
2E2E222C0A222E2E2E342E352E362E372E5A2E5A2E5A2E5A2E5A2E5A2E302E38
|
||||||
|
2E392E402E2E222C0A222E2E2E232E3B2E3A2E3D2E302E302E302E302E302E30
|
||||||
|
2E2B2E252E242E282E2E222C0A222E2E2E2E2E292E5B2E5D2C2E2E302E302E30
|
||||||
|
2E302C2C2C2D2C2A2C612E2E2E2E222C0A222E2E2E2E2C622C632C642E512C65
|
||||||
|
2E302C662C672C682C692C6A2C6B2E2E2E2E222C0A222E2E2E2E2E2E2C6C2C6D
|
||||||
|
2C6E2C6F2C702C712C722C732C742C752E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2C762C772C782C792C792C7A2C412C752E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2C422C432C442C452E2E2E2E2E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E227D0A
|
||||||
|
}
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnDeleteClick
|
||||||
|
ShowHint = True
|
||||||
|
ParentShowHint = False
|
||||||
|
end
|
||||||
|
object btnClear: TSpeedButton
|
||||||
|
Left = 108
|
||||||
|
Height = 22
|
||||||
|
Hint = 'Clear'
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
F10800002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A223136203136203130342032222C0A222E2E2063204E6F
|
||||||
|
6E65222C0A222E2C20632023464630303030222C0A222E2D2063202346443030
|
||||||
|
3030222C0A222E2A20632023464632423236222C0A222E612063202346463639
|
||||||
|
3543222C0A222E6220632023464636383542222C0A222E632063202346453637
|
||||||
|
3541222C0A222E6420632023464536353538222C0A222E652063202346453633
|
||||||
|
3536222C0A222E6620632023464536313534222C0A222E672063202346433237
|
||||||
|
3232222C0A222E6820632023464230303030222C0A222E692063202346463641
|
||||||
|
3544222C0A222E6A20632023464634373433222C0A222E6B2063202346453334
|
||||||
|
3334222C0A222E6C20632023464533323332222C0A222E6D2063202346443330
|
||||||
|
3330222C0A222E6E20632023464432443244222C0A222E6F2063202346433343
|
||||||
|
3338222C0A222E7020632023464335443446222C0A222E712063202346413235
|
||||||
|
3146222C0A222E7220632023463730303030222C0A222E732063202346463542
|
||||||
|
3538222C0A222E7420632023464643464346222C0A222E752063202346453532
|
||||||
|
3532222C0A222E7620632023464432463246222C0A222E772063202346443243
|
||||||
|
3243222C0A222E7820632023464334423442222C0A222E792063202346454343
|
||||||
|
4343222C0A222E7A20632023464234433438222C0A222E412063202346423537
|
||||||
|
3439222C0A222E4220632023463932333144222C0A222E432063202346353030
|
||||||
|
3030222C0A222E4420632023464534373433222C0A222E452063202346464633
|
||||||
|
4633222C0A222E4620632023464645444544222C0A222E472063202346433443
|
||||||
|
3443222C0A222E4820632023464334413441222C0A222E492063202346464543
|
||||||
|
4543222C0A222E4A20632023464646324632222C0A222E4B2063202346454341
|
||||||
|
4341222C0A222E4C20632023464132463241222C0A222E4D2063202346413531
|
||||||
|
3432222C0A222E4E20632023463330303030222C0A222E4F2063202346453333
|
||||||
|
3333222C0A222E5020632023464435303530222C0A222E512063202346454543
|
||||||
|
4543222C0A222E5220632023464133453345222C0A222E532063202346383137
|
||||||
|
3137222C0A222E5420632023463934453346222C0A222E552063202346313030
|
||||||
|
3030222C0A222E5620632023464536343537222C0A222E572063202346393344
|
||||||
|
3344222C0A222E5820632023463831363136222C0A222E592063202346373133
|
||||||
|
3133222C0A222E5A20632023463834423343222C0A222E302063202346453632
|
||||||
|
3535222C0A222E3120632023464332393239222C0A222E322063202346433438
|
||||||
|
3438222C0A222E3320632023463933413341222C0A222E342063202346373132
|
||||||
|
3132222C0A222E3520632023463630463046222C0A222E362063202346383438
|
||||||
|
3338222C0A222E3720632023464435463532222C0A222E382063202346433238
|
||||||
|
3238222C0A222E3920632023464334373437222C0A222E402063202346464631
|
||||||
|
4631222C0A222E2320632023464545414541222C0A222E3B2063202346373334
|
||||||
|
3334222C0A222E3A20632023463530423042222C0A222E3D2063202346383435
|
||||||
|
3335222C0A222E2B20632023454630303030222C0A222E252063202346443544
|
||||||
|
3446222C0A222E2420632023464233373332222C0A222E282063202346454342
|
||||||
|
4342222C0A222E2920632023464545424542222C0A222E5B2063202346393342
|
||||||
|
3342222C0A222E5D20632023463833393339222C0A222C2E2063202346454631
|
||||||
|
4631222C0A222C2C20632023464443354335222C0A222C2D2063202346363144
|
||||||
|
3138222C0A222C2A20632023463734333333222C0A222C612063202346393030
|
||||||
|
3030222C0A222C6220632023464235383441222C0A222C632063202346423437
|
||||||
|
3432222C0A222C6420632023464443394339222C0A222C652063202346363130
|
||||||
|
3130222C0A222C6620632023463733333333222C0A222C672063202346373335
|
||||||
|
3330222C0A222C6820632023463734343334222C0A222C692063202346323142
|
||||||
|
3134222C0A222C6A20632023454430303030222C0A222C6B2063202346413533
|
||||||
|
3434222C0A222C6C20632023463932393234222C0A222C6D2063202346353043
|
||||||
|
3043222C0A222C6E20632023463530393039222C0A222C6F2063202346353142
|
||||||
|
3136222C0A222C7020632023463131423134222C0A222C712063202346353230
|
||||||
|
3141222C0A222C7220632023463934433343222C0A222C732063202346383439
|
||||||
|
3341222C0A222C7420632023463834373338222C0A222C752063202346373433
|
||||||
|
3334222C0A222C7620632023463734323332222C0A222E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2E2C2E2C2E2C2E2C2E2D2E2D2E2D2E2D2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2C2E2A2E612E622E632E642E652E662E672E682E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2C2E2A2E692E6A2E6B2E6C2E6D2E6E2E6F2E702E712E722E2E
|
||||||
|
2E2E222C0A222E2E2E2C2E2A2E692E732E742E752E762E772E782E792E7A2E41
|
||||||
|
2E422E432E2E222C0A222E2E2E2C2E622E442E742E452E462E472E482E492E4A
|
||||||
|
2E4B2E4C2E4D2E4E2E2E222C0A222E2E2E2C2E632E4F2E502E462E452E462E46
|
||||||
|
2E4A2E512E522E532E542E552E2E222C0A222E2E2E2D2E562E6D2E6E2E782E46
|
||||||
|
2E4A2E4A2E492E572E582E592E5A2E552E2E222C0A222E2E2E2D2E302E772E31
|
||||||
|
2E322E462E4A2E4A2E512E332E342E352E362E552E2E222C0A222E2E2E2D2E37
|
||||||
|
2E382E392E492E4A2E492E512E402E232E3B2E3A2E3D2E2B2E2E222C0A222E2E
|
||||||
|
2E682E252E242E282E4A2E292E5B2E5D2E232C2E2C2C2C2D2C2A2E2B2E2E222C
|
||||||
|
0A222E2E2C612E712C622C632C642E5B2E592C652C662C2C2C672C682C692C6A
|
||||||
|
2E2E222C0A222E2E2E2E2E722E422C6B2C6C2E342E352C6D2C6E2C6F2C2A2C70
|
||||||
|
2C6A2E2E2E2E222C0A222E2E2E2E2E2E2E432C712C722C732C742E3D2C752C76
|
||||||
|
2C702C6A2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E552E552E552E552E2B
|
||||||
|
2E2B2C6A2C6A2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnClearClick
|
||||||
|
ShowHint = True
|
||||||
|
ParentShowHint = False
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object cbTileFilter: TCheckBox
|
||||||
|
Left = 4
|
||||||
|
Height = 24
|
||||||
|
Top = 4
|
||||||
|
Width = 214
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
Caption = 'Filter active'
|
||||||
|
Checked = True
|
||||||
|
State = cbChecked
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object GroupBox2: TGroupBox
|
||||||
|
Left = 4
|
||||||
|
Height = 168
|
||||||
|
Top = 319
|
||||||
|
Width = 228
|
||||||
|
Align = alBottom
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
Caption = 'Hue filter'
|
||||||
|
ClientHeight = 146
|
||||||
|
ClientWidth = 222
|
||||||
|
TabOrder = 2
|
||||||
|
object cbHueFilter: TCheckBox
|
||||||
|
Left = 4
|
||||||
|
Height = 24
|
||||||
|
Top = 4
|
||||||
|
Width = 214
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
Caption = 'Filter active'
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object vdtHues: TVirtualDrawTree
|
||||||
|
Left = 4
|
||||||
|
Height = 110
|
||||||
|
Top = 32
|
||||||
|
Width = 214
|
||||||
|
Align = alClient
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
BorderStyle = bsSingle
|
||||||
|
Header.AutoSizeIndex = 2
|
||||||
|
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
|
||||||
|
Header.Style = hsFlatButtons
|
||||||
|
PopupMenu = pmHues
|
||||||
|
TabOrder = 1
|
||||||
|
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
|
||||||
|
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||||
|
TreeOptions.SelectionOptions = [toFullRowSelect]
|
||||||
|
OnChecked = vdtHuesChecked
|
||||||
|
OnDrawNode = vdtHuesDrawNode
|
||||||
|
Columns = <
|
||||||
|
item
|
||||||
|
Width = 20
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Position = 1
|
||||||
|
Width = 38
|
||||||
|
WideText = 'Hue'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Position = 2
|
||||||
|
Width = 156
|
||||||
|
WideText = 'Name'
|
||||||
|
end>
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object Splitter1: TSplitter
|
||||||
|
Cursor = crVSplit
|
||||||
|
Height = 5
|
||||||
|
Top = 310
|
||||||
|
Width = 236
|
||||||
|
Align = alBottom
|
||||||
|
ResizeAnchor = akBottom
|
||||||
|
end
|
||||||
|
object pmHues: TPopupMenu
|
||||||
|
left = 148
|
||||||
|
top = 404
|
||||||
|
object mnuCheckHues: TMenuItem
|
||||||
|
Caption = 'Check all hues'
|
||||||
|
OnClick = mnuCheckHuesClick
|
||||||
|
end
|
||||||
|
object mnuUncheckHues: TMenuItem
|
||||||
|
Caption = 'Uncheck all hues'
|
||||||
|
OnClick = mnuUncheckHuesClick
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,325 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmFilter;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
ExtCtrls, VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes, UStatics,
|
||||||
|
PairSplitter, Menus;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmFilter }
|
||||||
|
|
||||||
|
TfrmFilter = class(TForm)
|
||||||
|
btnClear: TSpeedButton;
|
||||||
|
btnDelete: TSpeedButton;
|
||||||
|
btnRandomPresetDelete: TSpeedButton;
|
||||||
|
btnRandomPresetSave: TSpeedButton;
|
||||||
|
cbRandomPreset: TComboBox;
|
||||||
|
cbTileFilter: TCheckBox;
|
||||||
|
cbHueFilter: TCheckBox;
|
||||||
|
GroupBox1: TGroupBox;
|
||||||
|
GroupBox2: TGroupBox;
|
||||||
|
Label1: TLabel;
|
||||||
|
mnuUncheckHues: TMenuItem;
|
||||||
|
mnuCheckHues: TMenuItem;
|
||||||
|
pnlControls: TPanel;
|
||||||
|
pnlRandomPreset: TPanel;
|
||||||
|
pmHues: TPopupMenu;
|
||||||
|
rgFilterType: TRadioGroup;
|
||||||
|
Splitter1: TSplitter;
|
||||||
|
vdtFilter: TVirtualDrawTree;
|
||||||
|
vdtHues: TVirtualDrawTree;
|
||||||
|
procedure btnClearClick(Sender: TObject);
|
||||||
|
procedure btnDeleteClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure mnuUncheckHuesClick(Sender: TObject);
|
||||||
|
procedure mnuCheckHuesClick(Sender: TObject);
|
||||||
|
procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
|
||||||
|
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
|
||||||
|
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
|
||||||
|
procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
|
||||||
|
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
|
||||||
|
var Effect: Integer; var Accept: Boolean);
|
||||||
|
procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
|
||||||
|
const PaintInfo: TVTPaintInfo);
|
||||||
|
procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||||
|
procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
|
||||||
|
const PaintInfo: TVTPaintInfo);
|
||||||
|
protected
|
||||||
|
FLocked: Boolean;
|
||||||
|
FCheckedHues: TBits;
|
||||||
|
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||||
|
public
|
||||||
|
property Locked: Boolean read FLocked write FLocked;
|
||||||
|
function Filter(AStatic: TStaticItem): Boolean;
|
||||||
|
procedure JumpToHue(AHueID: Word);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmFilter: TfrmFilter;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
PTileInfo = ^TTileInfo;
|
||||||
|
TTileInfo = record
|
||||||
|
ID: Word;
|
||||||
|
end;
|
||||||
|
PHueInfo = ^THueInfo;
|
||||||
|
THueInfo = record
|
||||||
|
ID: Word;
|
||||||
|
Hue: THue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TfrmFilter }
|
||||||
|
|
||||||
|
procedure TfrmFilter.FormShow(Sender: TObject);
|
||||||
|
var
|
||||||
|
upperLeft, lowerLeft: TPoint;
|
||||||
|
begin
|
||||||
|
upperLeft := frmMain.pnlMain.ClientToScreen(Point(0, 0));
|
||||||
|
lowerLeft := frmMain.pnlMain.ClientToScreen(Point(0, frmMain.pnlMain.Height));
|
||||||
|
Left := upperLeft.x;
|
||||||
|
Top := upperLeft.y;
|
||||||
|
Height := lowerLeft.y - upperLeft.y;
|
||||||
|
|
||||||
|
SetWindowParent(Handle, frmMain.Handle);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtHues.ClearChecked;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
begin
|
||||||
|
node := vdtHues.GetFirst;
|
||||||
|
while node <> nil do
|
||||||
|
begin
|
||||||
|
vdtHues.CheckState[node] := csCheckedNormal;
|
||||||
|
node := vdtHues.GetNext(node);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
|
||||||
|
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
|
||||||
|
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
|
||||||
|
var
|
||||||
|
sourceTree: TVirtualDrawTree;
|
||||||
|
selected, node: PVirtualNode;
|
||||||
|
sourceTileInfo, targetTileInfo: PTileInfo;
|
||||||
|
begin
|
||||||
|
sourceTree := Source as TVirtualDrawTree;
|
||||||
|
if (sourceTree <> Sender) and (sourceTree <> nil) and
|
||||||
|
(sourceTree.Tag = 1) then
|
||||||
|
begin
|
||||||
|
Sender.BeginUpdate;
|
||||||
|
selected := sourceTree.GetFirstSelected;
|
||||||
|
while selected <> nil do
|
||||||
|
begin
|
||||||
|
sourceTileInfo := sourceTree.GetNodeData(selected);
|
||||||
|
if sourceTileInfo^.ID > $3FFF then
|
||||||
|
begin
|
||||||
|
node := Sender.AddChild(nil);
|
||||||
|
targetTileInfo := Sender.GetNodeData(node);
|
||||||
|
targetTileInfo^.ID := sourceTileInfo^.ID;
|
||||||
|
end;
|
||||||
|
selected := sourceTree.GetNextSelected(selected);
|
||||||
|
end;
|
||||||
|
Sender.EndUpdate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
|
||||||
|
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
|
||||||
|
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
|
||||||
|
begin
|
||||||
|
if (Source <> Sender) and (Source is TVirtualDrawTree) and
|
||||||
|
(TVirtualDrawTree(Source).Tag = 1) then
|
||||||
|
begin
|
||||||
|
Accept := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
|
||||||
|
const PaintInfo: TVTPaintInfo);
|
||||||
|
begin
|
||||||
|
frmMain.vdtTilesDrawNode(Sender, PaintInfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||||
|
var
|
||||||
|
hueInfo: PHueInfo;
|
||||||
|
begin
|
||||||
|
hueInfo := Sender.GetNodeData(Node);
|
||||||
|
FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
|
||||||
|
const PaintInfo: TVTPaintInfo);
|
||||||
|
var
|
||||||
|
hueInfo: PHueInfo;
|
||||||
|
hueColor: TColor;
|
||||||
|
i: Integer;
|
||||||
|
textStyle: TTextStyle;
|
||||||
|
begin
|
||||||
|
hueInfo := Sender.GetNodeData(PaintInfo.Node);
|
||||||
|
textStyle := PaintInfo.Canvas.TextStyle;
|
||||||
|
textStyle.Alignment := taLeftJustify;
|
||||||
|
textStyle.Layout := tlCenter;
|
||||||
|
textStyle.Wordbreak := True;
|
||||||
|
case PaintInfo.Column of
|
||||||
|
1:
|
||||||
|
begin
|
||||||
|
for i := 0 to 31 do
|
||||||
|
begin
|
||||||
|
hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
|
||||||
|
PaintInfo.Canvas.Pen.Color := hueColor;
|
||||||
|
PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
|
||||||
|
PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
2:
|
||||||
|
begin
|
||||||
|
PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.MouseLeave(var msg: TLMessage);
|
||||||
|
begin
|
||||||
|
{if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
|
||||||
|
Close;}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
|
||||||
|
var
|
||||||
|
found: Boolean;
|
||||||
|
tileInfo: PTileInfo;
|
||||||
|
node: PVirtualNode;
|
||||||
|
id: Word;
|
||||||
|
begin
|
||||||
|
if cbTileFilter.Checked then
|
||||||
|
begin
|
||||||
|
id := AStatic.TileID + $4000;
|
||||||
|
|
||||||
|
found := False;
|
||||||
|
node := vdtFilter.GetFirst;
|
||||||
|
while (node <> nil) and (not found) do
|
||||||
|
begin
|
||||||
|
tileInfo := vdtFilter.GetNodeData(node);
|
||||||
|
if tileInfo^.ID = id then
|
||||||
|
found := True
|
||||||
|
else
|
||||||
|
node := vdtFilter.GetNext(node);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
|
||||||
|
((rgFilterType.ItemIndex = 1) and found);
|
||||||
|
end else
|
||||||
|
Result := True;
|
||||||
|
|
||||||
|
if cbHueFilter.Checked then
|
||||||
|
begin
|
||||||
|
Result := Result and (
|
||||||
|
((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
|
||||||
|
((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
|
||||||
|
);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.JumpToHue(AHueID: Word);
|
||||||
|
var
|
||||||
|
hueInfo: PHueInfo;
|
||||||
|
node: PVirtualNode;
|
||||||
|
begin
|
||||||
|
node := vdtHues.GetFirst;
|
||||||
|
while node <> nil do
|
||||||
|
begin
|
||||||
|
hueInfo := vdtHues.GetNodeData(node);
|
||||||
|
if hueInfo^.ID = AHueID then
|
||||||
|
begin
|
||||||
|
vdtHues.ClearSelection;
|
||||||
|
vdtHues.Selected[node] := True;
|
||||||
|
vdtHues.FocusedNode := node;
|
||||||
|
node := nil;
|
||||||
|
end else
|
||||||
|
node := vdtHues.GetNext(node);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.FormCreate(Sender: TObject);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
hueInfo: PHueInfo;
|
||||||
|
node: PVirtualNode;
|
||||||
|
begin
|
||||||
|
FLocked := False;
|
||||||
|
vdtFilter.NodeDataSize := SizeOf(TTileInfo);
|
||||||
|
vdtHues.NodeDataSize := SizeOf(THueInfo);
|
||||||
|
|
||||||
|
vdtHues.BeginUpdate;
|
||||||
|
vdtHues.Clear;
|
||||||
|
for i := 0 to ResMan.Hue.Count - 1 do
|
||||||
|
begin
|
||||||
|
node := vdtHues.AddChild(nil);
|
||||||
|
hueInfo := vdtHues.GetNodeData(node);
|
||||||
|
hueInfo^.ID := i + 1;
|
||||||
|
hueInfo^.Hue := ResMan.Hue.Hues[i];
|
||||||
|
vdtHues.CheckType[node] := ctCheckBox;
|
||||||
|
end;
|
||||||
|
vdtHues.EndUpdate;
|
||||||
|
FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
|
||||||
|
//FCheckedHues.Bits[0] := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.btnDeleteClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtFilter.DeleteSelectedNodes;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmFilter.btnClearClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtFilter.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmFilter.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,45 @@
|
||||||
|
object frmHueSettings: TfrmHueSettings
|
||||||
|
Left = 290
|
||||||
|
Height = 207
|
||||||
|
Top = 171
|
||||||
|
Width = 217
|
||||||
|
HorzScrollBar.Page = 216
|
||||||
|
VertScrollBar.Page = 206
|
||||||
|
ActiveControl = lbHue
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsToolWindow
|
||||||
|
Caption = 'Hue Settings'
|
||||||
|
ClientHeight = 207
|
||||||
|
ClientWidth = 217
|
||||||
|
FormStyle = fsStayOnTop
|
||||||
|
OnClose = FormClose
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDeactivate = FormDeactivate
|
||||||
|
object lblHue: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 16
|
||||||
|
Top = 12
|
||||||
|
Width = 26
|
||||||
|
Caption = 'Hue:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lbHue: TListBox
|
||||||
|
Left = 8
|
||||||
|
Height = 160
|
||||||
|
Top = 40
|
||||||
|
Width = 200
|
||||||
|
ItemHeight = 16
|
||||||
|
OnDrawItem = lbHueDrawItem
|
||||||
|
OnSelectionChange = lbHueSelectionChange
|
||||||
|
Style = lbOwnerDrawFixed
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object edHue: TEdit
|
||||||
|
Left = 48
|
||||||
|
Height = 23
|
||||||
|
Top = 10
|
||||||
|
Width = 80
|
||||||
|
OnEditingDone = edHueEditingDone
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,156 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmHueSettings;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
LMessages, LCLIntf, UHue;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmHueSettings }
|
||||||
|
|
||||||
|
TfrmHueSettings = class(TForm)
|
||||||
|
edHue: TEdit;
|
||||||
|
lblHue: TLabel;
|
||||||
|
lbHue: TListBox;
|
||||||
|
procedure edHueEditingDone(Sender: TObject);
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDeactivate(Sender: TObject);
|
||||||
|
procedure lbHueDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
|
||||||
|
State: TOwnerDrawState);
|
||||||
|
procedure lbHueSelectionChange(Sender: TObject; User: boolean);
|
||||||
|
protected
|
||||||
|
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||||
|
public
|
||||||
|
class procedure DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
|
||||||
|
ACaption: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmHueSettings: TfrmHueSettings;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UGameResources, UGraphicHelper;
|
||||||
|
|
||||||
|
{ TfrmHueSettings }
|
||||||
|
|
||||||
|
procedure TfrmHueSettings.FormClose(Sender: TObject;
|
||||||
|
var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmHueSettings.edHueEditingDone(Sender: TObject);
|
||||||
|
var
|
||||||
|
hueID: Integer;
|
||||||
|
begin
|
||||||
|
if (not TryStrToInt(edHue.Text, hueID)) or (hueID >= lbHue.Items.Count) then
|
||||||
|
begin
|
||||||
|
edHue.Text := Format('$%x', [lbHue.ItemIndex]);
|
||||||
|
MessageDlg('Invalid Hue', 'The hue you''ve entered is invalid.', mtWarning, [mbOK], 0);
|
||||||
|
end else
|
||||||
|
lbHue.ItemIndex := hueID;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmHueSettings.FormCreate(Sender: TObject);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
hue: THue;
|
||||||
|
begin
|
||||||
|
lbHue.Clear;
|
||||||
|
lbHue.Items.Add('$0 (no hue)');
|
||||||
|
for i := 1 to ResMan.Hue.Count do
|
||||||
|
begin
|
||||||
|
hue := ResMan.Hue.Hues[i-1];
|
||||||
|
lbHue.Items.AddObject(Format('$%x (%s)', [i, hue.Name]), hue);
|
||||||
|
end;
|
||||||
|
lbHue.ItemIndex := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmHueSettings.FormDeactivate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmHueSettings.lbHueDrawItem(Control: TWinControl; Index: Integer;
|
||||||
|
ARect: TRect; State: TOwnerDrawState);
|
||||||
|
var
|
||||||
|
hue: THue;
|
||||||
|
begin
|
||||||
|
if Index > 0 then
|
||||||
|
hue := ResMan.Hue.Hues[Index-1]
|
||||||
|
else
|
||||||
|
hue := nil;
|
||||||
|
DrawHue(hue, lbHue.Canvas, ARect, lbHue.Items.Strings[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmHueSettings.lbHueSelectionChange(Sender: TObject; User: boolean);
|
||||||
|
begin
|
||||||
|
edHue.Text := Format('$%x', [lbHue.ItemIndex]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmHueSettings.MouseLeave(var msg: TLMessage);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
if not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)) then
|
||||||
|
Close;
|
||||||
|
except
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TfrmHueSettings.DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
|
||||||
|
ACaption: string);
|
||||||
|
var
|
||||||
|
hueColor: TColor;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
ACanvas.Pen.Color := clWhite;
|
||||||
|
ACanvas.Rectangle(ARect);
|
||||||
|
if AHue <> nil then
|
||||||
|
for i := 0 to 31 do
|
||||||
|
begin
|
||||||
|
hueColor := ARGB2RGB(AHue.ColorTable[i]);
|
||||||
|
ACanvas.Pen.Color := hueColor;
|
||||||
|
ACanvas.MoveTo(ARect.Left + 2 + i, ARect.Top + 1);
|
||||||
|
ACanvas.LineTo(ARect.Left + 2 + i, ARect.Bottom - 1);
|
||||||
|
end;
|
||||||
|
ACanvas.TextOut(ARect.Left + 36, ARect.Top, ACaption);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmHueSettings.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,259 @@
|
||||||
|
object frmMoveSettings: TfrmMoveSettings
|
||||||
|
Left = 290
|
||||||
|
Height = 125
|
||||||
|
Top = 171
|
||||||
|
Width = 228
|
||||||
|
HorzScrollBar.Page = 227
|
||||||
|
VertScrollBar.Page = 124
|
||||||
|
ActiveControl = cbAsk
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsToolWindow
|
||||||
|
Caption = 'Move settings'
|
||||||
|
ClientHeight = 125
|
||||||
|
ClientWidth = 228
|
||||||
|
FormStyle = fsStayOnTop
|
||||||
|
OnClose = FormClose
|
||||||
|
OnDeactivate = FormDeactivate
|
||||||
|
OnShow = FormShow
|
||||||
|
object cbAsk: TCheckBox
|
||||||
|
Left = 128
|
||||||
|
Height = 15
|
||||||
|
Top = 16
|
||||||
|
Width = 89
|
||||||
|
Caption = 'Ask each time'
|
||||||
|
Checked = True
|
||||||
|
State = cbChecked
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object gbDirection: TGroupBox
|
||||||
|
Left = 8
|
||||||
|
Height = 112
|
||||||
|
Top = 8
|
||||||
|
Width = 105
|
||||||
|
ClientHeight = 94
|
||||||
|
ClientWidth = 101
|
||||||
|
TabOrder = 1
|
||||||
|
object btnTopLeft: TSpeedButton
|
||||||
|
Left = 6
|
||||||
|
Height = 22
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Down = True
|
||||||
|
Glyph.Data = {
|
||||||
|
8D0100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E6522
|
||||||
|
2C0A222C20632023343034303430222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C
|
||||||
|
2C2C2C2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2C2E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2C2C2C2C2C2E2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2C2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2C2C2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2C2C2E2C2C2C2C2C2E2E2E2E2E2E222C0A222E2E2C2E2E2E2C2C2C2C2C2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2C2C2C2C2C2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2C2C2C2C2C2E2E2E222C0A222E2E2E2E2E2E2E2E2E2C2C2C2C2C2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E2E2C2C2C2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
GroupIndex = 1
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnTopLeftClick
|
||||||
|
end
|
||||||
|
object btnTop: TSpeedButton
|
||||||
|
Left = 38
|
||||||
|
Height = 22
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
8D0100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E6522
|
||||||
|
2C0A222C20632023343034303430222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2C2C2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2E2E2C2C2C2C2C2C2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2C2C2C2C2C2C2C2C2E2E2E2E222C0A222E2E2E2C2C2C2C2C2C2C
|
||||||
|
2C2C2C2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
GroupIndex = 1
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnTopLeftClick
|
||||||
|
end
|
||||||
|
object btnTopRight: TSpeedButton
|
||||||
|
Left = 70
|
||||||
|
Height = 22
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
8D0100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E6522
|
||||||
|
2C0A222C20632023343034303430222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2C2C2C2C2C2C2C2E2E222C0A222E2E2E2E2E2E2E2E2C2C2C2C2C2C2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E2C2C2C2C2C2E2E222C0A222E2E2E2E2E2E2E2E2C2C
|
||||||
|
2C2C2C2C2E2E222C0A222E2E2E2E2E2E2E2C2C2C2C2C2C2C2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2C2C2C2C2C2E2C2C2E2E222C0A222E2E2E2E2E2C2C2C2C2C2E2E2E2C
|
||||||
|
2E2E222C0A222E2E2E2E2C2C2C2C2C2E2E2E2E2E2E2E222C0A222E2E2E2C2C2C
|
||||||
|
2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2E2E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2C2C2C2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2C2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
GroupIndex = 1
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnTopLeftClick
|
||||||
|
end
|
||||||
|
object btnRight: TSpeedButton
|
||||||
|
Left = 70
|
||||||
|
Height = 22
|
||||||
|
Top = 32
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
8D0100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E6522
|
||||||
|
2C0A222C20632023343034303430222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2C2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E2E2C2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E
|
||||||
|
2C2C2C2E2E2E222C0A222E2E2C2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A222E2E
|
||||||
|
2C2C2C2C2C2C2C2C2C2C2C2C2C2E222C0A222E2E2C2C2C2C2C2C2C2C2C2C2C2C
|
||||||
|
2C2E222C0A222E2E2C2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2E2E2C2C2C2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2C2C2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E2E2C2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
GroupIndex = 1
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnTopLeftClick
|
||||||
|
end
|
||||||
|
object btnBottomRight: TSpeedButton
|
||||||
|
Left = 70
|
||||||
|
Height = 22
|
||||||
|
Top = 64
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
8D0100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E6522
|
||||||
|
2C0A222C20632023343034303430222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2C2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2C2C2C2E2E2E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2C2C2C2C2C2E2E2E2E2E2E2E2E2E222C0A222E2E2E2C2C2C2C2C2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2C2C2C2C2C2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2C2C2C2C2C2E2E2E2C2E2E222C0A222E2E2E2E2E2E2C2C2C2C2C2E2C2C
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2C2C2C2C2C2C2C2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2C2C2C2C2C2C2E2E222C0A222E2E2E2E2E2E2E2E2E2C2C2C2C2C2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2C2C2C2C2C2C2E2E222C0A222E2E2E2E2E2E2E2C2C2C
|
||||||
|
2C2C2C2C2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
GroupIndex = 1
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnTopLeftClick
|
||||||
|
end
|
||||||
|
object btnBottom: TSpeedButton
|
||||||
|
Left = 38
|
||||||
|
Height = 22
|
||||||
|
Top = 64
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
8D0100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E6522
|
||||||
|
2C0A222C20632023343034303430222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2C2C2C2C2E2E2E2E2E2E222C0A222E2E2E2C2C2C
|
||||||
|
2C2C2C2C2C2C2C2E2E2E222C0A222E2E2E2E2C2C2C2C2C2C2C2C2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2C2C2C2C2C2C2E2E2E2E2E222C0A222E2E2E2E2E2E2C2C2C2C
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2C2C2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
GroupIndex = 1
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnTopLeftClick
|
||||||
|
end
|
||||||
|
object btnBottomLeft: TSpeedButton
|
||||||
|
Left = 6
|
||||||
|
Height = 22
|
||||||
|
Top = 64
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
8D0100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E6522
|
||||||
|
2C0A222C20632023343034303430222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2C2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2C2C2C2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E2C2C2C2C2C2E2E222C0A222E2E2E2E2E2E2E2E2C2C
|
||||||
|
2C2C2C2E2E2E222C0A222E2E2E2E2E2E2E2C2C2C2C2C2E2E2E2E222C0A222E2E
|
||||||
|
2C2E2E2E2C2C2C2C2C2E2E2E2E2E222C0A222E2E2C2C2E2C2C2C2C2C2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2C2C2C2C2C2C2C2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C
|
||||||
|
2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2E2E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2C2C2C2C2C2C2E2E2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2C2C2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
GroupIndex = 1
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnTopLeftClick
|
||||||
|
end
|
||||||
|
object btnLeft: TSpeedButton
|
||||||
|
Left = 6
|
||||||
|
Height = 22
|
||||||
|
Top = 32
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
8D0100002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A22313620313620322031222C0A222E2063204E6F6E6522
|
||||||
|
2C0A222C20632023343034303430222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2C2E2E2E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2C2C2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2C2C2C2E2E2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2C2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A222E2C
|
||||||
|
2C2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A222E2C2C2C2C2C2C2C2C2C2C2C2C2C
|
||||||
|
2E2E222C0A222E2E2C2C2C2C2C2C2C2C2C2C2C2C2E2E222C0A222E2E2E2C2C2C
|
||||||
|
2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2C2C2E2E2E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2C2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
GroupIndex = 1
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnTopLeftClick
|
||||||
|
end
|
||||||
|
object seOffset: TSpinEdit
|
||||||
|
Left = 33
|
||||||
|
Height = 23
|
||||||
|
Hint = 'Offset'
|
||||||
|
Top = 32
|
||||||
|
Width = 34
|
||||||
|
MaxValue = 8
|
||||||
|
MinValue = 1
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 0
|
||||||
|
Value = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object btnCancel: TButton
|
||||||
|
Left = 128
|
||||||
|
Height = 25
|
||||||
|
Top = 88
|
||||||
|
Width = 89
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Cancel = True
|
||||||
|
Caption = 'Cancel'
|
||||||
|
ModalResult = 2
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,152 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmMoveSettings;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
Buttons, Spin, LMessages, LCLIntf, math;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmMoveSettings }
|
||||||
|
|
||||||
|
TfrmMoveSettings = class(TForm)
|
||||||
|
btnCancel: TButton;
|
||||||
|
cbAsk: TCheckBox;
|
||||||
|
gbDirection: TGroupBox;
|
||||||
|
btnTopLeft: TSpeedButton;
|
||||||
|
btnTop: TSpeedButton;
|
||||||
|
btnTopRight: TSpeedButton;
|
||||||
|
btnRight: TSpeedButton;
|
||||||
|
btnBottomRight: TSpeedButton;
|
||||||
|
btnBottom: TSpeedButton;
|
||||||
|
btnBottomLeft: TSpeedButton;
|
||||||
|
btnLeft: TSpeedButton;
|
||||||
|
seOffset: TSpinEdit;
|
||||||
|
procedure btnTopLeftClick(Sender: TObject);
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormDeactivate(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
protected
|
||||||
|
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||||
|
public
|
||||||
|
function GetOffsetX: Integer;
|
||||||
|
function GetOffsetY: Integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmMoveSettings: TfrmMoveSettings;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UdmNetwork, UfrmMain, UEnums;
|
||||||
|
|
||||||
|
{ TfrmMoveSettings }
|
||||||
|
|
||||||
|
procedure TfrmMoveSettings.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMoveSettings.FormDeactivate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if not (fsModal in FormState) then
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMoveSettings.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
btnCancel.Visible := (fsModal in FormState);
|
||||||
|
if dmNetwork.AccessLevel = alAdministrator then
|
||||||
|
seOffset.MaxValue := Max(frmMain.Landscape.CellWidth, frmMain.Landscape.CellHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMoveSettings.MouseLeave(var msg: TLMessage);
|
||||||
|
begin
|
||||||
|
if Visible and (not (fsModal in FormState)) and
|
||||||
|
(not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TfrmMoveSettings.GetOffsetX: Integer;
|
||||||
|
begin
|
||||||
|
if btnTopLeft.Down then
|
||||||
|
Result := -seOffset.Value
|
||||||
|
else if btnTop.Down then
|
||||||
|
Result := -seOffset.Value
|
||||||
|
else if btnTopRight.Down then
|
||||||
|
Result := 0
|
||||||
|
else if btnRight.Down then
|
||||||
|
Result := seOffset.Value
|
||||||
|
else if btnBottomRight.Down then
|
||||||
|
Result := seOffset.Value
|
||||||
|
else if btnBottom.Down then
|
||||||
|
Result := seOffset.Value
|
||||||
|
else if btnBottomLeft.Down then
|
||||||
|
Result := 0
|
||||||
|
else if btnLeft.Down then
|
||||||
|
Result := -seOffset.Value
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TfrmMoveSettings.GetOffsetY: Integer;
|
||||||
|
begin
|
||||||
|
if btnTopLeft.Down then
|
||||||
|
Result := 0
|
||||||
|
else if btnTop.Down then
|
||||||
|
Result := -seOffset.Value
|
||||||
|
else if btnTopRight.Down then
|
||||||
|
Result := -seOffset.Value
|
||||||
|
else if btnRight.Down then
|
||||||
|
Result := -seOffset.Value
|
||||||
|
else if btnBottomRight.Down then
|
||||||
|
Result := 0
|
||||||
|
else if btnBottom.Down then
|
||||||
|
Result := seOffset.Value
|
||||||
|
else if btnBottomLeft.Down then
|
||||||
|
Result := seOffset.Value
|
||||||
|
else if btnLeft.Down then
|
||||||
|
Result := seOffset.Value
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMoveSettings.btnTopLeftClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ModalResult := mrYes;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmMoveSettings.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,46 @@
|
||||||
|
object frmVirtualLayer: TfrmVirtualLayer
|
||||||
|
Left = 290
|
||||||
|
Height = 73
|
||||||
|
Top = 171
|
||||||
|
Width = 178
|
||||||
|
HorzScrollBar.Page = 177
|
||||||
|
VertScrollBar.Page = 72
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsToolWindow
|
||||||
|
Caption = 'Virtual Layer'
|
||||||
|
ClientHeight = 73
|
||||||
|
ClientWidth = 178
|
||||||
|
OnClose = FormClose
|
||||||
|
OnDeactivate = FormDeactivate
|
||||||
|
object seZ: TSpinEdit
|
||||||
|
Left = 120
|
||||||
|
Height = 23
|
||||||
|
Top = 8
|
||||||
|
Width = 50
|
||||||
|
MaxValue = 127
|
||||||
|
MinValue = -128
|
||||||
|
OnChange = seZChange
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object cbShowLayer: TCheckBox
|
||||||
|
Left = 11
|
||||||
|
Height = 15
|
||||||
|
Top = 12
|
||||||
|
Width = 103
|
||||||
|
Caption = 'Show Layer at Z:'
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object tbZ: TTrackBar
|
||||||
|
Left = 8
|
||||||
|
Height = 33
|
||||||
|
Top = 32
|
||||||
|
Width = 162
|
||||||
|
Frequency = 10
|
||||||
|
Max = 127
|
||||||
|
Min = -128
|
||||||
|
OnChange = tbZChange
|
||||||
|
PageSize = 1
|
||||||
|
ScalePos = trTop
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,92 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmVirtualLayer;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LCLIntf,
|
||||||
|
LMessages, StdCtrls, Spin, ComCtrls;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmVirtualLayer }
|
||||||
|
|
||||||
|
TfrmVirtualLayer = class(TForm)
|
||||||
|
cbShowLayer: TCheckBox;
|
||||||
|
seZ: TSpinEdit;
|
||||||
|
tbZ: TTrackBar;
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormDeactivate(Sender: TObject);
|
||||||
|
procedure seZChange(Sender: TObject);
|
||||||
|
procedure tbZChange(Sender: TObject);
|
||||||
|
protected
|
||||||
|
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmVirtualLayer: TfrmVirtualLayer;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TfrmVirtualLayer }
|
||||||
|
|
||||||
|
procedure TfrmVirtualLayer.FormClose(Sender: TObject;
|
||||||
|
var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmVirtualLayer.FormDeactivate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmVirtualLayer.seZChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
tbZ.Position := seZ.Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmVirtualLayer.tbZChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
seZ.Value := tbZ.Position;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmVirtualLayer.MouseLeave(var msg: TLMessage);
|
||||||
|
begin
|
||||||
|
if not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)) then
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmVirtualLayer.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,96 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UAdminHandling;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream, UEnums;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TFlushServerPacket }
|
||||||
|
|
||||||
|
TFlushServerPacket = class(TPacket)
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TQuitServerPacket }
|
||||||
|
|
||||||
|
TQuitServerPacket = class(TPacket)
|
||||||
|
constructor Create(AReason: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
|
||||||
|
var
|
||||||
|
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
var
|
||||||
|
packetHandler: TPacketHandler;
|
||||||
|
begin
|
||||||
|
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
|
||||||
|
if packetHandler <> nil then
|
||||||
|
packetHandler.Process(ABuffer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFlushServerPacket }
|
||||||
|
|
||||||
|
constructor TFlushServerPacket.Create;
|
||||||
|
begin
|
||||||
|
inherited Create($03, 0);
|
||||||
|
FStream.WriteByte($01);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TQuitServerPacket }
|
||||||
|
|
||||||
|
constructor TQuitServerPacket.Create(AReason: string);
|
||||||
|
begin
|
||||||
|
inherited Create($03, 0);
|
||||||
|
FStream.WriteByte($02);
|
||||||
|
FStream.WriteStringNull(AReason);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$WARNINGS OFF}
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
for i := 0 to $FF do
|
||||||
|
AdminPacketHandlers[i] := nil;
|
||||||
|
finalization
|
||||||
|
for i := 0 to $FF do
|
||||||
|
if AdminPacketHandlers[i] <> nil then
|
||||||
|
AdminPacketHandlers[i].Free;
|
||||||
|
{$WARNINGS ON}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,52 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UGUIPlatformUtils;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils
|
||||||
|
{$IFDEF LCLWin32}, windows{$ENDIF}
|
||||||
|
{$IFDEF LCLGtk}, gtk{$ENDIF};
|
||||||
|
|
||||||
|
procedure SetWindowParent(AHandle, AParent: THANDLE);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure SetWindowParent(AHandle, AParent: THANDLE);
|
||||||
|
begin
|
||||||
|
{$IFDEF LCLWin32}
|
||||||
|
SetWindowLong(AHandle, GWL_HWNDPARENT, AParent);
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF LCLGtk}
|
||||||
|
gtk_window_set_transient_for(PGtkWindow(AHandle), PGtkWindow(AParent));
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,120 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UGameResources;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, UArtProvider, UTileDataProvider, UTexmapProvider,
|
||||||
|
ULandscape, {URadarProvider,} UHueProvider;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TGameResourceManager }
|
||||||
|
|
||||||
|
TGameResourceManager = class(TObject)
|
||||||
|
constructor Create(ADataDir: string);
|
||||||
|
destructor Destroy; override;
|
||||||
|
protected
|
||||||
|
FDataDir: string;
|
||||||
|
FArtProvider: TArtProvider;
|
||||||
|
FTiledataProvider: TTiledataProvider;
|
||||||
|
FTexmapProvider: TTexmapProvider;
|
||||||
|
//FRadarProvider: TRadarProvider;
|
||||||
|
FHueProvider: THueProvider;
|
||||||
|
|
||||||
|
FLandscape: TLandscape;
|
||||||
|
public
|
||||||
|
procedure InitLandscape(AWidth, AHeight: Word);
|
||||||
|
function GetFile(AFileName: string): string;
|
||||||
|
|
||||||
|
property Art: TArtProvider read FArtProvider;
|
||||||
|
property Tiledata: TTiledataProvider read FTiledataProvider;
|
||||||
|
property Texmaps: TTexmapProvider read FTexmapProvider;
|
||||||
|
//property Radar: TRadarProvider read FRadarProvider;
|
||||||
|
property Hue: THueProvider read FHueProvider;
|
||||||
|
property Landscape: TLandscape read FLandscape;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
GameResourceManager: TGameResourceManager;
|
||||||
|
ResMan: TGameResourceManager absolute GameResourceManager;
|
||||||
|
|
||||||
|
procedure InitGameResourceManager(ADataDir: string);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure InitGameResourceManager(ADataDir: string);
|
||||||
|
begin
|
||||||
|
if GameResourceManager <> nil then FreeAndNil(GameResourceManager);
|
||||||
|
GameResourceManager := TGameResourceManager.Create(ADataDir);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TGameResourceManager }
|
||||||
|
|
||||||
|
constructor TGameResourceManager.Create(ADataDir: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FDataDir := IncludeTrailingPathDelimiter(ADataDir);
|
||||||
|
|
||||||
|
FArtProvider := TArtProvider.Create(GetFile('art.mul'), GetFile('artidx.mul'), True);
|
||||||
|
FTiledataProvider := TTiledataProvider.Create(GetFile('tiledata.mul'), True);
|
||||||
|
FTexmapProvider := TTexmapProvider.Create(GetFile('texmaps.mul'), GetFile('texidx.mul'), True);
|
||||||
|
//FRadarProvider := TRadarProvider.Create(GetFile('radarcol.mul'));
|
||||||
|
FHueProvider := THueProvider.Create(GetFile('hues.mul'), True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TGameResourceManager.Destroy;
|
||||||
|
begin
|
||||||
|
if FArtProvider <> nil then FreeAndNil(FArtProvider);
|
||||||
|
if FTiledataProvider <> nil then FreeAndNil(FTiledataProvider);
|
||||||
|
if FTexmapProvider <> nil then FreeAndNil(FTexmapProvider);
|
||||||
|
//if FRadarProvider <> nil then FreeAndNil(FRadarProvider);
|
||||||
|
if FHueProvider <> nil then FreeAndNil(FHueProvider);
|
||||||
|
if FLandscape <> nil then FreeAndNil(FLandscape);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGameResourceManager.GetFile(AFileName: string): string;
|
||||||
|
begin
|
||||||
|
Result := FDataDir + AFileName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word);
|
||||||
|
begin
|
||||||
|
if FLandscape <> nil then FreeAndNil(FLandscape);
|
||||||
|
FLandscape := TLandscape.Create(AWidth, AHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
begin
|
||||||
|
if GameResourceManager <> nil then FreeAndNil(GameResourceManager);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,246 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UOverlayUI;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Gl, GLU, ImagingTypes, ImagingClasses, ImagingOpenGL,
|
||||||
|
OpenGLContext, ImagingUtility;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TGLArrow }
|
||||||
|
|
||||||
|
TGLArrow = class(TObject)
|
||||||
|
constructor Create(AGraphic: TSingleImage);
|
||||||
|
destructor Destroy; override;
|
||||||
|
protected
|
||||||
|
FGraphic: TSingleImage;
|
||||||
|
FTexture: GLuint;
|
||||||
|
FRealWidth: Integer;
|
||||||
|
FRealHeight: Integer;
|
||||||
|
FWidth: Integer;
|
||||||
|
FHeight: Integer;
|
||||||
|
FCurrentX: Integer;
|
||||||
|
FCurrentY: Integer;
|
||||||
|
procedure UpdateTexture;
|
||||||
|
public
|
||||||
|
property Width: Integer read FWidth;
|
||||||
|
property Height: Integer read FHeight;
|
||||||
|
property CurrentX: Integer read FCurrentX;
|
||||||
|
property CurrentY: Integer read FCurrentY;
|
||||||
|
|
||||||
|
function HitTest(AX, AY: Integer): Boolean;
|
||||||
|
procedure DrawGL(AX, AY: Integer; AActive: Boolean = False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TOverlayUI }
|
||||||
|
|
||||||
|
TOverlayUI = class(TObject)
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
protected
|
||||||
|
FArrows: array[0..7] of TGLArrow;
|
||||||
|
FActiveArrow: Integer;
|
||||||
|
FVisible: Boolean;
|
||||||
|
public
|
||||||
|
property ActiveArrow: Integer read FActiveArrow write FActiveArrow;
|
||||||
|
property Visible: Boolean read FVisible write FVisible;
|
||||||
|
function HitTest(AX, AY: Integer): Integer;
|
||||||
|
procedure Draw(AContext: TOpenGLControl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UResourceManager;
|
||||||
|
|
||||||
|
{ TGLArrow }
|
||||||
|
|
||||||
|
constructor TGLArrow.Create(AGraphic: TSingleImage);
|
||||||
|
var
|
||||||
|
caps: TGLTextureCaps;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FRealWidth := AGraphic.Width;
|
||||||
|
FRealHeight := AGraphic.Height;
|
||||||
|
GetGLTextureCaps(caps);
|
||||||
|
if caps.PowerOfTwo then
|
||||||
|
begin
|
||||||
|
if IsPow2(FRealWidth) then FWidth := FRealWidth else FWidth := NextPow2(FRealWidth);
|
||||||
|
if IsPow2(FRealHeight) then FHeight := FRealHeight else FHeight := NextPow2(FRealHeight);
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
FWidth := FRealHeight;
|
||||||
|
FHeight := FRealHeight;
|
||||||
|
end;
|
||||||
|
FGraphic := TSingleImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8);
|
||||||
|
AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0);
|
||||||
|
FTexture := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TGLArrow.Destroy;
|
||||||
|
begin
|
||||||
|
if FGraphic <> nil then FreeAndNil(FGraphic);
|
||||||
|
if FTexture <> 0 then glDeleteTextures(1, @FTexture);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TGLArrow.UpdateTexture;
|
||||||
|
begin
|
||||||
|
if (FGraphic <> nil) and (FRealWidth > 0) and (FRealWidth > 0) then
|
||||||
|
begin
|
||||||
|
FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False);
|
||||||
|
|
||||||
|
glBindTexture(GL_TEXTURE_2D, FTexture);
|
||||||
|
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
|
||||||
|
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
|
||||||
|
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
|
||||||
|
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGLArrow.HitTest(AX, AY: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
if (AX > -1) and (AX < FRealWidth) and (AY > -1) and (AY < FRealHeight) then
|
||||||
|
begin
|
||||||
|
Result := (FGraphic <> nil) and (Cardinal(PIntegerArray(FGraphic.Bits)^[AY * FWidth + AX] and $FF000000) > 0);
|
||||||
|
end else
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TGLArrow.DrawGL(AX, AY: Integer; AActive: Boolean = False);
|
||||||
|
begin
|
||||||
|
FCurrentX := AX;
|
||||||
|
FCurrentY := AY;
|
||||||
|
|
||||||
|
if FTexture = 0 then UpdateTexture;
|
||||||
|
|
||||||
|
if FTexture <> 0 then
|
||||||
|
begin
|
||||||
|
if AActive then
|
||||||
|
begin
|
||||||
|
glEnable(GL_COLOR_LOGIC_OP);
|
||||||
|
glLogicOp(GL_COPY_INVERTED);
|
||||||
|
end;
|
||||||
|
|
||||||
|
glBindTexture(GL_TEXTURE_2D, FTexture);
|
||||||
|
glBegin(GL_QUADS);
|
||||||
|
glTexCoord2f(0, 0); glVertex2d(AX, AY);
|
||||||
|
glTexCoord2f(1, 0); glVertex2d(AX + FWidth, AY);
|
||||||
|
glTexCoord2f(1, 1); glVertex2d(AX + FWidth, AY + FHeight);
|
||||||
|
glTexCoord2f(0, 1); glVertex2d(AX, AY + FHeight);
|
||||||
|
glEnd;
|
||||||
|
|
||||||
|
if AActive then
|
||||||
|
glDisable(GL_COLOR_LOGIC_OP);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TOverlayUI }
|
||||||
|
|
||||||
|
constructor TOverlayUI.Create;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
arrow: TSingleImage;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FActiveArrow := -1;
|
||||||
|
FVisible := False;
|
||||||
|
|
||||||
|
arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(0));
|
||||||
|
for i := 0 to 3 do
|
||||||
|
begin
|
||||||
|
FArrows[2*i] := TGLArrow.Create(arrow);
|
||||||
|
arrow.Rotate(-90);
|
||||||
|
end;
|
||||||
|
arrow.Free;
|
||||||
|
arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(1));
|
||||||
|
for i := 0 to 3 do
|
||||||
|
begin
|
||||||
|
FArrows[2*i+1] := TGLArrow.Create(arrow);
|
||||||
|
arrow.Rotate(-90);
|
||||||
|
end;
|
||||||
|
arrow.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TOverlayUI.Destroy;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
for i := 0 to 7 do
|
||||||
|
if FArrows[i] <> nil then FreeAndNil(FArrows[i]);
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TOverlayUI.HitTest(AX, AY: Integer): Integer;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
i := 0;
|
||||||
|
while (i <= 7) and (Result = -1) do
|
||||||
|
begin
|
||||||
|
if FArrows[i].HitTest(AX - FArrows[i].CurrentX, AY - FArrows[i].CurrentY) then
|
||||||
|
Result := i;
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TOverlayUI.Draw(AContext: TOpenGLControl);
|
||||||
|
begin
|
||||||
|
if FVisible then
|
||||||
|
begin
|
||||||
|
FArrows[0].DrawGL(10, 10, FActiveArrow = 0);
|
||||||
|
FArrows[1].DrawGL(AContext.Width div 2 - FArrows[1].Width div 2, 10,
|
||||||
|
FActiveArrow = 1);
|
||||||
|
FArrows[2].DrawGL(AContext.Width - 10 - FArrows[2].Width, 10,
|
||||||
|
FActiveArrow = 2);
|
||||||
|
|
||||||
|
FArrows[3].DrawGL(AContext.Width - 10 - FArrows[3].Width,
|
||||||
|
AContext.Height div 2 - FArrows[3].Height div 2,
|
||||||
|
FActiveArrow = 3);
|
||||||
|
|
||||||
|
FArrows[4].DrawGL(AContext.Width - 10 - FArrows[4].Width,
|
||||||
|
AContext.Height - 10 - FArrows[4].Height,
|
||||||
|
FActiveArrow = 4);
|
||||||
|
FArrows[5].DrawGL(AContext.Width div 2 - FArrows[5].Width div 2,
|
||||||
|
AContext.Height - 10 - FArrows[5].Height,
|
||||||
|
FActiveArrow = 5);
|
||||||
|
FArrows[6].DrawGL(10, AContext.Height - 10 - FArrows[6].Height,
|
||||||
|
FActiveArrow = 6);
|
||||||
|
|
||||||
|
FArrows[7].DrawGL(10, AContext.Height div 2 - FArrows[7].Height div 2,
|
||||||
|
FActiveArrow = 7);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,150 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UPacketHandlers;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, dzlib, UEnhancedMemoryStream;
|
||||||
|
|
||||||
|
type
|
||||||
|
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream);
|
||||||
|
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream) of object;
|
||||||
|
|
||||||
|
{ TPacketHandler }
|
||||||
|
|
||||||
|
TPacketHandler = class(TObject)
|
||||||
|
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
|
||||||
|
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
|
||||||
|
procedure Process(ABuffer: TEnhancedMemoryStream);
|
||||||
|
protected
|
||||||
|
FLength: Cardinal;
|
||||||
|
FPacketProcessor: TPacketProcessor;
|
||||||
|
FPacketProcessorMethod: TPacketProcessorMethod;
|
||||||
|
published
|
||||||
|
property PacketLength: Cardinal read FLength;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
PacketHandlers: array[0..$FF] of TPacketHandler;
|
||||||
|
|
||||||
|
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UPackets, UAdminHandling;
|
||||||
|
|
||||||
|
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
|
||||||
|
begin
|
||||||
|
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
|
||||||
|
PacketHandlers[AID] := APacketHandler;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPacketHandler }
|
||||||
|
|
||||||
|
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FLength := ALength;
|
||||||
|
FPacketProcessor := APacketProcessor;
|
||||||
|
FPacketProcessorMethod := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPacketHandler.Create(ALength: Cardinal;
|
||||||
|
APacketProcessorMethod: TPacketProcessorMethod);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FLength := ALength;
|
||||||
|
FPacketProcessor := nil;
|
||||||
|
FPacketProcessorMethod := APacketProcessorMethod;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream);
|
||||||
|
begin
|
||||||
|
if Assigned(FPacketProcessor) then
|
||||||
|
FPacketProcessor(ABuffer)
|
||||||
|
else if Assigned(FPacketProcessorMethod) then
|
||||||
|
FPacketProcessorMethod(ABuffer);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
var
|
||||||
|
uncompStream: TEnhancedMemoryStream;
|
||||||
|
uncompBuffer: TDecompressionStream;
|
||||||
|
targetSize: Cardinal;
|
||||||
|
packetID: Byte;
|
||||||
|
begin
|
||||||
|
//writeln('compressed size: ', ABuffer.Size);
|
||||||
|
targetSize := ABuffer.ReadCardinal;
|
||||||
|
//writeln('uncompressed size: ', targetSize);
|
||||||
|
uncompBuffer := TDecompressionStream.Create(ABuffer);
|
||||||
|
uncompStream := TEnhancedMemoryStream.Create;
|
||||||
|
try
|
||||||
|
uncompStream.CopyFrom(uncompBuffer, targetSize);
|
||||||
|
uncompStream.Position := 0;
|
||||||
|
packetID := uncompStream.ReadByte;
|
||||||
|
if PacketHandlers[packetID] <> nil then
|
||||||
|
begin
|
||||||
|
if PacketHandlers[PacketID].PacketLength = 0 then
|
||||||
|
uncompStream.Position := uncompStream.Position + 4;
|
||||||
|
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
|
||||||
|
PacketHandlers[PacketID].Process(uncompStream);
|
||||||
|
uncompStream.Unlock;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
{Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
|
||||||
|
ANetState.Socket.Disconnect;
|
||||||
|
ANetState.ReceiveQueue.Clear;}
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
if uncompBuffer <> nil then uncompBuffer.Free;
|
||||||
|
if uncompStream <> nil then uncompStream.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$WARNINGS OFF}
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
for i := 0 to $FF do
|
||||||
|
PacketHandlers[i] := nil;
|
||||||
|
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
|
||||||
|
//$02 --> ConnectionHandling, done by TdmNetwork
|
||||||
|
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);;
|
||||||
|
//$04 --> handled by TLandscape
|
||||||
|
//$06-$0B --> handled by TLandscape
|
||||||
|
//$0C --> ClientHandling, done by TfrmMain
|
||||||
|
//$0D --> RadarMapHandling, done by TfrmRadarMap
|
||||||
|
finalization
|
||||||
|
for i := 0 to $FF do
|
||||||
|
if PacketHandlers[i] <> nil then
|
||||||
|
PacketHandlers[i].Free;
|
||||||
|
{$WARNINGS ON}
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,330 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UPackets;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, dzlib, UEnhancedMemoryStream, UPacket, UMap, UStatics;
|
||||||
|
|
||||||
|
type
|
||||||
|
TBlockCoords = packed record
|
||||||
|
X: Word;
|
||||||
|
Y: Word;
|
||||||
|
end;
|
||||||
|
TBlockCoordsArray = array of TBlockCoords;
|
||||||
|
|
||||||
|
{ TCompressedPacket }
|
||||||
|
|
||||||
|
TCompressedPacket = class(TPacket)
|
||||||
|
constructor Create(APacket: TPacket);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TLoginRequestPacket }
|
||||||
|
|
||||||
|
TLoginRequestPacket = class(TPacket)
|
||||||
|
constructor Create(AUsername, APassword: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TQuitPacket }
|
||||||
|
|
||||||
|
TQuitPacket = class(TPacket)
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRequestBlocksPacket }
|
||||||
|
|
||||||
|
TRequestBlocksPacket = class(TPacket)
|
||||||
|
constructor Create(ACoords: TBlockCoordsArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFreeBlockPacket }
|
||||||
|
|
||||||
|
TFreeBlockPacket = class(TPacket)
|
||||||
|
constructor Create(AX, AY: Word);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TDrawMapPacket }
|
||||||
|
|
||||||
|
TDrawMapPacket = class(TPacket)
|
||||||
|
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TInsertStaticPacket }
|
||||||
|
|
||||||
|
TInsertStaticPacket = class(TPacket)
|
||||||
|
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TDeleteStaticPacket }
|
||||||
|
|
||||||
|
TDeleteStaticPacket = class(TPacket)
|
||||||
|
constructor Create(AStaticItem: TStaticItem);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TElevateStaticPacket }
|
||||||
|
|
||||||
|
TElevateStaticPacket = class(TPacket)
|
||||||
|
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMoveStaticPacket }
|
||||||
|
|
||||||
|
TMoveStaticPacket = class(TPacket)
|
||||||
|
constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ THueStaticPacket }
|
||||||
|
|
||||||
|
THueStaticPacket = class(TPacket)
|
||||||
|
constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TUpdateClientPosPacket }
|
||||||
|
|
||||||
|
TUpdateClientPosPacket = class(TPacket)
|
||||||
|
constructor Create(AX, AY: Word);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TChatMessagePacket }
|
||||||
|
|
||||||
|
TChatMessagePacket = class(TPacket)
|
||||||
|
constructor Create(AMessage: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TGotoClientPosPacket }
|
||||||
|
|
||||||
|
TGotoClientPosPacket = class(TPacket)
|
||||||
|
constructor Create(AUsername: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRequestRadarChecksumPacket }
|
||||||
|
|
||||||
|
TRequestRadarChecksumPacket = class(TPacket)
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRequestRadarMapPacket }
|
||||||
|
|
||||||
|
TRequestRadarMapPacket = class(TPacket)
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TNoOpPacket }
|
||||||
|
|
||||||
|
TNoOpPacket = class(TPacket)
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TCompressedPacket }
|
||||||
|
|
||||||
|
constructor TCompressedPacket.Create(APacket: TPacket);
|
||||||
|
var
|
||||||
|
compBuffer: TEnhancedMemoryStream;
|
||||||
|
compStream: TCompressionStream;
|
||||||
|
sourceStream: TStream;
|
||||||
|
begin
|
||||||
|
inherited Create($01, 0);
|
||||||
|
compBuffer := TEnhancedMemoryStream.Create;
|
||||||
|
compStream := TCompressionStream.Create(clMax, compBuffer);
|
||||||
|
sourceStream := APacket.Stream;
|
||||||
|
compStream.CopyFrom(sourceStream, 0);
|
||||||
|
compStream.Free;
|
||||||
|
FStream.WriteCardinal(sourceStream.Size);
|
||||||
|
FStream.CopyFrom(compBuffer, 0);
|
||||||
|
compBuffer.Free;
|
||||||
|
APacket.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TLoginRequestPacket }
|
||||||
|
|
||||||
|
constructor TLoginRequestPacket.Create(AUsername, APassword: string);
|
||||||
|
begin
|
||||||
|
inherited Create($02, 0);
|
||||||
|
FStream.WriteByte($03);
|
||||||
|
FStream.WriteStringNull(AUsername);
|
||||||
|
FStream.WriteStringNull(APassword);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TQuitPacket }
|
||||||
|
|
||||||
|
constructor TQuitPacket.Create;
|
||||||
|
begin
|
||||||
|
inherited Create($02, 0);
|
||||||
|
FStream.WriteByte($05);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRequestBlocksPacket }
|
||||||
|
|
||||||
|
constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
inherited Create($04, 0);
|
||||||
|
FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TFreeBlockPacket }
|
||||||
|
|
||||||
|
constructor TFreeBlockPacket.Create(AX, AY: Word);
|
||||||
|
begin
|
||||||
|
inherited Create($05, 5);
|
||||||
|
FStream.WriteWord(AX);
|
||||||
|
FStream.WriteWord(AY);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TDrawMapPacket }
|
||||||
|
|
||||||
|
constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
|
||||||
|
begin
|
||||||
|
inherited Create($06, 8);
|
||||||
|
FStream.WriteWord(AX);
|
||||||
|
FStream.WriteWord(AY);
|
||||||
|
FStream.WriteShortInt(AZ);
|
||||||
|
FStream.WriteWord(ATileID);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TInsertStaticPacket }
|
||||||
|
|
||||||
|
constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
|
||||||
|
ATileID: Word; AHue: Word);
|
||||||
|
begin
|
||||||
|
inherited Create($07, 10);
|
||||||
|
FStream.WriteWord(AX);
|
||||||
|
FStream.WriteWord(AY);
|
||||||
|
FStream.WriteShortInt(AZ);
|
||||||
|
FStream.WriteWord(ATileID);
|
||||||
|
FStream.WriteWord(AHue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TDeleteStaticPacket }
|
||||||
|
|
||||||
|
constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
|
||||||
|
begin
|
||||||
|
inherited Create($08, 10);
|
||||||
|
FStream.WriteWord(AStaticItem.X);
|
||||||
|
FStream.WriteWord(AStaticItem.Y);
|
||||||
|
FStream.WriteShortInt(AStaticItem.Z);
|
||||||
|
FStream.WriteWord(AStaticItem.TileID);
|
||||||
|
FStream.WriteWord(AStaticItem.Hue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TElevateStaticPacket }
|
||||||
|
|
||||||
|
constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
|
||||||
|
begin
|
||||||
|
inherited Create($09, 11);
|
||||||
|
FStream.WriteWord(AStaticItem.X);
|
||||||
|
FStream.WriteWord(AStaticItem.Y);
|
||||||
|
FStream.WriteShortInt(AStaticItem.Z);
|
||||||
|
FStream.WriteWord(AStaticItem.TileID);
|
||||||
|
FStream.WriteWord(AStaticItem.Hue);
|
||||||
|
FStream.WriteShortInt(ANewZ);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMoveStaticPacket }
|
||||||
|
|
||||||
|
constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
|
||||||
|
ANewY: Word);
|
||||||
|
begin
|
||||||
|
inherited Create($0A, 14);
|
||||||
|
FStream.WriteWord(AStaticItem.X);
|
||||||
|
FStream.WriteWord(AStaticItem.Y);
|
||||||
|
FStream.WriteShortInt(AStaticItem.Z);
|
||||||
|
FStream.WriteWord(AStaticItem.TileID);
|
||||||
|
FStream.WriteWord(AStaticItem.Hue);
|
||||||
|
FStream.WriteWord(ANewX);
|
||||||
|
FStream.WriteWord(ANewY);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ THueStaticPacket }
|
||||||
|
|
||||||
|
constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
|
||||||
|
begin
|
||||||
|
inherited Create($0B, 12);
|
||||||
|
FStream.WriteWord(AStaticItem.X);
|
||||||
|
FStream.WriteWord(AStaticItem.Y);
|
||||||
|
FStream.WriteShortInt(AStaticItem.Z);
|
||||||
|
FStream.WriteWord(AStaticItem.TileID);
|
||||||
|
FStream.WriteWord(AStaticItem.Hue);
|
||||||
|
FStream.WriteWord(ANewHue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TUpdateClientPosPacket }
|
||||||
|
|
||||||
|
constructor TUpdateClientPosPacket.Create(AX, AY: Word);
|
||||||
|
begin
|
||||||
|
inherited Create($0C, 0);
|
||||||
|
FStream.WriteByte($04);
|
||||||
|
FStream.WriteWord(AX);
|
||||||
|
FStream.WriteWord(AY);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TChatMessagePacket }
|
||||||
|
|
||||||
|
constructor TChatMessagePacket.Create(AMessage: string);
|
||||||
|
begin
|
||||||
|
inherited Create($0C, 0);
|
||||||
|
FStream.WriteByte($05);
|
||||||
|
FStream.WriteStringNull(AMessage);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TGotoClientPosPacket }
|
||||||
|
|
||||||
|
constructor TGotoClientPosPacket.Create(AUsername: string);
|
||||||
|
begin
|
||||||
|
inherited Create($0C, 0);
|
||||||
|
FStream.WriteByte($06);
|
||||||
|
FStream.WriteStringNull(AUsername);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRequestRadarChecksumPacket }
|
||||||
|
|
||||||
|
constructor TRequestRadarChecksumPacket.Create;
|
||||||
|
begin
|
||||||
|
inherited Create($0D, 2);
|
||||||
|
FStream.WriteByte($01);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRequestRadarMapPacket }
|
||||||
|
|
||||||
|
constructor TRequestRadarMapPacket.Create;
|
||||||
|
begin
|
||||||
|
inherited Create($0D, 2);
|
||||||
|
FStream.WriteByte($02);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TNoOpPacket }
|
||||||
|
|
||||||
|
constructor TNoOpPacket.Create;
|
||||||
|
begin
|
||||||
|
inherited Create($FF, 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,53 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UPlatformTypes;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, ActiveX;
|
||||||
|
|
||||||
|
type
|
||||||
|
IDataObject = ActiveX.IDataObject;
|
||||||
|
{IDataObject = Interface (IUnknown)
|
||||||
|
['{0000010e-0000-0000-C000-000000000046}']
|
||||||
|
function GetData(const formatetcIn: FORMATETC; out medium: STGMEDIUM): HRESULT; stdcall;
|
||||||
|
function GetDataHere(const pformatetc: FormatETC; out medium: STGMEDIUM): HRESULT; stdcall;
|
||||||
|
function QueryGetData(const pformatetc: FORMATETC): HRESULT; stdcall;
|
||||||
|
function GetCanonicalFormatTEtc(const pformatetcIn: FORMATETC; out pformatetcOut: FORMATETC): HResult; stdcall;
|
||||||
|
function SetData (const pformatetc: FORMATETC;const medium:STGMEDIUM;FRelease : BOOL):HRESULT; stdcall;
|
||||||
|
function EnumFormatEtc(dwDirection: DWord; out enumformatetcpara: IENUMFORMATETC): HRESULT; stdcall;
|
||||||
|
function DAdvise(const formatetc: FORMATETC; advf: DWORD; const AdvSink: IAdviseSink; out dwConnection: DWORD): HRESULT; stdcall;
|
||||||
|
function DUnadvise(dwconnection: DWord): HRESULT; stdcall;
|
||||||
|
function EnumDAvise(out enumAdvise: IEnumStatData): HRESULT; stdcall;
|
||||||
|
end;}
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,106 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UResourceManager;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TResourceManager }
|
||||||
|
|
||||||
|
TResourceManager = class(TObject)
|
||||||
|
constructor Create(AFileName: string);
|
||||||
|
destructor Destroy; override;
|
||||||
|
protected
|
||||||
|
FFileStream: TFileStream;
|
||||||
|
FCount: Integer;
|
||||||
|
FLookupTable: array of Cardinal;
|
||||||
|
FCurrentResource: Integer;
|
||||||
|
FResourceStream: TMemoryStream;
|
||||||
|
public
|
||||||
|
function GetResource(AIndex: Integer): TStream;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
ResourceManager: TResourceManager;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TResourceManager }
|
||||||
|
|
||||||
|
constructor TResourceManager.Create(AFileName: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
|
||||||
|
FFileStream.Position := 0;
|
||||||
|
FFileStream.Read(FCount, SizeOf(Integer));
|
||||||
|
SetLength(FLookupTable, FCount);
|
||||||
|
FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
|
||||||
|
FCurrentResource := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TResourceManager.Destroy;
|
||||||
|
begin
|
||||||
|
if FFileStream <> nil then FreeAndNil(FFileStream);
|
||||||
|
if FResourceStream <> nil then FreeAndNil(FResourceStream);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TResourceManager.GetResource(AIndex: Integer): TStream;
|
||||||
|
var
|
||||||
|
size: Cardinal;
|
||||||
|
begin
|
||||||
|
if AIndex <> FCurrentResource then
|
||||||
|
begin
|
||||||
|
FFileStream.Position := FLookupTable[AIndex];
|
||||||
|
if FResourceStream <> nil then
|
||||||
|
FResourceStream.Free;
|
||||||
|
FResourceStream := TMemoryStream.Create;
|
||||||
|
FFileStream.Read(size, SizeOf(Cardinal));
|
||||||
|
FResourceStream.CopyFrom(FFileStream, size);
|
||||||
|
FCurrentResource := AIndex;
|
||||||
|
end;
|
||||||
|
FResourceStream.Position := 0;
|
||||||
|
Result := FResourceStream;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
begin
|
||||||
|
ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
|
||||||
|
end;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
begin
|
||||||
|
if ResourceManager <> nil then FreeAndNil(ResourceManager);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,24 @@
|
||||||
|
object dmNetwork: TdmNetwork
|
||||||
|
OnCreate = DataModuleCreate
|
||||||
|
OnDestroy = DataModuleDestroy
|
||||||
|
Height = 300
|
||||||
|
HorizontalOffset = 290
|
||||||
|
VerticalOffset = 171
|
||||||
|
Width = 400
|
||||||
|
object TCPClient: TLTCPComponent
|
||||||
|
OnReceive = TCPClientReceive
|
||||||
|
OnError = TCPClientError
|
||||||
|
OnDisconnect = TCPClientDisconnect
|
||||||
|
OnConnect = TCPClientConnect
|
||||||
|
left = 40
|
||||||
|
top = 24
|
||||||
|
end
|
||||||
|
object tmNoOp: TTimer
|
||||||
|
Enabled = False
|
||||||
|
Interval = 30000
|
||||||
|
OnTimer = tmNoOpTimer
|
||||||
|
OnStartTimer = tmNoOpStartTimer
|
||||||
|
left = 72
|
||||||
|
top = 24
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,362 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UdmNetwork;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
|
||||||
|
UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TdmNetwork }
|
||||||
|
|
||||||
|
TdmNetwork = class(TDataModule)
|
||||||
|
TCPClient: TLTCPComponent;
|
||||||
|
tmNoOp: TTimer;
|
||||||
|
procedure DataModuleCreate(Sender: TObject);
|
||||||
|
procedure DataModuleDestroy(Sender: TObject);
|
||||||
|
procedure TCPClientConnect(aSocket: TLSocket);
|
||||||
|
procedure TCPClientDisconnect(aSocket: TLSocket);
|
||||||
|
procedure TCPClientError(const msg: string; aSocket: TLSocket);
|
||||||
|
procedure TCPClientReceive(aSocket: TLSocket);
|
||||||
|
procedure tmNoOpStartTimer(Sender: TObject);
|
||||||
|
procedure tmNoOpTimer(Sender: TObject);
|
||||||
|
protected
|
||||||
|
FSendQueue: TEnhancedMemoryStream;
|
||||||
|
FReceiveQueue: TEnhancedMemoryStream;
|
||||||
|
FUsername: string;
|
||||||
|
FPassword: string;
|
||||||
|
FAccessLevel: TAccessLevel;
|
||||||
|
FDataDir: string;
|
||||||
|
FLastPacket: TDateTime;
|
||||||
|
procedure OnCanSend(ASocket: TLSocket);
|
||||||
|
procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
procedure ProcessQueue;
|
||||||
|
procedure DoLogin;
|
||||||
|
public
|
||||||
|
property Username: string read FUsername;
|
||||||
|
property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
|
||||||
|
procedure Send(APacket: TPacket);
|
||||||
|
procedure Disconnect;
|
||||||
|
procedure CheckClose(ASender: TForm);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
dmNetwork: TdmNetwork;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
|
||||||
|
UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
|
||||||
|
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
|
||||||
|
UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
|
||||||
|
UfrmVirtualLayer, UfrmFilter, UfrmTileInfo;
|
||||||
|
|
||||||
|
{$I version.inc}
|
||||||
|
|
||||||
|
{ TdmNetwork }
|
||||||
|
|
||||||
|
procedure TdmNetwork.DataModuleCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FSendQueue := TEnhancedMemoryStream.Create;
|
||||||
|
FReceiveQueue := TEnhancedMemoryStream.Create;
|
||||||
|
TCPClient.OnCanSend := @OnCanSend;
|
||||||
|
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket);
|
||||||
|
DoLogin;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.DataModuleDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if FSendQueue <> nil then FreeAndNil(FSendQueue);
|
||||||
|
if FReceiveQueue <> nil then FreeAndNil(FReceiveQueue);
|
||||||
|
if PacketHandlers[$02] <> nil then FreeAndNil(PacketHandlers[$02]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket);
|
||||||
|
begin
|
||||||
|
FSendQueue.Clear;
|
||||||
|
FReceiveQueue.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket);
|
||||||
|
begin
|
||||||
|
FSendQueue.Clear;
|
||||||
|
FReceiveQueue.Clear;
|
||||||
|
DoLogin;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket);
|
||||||
|
begin
|
||||||
|
MessageDlg('Connection error', msg, mtError, [mbOK], 0);
|
||||||
|
if not TCPClient.Connected then
|
||||||
|
TCPClientDisconnect(aSocket);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket);
|
||||||
|
var
|
||||||
|
buffer: array[0..4095] of byte;
|
||||||
|
size: Integer;
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
size := TCPClient.Get(buffer, 4096);
|
||||||
|
if size > 0 then
|
||||||
|
FReceiveQueue.Enqueue(buffer, size);
|
||||||
|
until size <= 0;
|
||||||
|
ProcessQueue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FLastPacket := Now;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.tmNoOpTimer(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if SecondsBetween(FLastPacket, Now) > 25 then
|
||||||
|
Send(TNoOpPacket.Create);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.OnCanSend(ASocket: TLSocket);
|
||||||
|
var
|
||||||
|
size: Integer;
|
||||||
|
begin
|
||||||
|
while FSendQueue.Size > 0 do
|
||||||
|
begin
|
||||||
|
FLastPacket := Now;
|
||||||
|
size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size);
|
||||||
|
if size > 0 then
|
||||||
|
FSendQueue.Dequeue(size)
|
||||||
|
else
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
var
|
||||||
|
subID: Byte;
|
||||||
|
loginState: TLoginState;
|
||||||
|
width, height: Word;
|
||||||
|
serverState: TServerState;
|
||||||
|
begin
|
||||||
|
subID := ABuffer.ReadByte;
|
||||||
|
case subID of
|
||||||
|
$01:
|
||||||
|
begin
|
||||||
|
if ABuffer.ReadCardinal = ProtocolVersion then
|
||||||
|
begin
|
||||||
|
frmInitialize.lblStatus.Caption := 'Authenticating';
|
||||||
|
Send(TLoginRequestPacket.Create(FUsername, FPassword));
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0);
|
||||||
|
Disconnect;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
$03:
|
||||||
|
begin
|
||||||
|
loginState := TLoginState(ABuffer.ReadByte);
|
||||||
|
if loginState = lsOK then
|
||||||
|
begin
|
||||||
|
frmInitialize.lblStatus.Caption := 'Initializing';
|
||||||
|
frmInitialize.Repaint;
|
||||||
|
frmInitialize.lblStatus.Repaint;
|
||||||
|
Application.ProcessMessages;
|
||||||
|
FAccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||||
|
InitGameResourceManager(FDataDir);
|
||||||
|
width := ABuffer.ReadWord;
|
||||||
|
height := ABuffer.ReadWord;
|
||||||
|
ResMan.InitLandscape(width, height);
|
||||||
|
frmMain := TfrmMain.Create(dmNetwork);
|
||||||
|
frmAccountControl := TfrmAccountControl.Create(frmMain);
|
||||||
|
frmEditAccount := TfrmEditAccount.Create(frmAccountControl);
|
||||||
|
frmConfirmation := TfrmConfirmation.Create(frmMain);
|
||||||
|
frmDrawSettings := TfrmDrawSettings.Create(frmMain);
|
||||||
|
frmMoveSettings := TfrmMoveSettings.Create(frmMain);
|
||||||
|
frmElevateSettings := TfrmElevateSettings.Create(frmMain);
|
||||||
|
frmHueSettings := TfrmHueSettings.Create(frmMain);
|
||||||
|
frmBoundaries := TfrmBoundaries.Create(frmMain);
|
||||||
|
frmFilter := TfrmFilter.Create(frmMain);
|
||||||
|
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
|
||||||
|
frmAbout := TfrmAbout.Create(frmMain);
|
||||||
|
frmRadarMap := TfrmRadarMap.Create(frmMain);
|
||||||
|
frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);
|
||||||
|
frmTileInfo := TfrmTileInfo.Create(frmMain);
|
||||||
|
frmMain.Show;
|
||||||
|
frmInitialize.Hide;
|
||||||
|
tmNoOp.Enabled := True;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
if loginState = lsInvalidUser then
|
||||||
|
MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0)
|
||||||
|
else if loginState = lsInvalidPassword then
|
||||||
|
MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0)
|
||||||
|
else if loginState = lsAlreadyLoggedIn then
|
||||||
|
MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0)
|
||||||
|
else if loginState = lsNoAccess then
|
||||||
|
MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
$04: //Server state
|
||||||
|
begin
|
||||||
|
serverState := TServerState(ABuffer.ReadByte);
|
||||||
|
if serverState = ssRunning then
|
||||||
|
begin
|
||||||
|
frmInitialize.UnsetModal;
|
||||||
|
frmInitialize.Hide;
|
||||||
|
tmNoOp.Enabled := True;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
case serverState of
|
||||||
|
ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.';
|
||||||
|
ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull
|
||||||
|
end;
|
||||||
|
tmNoOp.Enabled := False;
|
||||||
|
frmInitialize.Show;
|
||||||
|
frmInitialize.SetModal;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.ProcessQueue;
|
||||||
|
var
|
||||||
|
packetHandler: TPacketHandler;
|
||||||
|
size: Cardinal;
|
||||||
|
begin
|
||||||
|
FReceiveQueue.Position := 0;
|
||||||
|
while FReceiveQueue.Size >= 1 do
|
||||||
|
begin
|
||||||
|
packetHandler := PacketHandlers[FReceiveQueue.ReadByte];
|
||||||
|
if packetHandler <> nil then
|
||||||
|
begin
|
||||||
|
size := packetHandler.PacketLength;
|
||||||
|
if size = 0 then
|
||||||
|
begin
|
||||||
|
if FReceiveQueue.Size > 5 then
|
||||||
|
size := FReceiveQueue.ReadCardinal
|
||||||
|
else
|
||||||
|
Break; //wait for more data
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FReceiveQueue.Size >= size then
|
||||||
|
begin
|
||||||
|
FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much
|
||||||
|
packetHandler.Process(FReceiveQueue);
|
||||||
|
FReceiveQueue.Unlock;
|
||||||
|
FReceiveQueue.Dequeue(size);
|
||||||
|
end else
|
||||||
|
Break; //wait for more data
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
{Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);}
|
||||||
|
Disconnect;
|
||||||
|
FReceiveQueue.Clear;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.DoLogin;
|
||||||
|
begin
|
||||||
|
tmNoOp.Enabled := False;
|
||||||
|
frmLogin := TfrmLogin.Create(dmNetwork);
|
||||||
|
if frmInitialize = nil then frmInitialize := TfrmInitialize.Create(dmNetwork);
|
||||||
|
if frmTileInfo <> nil then FreeAndNil(frmTileInfo);
|
||||||
|
if frmLargeScaleCommand <> nil then FreeAndNil(frmLargeScaleCommand);
|
||||||
|
if frmEditAccount <> nil then FreeAndNil(frmEditAccount);
|
||||||
|
if frmAccountControl <> nil then FreeAndNil(frmAccountControl);
|
||||||
|
if frmConfirmation <> nil then FreeAndNil(frmConfirmation);
|
||||||
|
if frmDrawSettings <> nil then FreeAndNil(frmDrawSettings);
|
||||||
|
if frmMoveSettings <> nil then FreeAndNil(frmMoveSettings);
|
||||||
|
if frmElevateSettings <> nil then FreeAndNil(frmElevateSettings);
|
||||||
|
if frmHueSettings <> nil then FreeAndNil(frmHueSettings);
|
||||||
|
if frmBoundaries <> nil then FreeAndNil(frmBoundaries);
|
||||||
|
if frmFilter <> nil then FreeAndNil(frmFilter);
|
||||||
|
if frmVirtualLayer <> nil then FreeAndNil(frmVirtualLayer);
|
||||||
|
if frmAbout <> nil then FreeAndNil(frmAbout);
|
||||||
|
if frmRadarMap <> nil then FreeAndNil(frmRadarMap);
|
||||||
|
if frmMain <> nil then
|
||||||
|
begin
|
||||||
|
frmMain.ApplicationProperties1.OnIdle := nil;
|
||||||
|
FreeAndNil(frmMain);
|
||||||
|
end;
|
||||||
|
if GameResourceManager <> nil then FreeAndNil(GameResourceManager);
|
||||||
|
frmInitialize.Hide;
|
||||||
|
while frmLogin.ShowModal = mrOK do
|
||||||
|
begin
|
||||||
|
if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
|
||||||
|
begin
|
||||||
|
FUsername := frmLogin.edUsername.Text;
|
||||||
|
FPassword := frmLogin.edPassword.Text;
|
||||||
|
FDataDir := frmLogin.edData.Text;
|
||||||
|
frmInitialize.lblStatus.Caption := 'Connecting';
|
||||||
|
frmInitialize.Show;
|
||||||
|
Break;
|
||||||
|
end else
|
||||||
|
MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
frmLogin.Close;
|
||||||
|
FreeAndNil(frmLogin);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.Send(APacket: TPacket);
|
||||||
|
var
|
||||||
|
source: TEnhancedMemoryStream;
|
||||||
|
begin
|
||||||
|
if TCPClient.Connected then
|
||||||
|
begin
|
||||||
|
FSendQueue.Seek(0, soFromEnd);
|
||||||
|
source := APacket.Stream;
|
||||||
|
FSendQueue.CopyFrom(source, 0);
|
||||||
|
OnCanSend(nil);
|
||||||
|
end;
|
||||||
|
APacket.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.Disconnect;
|
||||||
|
begin
|
||||||
|
Send(TQuitPacket.Create);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TdmNetwork.CheckClose(ASender: TForm);
|
||||||
|
begin
|
||||||
|
if ((frmLogin = nil) or (ASender = frmLogin)) and
|
||||||
|
((frmMain = nil) or (ASender = frmMain)) and
|
||||||
|
((frmInitialize = nil) or (not frmInitialize.Visible)) then
|
||||||
|
begin
|
||||||
|
Application.Terminate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UdmNetwork.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,105 @@
|
||||||
|
object frmAbout: TfrmAbout
|
||||||
|
Left = 290
|
||||||
|
Height = 323
|
||||||
|
Top = 171
|
||||||
|
Width = 355
|
||||||
|
HorzScrollBar.Page = 354
|
||||||
|
VertScrollBar.Page = 322
|
||||||
|
ActiveControl = btnClose
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'About CentrED'
|
||||||
|
ClientHeight = 323
|
||||||
|
ClientWidth = 355
|
||||||
|
OnCreate = FormCreate
|
||||||
|
Position = poScreenCenter
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 61
|
||||||
|
Top = 208
|
||||||
|
Width = 339
|
||||||
|
BorderSpacing.Around = 8
|
||||||
|
Caption = 'Ultima™ Online © 1997 Electronic Arts Inc. Ultima, the UO logo, Are You With Us?, ORIGIN, the ORIGIN logo and We create worlds are trademarks or registered trademarks of Electronic Arts Inc. in the U.S. and/or other countries. All rights reserved.'
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Label5: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 16
|
||||||
|
Top = 128
|
||||||
|
Width = 227
|
||||||
|
Caption = 'It is using the following great components:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label6: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 46
|
||||||
|
Top = 144
|
||||||
|
Width = 218
|
||||||
|
Caption = '- Vampyre Imaging Lib by Marek Mauder'#13#10'- lNet by Ales Katona and Micha Nelissen'#13#10'- VirtualTrees by Mike Lischke'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label7: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 16
|
||||||
|
Top = 104
|
||||||
|
Width = 310
|
||||||
|
Caption = 'CentrED has been developed using Lazarus and FreePascal.'
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Panel1: TPanel
|
||||||
|
Height = 88
|
||||||
|
Width = 202
|
||||||
|
BevelInner = bvRaised
|
||||||
|
BevelOuter = bvLowered
|
||||||
|
ClientHeight = 88
|
||||||
|
ClientWidth = 202
|
||||||
|
TabOrder = 0
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 2
|
||||||
|
Height = 38
|
||||||
|
Top = 2
|
||||||
|
Width = 198
|
||||||
|
Align = alTop
|
||||||
|
Alignment = taCenter
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'UO CentrED'
|
||||||
|
Font.Height = -27
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblVersion: TLabel
|
||||||
|
Left = 6
|
||||||
|
Height = 18
|
||||||
|
Top = 40
|
||||||
|
Width = 190
|
||||||
|
Align = alTop
|
||||||
|
Alignment = taRightJustify
|
||||||
|
BorderSpacing.Left = 4
|
||||||
|
BorderSpacing.Right = 4
|
||||||
|
Font.Style = [fsItalic]
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblCopyright: TLabel
|
||||||
|
Left = 6
|
||||||
|
Height = 19
|
||||||
|
Top = 63
|
||||||
|
Width = 190
|
||||||
|
Align = alBottom
|
||||||
|
Alignment = taCenter
|
||||||
|
BorderSpacing.Around = 4
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object btnClose: TButton
|
||||||
|
Left = 144
|
||||||
|
Height = 25
|
||||||
|
Top = 288
|
||||||
|
Width = 75
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = 'Close'
|
||||||
|
OnClick = btnCloseClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,82 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmAbout;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
ExtCtrls;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmAbout }
|
||||||
|
|
||||||
|
TfrmAbout = class(TForm)
|
||||||
|
btnClose: TButton;
|
||||||
|
Label1: TLabel;
|
||||||
|
lblCopyright: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
lblVersion: TLabel;
|
||||||
|
Label5: TLabel;
|
||||||
|
Label6: TLabel;
|
||||||
|
Label7: TLabel;
|
||||||
|
Panel1: TPanel;
|
||||||
|
procedure btnCloseClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ private declarations }
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmAbout: TfrmAbout;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$I version.inc}
|
||||||
|
|
||||||
|
{ TfrmAbout }
|
||||||
|
|
||||||
|
procedure TfrmAbout.btnCloseClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAbout.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
lblVersion.Caption := Format('Version %s', [ProductVersion]);
|
||||||
|
lblCopyright.Caption := Format('Copyright %s', [Copyright]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmAbout.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,789 @@
|
||||||
|
object frmAccountControl: TfrmAccountControl
|
||||||
|
Left = 290
|
||||||
|
Height = 378
|
||||||
|
Top = 171
|
||||||
|
Width = 369
|
||||||
|
HorzScrollBar.Page = 368
|
||||||
|
VertScrollBar.Page = 377
|
||||||
|
ActiveControl = vstAccounts
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'Account Management'
|
||||||
|
ClientHeight = 378
|
||||||
|
ClientWidth = 369
|
||||||
|
OnClose = FormClose
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
OnShow = FormShow
|
||||||
|
Position = poOwnerFormCenter
|
||||||
|
object tbMain: TToolBar
|
||||||
|
Height = 26
|
||||||
|
Width = 369
|
||||||
|
Caption = 'tbMain'
|
||||||
|
Flat = True
|
||||||
|
Images = ilToolbar
|
||||||
|
TabOrder = 0
|
||||||
|
object tbRefresh: TToolButton
|
||||||
|
Left = 1
|
||||||
|
Hint = 'Refresh'
|
||||||
|
Top = 2
|
||||||
|
Caption = 'Refresh'
|
||||||
|
ImageIndex = 0
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = tbRefreshClick
|
||||||
|
end
|
||||||
|
object tbAddUser: TToolButton
|
||||||
|
Left = 32
|
||||||
|
Hint = 'Add User'
|
||||||
|
Top = 2
|
||||||
|
Caption = 'Add User'
|
||||||
|
ImageIndex = 1
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = tbAddUserClick
|
||||||
|
end
|
||||||
|
object tbEditUser: TToolButton
|
||||||
|
Left = 55
|
||||||
|
Hint = 'Edit User'
|
||||||
|
Top = 2
|
||||||
|
Caption = 'Edit User'
|
||||||
|
ImageIndex = 2
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = tbEditUserClick
|
||||||
|
end
|
||||||
|
object tbDeleteUser: TToolButton
|
||||||
|
Left = 78
|
||||||
|
Hint = 'Delete User'
|
||||||
|
Top = 2
|
||||||
|
Caption = 'Delete User'
|
||||||
|
ImageIndex = 3
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnClick = tbDeleteUserClick
|
||||||
|
end
|
||||||
|
object tbSeparator1: TToolButton
|
||||||
|
Left = 24
|
||||||
|
Top = 2
|
||||||
|
Width = 8
|
||||||
|
Caption = 'tbSeparator1'
|
||||||
|
Style = tbsDivider
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object vstAccounts: TVirtualStringTree
|
||||||
|
Height = 352
|
||||||
|
Top = 26
|
||||||
|
Width = 369
|
||||||
|
Align = alClient
|
||||||
|
Header.AutoSizeIndex = 1
|
||||||
|
Header.Options = [hoColumnResize, hoDrag, hoVisible]
|
||||||
|
Header.Style = hsPlates
|
||||||
|
Images = ilAccesslevel
|
||||||
|
TabOrder = 1
|
||||||
|
TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
|
||||||
|
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
|
||||||
|
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||||
|
TreeOptions.SelectionOptions = [toFullRowSelect]
|
||||||
|
OnDblClick = vstAccountsDblClick
|
||||||
|
OnGetText = vstAccountsGetText
|
||||||
|
OnGetImageIndex = vstAccountsGetImageIndex
|
||||||
|
Columns = <
|
||||||
|
item
|
||||||
|
Width = 30
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Position = 1
|
||||||
|
Width = 200
|
||||||
|
WideText = 'Username'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Position = 2
|
||||||
|
Width = 100
|
||||||
|
WideText = 'Accesslevel'
|
||||||
|
end>
|
||||||
|
end
|
||||||
|
object ilToolbar: TImageList
|
||||||
|
left = 144
|
||||||
|
Bitmap = {
|
||||||
|
6C69040000001000000010000000F00700002F2A2058504D202A2F0A73746174
|
||||||
|
69632063686172202A677261706869635B5D203D207B0A223136203136203838
|
||||||
|
2032222C0A222E2E2063204E6F6E65222C0A222E2C2063202334463939343722
|
||||||
|
2C0A222E2D20632023343939313431222C0A222E2A2063202336354234354222
|
||||||
|
2C0A222E6120632023354641443536222C0A222E622063202335414136353022
|
||||||
|
2C0A222E6320632023353339453442222C0A222E642063202334443936343522
|
||||||
|
2C0A222E6520632023363841383630222C0A222E662063202336324132354222
|
||||||
|
2C0A222E6720632023334137453334222C0A222E682063202336384239354522
|
||||||
|
2C0A222E6920632023383343333739222C0A222E6A2063202339324341383922
|
||||||
|
2C0A222E6B20632023394344303934222C0A222E6C2063202339454431393522
|
||||||
|
2C0A222E6D20632023393943463930222C0A222E6E2063202339344342384322
|
||||||
|
2C0A222E6F20632023384643393837222C0A222E702063202338374334383022
|
||||||
|
2C0A222E7120632023353439353445222C0A222E722063202332433644323722
|
||||||
|
2C0A222E7320632023363742363543222C0A222E742063202338454339383522
|
||||||
|
2C0A222E7520632023413444343942222C0A222E762063202339384345384622
|
||||||
|
2C0A222E7720632023394143463932222C0A222E782063202339354343384422
|
||||||
|
2C0A222E7920632023393043413838222C0A222E7A2063202338424336383322
|
||||||
|
2C0A222E4120632023383543343745222C0A222E422063202337464331373922
|
||||||
|
2C0A222E4320632023344338443437222C0A222E442063202332353635323222
|
||||||
|
2C0A222E4520632023374542463735222C0A222E462063202341314432393822
|
||||||
|
2C0A222E4720632023394343463934222C0A222E482063202338444337383622
|
||||||
|
2C0A222E4920632023363541373545222C0A222E4A2063202334303836333922
|
||||||
|
2C0A222E4B20632023333337363245222C0A222E4C2063202334463930343922
|
||||||
|
2C0A222E4D20632023344138423435222C0A222E4E2063202332343633323022
|
||||||
|
2C0A222E4F20632023354541423534222C0A222E502063202338394333383022
|
||||||
|
2C0A222E5120632023384143343833222C0A222E522063202334343842334422
|
||||||
|
2C0A222E5320632023334538333337222C0A222E542063202332373636323322
|
||||||
|
2C0A222E5520632023323336313146222C0A222E562063202335354131344422
|
||||||
|
2C0A222E5720632023343238383342222C0A222E582063202333433830333522
|
||||||
|
2C0A222E5920632023364543303633222C0A222E5A2063202336414242354622
|
||||||
|
2C0A222E3020632023384543363836222C0A222E312063202338464339383822
|
||||||
|
2C0A222E3220632023373642333646222C0A222E332063202336444245363222
|
||||||
|
2C0A222E3420632023383543373742222C0A222E352063202338314332373722
|
||||||
|
2C0A222E3620632023353741333445222C0A222E372063202335313942343922
|
||||||
|
2C0A222E3820632023364241433633222C0A222E392063202338424333383322
|
||||||
|
2C0A222E4020632023383943363832222C0A222E232063202335363937353022
|
||||||
|
2C0A222E3B20632023364342433630222C0A222E3A2063202338334334373922
|
||||||
|
2C0A222E3D20632023413744373945222C0A222E2B2063202339464432393722
|
||||||
|
2C0A222E2520632023383243323741222C0A222E242063202336334134354422
|
||||||
|
2C0A222E2820632023324136423236222C0A222E292063202337434244373322
|
||||||
|
2C0A222E5B20632023394644313936222C0A222E5D2063202339364344384622
|
||||||
|
2C0A222C2E20632023393143413841222C0A222C2C2063202338424337383522
|
||||||
|
2C0A222C2D20632023383142453741222C0A222C2A2063202336434144363522
|
||||||
|
2C0A222C6120632023353139323442222C0A222C622063202332393638323422
|
||||||
|
2C0A222C6320632023364542303636222C0A222C642063202336384141363122
|
||||||
|
2C0A222C6520632023333737423332222C0A222C662063202333323734324322
|
||||||
|
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2C2E2D2E2E2E
|
||||||
|
2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2A2E612E622E632E642E652E
|
||||||
|
662E672E2E2E2E2E2E2E2E222C0A222E2E2E2E2E682E692E6A2E6B2E6C2E6D2E
|
||||||
|
6E2E6F2E702E712E722E2E2E2E2E2E222C0A222E2E2E732E742E752E762E772E
|
||||||
|
782E792E7A2E412E422E432E442E2E2E2E2E2E222C0A222E2E2E452E462E472E
|
||||||
|
482E492E4A2E672E4B2E4C2E4D2E4E2E2E2E2E2E2E2E2E222C0A222E4F2E502E
|
||||||
|
782E512E522E532E2E2E2E2E2E2E542E552E2E2E2E2E2E2E2E2E2E222C0A222E
|
||||||
|
562E2C2E2D2E572E582E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
|
||||||
|
2C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E562E2C2E2D2E
|
||||||
|
572E58222C0A222E2E2E2E2E2E2E2E2E2E2E592E5A2E2E2E2E2E2E2E632E642E
|
||||||
|
302E312E322E4B222C0A222E2E2E2E2E2E2E2E2E332E342E352E4F2E362E372E
|
||||||
|
382E392E6F2E402E232E2E222C0A222E2E2E2E2E2E2E3B2E3A2E3D2E752E2B2E
|
||||||
|
772E782E792E252E412E242E282E2E222C0A222E2E2E2E2E2E2E2A2E292E5B2E
|
||||||
|
472E5D2C2E2C2C2C2D2C2A2C612C622E2E2E2E222C0A222E2E2E2E2E2E2E2E2E
|
||||||
|
362C632C642E522E532C652C662E722E2E2E2E2E2E2E2E222C0A222E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2D2E572E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E22
|
||||||
|
7D0A310A00002F2A2058504D202A2F0A7374617469632063686172202A677261
|
||||||
|
706869635B5D203D207B0A223136203136203132342032222C0A222E2E206320
|
||||||
|
4E6F6E65222C0A222E2C20632023384434383132222C0A222E2D206320233930
|
||||||
|
34423130222C0A222E2A20632023384134383046222C0A222E61206320233744
|
||||||
|
34323131222C0A222E6220632023354233333135222C0A222E63206320233936
|
||||||
|
34453131222C0A222E6420632023394235383132222C0A222E65206320233939
|
||||||
|
35383132222C0A222E6620632023393335333131222C0A222E67206320233837
|
||||||
|
34413046222C0A222E6820632023373133453045222C0A222E69206320233442
|
||||||
|
32453133222C0A222E6A20632023393734423046222C0A222E6B206320233946
|
||||||
|
35383132222C0A222E6C20632023384134413046222C0A222E6D206320233837
|
||||||
|
34423046222C0A222E6E20632023383734423131222C0A222E6F206320233835
|
||||||
|
34433135222C0A222E7020632023373534313132222C0A222E71206320233543
|
||||||
|
33333046222C0A222E7220632023383733453043222C0A222E73206320234238
|
||||||
|
39373743222C0A222E7420632023453442373841222C0A222E75206320234338
|
||||||
|
39433731222C0A222E7620632023364534303135222C0A222E77206320233732
|
||||||
|
34343139222C0A222E7820632023364234353232222C0A222E79206320233636
|
||||||
|
33423131222C0A222E7A20632023394235453146222C0A222E41206320234637
|
||||||
|
45384439222C0A222E4220632023463143353937222C0A222E43206320234535
|
||||||
|
42423845222C0A222E4420632023443141393746222C0A222E45206320234446
|
||||||
|
42353839222C0A222E4620632023454544464344222C0A222E47206320234137
|
||||||
|
36383233222C0A222E4820632023393235423241222C0A222E49206320234545
|
||||||
|
43414136222C0A222E4A20632023454143434142222C0A222E4B206320234636
|
||||||
|
44304137222C0A222E4C20632023463644304138222C0A222E4D206320234545
|
||||||
|
43444137222C0A222E4E20632023394136323244222C0A222E4F206320233235
|
||||||
|
33433641222C0A222E5020632023413736443334222C0A222E51206320234638
|
||||||
|
43433943222C0A222E5220632023463744344146222C0A222E53206320234636
|
||||||
|
43464135222C0A222E5420632023414537343334222C0A222E55206320233244
|
||||||
|
33453638222C0A222E5620632023314334384243222C0A222E57206320234434
|
||||||
|
45324634222C0A222E5820632023413937423445222C0A222E59206320234138
|
||||||
|
37423444222C0A222E5A20632023433344364633222C0A222E30206320233143
|
||||||
|
34364245222C0A222E3120632023314634434334222C0A222E32206320234436
|
||||||
|
45344636222C0A222E3320632023413445344646222C0A222E34206320233732
|
||||||
|
44344646222C0A222E3520632023363943394646222C0A222E36206320233633
|
||||||
|
43304646222C0A222E3720632023354642364646222C0A222E38206320233738
|
||||||
|
41424145222C0A222E3920632023373239373630222C0A222E40206320233636
|
||||||
|
38453446222C0A222E2320632023353738333432222C0A222E3B206320233434
|
||||||
|
35343841222C0A222E3A20632023414243384643222C0A222E3D206320233938
|
||||||
|
44314646222C0A222E2B20632023364443374645222C0A222E25206320233638
|
||||||
|
42464645222C0A222E2420632023363442394645222C0A222E28206320233545
|
||||||
|
42314645222C0A222E2920632023363139424137222C0A222E5B206320233831
|
||||||
|
41423631222C0A222E5D20632023423444343935222C0A222C2E206320234430
|
||||||
|
45364241222C0A222C2C20632023384642423641222C0A222C2D206320233537
|
||||||
|
38463244222C0A222C2A20632023333736423139222C0A222C61206320234345
|
||||||
|
37433238222C0A222C6220632023454142333738222C0A222C63206320233934
|
||||||
|
39454233222C0A222C6420632023363042374646222C0A222C65206320233633
|
||||||
|
42364646222C0A222C6620632023363142324645222C0A222C67206320233544
|
||||||
|
41434645222C0A222C6820632023353941354645222C0A222C69206320233544
|
||||||
|
38383441222C0A222C6A20632023423144333930222C0A222C6B206320234231
|
||||||
|
44363932222C0A222C6C20632023464646464646222C0A222C6D206320233843
|
||||||
|
42433635222C0A222C6E20632023384642433637222C0A222C6F206320234431
|
||||||
|
37443239222C0A222C7020632023454542413832222C0A222C71206320233538
|
||||||
|
36363946222C0A222C7220632023383442424635222C0A222C73206320233542
|
||||||
|
41434646222C0A222C7420632023354141384645222C0A222C75206320233537
|
||||||
|
41324645222C0A222C7620632023353339434645222C0A222C77206320233443
|
||||||
|
37423331222C0A222C7820632023423644343943222C0A222C79206320234232
|
||||||
|
44323935222C0A222C7A20632023434437393235222C0A222C41206320233631
|
||||||
|
36313836222C0A222C4220632023333536304246222C0A222C43206320233631
|
||||||
|
42394645222C0A222C4420632023363242394645222C0A222C45206320233341
|
||||||
|
36453232222C0A222C4620632023384242413632222C0A222C47206320233837
|
||||||
|
42413630222C0A222C4820632023383742393630222C0A222C49206320233230
|
||||||
|
35304233222C0A222C4A20632023314634304130222C0A222C4B206320233232
|
||||||
|
34354141222C0A222C4C20632023323234364143222C0A222C4D206320233232
|
||||||
|
34344142222C0A222C4E20632023324435373543222C0A222C4F206320233533
|
||||||
|
38433238222C0A222C5020632023384442413634222C0A222E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2C2E2D2E2A2E612E622E2E2E2E2E2E2E2E2E2E222C0A22
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E632E642E652E662E672E682E692E2E2E2E2E2E2E2E
|
||||||
|
222C0A222E2E2E2E2E2E2E2E2E6A2E6B2E6C2E6D2E6E2E6F2E702E712E2E2E2E
|
||||||
|
2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E722E732E742E752E762E772E782E79
|
||||||
|
2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E7A2E412E422E432E442E45
|
||||||
|
2E462E472E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E482E492E4A2E4B
|
||||||
|
2E4C2E4A2E4D2E4E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E4F2E50
|
||||||
|
2E512E522E522E532E542E552E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E
|
||||||
|
2E562E572E582E592E592E582E5A2E302E2E2E2E2E2E2E2E222C0A222E2E2E2E
|
||||||
|
2E2E2E312E322E332E342E352E362E372E382E392E402E232E2E2E2E222C0A22
|
||||||
|
2E2E2E2E2E3B2E3A2E3D2E2B2E252E242E282E292E5B2E5D2C2E2C2C2C2D2C2A
|
||||||
|
222C0A222E2E2C612C622C632C642C652C662C672C682C692C6A2C6B2C6C2C6D
|
||||||
|
2C6E2C2A222C0A222E2E2C6F2C702C712C722C732C742C752C762C772C782C6C
|
||||||
|
2C6C2C6C2C792C2A222C0A222E2E2E2E2C7A2C412C422C432C442C442C442C45
|
||||||
|
2C462C472C6C2C482C6E2C2A222C0A222E2E2E2E2E2E2E2E2C492C4A2C4B2C4C
|
||||||
|
2C4D2C4E2C4F2C502C792C502C4F2C2A222C0A222E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2C2A2C2A2C2A2C2A2C2A2E2E227D0AF10B00002F2A205850
|
||||||
|
4D202A2F0A7374617469632063686172202A677261706869635B5D203D207B0A
|
||||||
|
223136203136203135322032222C0A222E2E2063204E6F6E65222C0A222E2C20
|
||||||
|
632023384434383132222C0A222E2D20632023393034423130222C0A222E2A20
|
||||||
|
632023384134383046222C0A222E6120632023374434323131222C0A222E6220
|
||||||
|
632023354233333135222C0A222E6320632023393634453131222C0A222E6420
|
||||||
|
632023394235383132222C0A222E6520632023393935383132222C0A222E6620
|
||||||
|
632023393335333131222C0A222E6720632023383734413046222C0A222E6820
|
||||||
|
632023373133453045222C0A222E6920632023344232453133222C0A222E6A20
|
||||||
|
632023393734423046222C0A222E6B20632023394635383132222C0A222E6C20
|
||||||
|
632023384134413046222C0A222E6D20632023383734423046222C0A222E6E20
|
||||||
|
632023383734423131222C0A222E6F20632023383534433135222C0A222E7020
|
||||||
|
632023373534313132222C0A222E7120632023354333333046222C0A222E7220
|
||||||
|
632023383733453043222C0A222E7320632023423839373743222C0A222E7420
|
||||||
|
632023453442373841222C0A222E7520632023433839433731222C0A222E7620
|
||||||
|
632023364534303135222C0A222E7720632023373234343139222C0A222E7820
|
||||||
|
632023364234353232222C0A222E7920632023363633423131222C0A222E7A20
|
||||||
|
632023394235453146222C0A222E4120632023463745384439222C0A222E4220
|
||||||
|
632023463143353937222C0A222E4320632023453542423845222C0A222E4420
|
||||||
|
632023443141393746222C0A222E4520632023444642353839222C0A222E4620
|
||||||
|
632023454544464344222C0A222E4720632023413736383233222C0A222E4820
|
||||||
|
632023443841353538222C0A222E4920632023444242313835222C0A222E4A20
|
||||||
|
632023443039443436222C0A222E4B20632023393235423241222C0A222E4C20
|
||||||
|
632023454543414136222C0A222E4D20632023454143434142222C0A222E4E20
|
||||||
|
632023463644304137222C0A222E4F20632023463644304138222C0A222E5020
|
||||||
|
632023454543444137222C0A222E5120632023423738343238222C0A222E5220
|
||||||
|
632023453742453737222C0A222E5320632023463044324234222C0A222E5420
|
||||||
|
632023464646334535222C0A222E5520632023454644324143222C0A222E5620
|
||||||
|
632023433738433438222C0A222E5720632023323533433641222C0A222E5820
|
||||||
|
632023413736443334222C0A222E5920632023463843433943222C0A222E5A20
|
||||||
|
632023463744344146222C0A222E3020632023463643464135222C0A222E3120
|
||||||
|
632023424638413245222C0A222E3220632023454244333745222C0A222E3320
|
||||||
|
632023463945334232222C0A222E3420632023453743303842222C0A222E3520
|
||||||
|
632023463644334145222C0A222E3620632023464345304334222C0A222E3720
|
||||||
|
632023443339463636222C0A222E3820632023314334384243222C0A222E3920
|
||||||
|
632023443445324634222C0A222E4020632023413937423445222C0A222E2320
|
||||||
|
632023413837423444222C0A222E3B20632023424138433432222C0A222E3A20
|
||||||
|
632023454544343744222C0A222E3D20632023464446364334222C0A222E2B20
|
||||||
|
632023463644443643222C0A222E2520632023454443413644222C0A222E2420
|
||||||
|
632023443741333633222C0A222E2820632023443239423544222C0A222E2920
|
||||||
|
632023314634434334222C0A222E5B20632023443645344636222C0A222E5D20
|
||||||
|
632023413445344646222C0A222C2E20632023373244344646222C0A222C2C20
|
||||||
|
632023363943394646222C0A222C2D20632023383642424246222C0A222C2A20
|
||||||
|
632023454544333739222C0A222C6120632023464446374337222C0A222C6220
|
||||||
|
632023463544433546222C0A222C6320632023463745323542222C0A222C6420
|
||||||
|
632023463244363741222C0A222C6520632023444639393430222C0A222C6620
|
||||||
|
632023343435343841222C0A222C6720632023414243384643222C0A222C6820
|
||||||
|
632023393844314646222C0A222C6920632023364443374645222C0A222C6A20
|
||||||
|
632023363842464645222C0A222C6B20632023383041374230222C0A222C6C20
|
||||||
|
632023453743423737222C0A222C6D20632023463544433545222C0A222C6E20
|
||||||
|
632023463745313541222C0A222C6F20632023463144343742222C0A222C7020
|
||||||
|
632023443439313436222C0A222C7120632023373236363638222C0A222C7220
|
||||||
|
632023434537433238222C0A222C7320632023454142333738222C0A222C7420
|
||||||
|
632023393439454233222C0A222C7520632023363042374646222C0A222C7620
|
||||||
|
632023363342364646222C0A222C7720632023374441334233222C0A222C7820
|
||||||
|
632023443342383736222C0A222C7920632023464446364332222C0A222C7A20
|
||||||
|
632023463744463633222C0A222C4120632023463845323544222C0A222C4220
|
||||||
|
632023463044333739222C0A222C4320632023443839353437222C0A222C4420
|
||||||
|
632023454142323735222C0A222C4520632023433737343239222C0A222C4620
|
||||||
|
632023443137443239222C0A222C4720632023454542413832222C0A222C4820
|
||||||
|
632023353836363946222C0A222C4920632023383442424635222C0A222C4A20
|
||||||
|
632023373439324137222C0A222C4B20632023443542363741222C0A222C4C20
|
||||||
|
632023443142373930222C0A222C4D20632023453443393535222C0A222C4E20
|
||||||
|
632023463544463542222C0A222C4F20632023454444303738222C0A222C5020
|
||||||
|
632023443239363531222C0A222C5120632023354436343936222C0A222C5220
|
||||||
|
632023454642433833222C0A222C5320632023434137373241222C0A222C5420
|
||||||
|
632023434437393235222C0A222C5520632023363136313836222C0A222C5620
|
||||||
|
632023333536304246222C0A222C5720632023414138393433222C0A222C5820
|
||||||
|
632023464646324530222C0A222C5920632023443839413534222C0A222C5A20
|
||||||
|
632023424537413141222C0A222C3020632023433539383439222C0A222C3120
|
||||||
|
632023423738383439222C0A222C3220632023343235343943222C0A222C3320
|
||||||
|
632023364436343741222C0A222C3420632023434537453245222C0A222C3520
|
||||||
|
632023443341323644222C0A222C3620632023323035304233222C0A222C3720
|
||||||
|
632023383136343244222C0A222C3820632023463943373934222C0A222C3920
|
||||||
|
632023463943393931222C0A222C4020632023433938353431222C0A222C2320
|
||||||
|
632023413436323233222C0A222C3B20632023334434393839222C0A222C3A20
|
||||||
|
632023323434464232222C0A222C3D20632023353533443131222C0A222C2B20
|
||||||
|
632023383735463238222C0A222C2520632023424438383439222C0A222C2420
|
||||||
|
632023424338443432222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2C2E2D2E
|
||||||
|
2A2E612E622E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E632E
|
||||||
|
642E652E662E672E682E692E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E
|
||||||
|
6A2E6B2E6C2E6D2E6E2E6F2E702E712E2E2E2E2E2E2E2E2E2E222C0A222E2E2E
|
||||||
|
2E2E2E2E722E732E742E752E762E772E782E792E2E2E2E2E2E2E2E2E2E222C0A
|
||||||
|
222E2E2E2E2E2E2E7A2E412E422E432E442E452E462E472E2E2E482E492E4A2E
|
||||||
|
2E222C0A222E2E2E2E2E2E2E4B2E4C2E4D2E4E2E4F2E4D2E502E512E522E532E
|
||||||
|
542E552E56222C0A222E2E2E2E2E2E2E572E582E592E5A2E5A2E302E312E322E
|
||||||
|
332E342E352E362E37222C0A222E2E2E2E2E2E2E382E392E402E232E232E3B2E
|
||||||
|
3A2E3D2E2B2E252E242E282E2E222C0A222E2E2E2E2E292E5B2E5D2C2E2C2C2C
|
||||||
|
2D2C2A2C612C622C632C642C652E2E2E2E222C0A222E2E2C662C672C682C692C
|
||||||
|
6A2C6B2C6C2C612C6D2C6E2C6F2C702C712E2E2E2E222C0A222C722C732C742C
|
||||||
|
752C762C772C782C792C7A2C412C422C432C442C452E2E2E2E222C0A222C462C
|
||||||
|
472C482C492C4A2C4B2C4C2C4D2C4E2C4F2C502C512C522C532E2E2E2E222C0A
|
||||||
|
222E2E2C542C552C562C572C582C592C5A2C302C312C322C332C342C352E2E2E
|
||||||
|
2E222C0A222E2E2E2E2E2E2C362C372C382C392C402C232C3B2C3A2E2E2E2E2E
|
||||||
|
2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2C3D2C2B2C252C242E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E227D0AB10A00002F2A2058504D202A2F0A737461746963
|
||||||
|
2063686172202A677261706869635B5D203D207B0A2231362031362031333220
|
||||||
|
32222C0A222E2E2063204E6F6E65222C0A222E2C20632023384434383132222C
|
||||||
|
0A222E2D20632023393034423130222C0A222E2A20632023384134383046222C
|
||||||
|
0A222E6120632023374434323131222C0A222E6220632023354233333135222C
|
||||||
|
0A222E6320632023393634453131222C0A222E6420632023394235383132222C
|
||||||
|
0A222E6520632023393935383132222C0A222E6620632023393335333131222C
|
||||||
|
0A222E6720632023383734413046222C0A222E6820632023373133453045222C
|
||||||
|
0A222E6920632023344232453133222C0A222E6A20632023393734423046222C
|
||||||
|
0A222E6B20632023394635383132222C0A222E6C20632023384134413046222C
|
||||||
|
0A222E6D20632023383734423046222C0A222E6E20632023383734423131222C
|
||||||
|
0A222E6F20632023383534433135222C0A222E7020632023373534313132222C
|
||||||
|
0A222E7120632023354333333046222C0A222E7220632023383733453043222C
|
||||||
|
0A222E7320632023423839373743222C0A222E7420632023453442373841222C
|
||||||
|
0A222E7520632023433839433731222C0A222E7620632023364534303135222C
|
||||||
|
0A222E7720632023373234343139222C0A222E7820632023364234353232222C
|
||||||
|
0A222E7920632023363633423131222C0A222E7A20632023394235453146222C
|
||||||
|
0A222E4120632023463745384439222C0A222E4220632023463143353937222C
|
||||||
|
0A222E4320632023453542423845222C0A222E4420632023443141393746222C
|
||||||
|
0A222E4520632023444642353839222C0A222E4620632023454544464344222C
|
||||||
|
0A222E4720632023413736383233222C0A222E4820632023393235423241222C
|
||||||
|
0A222E4920632023454543414136222C0A222E4A20632023454143434142222C
|
||||||
|
0A222E4B20632023463644304137222C0A222E4C20632023463644304138222C
|
||||||
|
0A222E4D20632023454543444137222C0A222E4E20632023394136323244222C
|
||||||
|
0A222E4F20632023323533433641222C0A222E5020632023413736443334222C
|
||||||
|
0A222E5120632023463843433943222C0A222E5220632023463744344146222C
|
||||||
|
0A222E5320632023463643464135222C0A222E5420632023414537343334222C
|
||||||
|
0A222E5520632023324433453638222C0A222E5620632023314334384243222C
|
||||||
|
0A222E5720632023443445324634222C0A222E5820632023413937423445222C
|
||||||
|
0A222E5920632023413837423444222C0A222E5A20632023433344364633222C
|
||||||
|
0A222E3020632023314334364245222C0A222E3120632023314634434334222C
|
||||||
|
0A222E3220632023443645344636222C0A222E3320632023413445344646222C
|
||||||
|
0A222E3420632023373244344646222C0A222E3520632023363943394646222C
|
||||||
|
0A222E3620632023363343304646222C0A222E3720632023354642364646222C
|
||||||
|
0A222E3820632023413039303935222C0A222E3920632023433135443239222C
|
||||||
|
0A222E4020632023424234323035222C0A222E2320632023423034353042222C
|
||||||
|
0A222E3B20632023343435343841222C0A222E3A20632023414243384643222C
|
||||||
|
0A222E3D20632023393844314646222C0A222E2B20632023364443374645222C
|
||||||
|
0A222E2520632023363842464645222C0A222E2420632023363442394645222C
|
||||||
|
0A222E2820632023354542314645222C0A222E2920632023384238323935222C
|
||||||
|
0A222E5B20632023434537343344222C0A222E5D20632023463742353844222C
|
||||||
|
0A222C2E20632023464544364238222C0A222C2C20632023463541383732222C
|
||||||
|
0A222C2D20632023434136423244222C0A222C2A20632023434537433238222C
|
||||||
|
0A222C6120632023454142333738222C0A222C6220632023393439454233222C
|
||||||
|
0A222C6320632023363042374646222C0A222C6420632023363342364646222C
|
||||||
|
0A222C6520632023363142324645222C0A222C6620632023354441434645222C
|
||||||
|
0A222C6720632023353941354645222C0A222C6820632023414235303234222C
|
||||||
|
0A222C6920632023463642353844222C0A222C6A20632023464639323444222C
|
||||||
|
0A222C6B20632023464637373131222C0A222C6C20632023464638363231222C
|
||||||
|
0A222C6D20632023454238413430222C0A222C6E20632023423934343033222C
|
||||||
|
0A222C6F20632023443137443239222C0A222C7020632023454542413832222C
|
||||||
|
0A222C7120632023353836363946222C0A222C7220632023383442424635222C
|
||||||
|
0A222C7320632023354241434646222C0A222C7420632023354141384645222C
|
||||||
|
0A222C7520632023353741324645222C0A222C7620632023353339434645222C
|
||||||
|
0A222C7720632023424334323035222C0A222C7820632023464543444145222C
|
||||||
|
0A222C7920632023464646464646222C0A222C7A20632023454637463138222C
|
||||||
|
0A222C4120632023424334323034222C0A222C4220632023434437393235222C
|
||||||
|
0A222C4320632023363136313836222C0A222C4420632023333536304246222C
|
||||||
|
0A222C4520632023363142394645222C0A222C4620632023363242394645222C
|
||||||
|
0A222C4720632023414635323146222C0A222C4820632023463439443633222C
|
||||||
|
0A222C4920632023464637463138222C0A222C4A20632023463837363030222C
|
||||||
|
0A222C4B20632023454537363030222C0A222C4C20632023453136383033222C
|
||||||
|
0A222C4D20632023423934353033222C0A222C4E20632023323035304233222C
|
||||||
|
0A222C4F20632023314634304130222C0A222C5020632023323234354141222C
|
||||||
|
0A222C5120632023323234364143222C0A222C5220632023323234344142222C
|
||||||
|
0A222C5320632023373434433546222C0A222C5420632023433636333237222C
|
||||||
|
0A222C5520632023453637373231222C0A222C5620632023454137393035222C
|
||||||
|
0A222C5720632023444436343031222C0A222C5820632023424434443034222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2C2E2D2E2A2E612E622E2E2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E632E642E652E662E672E68
|
||||||
|
2E692E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E6A2E6B2E6C2E6D2E6E
|
||||||
|
2E6F2E702E712E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E722E732E74
|
||||||
|
2E752E762E772E782E792E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E7A
|
||||||
|
2E412E422E432E442E452E462E472E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2E482E492E4A2E4B2E4C2E4A2E4D2E4E2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E4F2E502E512E522E522E532E542E552E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E562E572E582E592E592E582E5A2E302E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E312E322E332E342E352E362E372E382E392E40
|
||||||
|
2E232E2E2E2E222C0A222E2E2E2E2E3B2E3A2E3D2E2B2E252E242E282E292E5B
|
||||||
|
2E5D2C2E2C2C2C2D2E2E222C0A222E2E2C2A2C612C622C632C642C652C662C67
|
||||||
|
2C682C692C6A2C6B2C6C2C6D2C6E222C0A222E2E2C6F2C702C712C722C732C74
|
||||||
|
2C752C762C772C782C792C792C792C7A2C41222C0A222E2E2E2E2C422C432C44
|
||||||
|
2C452C462C462C462C472C482C492C4A2C4B2C4C2C4D222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2C4E2C4F2C502C512C522C532C542C552C562C572C582E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2C4D2C412C4D2E2E2E2E227D
|
||||||
|
0A
|
||||||
|
}
|
||||||
|
end
|
||||||
|
object ilAccesslevel: TImageList
|
||||||
|
left = 176
|
||||||
|
Bitmap = {
|
||||||
|
6C69040000001000000010000000F10C00002F2A2058504D202A2F0A73746174
|
||||||
|
69632063686172202A677261706869635B5D203D207B0A223136203136203136
|
||||||
|
382032222C0A222E2E2063204E6F6E65222C0A222E2C20632023413341334133
|
||||||
|
222C0A222E2D20632023413041304130222C0A222E2A20632023394439443944
|
||||||
|
222C0A222E6120632023394139413941222C0A222E6220632023393739373937
|
||||||
|
222C0A222E6320632023393439343934222C0A222E6420632023413241324132
|
||||||
|
222C0A222E6520632023424342434243222C0A222E6620632023434143414341
|
||||||
|
222C0A222E6720632023434343434343222C0A222E6820632023433243324332
|
||||||
|
222C0A222E6920632023414441444144222C0A222E6A20632023384338433843
|
||||||
|
222C0A222E6B20632023413141314131222C0A222E6C20632023433443344334
|
||||||
|
222C0A222E6D20632023424542454245222C0A222E6E20632023393639363936
|
||||||
|
222C0A222E6F20632023393339333933222C0A222E7020632023414541454145
|
||||||
|
222C0A222E7120632023383438343834222C0A222E7220632023424142414241
|
||||||
|
222C0A222E7320632023424642464246222C0A222E7420632023393839383938
|
||||||
|
222C0A222E7520632023383738373837222C0A222E7620632023413841384138
|
||||||
|
222C0A222E7720632023394539453945222C0A222E7820632023383938393839
|
||||||
|
222C0A222E7920632023413941394139222C0A222E7A20632023373937393739
|
||||||
|
222C0A222E4120632023393939393939222C0A222E4220632023433643364336
|
||||||
|
222C0A222E4320632023374437443744222C0A222E4420632023414241424142
|
||||||
|
222C0A222E4520632023373637363736222C0A222E4620632023453143333631
|
||||||
|
222C0A222E4720632023413841303838222C0A222E4820632023393139313931
|
||||||
|
222C0A222E4920632023384538453845222C0A222E4A20632023444342393541
|
||||||
|
222C0A222E4B20632023444642383535222C0A222E4C20632023444542353531
|
||||||
|
222C0A222E4D20632023444442313444222C0A222E4E20632023444341443439
|
||||||
|
222C0A222E4F20632023443741383436222C0A222E5020632023373837383738
|
||||||
|
222C0A222E5120632023384437453635222C0A222E5220632023443839393331
|
||||||
|
222C0A222E5320632023453143323630222C0A222E5420632023464346334339
|
||||||
|
222C0A222E5520632023464446334342222C0A222E5620632023464546364434
|
||||||
|
222C0A222E5720632023464646364437222C0A222E5820632023464646344438
|
||||||
|
222C0A222E5920632023464646384530222C0A222E5A20632023464646384446
|
||||||
|
222C0A222E3020632023464646354441222C0A222E3120632023464346314344
|
||||||
|
222C0A222E3220632023464145444332222C0A222E3320632023464145424244
|
||||||
|
222C0A222E3420632023443639333242222C0A222E3520632023453042463543
|
||||||
|
222C0A222E3620632023464346334338222C0A222E3720632023463944463735
|
||||||
|
222C0A222E3820632023464445363839222C0A222E3920632023464645373935
|
||||||
|
222C0A222E4020632023464645353941222C0A222E2320632023464645454141
|
||||||
|
222C0A222E3B20632023464645444138222C0A222E3A20632023464645333939
|
||||||
|
222C0A222E3D20632023463944353734222C0A222E2B20632023463343433539
|
||||||
|
222C0A222E2520632023463143383446222C0A222E2420632023464145394242
|
||||||
|
222C0A222E2820632023443538443234222C0A222E2920632023444642423538
|
||||||
|
222C0A222E5B20632023464346314337222C0A222E5D20632023463944433646
|
||||||
|
222C0A222C2E20632023454442423536222C0A222C2C20632023454642443631
|
||||||
|
222C0A222C2D20632023464645373942222C0A222C2A20632023453241363335
|
||||||
|
222C0A222C6120632023453141343442222C0A222C6220632023464645323930
|
||||||
|
222C0A222C6320632023453941443439222C0A222C6420632023453341343338
|
||||||
|
222C0A222C6520632023463043343439222C0A222C6620632023463945384238
|
||||||
|
222C0A222C6720632023443438383145222C0A222C6820632023444542373533
|
||||||
|
222C0A222C6920632023464346304336222C0A222C6A20632023463844393641
|
||||||
|
222C0A222C6B20632023464445323743222C0A222C6C20632023464645383930
|
||||||
|
222C0A222C6D20632023464645393939222C0A222C6E20632023444639463332
|
||||||
|
222C0A222C6F20632023423238423534222C0A222C7020632023464645323841
|
||||||
|
222C0A222C7120632023463944303641222C0A222C7220632023463143353530
|
||||||
|
222C0A222C7320632023463043313436222C0A222C7420632023463945374236
|
||||||
|
222C0A222C7520632023443338333138222C0A222C7620632023444442323445
|
||||||
|
222C0A222C7720632023464245464333222C0A222C7820632023463844363635
|
||||||
|
222C0A222C7920632023454342363443222C0A222C7A20632023454642443541
|
||||||
|
222C0A222C4120632023464645423935222C0A222C4220632023444439373330
|
||||||
|
222C0A222C4320632023414238323444222C0A222C4420632023464645313834
|
||||||
|
222C0A222C4520632023453941393431222C0A222C4620632023453139463332
|
||||||
|
222C0A222C4720632023454642453432222C0A222C4820632023463945354234
|
||||||
|
222C0A222C4920632023443237453133222C0A222C4A20632023464245454331
|
||||||
|
222C0A222C4B20632023463744333546222C0A222C4C20632023464344423643
|
||||||
|
222C0A222C4D20632023464645353746222C0A222C4E20632023464645443846
|
||||||
|
222C0A222C4F20632023464646323937222C0A222C5020632023464645443933
|
||||||
|
222C0A222C5120632023464644463743222C0A222C5220632023463843433542
|
||||||
|
222C0A222C5320632023454642453436222C0A222C5420632023454542413343
|
||||||
|
222C0A222C5520632023463945334233222C0A222C5620632023443137393045
|
||||||
|
222C0A222C5720632023444241383433222C0A222C5820632023464245434246
|
||||||
|
222C0A222C5920632023463543463539222C0A222C5A20632023454342303431
|
||||||
|
222C0A222C3020632023454642413445222C0A222C3120632023454643323541
|
||||||
|
222C0A222C3220632023454643363630222C0A222C3320632023454643343543
|
||||||
|
222C0A222C3420632023454642363443222C0A222C3520632023453641353337
|
||||||
|
222C0A222C3620632023453139413241222C0A222C3720632023454542383338
|
||||||
|
222C0A222C3820632023463845334231222C0A222C3920632023443037353039
|
||||||
|
222C0A222C4020632023444141333344222C0A222C2320632023464145424243
|
||||||
|
222C0A222C3B20632023464345424243222C0A222C3A20632023464545454246
|
||||||
|
222C0A222C3D20632023464646344336222C0A222C2B20632023464646384345
|
||||||
|
222C0A222C2520632023464646414433222C0A222C2420632023464646384430
|
||||||
|
222C0A222C2820632023464646324337222C0A222C2920632023464345394241
|
||||||
|
222C0A222C5B20632023463945344233222C0A222C5D20632023463845324230
|
||||||
|
222C0A222D2E20632023434637313035222C0A222D2C20632023443939443336
|
||||||
|
222C0A222D2D20632023443739343243222C0A222D2A20632023443639303238
|
||||||
|
222C0A222D6120632023443538433233222C0A222D6220632023443338343141
|
||||||
|
222C0A222D6320632023443238303135222C0A222D6420632023443137433131
|
||||||
|
222C0A222D6520632023443037363041222C0A222D6620632023434637333037
|
||||||
|
222C0A222D6720632023434637303034222C0A222D6820632023434536453031
|
||||||
|
222C0A222E2E2E2E2E2E2E2E2E2E2E2C2E2D2E2A2E612E622E632E2E2E2E2E2E
|
||||||
|
2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E642E652E662E672E662E682E692E6A
|
||||||
|
2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E6B2E6C2E6D2E6B2E6E2E6F2E62
|
||||||
|
2E702E702E712E2E2E2E2E2E222C0A222E2E2E2E2E2E2E722E732E742E2E2E2E
|
||||||
|
2E2E2E2E2E752E762E772E2E2E2E2E2E222C0A222E2E2E2E2E2A2E6C2E6B2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E782E792E7A2E2E2E2E222C0A222E2E2E2E2E412E42
|
||||||
|
2E632E2E2E2E2E2E2E2E2E2E2E2E2E432E442E452E2E2E2E222C0A222E2E2E46
|
||||||
|
2E472E482E492E4A2E4B2E4C2E4D2E4E2E4F2E502E452E512E522E2E222C0A22
|
||||||
|
2E2E2E532E542E552E562E572E582E592E5A2E302E312E322E332E332E342E2E
|
||||||
|
222C0A222E2E2E352E362E372E382E392E402E232E3B2E3A2E3D2E2B2E252E24
|
||||||
|
2E282E2E222C0A222E2E2E292E5B2E5D2C2E2C2C2C2D2C2A2C612C622C632C64
|
||||||
|
2C652C662C672E2E222C0A222E2E2C682C692C6A2C6B2C6C2C6D2C6E2C6F2C70
|
||||||
|
2C712C722C732C742C752E2E222C0A222E2E2C762C772C782C792C7A2C412C42
|
||||||
|
2C432C442C452C462C472C482C492E2E222C0A222E2E2E4E2C4A2C4B2C4C2C4D
|
||||||
|
2C4E2C4F2C502C512C522C532C542C552C562E2E222C0A222E2E2C572C582C59
|
||||||
|
2C5A2C302C312C322C332C342C352C362C372C382C392E2E222C0A222E2E2C40
|
||||||
|
2C232C3B2C3A2C3D2C2B2C252C242C282C292C5B2C5D2C5D2D2E2E2E222C0A22
|
||||||
|
2E2E2D2C2E522D2D2D2A2D612C672D622D632D642C562D652D662D672D682E2E
|
||||||
|
227D0A410900002F2A2058504D202A2F0A7374617469632063686172202A6772
|
||||||
|
61706869635B5D203D207B0A223136203136203130392032222C0A222E2E2063
|
||||||
|
204E6F6E65222C0A222E2C20632023363835443536222C0A222E2D2063202337
|
||||||
|
4133463133222C0A222E2A20632023374433453044222C0A222E612063202337
|
||||||
|
3633433043222C0A222E6220632023363933393132222C0A222E632063202336
|
||||||
|
3335363445222C0A222E6420632023363936333546222C0A222E652063202337
|
||||||
|
4434443238222C0A222E6620632023393636313244222C0A222E672063202338
|
||||||
|
3834393046222C0A222E6820632023393336303243222C0A222E692063202337
|
||||||
|
3333453043222C0A222E6A20632023363033443142222C0A222E6B2063202336
|
||||||
|
3335453539222C0A222E6C20632023373935323337222C0A222E6D2063202339
|
||||||
|
3335413235222C0A222E6E20632023373633453043222C0A222E6F2063202338
|
||||||
|
3535343234222C0A222E7020632023373333453045222C0A222E712063202338
|
||||||
|
3435353236222C0A222E7220632023363933453136222C0A222E732063202335
|
||||||
|
3033303134222C0A222E7420632023363733363131222C0A222E752063202337
|
||||||
|
3134423241222C0A222E7620632023394537353443222C0A222E772063202338
|
||||||
|
4536333342222C0A222E7820632023354233353131222C0A222E792063202337
|
||||||
|
4235323238222C0A222E7A20632023353933393143222C0A222E412063202335
|
||||||
|
3533323130222C0A222E4220632023373834383138222C0A222E432063202344
|
||||||
|
3142373942222C0A222E4420632023454443394133222C0A222E452063202345
|
||||||
|
3843353946222C0A222E4620632023434441313734222C0A222E472063202344
|
||||||
|
4442303831222C0A222E4820632023434542333936222C0A222E492063202337
|
||||||
|
4534433141222C0A222E4A20632023384635443330222C0A222E4B2063202345
|
||||||
|
4543414136222C0A222E4C20632023454143434142222C0A222E4D2063202346
|
||||||
|
3644304137222C0A222E4E20632023463644304138222C0A222E4F2063202345
|
||||||
|
4543444137222C0A222E5020632023394136323245222C0A222E512063202333
|
||||||
|
4433443344222C0A222E5220632023394536463431222C0A222E532063202346
|
||||||
|
3843433943222C0A222E5420632023463744344146222C0A222E552063202346
|
||||||
|
3643464135222C0A222E5620632023413637363431222C0A222E572063202333
|
||||||
|
3733373337222C0A222E5820632023343934393439222C0A222E592063202334
|
||||||
|
4234423442222C0A222E5A20632023393839383938222C0A222E302063202335
|
||||||
|
4335433543222C0A222E3120632023413337433535222C0A222E322063202334
|
||||||
|
4334433443222C0A222E3320632023344534453445222C0A222E342063202337
|
||||||
|
3737373737222C0A222E3520632023393739373937222C0A222E362063202335
|
||||||
|
3935393539222C0A222E3720632023414241424142222C0A222E382063202341
|
||||||
|
3541354135222C0A222E3920632023353435343534222C0A222E402063202338
|
||||||
|
3638363836222C0A222E2320632023363236323632222C0A222E3B2063202334
|
||||||
|
4134413441222C0A222E3A20632023363336333633222C0A222E3D2063202341
|
||||||
|
3441344134222C0A222E2B20632023353035303530222C0A222E252063202335
|
||||||
|
3235323532222C0A222E2420632023354235423542222C0A222E282063202342
|
||||||
|
3842384238222C0A222E2920632023433143314331222C0A222E5B2063202335
|
||||||
|
3735373537222C0A222E5D20632023344434443444222C0A222C2E2063202335
|
||||||
|
4135413541222C0A222C2C20632023374537453745222C0A222C2D2063202336
|
||||||
|
3036303630222C0A222C2A20632023434537433238222C0A222C612063202345
|
||||||
|
4142333738222C0A222C6220632023374137413741222C0A222C632063202338
|
||||||
|
3338333833222C0A222C6420632023354435443544222C0A222C652063202335
|
||||||
|
3535353535222C0A222C6620632023363436343634222C0A222C672063202335
|
||||||
|
4635463546222C0A222C6820632023364436443644222C0A222C692063202345
|
||||||
|
4442383745222C0A222C6A20632023433737343239222C0A222C6B2063202344
|
||||||
|
3137443239222C0A222C6C20632023454542413832222C0A222C6D2063202338
|
||||||
|
4638463846222C0A222C6E20632023373237323732222C0A222C6F2063202336
|
||||||
|
4636463646222C0A222C7020632023383438343834222C0A222C712063202345
|
||||||
|
4642433833222C0A222C7220632023434137373241222C0A222C732063202343
|
||||||
|
4437393235222C0A222C7420632023354535453545222C0A222C752063202334
|
||||||
|
4634463446222C0A222C7620632023383038303830222C0A222C772063202334
|
||||||
|
3534353435222C0A222C7820632023434537453245222C0A222C792063202344
|
||||||
|
3341323644222C0A222C7A20632023343734373437222C0A222C412063202333
|
||||||
|
3833383338222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2C2E2D2E2A2E612E
|
||||||
|
622E632E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E642E652E662E
|
||||||
|
672E682E692E6A2E6B2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E6C2E
|
||||||
|
6D2E6E2E6F2E702E712E722E732E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E
|
||||||
|
2E2E742E752E762E772E782E792E7A2E412E2E2E2E2E2E2E2E222C0A222E2E2E
|
||||||
|
2E2E2E2E2E2E422E432E442E452E462E472E482E492E2E2E2E2E2E2E2E222C0A
|
||||||
|
222E2E2E2E2E2E2E2E2E4A2E4B2E4C2E4D2E4E2E4C2E4F2E502E2E2E2E2E2E2E
|
||||||
|
2E222C0A222E2E2E2E2E2E2E2E2E512E522E532E542E542E552E562E572E2E2E
|
||||||
|
2E2E2E2E2E222C0A222E2E2E2E2E2E2E582E592E5A2E302E312E312E322E5A2E
|
||||||
|
332E322E2E2E2E2E2E222C0A222E2E2E2E2E342E322E332E352E362E372E382E
|
||||||
|
392E402E232E3B2E2E2E2E2E2E222C0A222E2E2E2E2E3A2E3D2E2B2E252E242E
|
||||||
|
282E292E5B2E5D2C2E2C2C2C2D2E2E2E2E222C0A222E2E2C2A2C612C622C632C
|
||||||
|
2C2C642E582E322C652C662C672C682C692C6A2E2E222C0A222E2E2C6B2C6C2C
|
||||||
|
672C6D2C622E342C682E332C6E2C6F2C702C652C712C722E2E222C0A222E2E2E
|
||||||
|
2E2C732C742C752C702C702C762E392C632C702E3B2C772C782C792E2E222C0A
|
||||||
|
222E2E2E2E2E2E2E2E2E512E5D2E582C7A2C7A2C772C7A2C412E2E2E2E2E2E2E
|
||||||
|
2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E227D0A210A00002F2A2058504D202A2F0A73746174696320636861
|
||||||
|
72202A677261706869635B5D203D207B0A223136203136203132332032222C0A
|
||||||
|
222E2E2063204E6F6E65222C0A222E2C20632023453542323237222C0A222E2D
|
||||||
|
20632023463341373142222C0A222E2A20632023463441433143222C0A222E61
|
||||||
|
20632023463441383143222C0A222E6220632023463141313142222C0A222E63
|
||||||
|
20632023444541433237222C0A222E6420632023453542353238222C0A222E65
|
||||||
|
20632023463542363142222C0A222E6620632023463542363143222C0A222E67
|
||||||
|
20632023463542323143222C0A222E6820632023463441423143222C0A222E69
|
||||||
|
20632023463041413144222C0A222E6A20632023453042303238222C0A222E6B
|
||||||
|
20632023463542413144222C0A222E6C20632023463441413143222C0A222E6D
|
||||||
|
20632023463341433143222C0A222E6E20632023463041313143222C0A222E6F
|
||||||
|
20632023453439333143222C0A222E7020632023463339453142222C0A222E71
|
||||||
|
20632023434541423632222C0A222E7220632023453442373841222C0A222E73
|
||||||
|
20632023454243363345222C0A222E7420632023454439463143222C0A222E75
|
||||||
|
20632023454541343144222C0A222E7620632023454241353145222C0A222E77
|
||||||
|
20632023453939413143222C0A222E7820632023414436443145222C0A222E79
|
||||||
|
20632023454644374244222C0A222E7A20632023454443394133222C0A222E41
|
||||||
|
20632023453843353944222C0A222E4220632023454643453434222C0A222E43
|
||||||
|
20632023454643443542222C0A222E4420632023463144434138222C0A222E45
|
||||||
|
20632023424437433230222C0A222E4620632023384536313243222C0A222E47
|
||||||
|
20632023454543414136222C0A222E4820632023454143434142222C0A222E49
|
||||||
|
20632023463644304137222C0A222E4A20632023463644304138222C0A222E4B
|
||||||
|
20632023454543444137222C0A222E4C20632023393936323244222C0A222E4D
|
||||||
|
20632023343937323443222C0A222E4E20632023393937343334222C0A222E4F
|
||||||
|
20632023463843433943222C0A222E5020632023463744344146222C0A222E51
|
||||||
|
20632023463643464135222C0A222E5220632023413137413335222C0A222E53
|
||||||
|
20632023343636413441222C0A222E5420632023354439333739222C0A222E55
|
||||||
|
20632023344538353237222C0A222E5620632023433846354233222C0A222E57
|
||||||
|
20632023384638393439222C0A222E5820632023413037463442222C0A222E59
|
||||||
|
20632023424145384139222C0A222E5A20632023344438343236222C0A222E30
|
||||||
|
20632023353938433733222C0A222E3120632023414345304146222C0A222E32
|
||||||
|
20632023354439343337222C0A222E3320632023433646443946222C0A222E34
|
||||||
|
20632023423845463931222C0A222E3520632023394644363738222C0A222E36
|
||||||
|
20632023393643443646222C0A222E3720632023384643363639222C0A222E38
|
||||||
|
20632023383842463632222C0A222E3920632023393843463733222C0A222E40
|
||||||
|
20632023423946303934222C0A222E2320632023353138383330222C0A222E3B
|
||||||
|
20632023353438373738222C0A222E3A20632023364339443834222C0A222E3D
|
||||||
|
20632023364241323435222C0A222E2B20632023413945303832222C0A222E25
|
||||||
|
20632023393043373639222C0A222E2420632023384243323634222C0A222E28
|
||||||
|
20632023383542433545222C0A222E2920632023374542353537222C0A222E5B
|
||||||
|
20632023373741453530222C0A222E5D20632023393143383642222C0A222C2E
|
||||||
|
20632023384143303637222C0A222C2C20632023363639413446222C0A222C2D
|
||||||
|
20632023363439323736222C0A222C2A20632023434537433238222C0A222C61
|
||||||
|
20632023454142333738222C0A222C6220632023383142383541222C0A222C63
|
||||||
|
20632023383943303632222C0A222C6420632023383642443546222C0A222C65
|
||||||
|
20632023374342333535222C0A222C6620632023373641443446222C0A222C67
|
||||||
|
20632023373041373439222C0A222C6820632023363739453431222C0A222C69
|
||||||
|
20632023373441423444222C0A222C6A20632023454442383745222C0A222C6B
|
||||||
|
20632023433737343239222C0A222C6C20632023443137443239222C0A222C6D
|
||||||
|
20632023454542413832222C0A222C6E20632023363739453430222C0A222C6F
|
||||||
|
20632023393543433645222C0A222C7020632023383142383542222C0A222C71
|
||||||
|
20632023374542353538222C0A222C7220632023374142313533222C0A222C73
|
||||||
|
20632023373541433446222C0A222C7420632023374142313534222C0A222C75
|
||||||
|
20632023373641443531222C0A222C7620632023384143313637222C0A222C77
|
||||||
|
20632023354339323342222C0A222C7820632023454642433833222C0A222C79
|
||||||
|
20632023434137373241222C0A222C7A20632023434437393235222C0A222C41
|
||||||
|
20632023363739443432222C0A222C4220632023353838463331222C0A222C43
|
||||||
|
20632023384143313633222C0A222C4420632023353338413244222C0A222C45
|
||||||
|
20632023353338383246222C0A222C4620632023434537453245222C0A222C47
|
||||||
|
20632023443341323644222C0A222C4820632023353738433636222C0A222C49
|
||||||
|
20632023353538423432222C0A222C4A20632023353238393333222C0A222C4B
|
||||||
|
20632023353138383245222C0A222C4C20632023353038373244222C0A222C4D
|
||||||
|
20632023344538353245222C0A222C4E20632023344538353339222C0A222C4F
|
||||||
|
20632023344538323446222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2C2E2D
|
||||||
|
2E2A2E612E622E632E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E64
|
||||||
|
2E652E662E662E672E682E692E6A2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E
|
||||||
|
2E2E2E6B2E662E6C2E2A2E2A2E6D2E6E2E6F2E2E2E2E2E2E2E2E222C0A222E2E
|
||||||
|
2E2E2E2E2E2E2E702E712E722E732E742E752E762E772E2E2E2E2E2E2E2E222C
|
||||||
|
0A222E2E2E2E2E2E2E2E2E782E792E7A2E412E422E432E442E452E2E2E2E2E2E
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2E462E472E482E492E4A2E482E4B2E4C2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E4D2E4E2E4F2E502E502E512E52
|
||||||
|
2E532E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E542E552E562E572E582E58
|
||||||
|
2E572E592E5A2E302E2E2E2E2E2E222C0A222E2E2E2E2E312E322E332E342E35
|
||||||
|
2E362E372E382E392E402E232E3B2E2E2E2E222C0A222E2E2E3A2E3D2E2B2E2B
|
||||||
|
2E362E252E242E282E292E5B2E5D2C2E2C2C2C2D2E2E222C0A222E2E2C2A2C61
|
||||||
|
2C622C632C632C642C622C652C662C672C682C692C6A2C6B2E2E222C0A222E2E
|
||||||
|
2C6C2C6D2C6E2C6F2C702C712C722C732C742C752C762C772C782C792E2E222C
|
||||||
|
0A222E2E2E2E2C7A2C412C422C432C432C432C432C432C432C442C452C462C47
|
||||||
|
2E2E222C0A222E2E2E2E2E2E2E2E2C482C492C4A2C4B2C4C2C4D2C4E2C4F2E2E
|
||||||
|
2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E227D0AA10A00002F2A2058504D202A2F0A7374617469
|
||||||
|
632063686172202A677261706869635B5D203D207B0A22313620313620313331
|
||||||
|
2032222C0A222E2E2063204E6F6E65222C0A222E2C2063202336383544353622
|
||||||
|
2C0A222E2D20632023374133463133222C0A222E2A2063202337443345304422
|
||||||
|
2C0A222E6120632023373633433043222C0A222E622063202336393339313222
|
||||||
|
2C0A222E6320632023363335363445222C0A222E642063202336393633354622
|
||||||
|
2C0A222E6520632023374434443238222C0A222E662063202338413439304622
|
||||||
|
2C0A222E6720632023383834393046222C0A222E682063202338313435304522
|
||||||
|
2C0A222E6920632023373333453043222C0A222E6A2063202336303344314222
|
||||||
|
2C0A222E6B20632023363335453539222C0A222E6C2063202337393532333722
|
||||||
|
2C0A222E6D20632023384634393046222C0A222E6E2063202337363345304322
|
||||||
|
2C0A222E6F20632023373333453045222C0A222E702063202337303346313122
|
||||||
|
2C0A222E7120632023363133363046222C0A222E722063202335303330313422
|
||||||
|
2C0A222E7320632023373333373130222C0A222E742063202342353933373822
|
||||||
|
2C0A222E7520632023453442373841222C0A222E762063202343333933363722
|
||||||
|
2C0A222E7720632023354233353131222C0A222E782063202335463339313522
|
||||||
|
2C0A222E7920632023353933393143222C0A222E7A2063202335353332313022
|
||||||
|
2C0A222E4120632023393935433146222C0A222E422063202345464437424422
|
||||||
|
2C0A222E4320632023454443394133222C0A222E442063202345384335394622
|
||||||
|
2C0A222E4520632023434441313734222C0A222E462063202344444230383122
|
||||||
|
2C0A222E4720632023454244334237222C0A222E482063202341343635323322
|
||||||
|
2C0A222E4920632023383935463339222C0A222E4A2063202345454341413622
|
||||||
|
2C0A222E4B20632023454143434142222C0A222E4C2063202346364430413722
|
||||||
|
2C0A222E4D20632023463644304138222C0A222E4E2063202345454344413722
|
||||||
|
2C0A222E4F20632023393936323246222C0A222E502063202333453642393622
|
||||||
|
2C0A222E5120632023393137323533222C0A222E522063202346384343394322
|
||||||
|
2C0A222E5320632023463744344146222C0A222E542063202346364346413522
|
||||||
|
2C0A222E5520632023394137393531222C0A222E562063202333433634384322
|
||||||
|
2C0A222E5720632023343537364135222C0A222E582063202333463744423122
|
||||||
|
2C0A222E5920632023413042454438222C0A222E5A2063202337313832393622
|
||||||
|
2C0A222E3020632023413437323535222C0A222E312063202342353545343322
|
||||||
|
2C0A222E3220632023354637394132222C0A222E332063202341304245443922
|
||||||
|
2C0A222E3420632023343238304234222C0A222E352063202334363735413822
|
||||||
|
2C0A222E3620632023373039414332222C0A222E372063202334313744423222
|
||||||
|
2C0A222E3820632023394542464443222C0A222E392063202334433841424522
|
||||||
|
2C0A222E4020632023424342364334222C0A222E232063202343383637354522
|
||||||
|
2C0A222E3B20632023344438314233222C0A222E3A2063202338384230443322
|
||||||
|
2C0A222E3D20632023353939314332222C0A222E2B2063202333453741414622
|
||||||
|
2C0A222E2520632023343136463946222C0A222E242063202334413737413522
|
||||||
|
2C0A222E2820632023354239324333222C0A222E292063202342304341453222
|
||||||
|
2C0A222E5B20632023343438324236222C0A222E5D2063202334353833423722
|
||||||
|
2C0A222C2E20632023353538384238222C0A222C2C2063202344303542344122
|
||||||
|
2C0A222C2D20632023443236303530222C0A222C2A2063202334433837424122
|
||||||
|
2C0A222C6120632023343137464233222C0A222C622063202334453841424622
|
||||||
|
2C0A222C6320632023374441394430222C0A222C642063202335373844424522
|
||||||
|
2C0A222C6520632023343636463943222C0A222C662063202343453743323822
|
||||||
|
2C0A222C6720632023454142333738222C0A222C682063202337394136434522
|
||||||
|
2C0A222C6920632023383341454432222C0A222C6A2063202335393838423722
|
||||||
|
2C0A222C6B20632023413634453444222C0A222C6C2063202337433632373722
|
||||||
|
2C0A222C6D20632023344238344236222C0A222C6E2063202335433933433422
|
||||||
|
2C0A222C6F20632023353538454331222C0A222C702063202336373941433722
|
||||||
|
2C0A222C7120632023454442383745222C0A222C722063202343373734323922
|
||||||
|
2C0A222C7320632023443137443239222C0A222C742063202345454241383222
|
||||||
|
2C0A222C7520632023353538464331222C0A222C762063202339344239443822
|
||||||
|
2C0A222C7720632023373841364345222C0A222C782063202337354133434322
|
||||||
|
2C0A222C7920632023373039334241222C0A222C7A2063202334343746423222
|
||||||
|
2C0A222C4120632023364539464341222C0A222C422063202336393943433822
|
||||||
|
2C0A222C4320632023383541454433222C0A222C442063202334393834423822
|
||||||
|
2C0A222C4520632023454642433833222C0A222C462063202343413737324122
|
||||||
|
2C0A222C4720632023434437393235222C0A222C482063202335343845433022
|
||||||
|
2C0A222C4920632023343338314235222C0A222C4A2063202338354146443322
|
||||||
|
2C0A222C4B20632023374641424431222C0A222C4C2063202334373835423922
|
||||||
|
2C0A222C4D20632023334637424230222C0A222C4E2063202333433736413922
|
||||||
|
2C0A222C4F20632023434537453245222C0A222C502063202344334132364422
|
||||||
|
2C0A222C5120632023333436363939222C0A222C522063202334313741414622
|
||||||
|
2C0A222C5320632023334437394145222C0A222C542063202333433738414422
|
||||||
|
2C0A222C5520632023333937354141222C0A222C562063202333433735414122
|
||||||
|
2C0A222C5720632023333136313933222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2C2E2D2E2A2E612E622E632E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E
|
||||||
|
2E2E2E2E642E652E662E672E682E692E6A2E6B2E2E2E2E2E2E2E2E222C0A222E
|
||||||
|
2E2E2E2E2E2E2E2E6C2E6D2E6E2E692E6F2E702E712E722E2E2E2E2E2E2E2E22
|
||||||
|
2C0A222E2E2E2E2E2E2E2E2E732E742E752E762E772E782E792E7A2E2E2E2E2E
|
||||||
|
2E2E2E222C0A222E2E2E2E2E2E2E2E2E412E422E432E442E452E462E472E482E
|
||||||
|
2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E492E4A2E4B2E4C2E4D2E4B2E
|
||||||
|
4E2E4F2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E502E512E522E532E
|
||||||
|
532E542E552E562E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E572E582E592E
|
||||||
|
5A2E302E312E322E332E342E352E2E2E2E2E2E222C0A222E2E2E2E2E362E372E
|
||||||
|
342E382E392E402E232E3B2E3A2E3D2E2B2E252E2E2E2E222C0A222E2E2E242E
|
||||||
|
282E292E5B2E5D2C2E2C2C2C2D2C2A2C612C622C632C642C652E2E222C0A222E
|
||||||
|
2E2C662C672C682C692C632C6A2C6B2C6C2C6D2C6E2C6F2C702C712C722E2E22
|
||||||
|
2C0A222E2E2C732C742C752C762C772C782C792C7A2C412C422C432C442C452C
|
||||||
|
462E2E222C0A222E2E2E2E2C472C482C492C4A2C4A2C4B2C4C2C692C4A2C4D2C
|
||||||
|
4E2C4F2C502E2E222C0A222E2E2E2E2E2E2E2E2C512C522C532C542C542C552C
|
||||||
|
562C572E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,354 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmAccountControl;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
||||||
|
VirtualTrees, VTHeaderPopup, UEnhancedMemoryStream, UEnums;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmAccountControl }
|
||||||
|
|
||||||
|
TfrmAccountControl = class(TForm)
|
||||||
|
ilToolbar: TImageList;
|
||||||
|
ilAccesslevel: TImageList;
|
||||||
|
tbMain: TToolBar;
|
||||||
|
tbRefresh: TToolButton;
|
||||||
|
tbAddUser: TToolButton;
|
||||||
|
tbEditUser: TToolButton;
|
||||||
|
tbDeleteUser: TToolButton;
|
||||||
|
tbSeparator1: TToolButton;
|
||||||
|
vstAccounts: TVirtualStringTree;
|
||||||
|
procedure tbEditUserClick(Sender: TObject);
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure tbAddUserClick(Sender: TObject);
|
||||||
|
procedure tbDeleteUserClick(Sender: TObject);
|
||||||
|
procedure tbRefreshClick(Sender: TObject);
|
||||||
|
procedure vstAccountsDblClick(Sender: TObject);
|
||||||
|
procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
|
||||||
|
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||||||
|
var Ghosted: Boolean; var ImageIndex: Integer);
|
||||||
|
procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||||
|
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
|
||||||
|
protected
|
||||||
|
procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||||
|
procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||||
|
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
function FindNode(AUsername: string): PVirtualNode;
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmAccountControl: TfrmAccountControl;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount;
|
||||||
|
|
||||||
|
type
|
||||||
|
PAccountInfo = ^TAccountInfo;
|
||||||
|
TAccountInfo = record
|
||||||
|
Username: string;
|
||||||
|
AccessLevel: TAccessLevel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TModifyUserPacket }
|
||||||
|
|
||||||
|
TModifyUserPacket = class(TPacket)
|
||||||
|
constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TDeleteUserPacket }
|
||||||
|
|
||||||
|
TDeleteUserPacket = class(TPacket)
|
||||||
|
constructor Create(AUsername: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRequestUserListPacket }
|
||||||
|
|
||||||
|
TRequestUserListPacket = class(TPacket)
|
||||||
|
constructor Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TModifyUserPacket }
|
||||||
|
|
||||||
|
constructor TModifyUserPacket.Create(AUsername, APassword: string;
|
||||||
|
AAccessLevel: TAccessLevel);
|
||||||
|
begin
|
||||||
|
inherited Create($03, 0);
|
||||||
|
FStream.WriteByte($05);
|
||||||
|
FStream.WriteStringNull(AUsername);
|
||||||
|
FStream.WriteStringNull(APassword);
|
||||||
|
FStream.WriteByte(Byte(AAccessLevel));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TDeleteUserPacket }
|
||||||
|
|
||||||
|
constructor TDeleteUserPacket.Create(AUsername: string);
|
||||||
|
begin
|
||||||
|
inherited Create($03, 0);
|
||||||
|
FStream.WriteByte($06);
|
||||||
|
FStream.WriteStringNull(AUsername);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRequestUserListPacket }
|
||||||
|
|
||||||
|
constructor TRequestUserListPacket.Create;
|
||||||
|
begin
|
||||||
|
inherited Create($03, 0);
|
||||||
|
FStream.WriteByte($07);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TfrmAccountControl }
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
|
||||||
|
|
||||||
|
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserResponse);
|
||||||
|
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserResponse);
|
||||||
|
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.FormClose(Sender: TObject;
|
||||||
|
var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.tbEditUserClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
selected: PVirtualNode;
|
||||||
|
accountInfo: PAccountInfo;
|
||||||
|
begin
|
||||||
|
selected := vstAccounts.GetFirstSelected;
|
||||||
|
if selected <> nil then
|
||||||
|
begin
|
||||||
|
accountInfo := vstAccounts.GetNodeData(selected);
|
||||||
|
with frmEditAccount do
|
||||||
|
begin
|
||||||
|
edUsername.Text := accountInfo^.Username;
|
||||||
|
edUsername.Color := clBtnFace;
|
||||||
|
edUsername.ReadOnly := True;
|
||||||
|
edPassword.Text := '';
|
||||||
|
lblPasswordHint.Visible := True;
|
||||||
|
SetAccessLevel(accountInfo^.AccessLevel);
|
||||||
|
if ShowModal = mrOK then
|
||||||
|
dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text, GetAccessLevel));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if AdminPacketHandlers[$05] <> nil then FreeAndNil(AdminPacketHandlers[$05]);
|
||||||
|
if AdminPacketHandlers[$06] <> nil then FreeAndNil(AdminPacketHandlers[$06]);
|
||||||
|
if AdminPacketHandlers[$07] <> nil then FreeAndNil(AdminPacketHandlers[$07]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
tbRefreshClick(Sender);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.tbAddUserClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
with frmEditAccount do
|
||||||
|
begin
|
||||||
|
edUsername.Text := '';
|
||||||
|
edUsername.Color := clWindow;
|
||||||
|
edUsername.ReadOnly := False;
|
||||||
|
edPassword.Text := '';
|
||||||
|
lblPasswordHint.Visible := False;
|
||||||
|
cbAccessLevel.ItemIndex := 2;
|
||||||
|
if ShowModal = mrOK then
|
||||||
|
dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text, GetAccessLevel));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.tbDeleteUserClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
selected: PVirtualNode;
|
||||||
|
accountInfo: PAccountInfo;
|
||||||
|
begin
|
||||||
|
selected := vstAccounts.GetFirstSelected;
|
||||||
|
if selected <> nil then
|
||||||
|
begin
|
||||||
|
accountInfo := vstAccounts.GetNodeData(selected);
|
||||||
|
if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?', [accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
|
||||||
|
dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.tbRefreshClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
dmNetwork.Send(TRequestUserListPacket.Create);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
tbEditUserClick(Sender);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
|
||||||
|
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||||||
|
var Ghosted: Boolean; var ImageIndex: Integer);
|
||||||
|
var
|
||||||
|
accountInfo: PAccountInfo;
|
||||||
|
begin
|
||||||
|
if Column = 0 then
|
||||||
|
begin
|
||||||
|
accountInfo := Sender.GetNodeData(Node);
|
||||||
|
case accountInfo^.AccessLevel of
|
||||||
|
alNone: ImageIndex := 0;
|
||||||
|
alView: ImageIndex := 1;
|
||||||
|
alNormal: ImageIndex := 2;
|
||||||
|
alAdministrator: ImageIndex := 3;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.vstAccountsGetText(Sender: TBaseVirtualTree;
|
||||||
|
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||||
|
var CellText: WideString);
|
||||||
|
var
|
||||||
|
accountInfo: PAccountInfo;
|
||||||
|
begin
|
||||||
|
accountInfo := Sender.GetNodeData(Node);
|
||||||
|
case Column of
|
||||||
|
1: CellText := accountInfo^.Username;
|
||||||
|
2: CellText := GetAccessLevelString(accountInfo^.AccessLevel);
|
||||||
|
else
|
||||||
|
CellText := '';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
modifyStatus: TModifyUserStatus;
|
||||||
|
username: string;
|
||||||
|
accountInfo: PAccountInfo;
|
||||||
|
begin
|
||||||
|
modifyStatus := TModifyUserStatus(ABuffer.ReadByte);
|
||||||
|
username := ABuffer.ReadStringNull;
|
||||||
|
case modifyStatus of
|
||||||
|
muAdded:
|
||||||
|
begin
|
||||||
|
node := vstAccounts.AddChild(nil);
|
||||||
|
accountInfo := vstAccounts.GetNodeData(node);
|
||||||
|
accountInfo^.Username := username;
|
||||||
|
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||||
|
Messagedlg('Success', Format('The user "%s" has been added.', [username]), mtInformation, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
muModified:
|
||||||
|
begin
|
||||||
|
node := FindNode(username);
|
||||||
|
if node <> nil then
|
||||||
|
begin
|
||||||
|
accountInfo := vstAccounts.GetNodeData(node);
|
||||||
|
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||||
|
Messagedlg('Success', Format('The user "%s" has been modified.', [username]), mtInformation, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
muInvalidUsername:
|
||||||
|
MessageDlg('Error', Format('The username "%s" is not valid.', [username]), mtError, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
deleteStatus: TDeleteUserStatus;
|
||||||
|
username: string;
|
||||||
|
begin
|
||||||
|
deleteStatus := TDeleteUserStatus(ABuffer.ReadByte);
|
||||||
|
username := ABuffer.ReadStringNull;
|
||||||
|
case deleteStatus of
|
||||||
|
duDeleted:
|
||||||
|
begin
|
||||||
|
node := FindNode(username);
|
||||||
|
if node <> nil then
|
||||||
|
begin
|
||||||
|
vstAccounts.DeleteNode(node);
|
||||||
|
Messagedlg('Success', Format('The user "%s" has been deleted.', [username]), mtInformation, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
duNotFound:
|
||||||
|
MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe your list is out of date or you tried to delete yourself.', [username]), mtError, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
accountInfo: PAccountInfo;
|
||||||
|
i, count: Word;
|
||||||
|
begin
|
||||||
|
vstAccounts.BeginUpdate;
|
||||||
|
vstAccounts.Clear;
|
||||||
|
count := ABuffer.ReadWord;
|
||||||
|
for i := 1 to count do
|
||||||
|
begin
|
||||||
|
node := vstAccounts.AddChild(nil);
|
||||||
|
accountInfo := vstAccounts.GetNodeData(node);
|
||||||
|
accountInfo^.Username := ABuffer.ReadStringNull;
|
||||||
|
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||||
|
end;
|
||||||
|
vstAccounts.EndUpdate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode;
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
accountInfo: PAccountInfo;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
node := vstAccounts.GetFirst;
|
||||||
|
while (node <> nil) and (Result = nil) do
|
||||||
|
begin
|
||||||
|
accountInfo := vstAccounts.GetNodeData(node);
|
||||||
|
if accountInfo^.Username = AUsername then
|
||||||
|
Result := node;
|
||||||
|
node := vstAccounts.GetNext(node);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmAccountControl.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,107 @@
|
||||||
|
object frmEditAccount: TfrmEditAccount
|
||||||
|
Left = 290
|
||||||
|
Height = 186
|
||||||
|
Top = 171
|
||||||
|
Width = 266
|
||||||
|
HorzScrollBar.Page = 265
|
||||||
|
VertScrollBar.Page = 185
|
||||||
|
ActiveControl = btnOK
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'Edit Account'
|
||||||
|
ClientHeight = 186
|
||||||
|
ClientWidth = 266
|
||||||
|
Position = poOwnerFormCenter
|
||||||
|
object lblPasswordHint: TLabel
|
||||||
|
Left = 96
|
||||||
|
Height = 28
|
||||||
|
Top = 72
|
||||||
|
Width = 160
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Leave empty to leave the password unchanged.'
|
||||||
|
Enabled = False
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object lblUsername: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 16
|
||||||
|
Top = 20
|
||||||
|
Width = 57
|
||||||
|
Caption = 'Username:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblPassword: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 16
|
||||||
|
Top = 52
|
||||||
|
Width = 54
|
||||||
|
Caption = 'Password:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblAccessLevel: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 16
|
||||||
|
Top = 116
|
||||||
|
Width = 64
|
||||||
|
Caption = 'Accesslevel:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object btnOK: TButton
|
||||||
|
Left = 93
|
||||||
|
Height = 25
|
||||||
|
Top = 152
|
||||||
|
Width = 75
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = 'OK'
|
||||||
|
Default = True
|
||||||
|
ModalResult = 1
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object btnCancel: TButton
|
||||||
|
Left = 181
|
||||||
|
Height = 25
|
||||||
|
Top = 152
|
||||||
|
Width = 75
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Cancel = True
|
||||||
|
Caption = 'Cancel'
|
||||||
|
ModalResult = 2
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object edUsername: TEdit
|
||||||
|
Left = 96
|
||||||
|
Height = 23
|
||||||
|
Top = 16
|
||||||
|
Width = 160
|
||||||
|
Color = clBtnFace
|
||||||
|
ReadOnly = True
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object edPassword: TEdit
|
||||||
|
Left = 96
|
||||||
|
Height = 23
|
||||||
|
Top = 48
|
||||||
|
Width = 160
|
||||||
|
EchoMode = emPassword
|
||||||
|
PasswordChar = '*'
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object cbAccessLevel: TComboBox
|
||||||
|
Left = 96
|
||||||
|
Height = 21
|
||||||
|
Top = 112
|
||||||
|
Width = 160
|
||||||
|
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
|
||||||
|
ItemHeight = 13
|
||||||
|
Items.Strings = (
|
||||||
|
'None'
|
||||||
|
'Viewer'
|
||||||
|
'Normal'
|
||||||
|
'Administrator'
|
||||||
|
)
|
||||||
|
MaxLength = 0
|
||||||
|
Style = csDropDownList
|
||||||
|
TabOrder = 4
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,86 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmEditAccount;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
UEnums;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmEditAccount }
|
||||||
|
|
||||||
|
TfrmEditAccount = class(TForm)
|
||||||
|
btnOK: TButton;
|
||||||
|
btnCancel: TButton;
|
||||||
|
cbAccessLevel: TComboBox;
|
||||||
|
edUsername: TEdit;
|
||||||
|
edPassword: TEdit;
|
||||||
|
lblUsername: TLabel;
|
||||||
|
lblPassword: TLabel;
|
||||||
|
lblAccessLevel: TLabel;
|
||||||
|
lblPasswordHint: TLabel;
|
||||||
|
public
|
||||||
|
function GetAccessLevel: TAccessLevel;
|
||||||
|
procedure SetAccessLevel(AAccessLevel: TAccessLevel);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmEditAccount: TfrmEditAccount;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TfrmEditAccount }
|
||||||
|
|
||||||
|
function TfrmEditAccount.GetAccessLevel: TAccessLevel;
|
||||||
|
begin
|
||||||
|
case cbAccessLevel.ItemIndex of
|
||||||
|
0: Result := alNone;
|
||||||
|
1: Result := alView;
|
||||||
|
2: Result := alNormal;
|
||||||
|
3: Result := alAdministrator;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmEditAccount.SetAccessLevel(AAccessLevel: TAccessLevel);
|
||||||
|
begin
|
||||||
|
case AAccessLevel of
|
||||||
|
alNone: cbAccessLevel.ItemIndex := 0;
|
||||||
|
alView: cbAccessLevel.ItemIndex := 1;
|
||||||
|
alNormal: cbAccessLevel.ItemIndex := 2;
|
||||||
|
alAdministrator: cbAccessLevel.ItemIndex := 3;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmEditAccount.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,38 @@
|
||||||
|
object frmInitialize: TfrmInitialize
|
||||||
|
Left = 290
|
||||||
|
Height = 65
|
||||||
|
Top = 171
|
||||||
|
Width = 241
|
||||||
|
HorzScrollBar.Page = 240
|
||||||
|
VertScrollBar.Page = 64
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'Please wait ...'
|
||||||
|
ClientHeight = 65
|
||||||
|
ClientWidth = 241
|
||||||
|
OnClose = FormClose
|
||||||
|
OnCreate = FormCreate
|
||||||
|
Position = poScreenCenter
|
||||||
|
object pnlMain: TPanel
|
||||||
|
Left = 8
|
||||||
|
Height = 50
|
||||||
|
Top = 8
|
||||||
|
Width = 226
|
||||||
|
BevelInner = bvRaised
|
||||||
|
BevelOuter = bvLowered
|
||||||
|
ClientHeight = 50
|
||||||
|
ClientWidth = 226
|
||||||
|
TabOrder = 0
|
||||||
|
object lblStatus: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 32
|
||||||
|
Top = 8
|
||||||
|
Width = 208
|
||||||
|
Alignment = taCenter
|
||||||
|
AutoSize = False
|
||||||
|
Layout = tlCenter
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,96 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmInitialize;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||||
|
StdCtrls, LCLIntf, LCLType, WSForms;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmInitialize }
|
||||||
|
|
||||||
|
TfrmInitialize = class(TForm)
|
||||||
|
lblStatus: TLabel;
|
||||||
|
pnlMain: TPanel;
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
protected
|
||||||
|
FActiveWindow: HWND;
|
||||||
|
FModal: Boolean;
|
||||||
|
public
|
||||||
|
procedure SetModal;
|
||||||
|
procedure UnsetModal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmInitialize: TfrmInitialize;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TfrmInitialize }
|
||||||
|
|
||||||
|
procedure TfrmInitialize.FormClose(Sender: TObject;
|
||||||
|
var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caNone;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmInitialize.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FModal := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmInitialize.SetModal;
|
||||||
|
begin
|
||||||
|
if FModal then Exit;
|
||||||
|
FActiveWindow := GetActiveWindow;
|
||||||
|
TWSCustomFormClass(WidgetSetClass).ShowModal(Self);
|
||||||
|
{FormStyle := fsStayOnTop;
|
||||||
|
Screen.MoveFormToFocusFront(Self);
|
||||||
|
Screen.MoveFormToZFront(Self);}
|
||||||
|
FModal := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmInitialize.UnsetModal;
|
||||||
|
begin
|
||||||
|
if not FModal then Exit;
|
||||||
|
TWSCustomFormClass(WidgetSetClass).CloseModal(Self);
|
||||||
|
if FActiveWindow <> 0 then SetActiveWindow(FActiveWindow);
|
||||||
|
FActiveWindow := 0;
|
||||||
|
//FormStyle := fsNormal;
|
||||||
|
FModal := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmInitialize.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,673 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmLargeScaleCommand;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, CheckLst,
|
||||||
|
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
|
||||||
|
math, UPlatformTypes, UEnhancedMemoryStream;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
TAreaMoveType = (amLeft, amTop, amRight, amBottom);
|
||||||
|
TAreaMove = set of TAreaMoveType;
|
||||||
|
|
||||||
|
{ TfrmLargeScaleCommand }
|
||||||
|
|
||||||
|
TfrmLargeScaleCommand = class(TForm)
|
||||||
|
btnClearTerrain: TSpeedButton;
|
||||||
|
btnClearIStaticsTiles: TSpeedButton;
|
||||||
|
btnClearDStaticsTiles: TSpeedButton;
|
||||||
|
btnDeleteTerrain: TSpeedButton;
|
||||||
|
btnDeleteIStaticsTiles: TSpeedButton;
|
||||||
|
btnDeleteDStaticsTiles: TSpeedButton;
|
||||||
|
btnExecute: TButton;
|
||||||
|
btnClose: TButton;
|
||||||
|
cbCMEraseTarget: TCheckBox;
|
||||||
|
gbDrawTerrainTiles: TGroupBox;
|
||||||
|
gbDeleteStaticsTiles: TGroupBox;
|
||||||
|
gbInserStaticsTiles: TGroupBox;
|
||||||
|
gbStaticsProbability: TGroupBox;
|
||||||
|
gbStaticsPlacement: TGroupBox;
|
||||||
|
GroupBox1: TGroupBox;
|
||||||
|
gbCMOffset: TGroupBox;
|
||||||
|
Label1: TLabel;
|
||||||
|
Label10: TLabel;
|
||||||
|
Label2: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
Label4: TLabel;
|
||||||
|
Label5: TLabel;
|
||||||
|
Label6: TLabel;
|
||||||
|
Label7: TLabel;
|
||||||
|
Label8: TLabel;
|
||||||
|
Label9: TLabel;
|
||||||
|
lblDrawTerrainTilesDesc: TLabel;
|
||||||
|
lblDeleteStaticsTilesDesc: TLabel;
|
||||||
|
lblInsertStaticsTiles: TLabel;
|
||||||
|
lblX: TLabel;
|
||||||
|
lblY: TLabel;
|
||||||
|
nbActions: TNotebook;
|
||||||
|
pgCopyMove: TPage;
|
||||||
|
pgDeleteStatics: TPage;
|
||||||
|
pgInsertStatics: TPage;
|
||||||
|
pgModifyAltitude: TPage;
|
||||||
|
pnlControls: TPanel;
|
||||||
|
pnlDrawTerrainTilesControls: TPanel;
|
||||||
|
pnlAreaControls: TPanel;
|
||||||
|
pnlDrawTerrainTilesControls1: TPanel;
|
||||||
|
pnlDrawTerrainTilesControls2: TPanel;
|
||||||
|
pnlLeft: TPanel;
|
||||||
|
pbArea: TPaintBox;
|
||||||
|
pgArea: TPage;
|
||||||
|
pgDrawTerrain: TPage;
|
||||||
|
rgCMAction: TRadioGroup;
|
||||||
|
rbPlaceStaticsOnTerrain: TRadioButton;
|
||||||
|
rbPlaceStaticsOnTop: TRadioButton;
|
||||||
|
rbPlaceStaticsOnZ: TRadioButton;
|
||||||
|
rbSetTerrainAltitude: TRadioButton;
|
||||||
|
rbRelativeAltitudeChange: TRadioButton;
|
||||||
|
sbArea: TScrollBox;
|
||||||
|
btnAddArea: TSpeedButton;
|
||||||
|
btnDeleteArea: TSpeedButton;
|
||||||
|
seDeleteStaticsZ1: TSpinEdit;
|
||||||
|
seDeleteStaticsZ2: TSpinEdit;
|
||||||
|
seX1: TSpinEdit;
|
||||||
|
seX2: TSpinEdit;
|
||||||
|
seY1: TSpinEdit;
|
||||||
|
seY2: TSpinEdit;
|
||||||
|
btnClearArea: TSpeedButton;
|
||||||
|
seTerrainAltitude1: TSpinEdit;
|
||||||
|
seTerrainAltitude2: TSpinEdit;
|
||||||
|
seRelativeAltitude: TSpinEdit;
|
||||||
|
seStaticsProbability: TSpinEdit;
|
||||||
|
seInsertStaticsZ: TSpinEdit;
|
||||||
|
seCMOffsetX: TSpinEdit;
|
||||||
|
seCMOffsetY: TSpinEdit;
|
||||||
|
vdtTerrainTiles: TVirtualDrawTree;
|
||||||
|
vdtInsertStaticsTiles: TVirtualDrawTree;
|
||||||
|
vdtDeleteStaticsTiles: TVirtualDrawTree;
|
||||||
|
vstArea: TVirtualStringTree;
|
||||||
|
vstActions: TVirtualStringTree;
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure btnAddAreaClick(Sender: TObject);
|
||||||
|
procedure btnClearDStaticsTilesClick(Sender: TObject);
|
||||||
|
procedure btnClearIStaticsTilesClick(Sender: TObject);
|
||||||
|
procedure btnClearTerrainClick(Sender: TObject);
|
||||||
|
procedure btnCloseClick(Sender: TObject);
|
||||||
|
procedure btnDeleteDStaticsTilesClick(Sender: TObject);
|
||||||
|
procedure btnDeleteIStaticsTilesClick(Sender: TObject);
|
||||||
|
procedure btnDeleteTerrainClick(Sender: TObject);
|
||||||
|
procedure btnExecuteClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
|
||||||
|
);
|
||||||
|
procedure pbAreaPaint(Sender: TObject);
|
||||||
|
procedure btnDeleteAreaClick(Sender: TObject);
|
||||||
|
procedure btnClearAreaClick(Sender: TObject);
|
||||||
|
procedure seX1Change(Sender: TObject);
|
||||||
|
procedure vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree; Source: TObject;
|
||||||
|
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
|
||||||
|
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
|
||||||
|
procedure vdtTerrainTilesDragOver(Sender: TBaseVirtualTree; Source: TObject;
|
||||||
|
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
|
||||||
|
var Effect: Integer; var Accept: Boolean);
|
||||||
|
procedure vdtTerrainTilesDrawNode(Sender: TBaseVirtualTree;
|
||||||
|
const PaintInfo: TVTPaintInfo);
|
||||||
|
procedure vstActionsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||||
|
procedure vstActionsGetText(Sender: TBaseVirtualTree;
|
||||||
|
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||||
|
var CellText: WideString);
|
||||||
|
procedure vstActionsPaintText(Sender: TBaseVirtualTree;
|
||||||
|
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
||||||
|
TextType: TVSTTextType);
|
||||||
|
procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||||
|
procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||||
|
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
|
||||||
|
protected
|
||||||
|
FLastX: Integer;
|
||||||
|
FLastY: Integer;
|
||||||
|
FAreaMove: TAreaMove;
|
||||||
|
procedure AddNode(AActionID: Integer; ACaption: string);
|
||||||
|
function FindNode(AActionID: Integer): PVirtualNode;
|
||||||
|
procedure SerializeTiles(ATileList: TVirtualDrawTree;
|
||||||
|
AStream: TEnhancedMemoryStream);
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmLargeScaleCommand: TfrmLargeScaleCommand;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets,
|
||||||
|
UGUIPlatformUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
PNodeInfo = ^TNodeInfo;
|
||||||
|
TNodeInfo = record
|
||||||
|
ActionID: Integer;
|
||||||
|
Caption: string;
|
||||||
|
end;
|
||||||
|
PTileInfo = ^TTileInfo;
|
||||||
|
TTileInfo = record
|
||||||
|
ID: Word;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TfrmLargeScaleCommand }
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vstActions.NodeDataSize := SizeOf(TNodeInfo);
|
||||||
|
AddNode(-1, 'Target Area');
|
||||||
|
AddNode(0, 'Copy/Move');
|
||||||
|
AddNode(1, 'Modify altitude');
|
||||||
|
AddNode(2, 'Draw terrain');
|
||||||
|
AddNode(3, 'Delete statics');
|
||||||
|
AddNode(4, 'Insert statics');
|
||||||
|
vstActions.Selected[vstActions.GetFirst] := True;
|
||||||
|
|
||||||
|
vstArea.NodeDataSize := SizeOf(TRect);
|
||||||
|
|
||||||
|
pbArea.Width := frmRadarMap.Radar.Width;
|
||||||
|
pbArea.Height := frmRadarMap.Radar.Height;
|
||||||
|
seX1.MaxValue := ResMan.Landscape.CellWidth;
|
||||||
|
seX2.MaxValue := ResMan.Landscape.CellWidth;
|
||||||
|
seY1.MaxValue := ResMan.Landscape.CellHeight;
|
||||||
|
seY2.MaxValue := ResMan.Landscape.CellHeight;
|
||||||
|
|
||||||
|
vdtTerrainTiles.NodeDataSize := SizeOf(TTileInfo);
|
||||||
|
vdtInsertStaticsTiles.NodeDataSize := SizeOf(TTileInfo);
|
||||||
|
vdtDeleteStaticsTiles.NodeDataSize := SizeOf(TTileInfo);
|
||||||
|
|
||||||
|
seCMOffsetX.MinValue := -ResMan.Landscape.CellWidth;
|
||||||
|
seCMOffsetX.MaxValue := ResMan.Landscape.CellWidth;
|
||||||
|
seCMOffsetY.MinValue := -ResMan.Landscape.CellHeight;
|
||||||
|
seCMOffsetY.MaxValue := ResMan.Landscape.CellHeight;
|
||||||
|
|
||||||
|
frmRadarMap.Dependencies.Add(pbArea);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
frmRadarMap.Dependencies.Remove(pbArea);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.pbAreaMouseDown(Sender: TObject;
|
||||||
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||||
|
var
|
||||||
|
node, match: PVirtualNode;
|
||||||
|
nodeInfo: ^TRect;
|
||||||
|
p: TPoint;
|
||||||
|
begin
|
||||||
|
FAreaMove := [];
|
||||||
|
p := Point(X * 8, Y * 8);
|
||||||
|
match := nil;
|
||||||
|
node := vstArea.GetFirst;
|
||||||
|
while node <> nil do
|
||||||
|
begin
|
||||||
|
nodeInfo := vstArea.GetNodeData(node);
|
||||||
|
if PtInRect(nodeInfo^, p) then
|
||||||
|
match := node;
|
||||||
|
node := vstArea.GetNext(node);
|
||||||
|
end;
|
||||||
|
if match <> nil then
|
||||||
|
begin
|
||||||
|
nodeInfo := vstArea.GetNodeData(match);
|
||||||
|
if p.x - nodeInfo^.Left <= 64 then Include(FAreaMove, amLeft);
|
||||||
|
if p.y - nodeInfo^.Top <= 64 then Include(FAreaMove, amTop);
|
||||||
|
if nodeInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
|
||||||
|
if nodeInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
|
||||||
|
if FAreaMove = [] then
|
||||||
|
FAreaMove := [amLeft, amTop, amRight, amBottom];
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
match := vstArea.AddChild(nil);
|
||||||
|
nodeInfo := vstArea.GetNodeData(match);
|
||||||
|
nodeInfo^.Left := p.x;
|
||||||
|
nodeInfo^.Top := p.y;
|
||||||
|
nodeInfo^.Right := p.x;
|
||||||
|
nodeInfo^.Bottom := p.y;
|
||||||
|
FAreaMove := [amRight, amBottom];
|
||||||
|
end;
|
||||||
|
vstArea.ClearSelection;
|
||||||
|
vstArea.Selected[match] := True;
|
||||||
|
FLastX := X;
|
||||||
|
FLastY := Y;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.pbAreaMouseMove(Sender: TObject;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
nodeInfo: ^TRect;
|
||||||
|
offsetX, offsetY: Integer;
|
||||||
|
begin
|
||||||
|
if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then
|
||||||
|
begin
|
||||||
|
offsetX := (X - FLastX) * 8;
|
||||||
|
offsetY := (Y - FLastY) * 8;
|
||||||
|
if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX;
|
||||||
|
if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX;
|
||||||
|
if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY;
|
||||||
|
if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY;
|
||||||
|
FLastX := X;
|
||||||
|
FLastY := Y;
|
||||||
|
seX1Change(nil);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnAddAreaClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
nodeInfo: ^TRect;
|
||||||
|
begin
|
||||||
|
node := vstArea.AddChild(nil);
|
||||||
|
nodeInfo := vstArea.GetNodeData(node);
|
||||||
|
nodeInfo^.Left := 0;
|
||||||
|
nodeInfo^.Top := 0;
|
||||||
|
nodeInfo^.Right := 0;
|
||||||
|
nodeInfo^.Bottom := 0;
|
||||||
|
vstArea.ClearSelection;
|
||||||
|
vstArea.Selected[node] := True;
|
||||||
|
vstArea.FocusedNode := node;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
SetWindowParent(Handle, frmMain.Handle);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnClearDStaticsTilesClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtDeleteStaticsTiles.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnClearIStaticsTilesClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtInsertStaticsTiles.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnClearTerrainClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtTerrainTiles.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnCloseClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnDeleteDStaticsTilesClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtDeleteStaticsTiles.DeleteSelectedNodes;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnDeleteIStaticsTilesClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtInsertStaticsTiles.DeleteSelectedNodes;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnDeleteTerrainClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vdtTerrainTiles.DeleteSelectedNodes;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnExecuteClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
packet: TPacket;
|
||||||
|
stream: TEnhancedMemoryStream;
|
||||||
|
areaCount: Byte;
|
||||||
|
i: Integer;
|
||||||
|
node: PVirtualNode;
|
||||||
|
areaInfo: ^TRect;
|
||||||
|
begin
|
||||||
|
packet := TPacket.Create($0E, 0);
|
||||||
|
stream := packet.Stream;
|
||||||
|
stream.Position := stream.Size;
|
||||||
|
|
||||||
|
//Area
|
||||||
|
areaCount := Min(vstArea.RootNodeCount, 255);
|
||||||
|
stream.WriteByte(areaCount);
|
||||||
|
if areaCount = 0 then Exit;
|
||||||
|
i := 0;
|
||||||
|
node := vstArea.GetFirst;
|
||||||
|
while (node <> nil) and (i < areaCount) do
|
||||||
|
begin
|
||||||
|
areaInfo := vstArea.GetNodeData(node);
|
||||||
|
stream.WriteWord(Min(areaInfo^.Left, areaInfo^.Right));
|
||||||
|
stream.WriteWord(Min(areaInfo^.Top, areaInfo^.Bottom));
|
||||||
|
stream.WriteWord(Max(areaInfo^.Left, areaInfo^.Right));
|
||||||
|
stream.WriteWord(Max(areaInfo^.Top, areaInfo^.Bottom));
|
||||||
|
node := vstArea.GetNext(node);
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//Copy/Move
|
||||||
|
node := FindNode(0);
|
||||||
|
if vstActions.CheckState[node] = csCheckedNormal then
|
||||||
|
begin
|
||||||
|
stream.WriteBoolean(True);
|
||||||
|
stream.WriteByte(rgCMAction.ItemIndex);
|
||||||
|
stream.WriteInteger(seCMOffsetX.Value);
|
||||||
|
stream.WriteInteger(seCMOffsetY.Value);
|
||||||
|
stream.WriteBoolean(cbCMEraseTarget.Checked);
|
||||||
|
end else
|
||||||
|
stream.WriteBoolean(False);
|
||||||
|
|
||||||
|
//Modify altitude
|
||||||
|
node := FindNode(1);
|
||||||
|
if vstActions.CheckState[node] = csCheckedNormal then
|
||||||
|
begin
|
||||||
|
stream.WriteBoolean(True);
|
||||||
|
if rbSetTerrainAltitude.Checked then
|
||||||
|
begin
|
||||||
|
stream.WriteByte(1);
|
||||||
|
stream.WriteShortInt(Min(seTerrainAltitude1.Value, seTerrainAltitude2.Value));
|
||||||
|
stream.WriteShortInt(Max(seTerrainAltitude1.Value, seTerrainAltitude2.Value));
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
stream.WriteByte(2);
|
||||||
|
stream.WriteShortInt(seRelativeAltitude.Value);
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
stream.WriteBoolean(False);
|
||||||
|
|
||||||
|
//Draw terrain
|
||||||
|
node := FindNode(2);
|
||||||
|
if vstActions.CheckState[node] = csCheckedNormal then
|
||||||
|
begin
|
||||||
|
stream.WriteBoolean(True);
|
||||||
|
SerializeTiles(vdtTerrainTiles, stream);
|
||||||
|
end else
|
||||||
|
stream.WriteBoolean(False);
|
||||||
|
|
||||||
|
//Delete statics
|
||||||
|
node := FindNode(3);
|
||||||
|
if vstActions.CheckState[node] = csCheckedNormal then
|
||||||
|
begin
|
||||||
|
stream.WriteBoolean(True);
|
||||||
|
SerializeTiles(vdtDeleteStaticsTiles, stream);
|
||||||
|
stream.WriteShortInt(Min(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value));
|
||||||
|
stream.WriteShortInt(Max(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value));
|
||||||
|
end else
|
||||||
|
stream.WriteBoolean(False);
|
||||||
|
|
||||||
|
//Insert statics
|
||||||
|
node := FindNode(4);
|
||||||
|
if vstActions.CheckState[node] = csCheckedNormal then
|
||||||
|
begin
|
||||||
|
stream.WriteBoolean(True);
|
||||||
|
SerializeTiles(vdtInsertStaticsTiles, stream);
|
||||||
|
stream.WriteByte(seStaticsProbability.Value);
|
||||||
|
if rbPlaceStaticsOnZ.Checked then
|
||||||
|
begin
|
||||||
|
stream.WriteByte(3);
|
||||||
|
stream.WriteShortInt(seInsertStaticsZ.Value);
|
||||||
|
end else if rbPlaceStaticsOnTerrain.Checked then
|
||||||
|
stream.WriteByte(1)
|
||||||
|
else
|
||||||
|
stream.WriteByte(2);
|
||||||
|
end else
|
||||||
|
stream.WriteBoolean(False);
|
||||||
|
|
||||||
|
dmNetwork.Send(TCompressedPacket.Create(packet));
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.pbAreaPaint(Sender: TObject);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
node: PVirtualNode;
|
||||||
|
nodeInfo: ^TRect;
|
||||||
|
begin
|
||||||
|
DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar);
|
||||||
|
pbArea.Canvas.Pen.Color := clRed;
|
||||||
|
pbArea.Canvas.Brush.Color := clMaroon;
|
||||||
|
pbArea.Canvas.Brush.Style := bsFDiagonal;
|
||||||
|
node := vstArea.GetFirst;
|
||||||
|
while node <> nil do
|
||||||
|
begin
|
||||||
|
if vstArea.Selected[node] then
|
||||||
|
begin
|
||||||
|
pbArea.Canvas.Pen.Width := 2;
|
||||||
|
pbArea.Canvas.Pen.Style := psSolid;
|
||||||
|
//pbArea.Canvas.Brush.Color := clRed;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
pbArea.Canvas.Pen.Width := 1;
|
||||||
|
pbArea.Canvas.Pen.Style := psDot;
|
||||||
|
//pbArea.Canvas.Brush.Color := clMaroon;
|
||||||
|
end;
|
||||||
|
nodeInfo := vstArea.GetNodeData(node);
|
||||||
|
pbArea.Canvas.Rectangle(nodeInfo^.Left div 8, nodeInfo^.Top div 8,
|
||||||
|
nodeInfo^.Right div 8 + 1, nodeInfo^.Bottom div 8 + 1);
|
||||||
|
node := vstArea.GetNext(node);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnDeleteAreaClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vstArea.DeleteSelectedNodes;
|
||||||
|
vstAreaChange(vstArea, nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.btnClearAreaClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
vstArea.Clear;
|
||||||
|
vstAreaChange(vstArea, nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.seX1Change(Sender: TObject);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
nodeInfo: ^TRect;
|
||||||
|
begin
|
||||||
|
node := vstArea.GetFirstSelected;
|
||||||
|
if node <> nil then
|
||||||
|
begin
|
||||||
|
nodeInfo := vstArea.GetNodeData(node);
|
||||||
|
nodeInfo^.Left := seX1.Value;
|
||||||
|
nodeInfo^.Right := seX2.Value;
|
||||||
|
nodeInfo^.Top := seY1.Value;
|
||||||
|
nodeInfo^.Bottom := seY2.Value;
|
||||||
|
vstArea.InvalidateNode(node);
|
||||||
|
pbArea.Repaint;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree;
|
||||||
|
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
|
||||||
|
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
|
||||||
|
var
|
||||||
|
sourceTree: TVirtualDrawTree;
|
||||||
|
selected, node: PVirtualNode;
|
||||||
|
sourceTileInfo, targetTileInfo: PTileInfo;
|
||||||
|
begin
|
||||||
|
sourceTree := Source as TVirtualDrawTree;
|
||||||
|
if (sourceTree <> Sender) and (sourceTree <> nil) and
|
||||||
|
(sourceTree.Tag = 1) then
|
||||||
|
begin
|
||||||
|
Sender.BeginUpdate;
|
||||||
|
selected := sourceTree.GetFirstSelected;
|
||||||
|
while selected <> nil do
|
||||||
|
begin
|
||||||
|
sourceTileInfo := sourceTree.GetNodeData(selected);
|
||||||
|
if ((Sender = vdtTerrainTiles) and (sourceTileInfo^.ID < $4000)) or
|
||||||
|
((Sender = vdtInsertStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) or
|
||||||
|
((Sender = vdtDeleteStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) then
|
||||||
|
begin
|
||||||
|
node := Sender.AddChild(nil);
|
||||||
|
targetTileInfo := Sender.GetNodeData(node);
|
||||||
|
targetTileInfo^.ID := sourceTileInfo^.ID;
|
||||||
|
end;
|
||||||
|
selected := sourceTree.GetNextSelected(selected);
|
||||||
|
end;
|
||||||
|
Sender.EndUpdate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.vdtTerrainTilesDragOver(Sender: TBaseVirtualTree;
|
||||||
|
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
|
||||||
|
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
|
||||||
|
begin
|
||||||
|
if (Source <> Sender) and (Source is TVirtualDrawTree) and
|
||||||
|
(TVirtualDrawTree(Source).Tag = 1) then
|
||||||
|
begin
|
||||||
|
Accept := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.vdtTerrainTilesDrawNode(
|
||||||
|
Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
|
||||||
|
begin
|
||||||
|
frmMain.vdtTilesDrawNode(Sender, PaintInfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.vstActionsChange(Sender: TBaseVirtualTree;
|
||||||
|
Node: PVirtualNode);
|
||||||
|
var
|
||||||
|
nodeInfo: PNodeInfo;
|
||||||
|
begin
|
||||||
|
if Sender.Selected[Node] then
|
||||||
|
begin
|
||||||
|
nodeInfo := Sender.GetNodeData(Node);
|
||||||
|
nbActions.PageIndex := nodeInfo^.ActionID + 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.vstActionsGetText(
|
||||||
|
Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
|
||||||
|
TextType: TVSTTextType; var CellText: WideString);
|
||||||
|
var
|
||||||
|
nodeInfo: PNodeInfo;
|
||||||
|
begin
|
||||||
|
nodeInfo := Sender.GetNodeData(Node);
|
||||||
|
CellText := nodeInfo^.Caption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.vstActionsPaintText(Sender: TBaseVirtualTree;
|
||||||
|
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
||||||
|
TextType: TVSTTextType);
|
||||||
|
begin
|
||||||
|
if Sender.Selected[Node] then
|
||||||
|
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.vstAreaChange(Sender: TBaseVirtualTree;
|
||||||
|
Node: PVirtualNode);
|
||||||
|
var
|
||||||
|
nodeInfo: ^TRect;
|
||||||
|
selected: Boolean;
|
||||||
|
begin
|
||||||
|
selected := (Node <> nil) and Sender.Selected[Node];
|
||||||
|
btnDeleteArea.Enabled := selected;
|
||||||
|
lblX.Enabled := selected;
|
||||||
|
lblY.Enabled := selected;
|
||||||
|
seX1.Enabled := selected;
|
||||||
|
seX2.Enabled := selected;
|
||||||
|
seY1.Enabled := selected;
|
||||||
|
seY2.Enabled := selected;
|
||||||
|
if selected then
|
||||||
|
begin
|
||||||
|
nodeInfo := Sender.GetNodeData(Node);
|
||||||
|
seX1.Value := nodeInfo^.Left;
|
||||||
|
seX2.Value := nodeInfo^.Right;
|
||||||
|
seY1.Value := nodeInfo^.Top;
|
||||||
|
seY2.Value := nodeInfo^.Bottom;
|
||||||
|
end;
|
||||||
|
pbArea.Repaint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.vstAreaGetText(Sender: TBaseVirtualTree;
|
||||||
|
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||||
|
var CellText: WideString);
|
||||||
|
var
|
||||||
|
nodeInfo: ^TRect;
|
||||||
|
begin
|
||||||
|
nodeInfo := Sender.GetNodeData(Node);
|
||||||
|
CellText := Format('(%d, %d), (%d, %d)', [nodeInfo^.Left, nodeInfo^.Top,
|
||||||
|
nodeInfo^.Right, nodeInfo^.Bottom]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.AddNode(AActionID: Integer; ACaption: string);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
nodeInfo: PNodeInfo;
|
||||||
|
begin
|
||||||
|
node := vstActions.AddChild(nil);
|
||||||
|
nodeInfo := vstActions.GetNodeData(node);
|
||||||
|
nodeInfo^.ActionID := AActionID;
|
||||||
|
nodeInfo^.Caption := ACaption;
|
||||||
|
if AActionID > -1 then
|
||||||
|
vstActions.CheckType[node] := ctCheckBox;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TfrmLargeScaleCommand.FindNode(AActionID: Integer): PVirtualNode;
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
nodeInfo: PNodeInfo;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
node := vstActions.GetFirst;
|
||||||
|
while (node <> nil) and (Result = nil) do
|
||||||
|
begin
|
||||||
|
nodeInfo := vstActions.GetNodeData(node);
|
||||||
|
if nodeInfo^.ActionID = AActionID then
|
||||||
|
Result := node;
|
||||||
|
node := vstActions.GetNext(node);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLargeScaleCommand.SerializeTiles(ATileList: TVirtualDrawTree;
|
||||||
|
AStream: TEnhancedMemoryStream);
|
||||||
|
var
|
||||||
|
node: PVirtualNode;
|
||||||
|
tileInfo: PTileInfo;
|
||||||
|
begin
|
||||||
|
AStream.WriteWord(ATileList.RootNodeCount);
|
||||||
|
node := ATileList.GetFirst;
|
||||||
|
while node <> nil do
|
||||||
|
begin
|
||||||
|
tileInfo := ATileList.GetNodeData(node);
|
||||||
|
AStream.WriteWord(tileInfo^.ID);
|
||||||
|
node := ATileList.GetNext(node);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmLargeScaleCommand.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,632 @@
|
||||||
|
object frmLogin: TfrmLogin
|
||||||
|
Left = 290
|
||||||
|
Height = 265
|
||||||
|
Top = 171
|
||||||
|
Width = 489
|
||||||
|
HorzScrollBar.Page = 488
|
||||||
|
VertScrollBar.Page = 264
|
||||||
|
ActiveControl = edHost
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'UO CentrED'
|
||||||
|
ClientHeight = 265
|
||||||
|
ClientWidth = 489
|
||||||
|
OnClose = FormClose
|
||||||
|
OnCreate = FormCreate
|
||||||
|
Position = poScreenCenter
|
||||||
|
ShowInTaskBar = stAlways
|
||||||
|
object lblCopyright: TLabel
|
||||||
|
Height = 17
|
||||||
|
Top = 248
|
||||||
|
Width = 489
|
||||||
|
Align = alBottom
|
||||||
|
Alignment = taCenter
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object gbConnection: TGroupBox
|
||||||
|
Left = 8
|
||||||
|
Height = 128
|
||||||
|
Top = 8
|
||||||
|
Width = 321
|
||||||
|
Caption = 'Connection'
|
||||||
|
ClientHeight = 128
|
||||||
|
ClientWidth = 321
|
||||||
|
TabOrder = 0
|
||||||
|
object lblHost: TLabel
|
||||||
|
Left = 30
|
||||||
|
Height = 14
|
||||||
|
Top = 9
|
||||||
|
Width = 34
|
||||||
|
Caption = 'Host:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblUsername: TLabel
|
||||||
|
Left = 30
|
||||||
|
Height = 14
|
||||||
|
Top = 43
|
||||||
|
Width = 69
|
||||||
|
Caption = 'Username:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblPassword: TLabel
|
||||||
|
Left = 30
|
||||||
|
Height = 14
|
||||||
|
Top = 77
|
||||||
|
Width = 65
|
||||||
|
Caption = 'Password:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object imgHost: TImage
|
||||||
|
Left = 6
|
||||||
|
Height = 16
|
||||||
|
Top = 9
|
||||||
|
Width = 16
|
||||||
|
AutoSize = True
|
||||||
|
Picture.Data = {
|
||||||
|
07545069786D61702E0A00002F2A2058504D202A2F0A73746174696320636861
|
||||||
|
72202A64756D6D795B5D3D7B0A223136203136203132342032222C0A22517420
|
||||||
|
63204E6F6E65222C0A22236E20632023333739343337222C0A22236D20632023
|
||||||
|
343261313362222C0A22236620632023353661393530222C0A22233520632023
|
||||||
|
363036303630222C0A22233420632023363336333633222C0A22235920632023
|
||||||
|
363436343634222C0A22233320632023363736373637222C0A22235420632023
|
||||||
|
363836383638222C0A22233220632023366236623662222C0A22234920632023
|
||||||
|
366436643664222C0A22233120632023373037303730222C0A22237920632023
|
||||||
|
373337333733222C0A22233020632023373437343734222C0A22237020632023
|
||||||
|
373837383738222C0A22235A20632023373937393739222C0A22236820632023
|
||||||
|
376537653765222C0A22232E20632023383438343834222C0A222E3020632023
|
||||||
|
386138613861222C0A222E3220632023386238623862222C0A222E5A20632023
|
||||||
|
386438643864222C0A222E5920632023386638663866222C0A222E5420632023
|
||||||
|
393139313931222C0A222E4720632023393139313932222C0A222E4620632023
|
||||||
|
393339333934222C0A222E4520632023393539353936222C0A222E4420632023
|
||||||
|
393739373938222C0A222E4920632023393839383938222C0A22234A20632023
|
||||||
|
396239623962222C0A222E7A20632023396539653965222C0A22237A20632023
|
||||||
|
613261326132222C0A22235520632023613361336133222C0A22236520632023
|
||||||
|
613463386130222C0A222E7020632023613561356135222C0A22237120632023
|
||||||
|
613861386138222C0A222E6720632023616261626162222C0A22235220632023
|
||||||
|
616561666237222C0A22235120632023616562316239222C0A22236920632023
|
||||||
|
616661666166222C0A22234720632023616662316239222C0A222E6620632023
|
||||||
|
623062306230222C0A22235020632023623062316239222C0A22234620632023
|
||||||
|
623162326261222C0A22237720632023623162336262222C0A22234520632023
|
||||||
|
623262346262222C0A22234B20632023623362336233222C0A22237620632023
|
||||||
|
623362346262222C0A22234F20632023623362356264222C0A22234420632023
|
||||||
|
623462356263222C0A22237520632023623462366264222C0A22232320632023
|
||||||
|
623562356235222C0A22234320632023623562366265222C0A222E6520632023
|
||||||
|
623662366236222C0A22237420632023623662376265222C0A22236C20632023
|
||||||
|
623662386265222C0A22237320632023623762396330222C0A222E3820632023
|
||||||
|
623862396330222C0A22236420632023623962616331222C0A222E3720632023
|
||||||
|
623962626331222C0A22236320632023626162626332222C0A222E6420632023
|
||||||
|
626262626262222C0A222E3620632023626262636333222C0A222E5220632023
|
||||||
|
626262646333222C0A222E3520632023626362656334222C0A22234E20632023
|
||||||
|
626462666335222C0A222E5120632023626562666335222C0A222E3420632023
|
||||||
|
626562666336222C0A222E5020632023626663316336222C0A222E6320632023
|
||||||
|
633063306330222C0A222E5820632023633063316337222C0A222E7820632023
|
||||||
|
633163316337222C0A222E4F20632023633163326338222C0A222E7720632023
|
||||||
|
633163336338222C0A222E4E20632023633263336338222C0A222E7620632023
|
||||||
|
633363346361222C0A222E6220632023633463346334222C0A22235620632023
|
||||||
|
633463356336222C0A222E4320632023633463366362222C0A222E7520632023
|
||||||
|
633563366362222C0A222E4A20632023633663366336222C0A222E6120632023
|
||||||
|
633963396339222C0A222E7420632023633963616366222C0A222E7120632023
|
||||||
|
636263626362222C0A222E6820632023636363636363222C0A222E2320632023
|
||||||
|
636463646364222C0A22235320632023636463656433222C0A22234820632023
|
||||||
|
636563666434222C0A22237820632023636664306434222C0A22236F20632023
|
||||||
|
643064316436222C0A22236720632023643164336437222C0A22234220632023
|
||||||
|
643264326434222C0A222E3920632023643364336437222C0A22237220632023
|
||||||
|
643364346435222C0A22235720632023643364346439222C0A22234C20632023
|
||||||
|
643464346434222C0A222E3120632023643464356439222C0A22236B20632023
|
||||||
|
643564356437222C0A222E5320632023643564366461222C0A222E4820632023
|
||||||
|
643664376462222C0A22236220632023643864386439222C0A222E7920632023
|
||||||
|
643864396463222C0A222E3320632023643964396461222C0A222E6E20632023
|
||||||
|
646264626465222C0A222E6D20632023646264636466222C0A222E6920632023
|
||||||
|
646364636463222C0A222E5720632023646364636464222C0A222E6C20632023
|
||||||
|
646364636466222C0A222E6B20632023646364656531222C0A222E4D20632023
|
||||||
|
646464646464222C0A22236120632023646564656465222C0A222E7220632023
|
||||||
|
646664666466222C0A22234D20632023646664666531222C0A222E5620632023
|
||||||
|
653065306530222C0A222E4C20632023653165316531222C0A222E4220632023
|
||||||
|
653165316532222C0A222E6A20632023653365336536222C0A22235820632023
|
||||||
|
653565356538222C0A222E4120632023653965396539222C0A222E7320632023
|
||||||
|
656165616561222C0A22236A20632023656265626562222C0A222E5520632023
|
||||||
|
656365636563222C0A222E6F20632023656365636565222C0A222E4B20632023
|
||||||
|
656665666566222C0A22234120632023663066306630222C0A22517451745174
|
||||||
|
5174517451745174517451745174517451745174517451745174222C0A225174
|
||||||
|
51745174517451742E232E612E622E632E642E652E662E67517451745174222C
|
||||||
|
0A2251745174517451742E682E692E6A2E6B2E6C2E6D2E6E2E6F2E7051745174
|
||||||
|
5174222C0A225174517451742E712E722E732E742E752E762E772E782E792E7A
|
||||||
|
517451745174222C0A22517451742E712E412E412E422E432E442E452E462E47
|
||||||
|
2E482E49517451745174222C0A22517451742E4A2E4B2E4C2E4D2E4E2E4F2E50
|
||||||
|
2E512E522E532E54517451745174222C0A22517451742E632E552E562E572E58
|
||||||
|
2E472E592E5A2E302E312E32517451745174222C0A22517451742E642E552E72
|
||||||
|
2E332E342E352E362E372E382E39232E517451745174222C0A22517451742323
|
||||||
|
2E55236123622E52236323642365236623672368517451745174222C0A225174
|
||||||
|
51742369236A2E4D236B2E372E38236C236D236E236F2370517451745174222C
|
||||||
|
0A225174517423712E732E4D2372237323742375237623772378237951745174
|
||||||
|
5174222C0A2251745174237A23412E5623422343234423452346234723482349
|
||||||
|
517451745174222C0A2251745174234A234B234C234D234E234F235023512352
|
||||||
|
23532354517451745174222C0A2251745174517451742E302355235623572348
|
||||||
|
2353235323582359517451745174222C0A22517451745174517451745174235A
|
||||||
|
233023312332233323342335517451745174222C0A2251745174517451745174
|
||||||
|
51745174517451745174517451745174517451745174227D3B0A
|
||||||
|
}
|
||||||
|
end
|
||||||
|
object imgUsername: TImage
|
||||||
|
Left = 6
|
||||||
|
Height = 16
|
||||||
|
Top = 43
|
||||||
|
Width = 16
|
||||||
|
AutoSize = True
|
||||||
|
Picture.Data = {
|
||||||
|
07545069786D61702E0A00002F2A2058504D202A2F0A73746174696320636861
|
||||||
|
72202A64756D6D795B5D3D7B0A223136203136203132342032222C0A22517420
|
||||||
|
63204E6F6E65222C0A222E3220632023316334366265222C0A222E5820632023
|
||||||
|
316334386263222C0A22233420632023316633643966222C0A22235A20632023
|
||||||
|
316634306130222C0A22236120632023316634396335222C0A222E3320632023
|
||||||
|
316634636334222C0A22235920632023323035306233222C0A22233320632023
|
||||||
|
323134316137222C0A22233220632023323234346162222C0A22233020632023
|
||||||
|
323234356161222C0A22233120632023323234366163222C0A22235520632023
|
||||||
|
323434396231222C0A22233520632023323434666232222C0A222E5120632023
|
||||||
|
323533633661222C0A222E5720632023326433653638222C0A22235220632023
|
||||||
|
333536306266222C0A22236D20632023343235303838222C0A22237820632023
|
||||||
|
343338646666222C0A22236220632023343435343861222C0A22234D20632023
|
||||||
|
346135656134222C0A222E6B20632023346232653133222C0A22237720632023
|
||||||
|
346539376665222C0A22234B20632023353039666666222C0A22234920632023
|
||||||
|
353339636665222C0A22237620632023353339656664222C0A22236A20632023
|
||||||
|
353461306664222C0A22234A20632023353561336666222C0A22234820632023
|
||||||
|
353761326665222C0A22234420632023353836363966222C0A22237520632023
|
||||||
|
353961356665222C0A22236920632023353961386665222C0A22234720632023
|
||||||
|
356161386665222C0A222E6420632023356233333135222C0A22234620632023
|
||||||
|
356261636666222C0A222E7320632023356333333066222C0A22237420632023
|
||||||
|
356461636665222C0A22236820632023356562316665222C0A222E3920632023
|
||||||
|
356662366666222C0A22237120632023363062376666222C0A22235120632023
|
||||||
|
363136313836222C0A22237320632023363162326665222C0A22235320632023
|
||||||
|
363162396665222C0A22235420632023363262396665222C0A22237220632023
|
||||||
|
363362366666222C0A222E3820632023363363306666222C0A22236720632023
|
||||||
|
363462396665222C0A222E4120632023363633623131222C0A22236620632023
|
||||||
|
363862666665222C0A222E3720632023363963396666222C0A222E7A20632023
|
||||||
|
366234353232222C0A22235620632023366436343761222C0A22236520632023
|
||||||
|
366463376665222C0A222E7820632023366534303135222C0A222E6A20632023
|
||||||
|
373133653065222C0A222E7920632023373234343139222C0A222E3620632023
|
||||||
|
373264346666222C0A222E7220632023373534313132222C0A22234C20632023
|
||||||
|
373861656638222C0A22236B20632023376162376666222C0A222E6320632023
|
||||||
|
376434323131222C0A22236C20632023383061396665222C0A22232E20632023
|
||||||
|
383063316666222C0A22237920632023383238666263222C0A22234520632023
|
||||||
|
383462626635222C0A222E7120632023383534633135222C0A222E7420632023
|
||||||
|
383733653063222C0A222E6920632023383734613066222C0A222E6F20632023
|
||||||
|
383734623066222C0A222E7020632023383734623131222C0A222E6220632023
|
||||||
|
386134383066222C0A222E6E20632023386134613066222C0A222E2320632023
|
||||||
|
386434383132222C0A222E6120632023393034623130222C0A222E4A20632023
|
||||||
|
393235623261222C0A222E6820632023393335333131222C0A22237020632023
|
||||||
|
393439656233222C0A222E6520632023393634653131222C0A222E6C20632023
|
||||||
|
393734623066222C0A22236420632023393864316666222C0A222E6720632023
|
||||||
|
393935383132222C0A222E5020632023396136323264222C0A222E6620632023
|
||||||
|
396235383132222C0A222E4220632023396235653166222C0A222E6D20632023
|
||||||
|
396635383132222C0A222E3520632023613465346666222C0A222E4920632023
|
||||||
|
613736383233222C0A222E5220632023613736643334222C0A222E3020632023
|
||||||
|
613837623464222C0A222E5A20632023613937623465222C0A22236320632023
|
||||||
|
616263386663222C0A222E5620632023616537343334222C0A222E7520632023
|
||||||
|
623839373763222C0A222E3120632023633364366633222C0A22232320632023
|
||||||
|
633664376636222C0A22234120632023633737343239222C0A222E7720632023
|
||||||
|
633839633731222C0A22234F20632023636137373261222C0A22235020632023
|
||||||
|
636437393235222C0A22236E20632023636537633238222C0A22235720632023
|
||||||
|
636537653265222C0A22234220632023643137643239222C0A222E4620632023
|
||||||
|
643161393766222C0A22235820632023643361323664222C0A222E5920632023
|
||||||
|
643465326634222C0A222E3420632023643665346636222C0A222E4720632023
|
||||||
|
646662353839222C0A222E7620632023653462373861222C0A222E4520632023
|
||||||
|
653562623865222C0A22236F20632023656162333738222C0A222E4C20632023
|
||||||
|
656163636162222C0A22237A20632023656462383765222C0A22234320632023
|
||||||
|
656562613832222C0A222E4B20632023656563616136222C0A222E4F20632023
|
||||||
|
656563646137222C0A222E4820632023656564666364222C0A22234E20632023
|
||||||
|
656662633833222C0A222E4420632023663163353937222C0A222E5520632023
|
||||||
|
663663666135222C0A222E4D20632023663664306137222C0A222E4E20632023
|
||||||
|
663664306138222C0A222E5420632023663764346166222C0A222E4320632023
|
||||||
|
663765386439222C0A222E5320632023663863633963222C0A22517451745174
|
||||||
|
5174517451745174517451745174517451745174517451745174222C0A225174
|
||||||
|
517451745174517451742E232E612E622E632E6451745174517451745174222C
|
||||||
|
0A22517451745174517451742E652E662E672E682E692E6A2E6B517451745174
|
||||||
|
5174222C0A2251745174517451742E6C2E6D2E6E2E6F2E702E712E722E735174
|
||||||
|
517451745174222C0A2251745174517451742E742E752E762E772E782E792E7A
|
||||||
|
2E415174517451745174222C0A2251745174517451742E422E432E442E452E46
|
||||||
|
2E472E482E495174517451745174222C0A2251745174517451742E4A2E4B2E4C
|
||||||
|
2E4D2E4E2E4C2E4F2E505174517451745174222C0A2251745174517451742E51
|
||||||
|
2E522E532E542E542E552E562E575174517451745174222C0A22517451745174
|
||||||
|
51742E582E592E5A2E302E302E5A2E312E325174517451745174222C0A225174
|
||||||
|
517451742E332E342E352E362E372E382E39232E23232361517451745174222C
|
||||||
|
0A225174517423622363236423652366236723682369236A236B236C236D5174
|
||||||
|
5174222C0A225174236E236F2370237123722373237423752376237723782379
|
||||||
|
237A23415174222C0A22517423422343234423452346234723482349234A234B
|
||||||
|
234C234D234E234F5174222C0A22517451742350235123522353235423542354
|
||||||
|
2353235323552356235723585174222C0A2251745174517451742359235A2330
|
||||||
|
233123322333233423355174517451745174222C0A2251745174517451745174
|
||||||
|
51745174517451745174517451745174517451745174227D3B0A
|
||||||
|
}
|
||||||
|
end
|
||||||
|
object imgPassword: TImage
|
||||||
|
Left = 6
|
||||||
|
Height = 16
|
||||||
|
Top = 77
|
||||||
|
Width = 16
|
||||||
|
AutoSize = True
|
||||||
|
Picture.Data = {
|
||||||
|
07545069786D6170DE0800002F2A2058504D202A2F0A73746174696320636861
|
||||||
|
72202A64756D6D795B5D3D7B0A223136203136203130332032222C0A22517420
|
||||||
|
63204E6F6E65222C0A22236F20632023623238383338222C0A22237620632023
|
||||||
|
623538623339222C0A22234220632023623738643339222C0A22236420632023
|
||||||
|
623838333333222C0A222E4E20632023626138363334222C0A22234820632023
|
||||||
|
626139303361222C0A222E5820632023626238383335222C0A222E3820632023
|
||||||
|
626638623335222C0A22236720632023633138653336222C0A22234B20632023
|
||||||
|
633239353362222C0A22234120632023633838383331222C0A222E6B20632023
|
||||||
|
633839353339222C0A22234720632023633938613332222C0A22236320632023
|
||||||
|
636138613332222C0A22237520632023636138623332222C0A22236E20632023
|
||||||
|
636238623332222C0A22234A20632023636339303333222C0A22234920632023
|
||||||
|
643139363336222C0A222E4420632023643637633239222C0A22236520632023
|
||||||
|
643637643239222C0A222E4D20632023643637663239222C0A222E5720632023
|
||||||
|
643738313262222C0A222E3720632023643738323262222C0A22236620632023
|
||||||
|
643838353263222C0A222E7720632023646139303330222C0A222E7120632023
|
||||||
|
646439383332222C0A222E6A20632023646661313339222C0A222E6620632023
|
||||||
|
646661623432222C0A22234320632023653161633432222C0A222E3420632023
|
||||||
|
653361393365222C0A222E6F20632023653361633432222C0A222E2320632023
|
||||||
|
653362303434222C0A222E4F20632023653362323435222C0A222E4520632023
|
||||||
|
656163343666222C0A222E5020632023656163353736222C0A22237220632023
|
||||||
|
656563353238222C0A22236B20632023656563383238222C0A22232320632023
|
||||||
|
656663393262222C0A222E5620632023656663393332222C0A222E4B20632023
|
||||||
|
656663643334222C0A222E4220632023663063653338222C0A222E3120632023
|
||||||
|
663064323238222C0A22237120632023663164313339222C0A222E4720632023
|
||||||
|
663164313364222C0A22237820632023663164363433222C0A222E5520632023
|
||||||
|
663263653363222C0A222E5220632023663264363339222C0A222E4120632023
|
||||||
|
663264363437222C0A22236120632023663364363364222C0A222E4A20632023
|
||||||
|
663364373530222C0A22232E20632023663364383465222C0A222E7420632023
|
||||||
|
663364613862222C0A22236C20632023663464373431222C0A22236A20632023
|
||||||
|
663464383433222C0A222E3220632023663564343337222C0A22237920632023
|
||||||
|
663564623438222C0A222E5320632023663564623464222C0A222E4820632023
|
||||||
|
663564623564222C0A222E7520632023663564643439222C0A22237A20632023
|
||||||
|
663565313832222C0A22237320632023663664633465222C0A222E4920632023
|
||||||
|
663664663639222C0A222E3320632023663665303833222C0A22234520632023
|
||||||
|
663665313766222C0A222E3020632023663665343762222C0A22236220632023
|
||||||
|
663765313861222C0A22237420632023663765323835222C0A22236D20632023
|
||||||
|
663765323839222C0A222E5420632023663765343635222C0A222E6C20632023
|
||||||
|
663765343765222C0A222E4620632023663765353830222C0A222E7220632023
|
||||||
|
663765353831222C0A222E7A20632023663765353832222C0A22234620632023
|
||||||
|
663765363966222C0A22234420632023663765626334222C0A222E7920632023
|
||||||
|
663865373839222C0A222E6720632023663865373864222C0A222E6D20632023
|
||||||
|
663865393934222C0A222E6E20632023663865396263222C0A222E3920632023
|
||||||
|
663965616162222C0A222E6320632023663965623965222C0A222E6820632023
|
||||||
|
663965636131222C0A222E5120632023666165656163222C0A22236920632023
|
||||||
|
666165656230222C0A22237020632023666165666262222C0A222E4C20632023
|
||||||
|
666265663835222C0A222E5A20632023666266316262222C0A222E7320632023
|
||||||
|
666266316263222C0A222E6420632023666266326265222C0A22237720632023
|
||||||
|
666266346336222C0A222E3520632023666366336130222C0A222E3620632023
|
||||||
|
666366356139222C0A222E4320632023666366356165222C0A222E6220632023
|
||||||
|
666366356365222C0A222E7820632023666366376435222C0A222E6120632023
|
||||||
|
666366386465222C0A222E7620632023666466386331222C0A222E7020632023
|
||||||
|
666566636565222C0A22236820632023666566636630222C0A222E5920632023
|
||||||
|
666566636631222C0A222E6520632023666666666665222C0A222E6920632023
|
||||||
|
666666666666222C0A22517451745174517451745174517451742E232E232E23
|
||||||
|
2E235174517451745174222C0A2251745174517451745174517451742E232E23
|
||||||
|
2E612E612E232E23517451745174222C0A225174517451745174517451742E23
|
||||||
|
2E232E622E632E642E652E232E6651745174222C0A2251745174517451745174
|
||||||
|
2E232E232E622E672E682E232E232E692E6A2E6B5174222C0A22517451745174
|
||||||
|
517451742E232E612E672E6C2E6D2E6E2E232E6F2E702E712E6B222C0A225174
|
||||||
|
51745174517451742E232E642E6C2E6C2E722E6D2E732E742E752E762E77222C
|
||||||
|
0A22517451745174517451742E232E782E792E6C2E6C2E6C2E7A2E412E422E43
|
||||||
|
2E44222C0A22517451745174517451742E232E452E462E472E482E492E4A2E4B
|
||||||
|
2E4C2E4D2E4E222C0A22517451742E232E232E4F2E502E512E522E532E542E55
|
||||||
|
2E562E4C2E572E585174222C0A22517451742E232E592E5A2E302E312E322E33
|
||||||
|
2E342E352E362E372E3851745174222C0A222E232E232E232E39232E23232361
|
||||||
|
236223632364236523662367517451745174222C0A222E2323682369236A236B
|
||||||
|
236C236D236E236F5174517451745174517451745174222C0A222E2323702371
|
||||||
|
2372237323742375237651745174517451745174517451745174222C0A222E23
|
||||||
|
237723782379237A23412342517451745174517451745174517451745174222C
|
||||||
|
0A22234323442345234623472348517451745174517451745174517451745174
|
||||||
|
5174222C0A2251742349234A236E234B51745174517451745174517451745174
|
||||||
|
517451745174227D3B0A
|
||||||
|
}
|
||||||
|
end
|
||||||
|
object edHost: TEdit
|
||||||
|
Left = 101
|
||||||
|
Height = 23
|
||||||
|
Top = 5
|
||||||
|
Width = 137
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'localhost'
|
||||||
|
end
|
||||||
|
object edUsername: TEdit
|
||||||
|
Left = 101
|
||||||
|
Height = 23
|
||||||
|
Top = 39
|
||||||
|
Width = 201
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object edPassword: TEdit
|
||||||
|
Left = 101
|
||||||
|
Height = 23
|
||||||
|
Top = 73
|
||||||
|
Width = 201
|
||||||
|
EchoMode = emPassword
|
||||||
|
PasswordChar = '*'
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object edPort: TSpinEdit
|
||||||
|
Left = 246
|
||||||
|
Height = 23
|
||||||
|
Top = 5
|
||||||
|
Width = 56
|
||||||
|
MaxValue = 65565
|
||||||
|
MinValue = 1024
|
||||||
|
TabOrder = 1
|
||||||
|
Value = 2597
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object gbActions: TGroupBox
|
||||||
|
Left = 336
|
||||||
|
Height = 96
|
||||||
|
Top = 8
|
||||||
|
Width = 145
|
||||||
|
ClientHeight = 96
|
||||||
|
ClientWidth = 145
|
||||||
|
TabOrder = 2
|
||||||
|
object btnOK: TButton
|
||||||
|
Left = 6
|
||||||
|
Height = 25
|
||||||
|
Top = 5
|
||||||
|
Width = 128
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = '&OK'
|
||||||
|
Default = True
|
||||||
|
OnClick = btnOKClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object btnCancel: TButton
|
||||||
|
Left = 6
|
||||||
|
Height = 25
|
||||||
|
Top = 39
|
||||||
|
Width = 128
|
||||||
|
BorderSpacing.InnerBorder = 4
|
||||||
|
Caption = '&Cancel'
|
||||||
|
ModalResult = 2
|
||||||
|
OnClick = btnCancelClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object gbData: TGroupBox
|
||||||
|
Left = 8
|
||||||
|
Height = 97
|
||||||
|
Top = 144
|
||||||
|
Width = 321
|
||||||
|
Caption = 'Data files'
|
||||||
|
ClientHeight = 97
|
||||||
|
ClientWidth = 321
|
||||||
|
TabOrder = 1
|
||||||
|
object lblData: TLabel
|
||||||
|
Left = 7
|
||||||
|
Height = 32
|
||||||
|
Top = 8
|
||||||
|
Width = 304
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'Select the directory containing art.mul, artidx.mul, hues.mul, tiledata.mul, texmaps.mul and texidx.mul.'
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object edData: TDirectoryEdit
|
||||||
|
Left = 7
|
||||||
|
Height = 23
|
||||||
|
Top = 48
|
||||||
|
Width = 280
|
||||||
|
ButtonWidth = 23
|
||||||
|
NumGlyphs = 1
|
||||||
|
ParentColor = False
|
||||||
|
ReadOnly = True
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object GroupBox1: TGroupBox
|
||||||
|
Left = 336
|
||||||
|
Height = 81
|
||||||
|
Top = 112
|
||||||
|
Width = 145
|
||||||
|
Caption = 'Profiles'
|
||||||
|
ClientHeight = 81
|
||||||
|
ClientWidth = 145
|
||||||
|
TabOrder = 3
|
||||||
|
object btnSaveProfile: TSpeedButton
|
||||||
|
Left = 86
|
||||||
|
Height = 22
|
||||||
|
Hint = 'Save profile'
|
||||||
|
Top = 32
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
010C00002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A223136203136203135332032222C0A222E2E2063204E6F
|
||||||
|
6E65222C0A222E2C20632023333636424243222C0A222E2D2063202333363642
|
||||||
|
4242222C0A222E2A20632023333636414242222C0A222E612063202333393643
|
||||||
|
4243222C0A222E6220632023334236454244222C0A222E632063202333413644
|
||||||
|
4242222C0A222E6420632023333836424242222C0A222E652063202333453730
|
||||||
|
4242222C0A222E6620632023443145304636222C0A222E672063202344314530
|
||||||
|
4637222C0A222E6820632023463846424645222C0A222E692063202346374642
|
||||||
|
4645222C0A222E6A20632023463646394644222C0A222E6B2063202346304635
|
||||||
|
4643222C0A222E6C20632023454146304641222C0A222E6D2063202345444632
|
||||||
|
4642222C0A222E6E20632023463746414644222C0A222E6F2063202345424631
|
||||||
|
4642222C0A222E7020632023444645394638222C0A222E712063202342444430
|
||||||
|
4543222C0A222E7220632023354538394339222C0A222E732063202344314446
|
||||||
|
4636222C0A222E7420632023383041414539222C0A222E752063202346364641
|
||||||
|
4645222C0A222E7620632023463646414644222C0A222E772063202336343843
|
||||||
|
4338222C0A222E7820632023454546334642222C0A222E792063202345414631
|
||||||
|
4642222C0A222E7A20632023463246364643222C0A222E412063202346314636
|
||||||
|
4643222C0A222E4220632023453245434639222C0A222E432063202344424537
|
||||||
|
4638222C0A222E4420632023424144304545222C0A222E452063202344304446
|
||||||
|
4636222C0A222E4620632023374541384538222C0A222E472063202345394631
|
||||||
|
4641222C0A222E4820632023454546344642222C0A222E492063202345384630
|
||||||
|
4641222C0A222E4A20632023444445384638222C0A222E4B2063202344424536
|
||||||
|
4637222C0A222E4C20632023374141334531222C0A222E4D2063202343334435
|
||||||
|
4546222C0A222E4E20632023333536394237222C0A222E4F2063202343434444
|
||||||
|
4635222C0A222E5020632023374541384537222C0A222E512063202336363844
|
||||||
|
4339222C0A222E5220632023453946304641222C0A222E532063202346334638
|
||||||
|
4644222C0A222E5420632023463846414645222C0A222E552063202345464634
|
||||||
|
4643222C0A222E5620632023444645394639222C0A222E572063202344424537
|
||||||
|
4637222C0A222E5820632023443945354637222C0A222E592063202337384132
|
||||||
|
4530222C0A222E5A20632023413943324537222C0A222E302063202333353638
|
||||||
|
4236222C0A222E3120632023433944434634222C0A222E322063202337444137
|
||||||
|
4537222C0A222E3320632023453145434639222C0A222E342063202345334544
|
||||||
|
4639222C0A222E3520632023454546344643222C0A222E362063202346334637
|
||||||
|
4644222C0A222E3720632023453545444641222C0A222E382063202344384535
|
||||||
|
4636222C0A222E3920632023373741304445222C0A222E402063202341344245
|
||||||
|
4534222C0A222E2320632023333436374234222C0A222E3B2063202343374439
|
||||||
|
4634222C0A222E3A20632023374441364536222C0A222E3D2063202336353844
|
||||||
|
4339222C0A222E2B20632023363738454339222C0A222E252063202336433932
|
||||||
|
4342222C0A222E2420632023364439324342222C0A222E282063202336393930
|
||||||
|
4341222C0A222E2920632023363538434338222C0A222E5B2063202337343943
|
||||||
|
4441222C0A222E5D20632023394642414531222C0A222C2E2063202333343636
|
||||||
|
4233222C0A222C2C20632023433544384632222C0A222C2D2063202337424134
|
||||||
|
4533222C0A222C2A20632023374141334533222C0A222C612063202337414134
|
||||||
|
4533222C0A222C6220632023374241344532222C0A222C632063202337424133
|
||||||
|
4532222C0A222C6420632023374241334531222C0A222C652063202337394132
|
||||||
|
4531222C0A222C6620632023373741304446222C0A222C672063202337363946
|
||||||
|
4445222C0A222C6820632023373439454444222C0A222C692063202337323943
|
||||||
|
4442222C0A222C6A20632023373439444443222C0A222C6B2063202339414235
|
||||||
|
4444222C0A222C6C20632023333436354231222C0A222C6D2063202343324435
|
||||||
|
4632222C0A222C6E20632023373841314530222C0A222C6F2063202337353945
|
||||||
|
4445222C0A222C7020632023373339424441222C0A222C712063202337333942
|
||||||
|
4439222C0A222C7220632023393542304441222C0A222C732063202333333634
|
||||||
|
4146222C0A222C7420632023424544324630222C0A222C752063202337414133
|
||||||
|
4532222C0A222C7620632023373739464445222C0A222C772063202337363946
|
||||||
|
4444222C0A222C7820632023373239424439222C0A222C792063202337313939
|
||||||
|
4438222C0A222C7A20632023373039394436222C0A222C412063202338454142
|
||||||
|
4435222C0A222C4220632023333336334144222C0A222C432063202333363641
|
||||||
|
4241222C0A222C4420632023424244304546222C0A222C452063202337414132
|
||||||
|
4532222C0A222C4620632023364439364433222C0A222C472063202338414137
|
||||||
|
4432222C0A222C4820632023333236324142222C0A222C492063202342384345
|
||||||
|
4546222C0A222C4A20632023463746414645222C0A222C4B2063202338384330
|
||||||
|
3632222C0A222C4C20632023364139334346222C0A222C4D2063202338344133
|
||||||
|
4345222C0A222C4E20632023333236314141222C0A222C4F2063202333383643
|
||||||
|
4242222C0A222C5020632023423643434545222C0A222C512063202337414132
|
||||||
|
4531222C0A222C5220632023433244434246222C0A222C532063202336383930
|
||||||
|
4344222C0A222C5420632023383139454343222C0A222C552063202333323631
|
||||||
|
4138222C0A222C5620632023333736424241222C0A222C572063202342334341
|
||||||
|
4544222C0A222C5820632023374141324530222C0A222C592063202336353844
|
||||||
|
4341222C0A222C5A20632023374339424339222C0A222C302063202333313630
|
||||||
|
4137222C0A222C3120632023333536414241222C0A222C322063202341444336
|
||||||
|
4542222C0A222C3320632023414443354541222C0A222C342063202337433941
|
||||||
|
4338222C0A222C3520632023373939384337222C0A222C362063202333353639
|
||||||
|
4239222C0A222C3720632023333536394238222C0A222C382063202333353638
|
||||||
|
4237222C0A222C3920632023333536384235222C0A222C402063202333343636
|
||||||
|
4232222C0A222C2320632023333336354230222C0A222C3B2063202333333634
|
||||||
|
4145222C0A222C3A20632023333236334143222C0A222C3D2063202333323632
|
||||||
|
4141222C0A222C2B20632023333236314139222C0A222C252063202333313630
|
||||||
|
4138222C0A222C2420632023333136304136222C0A222C282063202333313631
|
||||||
|
4138222C0A222E2E2E2C2E2C2E2C2E2C2E2D2E2D2E2A2E2A2E612E622E632E64
|
||||||
|
2E652E2E2E2E222C0A222E2C2E662E672E682E692E6A2E6B2E6C2E6D2E6A2E6E
|
||||||
|
2E6F2E702E712E722E2E222C0A222E2C2E732E742E752E762E772E782E792E7A
|
||||||
|
2E682E412E422E432E442E712E65222C0A222E2C2E452E462E412E412E772E47
|
||||||
|
2E482E6E2E6A2E492E4A2E4B2E4C2E4D2E4E222C0A222E2C2E4F2E502E492E49
|
||||||
|
2E512E522E532E542E552E562E572E582E592E5A2E30222C0A222E2D2E312E32
|
||||||
|
2E332E332E342E352E6E2E362E372E572E582E382E392E402E23222C0A222E2D
|
||||||
|
2E3B2E3A2E772E3D2E2B2E252E242E282E292E772E772E772E5B2E5D2C2E222C
|
||||||
|
0A222E2A2C2C2C2D2C2A2C612C622C632C642C652C662C672C682C692C6A2C6B
|
||||||
|
2C6C222C0A222E2A2C6D2C2A2C2A2C632C632C622C652C6E2E392C6F2C6A2C70
|
||||||
|
2C712C722C73222C0A222E2A2C742C752C752E4C2C632C642C6E2C762C772C6A
|
||||||
|
2C782C792C7A2C412C42222C0A222C432C442C452E682E682E682E682E682E68
|
||||||
|
2E682E682E682E682C462C472C48222C0A222E642C492C652C4A2C4B2C4B2C4B
|
||||||
|
2C4B2C4B2C4B2C4B2C4B2E6A2C4C2C4D2C4E222C0A222C4F2C502C512C4A2C52
|
||||||
|
2C522C522C522C522C522C522C522E6A2C532C542C55222C0A222C562C572C58
|
||||||
|
2C4A2C4B2C4B2C4B2C4B2C4B2C4B2C4B2C4B2E6A2C592C5A2C30222C0A222C31
|
||||||
|
2C322C332E682E682E682E682E682E682E682E682E682E682C342C352C30222C
|
||||||
|
0A222C432C362C372C382C392E232C402C232C3B2C3A2C3D2C2B2C252C302C24
|
||||||
|
2C28227D0A
|
||||||
|
}
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnSaveProfileClick
|
||||||
|
ShowCaption = False
|
||||||
|
ShowHint = True
|
||||||
|
ParentShowHint = False
|
||||||
|
end
|
||||||
|
object btnDeleteProfile: TSpeedButton
|
||||||
|
Left = 111
|
||||||
|
Height = 22
|
||||||
|
Hint = 'Delete profile'
|
||||||
|
Top = 32
|
||||||
|
Width = 23
|
||||||
|
Color = clBtnFace
|
||||||
|
Glyph.Data = {
|
||||||
|
100800002F2A2058504D202A2F0A7374617469632063686172202A6772617068
|
||||||
|
69635B5D203D207B0A2231362031362039302032222C0A222E2E2063204E6F6E
|
||||||
|
65222C0A222E2C20632023464637373741222C0A222E2D206320234645373637
|
||||||
|
39222C0A222E2A20632023463836313634222C0A222E61206320234639363836
|
||||||
|
41222C0A222E6220632023463335313534222C0A222E63206320234646374538
|
||||||
|
31222C0A222E6420632023464537453831222C0A222E65206320234644373137
|
||||||
|
34222C0A222E6620632023463835463632222C0A222E67206320234642364436
|
||||||
|
46222C0A222E6820632023464637433745222C0A222E69206320234645373137
|
||||||
|
34222C0A222E6A20632023464537413744222C0A222E6B206320234646383738
|
||||||
|
41222C0A222E6C20632023464437393743222C0A222E6D206320234642363936
|
||||||
|
43222C0A222E6E20632023463835453631222C0A222E6F206320234641364336
|
||||||
|
45222C0A222E7020632023464637413744222C0A222E71206320234637354636
|
||||||
|
31222C0A222E7220632023463034363439222C0A222E73206320234643364236
|
||||||
|
45222C0A222E7420632023464437343737222C0A222E75206320234646383238
|
||||||
|
36222C0A222E7620632023464337333736222C0A222E77206320234638363236
|
||||||
|
34222C0A222E7820632023463735443630222C0A222E79206320234641364136
|
||||||
|
44222C0A222E7A20632023464637393742222C0A222E41206320234546343534
|
||||||
|
38222C0A222E4220632023463936333636222C0A222E43206320234642364437
|
||||||
|
30222C0A222E4420632023464637453830222C0A222E45206320234646374237
|
||||||
|
45222C0A222E4620632023464637393743222C0A222E47206320234646373737
|
||||||
|
39222C0A222E4820632023463735433545222C0A222E49206320234546343434
|
||||||
|
37222C0A222E4A20632023463635413544222C0A222E4B206320234646373937
|
||||||
|
44222C0A222E4C20632023464635423545222C0A222E4D206320234646353835
|
||||||
|
42222C0A222E4E20632023464637343736222C0A222E4F206320234546343334
|
||||||
|
36222C0A222E5020632023463735423544222C0A222E51206320234646373637
|
||||||
|
39222C0A222E5220632023464635363539222C0A222E53206320234646353435
|
||||||
|
37222C0A222E5420632023464637303732222C0A222E55206320234630343634
|
||||||
|
38222C0A222E5620632023463635413543222C0A222E57206320234641363436
|
||||||
|
37222C0A222E5820632023464637323734222C0A222E59206320234646373037
|
||||||
|
33222C0A222E5A20632023464636453730222C0A222E30206320234646364336
|
||||||
|
45222C0A222E3120632023463735353537222C0A222E32206320234545334433
|
||||||
|
46222C0A222E3320632023463635393542222C0A222E34206320234641363336
|
||||||
|
36222C0A222E3520632023464637313734222C0A222E36206320234636353835
|
||||||
|
41222C0A222E3720632023454534313433222C0A222E38206320234543334333
|
||||||
|
45222C0A222E3920632023463434443530222C0A222E40206320234646363736
|
||||||
|
38222C0A222E2320632023463534453530222C0A222E3B206320234542333433
|
||||||
|
36222C0A222E3A20632023463635383542222C0A222E3D206320234641363236
|
||||||
|
35222C0A222E2B20632023464637303731222C0A222E25206320234636353635
|
||||||
|
39222C0A222E2420632023454534303432222C0A222E28206320234539333233
|
||||||
|
35222C0A222E2920632023463234353437222C0A222E5B206320234646363236
|
||||||
|
33222C0A222E5D20632023463434383441222C0A222C2E206320234539324432
|
||||||
|
46222C0A222C2C20632023463535363538222C0A222C2D206320234641363136
|
||||||
|
33222C0A222C2A20632023463635353538222C0A222C61206320234544334634
|
||||||
|
31222C0A222C6220632023453632413243222C0A222C63206320234631334634
|
||||||
|
31222C0A222C6420632023463634413443222C0A222C65206320234541324633
|
||||||
|
31222C0A222C6620632023463234433446222C0A222C67206320234544334534
|
||||||
|
30222C0A222C6820632023453432323234222C0A222E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E
|
||||||
|
2E2E2E2E2C2E2D2E2E2E2E2E2E2E2E2E2E2E2E2E2A2E612E622E2E2E2E222C0A
|
||||||
|
222E2E2E2E2E2C2E632E642E652E2E2E2E2E2E2E2E2E662E672E682E662E2E2E
|
||||||
|
2E222C0A222E2E2E2E2E692E6A2E6B2E6C2E6D2E2E2E2E2E6E2E6F2E702E712E
|
||||||
|
722E2E2E2E222C0A222E2E2E2E2E2E2E732E742E752E762E772E782E792E7A2E
|
||||||
|
782E412E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E422E432E442E452E462E
|
||||||
|
472E482E492E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E4A2E4B2E
|
||||||
|
4C2E4D2E4E2E4F2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
502E512E522E532E542E552E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E
|
||||||
|
2E2E562E572E582E592E5A2E302E312E322E2E2E2E2E2E2E2E222C0A222E2E2E
|
||||||
|
2E2E2E2E332E342E352E362E372E382E392E402E232E3B2E2E2E2E2E2E222C0A
|
||||||
|
222E2E2E2E2E3A2E3D2E2B2E252E242E2E2E2E2E282E292E5B2E5D2C2E2E2E2E
|
||||||
|
2E222C0A222E2E2E2E2C2C2C2D2C2A2C612E2E2E2E2E2E2E2E2C622C632C642C
|
||||||
|
652E2E2E2E222C0A222E2E2E2E2E2E2C662C672E2E2E2E2E2E2E2E2E2E2E2E2C
|
||||||
|
682C652E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
|
||||||
|
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
|
||||||
|
}
|
||||||
|
NumGlyphs = 0
|
||||||
|
OnClick = btnDeleteProfileClick
|
||||||
|
ShowCaption = False
|
||||||
|
ShowHint = True
|
||||||
|
ParentShowHint = False
|
||||||
|
end
|
||||||
|
object cbProfile: TComboBox
|
||||||
|
Left = 6
|
||||||
|
Height = 21
|
||||||
|
Top = 8
|
||||||
|
Width = 128
|
||||||
|
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
|
||||||
|
MaxLength = 0
|
||||||
|
OnChange = cbProfileChange
|
||||||
|
Style = csDropDownList
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,187 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmLogin;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
ExtCtrls, Spin, EditBtn, Buttons, IniFiles;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmLogin }
|
||||||
|
|
||||||
|
TfrmLogin = class(TForm)
|
||||||
|
btnOK: TButton;
|
||||||
|
btnCancel: TButton;
|
||||||
|
cbProfile: TComboBox;
|
||||||
|
edData: TDirectoryEdit;
|
||||||
|
edHost: TEdit;
|
||||||
|
edUsername: TEdit;
|
||||||
|
edPassword: TEdit;
|
||||||
|
gbConnection: TGroupBox;
|
||||||
|
gbData: TGroupBox;
|
||||||
|
gbActions: TGroupBox;
|
||||||
|
GroupBox1: TGroupBox;
|
||||||
|
imgHost: TImage;
|
||||||
|
imgUsername: TImage;
|
||||||
|
imgPassword: TImage;
|
||||||
|
lblCopyright: TLabel;
|
||||||
|
lblHost: TLabel;
|
||||||
|
lblUsername: TLabel;
|
||||||
|
lblPassword: TLabel;
|
||||||
|
edPort: TSpinEdit;
|
||||||
|
lblData: TLabel;
|
||||||
|
btnSaveProfile: TSpeedButton;
|
||||||
|
btnDeleteProfile: TSpeedButton;
|
||||||
|
procedure btnCancelClick(Sender: TObject);
|
||||||
|
procedure btnDeleteProfileClick(Sender: TObject);
|
||||||
|
procedure btnOKClick(Sender: TObject);
|
||||||
|
procedure btnSaveProfileClick(Sender: TObject);
|
||||||
|
procedure cbProfileChange(Sender: TObject);
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
protected
|
||||||
|
FProfilePath: string;
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmLogin: TfrmLogin;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UdmNetwork;
|
||||||
|
|
||||||
|
{$I version.inc}
|
||||||
|
|
||||||
|
{ TfrmLogin }
|
||||||
|
|
||||||
|
procedure TfrmLogin.btnCancelClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if cbProfile.ItemIndex > -1 then
|
||||||
|
begin
|
||||||
|
DeleteFile(FProfilePath + cbProfile.Text + '.ini');
|
||||||
|
cbProfile.Items.Delete(cbProfile.ItemIndex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLogin.btnOKClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
path: string;
|
||||||
|
begin
|
||||||
|
path := IncludeTrailingPathDelimiter(edData.Text);
|
||||||
|
if (not FileExists(path + 'art.mul')) or
|
||||||
|
(not FileExists(path + 'artidx.mul')) or
|
||||||
|
(not FileExists(path + 'hues.mul')) or
|
||||||
|
(not FileExists(path + 'tiledata.mul')) or
|
||||||
|
(not FileExists(path + 'texmaps.mul')) or
|
||||||
|
(not FileExists(path + 'texidx.mul')) then
|
||||||
|
begin
|
||||||
|
MessageDlg('Incorrect directory', 'The data path you specified does not seem to be correct.', mtWarning, [mbOK], 0);
|
||||||
|
edData.SetFocus;
|
||||||
|
Exit;
|
||||||
|
end else
|
||||||
|
ModalResult := mrOK;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLogin.btnSaveProfileClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
profileName: string;
|
||||||
|
profile: TIniFile;
|
||||||
|
begin
|
||||||
|
profileName := cbProfile.Text;
|
||||||
|
if InputQuery('Save profile', 'Enter the name of the profile:', profileName) then
|
||||||
|
begin
|
||||||
|
profile := TIniFile.Create(FProfilePath + profileName + '.ini');
|
||||||
|
profile.WriteString('Connection', 'Host', edHost.Text);
|
||||||
|
profile.WriteInteger('Connection', 'Port', edPort.Value);
|
||||||
|
profile.WriteString('Connection', 'Username', edUsername.Text);
|
||||||
|
profile.WriteString('Data', 'Path', edData.Text);
|
||||||
|
profile.Free;
|
||||||
|
cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName);
|
||||||
|
if cbProfile.ItemIndex = -1 then
|
||||||
|
begin
|
||||||
|
cbProfile.Items.Add(profileName);
|
||||||
|
cbProfile.ItemIndex := cbProfile.Items.Count - 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLogin.cbProfileChange(Sender: TObject);
|
||||||
|
var
|
||||||
|
profile: TIniFile;
|
||||||
|
begin
|
||||||
|
if cbProfile.ItemIndex > -1 then
|
||||||
|
begin
|
||||||
|
profile := TIniFile.Create(FProfilePath + cbProfile.Text + '.ini');
|
||||||
|
edHost.Text := profile.ReadString('Connection', 'Host', '');
|
||||||
|
edPort.Value := profile.ReadInteger('Connection', 'Port', 2597);
|
||||||
|
edUsername.Text := profile.ReadString('Connection', 'Username', '');
|
||||||
|
edPassword.Text := '';
|
||||||
|
edData.Text := profile.ReadString('Data', 'Path', '');
|
||||||
|
edPassword.SetFocus;
|
||||||
|
profile.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
if ModalResult <> mrOK then
|
||||||
|
dmNetwork.CheckClose(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmLogin.FormCreate(Sender: TObject);
|
||||||
|
var
|
||||||
|
searchRec: TSearchRec;
|
||||||
|
begin
|
||||||
|
lblCopyright.Caption := Format('UO CentrED Client Version %s (c) %s', [ProductVersion, Copyright]);
|
||||||
|
|
||||||
|
FProfilePath := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'Profiles' + PathDelim;
|
||||||
|
if FindFirst(FProfilePath + '*.ini', faAnyFile, searchRec) = 0 then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
cbProfile.Items.Add(ChangeFileExt(searchRec.Name, ''));
|
||||||
|
until FindNext(searchRec) <> 0;
|
||||||
|
end;
|
||||||
|
FindClose(searchRec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmLogin.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,54 @@
|
||||||
|
object frmRadarMap: TfrmRadarMap
|
||||||
|
Left = 290
|
||||||
|
Height = 360
|
||||||
|
Top = 171
|
||||||
|
Width = 479
|
||||||
|
HorzScrollBar.Page = 478
|
||||||
|
VertScrollBar.Page = 359
|
||||||
|
Caption = 'Radar Map (1:8)'
|
||||||
|
ClientHeight = 360
|
||||||
|
ClientWidth = 479
|
||||||
|
OnClose = FormClose
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
OnResize = FormResize
|
||||||
|
Position = poOwnerFormCenter
|
||||||
|
ShowInTaskBar = stAlways
|
||||||
|
object pnlBottom: TPanel
|
||||||
|
Height = 21
|
||||||
|
Top = 339
|
||||||
|
Width = 479
|
||||||
|
Align = alBottom
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 21
|
||||||
|
ClientWidth = 479
|
||||||
|
TabOrder = 0
|
||||||
|
object lblPosition: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 21
|
||||||
|
Width = 38
|
||||||
|
Align = alLeft
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
Layout = tlCenter
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object sbMain: TScrollBox
|
||||||
|
Height = 339
|
||||||
|
Width = 479
|
||||||
|
HorzScrollBar.Page = 474
|
||||||
|
HorzScrollBar.Range = 292
|
||||||
|
VertScrollBar.Page = 334
|
||||||
|
VertScrollBar.Range = 202
|
||||||
|
Align = alClient
|
||||||
|
TabOrder = 1
|
||||||
|
object pbRadar: TPaintBox
|
||||||
|
Height = 202
|
||||||
|
Width = 292
|
||||||
|
OnMouseDown = pbRadarMouseDown
|
||||||
|
OnMouseMove = pbRadarMouseMove
|
||||||
|
OnMouseLeave = pbRadarMouseLeave
|
||||||
|
OnPaint = pbRadarPaint
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,246 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmRadar;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||||
|
ImagingClasses, ImagingComponents, ImagingTypes, UEnhancedMemoryStream, crc,
|
||||||
|
StdCtrls;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
TRadarColorMap = array of Word;
|
||||||
|
|
||||||
|
{ TfrmRadarMap }
|
||||||
|
|
||||||
|
TfrmRadarMap = class(TForm)
|
||||||
|
lblPosition: TLabel;
|
||||||
|
pbRadar: TPaintBox;
|
||||||
|
pnlBottom: TPanel;
|
||||||
|
sbMain: TScrollBox;
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure FormResize(Sender: TObject);
|
||||||
|
procedure pbRadarMouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
procedure pbRadarMouseLeave(Sender: TObject);
|
||||||
|
procedure pbRadarMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||||
|
Y: Integer);
|
||||||
|
procedure pbRadarPaint(Sender: TObject);
|
||||||
|
protected
|
||||||
|
FRadar: TSingleImage;
|
||||||
|
FRadarDependencies: TList;
|
||||||
|
procedure OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
procedure RefreshRadar(ARadarMap: TRadarColorMap);
|
||||||
|
procedure RepaintRadar;
|
||||||
|
public
|
||||||
|
property Radar: TSingleImage read FRadar;
|
||||||
|
property Dependencies: TList read FRadarDependencies;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmRadarMap: TfrmRadarMap;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UdmNetwork, UGameResources, UPacketHandlers, UPackets, UfrmInitialize,
|
||||||
|
UfrmMain, UGraphicHelper;
|
||||||
|
|
||||||
|
{ TfrmRadarMap }
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FRadar := TSingleImage.CreateFromParams(ResMan.Landscape.Width,
|
||||||
|
ResMan.Landscape.Height, ifA8R8G8B8);
|
||||||
|
pbRadar.Width := FRadar.Width;
|
||||||
|
pbRadar.Height := FRadar.Height;
|
||||||
|
sbMain.ClientWidth := FRadar.Width;
|
||||||
|
sbMain.ClientHeight := FRadar.Height;
|
||||||
|
ClientWidth := sbMain.Width + sbMain.VertScrollBar.Size;
|
||||||
|
ClientHeight := sbMain.Height + sbMain.HorzScrollBar.Size + pnlBottom.Height;
|
||||||
|
Constraints.MaxWidth := Width;
|
||||||
|
Constraints.MaxHeight := Height;
|
||||||
|
|
||||||
|
FRadarDependencies := TList.Create;
|
||||||
|
|
||||||
|
RegisterPacketHandler($0D, TPacketHandler.Create(0, @OnRadarHandlingPacket));
|
||||||
|
|
||||||
|
dmNetwork.Send(TRequestRadarChecksumPacket.Create);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.FormDestroy(Sender: TObject);
|
||||||
|
var
|
||||||
|
radarMap: TRadarColorMap;
|
||||||
|
x, y: Integer;
|
||||||
|
radarMapFile: TFileStream;
|
||||||
|
begin
|
||||||
|
RegisterPacketHandler($0D, nil);
|
||||||
|
|
||||||
|
SetLength(radarMap, FRadar.Width * FRadar.Height);
|
||||||
|
for x := 0 to FRadar.Width - 1 do
|
||||||
|
for y := 0 to FRadar.Height - 1 do
|
||||||
|
radarMap[x * FRadar.Height + y] := EncodeUOColor(PInteger(FRadar.PixelPointers[x, y])^);
|
||||||
|
|
||||||
|
radarMapFile := TFileStream.Create(IncludeTrailingPathDelimiter(
|
||||||
|
ExtractFilePath(Application.ExeName)) + 'RadarMap.cache', fmCreate);
|
||||||
|
radarMapFile.Write(radarMap[0], Length(radarMap) * SizeOf(Word));
|
||||||
|
radarMapFile.Free;
|
||||||
|
|
||||||
|
if FRadarDependencies <> nil then FreeAndNil(FRadarDependencies);
|
||||||
|
if FRadar <> nil then FreeAndNil(FRadar);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.FormResize(Sender: TObject);
|
||||||
|
begin
|
||||||
|
sbMain.AutoScroll := (Width < Constraints.MaxWidth) or (Height < Constraints.MaxHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.pbRadarMouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
begin
|
||||||
|
frmMain.SetPos(X * 8, Y * 8);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.pbRadarMouseLeave(Sender: TObject);
|
||||||
|
begin
|
||||||
|
lblPosition.Caption := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.pbRadarMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||||
|
Y: Integer);
|
||||||
|
begin
|
||||||
|
lblPosition.Caption := Format('X: %d, Y: %d', [X * 8, Y * 8]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.pbRadarPaint(Sender: TObject);
|
||||||
|
var
|
||||||
|
posX, posY: Word;
|
||||||
|
begin
|
||||||
|
DisplayImage(pbRadar.Canvas, 0, 0, FRadar);
|
||||||
|
posX := frmMain.X div 8;
|
||||||
|
posY := frmMain.Y div 8;
|
||||||
|
pbRadar.Canvas.Pen.Color := clBlack;
|
||||||
|
pbRadar.Canvas.Pen.Style := psSolid;
|
||||||
|
pbRadar.Canvas.Brush.Color := clRed;
|
||||||
|
pbRadar.Canvas.Brush.Style := bsSolid;
|
||||||
|
pbRadar.Canvas.Ellipse(posX - 3, posY - 3, posX + 3, posY + 3);
|
||||||
|
{pbRadar.Canvas.Pen.Color := clRed;
|
||||||
|
pbRadar.Canvas.Pen.Style := psDash;
|
||||||
|
pbRadar.Canvas.Line(0, posY, pbRadar.Width, posY);
|
||||||
|
pbRadar.Canvas.Line(posX, 0, posX, pbRadar.Height);}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||||||
|
var
|
||||||
|
subID: Byte;
|
||||||
|
checksum, realChecksum: Cardinal;
|
||||||
|
radarMapFile: TFileStream;
|
||||||
|
radarMapFileName: string;
|
||||||
|
radarMap: TRadarColorMap;
|
||||||
|
x, y: Integer;
|
||||||
|
begin
|
||||||
|
subID := ABuffer.ReadByte;
|
||||||
|
case subID of
|
||||||
|
$01: //checksum
|
||||||
|
begin
|
||||||
|
checksum := ABuffer.ReadCardinal;
|
||||||
|
realChecksum := crc32(0, nil, 0);
|
||||||
|
radarMapFileName := IncludeTrailingPathDelimiter(ExtractFilePath(
|
||||||
|
Application.ExeName)) + 'RadarMap.cache';
|
||||||
|
if FileExists(radarMapFileName) then
|
||||||
|
begin
|
||||||
|
radarMapFile := TFileStream.Create(radarMapFileName, fmOpenRead);
|
||||||
|
SetLength(radarMap, radarMapFile.Size div SizeOf(Word));
|
||||||
|
radarMapFile.Read(radarMap[0], radarMapFile.Size);
|
||||||
|
radarMapFile.Free;
|
||||||
|
|
||||||
|
realChecksum := crc32(realChecksum, @radarMap[0], Length(radarMap) * SizeOf(Word));
|
||||||
|
end;
|
||||||
|
|
||||||
|
if checksum <> realChecksum then
|
||||||
|
begin
|
||||||
|
frmInitialize.lblStatus.Caption := 'Updating Radar Map';
|
||||||
|
frmInitialize.Show;
|
||||||
|
frmInitialize.SetModal;
|
||||||
|
//frmMain.Enabled := False;
|
||||||
|
dmNetwork.Send(TRequestRadarMapPacket.Create);
|
||||||
|
end else
|
||||||
|
RefreshRadar(radarMap);
|
||||||
|
end;
|
||||||
|
$02: //radar map
|
||||||
|
begin
|
||||||
|
SetLength(radarMap, (ABuffer.Size - ABuffer.Position) div SizeOf(Word));
|
||||||
|
ABuffer.Read(radarMap[0], Length(radarMap) * SizeOf(Word));
|
||||||
|
RefreshRadar(radarMap);
|
||||||
|
//frmMain.Enabled := True;
|
||||||
|
frmInitialize.UnsetModal;
|
||||||
|
frmInitialize.Hide;
|
||||||
|
end;
|
||||||
|
$03: //update radar
|
||||||
|
begin
|
||||||
|
x := ABuffer.ReadWord;
|
||||||
|
y := ABuffer.ReadWord;
|
||||||
|
PInteger(FRadar.PixelPointers[x, y])^ := DecodeUOColor(ABuffer.ReadWord);
|
||||||
|
RepaintRadar;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.RefreshRadar(ARadarMap: TRadarColorMap);
|
||||||
|
var
|
||||||
|
x, y: Integer;
|
||||||
|
begin
|
||||||
|
for x := 0 to FRadar.Width - 1 do
|
||||||
|
for y := 0 to FRadar.Height - 1 do
|
||||||
|
PInteger(FRadar.PixelPointers[x, y])^ := DecodeUOColor(ARadarMap[x * FRadar.Height + y]);
|
||||||
|
RepaintRadar;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmRadarMap.RepaintRadar;
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
pbRadar.Repaint;
|
||||||
|
for i := 0 to FRadarDependencies.Count - 1 do
|
||||||
|
TWinControl(FRadarDependencies.Items[i]).Repaint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmRadar.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,64 @@
|
||||||
|
object frmTileInfo: TfrmTileInfo
|
||||||
|
Left = 290
|
||||||
|
Height = 107
|
||||||
|
Top = 171
|
||||||
|
Width = 250
|
||||||
|
HorzScrollBar.Page = 249
|
||||||
|
VertScrollBar.Page = 106
|
||||||
|
AutoSize = True
|
||||||
|
BorderIcons = []
|
||||||
|
BorderStyle = bsNone
|
||||||
|
Caption = 'Tile info'
|
||||||
|
ClientHeight = 107
|
||||||
|
ClientWidth = 250
|
||||||
|
Color = clInfoBk
|
||||||
|
Constraints.MinWidth = 250
|
||||||
|
Font.Color = clInfoText
|
||||||
|
FormStyle = fsStayOnTop
|
||||||
|
OnShow = FormShow
|
||||||
|
object lblTileID: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 17
|
||||||
|
Top = 27
|
||||||
|
Width = 234
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 2
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
BorderSpacing.Bottom = 8
|
||||||
|
Font.Color = clInfoText
|
||||||
|
Font.Style = [fsItalic]
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblFlags: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 47
|
||||||
|
Top = 52
|
||||||
|
Width = 234
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Around = 8
|
||||||
|
Font.Color = clInfoText
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object lblName: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 17
|
||||||
|
Top = 8
|
||||||
|
Width = 234
|
||||||
|
Align = alTop
|
||||||
|
BorderSpacing.Left = 8
|
||||||
|
BorderSpacing.Top = 8
|
||||||
|
BorderSpacing.Right = 8
|
||||||
|
BorderSpacing.Bottom = 2
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object tmHide: TTimer
|
||||||
|
Enabled = False
|
||||||
|
Interval = 5000
|
||||||
|
OnTimer = tmHideTimer
|
||||||
|
left = 216
|
||||||
|
top = 8
|
||||||
|
end
|
||||||
|
end
|
||||||
|
|
@ -0,0 +1,186 @@
|
||||||
|
(*
|
||||||
|
* CDDL HEADER START
|
||||||
|
*
|
||||||
|
* The contents of this file are subject to the terms of the
|
||||||
|
* Common Development and Distribution License, Version 1.0 only
|
||||||
|
* (the "License"). You may not use this file except in compliance
|
||||||
|
* with the License.
|
||||||
|
*
|
||||||
|
* You can obtain a copy of the license at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php.
|
||||||
|
* See the License for the specific language governing permissions
|
||||||
|
* and limitations under the License.
|
||||||
|
*
|
||||||
|
* When distributing Covered Code, include this CDDL HEADER in each
|
||||||
|
* file and include the License file at
|
||||||
|
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||||
|
* add the following below this CDDL HEADER, with the fields enclosed
|
||||||
|
* by brackets "[]" replaced with your own identifying * information:
|
||||||
|
* Portions Copyright [yyyy] [name of copyright owner]
|
||||||
|
*
|
||||||
|
* CDDL HEADER END
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* Portions Copyright 2007 Andreas Schneider
|
||||||
|
*)
|
||||||
|
unit UfrmTileInfo;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
ExtCtrls, LCLIntf, LCLType, LMessages, strutils;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmTileInfo }
|
||||||
|
|
||||||
|
TfrmTileInfo = class(TForm)
|
||||||
|
lblName: TLabel;
|
||||||
|
lblFlags: TLabel;
|
||||||
|
lblTileID: TLabel;
|
||||||
|
tmHide: TTimer;
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure tmHideTimer(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ private declarations }
|
||||||
|
public
|
||||||
|
procedure Update(ATileID: Word);
|
||||||
|
//procedure Show; overload; reintroduce;
|
||||||
|
procedure Show(ATileID: Word); overload;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmTileInfo: TfrmTileInfo;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
UGameResources, UTiledata;
|
||||||
|
|
||||||
|
{ TfrmTileInfo }
|
||||||
|
|
||||||
|
procedure TfrmTileInfo.tmHideTimer(Sender: TObject);
|
||||||
|
begin
|
||||||
|
tmHide.Enabled := False;
|
||||||
|
Hide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmTileInfo.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
tmHide.Enabled := True;
|
||||||
|
Left := Mouse.CursorPos.x + 8;
|
||||||
|
Top := Mouse.CursorPos.y + 8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmTileInfo.Update(ATileID: Word);
|
||||||
|
var
|
||||||
|
tileData: TTiledata;
|
||||||
|
prefix, flags: string;
|
||||||
|
|
||||||
|
procedure UpdateFlags(AFlag: LongWord; AName: string);
|
||||||
|
begin
|
||||||
|
if tileData.HasFlag(AFlag) then
|
||||||
|
begin
|
||||||
|
if flags <> '' then
|
||||||
|
flags := flags + ', ' + AName
|
||||||
|
else
|
||||||
|
flags := AName;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Visible then
|
||||||
|
begin
|
||||||
|
Left := Mouse.CursorPos.x + 8;
|
||||||
|
Top := Mouse.CursorPos.y + 8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
flags := '';
|
||||||
|
|
||||||
|
if ATileID < $4000 then
|
||||||
|
begin
|
||||||
|
tileData := ResMan.Tiledata.LandTiles[ATileID];
|
||||||
|
if TLandTiledata(tileData).TextureID > 0 then
|
||||||
|
flags := 'Stretchable';
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
Dec(ATileID, $4000);
|
||||||
|
tileData := ResMan.Tiledata.StaticTiles[ATileID];
|
||||||
|
end;
|
||||||
|
|
||||||
|
if tileData.HasFlag(tdfArticleA) then
|
||||||
|
prefix := 'a '
|
||||||
|
else if tileData.HasFlag(tdfArticleAn) then
|
||||||
|
prefix := 'an '
|
||||||
|
else
|
||||||
|
prefix := '';
|
||||||
|
|
||||||
|
lblName.Caption := AnsiProperCase(Format('%s%s', [prefix, tileData.TileName]), [' ']);
|
||||||
|
lblTileID.Caption := Format('Tile ID: $%x (%0:d)', [ATileID]);
|
||||||
|
|
||||||
|
UpdateFlags(tdfBackground, 'Background');
|
||||||
|
UpdateFlags(tdfWeapon, 'Weapon');
|
||||||
|
UpdateFlags(tdfTransparent, 'Transparent');
|
||||||
|
UpdateFlags(tdfTranslucent, 'Translucent');
|
||||||
|
UpdateFlags(tdfWall, 'Wall');
|
||||||
|
UpdateFlags(tdfDamaging, 'Damaging');
|
||||||
|
UpdateFlags(tdfImpassable, 'Impassable');
|
||||||
|
UpdateFlags(tdfWet, 'Wet');
|
||||||
|
UpdateFlags(tdfSurface, 'Surface');
|
||||||
|
UpdateFlags(tdfBridge, 'Bridge');
|
||||||
|
UpdateFlags(tdfGeneric, 'Generic');
|
||||||
|
UpdateFlags(tdfWindow, 'Window');
|
||||||
|
UpdateFlags(tdfNoShoot, 'NoShoot');
|
||||||
|
UpdateFlags(tdfInternal, 'Internal');
|
||||||
|
UpdateFlags(tdfFoliage, 'Foliage');
|
||||||
|
UpdateFlags(tdfPartialHue, 'PartialHue');
|
||||||
|
UpdateFlags(tdfMap, 'Map');
|
||||||
|
UpdateFlags(tdfContainer, 'Container');
|
||||||
|
UpdateFlags(tdfWearable, 'Wearable');
|
||||||
|
UpdateFlags(tdfLightSource, 'Lightsource');
|
||||||
|
UpdateFlags(tdfAnimation, 'Animation');
|
||||||
|
UpdateFlags(tdfNoDiagonal, 'NoDiagonal');
|
||||||
|
UpdateFlags(tdfArmor, 'Armor');
|
||||||
|
UpdateFlags(tdfRoof, 'Roof');
|
||||||
|
UpdateFlags(tdfDoor, 'Door');
|
||||||
|
UpdateFlags(tdfStairBack, 'StairBack');
|
||||||
|
UpdateFlags(tdfStairRight, 'StairRight');
|
||||||
|
|
||||||
|
lblFlags.Caption := Format('Flags = [%s]', [flags]);
|
||||||
|
|
||||||
|
if tmHide.Enabled then
|
||||||
|
begin
|
||||||
|
tmHide.Enabled := False;
|
||||||
|
tmHide.Enabled := True; //Refresh timer
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{procedure TfrmTileInfo.Show;
|
||||||
|
begin
|
||||||
|
ShowWindow(Handle, SW_SHOWNOACTIVATE);
|
||||||
|
Include(FormState, fsVisible);
|
||||||
|
VisibleChanging;
|
||||||
|
try
|
||||||
|
Perform(CM_VISIBLECHANGED, WParam(Ord(True)), 0);
|
||||||
|
AdjustSize;
|
||||||
|
RequestAlign;
|
||||||
|
finally
|
||||||
|
VisibleChanged;
|
||||||
|
end;
|
||||||
|
//FormShow(Self);
|
||||||
|
end;}
|
||||||
|
|
||||||
|
procedure TfrmTileInfo.Show(ATileID: Word);
|
||||||
|
begin
|
||||||
|
Update(ATileID);
|
||||||
|
Show;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I UfrmTileInfo.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,853 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingBitmap.pas 94 2007-06-21 19:29:49Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains image format loader/saver for Windows Bitmap images.}
|
||||||
|
unit ImagingBitmap;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
ImagingTypes, Imaging, ImagingUtility, ImagingFormats, ImagingIO;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Class for loading and saving Windows Bitmap images.
|
||||||
|
It can load/save 8bit indexed, 16, 24, 32 bit RGB or ARGB
|
||||||
|
images with or without RLE compression. It can also load 1/4 bit
|
||||||
|
indexed images and OS2 bitmaps.}
|
||||||
|
TBitmapFileFormat = class(TImageFileFormat)
|
||||||
|
protected
|
||||||
|
FUseRLE: LongBool;
|
||||||
|
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
|
||||||
|
OnlyFirstLevel: Boolean): Boolean; override;
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
function TestFormat(Handle: TImagingHandle): Boolean; override;
|
||||||
|
published
|
||||||
|
{ Controls that RLE compression is used during saving. Accessible trough
|
||||||
|
ImagingBitmapRLE option.}
|
||||||
|
property UseRLE: LongBool read FUseRLE write FUseRLE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
SBitmapFormatName = 'Windows Bitmap Image';
|
||||||
|
SBitmapMasks = '*.bmp,*.dib';
|
||||||
|
BitmapSupportedFormats: TImageFormats = [ifIndex8, ifA1R5G5B5, ifA4R4G4B4,
|
||||||
|
ifR5G6B5, ifR8G8B8, ifA8R8G8B8, ifX1R5G5B5, ifX4R4G4B4, ifX8R8G8B8];
|
||||||
|
BitmapDefaultRLE = True;
|
||||||
|
|
||||||
|
const
|
||||||
|
{ Bitmap file identifier 'BM'.}
|
||||||
|
BMMagic: Word = 19778;
|
||||||
|
|
||||||
|
{ Constants for the TBitmapInfoHeader.Compression field.}
|
||||||
|
BI_RGB = 0;
|
||||||
|
BI_RLE8 = 1;
|
||||||
|
BI_RLE4 = 2;
|
||||||
|
BI_BITFIELDS = 3;
|
||||||
|
|
||||||
|
V3InfoHeaderSize = 40;
|
||||||
|
V4InfoHeaderSize = 108;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ File Header for Windows/OS2 bitmap file.}
|
||||||
|
TBitmapFileHeader = packed record
|
||||||
|
ID: Word; // Is always 19778 : 'BM'
|
||||||
|
Size: LongWord; // Filesize
|
||||||
|
Reserved1: Word;
|
||||||
|
Reserved2: Word;
|
||||||
|
Offset: LongWord; // Offset from start pos to beginning of image bits
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Info Header for Windows bitmap file version 4.}
|
||||||
|
TBitmapInfoHeader = packed record
|
||||||
|
Size: LongWord;
|
||||||
|
Width: LongInt;
|
||||||
|
Height: LongInt;
|
||||||
|
Planes: Word;
|
||||||
|
BitCount: Word;
|
||||||
|
Compression: LongWord;
|
||||||
|
SizeImage: LongWord;
|
||||||
|
XPelsPerMeter: LongInt;
|
||||||
|
YPelsPerMeter: LongInt;
|
||||||
|
ClrUsed: LongInt;
|
||||||
|
ClrImportant: LongInt;
|
||||||
|
RedMask: LongWord;
|
||||||
|
GreenMask: LongWord;
|
||||||
|
BlueMask: LongWord;
|
||||||
|
AlphaMask: LongWord;
|
||||||
|
CSType: LongWord;
|
||||||
|
EndPoints: array[0..8] of LongWord;
|
||||||
|
GammaRed: LongWord;
|
||||||
|
GammaGreen: LongWord;
|
||||||
|
GammaBlue: LongWord;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Info Header for OS2 bitmaps.}
|
||||||
|
TBitmapCoreHeader = packed record
|
||||||
|
Size: LongWord;
|
||||||
|
Width: Word;
|
||||||
|
Height: Word;
|
||||||
|
Planes: Word;
|
||||||
|
BitCount: Word;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Used in RLE encoding and decoding.}
|
||||||
|
TRLEOpcode = packed record
|
||||||
|
Count: Byte;
|
||||||
|
Command: Byte;
|
||||||
|
end;
|
||||||
|
PRLEOpcode = ^TRLEOpcode;
|
||||||
|
|
||||||
|
{ TBitmapFileFormat class implementation }
|
||||||
|
|
||||||
|
constructor TBitmapFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SBitmapFormatName;
|
||||||
|
FCanLoad := True;
|
||||||
|
FCanSave := True;
|
||||||
|
FIsMultiImageFormat := False;
|
||||||
|
FSupportedFormats := BitmapSupportedFormats;
|
||||||
|
|
||||||
|
FUseRLE := BitmapDefaultRLE;
|
||||||
|
|
||||||
|
AddMasks(SBitmapMasks);
|
||||||
|
RegisterOption(ImagingBitmapRLE, @FUseRLE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBitmapFileFormat.LoadData(Handle: TImagingHandle;
|
||||||
|
var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
BF: TBitmapFileHeader;
|
||||||
|
BI: TBitmapInfoHeader;
|
||||||
|
BC: TBitmapCoreHeader;
|
||||||
|
IsOS2: Boolean;
|
||||||
|
PalRGB: PPalette24;
|
||||||
|
I, FPalSize, AlignedSize, StartPos, HeaderSize, AlignedWidthBytes, WidthBytes: LongInt;
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
Data: Pointer;
|
||||||
|
|
||||||
|
procedure LoadRGB;
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
LineBuffer: PByte;
|
||||||
|
begin
|
||||||
|
with Images[0], GetIO do
|
||||||
|
begin
|
||||||
|
// If BI.Height is < 0 then image data are stored non-flipped
|
||||||
|
// but default in windows is flipped so if Height is positive we must
|
||||||
|
// flip it
|
||||||
|
|
||||||
|
if BI.BitCount < 8 then
|
||||||
|
begin
|
||||||
|
// For 1 and 4 bit images load aligned data, they will be converted to
|
||||||
|
// 8 bit and unaligned later
|
||||||
|
GetMem(Data, AlignedSize);
|
||||||
|
|
||||||
|
if BI.Height < 0 then
|
||||||
|
Read(Handle, Data, AlignedSize)
|
||||||
|
else
|
||||||
|
for I := Height - 1 downto 0 do
|
||||||
|
Read(Handle, @PByteArray(Data)[I * AlignedWidthBytes], AlignedWidthBytes);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Images with pixels of size >= 1 Byte are read line by line and
|
||||||
|
// copied to image bits without padding bytes
|
||||||
|
GetMem(LineBuffer, AlignedWidthBytes);
|
||||||
|
try
|
||||||
|
if BI.Height < 0 then
|
||||||
|
for I := 0 to Height - 1 do
|
||||||
|
begin
|
||||||
|
Read(Handle, LineBuffer, AlignedWidthBytes);
|
||||||
|
Move(LineBuffer^, PByteArray(Bits)[I * WidthBytes], WidthBytes);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
for I := Height - 1 downto 0 do
|
||||||
|
begin
|
||||||
|
Read(Handle, LineBuffer, AlignedWidthBytes);
|
||||||
|
Move(LineBuffer^, PByteArray(Bits)[I * WidthBytes], WidthBytes);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FreeMemNil(LineBuffer);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure LoadRLE4;
|
||||||
|
var
|
||||||
|
RLESrc: PByteArray;
|
||||||
|
Row, Col, WriteRow, I: LongInt;
|
||||||
|
SrcPos: LongWord;
|
||||||
|
DeltaX, DeltaY, Low, High: Byte;
|
||||||
|
Pixels: PByteArray;
|
||||||
|
OpCode: TRLEOpcode;
|
||||||
|
NegHeightBitmap: Boolean;
|
||||||
|
begin
|
||||||
|
GetMem(RLESrc, BI.SizeImage);
|
||||||
|
GetIO.Read(Handle, RLESrc, BI.SizeImage);
|
||||||
|
with Images[0] do
|
||||||
|
try
|
||||||
|
Low := 0;
|
||||||
|
Pixels := Bits;
|
||||||
|
SrcPos := 0;
|
||||||
|
NegHeightBitmap := BI.Height < 0;
|
||||||
|
Row := 0; // Current row in dest image
|
||||||
|
Col := 0; // Current column in dest image
|
||||||
|
// Row in dest image where actuall writting will be done
|
||||||
|
WriteRow := Iff(NegHeightBitmap, Row, Height - 1 - Row);
|
||||||
|
while (Row < Height) and (SrcPos < BI.SizeImage) do
|
||||||
|
begin
|
||||||
|
// Read RLE op-code
|
||||||
|
OpCode := PRLEOpcode(@RLESrc[SrcPos])^;
|
||||||
|
Inc(SrcPos, SizeOf(OpCode));
|
||||||
|
if OpCode.Count = 0 then
|
||||||
|
begin
|
||||||
|
// A byte Count of zero means that this is a special
|
||||||
|
// instruction.
|
||||||
|
case OpCode.Command of
|
||||||
|
0:
|
||||||
|
begin
|
||||||
|
// Move to next row
|
||||||
|
Inc(Row);
|
||||||
|
WriteRow := Iff(NegHeightBitmap, Row, Height - 1 - Row);
|
||||||
|
Col := 0;
|
||||||
|
end ;
|
||||||
|
1: Break; // Image is finished
|
||||||
|
2:
|
||||||
|
begin
|
||||||
|
// Move to a new relative position
|
||||||
|
DeltaX := RLESrc[SrcPos];
|
||||||
|
DeltaY := RLESrc[SrcPos + 1];
|
||||||
|
Inc(SrcPos, 2);
|
||||||
|
Inc(Col, DeltaX);
|
||||||
|
Inc(Row, DeltaY);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
// Do not read data after EOF
|
||||||
|
if SrcPos + OpCode.Command > BI.SizeImage then
|
||||||
|
OpCode.Command := BI.SizeImage - SrcPos;
|
||||||
|
// Take padding bytes and nibbles into account
|
||||||
|
if Col + OpCode.Command > Width then
|
||||||
|
OpCode.Command := Width - Col;
|
||||||
|
// Store absolute data. Command code is the
|
||||||
|
// number of absolute bytes to store
|
||||||
|
for I := 0 to OpCode.Command - 1 do
|
||||||
|
begin
|
||||||
|
if (I and 1) = 0 then
|
||||||
|
begin
|
||||||
|
High := RLESrc[SrcPos] shr 4;
|
||||||
|
Low := RLESrc[SrcPos] and $F;
|
||||||
|
Pixels[WriteRow * Width + Col] := High;
|
||||||
|
Inc(SrcPos);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Pixels[WriteRow * Width + Col] := Low;
|
||||||
|
Inc(Col);
|
||||||
|
end;
|
||||||
|
// Odd number of bytes is followed by a pad byte
|
||||||
|
if (OpCode.Command mod 4) in [1, 2] then
|
||||||
|
Inc(SrcPos);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Take padding bytes and nibbles into account
|
||||||
|
if Col + OpCode.Count > Width then
|
||||||
|
OpCode.Count := Width - Col;
|
||||||
|
// Store a run of the same color value
|
||||||
|
for I := 0 to OpCode.Count - 1 do
|
||||||
|
begin
|
||||||
|
if (I and 1) = 0 then
|
||||||
|
Pixels[WriteRow * Width + Col] := OpCode.Command shr 4
|
||||||
|
else
|
||||||
|
Pixels[WriteRow * Width + Col] := OpCode.Command and $F;
|
||||||
|
Inc(Col);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FreeMem(RLESrc);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure LoadRLE8;
|
||||||
|
var
|
||||||
|
RLESrc: PByteArray;
|
||||||
|
SrcCount, Row, Col, WriteRow: LongInt;
|
||||||
|
SrcPos: LongWord;
|
||||||
|
DeltaX, DeltaY: Byte;
|
||||||
|
Pixels: PByteArray;
|
||||||
|
OpCode: TRLEOpcode;
|
||||||
|
NegHeightBitmap: Boolean;
|
||||||
|
begin
|
||||||
|
GetMem(RLESrc, BI.SizeImage);
|
||||||
|
GetIO.Read(Handle, RLESrc, BI.SizeImage);
|
||||||
|
with Images[0] do
|
||||||
|
try
|
||||||
|
Pixels := Bits;
|
||||||
|
SrcPos := 0;
|
||||||
|
NegHeightBitmap := BI.Height < 0;
|
||||||
|
Row := 0; // Current row in dest image
|
||||||
|
Col := 0; // Current column in dest image
|
||||||
|
// Row in dest image where actuall writting will be done
|
||||||
|
WriteRow := Iff(NegHeightBitmap, Row, Height - 1 - Row);
|
||||||
|
while (Row < Height) and (SrcPos < BI.SizeImage) do
|
||||||
|
begin
|
||||||
|
// Read RLE op-code
|
||||||
|
OpCode := PRLEOpcode(@RLESrc[SrcPos])^;
|
||||||
|
Inc(SrcPos, SizeOf(OpCode));
|
||||||
|
if OpCode.Count = 0 then
|
||||||
|
begin
|
||||||
|
// A byte Count of zero means that this is a special
|
||||||
|
// instruction.
|
||||||
|
case OpCode.Command of
|
||||||
|
0:
|
||||||
|
begin
|
||||||
|
// Move to next row
|
||||||
|
Inc(Row);
|
||||||
|
WriteRow := Iff(NegHeightBitmap, Row, Height - 1 - Row);
|
||||||
|
Col := 0;
|
||||||
|
end ;
|
||||||
|
1: Break; // Image is finished
|
||||||
|
2:
|
||||||
|
begin
|
||||||
|
// Move to a new relative position
|
||||||
|
DeltaX := RLESrc[SrcPos];
|
||||||
|
DeltaY := RLESrc[SrcPos + 1];
|
||||||
|
Inc(SrcPos, 2);
|
||||||
|
Inc(Col, DeltaX);
|
||||||
|
Inc(Row, DeltaY);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
SrcCount := OpCode.Command;
|
||||||
|
// Do not read data after EOF
|
||||||
|
if SrcPos + OpCode.Command > BI.SizeImage then
|
||||||
|
OpCode.Command := BI.SizeImage - SrcPos;
|
||||||
|
// Take padding bytes into account
|
||||||
|
if Col + OpCode.Command > Width then
|
||||||
|
OpCode.Command := Width - Col;
|
||||||
|
// Store absolute data. Command code is the
|
||||||
|
// number of absolute bytes to store
|
||||||
|
Move(RLESrc[SrcPos], Pixels[WriteRow * Width + Col], OpCode.Command);
|
||||||
|
Inc(SrcPos, SrcCount);
|
||||||
|
Inc(Col, OpCode.Command);
|
||||||
|
// Odd number of bytes is followed by a pad byte
|
||||||
|
if (SrcCount mod 2) = 1 then
|
||||||
|
Inc(SrcPos);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Take padding bytes into account
|
||||||
|
if Col + OpCode.Count > Width then
|
||||||
|
OpCode.Count := Width - Col;
|
||||||
|
// Store a run of the same color value. Count is number of bytes to store
|
||||||
|
FillChar(Pixels [WriteRow * Width + Col], OpCode.Count, OpCode.Command);
|
||||||
|
Inc(Col, OpCode.Count);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FreeMem(RLESrc);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Data := nil;
|
||||||
|
SetLength(Images, 1);
|
||||||
|
with GetIO, Images[0] do
|
||||||
|
try
|
||||||
|
FillChar(BI, SizeOf(BI), 0);
|
||||||
|
StartPos := Tell(Handle);
|
||||||
|
Read(Handle, @BF, SizeOf(BF));
|
||||||
|
Read(Handle, @BI.Size, SizeOf(BI.Size));
|
||||||
|
IsOS2 := BI.Size = SizeOf(TBitmapCoreHeader);
|
||||||
|
|
||||||
|
// Bitmap Info reading
|
||||||
|
if IsOS2 then
|
||||||
|
begin
|
||||||
|
// OS/2 type bitmap, reads info header without 4 already read bytes
|
||||||
|
Read(Handle, @PByteArray(@BC)[SizeOf(BI.Size)],
|
||||||
|
SizeOf(TBitmapCoreHeader) - SizeOf(BI.Size));
|
||||||
|
with BI do
|
||||||
|
begin
|
||||||
|
ClrUsed := 0;
|
||||||
|
Compression := BI_RGB;
|
||||||
|
BitCount := BC.BitCount;
|
||||||
|
Height := BC.Height;
|
||||||
|
Width := BC.Width;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Windows type bitmap
|
||||||
|
HeaderSize := Min(BI.Size - SizeOf(BI.Size), SizeOf(BI) - SizeOf(BI.Size)); // do not read more than size of BI!
|
||||||
|
Read(Handle, @PByteArray(@BI)[SizeOf(BI.Size)], HeaderSize);
|
||||||
|
// SizeImage can be 0 for BI_RGB images, but it is here because of:
|
||||||
|
// I saved 8bit bitmap in Paint Shop Pro 8 as OS2 RLE compressed.
|
||||||
|
// It wrote strange 64 Byte Info header with SizeImage set to 0
|
||||||
|
// Some progs were able to open it, some were not.
|
||||||
|
if BI.SizeImage = 0 then
|
||||||
|
BI.SizeImage := BF.Size - BF.Offset;
|
||||||
|
end;
|
||||||
|
// Bit mask reading. Only read it if there is V3 header, V4 header has
|
||||||
|
// masks laoded already (only masks for RGB in V3).
|
||||||
|
if (BI.Compression = BI_BITFIELDS) and (BI.Size = V3InfoHeaderSize) then
|
||||||
|
Read(Handle, @BI.RedMask, SizeOf(BI.RedMask) * 3);
|
||||||
|
|
||||||
|
case BI.BitCount of
|
||||||
|
1, 4, 8: Format := ifIndex8;
|
||||||
|
16:
|
||||||
|
if BI.RedMask = $0F00 then
|
||||||
|
// Set XRGB4 or ARGB4 according to value of alpha mask
|
||||||
|
Format := IffFormat(BI.AlphaMask = 0, ifX4R4G4B4, ifA4R4G4B4)
|
||||||
|
else if BI.RedMask = $F800 then
|
||||||
|
Format := ifR5G6B5
|
||||||
|
else
|
||||||
|
// R5G5B5 is default 16bit format (with Compression = BI_RGB or masks).
|
||||||
|
// We set it to A1.. and later there is a check if there are any alpha values
|
||||||
|
// and if not it is changed to X1R5G5B5
|
||||||
|
Format := ifA1R5G5B5;
|
||||||
|
24: Format := ifR8G8B8;
|
||||||
|
32: Format := ifA8R8G8B8; // As with R5G5B5 there is alpha check later
|
||||||
|
end;
|
||||||
|
|
||||||
|
NewImage(BI.Width, Abs(BI.Height), Format, Images[0]);
|
||||||
|
Info := GetFormatInfo(Format);
|
||||||
|
WidthBytes := Width * Info.BytesPerPixel;
|
||||||
|
AlignedWidthBytes := (((Width * BI.BitCount) + 31) shr 5) * 4;
|
||||||
|
AlignedSize := Height * LongInt(AlignedWidthBytes);
|
||||||
|
|
||||||
|
// Palette settings and reading
|
||||||
|
if BI.BitCount <= 8 then
|
||||||
|
begin
|
||||||
|
// Seek to the begining of palette
|
||||||
|
Seek(Handle, StartPos + SizeOf(TBitmapFileHeader) + LongInt(BI.Size),
|
||||||
|
smFromBeginning);
|
||||||
|
if IsOS2 then
|
||||||
|
begin
|
||||||
|
// OS/2 type
|
||||||
|
FPalSize := 1 shl BI.BitCount;
|
||||||
|
GetMem(PalRGB, FPalSize * SizeOf(TColor24Rec));
|
||||||
|
try
|
||||||
|
Read(Handle, PalRGB, FPalSize * SizeOf(TColor24Rec));
|
||||||
|
for I := 0 to FPalSize - 1 do
|
||||||
|
with PalRGB[I] do
|
||||||
|
begin
|
||||||
|
Palette[I].R := R;
|
||||||
|
Palette[I].G := G;
|
||||||
|
Palette[I].B := B;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FreeMemNil(PalRGB);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Windows type
|
||||||
|
FPalSize := BI.ClrUsed;
|
||||||
|
if FPalSize = 0 then
|
||||||
|
FPalSize := 1 shl BI.BitCount;
|
||||||
|
Read(Handle, Palette, FPalSize * SizeOf(TColor32Rec));
|
||||||
|
end;
|
||||||
|
for I := 0 to FPalSize - 1 do
|
||||||
|
Palette[I].A := $FF;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Seek to the beginning of image bits
|
||||||
|
Seek(Handle, StartPos + LongInt(BF.Offset), smFromBeginning);
|
||||||
|
|
||||||
|
case BI.Compression of
|
||||||
|
BI_RGB: LoadRGB;
|
||||||
|
BI_RLE4: LoadRLE4;
|
||||||
|
BI_RLE8: LoadRLE8;
|
||||||
|
BI_BITFIELDS: LoadRGB;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if BI.AlphaMask = 0 then
|
||||||
|
begin
|
||||||
|
// Alpha mask is not stored in file (V3) or not defined.
|
||||||
|
// Check alpha channels of loaded images if they might contain them.
|
||||||
|
if Format = ifA1R5G5B5 then
|
||||||
|
begin
|
||||||
|
// Check if there is alpha channel present in A1R5GB5 images, if it is not
|
||||||
|
// change format to X1R5G5B5
|
||||||
|
if not Has16BitImageAlpha(Width * Height, Bits) then
|
||||||
|
Format := ifX1R5G5B5;
|
||||||
|
end
|
||||||
|
else if Format = ifA8R8G8B8 then
|
||||||
|
begin
|
||||||
|
// Check if there is alpha channel present in A8R8G8B8 images, if it is not
|
||||||
|
// change format to X8R8G8B8
|
||||||
|
if not Has32BitImageAlpha(Width * Height, Bits) then
|
||||||
|
Format := ifX8R8G8B8;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if BI.BitCount < 8 then
|
||||||
|
begin
|
||||||
|
// 1 and 4 bpp images are supported only for loading which is now
|
||||||
|
// so we now convert them to 8bpp (and unalign scanlines).
|
||||||
|
case BI.BitCount of
|
||||||
|
1: Convert1To8(Data, Bits, Width, Height, AlignedWidthBytes);
|
||||||
|
4:
|
||||||
|
begin
|
||||||
|
// RLE4 bitmaps are translated to 8bit during RLE decoding
|
||||||
|
if BI.Compression <> BI_RLE4 then
|
||||||
|
Convert4To8(Data, Bits, Width, Height, AlignedWidthBytes);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// Enlarge palette
|
||||||
|
ReallocMem(Palette, Info.PaletteEntries * SizeOf(TColor32Rec));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
FreeMemNil(Data);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBitmapFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: LongInt): Boolean;
|
||||||
|
var
|
||||||
|
StartPos, EndPos, I, Pad, PadSize, WidthBytes: LongInt;
|
||||||
|
BF: TBitmapFileHeader;
|
||||||
|
BI: TBitmapInfoHeader;
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
ImageToSave: TImageData;
|
||||||
|
MustBeFreed: Boolean;
|
||||||
|
|
||||||
|
procedure SaveRLE8;
|
||||||
|
const
|
||||||
|
BufferSize = 8 * 1024;
|
||||||
|
var
|
||||||
|
X, Y, I, SrcPos: LongInt;
|
||||||
|
DiffCount, SameCount: Byte;
|
||||||
|
Pixels: PByteArray;
|
||||||
|
Buffer: array[0..BufferSize - 1] of Byte;
|
||||||
|
BufferPos: LongInt;
|
||||||
|
|
||||||
|
procedure WriteByte(ByteToWrite: Byte);
|
||||||
|
begin
|
||||||
|
if BufferPos = BufferSize then
|
||||||
|
begin
|
||||||
|
// Flush buffer if necessary
|
||||||
|
GetIO.Write(Handle, @Buffer, BufferPos);
|
||||||
|
BufferPos := 0;
|
||||||
|
end;
|
||||||
|
Buffer[BufferPos] := ByteToWrite;
|
||||||
|
Inc(BufferPos);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
BufferPos := 0;
|
||||||
|
with GetIO, ImageToSave do
|
||||||
|
begin
|
||||||
|
for Y := Height - 1 downto 0 do
|
||||||
|
begin
|
||||||
|
X := 0;
|
||||||
|
SrcPos := 0;
|
||||||
|
Pixels := @PByteArray(Bits)[Y * Width];
|
||||||
|
|
||||||
|
while X < Width do
|
||||||
|
begin
|
||||||
|
SameCount := 1;
|
||||||
|
DiffCount := 0;
|
||||||
|
// Determine run length
|
||||||
|
while X + SameCount < Width do
|
||||||
|
begin
|
||||||
|
// If we reach max run length or byte with different value
|
||||||
|
// we end this run
|
||||||
|
if (SameCount = 255) or (Pixels[SrcPos + SameCount] <> Pixels[SrcPos]) then
|
||||||
|
Break;
|
||||||
|
Inc(SameCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if SameCount = 1 then
|
||||||
|
begin
|
||||||
|
// If there are not some bytes with the same value we
|
||||||
|
// compute how many different bytes are there
|
||||||
|
while X + DiffCount < Width do
|
||||||
|
begin
|
||||||
|
// Stop diff byte counting if there two bytes with the same value
|
||||||
|
// or DiffCount is too big
|
||||||
|
if (DiffCount = 255) or (Pixels[SrcPos + DiffCount + 1] =
|
||||||
|
Pixels[SrcPos + DiffCount]) then
|
||||||
|
Break;
|
||||||
|
Inc(DiffCount);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Now store absolute data (direct copy image->file) or
|
||||||
|
// store RLE code only (number of repeats + byte to be repeated)
|
||||||
|
if DiffCount > 2 then
|
||||||
|
begin
|
||||||
|
// Save 'Absolute Data' (0 + number of bytes) but only
|
||||||
|
// if number is >2 because (0+1) and (0+2) are other special commands
|
||||||
|
WriteByte(0);
|
||||||
|
WriteByte(DiffCount);
|
||||||
|
// Write absolute data to buffer
|
||||||
|
for I := 0 to DiffCount - 1 do
|
||||||
|
WriteByte(Pixels[SrcPos + I]);
|
||||||
|
Inc(X, DiffCount);
|
||||||
|
Inc(SrcPos, DiffCount);
|
||||||
|
// Odd number of bytes must be padded
|
||||||
|
if (DiffCount mod 2) = 1 then
|
||||||
|
WriteByte(0);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Save number of repeats and byte that should be repeated
|
||||||
|
WriteByte(SameCount);
|
||||||
|
WriteByte(Pixels[SrcPos]);
|
||||||
|
Inc(X, SameCount);
|
||||||
|
Inc(SrcPos, SameCount);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// Save 'End Of Line' command
|
||||||
|
WriteByte(0);
|
||||||
|
WriteByte(0);
|
||||||
|
end;
|
||||||
|
// Save 'End Of Bitmap' command
|
||||||
|
WriteByte(0);
|
||||||
|
WriteByte(1);
|
||||||
|
// Flush buffer
|
||||||
|
GetIO.Write(Handle, @Buffer, BufferPos);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
|
||||||
|
with GetIO, ImageToSave do
|
||||||
|
try
|
||||||
|
Info := GetFormatInfo(Format);
|
||||||
|
StartPos := Tell(Handle);
|
||||||
|
FillChar(BF, SizeOf(BF), 0);
|
||||||
|
FillChar(BI, SizeOf(BI), 0);
|
||||||
|
// Other fields will be filled later - we don't know all values now
|
||||||
|
BF.ID := BMMagic;
|
||||||
|
Write(Handle, @BF, SizeOf(BF));
|
||||||
|
if Info.HasAlphaChannel and (Info.BytesPerPixel = 2){V4 temp hack} then
|
||||||
|
// Save images with alpha in V4 format
|
||||||
|
BI.Size := V4InfoHeaderSize
|
||||||
|
else
|
||||||
|
// Save images without alpha in V3 format - for better compatibility
|
||||||
|
BI.Size := V3InfoHeaderSize;
|
||||||
|
BI.Width := Width;
|
||||||
|
BI.Height := Height;
|
||||||
|
BI.Planes := 1;
|
||||||
|
BI.BitCount := Info.BytesPerPixel * 8;
|
||||||
|
BI.XPelsPerMeter := 2835; // 72 dpi
|
||||||
|
BI.YPelsPerMeter := 2835; // 72 dpi
|
||||||
|
// Set compression
|
||||||
|
if (Info.BytesPerPixel = 1) and FUseRLE then
|
||||||
|
BI.Compression := BI_RLE8
|
||||||
|
else if (Info.HasAlphaChannel or
|
||||||
|
((BI.BitCount = 16) and (Format <> ifX1R5G5B5))) and (Info.BytesPerPixel = 2){V4 temp hack} then
|
||||||
|
BI.Compression := BI_BITFIELDS
|
||||||
|
else
|
||||||
|
BI.Compression := BI_RGB;
|
||||||
|
// Write header (first time)
|
||||||
|
Write(Handle, @BI, BI.Size);
|
||||||
|
|
||||||
|
// Write mask info
|
||||||
|
if BI.Compression = BI_BITFIELDS then
|
||||||
|
begin
|
||||||
|
if BI.BitCount = 16 then
|
||||||
|
with Info.PixelFormat^ do
|
||||||
|
begin
|
||||||
|
BI.RedMask := RBitMask;
|
||||||
|
BI.GreenMask := GBitMask;
|
||||||
|
BI.BlueMask := BBitMask;
|
||||||
|
BI.AlphaMask := ABitMask;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Set masks for A8R8G8B8
|
||||||
|
BI.RedMask := $00FF0000;
|
||||||
|
BI.GreenMask := $0000FF00;
|
||||||
|
BI.BlueMask := $000000FF;
|
||||||
|
BI.AlphaMask := $FF000000;
|
||||||
|
end;
|
||||||
|
// If V3 header is used RGB masks must be written to file separately.
|
||||||
|
// V4 header has embedded masks (V4 is default for formats with alpha).
|
||||||
|
if BI.Size = V3InfoHeaderSize then
|
||||||
|
Write(Handle, @BI.RedMask, SizeOf(BI.RedMask) * 3);
|
||||||
|
end;
|
||||||
|
// Write palette
|
||||||
|
if Palette <> nil then
|
||||||
|
Write(Handle, Palette, Info.PaletteEntries * SizeOf(TColor32Rec));
|
||||||
|
|
||||||
|
BF.Offset := Tell(Handle) - StartPos;
|
||||||
|
|
||||||
|
if BI.Compression <> BI_RLE8 then
|
||||||
|
begin
|
||||||
|
// Save uncompressed data, scanlines must be filled with pad bytes
|
||||||
|
// to be multiples of 4, save as bottom-up (Windows native) bitmap
|
||||||
|
Pad := 0;
|
||||||
|
WidthBytes := Width * Info.BytesPerPixel;
|
||||||
|
PadSize := ((Width * BI.BitCount + 31) div 32) * 4 - WidthBytes;
|
||||||
|
|
||||||
|
for I := Height - 1 downto 0 do
|
||||||
|
begin
|
||||||
|
Write(Handle, @PByteArray(Bits)[I * WidthBytes], WidthBytes);
|
||||||
|
if PadSize > 0 then
|
||||||
|
Write(Handle, @Pad, PadSize);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Save data with RLE8 compression
|
||||||
|
SaveRLE8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
EndPos := Tell(Handle);
|
||||||
|
Seek(Handle, StartPos, smFromBeginning);
|
||||||
|
// Rewrite header with new values
|
||||||
|
BF.Size := EndPos - StartPos;
|
||||||
|
BI.SizeImage := BF.Size - BF.Offset;
|
||||||
|
Write(Handle, @BF, SizeOf(BF));
|
||||||
|
Write(Handle, @BI, BI.Size);
|
||||||
|
Seek(Handle, EndPos, smFromBeginning);
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
if MustBeFreed then
|
||||||
|
FreeImage(ImageToSave);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBitmapFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
var
|
||||||
|
ConvFormat: TImageFormat;
|
||||||
|
begin
|
||||||
|
if Info.IsFloatingPoint then
|
||||||
|
// Convert FP image to RGB/ARGB according to presence of alpha channel
|
||||||
|
ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8)
|
||||||
|
else if Info.HasGrayChannel or Info.IsIndexed then
|
||||||
|
// Convert all grayscale and indexed images to Index8 unless they have alpha
|
||||||
|
// (preserve it)
|
||||||
|
ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifIndex8)
|
||||||
|
else if Info.HasAlphaChannel then
|
||||||
|
// Convert images with alpha channel to A8R8G8B8
|
||||||
|
ConvFormat := ifA8R8G8B8
|
||||||
|
else if Info.UsePixelFormat then
|
||||||
|
// Convert 16bit RGB images (no alpha) to X1R5G5B5
|
||||||
|
ConvFormat := ifX1R5G5B5
|
||||||
|
else
|
||||||
|
// Convert all other formats to R8G8B8
|
||||||
|
ConvFormat := ifR8G8B8;
|
||||||
|
|
||||||
|
ConvertImage(Image, ConvFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBitmapFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
|
||||||
|
var
|
||||||
|
Hdr: TBitmapFileHeader;
|
||||||
|
ReadCount: LongInt;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if Handle <> nil then
|
||||||
|
with GetIO do
|
||||||
|
begin
|
||||||
|
ReadCount := Read(Handle, @Hdr, SizeOf(Hdr));
|
||||||
|
Seek(Handle, -ReadCount, smFromCurrent);
|
||||||
|
Result := (Hdr.ID = BMMagic) and (ReadCount = SizeOf(Hdr));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterImageFileFormat(TBitmapFileFormat);
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
- Add option to choose to save V3 or V4 headers.
|
||||||
|
|
||||||
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Now saves bitmaps as bottom-up for better compatibility
|
||||||
|
(mainly Lazarus' TImage!).
|
||||||
|
- Fixed crash when loading bitmaps with headers larger than V4.
|
||||||
|
- Temp hacks to disable V4 headers for 32bit images (compatibility with
|
||||||
|
other soft).
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Removed temporary data allocation for image with aligned scanlines.
|
||||||
|
They are now directly written to output so memory requirements are
|
||||||
|
much lower now.
|
||||||
|
- Now uses and recognizes BITMAPINFOHEADERV4 when loading/saving.
|
||||||
|
Mainly for formats with alpha channels.
|
||||||
|
- Added ifR5G6B5 to supported formats, changed converting to supported
|
||||||
|
formats little bit.
|
||||||
|
- Rewritten SaveRLE8 nested procedure. Old code was long and
|
||||||
|
mysterious - new is short and much more readable.
|
||||||
|
- MakeCompatible method moved to base class, put ConvertToSupported here.
|
||||||
|
GetSupportedFormats removed, it is now set in constructor.
|
||||||
|
- Rewritten LoadRLE4 and LoadRLE8 nested procedures.
|
||||||
|
Should be less buggy an more readable (load inspired by Colosseum Builders' code).
|
||||||
|
- Made public properties for options registered to SetOption/GetOption
|
||||||
|
functions.
|
||||||
|
- Addded alpha check to 32b bitmap loading too (teh same as in 16b
|
||||||
|
bitmap loading).
|
||||||
|
- Moved Convert1To8 and Convert4To8 to ImagingFormats
|
||||||
|
- Changed extensions to filename masks.
|
||||||
|
- Changed SaveData, LoadData, and MakeCompatible methods according
|
||||||
|
to changes in base class in Imaging unit.
|
||||||
|
|
||||||
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
||||||
|
- fixed wrong const that caused A4R4G4B4 BMPs to load as A1R5G5B5
|
||||||
|
- fixed the bug that caused 8bit RLE compressed bitmaps to load as
|
||||||
|
whole black
|
||||||
|
|
||||||
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
||||||
|
- 16 bit images are usually without alpha but some has alpha
|
||||||
|
channel and there is no indication of it - so I have added
|
||||||
|
a check: if all pixels of image are with alpha = 0 image is treated
|
||||||
|
as X1R5G5B5 otherwise as A1R5G5B5
|
||||||
|
|
||||||
|
-- 0.13 Changes/Bug Fixes -----------------------------------
|
||||||
|
- when loading 1/4 bit images with dword aligned dimensions
|
||||||
|
there was ugly memory rewritting bug causing image corruption
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,984 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingClasses.pas 94 2007-06-21 19:29:49Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains class based wrapper to Imaging library.}
|
||||||
|
unit ImagingClasses;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Types, Classes, ImagingTypes, Imaging, ImagingFormats, ImagingUtility;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Base abstract high level class wrapper to low level Imaging structures and
|
||||||
|
functions.}
|
||||||
|
TBaseImage = class(TPersistent)
|
||||||
|
protected
|
||||||
|
FPData: PImageData;
|
||||||
|
FOnDataSizeChanged: TNotifyEvent;
|
||||||
|
FOnPixelsChanged: TNotifyEvent;
|
||||||
|
function GetFormat: TImageFormat; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetHeight: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetSize: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetWidth: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetBits: Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetPalette: PPalette32; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetPaletteEntries: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetScanLine(Index: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetPixelPointer(X, Y: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetFormatInfo: TImageFormatInfo; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetBoundsRect: TRect;
|
||||||
|
procedure SetFormat(const Value: TImageFormat); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
procedure SetHeight(const Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
procedure SetWidth(const Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
procedure SetPointer; virtual; abstract;
|
||||||
|
procedure DoDataSizeChanged; virtual;
|
||||||
|
procedure DoPixelsChanged; virtual;
|
||||||
|
published
|
||||||
|
public
|
||||||
|
constructor Create; virtual;
|
||||||
|
constructor CreateFromImage(AImage: TBaseImage);
|
||||||
|
destructor Destroy; override;
|
||||||
|
{ Returns info about current image.}
|
||||||
|
function ToString: string;
|
||||||
|
|
||||||
|
{ Creates a new image data with the given size and format. Old image
|
||||||
|
data is lost. Works only for the current image of TMultiImage.}
|
||||||
|
procedure RecreateImageData(AWidth, AHeight: LongInt; AFormat: TImageFormat);
|
||||||
|
{ Resizes current image with optional resampling.}
|
||||||
|
procedure Resize(NewWidth, NewHeight: LongInt; Filter: TResizeFilter);
|
||||||
|
{ Flips current image. Reverses the image along its horizontal axis the top
|
||||||
|
becomes the bottom and vice versa.}
|
||||||
|
procedure Flip;
|
||||||
|
{ Mirrors current image. Reverses the image along its vertical axis the left
|
||||||
|
side becomes the right and vice versa.}
|
||||||
|
procedure Mirror;
|
||||||
|
{ Rotates image by 90, 180, 270, -90, -180, or -270 degrees counterclockwise.}
|
||||||
|
procedure Rotate(Angle: LongInt);
|
||||||
|
{ Copies rectangular part of SrcImage to DstImage. No blending is performed -
|
||||||
|
alpha is simply copied to destination image. Operates also with
|
||||||
|
negative X and Y coordinates.
|
||||||
|
Note that copying is fastest for images in the same data format
|
||||||
|
(and slowest for images in special formats).}
|
||||||
|
procedure CopyTo(SrcX, SrcY, Width, Height: LongInt; DstImage: TBaseImage; DstX, DstY: LongInt);
|
||||||
|
{ Stretches the contents of the source rectangle to the destination rectangle
|
||||||
|
with optional resampling. No blending is performed - alpha is
|
||||||
|
simply copied/resampled to destination image. Note that stretching is
|
||||||
|
fastest for images in the same data format (and slowest for
|
||||||
|
images in special formats).}
|
||||||
|
procedure StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: LongInt; DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter);
|
||||||
|
{ Replaces pixels with OldPixel in the given rectangle by NewPixel.
|
||||||
|
OldPixel and NewPixel should point to the pixels in the same format
|
||||||
|
as the given image is in.}
|
||||||
|
procedure ReplaceColor(X, Y, Width, Height: LongInt; OldColor, NewColor: Pointer);
|
||||||
|
{ Swaps SrcChannel and DstChannel color or alpha channels of image.
|
||||||
|
Use ChannelRed, ChannelBlue, ChannelGreen, ChannelAlpha constants to
|
||||||
|
identify channels.}
|
||||||
|
procedure SwapChannels(SrcChannel, DstChannel: LongInt);
|
||||||
|
|
||||||
|
{ Loads current image data from file.}
|
||||||
|
procedure LoadFromFile(const FileName: string); virtual;
|
||||||
|
{ Loads current image data from stream.}
|
||||||
|
procedure LoadFromStream(Stream: TStream); virtual;
|
||||||
|
|
||||||
|
{ Saves current image data to file.}
|
||||||
|
procedure SaveToFile(const FileName: string);
|
||||||
|
{ Saves current image data to stream. Ext identifies desired image file
|
||||||
|
format (jpg, png, dds, ...)}
|
||||||
|
procedure SaveToStream(const Ext: string; Stream: TStream);
|
||||||
|
|
||||||
|
{ Width of current image in pixels.}
|
||||||
|
property Width: LongInt read GetWidth write SetWidth;
|
||||||
|
{ Height of current image in pixels.}
|
||||||
|
property Height: LongInt read GetHeight write SetHeight;
|
||||||
|
{ Image data format of current image.}
|
||||||
|
property Format: TImageFormat read GetFormat write SetFormat;
|
||||||
|
{ Size in bytes of current image's data.}
|
||||||
|
property Size: LongInt read GetSize;
|
||||||
|
{ Pointer to memory containing image bits.}
|
||||||
|
property Bits: Pointer read GetBits;
|
||||||
|
{ Pointer to palette for indexed format images. It is nil for others.
|
||||||
|
Max palette entry is at index [PaletteEntries - 1].}
|
||||||
|
property Palette: PPalette32 read GetPalette;
|
||||||
|
{ Number of entries in image's palette}
|
||||||
|
property PaletteEntries: LongInt read GetPaletteEntries;
|
||||||
|
{ Provides indexed access to each line of pixels. Does not work with special
|
||||||
|
format images (like DXT).}
|
||||||
|
property ScanLine[Index: LongInt]: Pointer read GetScanLine;
|
||||||
|
{ Returns pointer to image pixel at [X, Y] coordinates.}
|
||||||
|
property PixelPointers[X, Y: LongInt]: Pointer read GetPixelPointer;
|
||||||
|
{ Extended image format information.}
|
||||||
|
property FormatInfo: TImageFormatInfo read GetFormatInfo;
|
||||||
|
{ This gives complete access to underlying TImageData record.
|
||||||
|
It can be used in functions that take TImageData as parameter
|
||||||
|
(for example: ReduceColors(SingleImageInstance.ImageData^, 64)).}
|
||||||
|
property ImageDataPointer: PImageData read FPData;
|
||||||
|
{ Indicates whether the current image is valid (proper format,
|
||||||
|
allowed dimensions, right size, ...).}
|
||||||
|
property Valid: Boolean read GetValid;
|
||||||
|
{{ Specifies the bounding rectangle of the image.}
|
||||||
|
property BoundsRect: TRect read GetBoundsRect;
|
||||||
|
{ This event occurs when the image data size has just changed. That means
|
||||||
|
image width, height, or format has been changed.}
|
||||||
|
property OnDataSizeChanged: TNotifyEvent read FOnDataSizeChanged write FOnDataSizeChanged;
|
||||||
|
{ This event occurs when some pixels of the image have just changed.}
|
||||||
|
property OnPixelsChanged: TNotifyEvent read FOnPixelsChanged write FOnPixelsChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Extension of TBaseImage which uses single TImageData record to
|
||||||
|
store image. All methods inherited from TBaseImage work with this record.}
|
||||||
|
TSingleImage = class(TBaseImage)
|
||||||
|
protected
|
||||||
|
FImageData: TImageData;
|
||||||
|
procedure SetPointer; override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
constructor CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault);
|
||||||
|
constructor CreateFromData(const AData: TImageData);
|
||||||
|
constructor CreateFromFile(const FileName: string);
|
||||||
|
constructor CreateFromStream(Stream: TStream);
|
||||||
|
destructor Destroy; override;
|
||||||
|
{ Assigns single image from another single image or multi image.}
|
||||||
|
procedure Assign(Source: TPersistent); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Extension of TBaseImage which uses array of TImageData records to
|
||||||
|
store multiple images. Images are independent on each other and they don't
|
||||||
|
share any common characteristic. Each can have different size, format, and
|
||||||
|
palette. All methods inherited from TBaseImage work only with
|
||||||
|
active image (it could represent mipmap level, animation frame, or whatever).
|
||||||
|
Methods whose names contain word 'Multi' work with all images in array
|
||||||
|
(as well as other methods with obvious names).}
|
||||||
|
TMultiImage = class(TBaseImage)
|
||||||
|
protected
|
||||||
|
FDataArray: TDynImageDataArray;
|
||||||
|
FActiveImage: LongInt;
|
||||||
|
procedure SetActiveImage(Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetImageCount: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
procedure SetImageCount(Value: LongInt);
|
||||||
|
function GetAllImagesValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
function GetImage(Index: LongInt): TImageData; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
procedure SetImage(Index: LongInt; Value: TImageData); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
procedure SetPointer; override;
|
||||||
|
function PrepareInsert(Index, Count: LongInt): Boolean;
|
||||||
|
procedure DoInsertImages(Index: LongInt; const Images: TDynImageDataArray);
|
||||||
|
procedure DoInsertNew(Index: LongInt; AWidth, AHeight: LongInt; AFormat: TImageFormat);
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
constructor CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat; Images: LongInt);
|
||||||
|
constructor CreateFromArray(ADataArray: TDynImageDataArray);
|
||||||
|
constructor CreateFromFile(const FileName: string);
|
||||||
|
constructor CreateFromStream(Stream: TStream);
|
||||||
|
destructor Destroy; override;
|
||||||
|
{ Assigns multi image from another multi image or single image.}
|
||||||
|
procedure Assign(Source: TPersistent); override;
|
||||||
|
|
||||||
|
{ Adds new image at the end of the image array. }
|
||||||
|
procedure AddImage(AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); overload;
|
||||||
|
{ Adds existing image at the end of the image array. }
|
||||||
|
procedure AddImage(const Image: TImageData); overload;
|
||||||
|
{ Adds existing image (Active image of a TmultiImage)
|
||||||
|
at the end of the image array. }
|
||||||
|
procedure AddImage(Image: TBaseImage); overload;
|
||||||
|
{ Adds existing image array ((all images of a multi image))
|
||||||
|
at the end of the image array. }
|
||||||
|
procedure AddImages(const Images: TDynImageDataArray); overload;
|
||||||
|
{ Adds existing MultiImage images at the end of the image array. }
|
||||||
|
procedure AddImages(Images: TMultiImage); overload;
|
||||||
|
|
||||||
|
{ Inserts new image image at the given position in the image array. }
|
||||||
|
procedure InsertImage(Index, AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); overload;
|
||||||
|
{ Inserts existing image at the given position in the image array. }
|
||||||
|
procedure InsertImage(Index: LongInt; const Image: TImageData); overload;
|
||||||
|
{ Inserts existing image (Active image of a TmultiImage)
|
||||||
|
at the given position in the image array. }
|
||||||
|
procedure InsertImage(Index: LongInt; Image: TBaseImage); overload;
|
||||||
|
{ Inserts existing image at the given position in the image array. }
|
||||||
|
procedure InsertImages(Index: LongInt; const Images: TDynImageDataArray); overload;
|
||||||
|
{ Inserts existing images (all images of a TmultiImage) at
|
||||||
|
the given position in the image array. }
|
||||||
|
procedure InsertImages(Index: LongInt; Images: TMultiImage); overload;
|
||||||
|
|
||||||
|
{ Exchanges two images at the given positions in the image array. }
|
||||||
|
procedure ExchangeImages(Index1, Index2: LongInt);
|
||||||
|
{ Deletes image at the given position in the image array.}
|
||||||
|
procedure DeleteImage(Index: LongInt);
|
||||||
|
|
||||||
|
{ Converts all images to another image data format.}
|
||||||
|
procedure ConvertImages(Format: TImageFormat);
|
||||||
|
{ Resizes all images.}
|
||||||
|
procedure ResizeImages(NewWidth, NewHeight: LongInt; Filter: TResizeFilter);
|
||||||
|
|
||||||
|
{ Overloaded loading method that will add new image to multiimage if
|
||||||
|
image array is empty bero loading. }
|
||||||
|
procedure LoadFromFile(const FileName: string); override;
|
||||||
|
{ Overloaded loading method that will add new image to multiimage if
|
||||||
|
image array is empty bero loading. }
|
||||||
|
procedure LoadFromStream(Stream: TStream); override;
|
||||||
|
|
||||||
|
{ Loads whole multi image from file.}
|
||||||
|
procedure LoadMultiFromFile(const FileName: string);
|
||||||
|
{ Loads whole multi image from stream.}
|
||||||
|
procedure LoadMultiFromStream(Stream: TStream);
|
||||||
|
{ Saves whole multi image to file.}
|
||||||
|
procedure SaveMultiToFile(const FileName: string);
|
||||||
|
{ Saves whole multi image to stream. Ext identifies desired
|
||||||
|
image file format (jpg, png, dds, ...).}
|
||||||
|
procedure SaveMultiToStream(const Ext: string; Stream: TStream);
|
||||||
|
|
||||||
|
{ Indicates active image of this multi image. All methods inherited
|
||||||
|
from TBaseImage operate on this image only.}
|
||||||
|
property ActiveImage: LongInt read FActiveImage write SetActiveImage;
|
||||||
|
{ Number of images of this multi image.}
|
||||||
|
property ImageCount: LongInt read GetImageCount write SetImageCount;
|
||||||
|
{ This value is True if all images of this TMultiImage are valid.}
|
||||||
|
property AllImagesValid: Boolean read GetAllImagesValid;
|
||||||
|
{ This gives complete access to underlying TDynImageDataArray.
|
||||||
|
It can be used in functions that take TDynImageDataArray
|
||||||
|
as parameter.}
|
||||||
|
property DataArray: TDynImageDataArray read FDataArray;
|
||||||
|
{ Array property for accessing individual images of TMultiImage. When you
|
||||||
|
set image at given index the old image is freed and the source is cloned.}
|
||||||
|
property Images[Index: LongInt]: TImageData read GetImage write SetImage; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
DefaultWidth = 16;
|
||||||
|
DefaultHeight = 16;
|
||||||
|
DefaultImages = 1;
|
||||||
|
|
||||||
|
function GetArrayFromImageData(const ImageData: TImageData): TDynImageDataArray;
|
||||||
|
begin
|
||||||
|
SetLength(Result, 1);
|
||||||
|
Result[0] := ImageData;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TBaseImage class implementation }
|
||||||
|
|
||||||
|
constructor TBaseImage.Create;
|
||||||
|
begin
|
||||||
|
SetPointer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TBaseImage.CreateFromImage(AImage: TBaseImage);
|
||||||
|
begin
|
||||||
|
Create;
|
||||||
|
Assign(AImage);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TBaseImage.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetWidth: LongInt;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Result := FPData.Width
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetHeight: LongInt;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Result := FPData.Height
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetFormat: TImageFormat;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Result := FPData.Format
|
||||||
|
else
|
||||||
|
Result := ifUnknown;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetScanLine(Index: LongInt): Pointer;
|
||||||
|
var
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
begin
|
||||||
|
Info := GetFormatInfo;
|
||||||
|
if not Info.IsSpecial then
|
||||||
|
Result := ImagingFormats.GetScanLine(FPData.Bits, Info, FPData.Width, Index)
|
||||||
|
else
|
||||||
|
Result := FPData.Bits;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetPixelPointer(X, Y: LongInt): Pointer;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Result := @PByteArray(FPData.Bits)[(Y * FPData.Width + X) * GetFormatInfo.BytesPerPixel]
|
||||||
|
else
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetSize: LongInt;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Result := FPData.Size
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetBits: Pointer;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Result := FPData.Bits
|
||||||
|
else
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetPalette: PPalette32;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Result := FPData.Palette
|
||||||
|
else
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetPaletteEntries: LongInt;
|
||||||
|
begin
|
||||||
|
Result := GetFormatInfo.PaletteEntries;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetFormatInfo: TImageFormatInfo;
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Imaging.GetImageFormatInfo(FPData.Format, Result)
|
||||||
|
else
|
||||||
|
FillChar(Result, SizeOf(Result), 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetValid: Boolean;
|
||||||
|
begin
|
||||||
|
Result := Assigned(FPData) and Imaging.TestImage(FPData^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.GetBoundsRect: TRect;
|
||||||
|
begin
|
||||||
|
Result := Rect(0, 0, GetWidth, GetHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.SetWidth(const Value: LongInt);
|
||||||
|
begin
|
||||||
|
Resize(Value, GetHeight, rfNearest);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.SetHeight(const Value: LongInt);
|
||||||
|
begin
|
||||||
|
Resize(GetWidth, Value, rfNearest);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.SetFormat(const Value: TImageFormat);
|
||||||
|
begin
|
||||||
|
if Valid and Imaging.ConvertImage(FPData^, Value) then
|
||||||
|
DoDataSizeChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.DoDataSizeChanged;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnDataSizeChanged) then
|
||||||
|
FOnDataSizeChanged(Self);
|
||||||
|
DoPixelsChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.DoPixelsChanged;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnPixelsChanged) then
|
||||||
|
FOnPixelsChanged(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.RecreateImageData(AWidth, AHeight: LongInt; AFormat: TImageFormat);
|
||||||
|
begin
|
||||||
|
if Assigned(FPData) and Imaging.NewImage(AWidth, AHeight, AFormat, FPData^) then
|
||||||
|
DoDataSizeChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.Resize(NewWidth, NewHeight: LongInt; Filter: TResizeFilter);
|
||||||
|
begin
|
||||||
|
if Valid and Imaging.ResizeImage(FPData^, NewWidth, NewHeight, Filter) then
|
||||||
|
DoDataSizeChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.Flip;
|
||||||
|
begin
|
||||||
|
if Valid and Imaging.FlipImage(FPData^) then
|
||||||
|
DoPixelsChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.Mirror;
|
||||||
|
begin
|
||||||
|
if Valid and Imaging.MirrorImage(FPData^) then
|
||||||
|
DoPixelsChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.Rotate(Angle: LongInt);
|
||||||
|
begin
|
||||||
|
if Valid and Imaging.RotateImage(FPData^, Angle) then
|
||||||
|
DoPixelsChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.CopyTo(SrcX, SrcY, Width, Height: LongInt;
|
||||||
|
DstImage: TBaseImage; DstX, DstY: LongInt);
|
||||||
|
begin
|
||||||
|
if Valid and Assigned(DstImage) and DstImage.Valid then
|
||||||
|
begin
|
||||||
|
Imaging.CopyRect(FPData^, SrcX, SrcY, Width, Height, DstImage.FPData^, DstX, DstY);
|
||||||
|
DstImage.DoPixelsChanged;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: LongInt;
|
||||||
|
DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter);
|
||||||
|
begin
|
||||||
|
if Valid and Assigned(DstImage) and DstImage.Valid then
|
||||||
|
begin
|
||||||
|
Imaging.StretchRect(FPData^, SrcX, SrcY, SrcWidth, SrcHeight,
|
||||||
|
DstImage.FPData^, DstX, DstY, DstWidth, DstHeight, Filter);
|
||||||
|
DstImage.DoPixelsChanged;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.ReplaceColor(X, Y, Width, Height: Integer; OldColor,
|
||||||
|
NewColor: Pointer);
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
begin
|
||||||
|
Imaging.ReplaceColor(FPData^, X, Y, Width, Height, OldColor, NewColor);
|
||||||
|
DoPixelsChanged;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.SwapChannels(SrcChannel, DstChannel: Integer);
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
begin
|
||||||
|
Imaging.SwapChannels(FPData^, SrcChannel, DstChannel);
|
||||||
|
DoPixelsChanged;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBaseImage.ToString: string;
|
||||||
|
begin
|
||||||
|
Result := Iff(Valid, Imaging.ImageToStr(FPData^), 'empty image');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.LoadFromFile(const FileName: string);
|
||||||
|
begin
|
||||||
|
if Assigned(FPData) and Imaging.LoadImageFromFile(FileName, FPData^) then
|
||||||
|
DoDataSizeChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.LoadFromStream(Stream: TStream);
|
||||||
|
begin
|
||||||
|
if Assigned(FPData) and Imaging.LoadImageFromStream(Stream, FPData^) then
|
||||||
|
DoDataSizeChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.SaveToFile(const FileName: string);
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Imaging.SaveImageToFile(FileName, FPData^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBaseImage.SaveToStream(const Ext: string; Stream: TStream);
|
||||||
|
begin
|
||||||
|
if Valid then
|
||||||
|
Imaging.SaveImageToStream(Ext, Stream, FPData^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TSingleImage class implementation }
|
||||||
|
|
||||||
|
constructor TSingleImage.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
RecreateImageData(DefaultWidth, DefaultHeight, ifDefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TSingleImage.CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
RecreateImageData(AWidth, AHeight, AFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TSingleImage.CreateFromData(const AData: TImageData);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
if Imaging.TestImage(AData) then
|
||||||
|
begin
|
||||||
|
Imaging.CloneImage(AData, FImageData);
|
||||||
|
DoDataSizeChanged;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TSingleImage.CreateFromFile(const FileName: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
LoadFromFile(FileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TSingleImage.CreateFromStream(Stream: TStream);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
LoadFromStream(Stream);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TSingleImage.Destroy;
|
||||||
|
begin
|
||||||
|
Imaging.FreeImage(FImageData);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSingleImage.SetPointer;
|
||||||
|
begin
|
||||||
|
FPData := @FImageData;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSingleImage.Assign(Source: TPersistent);
|
||||||
|
begin
|
||||||
|
if Source = nil then
|
||||||
|
begin
|
||||||
|
Create;
|
||||||
|
end
|
||||||
|
else if Source is TSingleImage then
|
||||||
|
begin
|
||||||
|
CreateFromData(TSingleImage(Source).FImageData);
|
||||||
|
end
|
||||||
|
else if Source is TMultiImage then
|
||||||
|
begin
|
||||||
|
if TMultiImage(Source).Valid then
|
||||||
|
CreateFromData(TMultiImage(Source).FPData^)
|
||||||
|
else
|
||||||
|
Assign(nil);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
inherited Assign(Source);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TMultiImage class implementation }
|
||||||
|
|
||||||
|
constructor TMultiImage.Create;
|
||||||
|
begin
|
||||||
|
SetImageCount(DefaultImages);
|
||||||
|
SetActiveImage(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TMultiImage.CreateFromParams(AWidth, AHeight: LongInt;
|
||||||
|
AFormat: TImageFormat; Images: LongInt);
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
begin
|
||||||
|
Imaging.FreeImagesInArray(FDataArray);
|
||||||
|
SetLength(FDataArray, Images);
|
||||||
|
for I := 0 to GetImageCount - 1 do
|
||||||
|
Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[I]);
|
||||||
|
SetActiveImage(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TMultiImage.CreateFromArray(ADataArray: TDynImageDataArray);
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
begin
|
||||||
|
Imaging.FreeImagesInArray(FDataArray);
|
||||||
|
SetLength(FDataArray, Length(ADataArray));
|
||||||
|
for I := 0 to GetImageCount - 1 do
|
||||||
|
begin
|
||||||
|
// Clone only valid images
|
||||||
|
if Imaging.TestImage(ADataArray[I]) then
|
||||||
|
Imaging.CloneImage(ADataArray[I], FDataArray[I])
|
||||||
|
else
|
||||||
|
Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]);
|
||||||
|
end;
|
||||||
|
SetActiveImage(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TMultiImage.CreateFromFile(const FileName: string);
|
||||||
|
begin
|
||||||
|
LoadMultiFromFile(FileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TMultiImage.CreateFromStream(Stream: TStream);
|
||||||
|
begin
|
||||||
|
LoadMultiFromStream(Stream);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TMultiImage.Destroy;
|
||||||
|
begin
|
||||||
|
Imaging.FreeImagesInArray(FDataArray);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.SetActiveImage(Value: LongInt);
|
||||||
|
begin
|
||||||
|
FActiveImage := Value;
|
||||||
|
SetPointer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiImage.GetImageCount: LongInt;
|
||||||
|
begin
|
||||||
|
Result := Length(FDataArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.SetImageCount(Value: LongInt);
|
||||||
|
var
|
||||||
|
I, OldCount: LongInt;
|
||||||
|
begin
|
||||||
|
if Value > GetImageCount then
|
||||||
|
begin
|
||||||
|
// Create new empty images if array will be enlarged
|
||||||
|
OldCount := GetImageCount;
|
||||||
|
SetLength(FDataArray, Value);
|
||||||
|
for I := OldCount to Value - 1 do
|
||||||
|
Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Free images that exceed desired count and shrink array
|
||||||
|
for I := Value to GetImageCount - 1 do
|
||||||
|
Imaging.FreeImage(FDataArray[I]);
|
||||||
|
SetLength(FDataArray, Value);
|
||||||
|
end;
|
||||||
|
SetPointer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiImage.GetAllImagesValid: Boolean;
|
||||||
|
begin
|
||||||
|
Result := (GetImageCount > 0) and TestImagesInArray(FDataArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiImage.GetImage(Index: LongInt): TImageData;
|
||||||
|
begin
|
||||||
|
if (Index >= 0) and (Index < GetImageCount) then
|
||||||
|
Result := FDataArray[Index];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.SetImage(Index: LongInt; Value: TImageData);
|
||||||
|
begin
|
||||||
|
if (Index >= 0) and (Index < GetImageCount) then
|
||||||
|
Imaging.CloneImage(Value, FDataArray[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.SetPointer;
|
||||||
|
begin
|
||||||
|
if GetImageCount > 0 then
|
||||||
|
begin
|
||||||
|
FActiveImage := ClampInt(FActiveImage, 0, GetImageCount - 1);
|
||||||
|
FPData := @FDataArray[FActiveImage];
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FActiveImage := -1;
|
||||||
|
FPData := nil
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMultiImage.PrepareInsert(Index, Count: LongInt): Boolean;
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
begin
|
||||||
|
// Inserting to empty image will add image at index 0
|
||||||
|
if GetImageCount = 0 then
|
||||||
|
Index := 0;
|
||||||
|
|
||||||
|
if (Index >= 0) and (Index <= GetImageCount) and (Count > 0) then
|
||||||
|
begin
|
||||||
|
SetLength(FDataArray, GetImageCount + Count);
|
||||||
|
if Index < GetImageCount - 1 then
|
||||||
|
begin
|
||||||
|
// Move imges to new position
|
||||||
|
System.Move(FDataArray[Index], FDataArray[Index + Count],
|
||||||
|
(GetImageCount - Count - Index) * SizeOf(TImageData));
|
||||||
|
// Null old images, not free them!
|
||||||
|
for I := Index to Index + Count - 1 do
|
||||||
|
InitImage(FDataArray[I]);
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.DoInsertImages(Index: LongInt; const Images: TDynImageDataArray);
|
||||||
|
var
|
||||||
|
I, Len: LongInt;
|
||||||
|
begin
|
||||||
|
Len := Length(Images);
|
||||||
|
if PrepareInsert(Index, Len) then
|
||||||
|
begin
|
||||||
|
for I := 0 to Len - 1 do
|
||||||
|
Imaging.CloneImage(Images[I], FDataArray[Index + I]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.DoInsertNew(Index, AWidth, AHeight: LongInt;
|
||||||
|
AFormat: TImageFormat);
|
||||||
|
begin
|
||||||
|
if PrepareInsert(Index, 1) then
|
||||||
|
Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.Assign(Source: TPersistent);
|
||||||
|
var
|
||||||
|
Arr: TDynImageDataArray;
|
||||||
|
begin
|
||||||
|
if Source = nil then
|
||||||
|
begin
|
||||||
|
Create;
|
||||||
|
end
|
||||||
|
else if Source is TMultiImage then
|
||||||
|
begin
|
||||||
|
CreateFromArray(TMultiImage(Source).FDataArray);
|
||||||
|
SetActiveImage(TMultiImage(Source).ActiveImage);
|
||||||
|
end
|
||||||
|
else if Source is TSingleImage then
|
||||||
|
begin
|
||||||
|
SetLength(Arr, 1);
|
||||||
|
Arr[0] := TSingleImage(Source).FImageData;
|
||||||
|
CreateFromArray(Arr);
|
||||||
|
Arr := nil;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
inherited Assign(Source);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.AddImage(AWidth, AHeight: LongInt; AFormat: TImageFormat);
|
||||||
|
begin
|
||||||
|
DoInsertNew(GetImageCount, AWidth, AHeight, AFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.AddImage(const Image: TImageData);
|
||||||
|
begin
|
||||||
|
DoInsertImages(GetImageCount, GetArrayFromImageData(Image));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.AddImage(Image: TBaseImage);
|
||||||
|
begin
|
||||||
|
if Assigned(Image) and Image.Valid then
|
||||||
|
DoInsertImages(GetImageCount, GetArrayFromImageData(Image.FPData^));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.AddImages(const Images: TDynImageDataArray);
|
||||||
|
begin
|
||||||
|
DoInsertImages(GetImageCount, Images);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.AddImages(Images: TMultiImage);
|
||||||
|
begin
|
||||||
|
DoInsertImages(GetImageCount, Images.FDataArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.InsertImage(Index, AWidth, AHeight: LongInt;
|
||||||
|
AFormat: TImageFormat);
|
||||||
|
begin
|
||||||
|
DoInsertNew(Index, AWidth, AHeight, AFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.InsertImage(Index: LongInt; const Image: TImageData);
|
||||||
|
begin
|
||||||
|
DoInsertImages(Index, GetArrayFromImageData(Image));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.InsertImage(Index: LongInt; Image: TBaseImage);
|
||||||
|
begin
|
||||||
|
if Assigned(Image) and Image.Valid then
|
||||||
|
DoInsertImages(Index, GetArrayFromImageData(Image.FPData^));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.InsertImages(Index: LongInt;
|
||||||
|
const Images: TDynImageDataArray);
|
||||||
|
begin
|
||||||
|
DoInsertImages(Index, FDataArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.InsertImages(Index: LongInt; Images: TMultiImage);
|
||||||
|
begin
|
||||||
|
DoInsertImages(Index, Images.FDataArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.ExchangeImages(Index1, Index2: LongInt);
|
||||||
|
var
|
||||||
|
TempData: TImageData;
|
||||||
|
begin
|
||||||
|
if (Index1 >= 0) and (Index1 < GetImageCount) and
|
||||||
|
(Index2 >= 0) and (Index2 < GetImageCount) then
|
||||||
|
begin
|
||||||
|
TempData := FDataArray[Index1];
|
||||||
|
FDataArray[Index1] := FDataArray[Index2];
|
||||||
|
FDataArray[Index2] := TempData;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.DeleteImage(Index: LongInt);
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
begin
|
||||||
|
if (Index >= 0) and (Index < GetImageCount) then
|
||||||
|
begin
|
||||||
|
// Free image at index to be deleted
|
||||||
|
Imaging.FreeImage(FDataArray[Index]);
|
||||||
|
if Index < GetImageCount - 1 then
|
||||||
|
begin
|
||||||
|
// Move images to new indices if necessary
|
||||||
|
for I := Index to GetImageCount - 2 do
|
||||||
|
FDataArray[I] := FDataArray[I + 1];
|
||||||
|
end;
|
||||||
|
// Set new array length and update pointer to active image
|
||||||
|
SetLength(FDataArray, GetImageCount - 1);
|
||||||
|
SetPointer;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.ConvertImages(Format: TImageFormat);
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
begin
|
||||||
|
for I := 0 to GetImageCount - 1 do
|
||||||
|
Imaging.ConvertImage(FDataArray[I], Format);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.ResizeImages(NewWidth, NewHeight: LongInt;
|
||||||
|
Filter: TResizeFilter);
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
begin
|
||||||
|
for I := 0 to GetImageCount do
|
||||||
|
Imaging.ResizeImage(FDataArray[I], NewWidth, NewHeight, Filter);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.LoadFromFile(const FileName: string);
|
||||||
|
begin
|
||||||
|
if GetImageCount = 0 then
|
||||||
|
ImageCount := 1;
|
||||||
|
inherited LoadFromFile(FileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.LoadFromStream(Stream: TStream);
|
||||||
|
begin
|
||||||
|
if GetImageCount = 0 then
|
||||||
|
ImageCount := 1;
|
||||||
|
inherited LoadFromStream(Stream);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.LoadMultiFromFile(const FileName: string);
|
||||||
|
begin
|
||||||
|
Imaging.LoadMultiImageFromFile(FileName, FDataArray);
|
||||||
|
SetActiveImage(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.LoadMultiFromStream(Stream: TStream);
|
||||||
|
begin
|
||||||
|
Imaging.LoadMultiImageFromStream(Stream, FDataArray);
|
||||||
|
SetActiveImage(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.SaveMultiToFile(const FileName: string);
|
||||||
|
begin
|
||||||
|
Imaging.SaveMultiImageToFile(FileName, FDataArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMultiImage.SaveMultiToStream(const Ext: string; Stream: TStream);
|
||||||
|
begin
|
||||||
|
Imaging.SaveMultiImageToStream(Ext, Stream, FDataArray);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
- add SetPalette, create some pal wrapper first
|
||||||
|
- put all low level stuff here like ReplaceColor etc, change
|
||||||
|
CopyTo to Copy, and add overload Copy(SrcRect, DstX, DstY) ...
|
||||||
|
|
||||||
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Added SwapChannels method to TBaseImage.
|
||||||
|
- Added ReplaceColor method to TBaseImage.
|
||||||
|
- Added ToString method to TBaseImage.
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Inserting images to empty MultiImage will act as Add method.
|
||||||
|
- MultiImages with empty arrays will now create one image when
|
||||||
|
LoadFromFile or LoadFromStream is called.
|
||||||
|
- Fixed bug that caused AVs when getting props like Width, Height, asn Size
|
||||||
|
and when inlining was off. There was call to Iff but with inlining disabled
|
||||||
|
params like FPData.Size were evaluated and when FPData was nil => AV.
|
||||||
|
- Added many FPData validity checks to many methods. There were AVs
|
||||||
|
when calling most methods on empty TMultiImage.
|
||||||
|
- Added AllImagesValid property to TMultiImage.
|
||||||
|
- Fixed memory leak in TMultiImage.CreateFromParams.
|
||||||
|
|
||||||
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
||||||
|
- added ResizeImages method to TMultiImage
|
||||||
|
- removed Ext parameter from various LoadFromStream methods, no
|
||||||
|
longer needed
|
||||||
|
- fixed various issues concerning ActiveImage of TMultiImage
|
||||||
|
(it pointed to invalid location after some operations)
|
||||||
|
- most of property set/get methods are now inline
|
||||||
|
- added PixelPointers property to TBaseImage
|
||||||
|
- added Images default array property to TMultiImage
|
||||||
|
- renamed methods in TMultiImage to contain 'Image' instead of 'Level'
|
||||||
|
- added canvas support
|
||||||
|
- added OnDataSizeChanged and OnPixelsChanged event to TBaseImage
|
||||||
|
- renamed TSingleImage.NewImage to RecreateImageData, made public, and
|
||||||
|
moved to TBaseImage
|
||||||
|
|
||||||
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
||||||
|
- added props PaletteEntries and ScanLine to TBaseImage
|
||||||
|
- aded new constructor to TBaseImage that take TBaseImage source
|
||||||
|
- TMultiImage levels adding and inserting rewritten internally
|
||||||
|
- added some new functions to TMultiImage: AddLevels, InsertLevels
|
||||||
|
- added some new functions to TBaseImage: Flip, Mirror, Rotate,
|
||||||
|
CopyRect, StretchRect
|
||||||
|
- TBasicImage.Resize has now filter parameter
|
||||||
|
- new stuff added to TMultiImage (DataArray prop, ConvertLevels)
|
||||||
|
|
||||||
|
-- 0.13 Changes/Bug Fixes -----------------------------------
|
||||||
|
- added AddLevel, InsertLevel, ExchangeLevels and DeleteLevel
|
||||||
|
methods to TMultiImage
|
||||||
|
- added TBaseImage, TSingleImage and TMultiImage with initial
|
||||||
|
members
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,204 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingColors.pas 74 2007-03-12 15:04:04Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains functions for manipulating and converting color values.}
|
||||||
|
unit ImagingColors;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, ImagingTypes, ImagingUtility;
|
||||||
|
|
||||||
|
{ Converts RGB color to YUV.}
|
||||||
|
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
|
||||||
|
{ Converts YIV to RGB color.}
|
||||||
|
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
|
||||||
|
|
||||||
|
{ Converts RGB color to YCbCr as used in JPEG.}
|
||||||
|
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
|
||||||
|
{ Converts YCbCr as used in JPEG to RGB color.}
|
||||||
|
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
|
||||||
|
{ Converts RGB color to YCbCr as used in JPEG.}
|
||||||
|
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
|
||||||
|
{ Converts YCbCr as used in JPEG to RGB color.}
|
||||||
|
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
|
||||||
|
|
||||||
|
{ Converts RGB color to CMY.}
|
||||||
|
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
|
||||||
|
{ Converts CMY to RGB color.}
|
||||||
|
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
|
||||||
|
{ Converts RGB color to CMY.}
|
||||||
|
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
|
||||||
|
{ Converts CMY to RGB color.}
|
||||||
|
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
|
||||||
|
|
||||||
|
{ Converts RGB color to CMYK.}
|
||||||
|
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
|
||||||
|
{ Converts CMYK to RGB color.}
|
||||||
|
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
|
||||||
|
{ Converts RGB color to CMYK.}
|
||||||
|
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
|
||||||
|
{ Converts CMYK to RGB color.}
|
||||||
|
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
|
||||||
|
begin
|
||||||
|
Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
|
||||||
|
V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128);
|
||||||
|
U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
|
||||||
|
var
|
||||||
|
CY, CU, CV: LongInt;
|
||||||
|
begin
|
||||||
|
CY := Y - 16;
|
||||||
|
CU := U - 128;
|
||||||
|
CV := V - 128;
|
||||||
|
R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
|
||||||
|
G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
|
||||||
|
B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
|
||||||
|
begin
|
||||||
|
Y := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
|
||||||
|
Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 128));
|
||||||
|
Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 128));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
|
||||||
|
begin
|
||||||
|
R := ClampToByte(Round(Y + 1.40200 * (Cr - 128)));
|
||||||
|
G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
|
||||||
|
B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
|
||||||
|
begin
|
||||||
|
Y := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
|
||||||
|
Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 32768));
|
||||||
|
Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 32768));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
|
||||||
|
begin
|
||||||
|
R := ClampToWord(Round(Y + 1.40200 * (Cr - 32768)));
|
||||||
|
G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
|
||||||
|
B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
|
||||||
|
begin
|
||||||
|
C := 255 - R;
|
||||||
|
M := 255 - G;
|
||||||
|
Y := 255 - B;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
|
||||||
|
begin
|
||||||
|
R := 255 - C;
|
||||||
|
G := 255 - M;
|
||||||
|
B := 255 - Y;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
|
||||||
|
begin
|
||||||
|
C := 65535 - R;
|
||||||
|
M := 65535 - G;
|
||||||
|
Y := 65535 - B;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
|
||||||
|
begin
|
||||||
|
R := 65535 - C;
|
||||||
|
G := 65535 - M;
|
||||||
|
B := 65535 - Y;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
|
||||||
|
begin
|
||||||
|
RGBToCMY(R, G, B, C, M, Y);
|
||||||
|
K := Min(C, Min(M, Y));
|
||||||
|
if K > 0 then
|
||||||
|
begin
|
||||||
|
C := C - K;
|
||||||
|
M := M - K;
|
||||||
|
Y := Y - K;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
|
||||||
|
begin
|
||||||
|
R := (255 - (C - MulDiv(C, K, 255) + K));
|
||||||
|
G := (255 - (M - MulDiv(M, K, 255) + K));
|
||||||
|
B := (255 - (Y - MulDiv(Y, K, 255) + K));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
|
||||||
|
begin
|
||||||
|
RGBToCMY16(R, G, B, C, M, Y);
|
||||||
|
K := Min(C, Min(M, Y));
|
||||||
|
if K > 0 then
|
||||||
|
begin
|
||||||
|
C := C - K;
|
||||||
|
M := M - K;
|
||||||
|
Y := Y - K;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
|
||||||
|
begin
|
||||||
|
R := 65535 - (C - MulDiv(C, K, 65535) + K);
|
||||||
|
G := 65535 - (M - MulDiv(M, K, 65535) + K);
|
||||||
|
B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
|
||||||
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Added RGB<>CMY(K) converion functions for 16 bit channels
|
||||||
|
(needed by PSD loading code).
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Added some color space conversion functions and LUTs
|
||||||
|
(RGB/YUV/YCrCb/CMY/CMYK).
|
||||||
|
|
||||||
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
||||||
|
- unit created (empty!)
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,853 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingDds.pas 100 2007-06-28 21:09:52Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains image format loader/saver for DirectDraw Surface images.}
|
||||||
|
unit ImagingDds;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
ImagingTypes, Imaging, ImagingUtility, ImagingFormats;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Class for loading and saving Microsoft DirectDraw surfaces.
|
||||||
|
It can load/save all D3D formats which have coresponding
|
||||||
|
TImageFormat. It supports plain textures, cube textures and
|
||||||
|
volume textures, all of these can have mipmaps. It can also
|
||||||
|
load some formats which have no exact TImageFormat, but can be easily
|
||||||
|
converted to one (bump map formats).
|
||||||
|
You can get some information about last loaded DDS file by calling
|
||||||
|
GetOption with ImagingDDSLoadedXXX options and you can set some
|
||||||
|
saving options by calling SetOption with ImagingDDSSaveXXX or you can
|
||||||
|
simply use properties of this class.
|
||||||
|
Note that when saving cube maps and volumes input image array must contain
|
||||||
|
at least number of images to build cube/volume based on current
|
||||||
|
Depth and MipMapCount settings.}
|
||||||
|
TDDSFileFormat = class(TImageFileFormat)
|
||||||
|
protected
|
||||||
|
FLoadedCubeMap: LongBool;
|
||||||
|
FLoadedVolume: LongBool;
|
||||||
|
FLoadedMipMapCount: LongInt;
|
||||||
|
FLoadedDepth: LongInt;
|
||||||
|
FSaveCubeMap: LongBool;
|
||||||
|
FSaveVolume: LongBool;
|
||||||
|
FSaveMipMapCount: LongInt;
|
||||||
|
FSaveDepth: LongInt;
|
||||||
|
procedure ComputeSubDimensions(Idx, Width, Height, MipMaps, Depth: LongInt;
|
||||||
|
IsCubeMap, IsVolume: Boolean; var CurWidth, CurHeight: LongInt);
|
||||||
|
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
|
||||||
|
OnlyFirstLevel: Boolean): Boolean; override;
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
function TestFormat(Handle: TImagingHandle): Boolean; override;
|
||||||
|
procedure CheckOptionsValidity; override;
|
||||||
|
published
|
||||||
|
{ True if last loaded DDS file was cube map.}
|
||||||
|
property LoadedCubeMap: LongBool read FLoadedCubeMap write FLoadedCubeMap;
|
||||||
|
{ True if last loaded DDS file was volume texture.}
|
||||||
|
property LoadedVolume: LongBool read FLoadedVolume write FLoadedVolume;
|
||||||
|
{ Number of mipmap levels of last loaded DDS image.}
|
||||||
|
property LoadedMipMapCount: LongInt read FLoadedMipMapCount write FLoadedMipMapCount;
|
||||||
|
{ Depth (slices of volume texture or faces of cube map) of last loaded DDS image.}
|
||||||
|
property LoadedDepth: LongInt read FLoadedDepth write FLoadedDepth;
|
||||||
|
{ True if next DDS file to be saved should be stored as cube map.}
|
||||||
|
property SaveCubeMap: LongBool read FSaveCubeMap write FSaveCubeMap;
|
||||||
|
{ True if next DDS file to be saved should be stored as volume texture.}
|
||||||
|
property SaveVolume: LongBool read FSaveVolume write FSaveVolume;
|
||||||
|
{ Sets the number of mipmaps which should be stored in the next saved DDS file.
|
||||||
|
Only applies to cube maps and volumes, ordinary 2D textures save all
|
||||||
|
levels present in input.}
|
||||||
|
property SaveMipMapCount: LongInt read FSaveMipMapCount write FSaveMipMapCount;
|
||||||
|
{ Sets the depth (slices of volume texture or faces of cube map)
|
||||||
|
of the next saved DDS file.}
|
||||||
|
property SaveDepth: LongInt read FSaveDepth write FSaveDepth;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
SDDSFormatName = 'DirectDraw Surface';
|
||||||
|
SDDSMasks = '*.dds';
|
||||||
|
DDSSupportedFormats: TImageFormats = [ifR8G8B8, ifA8R8G8B8, ifX8R8G8B8,
|
||||||
|
ifA1R5G5B5, ifA4R4G4B4, ifX1R5G5B5, ifX4R4G4B4, ifR5G6B5, ifA16B16G16R16,
|
||||||
|
ifR32F, ifA32B32G32R32F, ifR16F, ifA16B16G16R16F, ifR3G3B2, ifGray8, ifA8Gray8,
|
||||||
|
ifGray16, ifDXT1, ifDXT3, ifDXT5];
|
||||||
|
|
||||||
|
const
|
||||||
|
{ Four character codes.}
|
||||||
|
DDSMagic = LongWord(Byte('D') or (Byte('D') shl 8) or (Byte('S') shl 16) or
|
||||||
|
(Byte(' ') shl 24));
|
||||||
|
FOURCC_DXT1 = LongWord(Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or
|
||||||
|
(Byte('1') shl 24));
|
||||||
|
FOURCC_DXT3 = LongWord(Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or
|
||||||
|
(Byte('3') shl 24));
|
||||||
|
FOURCC_DXT5 = LongWord(Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or
|
||||||
|
(Byte('5') shl 24));
|
||||||
|
|
||||||
|
{ Some D3DFORMAT values used in DDS files as FourCC value.}
|
||||||
|
D3DFMT_A16B16G16R16 = 36;
|
||||||
|
D3DFMT_R32F = 114;
|
||||||
|
D3DFMT_A32B32G32R32F = 116;
|
||||||
|
D3DFMT_R16F = 111;
|
||||||
|
D3DFMT_A16B16G16R16F = 113;
|
||||||
|
|
||||||
|
{ Constans used by TDDSurfaceDesc2.Flags.}
|
||||||
|
DDSD_CAPS = $00000001;
|
||||||
|
DDSD_HEIGHT = $00000002;
|
||||||
|
DDSD_WIDTH = $00000004;
|
||||||
|
DDSD_PITCH = $00000008;
|
||||||
|
DDSD_PIXELFORMAT = $00001000;
|
||||||
|
DDSD_MIPMAPCOUNT = $00020000;
|
||||||
|
DDSD_LINEARSIZE = $00080000;
|
||||||
|
DDSD_DEPTH = $00800000;
|
||||||
|
|
||||||
|
{ Constans used by TDDSPixelFormat.Flags.}
|
||||||
|
DDPF_ALPHAPIXELS = $00000001; // used by formats which contain alpha
|
||||||
|
DDPF_FOURCC = $00000004; // used by DXT and large ARGB formats
|
||||||
|
DDPF_RGB = $00000040; // used by RGB formats
|
||||||
|
DDPF_LUMINANCE = $00020000; // used by formats like D3DFMT_L16
|
||||||
|
DDPF_BUMPLUMINANCE = $00040000; // used by mixed signed-unsigned formats
|
||||||
|
DDPF_BUMPDUDV = $00080000; // used by signed formats
|
||||||
|
|
||||||
|
{ Constans used by TDDSCaps.Caps1.}
|
||||||
|
DDSCAPS_COMPLEX = $00000008;
|
||||||
|
DDSCAPS_TEXTURE = $00001000;
|
||||||
|
DDSCAPS_MIPMAP = $00400000;
|
||||||
|
|
||||||
|
{ Constans used by TDDSCaps.Caps2.}
|
||||||
|
DDSCAPS2_CUBEMAP = $00000200;
|
||||||
|
DDSCAPS2_POSITIVEX = $00000400;
|
||||||
|
DDSCAPS2_NEGATIVEX = $00000800;
|
||||||
|
DDSCAPS2_POSITIVEY = $00001000;
|
||||||
|
DDSCAPS2_NEGATIVEY = $00002000;
|
||||||
|
DDSCAPS2_POSITIVEZ = $00004000;
|
||||||
|
DDSCAPS2_NEGATIVEZ = $00008000;
|
||||||
|
DDSCAPS2_VOLUME = $00200000;
|
||||||
|
|
||||||
|
{ Flags for TDDSurfaceDesc2.Flags used when saving DDS file.}
|
||||||
|
DDS_SAVE_FLAGS = DDSD_CAPS or DDSD_PIXELFORMAT or DDSD_WIDTH or
|
||||||
|
DDSD_HEIGHT or DDSD_LINEARSIZE;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Stores the pixel format information.}
|
||||||
|
TDDPixelFormat = packed record
|
||||||
|
Size: LongWord; // Size of the structure = 32 bytes
|
||||||
|
Flags: LongWord; // Flags to indicate valid fields
|
||||||
|
FourCC: LongWord; // Four-char code for compressed textures (DXT)
|
||||||
|
BitCount: LongWord; // Bits per pixel if uncomp. usually 16,24 or 32
|
||||||
|
RedMask: LongWord; // Bit mask for the Red component
|
||||||
|
GreenMask: LongWord; // Bit mask for the Green component
|
||||||
|
BlueMask: LongWord; // Bit mask for the Blue component
|
||||||
|
AlphaMask: LongWord; // Bit mask for the Alpha component
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Specifies capabilities of surface.}
|
||||||
|
TDDSCaps = packed record
|
||||||
|
Caps1: LongWord; // Should always include DDSCAPS_TEXTURE
|
||||||
|
Caps2: LongWord; // For cubic environment maps
|
||||||
|
Reserved: array[0..1] of LongWord; // Reserved
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Record describing DDS file contents.}
|
||||||
|
TDDSurfaceDesc2 = packed record
|
||||||
|
Size: LongWord; // Size of the structure = 124 Bytes
|
||||||
|
Flags: LongWord; // Flags to indicate valid fields
|
||||||
|
Height: LongWord; // Height of the main image in pixels
|
||||||
|
Width: LongWord; // Width of the main image in pixels
|
||||||
|
PitchOrLinearSize: LongWord; // For uncomp formats number of bytes per
|
||||||
|
// scanline. For comp it is the size in
|
||||||
|
// bytes of the main image
|
||||||
|
Depth: LongWord; // Only for volume text depth of the volume
|
||||||
|
MipMaps: LongInt; // Total number of levels in the mipmap chain
|
||||||
|
Reserved1: array[0..10] of LongWord; // Reserved
|
||||||
|
PixelFormat: TDDPixelFormat; // Format of the pixel data
|
||||||
|
Caps: TDDSCaps; // Capabilities
|
||||||
|
Reserved2: LongWord; // Reserved
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ DDS file header.}
|
||||||
|
TDDSFileHeader = packed record
|
||||||
|
Magic: LongWord; // File format magic
|
||||||
|
Desc: TDDSurfaceDesc2; // Surface description
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TDDSFileFormat class implementation }
|
||||||
|
|
||||||
|
constructor TDDSFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SDDSFormatName;
|
||||||
|
FCanLoad := True;
|
||||||
|
FCanSave := True;
|
||||||
|
FIsMultiImageFormat := True;
|
||||||
|
FSupportedFormats := DDSSupportedFormats;
|
||||||
|
|
||||||
|
FSaveCubeMap := False;
|
||||||
|
FSaveVolume := False;
|
||||||
|
FSaveMipMapCount := 1;
|
||||||
|
FSaveDepth := 1;
|
||||||
|
|
||||||
|
AddMasks(SDDSMasks);
|
||||||
|
|
||||||
|
RegisterOption(ImagingDDSLoadedCubeMap, @FLoadedCubeMap);
|
||||||
|
RegisterOption(ImagingDDSLoadedVolume, @FLoadedVolume);
|
||||||
|
RegisterOption(ImagingDDSLoadedMipMapCount, @FLoadedMipMapCount);
|
||||||
|
RegisterOption(ImagingDDSLoadedDepth, @FLoadedDepth);
|
||||||
|
RegisterOption(ImagingDDSSaveCubeMap, @FSaveCubeMap);
|
||||||
|
RegisterOption(ImagingDDSSaveVolume, @FSaveVolume);
|
||||||
|
RegisterOption(ImagingDDSSaveMipMapCount, @FSaveMipMapCount);
|
||||||
|
RegisterOption(ImagingDDSSaveDepth, @FSaveDepth);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDDSFileFormat.CheckOptionsValidity;
|
||||||
|
begin
|
||||||
|
if FSaveCubeMap then
|
||||||
|
FSaveVolume := False;
|
||||||
|
if FSaveVolume then
|
||||||
|
FSaveCubeMap := False;
|
||||||
|
if FSaveDepth < 1 then
|
||||||
|
FSaveDepth := 1;
|
||||||
|
if FSaveMipMapCount < 1 then
|
||||||
|
FSaveMipMapCount := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDDSFileFormat.ComputeSubDimensions(Idx, Width, Height, MipMaps, Depth: LongInt;
|
||||||
|
IsCubeMap, IsVolume: Boolean; var CurWidth, CurHeight: LongInt);
|
||||||
|
var
|
||||||
|
I, Last, Shift: LongInt;
|
||||||
|
begin
|
||||||
|
CurWidth := Width;
|
||||||
|
CurHeight := Height;
|
||||||
|
if MipMaps > 1 then
|
||||||
|
begin
|
||||||
|
if not IsVolume then
|
||||||
|
begin
|
||||||
|
if IsCubeMap then
|
||||||
|
begin
|
||||||
|
// Cube maps are stored like this
|
||||||
|
// Face 0 mimap 0
|
||||||
|
// Face 0 mipmap 1
|
||||||
|
// ...
|
||||||
|
// Face 1 mipmap 0
|
||||||
|
// Face 1 mipmap 1
|
||||||
|
// ...
|
||||||
|
|
||||||
|
// Modify index so later in for loop we iterate less times
|
||||||
|
Idx := Idx - ((Idx div MipMaps) * MipMaps);
|
||||||
|
end;
|
||||||
|
for I := 0 to Idx - 1 do
|
||||||
|
begin
|
||||||
|
CurWidth := ClampInt(CurWidth shr 1, 1, CurWidth);
|
||||||
|
CurHeight := ClampInt(CurHeight shr 1, 1, CurHeight);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Volume textures are stored in DDS files like this:
|
||||||
|
// Slice 0 mipmap 0
|
||||||
|
// Slice 1 mipmap 0
|
||||||
|
// Slice 2 mipmap 0
|
||||||
|
// Slice 3 mipmap 0
|
||||||
|
// Slice 0 mipmap 1
|
||||||
|
// Slice 1 mipmap 1
|
||||||
|
// Slice 0 mipmap 2
|
||||||
|
// Slice 0 mipmap 3 ...
|
||||||
|
Shift := 0;
|
||||||
|
Last := Depth;
|
||||||
|
while Idx > Last - 1 do
|
||||||
|
begin
|
||||||
|
CurWidth := ClampInt(CurWidth shr 1, 1, CurWidth);
|
||||||
|
CurHeight := ClampInt(CurHeight shr 1, 1, CurHeight);
|
||||||
|
if (CurWidth = 1) and (CurHeight = 1) then
|
||||||
|
Break;
|
||||||
|
Inc(Shift);
|
||||||
|
Inc(Last, ClampInt(Depth shr Shift, 1, Depth));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDDSFileFormat.LoadData(Handle: TImagingHandle;
|
||||||
|
var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
Hdr: TDDSFileHeader;
|
||||||
|
SrcFormat: TImageFormat;
|
||||||
|
FmtInfo: TImageFormatInfo;
|
||||||
|
NeedsSwapChannels: Boolean;
|
||||||
|
CurrentWidth, CurrentHeight, ImageCount, LoadSize, I, PitchOrLinear: LongInt;
|
||||||
|
Data: PByte;
|
||||||
|
UseAsPitch: Boolean;
|
||||||
|
UseAsLinear: Boolean;
|
||||||
|
|
||||||
|
function MasksEqual(const DDPF: TDDPixelFormat; PF: PPixelFormatInfo): Boolean;
|
||||||
|
begin
|
||||||
|
Result := (DDPF.AlphaMask = PF.ABitMask) and
|
||||||
|
(DDPF.RedMask = PF.RBitMask) and (DDPF.GreenMask = PF.GBitMask) and
|
||||||
|
(DDPF.BlueMask = PF.BBitMask);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
ImageCount := 1;
|
||||||
|
FLoadedMipMapCount := 1;
|
||||||
|
FLoadedDepth := 1;
|
||||||
|
FLoadedVolume := False;
|
||||||
|
FLoadedCubeMap := False;
|
||||||
|
|
||||||
|
with GetIO, Hdr, Hdr.Desc.PixelFormat do
|
||||||
|
begin
|
||||||
|
Read(Handle, @Hdr, SizeOF(Hdr));
|
||||||
|
{
|
||||||
|
// Set position to the end of the header (for possible future versions
|
||||||
|
// ith larger header)
|
||||||
|
Seek(Handle, Hdr.Desc.Size + SizeOf(Hdr.Magic) - SizeOf(Hdr),
|
||||||
|
smFromCurrent);
|
||||||
|
}
|
||||||
|
SrcFormat := ifUnknown;
|
||||||
|
NeedsSwapChannels := False;
|
||||||
|
// Get image data format
|
||||||
|
if (Flags and DDPF_FOURCC) = DDPF_FOURCC then
|
||||||
|
begin
|
||||||
|
// Handle FourCC and large ARGB formats
|
||||||
|
case FourCC of
|
||||||
|
D3DFMT_A16B16G16R16: SrcFormat := ifA16B16G16R16;
|
||||||
|
D3DFMT_R32F: SrcFormat := ifR32F;
|
||||||
|
D3DFMT_A32B32G32R32F: SrcFormat := ifA32B32G32R32F;
|
||||||
|
D3DFMT_R16F: SrcFormat := ifR16F;
|
||||||
|
D3DFMT_A16B16G16R16F: SrcFormat := ifA16B16G16R16F;
|
||||||
|
FOURCC_DXT1: SrcFormat := ifDXT1;
|
||||||
|
FOURCC_DXT3: SrcFormat := ifDXT3;
|
||||||
|
FOURCC_DXT5: SrcFormat := ifDXT5;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if (Flags and DDPF_RGB) = DDPF_RGB then
|
||||||
|
begin
|
||||||
|
// Handle RGB formats
|
||||||
|
if (Flags and DDPF_ALPHAPIXELS) = DDPF_ALPHAPIXELS then
|
||||||
|
begin
|
||||||
|
// Handle RGB with alpha formats
|
||||||
|
case BitCount of
|
||||||
|
16:
|
||||||
|
begin
|
||||||
|
if MasksEqual(Desc.PixelFormat,
|
||||||
|
GetFormatInfo(ifA4R4G4B4).PixelFormat) then
|
||||||
|
SrcFormat := ifA4R4G4B4;
|
||||||
|
if MasksEqual(Desc.PixelFormat,
|
||||||
|
GetFormatInfo(ifA1R5G5B5).PixelFormat) then
|
||||||
|
SrcFormat := ifA1R5G5B5;
|
||||||
|
end;
|
||||||
|
32:
|
||||||
|
begin
|
||||||
|
SrcFormat := ifA8R8G8B8;
|
||||||
|
if BlueMask = $00FF0000 then
|
||||||
|
NeedsSwapChannels := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Handle RGB without alpha formats
|
||||||
|
case BitCount of
|
||||||
|
8:
|
||||||
|
if MasksEqual(Desc.PixelFormat,
|
||||||
|
GetFormatInfo(ifR3G3B2).PixelFormat) then
|
||||||
|
SrcFormat := ifR3G3B2;
|
||||||
|
16:
|
||||||
|
begin
|
||||||
|
if MasksEqual(Desc.PixelFormat,
|
||||||
|
GetFormatInfo(ifX4R4G4B4).PixelFormat) then
|
||||||
|
SrcFormat := ifX4R4G4B4;
|
||||||
|
if MasksEqual(Desc.PixelFormat,
|
||||||
|
GetFormatInfo(ifX1R5G5B5).PixelFormat) then
|
||||||
|
SrcFormat := ifX1R5G5B5;
|
||||||
|
if MasksEqual(Desc.PixelFormat,
|
||||||
|
GetFormatInfo(ifR5G6B5).PixelFormat) then
|
||||||
|
SrcFormat := ifR5G6B5;
|
||||||
|
end;
|
||||||
|
24: SrcFormat := ifR8G8B8;
|
||||||
|
32:
|
||||||
|
begin
|
||||||
|
SrcFormat := ifX8R8G8B8;
|
||||||
|
if BlueMask = $00FF0000 then
|
||||||
|
NeedsSwapChannels := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if (Flags and DDPF_LUMINANCE) = DDPF_LUMINANCE then
|
||||||
|
begin
|
||||||
|
// Handle luminance formats
|
||||||
|
if (Flags and DDPF_ALPHAPIXELS) = DDPF_ALPHAPIXELS then
|
||||||
|
begin
|
||||||
|
// Handle luminance with alpha formats
|
||||||
|
if BitCount = 16 then
|
||||||
|
SrcFormat := ifA8Gray8;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Handle luminance without alpha formats
|
||||||
|
case BitCount of
|
||||||
|
8: SrcFormat := ifGray8;
|
||||||
|
16: SrcFormat := ifGray16;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if (Flags and DDPF_BUMPLUMINANCE) = DDPF_BUMPLUMINANCE then
|
||||||
|
begin
|
||||||
|
// Handle mixed bump-luminance formats like D3DFMT_X8L8V8U8
|
||||||
|
case BitCount of
|
||||||
|
32:
|
||||||
|
if BlueMask = $00FF0000 then
|
||||||
|
begin
|
||||||
|
SrcFormat := ifX8R8G8B8; // D3DFMT_X8L8V8U8
|
||||||
|
NeedsSwapChannels := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if (Flags and DDPF_BUMPDUDV) = DDPF_BUMPDUDV then
|
||||||
|
begin
|
||||||
|
// Handle bumpmap formats like D3DFMT_Q8W8V8U8
|
||||||
|
case BitCount of
|
||||||
|
16: SrcFormat := ifA8Gray8; // D3DFMT_V8U8
|
||||||
|
32:
|
||||||
|
if AlphaMask = $FF000000 then
|
||||||
|
begin
|
||||||
|
SrcFormat := ifA8R8G8B8; // D3DFMT_Q8W8V8U8
|
||||||
|
NeedsSwapChannels := True;
|
||||||
|
end;
|
||||||
|
64: SrcFormat := ifA16B16G16R16; // D3DFMT_Q16W16V16U16
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// If DDS format is not supported we will exit
|
||||||
|
if SrcFormat = ifUnknown then Exit;
|
||||||
|
|
||||||
|
// File contains mipmaps for each subimage.
|
||||||
|
{ Some DDS writers ignore setting proper Caps and Flags so
|
||||||
|
this check is not usable:
|
||||||
|
if ((Desc.Caps.Caps1 and DDSCAPS_MIPMAP) = DDSCAPS_MIPMAP) and
|
||||||
|
((Desc.Flags and DDSD_MIPMAPCOUNT) = DDSD_MIPMAPCOUNT) then}
|
||||||
|
if Desc.MipMaps > 1 then
|
||||||
|
begin
|
||||||
|
FLoadedMipMapCount := Desc.MipMaps;
|
||||||
|
ImageCount := Desc.MipMaps;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// File stores volume texture
|
||||||
|
if ((Desc.Caps.Caps2 and DDSCAPS2_VOLUME) = DDSCAPS2_VOLUME) and
|
||||||
|
((Desc.Flags and DDSD_DEPTH) = DDSD_DEPTH) then
|
||||||
|
begin
|
||||||
|
FLoadedVolume := True;
|
||||||
|
FLoadedDepth := Desc.Depth;
|
||||||
|
ImageCount := GetVolumeLevelCount(Desc.Depth, ImageCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// File stores cube texture
|
||||||
|
if (Desc.Caps.Caps2 and DDSCAPS2_CUBEMAP) = DDSCAPS2_CUBEMAP then
|
||||||
|
begin
|
||||||
|
FLoadedCubeMap := True;
|
||||||
|
I := 0;
|
||||||
|
if (Desc.Caps.Caps2 and DDSCAPS2_POSITIVEX) = DDSCAPS2_POSITIVEX then Inc(I);
|
||||||
|
if (Desc.Caps.Caps2 and DDSCAPS2_POSITIVEY) = DDSCAPS2_POSITIVEY then Inc(I);
|
||||||
|
if (Desc.Caps.Caps2 and DDSCAPS2_POSITIVEZ) = DDSCAPS2_POSITIVEZ then Inc(I);
|
||||||
|
if (Desc.Caps.Caps2 and DDSCAPS2_NEGATIVEX) = DDSCAPS2_NEGATIVEX then Inc(I);
|
||||||
|
if (Desc.Caps.Caps2 and DDSCAPS2_NEGATIVEY) = DDSCAPS2_NEGATIVEY then Inc(I);
|
||||||
|
if (Desc.Caps.Caps2 and DDSCAPS2_NEGATIVEZ) = DDSCAPS2_NEGATIVEZ then Inc(I);
|
||||||
|
FLoadedDepth := I;
|
||||||
|
ImageCount := ImageCount * I;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Allocate and load all images in file
|
||||||
|
FmtInfo := GetFormatInfo(SrcFormat);
|
||||||
|
SetLength(Images, ImageCount);
|
||||||
|
|
||||||
|
// Compute the pitch or get if from file if present
|
||||||
|
UseAsPitch := (Desc.Flags and DDSD_PITCH) = DDSD_PITCH;
|
||||||
|
UseAsLinear := (Desc.Flags and DDSD_LINEARSIZE) = DDSD_LINEARSIZE;
|
||||||
|
// Use linear as default if none is set
|
||||||
|
if not UseAsPitch and not UseAsLinear then
|
||||||
|
UseAsLinear := True;
|
||||||
|
// Main image pitch or linear size
|
||||||
|
PitchOrLinear := Desc.PitchOrLinearSize;
|
||||||
|
|
||||||
|
for I := 0 to ImageCount - 1 do
|
||||||
|
begin
|
||||||
|
// Compute dimensions of surrent subimage based on texture type and
|
||||||
|
// number of mipmaps
|
||||||
|
ComputeSubDimensions(I, Desc.Width, Desc.Height, Desc.MipMaps, Desc.Depth,
|
||||||
|
FloadedCubeMap, FLoadedVolume, CurrentWidth, CurrentHeight);
|
||||||
|
NewImage(CurrentWidth, CurrentHeight, SrcFormat, Images[I]);
|
||||||
|
|
||||||
|
if (I > 0) or (PitchOrLinear = 0) then
|
||||||
|
begin
|
||||||
|
// Compute pitch or linear size for mipmap levels, or even for main image
|
||||||
|
// since some formats do not fill pitch nor size
|
||||||
|
if UseAsLinear then
|
||||||
|
PitchOrLinear := FmtInfo.GetPixelsSize(SrcFormat, CurrentWidth, CurrentHeight)
|
||||||
|
else
|
||||||
|
PitchOrLinear := (CurrentWidth * FmtInfo.BytesPerPixel + 3) div 4 * 4; // must be DWORD aligned
|
||||||
|
end;
|
||||||
|
|
||||||
|
if UseAsLinear then
|
||||||
|
LoadSize := PitchOrLinear
|
||||||
|
else
|
||||||
|
LoadSize := CurrentHeight * PitchOrLinear;
|
||||||
|
|
||||||
|
if UseAsLinear or (LoadSize = Images[I].Size) then
|
||||||
|
begin
|
||||||
|
// If DDS does not use Pitch we can simply copy data
|
||||||
|
Read(Handle, Images[I].Bits, LoadSize)
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// If DDS uses Pitch we must load aligned scanlines
|
||||||
|
// and then remove padding
|
||||||
|
GetMem(Data, LoadSize);
|
||||||
|
try
|
||||||
|
Read(Handle, Data, LoadSize);
|
||||||
|
RemovePadBytes(Data, Images[I].Bits, CurrentWidth, CurrentHeight,
|
||||||
|
FmtInfo.BytesPerPixel, PitchOrLinear);
|
||||||
|
finally
|
||||||
|
FreeMem(Data);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if NeedsSwapChannels then
|
||||||
|
SwapChannels(Images[I], ChannelRed, ChannelBlue);
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDDSFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: LongInt): Boolean;
|
||||||
|
var
|
||||||
|
Hdr: TDDSFileHeader;
|
||||||
|
MainImage, ImageToSave: TImageData;
|
||||||
|
I, MainIdx, Len, ImageCount: LongInt;
|
||||||
|
J: LongWord;
|
||||||
|
FmtInfo: TImageFormatInfo;
|
||||||
|
MustBeFreed: Boolean;
|
||||||
|
Is2DTexture, IsCubeMap, IsVolume: Boolean;
|
||||||
|
MipMapCount, CurrentWidth, CurrentHeight: LongInt;
|
||||||
|
NeedsResize: Boolean;
|
||||||
|
NeedsConvert: Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
FillChar(Hdr, Sizeof(Hdr), 0);
|
||||||
|
|
||||||
|
MainIdx := FFirstIdx;
|
||||||
|
Len := FLastIdx - MainIdx + 1;
|
||||||
|
// Some DDS saving rules:
|
||||||
|
// 2D textures: Len is used as mipmap count (FSaveMipMapCount not used!).
|
||||||
|
// Cube maps: FSaveDepth * FSaveMipMapCount images are used, if Len is
|
||||||
|
// smaller than this file is saved as regular 2D texture.
|
||||||
|
// Volume maps: GetVolumeLevelCount(FSaveDepth, FSaveMipMapCount) images are
|
||||||
|
// used, if Len is smaller than this file is
|
||||||
|
// saved as regular 2D texture.
|
||||||
|
|
||||||
|
IsCubeMap := FSaveCubeMap;
|
||||||
|
IsVolume := FSaveVolume;
|
||||||
|
MipMapCount := FSaveMipMapCount;
|
||||||
|
|
||||||
|
if IsCubeMap then
|
||||||
|
begin
|
||||||
|
// Check if we have enough images on Input to save cube map
|
||||||
|
if Len < FSaveDepth * FSaveMipMapCount then
|
||||||
|
IsCubeMap := False;
|
||||||
|
end
|
||||||
|
else if IsVolume then
|
||||||
|
begin
|
||||||
|
// Check if we have enough images on Input to save volume texture
|
||||||
|
if Len < GetVolumeLevelCount(FSaveDepth, FSaveMipMapCount) then
|
||||||
|
IsVolume := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Is2DTexture := not IsCubeMap and not IsVolume;
|
||||||
|
if Is2DTexture then
|
||||||
|
begin
|
||||||
|
// Get number of mipmaps used with 2D texture
|
||||||
|
MipMapCount := Min(Len, GetNumMipMapLevels(Images[MainIdx].Width, Images[MainIdx].Height));
|
||||||
|
end;
|
||||||
|
|
||||||
|
// we create compatible main image and fill headers
|
||||||
|
if MakeCompatible(Images[MainIdx], MainImage, MustBeFreed) then
|
||||||
|
with GetIO, MainImage, Hdr do
|
||||||
|
try
|
||||||
|
FmtInfo := GetFormatInfo(Format);
|
||||||
|
Magic := DDSMagic;
|
||||||
|
Desc.Size := SizeOf(Desc);
|
||||||
|
Desc.Width := Width;
|
||||||
|
Desc.Height := Height;
|
||||||
|
Desc.Flags := DDS_SAVE_FLAGS;
|
||||||
|
Desc.Caps.Caps1 := DDSCAPS_TEXTURE;
|
||||||
|
Desc.PixelFormat.Size := SizeOf(Desc.PixelFormat);
|
||||||
|
Desc.PitchOrLinearSize := MainImage.Size;
|
||||||
|
ImageCount := MipMapCount;
|
||||||
|
|
||||||
|
if MipMapCount > 1 then
|
||||||
|
begin
|
||||||
|
// Set proper flags if we have some mipmaps to be saved
|
||||||
|
Desc.Flags := Desc.Flags or DDSD_MIPMAPCOUNT;
|
||||||
|
Desc.Caps.Caps1 := Desc.Caps.Caps1 or DDSCAPS_MIPMAP or DDSCAPS_COMPLEX;
|
||||||
|
Desc.MipMaps := MipMapCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if IsCubeMap then
|
||||||
|
begin
|
||||||
|
// Set proper cube map flags - number of stored faces is taken
|
||||||
|
// from FSaveDepth
|
||||||
|
Desc.Caps.Caps1 := Desc.Caps.Caps1 or DDSCAPS_COMPLEX;
|
||||||
|
Desc.Caps.Caps2 := Desc.Caps.Caps2 or DDSCAPS2_CUBEMAP;
|
||||||
|
J := DDSCAPS2_POSITIVEX;
|
||||||
|
for I := 0 to FSaveDepth - 1 do
|
||||||
|
begin
|
||||||
|
Desc.Caps.Caps2 := Desc.Caps.Caps2 or J;
|
||||||
|
J := J shl 1;
|
||||||
|
end;
|
||||||
|
ImageCount := FSaveDepth * FSaveMipMapCount;
|
||||||
|
end
|
||||||
|
else if IsVolume then
|
||||||
|
begin
|
||||||
|
// Set proper flags for volume texture
|
||||||
|
Desc.Flags := Desc.Flags or DDSD_DEPTH;
|
||||||
|
Desc.Caps.Caps1 := Desc.Caps.Caps1 or DDSCAPS_COMPLEX;
|
||||||
|
Desc.Caps.Caps2 := Desc.Caps.Caps2 or DDSCAPS2_VOLUME;
|
||||||
|
Desc.Depth := FSaveDepth;
|
||||||
|
ImageCount := GetVolumeLevelCount(FSaveDepth, FSaveMipMapCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Now we set DDS pixel format for main image
|
||||||
|
if FmtInfo.IsSpecial or FmtInfo.IsFloatingPoint or
|
||||||
|
(FmtInfo.BytesPerPixel > 4) then
|
||||||
|
begin
|
||||||
|
Desc.PixelFormat.Flags := DDPF_FOURCC;
|
||||||
|
case Format of
|
||||||
|
ifA16B16G16R16: Desc.PixelFormat.FourCC := D3DFMT_A16B16G16R16;
|
||||||
|
ifR32F: Desc.PixelFormat.FourCC := D3DFMT_R32F;
|
||||||
|
ifA32B32G32R32F: Desc.PixelFormat.FourCC := D3DFMT_A32B32G32R32F;
|
||||||
|
ifR16F: Desc.PixelFormat.FourCC := D3DFMT_R16F;
|
||||||
|
ifA16B16G16R16F: Desc.PixelFormat.FourCC := D3DFMT_A16B16G16R16F;
|
||||||
|
ifDXT1: Desc.PixelFormat.FourCC := FOURCC_DXT1;
|
||||||
|
ifDXT3: Desc.PixelFormat.FourCC := FOURCC_DXT3;
|
||||||
|
ifDXT5: Desc.PixelFormat.FourCC := FOURCC_DXT5;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if FmtInfo.HasGrayChannel then
|
||||||
|
begin
|
||||||
|
Desc.PixelFormat.Flags := DDPF_LUMINANCE;
|
||||||
|
Desc.PixelFormat.BitCount := FmtInfo.BytesPerPixel * 8;
|
||||||
|
case Format of
|
||||||
|
ifGray8: Desc.PixelFormat.RedMask := 255;
|
||||||
|
ifGray16: Desc.PixelFormat.RedMask := 65535;
|
||||||
|
ifA8Gray8:
|
||||||
|
begin
|
||||||
|
Desc.PixelFormat.Flags := Desc.PixelFormat.Flags or DDPF_ALPHAPIXELS;
|
||||||
|
Desc.PixelFormat.RedMask := 255;
|
||||||
|
Desc.PixelFormat.AlphaMask := 65280;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Desc.PixelFormat.Flags := DDPF_RGB;
|
||||||
|
Desc.PixelFormat.BitCount := FmtInfo.BytesPerPixel * 8;
|
||||||
|
if FmtInfo.HasAlphaChannel then
|
||||||
|
begin
|
||||||
|
Desc.PixelFormat.Flags := Desc.PixelFormat.Flags or DDPF_ALPHAPIXELS;
|
||||||
|
Desc.PixelFormat.AlphaMask := $FF000000;
|
||||||
|
end;
|
||||||
|
if FmtInfo.BytesPerPixel > 2 then
|
||||||
|
begin
|
||||||
|
Desc.PixelFormat.RedMask := $00FF0000;
|
||||||
|
Desc.PixelFormat.GreenMask := $0000FF00;
|
||||||
|
Desc.PixelFormat.BlueMask := $000000FF;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Desc.PixelFormat.AlphaMask := FmtInfo.PixelFormat.ABitMask;
|
||||||
|
Desc.PixelFormat.RedMask := FmtInfo.PixelFormat.RBitMask;
|
||||||
|
Desc.PixelFormat.GreenMask := FmtInfo.PixelFormat.GBitMask;
|
||||||
|
Desc.PixelFormat.BlueMask := FmtInfo.PixelFormat.BBitMask;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Header and main image are written to output
|
||||||
|
Write(Handle, @Hdr, SizeOf(Hdr));
|
||||||
|
Write(Handle, MainImage.Bits, MainImage.Size);
|
||||||
|
|
||||||
|
// Write the rest of the images and convert them to
|
||||||
|
// the same format as main image if necessary and ensure proper mipmap
|
||||||
|
// simensions too.
|
||||||
|
for I := MainIdx + 1 to MainIdx + ImageCount - 1 do
|
||||||
|
begin
|
||||||
|
// Get proper dimensions for this level
|
||||||
|
ComputeSubDimensions(I, Desc.Width, Desc.Height, Desc.MipMaps, Desc.Depth,
|
||||||
|
IsCubeMap, IsVolume, CurrentWidth, CurrentHeight);
|
||||||
|
|
||||||
|
// Check if input image for this level has the right size and format
|
||||||
|
NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight));
|
||||||
|
NeedsConvert := not (Images[I].Format = Format);
|
||||||
|
|
||||||
|
if NeedsResize or NeedsConvert then
|
||||||
|
begin
|
||||||
|
// Input image must be resized or converted to different format
|
||||||
|
// to become valid mipmap level
|
||||||
|
InitImage(ImageToSave);
|
||||||
|
CloneImage(Images[I], ImageToSave);
|
||||||
|
if NeedsConvert then
|
||||||
|
ConvertImage(ImageToSave, Format);
|
||||||
|
if NeedsResize then
|
||||||
|
ResizeImage(ImageToSave, CurrentWidth, CurrentHeight, rfBilinear);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
// Input image can be used without any changes
|
||||||
|
ImageToSave := Images[I];
|
||||||
|
|
||||||
|
// Write level data and release temp image if necessary
|
||||||
|
Write(Handle, ImageToSave.Bits, ImageToSave.Size);
|
||||||
|
if Images[I].Bits <> ImageToSave.Bits then
|
||||||
|
FreeImage(ImageToSave);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
if MustBeFreed then
|
||||||
|
FreeImage(MainImage);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDDSFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
var
|
||||||
|
ConvFormat: TImageFormat;
|
||||||
|
begin
|
||||||
|
if Info.IsIndexed or Info.IsSpecial then
|
||||||
|
// convert indexed and unsupported special formatd to A8R8G8B8
|
||||||
|
ConvFormat := ifA8R8G8B8
|
||||||
|
else if Info.IsFloatingPoint then
|
||||||
|
begin
|
||||||
|
if Info.Format = ifA16R16G16B16F then
|
||||||
|
// only swap channels here
|
||||||
|
ConvFormat := ifA16B16G16R16F
|
||||||
|
else
|
||||||
|
// convert other floating point formats to A32B32G32R32F
|
||||||
|
ConvFormat := ifA32B32G32R32F
|
||||||
|
end
|
||||||
|
else if Info.HasGrayChannel then
|
||||||
|
begin
|
||||||
|
if Info.HasAlphaChannel then
|
||||||
|
// convert grayscale with alpha to A8Gray8
|
||||||
|
ConvFormat := ifA8Gray8
|
||||||
|
else if Info.BytesPerPixel = 1 then
|
||||||
|
// convert 8bit grayscale to Gray8
|
||||||
|
ConvFormat := ifGray8
|
||||||
|
else
|
||||||
|
// convert 16-64bit grayscales to Gray16
|
||||||
|
ConvFormat := ifGray16;
|
||||||
|
end
|
||||||
|
else if Info.BytesPerPixel > 4 then
|
||||||
|
ConvFormat := ifA16B16G16R16
|
||||||
|
else if Info.HasAlphaChannel then
|
||||||
|
// convert the other images with alpha channel to A8R8G8B8
|
||||||
|
ConvFormat := ifA8R8G8B8
|
||||||
|
else
|
||||||
|
// convert the other formats to X8R8G8B8
|
||||||
|
ConvFormat := ifX8R8G8B8;
|
||||||
|
|
||||||
|
ConvertImage(Image, ConvFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDDSFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
|
||||||
|
var
|
||||||
|
Hdr: TDDSFileHeader;
|
||||||
|
ReadCount: LongInt;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if Handle <> nil then
|
||||||
|
with GetIO do
|
||||||
|
begin
|
||||||
|
ReadCount := Read(Handle, @Hdr, SizeOf(Hdr));
|
||||||
|
Seek(Handle, -ReadCount, smFromCurrent);
|
||||||
|
Result := (Hdr.Magic = DDSMagic) and (ReadCount = SizeOf(Hdr)) and
|
||||||
|
((Hdr.Desc.Caps.Caps1 and DDSCAPS_TEXTURE) = DDSCAPS_TEXTURE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterImageFileFormat(TDDSFileFormat);
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
|
||||||
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Saved DDS with mipmaps now correctly defineds COMPLEX flag.
|
||||||
|
- Fixed loading of RGB DDS files that use pitch and have mipmaps -
|
||||||
|
mipmaps were loaded wrongly.
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Changed saving behaviour a bit: mipmaps are inlcuded automatically for
|
||||||
|
2D textures if input image array has more than 1 image (no need to
|
||||||
|
set SaveMipMapCount manually).
|
||||||
|
- Mipmap levels are now saved with proper dimensions when saving DDS files.
|
||||||
|
- Made some changes to not be so strict when loading DDS files.
|
||||||
|
Many programs seem to save them in non-standard format
|
||||||
|
(by MS DDS File Reference).
|
||||||
|
- Added missing ifX8R8G8B8 to SupportedFormats, MakeCompatible failed
|
||||||
|
when image was converted to this format (inside).
|
||||||
|
- MakeCompatible method moved to base class, put ConvertToSupported here.
|
||||||
|
GetSupportedFormats removed, it is now set in constructor.
|
||||||
|
- Fixed bug that sometimes saved non-standard DDS files and another
|
||||||
|
one that caused crash when these files were loaded.
|
||||||
|
- Changed extensions to filename masks.
|
||||||
|
- Changed SaveData, LoadData, and MakeCompatible methods according
|
||||||
|
to changes in base class in Imaging unit.
|
||||||
|
|
||||||
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
||||||
|
- added support for half-float image formats
|
||||||
|
- change in LoadData to allow support for more images
|
||||||
|
in one stream loading
|
||||||
|
|
||||||
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
||||||
|
- fixed bug in TestFormat which does not recognize many DDS files
|
||||||
|
- changed pitch/linearsize handling in DDS loading code to
|
||||||
|
load DDS files produced by NVidia's Photoshop plugin
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,887 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingExport.pas 71 2007-03-08 00:10:10Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This function contains functions exported from Imaging dynamic link library.
|
||||||
|
All string are exported as PChars and all var parameters are exported
|
||||||
|
as pointers. All posible exceptions getting out of dll are catched.}
|
||||||
|
unit ImagingExport;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
ImagingTypes,
|
||||||
|
Imaging;
|
||||||
|
|
||||||
|
{ Returns version of Imaging library. }
|
||||||
|
procedure ImGetVersion(var Major, Minor, Patch: LongInt); cdecl;
|
||||||
|
{ Look at InitImage for details.}
|
||||||
|
procedure ImInitImage(var Image: TImageData); cdecl;
|
||||||
|
{ Look at NewImage for details.}
|
||||||
|
function ImNewImage(Width, Height: LongInt; Format: TImageFormat;
|
||||||
|
var Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at TestImage for details.}
|
||||||
|
function ImTestImage(var Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at FreeImage for details.}
|
||||||
|
function ImFreeImage(var Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at DetermineFileFormat for details. Ext should have enough space for
|
||||||
|
result file extension.}
|
||||||
|
function ImDetermineFileFormat(FileName, Ext: PChar): Boolean; cdecl;
|
||||||
|
{ Look at DetermineMemoryFormat for details. Ext should have enough space for
|
||||||
|
result file extension.}
|
||||||
|
function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PChar): Boolean; cdecl;
|
||||||
|
{ Look at IsFileFormatSupported for details.}
|
||||||
|
function ImIsFileFormatSupported(FileName: PChar): Boolean; cdecl;
|
||||||
|
{ Look at EnumFileFormats for details.}
|
||||||
|
function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PChar;
|
||||||
|
var CanSave, IsMultiImageFormat: Boolean): Boolean; cdecl;
|
||||||
|
|
||||||
|
{ Inits image list.}
|
||||||
|
function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean; cdecl;
|
||||||
|
{ Returns size of image list.}
|
||||||
|
function ImGetImageListSize(ImageList: TImageDataList): LongInt; cdecl;
|
||||||
|
{ Returns image list's element at given index. Output image is not cloned it's
|
||||||
|
Bits point to Bits in list => do not free OutImage.}
|
||||||
|
function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt;
|
||||||
|
var OutImage: TImageData): Boolean; cdecl;
|
||||||
|
{ Sets size of image list.}
|
||||||
|
function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt): Boolean; cdecl;
|
||||||
|
{ Sets image list element at given index. Input image is not cloned - image in
|
||||||
|
list will point to InImage's Bits.}
|
||||||
|
function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt;
|
||||||
|
const InImage: TImageData): Boolean; cdecl;
|
||||||
|
{ Returns True if all images in list pass ImTestImage test. }
|
||||||
|
function ImTestImagesInList(ImageList: TImageDataList): Boolean; cdecl;
|
||||||
|
{ Frees image list and all images in it.}
|
||||||
|
function ImFreeImageList(var ImageList: TImageDataList): Boolean; cdecl;
|
||||||
|
|
||||||
|
{ Look at LoadImageFromFile for details.}
|
||||||
|
function ImLoadImageFromFile(FileName: PChar; var Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at LoadImageFromMemory for details.}
|
||||||
|
function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at LoadMultiImageFromFile for details.}
|
||||||
|
function ImLoadMultiImageFromFile(FileName: PChar; var ImageList: TImageDataList): Boolean; cdecl;
|
||||||
|
{ Look at LoadMultiImageFromMemory for details.}
|
||||||
|
function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt;
|
||||||
|
var ImageList: TImageDataList): Boolean; cdecl;
|
||||||
|
|
||||||
|
{ Look at SaveImageToFile for details.}
|
||||||
|
function ImSaveImageToFile(FileName: PChar; const Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at SaveImageToMemory for details.}
|
||||||
|
function ImSaveImageToMemory(Ext: PChar; Data: Pointer; var Size: LongInt;
|
||||||
|
const Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at SaveMultiImageToFile for details.}
|
||||||
|
function ImSaveMultiImageToFile(FileName: PChar; ImageList: TImageDataList): Boolean; cdecl;
|
||||||
|
{ Look at SaveMultiImageToMemory for details.}
|
||||||
|
function ImSaveMultiImageToMemory(Ext: PChar; Data: Pointer; Size: PLongInt;
|
||||||
|
ImageList: TImageDataList): Boolean; cdecl;
|
||||||
|
|
||||||
|
{ Look at CloneImage for details.}
|
||||||
|
function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at ConvertImage for details.}
|
||||||
|
function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; cdecl;
|
||||||
|
{ Look at FlipImage for details.}
|
||||||
|
function ImFlipImage(var Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at MirrorImage for details.}
|
||||||
|
function ImMirrorImage(var Image: TImageData): Boolean; cdecl;
|
||||||
|
{ Look at ResizeImage for details.}
|
||||||
|
function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt;
|
||||||
|
Filter: TResizeFilter): Boolean; cdecl;
|
||||||
|
{ Look at SwapChannels for details.}
|
||||||
|
function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; cdecl;
|
||||||
|
{ Look at ReduceColors for details.}
|
||||||
|
function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; cdecl;
|
||||||
|
{ Look at GenerateMipMaps for details.}
|
||||||
|
function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt;
|
||||||
|
var MipMaps: TImageDataList): Boolean; cdecl;
|
||||||
|
{ Look at MapImageToPalette for details.}
|
||||||
|
function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32;
|
||||||
|
Entries: LongInt): Boolean; cdecl;
|
||||||
|
{ Look at SplitImage for details.}
|
||||||
|
function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList;
|
||||||
|
ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt;
|
||||||
|
PreserveSize: Boolean; Fill: Pointer): Boolean; cdecl;
|
||||||
|
{ Look at MakePaletteForImages for details.}
|
||||||
|
function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32;
|
||||||
|
MaxColors: LongInt; ConvertImages: Boolean): Boolean; cdecl;
|
||||||
|
{ Look at RotateImage for details.}
|
||||||
|
function ImRotateImage(var Image: TImageData; Angle: LongInt): Boolean; cdecl;
|
||||||
|
|
||||||
|
{ Look at CopyRect for details.}
|
||||||
|
function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;
|
||||||
|
var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl;
|
||||||
|
{ Look at FillRect for details.}
|
||||||
|
function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt;
|
||||||
|
Fill: Pointer): Boolean; cdecl;
|
||||||
|
{ Look at ReplaceColor for details.}
|
||||||
|
function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt;
|
||||||
|
OldPixel, NewPixel: Pointer): Boolean; cdecl;
|
||||||
|
{ Look at StretchRect for details.}
|
||||||
|
function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
|
||||||
|
SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,
|
||||||
|
DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl;
|
||||||
|
{ Look at GetPixelDirect for details.}
|
||||||
|
procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl;
|
||||||
|
{ Look at SetPixelDirect for details.}
|
||||||
|
procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl;
|
||||||
|
{ Look at GetPixel32 for details.}
|
||||||
|
function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl;
|
||||||
|
{ Look at SetPixel32 for details.}
|
||||||
|
procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); cdecl;
|
||||||
|
{ Look at GetPixelFP for details.}
|
||||||
|
function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl;
|
||||||
|
{ Look at SetPixelFP for details.}
|
||||||
|
procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); cdecl;
|
||||||
|
|
||||||
|
{ Look at NewPalette for details.}
|
||||||
|
function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean; cdecl;
|
||||||
|
{ Look at FreePalette for details.}
|
||||||
|
function ImFreePalette(var Pal: PPalette32): Boolean; cdecl;
|
||||||
|
{ Look at CopyPalette for details.}
|
||||||
|
function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; cdecl;
|
||||||
|
{ Look at FindColor for details.}
|
||||||
|
function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt; cdecl;
|
||||||
|
{ Look at FillGrayscalePalette for details.}
|
||||||
|
function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean; cdecl;
|
||||||
|
{ Look at FillCustomPalette for details.}
|
||||||
|
function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits,
|
||||||
|
BBits: Byte; Alpha: Byte): Boolean; cdecl;
|
||||||
|
{ Look at SwapChannelsOfPalette for details.}
|
||||||
|
function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel,
|
||||||
|
DstChannel: LongInt): Boolean; cdecl;
|
||||||
|
|
||||||
|
{ Look at SetOption for details.}
|
||||||
|
function ImSetOption(OptionId, Value: LongInt): Boolean; cdecl;
|
||||||
|
{ Look at GetOption for details.}
|
||||||
|
function ImGetOption(OptionId: LongInt): LongInt; cdecl;
|
||||||
|
{ Look at PushOptions for details.}
|
||||||
|
function ImPushOptions: Boolean; cdecl;
|
||||||
|
{ Look at PopOptions for details.}
|
||||||
|
function ImPopOptions: Boolean; cdecl;
|
||||||
|
|
||||||
|
{ Look at GetImageFormatInfo for details.}
|
||||||
|
function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; cdecl;
|
||||||
|
{ Look at GetPixelsSize for details.}
|
||||||
|
function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; cdecl;
|
||||||
|
|
||||||
|
{ Look at SetUserFileIO for details.}
|
||||||
|
procedure ImSetUserFileIO(OpenReadProc: TOpenReadProc; OpenWriteProc:
|
||||||
|
TOpenWriteProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc;
|
||||||
|
TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc); cdecl;
|
||||||
|
{ Look at ResetFileIO for details.}
|
||||||
|
procedure ImResetFileIO; cdecl;
|
||||||
|
|
||||||
|
{ These are only for documentation generation reasons.}
|
||||||
|
{ Loads Imaging functions from dll/so library.}
|
||||||
|
function ImLoadLibrary: Boolean;
|
||||||
|
{ Frees Imaging functions loaded from dll/so and releases library.}
|
||||||
|
function ImFreeLibrary: Boolean;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
ImagingUtility;
|
||||||
|
|
||||||
|
function ImLoadLibrary: Boolean; begin Result := True; end;
|
||||||
|
function ImFreeLibrary: Boolean; begin Result := True; end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TInternalList = record
|
||||||
|
List: TDynImageDataArray;
|
||||||
|
end;
|
||||||
|
PInternalList = ^TInternalList;
|
||||||
|
|
||||||
|
procedure ImGetVersion(var Major, Minor, Patch: LongInt);
|
||||||
|
begin
|
||||||
|
Major := ImagingVersionMajor;
|
||||||
|
Minor := ImagingVersionMinor;
|
||||||
|
Patch := ImagingVersionPatch;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ImInitImage(var Image: TImageData);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.InitImage(Image);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImNewImage(Width, Height: LongInt; Format: TImageFormat;
|
||||||
|
var Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.NewImage(Width, Height, Format, Image);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImTestImage(var Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.TestImage(Image);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImFreeImage(var Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.FreeImage(Image);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImDetermineFileFormat(FileName, Ext: PChar): Boolean;
|
||||||
|
var
|
||||||
|
S: string;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
S := Imaging.DetermineFileFormat(FileName);
|
||||||
|
Result := S <> '';
|
||||||
|
StrCopy(Ext, PChar(S));
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PChar): Boolean;
|
||||||
|
var
|
||||||
|
S: string;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
S := Imaging.DetermineMemoryFormat(Data, Size);
|
||||||
|
Result := S <> '';
|
||||||
|
StrCopy(Ext, PChar(S));
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImIsFileFormatSupported(FileName: PChar): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.IsFileFormatSupported(FileName);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PChar;
|
||||||
|
var CanSave, IsMultiImageFormat: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
StrName, StrDefaultExt, StrMasks: string;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.EnumFileFormats(Index, StrName, StrDefaultExt, StrMasks, CanSave,
|
||||||
|
IsMultiImageFormat);
|
||||||
|
StrCopy(Name, PChar(StrName));
|
||||||
|
StrCopy(DefaultExt, PChar(StrDefaultExt));
|
||||||
|
StrCopy(Masks, PChar(StrMasks));
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean;
|
||||||
|
var
|
||||||
|
Int: PInternalList;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
try
|
||||||
|
ImFreeImageList(ImageList);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
New(Int);
|
||||||
|
SetLength(Int.List, Size);
|
||||||
|
ImageList := TImageDataList(Int);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
ImageList := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImGetImageListSize(ImageList: TImageDataList): LongInt;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Length(PInternalList(ImageList).List);
|
||||||
|
except
|
||||||
|
Result := -1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt;
|
||||||
|
var OutImage: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Index := ClampInt(Index, 0, Length(PInternalList(ImageList).List) - 1);
|
||||||
|
ImCloneImage(PInternalList(ImageList).List[Index], OutImage);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt):
|
||||||
|
Boolean;
|
||||||
|
var
|
||||||
|
I, OldSize: LongInt;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
OldSize := Length(PInternalList(ImageList).List);
|
||||||
|
if NewSize < OldSize then
|
||||||
|
for I := NewSize to OldSize - 1 do
|
||||||
|
Imaging.FreeImage(PInternalList(ImageList).List[I]);
|
||||||
|
SetLength(PInternalList(ImageList).List, NewSize);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt;
|
||||||
|
const InImage: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Index := ClampInt(Index, 0, Length(PInternalList(ImageList).List) - 1);
|
||||||
|
ImCloneImage(InImage, PInternalList(ImageList).List[Index]);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImTestImagesInList(ImageList: TImageDataList): Boolean;
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
Arr: TDynImageDataArray;
|
||||||
|
begin
|
||||||
|
Arr := nil;
|
||||||
|
try
|
||||||
|
Arr := PInternalList(ImageList).List;
|
||||||
|
Result := True;
|
||||||
|
for I := 0 to Length(Arr) - 1 do
|
||||||
|
begin
|
||||||
|
Result := Result and Imaging.TestImage(Arr[I]);
|
||||||
|
if not Result then Break;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImFreeImageList(var ImageList: TImageDataList): Boolean;
|
||||||
|
var
|
||||||
|
Int: PInternalList;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
if ImageList <> nil then
|
||||||
|
begin
|
||||||
|
Int := PInternalList(ImageList);
|
||||||
|
FreeImagesInArray(Int.List);
|
||||||
|
Dispose(Int);
|
||||||
|
ImageList := nil;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImLoadImageFromFile(FileName: PChar; var Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.LoadImageFromFile(FileName, Image);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.LoadImageFromMemory(Data, Size, Image);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImLoadMultiImageFromFile(FileName: PChar; var ImageList: TImageDataList):
|
||||||
|
Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
ImInitImageList(0, ImageList);
|
||||||
|
Result := Imaging.LoadMultiImageFromFile(FileName,
|
||||||
|
PInternalList(ImageList).List);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt;
|
||||||
|
var ImageList: TImageDataList): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
ImInitImageList(0, ImageList);
|
||||||
|
Result := Imaging.LoadMultiImageFromMemory(Data, Size, PInternalList(ImageList).List);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSaveImageToFile(FileName: PChar; const Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.SaveImageToFile(FileName, Image);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSaveImageToMemory(Ext: PChar; Data: Pointer; var Size: LongInt;
|
||||||
|
const Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.SaveImageToMemory(Ext, Data, Size, Image);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSaveMultiImageToFile(FileName: PChar;
|
||||||
|
ImageList: TImageDataList): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.SaveMultiImageToFile(FileName,
|
||||||
|
PInternalList(ImageList).List);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSaveMultiImageToMemory(Ext: PChar; Data: Pointer; Size: PLongInt;
|
||||||
|
ImageList: TImageDataList): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.SaveMultiImageToMemory(Ext, Data, Size^,
|
||||||
|
PInternalList(ImageList).List);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.CloneImage(Image, Clone);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.ConvertImage(Image, DestFormat);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImFlipImage(var Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.FlipImage(Image);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImMirrorImage(var Image: TImageData): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.MirrorImage(Image);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt;
|
||||||
|
Filter: TResizeFilter): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.ResizeImage(Image, NewWidth, NewHeight, Filter);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt):
|
||||||
|
Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.SwapChannels(Image, SrcChannel, DstChannel);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.ReduceColors(Image, MaxColors);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt;
|
||||||
|
var MipMaps: TImageDataList): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
ImInitImageList(0, MipMaps);
|
||||||
|
Result := Imaging.GenerateMipMaps(Image, Levels,
|
||||||
|
PInternalList(MipMaps).List);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32;
|
||||||
|
Entries: LongInt): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.MapImageToPalette(Image, Pal, Entries);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList;
|
||||||
|
ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt;
|
||||||
|
PreserveSize: Boolean; Fill: Pointer): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
ImInitImageList(0, Chunks);
|
||||||
|
Result := Imaging.SplitImage(Image, PInternalList(Chunks).List,
|
||||||
|
ChunkWidth, ChunkHeight, XChunks, YChunks, PreserveSize, Fill);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32;
|
||||||
|
MaxColors: LongInt; ConvertImages: Boolean): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.MakePaletteForImages(PInternalList(Images).List,
|
||||||
|
Pal, MaxColors, ConvertImages);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImRotateImage(var Image: TImageData; Angle: LongInt): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.RotateImage(Image, Angle);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;
|
||||||
|
var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.CopyRect(SrcImage, SrcX, SrcY, Width, Height,
|
||||||
|
DstImage, DstX, DstY);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt;
|
||||||
|
Fill: Pointer): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.FillRect(Image, X, Y, Width, Height, Fill);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt;
|
||||||
|
OldPixel, NewPixel: Pointer): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.ReplaceColor(Image, X, Y, Width, Height, OldPixel, NewPixel);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
|
||||||
|
SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,
|
||||||
|
DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.StretchRect(SrcImage, SrcX, SrcY, SrcWidth, SrcHeight,
|
||||||
|
DstImage, DstX, DstY, DstWidth, DstHeight, Filter);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.GetPixelDirect(Image, X, Y, Pixel);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.SetPixelDirect(Image, X, Y, Pixel);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.GetPixel32(Image, X, Y);
|
||||||
|
except
|
||||||
|
Result.Color := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.SetPixel32(Image, X, Y, Color);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.GetPixelFP(Image, X, Y);
|
||||||
|
except
|
||||||
|
FillChar(Result, SizeOf(Result), 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.SetPixelFP(Image, X, Y, Color);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.NewPalette(Entries, Pal);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImFreePalette(var Pal: PPalette32): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.FreePalette(Pal);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.CopyPalette(SrcPal, DstPal, SrcIdx, DstIdx, Count);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.FindColor(Pal, Entries, Color);
|
||||||
|
except
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.FillGrayscalePalette(Pal, Entries);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits,
|
||||||
|
BBits: Byte; Alpha: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.FillCustomPalette(Pal, Entries, RBits, GBits, BBits, Alpha);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel,
|
||||||
|
DstChannel: LongInt): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.SwapChannelsOfPalette(Pal, Entries, SrcChannel, DstChannel);
|
||||||
|
Result := True;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImSetOption(OptionId, Value: LongInt): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.SetOption(OptionId, Value);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImGetOption(OptionId: LongInt): LongInt;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := GetOption(OptionId);
|
||||||
|
except
|
||||||
|
Result := InvalidOption;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImPushOptions: Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.PushOptions;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImPopOptions: Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.PopOptions;
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.GetImageFormatInfo(Format, Info);
|
||||||
|
except
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := Imaging.GetPixelsSize(Format, Width, Height);
|
||||||
|
except
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ImSetUserFileIO(OpenReadProc: TOpenReadProc; OpenWriteProc:
|
||||||
|
TOpenWriteProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc;
|
||||||
|
TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.SetUserFileIO(OpenReadProc, OpenWriteProc, CloseProc, EofProc,
|
||||||
|
SeekProc, TellProc, ReadProc, WriteProc);
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ImResetFileIO;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Imaging.ResetFileIO;
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
Changes/Bug Fixes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
|
||||||
|
-- 0.19 -----------------------------------------------------
|
||||||
|
- updated to reflect changes in low level interface (added pixel set/get, ...)
|
||||||
|
- changed ImInitImage to procedure to reflect change in Imaging.pas
|
||||||
|
- added ImIsFileFormatSupported
|
||||||
|
|
||||||
|
-- 0.15 -----------------------------------------------------
|
||||||
|
- behaviour of ImGetImageListElement and ImSetImageListElement
|
||||||
|
has changed - list items are now cloned rather than referenced,
|
||||||
|
because of this ImFreeImageListKeepImages was no longer needed
|
||||||
|
and was removed
|
||||||
|
- many function headers were changed - mainly pointers were
|
||||||
|
replaced with var and const parameters
|
||||||
|
|
||||||
|
-- 0.13 -----------------------------------------------------
|
||||||
|
- added TestImagesInList function and new 0.13 functions
|
||||||
|
- images were not freed when image list was resized in ImSetImageListSize
|
||||||
|
- ImSaveMultiImageTo* recreated the input image list with size = 0
|
||||||
|
|
||||||
|
}
|
||||||
|
end.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,988 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingGif.pas 111 2007-12-02 23:25:44Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains image format loader/saver for GIF images.}
|
||||||
|
unit ImagingGif;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, Imaging, ImagingTypes, ImagingUtility;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ GIF (Graphics Interchange Format) loader/saver class. GIF was
|
||||||
|
(and is still used) popular format for storing images supporting
|
||||||
|
multiple images per file and single color transparency.
|
||||||
|
Pixel format is 8 bit indexed where each image frame can have
|
||||||
|
its own color palette. GIF uses lossless LZW compression
|
||||||
|
(patent expired few years ago).
|
||||||
|
Imaging can load and save all GIFs with all frames and supports
|
||||||
|
transparency.}
|
||||||
|
TGIFFileFormat = class(TImageFileFormat)
|
||||||
|
private
|
||||||
|
function InterlaceStep(Y, Height: Integer; var Pass: Integer): Integer;
|
||||||
|
procedure LZWDecompress(const IO: TIOFunctions; Handle: TImagingHandle;
|
||||||
|
Width, Height: Integer; Interlaced: Boolean; Data: Pointer);
|
||||||
|
procedure LZWCompress(const IO: TIOFunctions; Handle: TImagingHandle;
|
||||||
|
Width, Height, BitCount: Integer; Interlaced: Boolean; Data: Pointer);
|
||||||
|
protected
|
||||||
|
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
|
||||||
|
OnlyFirstLevel: Boolean): Boolean; override;
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
function TestFormat(Handle: TImagingHandle): Boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
SGIFFormatName = 'Graphics Interchange Format';
|
||||||
|
SGIFMasks = '*.gif';
|
||||||
|
GIFSupportedFormats: TImageFormats = [ifIndex8];
|
||||||
|
|
||||||
|
type
|
||||||
|
TGIFVersion = (gv87, gv89);
|
||||||
|
TDisposalMethod = (dmUndefined, dmLeave, dmRestoreBackground,
|
||||||
|
dmRestorePrevious, dmReserved4, dmReserved5, dmReserved6, dmReserved7);
|
||||||
|
|
||||||
|
const
|
||||||
|
GIFSignature: TChar3 = 'GIF';
|
||||||
|
GIFVersions: array[TGIFVersion] of TChar3 = ('87a', '89a');
|
||||||
|
|
||||||
|
// Masks for accessing fields in PackedFields of TGIFHeader
|
||||||
|
GIFGlobalColorTable = $80;
|
||||||
|
GIFColorResolution = $70;
|
||||||
|
GIFColorTableSorted = $08;
|
||||||
|
GIFColorTableSize = $07;
|
||||||
|
|
||||||
|
// Masks for accessing fields in PackedFields of TImageDescriptor
|
||||||
|
GIFLocalColorTable = $80;
|
||||||
|
GIFInterlaced = $40;
|
||||||
|
GIFLocalTableSorted = $20;
|
||||||
|
|
||||||
|
// Block identifiers
|
||||||
|
GIFPlainText: Byte = $01;
|
||||||
|
GIFGraphicControlExtension: Byte = $F9;
|
||||||
|
GIFCommentExtension: Byte = $FE;
|
||||||
|
GIFApplicationExtension: Byte = $FF;
|
||||||
|
GIFImageDescriptor: Byte = Ord(',');
|
||||||
|
GIFExtensionIntroducer: Byte = Ord('!');
|
||||||
|
GIFTrailer: Byte = Ord(';');
|
||||||
|
GIFBlockTerminator: Byte = $00;
|
||||||
|
|
||||||
|
// Masks for accessing fields in PackedFields of TGraphicControlExtension
|
||||||
|
GIFTransparent = $01;
|
||||||
|
GIFUserInput = $02;
|
||||||
|
GIFDisposalMethod = $1C;
|
||||||
|
|
||||||
|
type
|
||||||
|
TGIFHeader = packed record
|
||||||
|
// File header part
|
||||||
|
Signature: TChar3; // Header Signature (always "GIF")
|
||||||
|
Version: TChar3; // GIF format version("87a" or "89a")
|
||||||
|
// Logical Screen Descriptor part
|
||||||
|
ScreenWidth: Word; // Width of Display Screen in Pixels
|
||||||
|
ScreenHeight: Word; // Height of Display Screen in Pixels
|
||||||
|
PackedFields: Byte; // Screen and color map information
|
||||||
|
BackgroundColorIndex: Byte; // Background color index (in global color table)
|
||||||
|
AspectRatio: Byte; // Pixel aspect ratio, ratio = (AspectRatio + 15) / 64
|
||||||
|
end;
|
||||||
|
|
||||||
|
TImageDescriptor = packed record
|
||||||
|
//Separator: Byte; // leave that out since we always read one bye ahead
|
||||||
|
Left: Word; // X position of image with respect to logical screen
|
||||||
|
Top: Word; // Y position
|
||||||
|
Width: Word;
|
||||||
|
Height: Word;
|
||||||
|
PackedFields: Byte;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
// GIF extension labels
|
||||||
|
GIFExtTypeGraphic = $F9;
|
||||||
|
GIFExtTypePlainText = $01;
|
||||||
|
GIFExtTypeApplication = $FF;
|
||||||
|
GIFExtTypeComment = $FE;
|
||||||
|
|
||||||
|
type
|
||||||
|
TGraphicControlExtension = packed record
|
||||||
|
BlockSize: Byte;
|
||||||
|
PackedFields: Byte;
|
||||||
|
DelayTime: Word;
|
||||||
|
TransparentColorIndex: Byte;
|
||||||
|
Terminator: Byte;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
CodeTableSize = 4096;
|
||||||
|
HashTableSize = 17777;
|
||||||
|
|
||||||
|
type
|
||||||
|
TReadContext = record
|
||||||
|
Inx: Integer;
|
||||||
|
Size: Integer;
|
||||||
|
Buf: array [0..255 + 4] of Byte;
|
||||||
|
CodeSize: Integer;
|
||||||
|
ReadMask: Integer;
|
||||||
|
end;
|
||||||
|
PReadContext = ^TReadContext;
|
||||||
|
|
||||||
|
TWriteContext = record
|
||||||
|
Inx: Integer;
|
||||||
|
CodeSize: Integer;
|
||||||
|
Buf: array [0..255 + 4] of Byte;
|
||||||
|
end;
|
||||||
|
PWriteContext = ^TWriteContext;
|
||||||
|
|
||||||
|
TOutputContext = record
|
||||||
|
W: Integer;
|
||||||
|
H: Integer;
|
||||||
|
X: Integer;
|
||||||
|
Y: Integer;
|
||||||
|
BitsPerPixel: Integer;
|
||||||
|
Pass: Integer;
|
||||||
|
Interlace: Boolean;
|
||||||
|
LineIdent: Integer;
|
||||||
|
Data: Pointer;
|
||||||
|
CurrLineData: Pointer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TImageDict = record
|
||||||
|
Tail: Word;
|
||||||
|
Index: Word;
|
||||||
|
Col: Byte;
|
||||||
|
end;
|
||||||
|
PImageDict = ^TImageDict;
|
||||||
|
|
||||||
|
PIntCodeTable = ^TIntCodeTable;
|
||||||
|
TIntCodeTable = array [0..CodeTableSize - 1] of Word;
|
||||||
|
|
||||||
|
TDictTable = array [0..CodeTableSize - 1] of TImageDict;
|
||||||
|
PDictTable = ^TDictTable;
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
SGIFDecodingError = 'Error when decoding GIF LZW data';
|
||||||
|
|
||||||
|
{
|
||||||
|
TGIFFileFormat implementation
|
||||||
|
}
|
||||||
|
|
||||||
|
constructor TGIFFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SGIFFormatName;
|
||||||
|
FCanLoad := True;
|
||||||
|
FCanSave := True;
|
||||||
|
FIsMultiImageFormat := True;
|
||||||
|
FSupportedFormats := GIFSupportedFormats;
|
||||||
|
|
||||||
|
AddMasks(SGIFMasks);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGIFFileFormat.InterlaceStep(Y, Height: Integer; var Pass: Integer): Integer;
|
||||||
|
begin
|
||||||
|
Result := Y;
|
||||||
|
case Pass of
|
||||||
|
0, 1:
|
||||||
|
Inc(Result, 8);
|
||||||
|
2:
|
||||||
|
Inc(Result, 4);
|
||||||
|
3:
|
||||||
|
Inc(Result, 2);
|
||||||
|
end;
|
||||||
|
if Result >= Height then
|
||||||
|
begin
|
||||||
|
if Pass = 0 then
|
||||||
|
begin
|
||||||
|
Pass := 1;
|
||||||
|
Result := 4;
|
||||||
|
if Result < Height then
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if Pass = 1 then
|
||||||
|
begin
|
||||||
|
Pass := 2;
|
||||||
|
Result := 2;
|
||||||
|
if Result < Height then
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if Pass = 2 then
|
||||||
|
begin
|
||||||
|
Pass := 3;
|
||||||
|
Result := 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ GIF LZW decompresion code is from JVCL JvGIF.pas unit.}
|
||||||
|
procedure TGIFFileFormat.LZWDecompress(const IO: TIOFunctions; Handle: TImagingHandle; Width, Height: Integer;
|
||||||
|
Interlaced: Boolean; Data: Pointer);
|
||||||
|
var
|
||||||
|
MinCodeSize: Byte;
|
||||||
|
MaxCode, BitMask, InitCodeSize: Integer;
|
||||||
|
ClearCode, EndingCode, FirstFreeCode, FreeCode: Word;
|
||||||
|
I, OutCount, Code: Integer;
|
||||||
|
CurCode, OldCode, InCode, FinalChar: Word;
|
||||||
|
Prefix, Suffix, OutCode: PIntCodeTable;
|
||||||
|
ReadCtxt: TReadContext;
|
||||||
|
OutCtxt: TOutputContext;
|
||||||
|
TableFull: Boolean;
|
||||||
|
|
||||||
|
function ReadCode(var Context: TReadContext): Integer;
|
||||||
|
var
|
||||||
|
RawCode: Integer;
|
||||||
|
ByteIndex: Integer;
|
||||||
|
Bytes: Byte;
|
||||||
|
BytesToLose: Integer;
|
||||||
|
begin
|
||||||
|
while Context.Inx + Context.CodeSize > Context.Size do
|
||||||
|
begin
|
||||||
|
// Not enough bits in buffer - refill it - Not very efficient, but infrequently called
|
||||||
|
BytesToLose := Context.Inx shr 3;
|
||||||
|
// Note biggest Code Size is 12 bits. And this can at worst span 3 Bytes
|
||||||
|
Move(Context.Buf[Word(BytesToLose)], Context.Buf[0], 3);
|
||||||
|
Context.Inx := Context.Inx and 7;
|
||||||
|
Context.Size := Context.Size - (BytesToLose shl 3);
|
||||||
|
IO.Read(Handle, @Bytes, 1);
|
||||||
|
if Bytes > 0 then
|
||||||
|
IO.Read(Handle, @Context.Buf[Word(Context.Size shr 3)], Bytes);
|
||||||
|
Context.Size := Context.Size + (Bytes shl 3);
|
||||||
|
end;
|
||||||
|
ByteIndex := Context.Inx shr 3;
|
||||||
|
RawCode := Context.Buf[Word(ByteIndex)] +
|
||||||
|
(Word(Context.Buf[Word(ByteIndex + 1)]) shl 8);
|
||||||
|
if Context.CodeSize > 8 then
|
||||||
|
RawCode := RawCode + (Longint(Context.Buf[ByteIndex + 2]) shl 16);
|
||||||
|
RawCode := RawCode shr (Context.Inx and 7);
|
||||||
|
Context.Inx := Context.Inx + Byte(Context.CodeSize);
|
||||||
|
Result := RawCode and Context.ReadMask;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Output(Value: Byte; var Context: TOutputContext);
|
||||||
|
var
|
||||||
|
P: PByte;
|
||||||
|
begin
|
||||||
|
if Context.Y >= Context.H then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
// Only ifIndex8 supported
|
||||||
|
P := @PByteArray(Context.CurrLineData)[Context.X];
|
||||||
|
P^ := Value;
|
||||||
|
|
||||||
|
{case Context.BitsPerPixel of
|
||||||
|
1:
|
||||||
|
begin
|
||||||
|
P := @PByteArray(Context.CurrLineData)[Context.X shr 3];
|
||||||
|
if (Context.X and $07) <> 0 then
|
||||||
|
P^ := P^ or Word(Value shl (7 - (Word(Context.X and 7))))
|
||||||
|
else
|
||||||
|
P^ := Byte(Value shl 7);
|
||||||
|
end;
|
||||||
|
4:
|
||||||
|
begin
|
||||||
|
P := @PByteArray(Context.CurrLineData)[Context.X shr 1];
|
||||||
|
if (Context.X and 1) <> 0 then
|
||||||
|
P^ := P^ or Value
|
||||||
|
else
|
||||||
|
P^ := Byte(Value shl 4);
|
||||||
|
end;
|
||||||
|
8:
|
||||||
|
begin
|
||||||
|
P := @PByteArray(Context.CurrLineData)[Context.X];
|
||||||
|
P^ := Value;
|
||||||
|
end;
|
||||||
|
end;}
|
||||||
|
Inc(Context.X);
|
||||||
|
|
||||||
|
if Context.X < Context.W then
|
||||||
|
Exit;
|
||||||
|
Context.X := 0;
|
||||||
|
if Context.Interlace then
|
||||||
|
Context.Y := InterlaceStep(Context.Y, Context.H, Context.Pass)
|
||||||
|
else
|
||||||
|
Inc(Context.Y);
|
||||||
|
|
||||||
|
Context.CurrLineData := @PByteArray(Context.Data)[Context.Y * Context.LineIdent];
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
OutCount := 0;
|
||||||
|
OldCode := 0;
|
||||||
|
FinalChar := 0;
|
||||||
|
TableFull := False;
|
||||||
|
GetMem(Prefix, SizeOf(TIntCodeTable));
|
||||||
|
GetMem(Suffix, SizeOf(TIntCodeTable));
|
||||||
|
GetMem(OutCode, SizeOf(TIntCodeTable) + SizeOf(Word));
|
||||||
|
try
|
||||||
|
IO.Read(Handle, @MinCodeSize, 1);
|
||||||
|
if (MinCodeSize < 2) or (MinCodeSize > 9) then
|
||||||
|
RaiseImaging(SGIFDecodingError, []);
|
||||||
|
// Initial read context
|
||||||
|
ReadCtxt.Inx := 0;
|
||||||
|
ReadCtxt.Size := 0;
|
||||||
|
ReadCtxt.CodeSize := MinCodeSize + 1;
|
||||||
|
ReadCtxt.ReadMask := (1 shl ReadCtxt.CodeSize) - 1;
|
||||||
|
// Initialise pixel-output context
|
||||||
|
OutCtxt.X := 0;
|
||||||
|
OutCtxt.Y := 0;
|
||||||
|
OutCtxt.Pass := 0;
|
||||||
|
OutCtxt.W := Width;
|
||||||
|
OutCtxt.H := Height;
|
||||||
|
OutCtxt.BitsPerPixel := MinCodeSize;
|
||||||
|
OutCtxt.Interlace := Interlaced;
|
||||||
|
OutCtxt.LineIdent := Width;
|
||||||
|
OutCtxt.Data := Data;
|
||||||
|
OutCtxt.CurrLineData := Data;
|
||||||
|
BitMask := (1 shl OutCtxt.BitsPerPixel) - 1;
|
||||||
|
// 2 ^ MinCodeSize accounts for all colours in file
|
||||||
|
ClearCode := 1 shl MinCodeSize;
|
||||||
|
EndingCode := ClearCode + 1;
|
||||||
|
FreeCode := ClearCode + 2;
|
||||||
|
FirstFreeCode := FreeCode;
|
||||||
|
// 2^ (MinCodeSize + 1) includes clear and eoi Code and space too
|
||||||
|
InitCodeSize := ReadCtxt.CodeSize;
|
||||||
|
MaxCode := 1 shl ReadCtxt.CodeSize;
|
||||||
|
Code := ReadCode(ReadCtxt);
|
||||||
|
while (Code <> EndingCode) and (Code <> $FFFF) and
|
||||||
|
(OutCtxt.Y < OutCtxt.H) do
|
||||||
|
begin
|
||||||
|
if Code = ClearCode then
|
||||||
|
begin
|
||||||
|
ReadCtxt.CodeSize := InitCodeSize;
|
||||||
|
MaxCode := 1 shl ReadCtxt.CodeSize;
|
||||||
|
ReadCtxt.ReadMask := MaxCode - 1;
|
||||||
|
FreeCode := FirstFreeCode;
|
||||||
|
Code := ReadCode(ReadCtxt);
|
||||||
|
CurCode := Code;
|
||||||
|
OldCode := Code;
|
||||||
|
if Code = $FFFF then
|
||||||
|
Break;
|
||||||
|
FinalChar := (CurCode and BitMask);
|
||||||
|
Output(Byte(FinalChar), OutCtxt);
|
||||||
|
TableFull := False;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
CurCode := Code;
|
||||||
|
InCode := Code;
|
||||||
|
if CurCode >= FreeCode then
|
||||||
|
begin
|
||||||
|
CurCode := OldCode;
|
||||||
|
OutCode^[OutCount] := FinalChar;
|
||||||
|
Inc(OutCount);
|
||||||
|
end;
|
||||||
|
while CurCode > BitMask do
|
||||||
|
begin
|
||||||
|
if OutCount > CodeTableSize then
|
||||||
|
RaiseImaging(SGIFDecodingError, []);
|
||||||
|
OutCode^[OutCount] := Suffix^[CurCode];
|
||||||
|
Inc(OutCount);
|
||||||
|
CurCode := Prefix^[CurCode];
|
||||||
|
end;
|
||||||
|
|
||||||
|
FinalChar := CurCode and BitMask;
|
||||||
|
OutCode^[OutCount] := FinalChar;
|
||||||
|
Inc(OutCount);
|
||||||
|
for I := OutCount - 1 downto 0 do
|
||||||
|
Output(Byte(OutCode^[I]), OutCtxt);
|
||||||
|
OutCount := 0;
|
||||||
|
// Update dictionary
|
||||||
|
if not TableFull then
|
||||||
|
begin
|
||||||
|
Prefix^[FreeCode] := OldCode;
|
||||||
|
Suffix^[FreeCode] := FinalChar;
|
||||||
|
// Advance to next free slot
|
||||||
|
Inc(FreeCode);
|
||||||
|
if FreeCode >= MaxCode then
|
||||||
|
begin
|
||||||
|
if ReadCtxt.CodeSize < 12 then
|
||||||
|
begin
|
||||||
|
Inc(ReadCtxt.CodeSize);
|
||||||
|
MaxCode := MaxCode shl 1;
|
||||||
|
ReadCtxt.ReadMask := (1 shl ReadCtxt.CodeSize) - 1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
TableFull := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
OldCode := InCode;
|
||||||
|
end;
|
||||||
|
Code := ReadCode(ReadCtxt);
|
||||||
|
end;
|
||||||
|
if Code = $FFFF then
|
||||||
|
RaiseImaging(SGIFDecodingError, []);
|
||||||
|
finally
|
||||||
|
FreeMem(Prefix);
|
||||||
|
FreeMem(OutCode);
|
||||||
|
FreeMem(Suffix);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ GIF LZW compresion code is from JVCL JvGIF.pas unit.}
|
||||||
|
procedure TGIFFileFormat.LZWCompress(const IO: TIOFunctions; Handle: TImagingHandle; Width, Height, BitCount: Integer;
|
||||||
|
Interlaced: Boolean; Data: Pointer);
|
||||||
|
var
|
||||||
|
LineIdent: Integer;
|
||||||
|
MinCodeSize, Col: Byte;
|
||||||
|
InitCodeSize, X, Y: Integer;
|
||||||
|
Pass: Integer;
|
||||||
|
MaxCode: Integer; { 1 shl CodeSize }
|
||||||
|
ClearCode, EndingCode, LastCode, Tail: Integer;
|
||||||
|
I, HashValue: Integer;
|
||||||
|
LenString: Word;
|
||||||
|
Dict: PDictTable;
|
||||||
|
HashTable: TList;
|
||||||
|
PData: PByte;
|
||||||
|
WriteCtxt: TWriteContext;
|
||||||
|
|
||||||
|
function InitHash(P: Integer): Integer;
|
||||||
|
begin
|
||||||
|
Result := (P + 3) * 301;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure WriteCode(Code: Integer; var Context: TWriteContext);
|
||||||
|
var
|
||||||
|
BufIndex: Integer;
|
||||||
|
Bytes: Byte;
|
||||||
|
begin
|
||||||
|
BufIndex := Context.Inx shr 3;
|
||||||
|
Code := Code shl (Context.Inx and 7);
|
||||||
|
Context.Buf[BufIndex] := Context.Buf[BufIndex] or Byte(Code);
|
||||||
|
Context.Buf[BufIndex + 1] := Byte(Code shr 8);
|
||||||
|
Context.Buf[BufIndex + 2] := Byte(Code shr 16);
|
||||||
|
Context.Inx := Context.Inx + Context.CodeSize;
|
||||||
|
if Context.Inx >= 255 * 8 then
|
||||||
|
begin
|
||||||
|
// Flush out full buffer
|
||||||
|
Bytes := 255;
|
||||||
|
IO.Write(Handle, @Bytes, 1);
|
||||||
|
IO.Write(Handle, @Context.Buf, Bytes);
|
||||||
|
Move(Context.Buf[255], Context.Buf[0], 2);
|
||||||
|
FillChar(Context.Buf[2], 255, 0);
|
||||||
|
Context.Inx := Context.Inx - (255 * 8);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FlushCode(var Context: TWriteContext);
|
||||||
|
var
|
||||||
|
Bytes: Byte;
|
||||||
|
begin
|
||||||
|
Bytes := (Context.Inx + 7) shr 3;
|
||||||
|
if Bytes > 0 then
|
||||||
|
begin
|
||||||
|
IO.Write(Handle, @Bytes, 1);
|
||||||
|
IO.Write(Handle, @Context.Buf, Bytes);
|
||||||
|
end;
|
||||||
|
// Data block terminator - a block of zero Size
|
||||||
|
Bytes := 0;
|
||||||
|
IO.Write(Handle, @Bytes, 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
LineIdent := Width;
|
||||||
|
Tail := 0;
|
||||||
|
HashValue := 0;
|
||||||
|
Col := 0;
|
||||||
|
HashTable := TList.Create;
|
||||||
|
GetMem(Dict, SizeOf(TDictTable));
|
||||||
|
try
|
||||||
|
for I := 0 to HashTableSize - 1 do
|
||||||
|
HashTable.Add(nil);
|
||||||
|
|
||||||
|
// Initialise encoder variables
|
||||||
|
InitCodeSize := BitCount + 1;
|
||||||
|
if InitCodeSize = 2 then
|
||||||
|
Inc(InitCodeSize);
|
||||||
|
MinCodeSize := InitCodeSize - 1;
|
||||||
|
IO.Write(Handle, @MinCodeSize, 1);
|
||||||
|
ClearCode := 1 shl MinCodeSize;
|
||||||
|
EndingCode := ClearCode + 1;
|
||||||
|
LastCode := EndingCode;
|
||||||
|
MaxCode := 1 shl InitCodeSize;
|
||||||
|
LenString := 0;
|
||||||
|
// Setup write context
|
||||||
|
WriteCtxt.Inx := 0;
|
||||||
|
WriteCtxt.CodeSize := InitCodeSize;
|
||||||
|
FillChar(WriteCtxt.Buf, SizeOf(WriteCtxt.Buf), 0);
|
||||||
|
WriteCode(ClearCode, WriteCtxt);
|
||||||
|
Y := 0;
|
||||||
|
Pass := 0;
|
||||||
|
|
||||||
|
while Y < Height do
|
||||||
|
begin
|
||||||
|
PData := @PByteArray(Data)[Y * LineIdent];
|
||||||
|
for X := 0 to Width - 1 do
|
||||||
|
begin
|
||||||
|
// Only ifIndex8 support
|
||||||
|
case BitCount of
|
||||||
|
8:
|
||||||
|
begin
|
||||||
|
Col := PData^;
|
||||||
|
PData := @PByteArray(PData)[1];
|
||||||
|
end;
|
||||||
|
{4:
|
||||||
|
begin
|
||||||
|
if X and 1 <> 0 then
|
||||||
|
begin
|
||||||
|
Col := PData^ and $0F;
|
||||||
|
PData := @PByteArray(PData)[1];
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Col := PData^ shr 4;
|
||||||
|
end;
|
||||||
|
1:
|
||||||
|
begin
|
||||||
|
if X and 7 = 7 then
|
||||||
|
begin
|
||||||
|
Col := PData^ and 1;
|
||||||
|
PData := @PByteArray(PData)[1];
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Col := (PData^ shr (7 - (X and $07))) and $01;
|
||||||
|
end;}
|
||||||
|
end;
|
||||||
|
Inc(LenString);
|
||||||
|
if LenString = 1 then
|
||||||
|
begin
|
||||||
|
Tail := Col;
|
||||||
|
HashValue := InitHash(Col);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
HashValue := HashValue * (Col + LenString + 4);
|
||||||
|
I := HashValue mod HashTableSize;
|
||||||
|
HashValue := HashValue mod HashTableSize;
|
||||||
|
while (HashTable[I] <> nil) and
|
||||||
|
((PImageDict(HashTable[I])^.Tail <> Tail) or
|
||||||
|
(PImageDict(HashTable[I])^.Col <> Col)) do
|
||||||
|
begin
|
||||||
|
Inc(I);
|
||||||
|
if I >= HashTableSize then
|
||||||
|
I := 0;
|
||||||
|
end;
|
||||||
|
if HashTable[I] <> nil then // Found in the strings table
|
||||||
|
Tail := PImageDict(HashTable[I])^.Index
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Not found
|
||||||
|
WriteCode(Tail, WriteCtxt);
|
||||||
|
Inc(LastCode);
|
||||||
|
HashTable[I] := @Dict^[LastCode];
|
||||||
|
PImageDict(HashTable[I])^.Index := LastCode;
|
||||||
|
PImageDict(HashTable[I])^.Tail := Tail;
|
||||||
|
PImageDict(HashTable[I])^.Col := Col;
|
||||||
|
Tail := Col;
|
||||||
|
HashValue := InitHash(Col);
|
||||||
|
LenString := 1;
|
||||||
|
if LastCode >= MaxCode then
|
||||||
|
begin
|
||||||
|
// Next Code will be written longer
|
||||||
|
MaxCode := MaxCode shl 1;
|
||||||
|
Inc(WriteCtxt.CodeSize);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if LastCode >= CodeTableSize - 2 then
|
||||||
|
begin
|
||||||
|
// Reset tables
|
||||||
|
WriteCode(Tail, WriteCtxt);
|
||||||
|
WriteCode(ClearCode, WriteCtxt);
|
||||||
|
LenString := 0;
|
||||||
|
LastCode := EndingCode;
|
||||||
|
WriteCtxt.CodeSize := InitCodeSize;
|
||||||
|
MaxCode := 1 shl InitCodeSize;
|
||||||
|
for I := 0 to HashTableSize - 1 do
|
||||||
|
HashTable[I] := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if Interlaced then
|
||||||
|
Y := InterlaceStep(Y, Height, Pass)
|
||||||
|
else
|
||||||
|
Inc(Y);
|
||||||
|
end;
|
||||||
|
WriteCode(Tail, WriteCtxt);
|
||||||
|
WriteCode(EndingCode, WriteCtxt);
|
||||||
|
FlushCode(WriteCtxt);
|
||||||
|
finally
|
||||||
|
HashTable.Free;
|
||||||
|
FreeMem(Dict);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGIFFileFormat.LoadData(Handle: TImagingHandle;
|
||||||
|
var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
Header: TGIFHeader;
|
||||||
|
HasGlobalPal: Boolean;
|
||||||
|
GlobalPalLength: Integer;
|
||||||
|
GlobalPal: TPalette32Size256;
|
||||||
|
I: Integer;
|
||||||
|
BlockID: Byte;
|
||||||
|
HasGraphicExt: Boolean;
|
||||||
|
GraphicExt: TGraphicControlExtension;
|
||||||
|
Disposals: array of TDisposalMethod;
|
||||||
|
|
||||||
|
function ReadBlockID: Byte;
|
||||||
|
begin
|
||||||
|
Result := GIFTrailer;
|
||||||
|
GetIO.Read(Handle, @Result, SizeOf(Result));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ReadExtensions;
|
||||||
|
var
|
||||||
|
BlockSize, ExtType: Byte;
|
||||||
|
begin
|
||||||
|
HasGraphicExt := False;
|
||||||
|
|
||||||
|
// Read extensions until image descriptor is found. Only graphic extension
|
||||||
|
// is stored now (for transparency), others are skipped.
|
||||||
|
while BlockID = GIFExtensionIntroducer do
|
||||||
|
with GetIO do
|
||||||
|
begin
|
||||||
|
Read(Handle, @ExtType, SizeOf(ExtType));
|
||||||
|
|
||||||
|
if ExtType = GIFGraphicControlExtension then
|
||||||
|
begin
|
||||||
|
HasGraphicExt := True;
|
||||||
|
Read(Handle, @GraphicExt, SizeOf(GraphicExt));
|
||||||
|
end
|
||||||
|
else if ExtType in [GIFCommentExtension, GIFApplicationExtension, GIFPlainText] then
|
||||||
|
repeat
|
||||||
|
// Read block sizes and skip them
|
||||||
|
Read(Handle, @BlockSize, SizeOf(BlockSize));
|
||||||
|
Seek(Handle, BlockSize, smFromCurrent);
|
||||||
|
until BlockSize = 0;
|
||||||
|
|
||||||
|
// Read ID of following block
|
||||||
|
BlockID := ReadBlockID;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure CopyFrameTransparent(const Image, Frame: TImageData; Left, Top, TransIndex: Integer);
|
||||||
|
var
|
||||||
|
X, Y: Integer;
|
||||||
|
Src, Dst: PByte;
|
||||||
|
begin
|
||||||
|
Src := Frame.Bits;
|
||||||
|
|
||||||
|
// Copy all pixels from frame to log screen but ignore the transparent ones
|
||||||
|
for Y := 0 to Frame.Height - 1 do
|
||||||
|
begin
|
||||||
|
Dst := @PByteArray(Image.Bits)[(Top + Y) * Image.Width + Left];
|
||||||
|
for X := 0 to Frame.Width - 1 do
|
||||||
|
begin
|
||||||
|
if Src^ <> TransIndex then
|
||||||
|
Dst^ := Src^;
|
||||||
|
Inc(Src);
|
||||||
|
Inc(Dst);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ReadFrame;
|
||||||
|
var
|
||||||
|
ImageDesc: TImageDescriptor;
|
||||||
|
HasLocalPal, Interlaced, HasTransparency: Boolean;
|
||||||
|
I, Idx, LocalPalLength, TransIndex: Integer;
|
||||||
|
LocalPal: TPalette32Size256;
|
||||||
|
BlockTerm: Byte;
|
||||||
|
Frame: TImageData;
|
||||||
|
begin
|
||||||
|
Idx := Length(Images);
|
||||||
|
SetLength(Images, Idx + 1);
|
||||||
|
FillChar(LocalPal, SizeOf(LocalPal), 0);
|
||||||
|
with GetIO do
|
||||||
|
begin
|
||||||
|
// Read and parse image descriptor
|
||||||
|
Read(Handle, @ImageDesc, SizeOf(ImageDesc));
|
||||||
|
HasLocalPal := (ImageDesc.PackedFields and GIFLocalColorTable) = GIFLocalColorTable;
|
||||||
|
Interlaced := (ImageDesc.PackedFields and GIFInterlaced) = GIFInterlaced;
|
||||||
|
LocalPalLength := ImageDesc.PackedFields and GIFColorTableSize;
|
||||||
|
LocalPalLength := 1 shl (LocalPalLength + 1); // Total pal length is 2^(n+1)
|
||||||
|
|
||||||
|
// Create new logical screen
|
||||||
|
NewImage(Header.ScreenWidth, Header.ScreenHeight, ifIndex8, Images[Idx]);
|
||||||
|
// Create new image for this frame which would be later pasted onto logical screen
|
||||||
|
InitImage(Frame);
|
||||||
|
NewImage(ImageDesc.Width, ImageDesc.Height, ifIndex8, Frame);
|
||||||
|
|
||||||
|
// Load local palette if there is any
|
||||||
|
if HasLocalPal then
|
||||||
|
for I := 0 to LocalPalLength - 1 do
|
||||||
|
begin
|
||||||
|
LocalPal[I].A := 255;
|
||||||
|
Read(Handle, @LocalPal[I].R, SizeOf(LocalPal[I].R));
|
||||||
|
Read(Handle, @LocalPal[I].G, SizeOf(LocalPal[I].G));
|
||||||
|
Read(Handle, @LocalPal[I].B, SizeOf(LocalPal[I].B));
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Use local pal if present or global pal if present or create
|
||||||
|
// default pal if neither of them is present
|
||||||
|
if HasLocalPal then
|
||||||
|
Move(LocalPal, Images[Idx].Palette^, SizeOf(LocalPal))
|
||||||
|
else if HasGlobalPal then
|
||||||
|
Move(GlobalPal, Images[Idx].Palette^, SizeOf(GlobalPal))
|
||||||
|
else
|
||||||
|
FillCustomPalette(Images[Idx].Palette, GlobalPalLength, 3, 3, 2);
|
||||||
|
|
||||||
|
// Add default disposal method for this frame
|
||||||
|
SetLength(Disposals, Length(Disposals) + 1);
|
||||||
|
Disposals[High(Disposals)] := dmUndefined;
|
||||||
|
|
||||||
|
// If Grahic Control Extension is present make use of it
|
||||||
|
if HasGraphicExt then
|
||||||
|
begin
|
||||||
|
HasTransparency := (GraphicExt.PackedFields and GIFTransparent) = GIFTransparent;
|
||||||
|
Disposals[High(Disposals)] := TDisposalMethod((GraphicExt.PackedFields and GIFDisposalMethod) shr 2);
|
||||||
|
if HasTransparency then
|
||||||
|
Images[Idx].Palette[GraphicExt.TransparentColorIndex].A := 0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
HasTransparency := False;
|
||||||
|
|
||||||
|
if Idx >= 1 then
|
||||||
|
begin
|
||||||
|
// If previous frame had some special disposal method we take it into
|
||||||
|
// account now
|
||||||
|
case Disposals[Idx - 1] of
|
||||||
|
dmUndefined: ; // Do nothing
|
||||||
|
dmLeave:
|
||||||
|
begin
|
||||||
|
// Leave previous frame on log screen
|
||||||
|
CopyRect(Images[Idx - 1], 0, 0, Images[Idx].Width,
|
||||||
|
Images[Idx].Height, Images[Idx], 0, 0);
|
||||||
|
end;
|
||||||
|
dmRestoreBackground:
|
||||||
|
begin
|
||||||
|
// Clear log screen with background color
|
||||||
|
FillRect(Images[Idx], 0, 0, Images[Idx].Width, Images[Idx].Height,
|
||||||
|
@Header.BackgroundColorIndex);
|
||||||
|
end;
|
||||||
|
dmRestorePrevious:
|
||||||
|
if Idx >= 2 then
|
||||||
|
begin
|
||||||
|
// Set log screen to "previous of previous" frame
|
||||||
|
CopyRect(Images[Idx - 2], 0, 0, Images[Idx].Width,
|
||||||
|
Images[Idx].Height, Images[Idx], 0, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// First frame - just fill with background color
|
||||||
|
FillRect(Images[Idx], 0, 0, Images[Idx].Width, Images[Idx].Height,
|
||||||
|
@Header.BackgroundColorIndex);
|
||||||
|
end;
|
||||||
|
|
||||||
|
try
|
||||||
|
// Data decompression finally
|
||||||
|
LZWDecompress(GetIO, Handle, ImageDesc.Width, ImageDesc.Height, Interlaced, Frame.Bits);
|
||||||
|
Read(Handle, @BlockTerm, SizeOf(BlockTerm));
|
||||||
|
// Now copy frame to logical screen with skipping of transparent pixels (if enabled)
|
||||||
|
TransIndex := Iff(HasTransparency, GraphicExt.TransparentColorIndex, MaxInt);
|
||||||
|
CopyFrameTransparent(Images[Idx], Frame, ImageDesc.Left, ImageDesc.Top, TransIndex);
|
||||||
|
finally
|
||||||
|
FreeImage(Frame);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
SetLength(Images, 0);
|
||||||
|
FillChar(GlobalPal, SizeOf(GlobalPal), 0);
|
||||||
|
with GetIO do
|
||||||
|
begin
|
||||||
|
// Read GIF header
|
||||||
|
Read(Handle, @Header, SizeOf(Header));
|
||||||
|
HasGlobalPal := Header.PackedFields and GIFGlobalColorTable = GIFGlobalColorTable; // Bit 7
|
||||||
|
GlobalPalLength := Header.PackedFields and GIFColorTableSize; // Bits 0-2
|
||||||
|
GlobalPalLength := 1 shl (GlobalPalLength + 1); // Total pal length is 2^(n+1)
|
||||||
|
|
||||||
|
// Read global palette from file if present
|
||||||
|
if HasGlobalPal then
|
||||||
|
begin
|
||||||
|
for I := 0 to GlobalPalLength - 1 do
|
||||||
|
begin
|
||||||
|
GlobalPal[I].A := 255;
|
||||||
|
Read(Handle, @GlobalPal[I].R, SizeOf(GlobalPal[I].R));
|
||||||
|
Read(Handle, @GlobalPal[I].G, SizeOf(GlobalPal[I].G));
|
||||||
|
Read(Handle, @GlobalPal[I].B, SizeOf(GlobalPal[I].B));
|
||||||
|
end;
|
||||||
|
GlobalPal[Header.BackgroundColorIndex].A := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Read ID of the first block
|
||||||
|
BlockID := ReadBlockID;
|
||||||
|
|
||||||
|
// Now read all data blocks in the file until file trailer is reached
|
||||||
|
while BlockID <> GIFTrailer do
|
||||||
|
begin
|
||||||
|
// Read supported and skip unsupported extensions
|
||||||
|
ReadExtensions;
|
||||||
|
// If image frame is found read it
|
||||||
|
if BlockID = GIFImageDescriptor then
|
||||||
|
ReadFrame;
|
||||||
|
// Read next block's ID
|
||||||
|
BlockID := ReadBlockID;
|
||||||
|
// If block ID is unknown set it to end-of-GIF marker
|
||||||
|
if not (BlockID in [GIFExtensionIntroducer, GIFTrailer, GIFImageDescriptor]) then
|
||||||
|
BlockID := GIFTrailer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGIFFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: Integer): Boolean;
|
||||||
|
var
|
||||||
|
Header: TGIFHeader;
|
||||||
|
ImageDesc: TImageDescriptor;
|
||||||
|
ImageToSave: TImageData;
|
||||||
|
MustBeFreed: Boolean;
|
||||||
|
I, J: Integer;
|
||||||
|
GraphicExt: TGraphicControlExtension;
|
||||||
|
|
||||||
|
procedure FindMaxDimensions(var MaxWidth, MaxHeight: Word);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
MaxWidth := Images[FFirstIdx].Width;
|
||||||
|
MaxHeight := Images[FFirstIdx].Height;
|
||||||
|
|
||||||
|
for I := FFirstIdx + 1 to FLastIdx do
|
||||||
|
begin
|
||||||
|
MaxWidth := Iff(Images[I].Width > MaxWidth, Images[I].Width, MaxWidth);
|
||||||
|
MaxHeight := Iff(Images[I].Height > MaxWidth, Images[I].Height, MaxHeight);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// Fill header with data, select size of largest image in array as
|
||||||
|
// logical screen size
|
||||||
|
FillChar(Header, Sizeof(Header), 0);
|
||||||
|
Header.Signature := GIFSignature;
|
||||||
|
Header.Version := GIFVersions[gv89];
|
||||||
|
FindMaxDimensions(Header.ScreenWidth, Header.ScreenHeight);
|
||||||
|
Header.PackedFields := GIFColorResolution; // Color resolution is 256
|
||||||
|
GetIO.Write(Handle, @Header, SizeOf(Header));
|
||||||
|
|
||||||
|
// Prepare default GC extension with delay
|
||||||
|
FillChar(GraphicExt, Sizeof(GraphicExt), 0);
|
||||||
|
GraphicExt.DelayTime := 65;
|
||||||
|
GraphicExt.BlockSize := 4;
|
||||||
|
|
||||||
|
for I := FFirstIdx to FLastIdx do
|
||||||
|
begin
|
||||||
|
if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then
|
||||||
|
with GetIO, ImageToSave do
|
||||||
|
try
|
||||||
|
// Write Graphic Control Extension with default delay
|
||||||
|
Write(Handle, @GIFExtensionIntroducer, SizeOf(GIFExtensionIntroducer));
|
||||||
|
Write(Handle, @GIFGraphicControlExtension, SizeOf(GIFGraphicControlExtension));
|
||||||
|
Write(Handle, @GraphicExt, SizeOf(GraphicExt));
|
||||||
|
// Write frame marker and fill and write image descriptor for this frame
|
||||||
|
Write(Handle, @GIFImageDescriptor, SizeOf(GIFImageDescriptor));
|
||||||
|
FillChar(ImageDesc, Sizeof(ImageDesc), 0);
|
||||||
|
ImageDesc.Width := Width;
|
||||||
|
ImageDesc.Height := Height;
|
||||||
|
ImageDesc.PackedFields := GIFLocalColorTable or GIFColorTableSize; // Use lccal color table with 256 entries
|
||||||
|
Write(Handle, @ImageDesc, SizeOf(ImageDesc));
|
||||||
|
|
||||||
|
// Write local color table for each frame
|
||||||
|
for J := 0 to 255 do
|
||||||
|
begin
|
||||||
|
Write(Handle, @Palette[J].R, SizeOf(Palette[J].R));
|
||||||
|
Write(Handle, @Palette[J].G, SizeOf(Palette[J].G));
|
||||||
|
Write(Handle, @Palette[J].B, SizeOf(Palette[J].B));
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Fonally compress image data
|
||||||
|
LZWCompress(GetIO, Handle, Width, Height, 8, False, Bits);
|
||||||
|
|
||||||
|
finally
|
||||||
|
if MustBeFreed then
|
||||||
|
FreeImage(ImageToSave);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
GetIO.Write(Handle, @GIFTrailer, SizeOf(GIFTrailer));
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TGIFFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
begin
|
||||||
|
ConvertImage(Image, ifIndex8);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TGIFFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
|
||||||
|
var
|
||||||
|
Header: TGIFHeader;
|
||||||
|
ReadCount: LongInt;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if Handle <> nil then
|
||||||
|
begin
|
||||||
|
ReadCount := GetIO.Read(Handle, @Header, SizeOf(Header));
|
||||||
|
GetIO.Seek(Handle, -ReadCount, smFromCurrent);
|
||||||
|
Result := (ReadCount >= SizeOf(Header)) and
|
||||||
|
(Header.Signature = GIFSignature) and
|
||||||
|
((Header.Version = GIFVersions[gv87]) or (Header.Version = GIFVersions[gv89]));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterImageFileFormat(TGIFFileFormat);
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
|
||||||
|
-- 0.24.1 Changes/Bug Fixes ---------------------------------
|
||||||
|
- Made backround color transparent by default (alpha = 0).
|
||||||
|
|
||||||
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Fixed other loading bugs (local pal size, transparency).
|
||||||
|
- Added GIF saving.
|
||||||
|
- Fixed bug when loading multiframe GIFs and implemented few animation
|
||||||
|
features (disposal methods, ...).
|
||||||
|
- Loading of GIFs working.
|
||||||
|
- Unit created with initial stuff!
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,574 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingIO.pas 100 2007-06-28 21:09:52Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains default IO functions for reading from/writting to
|
||||||
|
files, streams and memory.}
|
||||||
|
unit ImagingIO;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, ImagingTypes, Imaging, ImagingUtility;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMemoryIORec = record
|
||||||
|
Data: ImagingUtility.PByteArray;
|
||||||
|
Position: LongInt;
|
||||||
|
Size: LongInt;
|
||||||
|
end;
|
||||||
|
PMemoryIORec = ^TMemoryIORec;
|
||||||
|
|
||||||
|
var
|
||||||
|
OriginalFileIO: TIOFunctions;
|
||||||
|
FileIO: TIOFunctions;
|
||||||
|
StreamIO: TIOFunctions;
|
||||||
|
MemoryIO: TIOFunctions;
|
||||||
|
|
||||||
|
{ Helper function that returns size of input (from current position to the end)
|
||||||
|
represented by Handle (and opened and operated on by members of IOFunctions).}
|
||||||
|
function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt;
|
||||||
|
{ Helper function that initializes TMemoryIORec with given params.}
|
||||||
|
function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
DefaultBufferSize = 16 * 1024;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Based on TaaBufferedStream
|
||||||
|
Copyright (c) Julian M Bucknall 1997, 1999 }
|
||||||
|
TBufferedStream = class(TObject)
|
||||||
|
private
|
||||||
|
FBuffer: PByteArray;
|
||||||
|
FBufSize: Integer;
|
||||||
|
FBufStart: Integer;
|
||||||
|
FBufPos: Integer;
|
||||||
|
FBytesInBuf: Integer;
|
||||||
|
FSize: Integer;
|
||||||
|
FDirty: Boolean;
|
||||||
|
FStream: TStream;
|
||||||
|
function GetPosition: Integer;
|
||||||
|
function GetSize: Integer;
|
||||||
|
procedure ReadBuffer;
|
||||||
|
procedure WriteBuffer;
|
||||||
|
procedure SetPosition(const Value: Integer);
|
||||||
|
public
|
||||||
|
constructor Create(AStream: TStream);
|
||||||
|
destructor Destroy; override;
|
||||||
|
function Read(var Buffer; Count: Integer): Integer;
|
||||||
|
function Write(const Buffer; Count: Integer): Integer;
|
||||||
|
function Seek(Offset: Integer; Origin: Word): Integer;
|
||||||
|
procedure Commit;
|
||||||
|
property Stream: TStream read FStream;
|
||||||
|
property Position: Integer read GetPosition write SetPosition;
|
||||||
|
property Size: Integer read GetSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TBufferedStream.Create(AStream: TStream);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FStream := AStream;
|
||||||
|
FBufSize := DefaultBufferSize;
|
||||||
|
GetMem(FBuffer, FBufSize);
|
||||||
|
FBufPos := 0;
|
||||||
|
FBytesInBuf := 0;
|
||||||
|
FBufStart := 0;
|
||||||
|
FDirty := False;
|
||||||
|
FSize := AStream.Size;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TBufferedStream.Destroy;
|
||||||
|
begin
|
||||||
|
if FBuffer <> nil then
|
||||||
|
begin
|
||||||
|
Commit;
|
||||||
|
FreeMem(FBuffer);
|
||||||
|
end;
|
||||||
|
FStream.Position := Position; // Make sure source stream has right position
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedStream.GetPosition: Integer;
|
||||||
|
begin
|
||||||
|
Result := FBufStart + FBufPos;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedStream.SetPosition(const Value: Integer);
|
||||||
|
begin
|
||||||
|
Seek(Value, soFromCurrent);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedStream.GetSize: Integer;
|
||||||
|
begin
|
||||||
|
Result := FSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedStream.ReadBuffer;
|
||||||
|
var
|
||||||
|
SeekResult: Integer;
|
||||||
|
begin
|
||||||
|
SeekResult := FStream.Seek(FBufStart, 0);
|
||||||
|
if SeekResult = -1 then
|
||||||
|
raise Exception.Create('TBufferedStream.ReadBuffer: seek failed');
|
||||||
|
FBytesInBuf := FStream.Read(FBuffer^, FBufSize);
|
||||||
|
if FBytesInBuf <= 0 then
|
||||||
|
raise Exception.Create('TBufferedStream.ReadBuffer: read failed');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedStream.WriteBuffer;
|
||||||
|
var
|
||||||
|
SeekResult: Integer;
|
||||||
|
BytesWritten: Integer;
|
||||||
|
begin
|
||||||
|
SeekResult := FStream.Seek(FBufStart, 0);
|
||||||
|
if SeekResult = -1 then
|
||||||
|
raise Exception.Create('TBufferedStream.WriteBuffer: seek failed');
|
||||||
|
BytesWritten := FStream.Write(FBuffer^, FBytesInBuf);
|
||||||
|
if BytesWritten <> FBytesInBuf then
|
||||||
|
raise Exception.Create('TBufferedStream.WriteBuffer: write failed');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBufferedStream.Commit;
|
||||||
|
begin
|
||||||
|
if FDirty then
|
||||||
|
begin
|
||||||
|
WriteBuffer;
|
||||||
|
FDirty := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedStream.Read(var Buffer; Count: Integer): Integer;
|
||||||
|
var
|
||||||
|
BufAsBytes : TByteArray absolute Buffer;
|
||||||
|
BufIdx, BytesToGo, BytesToRead: Integer;
|
||||||
|
begin
|
||||||
|
// Calculate the actual number of bytes we can read - this depends on
|
||||||
|
// the current position and size of the stream as well as the number
|
||||||
|
// of bytes requested.
|
||||||
|
BytesToGo := Count;
|
||||||
|
if FSize < (FBufStart + FBufPos + Count) then
|
||||||
|
BytesToGo := FSize - (FBufStart + FBufPos);
|
||||||
|
|
||||||
|
if BytesToGo <= 0 then
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
// Remember to return the result of our calculation
|
||||||
|
Result := BytesToGo;
|
||||||
|
|
||||||
|
BufIdx := 0;
|
||||||
|
if FBytesInBuf = 0 then
|
||||||
|
ReadBuffer;
|
||||||
|
// Calculate the number of bytes we can read prior to the loop
|
||||||
|
BytesToRead := FBytesInBuf - FBufPos;
|
||||||
|
if BytesToRead > BytesToGo then
|
||||||
|
BytesToRead := BytesToGo;
|
||||||
|
// Copy from the stream buffer to the caller's buffer
|
||||||
|
Move(FBuffer^[FBufPos], BufAsBytes[BufIdx], BytesToRead);
|
||||||
|
// Calculate the number of bytes still to read}
|
||||||
|
Dec(BytesToGo, BytesToRead);
|
||||||
|
|
||||||
|
// while we have bytes to read, read them
|
||||||
|
while BytesToGo > 0 do
|
||||||
|
begin
|
||||||
|
Inc(BufIdx, BytesToRead);
|
||||||
|
// As we've exhausted this buffer-full, advance to the next, check
|
||||||
|
// to see whether we need to write the buffer out first
|
||||||
|
if FDirty then
|
||||||
|
begin
|
||||||
|
WriteBuffer;
|
||||||
|
FDirty := false;
|
||||||
|
end;
|
||||||
|
Inc(FBufStart, FBufSize);
|
||||||
|
FBufPos := 0;
|
||||||
|
ReadBuffer;
|
||||||
|
// Calculate the number of bytes we can read in this cycle
|
||||||
|
BytesToRead := FBytesInBuf;
|
||||||
|
if BytesToRead > BytesToGo then
|
||||||
|
BytesToRead := BytesToGo;
|
||||||
|
// Ccopy from the stream buffer to the caller's buffer
|
||||||
|
Move(FBuffer^, BufAsBytes[BufIdx], BytesToRead);
|
||||||
|
// Calculate the number of bytes still to read
|
||||||
|
Dec(BytesToGo, BytesToRead);
|
||||||
|
end;
|
||||||
|
// Remember our new position
|
||||||
|
Inc(FBufPos, BytesToRead);
|
||||||
|
if FBufPos = FBufSize then
|
||||||
|
begin
|
||||||
|
Inc(FBufStart, FBufSize);
|
||||||
|
FBufPos := 0;
|
||||||
|
FBytesInBuf := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedStream.Seek(Offset: Integer; Origin: Word): Integer;
|
||||||
|
var
|
||||||
|
NewBufStart, NewPos: Integer;
|
||||||
|
begin
|
||||||
|
// Calculate the new position
|
||||||
|
case Origin of
|
||||||
|
soFromBeginning : NewPos := Offset;
|
||||||
|
soFromCurrent : NewPos := FBufStart + FBufPos + Offset;
|
||||||
|
soFromEnd : NewPos := FSize + Offset;
|
||||||
|
else
|
||||||
|
raise Exception.Create('TBufferedStream.Seek: invalid origin');
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (NewPos < 0) or (NewPos > FSize) then
|
||||||
|
begin
|
||||||
|
//NewPos := ClampInt(NewPos, 0, FSize); don't do this - for writing
|
||||||
|
end;
|
||||||
|
// Calculate which page of the file we need to be at
|
||||||
|
NewBufStart := NewPos and not Pred(FBufSize);
|
||||||
|
// If the new page is different than the old, mark the buffer as being
|
||||||
|
// ready to be replenished, and if need be write out any dirty data
|
||||||
|
if NewBufStart <> FBufStart then
|
||||||
|
begin
|
||||||
|
if FDirty then
|
||||||
|
begin
|
||||||
|
WriteBuffer;
|
||||||
|
FDirty := False;
|
||||||
|
end;
|
||||||
|
FBufStart := NewBufStart;
|
||||||
|
FBytesInBuf := 0;
|
||||||
|
end;
|
||||||
|
// Save the new position
|
||||||
|
FBufPos := NewPos - NewBufStart;
|
||||||
|
Result := NewPos;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBufferedStream.Write(const Buffer; Count: Integer): Integer;
|
||||||
|
var
|
||||||
|
BufAsBytes: TByteArray absolute Buffer;
|
||||||
|
BufIdx, BytesToGo, BytesToWrite: Integer;
|
||||||
|
begin
|
||||||
|
// When we write to this stream we always assume that we can write the
|
||||||
|
// requested number of bytes: if we can't (eg, the disk is full) we'll
|
||||||
|
// get an exception somewhere eventually.
|
||||||
|
BytesToGo := Count;
|
||||||
|
// Remember to return the result of our calculation
|
||||||
|
Result := BytesToGo;
|
||||||
|
|
||||||
|
BufIdx := 0;
|
||||||
|
if (FBytesInBuf = 0) and (FSize > FBufStart) then
|
||||||
|
ReadBuffer;
|
||||||
|
// Calculate the number of bytes we can write prior to the loop
|
||||||
|
BytesToWrite := FBufSize - FBufPos;
|
||||||
|
if BytesToWrite > BytesToGo then
|
||||||
|
BytesToWrite := BytesToGo;
|
||||||
|
// Copy from the caller's buffer to the stream buffer
|
||||||
|
Move(BufAsBytes[BufIdx], FBuffer^[FBufPos], BytesToWrite);
|
||||||
|
// Mark our stream buffer as requiring a save to the actual stream,
|
||||||
|
// note that this will suffice for the rest of the routine as well: no
|
||||||
|
// inner routine will turn off the dirty flag.
|
||||||
|
FDirty := True;
|
||||||
|
// Calculate the number of bytes still to write
|
||||||
|
Dec(BytesToGo, BytesToWrite);
|
||||||
|
|
||||||
|
// While we have bytes to write, write them
|
||||||
|
while BytesToGo > 0 do
|
||||||
|
begin
|
||||||
|
Inc(BufIdx, BytesToWrite);
|
||||||
|
// As we've filled this buffer, write it out to the actual stream
|
||||||
|
// and advance to the next buffer, reading it if required
|
||||||
|
FBytesInBuf := FBufSize;
|
||||||
|
WriteBuffer;
|
||||||
|
Inc(FBufStart, FBufSize);
|
||||||
|
FBufPos := 0;
|
||||||
|
FBytesInBuf := 0;
|
||||||
|
if FSize > FBufStart then
|
||||||
|
ReadBuffer;
|
||||||
|
// Calculate the number of bytes we can write in this cycle
|
||||||
|
BytesToWrite := FBufSize;
|
||||||
|
if BytesToWrite > BytesToGo then
|
||||||
|
BytesToWrite := BytesToGo;
|
||||||
|
// Copy from the caller's buffer to our buffer
|
||||||
|
Move(BufAsBytes[BufIdx], FBuffer^, BytesToWrite);
|
||||||
|
// Calculate the number of bytes still to write
|
||||||
|
Dec(BytesToGo, BytesToWrite);
|
||||||
|
end;
|
||||||
|
// Remember our new position
|
||||||
|
Inc(FBufPos, BytesToWrite);
|
||||||
|
// Make sure the count of valid bytes is correct
|
||||||
|
if FBytesInBuf < FBufPos then
|
||||||
|
FBytesInBuf := FBufPos;
|
||||||
|
// Make sure the stream size is correct
|
||||||
|
if FSize < (FBufStart + FBytesInBuf) then
|
||||||
|
FSize := FBufStart + FBytesInBuf;
|
||||||
|
// If we're at the end of the buffer, write it out and advance to the
|
||||||
|
// start of the next page
|
||||||
|
if FBufPos = FBufSize then
|
||||||
|
begin
|
||||||
|
WriteBuffer;
|
||||||
|
FDirty := False;
|
||||||
|
Inc(FBufStart, FBufSize);
|
||||||
|
FBufPos := 0;
|
||||||
|
FBytesInBuf := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ File IO functions }
|
||||||
|
|
||||||
|
function FileOpenRead(FileName: PChar): TImagingHandle; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TBufferedStream.Create(TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileOpenWrite(FileName: PChar): TImagingHandle; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TBufferedStream.Create(TFileStream.Create(FileName, fmCreate or fmShareDenyWrite));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FileClose(Handle: TImagingHandle); cdecl;
|
||||||
|
var
|
||||||
|
Stream: TStream;
|
||||||
|
begin
|
||||||
|
Stream := TBufferedStream(Handle).Stream;
|
||||||
|
TBufferedStream(Handle).Free;
|
||||||
|
Stream.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileEof(Handle: TImagingHandle): Boolean; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TBufferedStream(Handle).Position = TBufferedStream(Handle).Size;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
|
||||||
|
LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TBufferedStream(Handle).Seek(Offset, LongInt(Mode));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileTell(Handle: TImagingHandle): LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TBufferedStream(Handle).Position;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
||||||
|
LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TBufferedStream(Handle).Read(Buffer^, Count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
||||||
|
LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TBufferedStream(Handle).Write(Buffer^, Count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Stream IO functions }
|
||||||
|
|
||||||
|
function StreamOpenRead(FileName: PChar): TImagingHandle; cdecl;
|
||||||
|
begin
|
||||||
|
Result := FileName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StreamOpenWrite(FileName: PChar): TImagingHandle; cdecl;
|
||||||
|
begin
|
||||||
|
Result := FileName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure StreamClose(Handle: TImagingHandle); cdecl;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StreamEof(Handle: TImagingHandle): Boolean; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TStream(Handle).Position = TStream(Handle).Size;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StreamSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
|
||||||
|
LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TStream(Handle).Seek(Offset, LongInt(Mode));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StreamTell(Handle: TImagingHandle): LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TStream(Handle).Position;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StreamRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
||||||
|
LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TStream(Handle).Read(Buffer^, Count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function StreamWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
||||||
|
LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := TStream(Handle).Write(Buffer^, Count);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Memory IO functions }
|
||||||
|
|
||||||
|
function MemoryOpenRead(FileName: PChar): TImagingHandle; cdecl;
|
||||||
|
begin
|
||||||
|
Result := FileName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MemoryOpenWrite(FileName: PChar): TImagingHandle; cdecl;
|
||||||
|
begin
|
||||||
|
Result := FileName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure MemoryClose(Handle: TImagingHandle); cdecl;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MemoryEof(Handle: TImagingHandle): Boolean; cdecl;
|
||||||
|
begin
|
||||||
|
Result := PMemoryIORec(Handle).Position = PMemoryIORec(Handle).Size;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MemorySeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode):
|
||||||
|
LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := PMemoryIORec(Handle).Position;
|
||||||
|
case Mode of
|
||||||
|
smFromBeginning: Result := Offset;
|
||||||
|
smFromCurrent: Result := PMemoryIORec(Handle).Position + Offset;
|
||||||
|
smFromEnd: Result := PMemoryIORec(Handle).Size + Offset;
|
||||||
|
end;
|
||||||
|
//Result := ClampInt(Result, 0, PMemoryIORec(Handle).Size); don't do this - some file formats use it
|
||||||
|
PMemoryIORec(Handle).Position := Result;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MemoryTell(Handle: TImagingHandle): LongInt; cdecl;
|
||||||
|
begin
|
||||||
|
Result := PMemoryIORec(Handle).Position;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MemoryRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
||||||
|
LongInt; cdecl;
|
||||||
|
var
|
||||||
|
Rec: PMemoryIORec;
|
||||||
|
begin
|
||||||
|
Rec := PMemoryIORec(Handle);
|
||||||
|
Result := Count;
|
||||||
|
if Rec.Position + Count > Rec.Size then
|
||||||
|
Result := Rec.Size - Rec.Position;
|
||||||
|
Move(Rec.Data[Rec.Position], Buffer^, Result);
|
||||||
|
Rec.Position := Rec.Position + Result;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function MemoryWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt):
|
||||||
|
LongInt; cdecl;
|
||||||
|
var
|
||||||
|
Rec: PMemoryIORec;
|
||||||
|
begin
|
||||||
|
Rec := PMemoryIORec(Handle);
|
||||||
|
Result := Count;
|
||||||
|
if Rec.Position + Count > Rec.Size then
|
||||||
|
Result := Rec.Size - Rec.Position;
|
||||||
|
Move(Buffer^, Rec.Data[Rec.Position], Result);
|
||||||
|
Rec.Position := Rec.Position + Result;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Helper IO functions }
|
||||||
|
|
||||||
|
function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt;
|
||||||
|
var
|
||||||
|
OldPos: Int64;
|
||||||
|
begin
|
||||||
|
OldPos := IOFunctions.Tell(Handle);
|
||||||
|
IOFunctions.Seek(Handle, 0, smFromEnd);
|
||||||
|
Result := IOFunctions.Tell(Handle);
|
||||||
|
IOFunctions.Seek(Handle, OldPos, smFromBeginning);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec;
|
||||||
|
begin
|
||||||
|
Result.Data := Data;
|
||||||
|
Result.Position := 0;
|
||||||
|
Result.Size := Size;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
OriginalFileIO.OpenRead := FileOpenRead;
|
||||||
|
OriginalFileIO.OpenWrite := FileOpenWrite;
|
||||||
|
OriginalFileIO.Close := FileClose;
|
||||||
|
OriginalFileIO.Eof := FileEof;
|
||||||
|
OriginalFileIO.Seek := FileSeek;
|
||||||
|
OriginalFileIO.Tell := FileTell;
|
||||||
|
OriginalFileIO.Read := FileRead;
|
||||||
|
OriginalFileIO.Write := FileWrite;
|
||||||
|
|
||||||
|
StreamIO.OpenRead := StreamOpenRead;
|
||||||
|
StreamIO.OpenWrite := StreamOpenWrite;
|
||||||
|
StreamIO.Close := StreamClose;
|
||||||
|
StreamIO.Eof := StreamEof;
|
||||||
|
StreamIO.Seek := StreamSeek;
|
||||||
|
StreamIO.Tell := StreamTell;
|
||||||
|
StreamIO.Read := StreamRead;
|
||||||
|
StreamIO.Write := StreamWrite;
|
||||||
|
|
||||||
|
MemoryIO.OpenRead := MemoryOpenRead;
|
||||||
|
MemoryIO.OpenWrite := MemoryOpenWrite;
|
||||||
|
MemoryIO.Close := MemoryClose;
|
||||||
|
MemoryIO.Eof := MemoryEof;
|
||||||
|
MemoryIO.Seek := MemorySeek;
|
||||||
|
MemoryIO.Tell := MemoryTell;
|
||||||
|
MemoryIO.Read := MemoryRead;
|
||||||
|
MemoryIO.Write := MemoryWrite;
|
||||||
|
|
||||||
|
ResetFileIO;
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
|
||||||
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Added merge between buffered read-only and write-only file
|
||||||
|
stream adapters - TIFF saving needed both reading and writing.
|
||||||
|
- Fixed bug causing wrong value of TBufferedWriteFile.Size
|
||||||
|
(needed to add buffer pos to size).
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Removed TMemoryIORec.Written, use Position to get proper memory
|
||||||
|
position (Written didn't take Seeks into account).
|
||||||
|
- Added TBufferedReadFile and TBufferedWriteFile classes for
|
||||||
|
buffered file reading/writting. File IO functions now use these
|
||||||
|
classes resulting in performance increase mainly in file formats
|
||||||
|
that read/write many small chunks.
|
||||||
|
- Added fmShareDenyWrite to FileOpenRead. You can now read
|
||||||
|
files opened for reading by Imaging from other apps.
|
||||||
|
- Added GetInputSize and PrepareMemIO helper functions.
|
||||||
|
|
||||||
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
||||||
|
- changed behaviour of MemorySeek to act as TStream
|
||||||
|
based Seeks
|
||||||
|
}
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,589 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingJpeg.pas 103 2007-09-15 01:11:14Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains image format loader/saver for Jpeg images.}
|
||||||
|
unit ImagingJpeg;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
{ You can choose which Pascal JpegLib implementation will be used.
|
||||||
|
IMJPEGLIB is version bundled with Imaging which works with all supported
|
||||||
|
compilers and platforms.
|
||||||
|
PASJPEG is original JpegLib translation or version modified for FPC
|
||||||
|
(and shipped with it). You can use PASJPEG if this version is already
|
||||||
|
linked with another part of your program and you don't want to have
|
||||||
|
two quite large almost the same libraries linked to your exe.
|
||||||
|
This is the case with Lazarus applications for example.}
|
||||||
|
|
||||||
|
{$DEFINE IMJPEGLIB}
|
||||||
|
{ $DEFINE PASJPEG}
|
||||||
|
|
||||||
|
{ Automatically use FPC's PasJpeg when compiling with Lazarus.}
|
||||||
|
|
||||||
|
{$IFDEF LCL}
|
||||||
|
{ $UNDEF IMJPEGLIB}
|
||||||
|
{$DEFINE PASJPEG}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, ImagingTypes, Imaging, ImagingColors,
|
||||||
|
{$IF Defined(IMJPEGLIB)}
|
||||||
|
imjpeglib, imjmorecfg, imjcomapi, imjdapimin,
|
||||||
|
imjdapistd, imjcapimin, imjcapistd, imjdmarker, imjcparam,
|
||||||
|
{$ELSEIF Defined(PASJPEG)}
|
||||||
|
jpeglib, jmorecfg, jcomapi, jdapimin,
|
||||||
|
jdapistd, jcapimin, jcapistd, jdmarker, jcparam,
|
||||||
|
{$IFEND}
|
||||||
|
ImagingUtility;
|
||||||
|
|
||||||
|
{$IF Defined(FPC) and Defined(PASJPEG)}
|
||||||
|
{ When using FPC's pasjpeg in FPC the channel order is BGR instead of RGB}
|
||||||
|
{ $DEFINE RGBSWAPPED} // not needed now apparently
|
||||||
|
{$IFEND}
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Class for loading/saving Jpeg images. Supports load/save of
|
||||||
|
8 bit grayscale and 24 bit RGB images.}
|
||||||
|
TJpegFileFormat = class(TImageFileFormat)
|
||||||
|
private
|
||||||
|
FGrayScale: Boolean;
|
||||||
|
protected
|
||||||
|
FQuality: LongInt;
|
||||||
|
FProgressive: LongBool;
|
||||||
|
procedure SetJpegIO(const JpegIO: TIOFunctions); virtual;
|
||||||
|
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
|
||||||
|
OnlyFirstLevel: Boolean): Boolean; override;
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
function TestFormat(Handle: TImagingHandle): Boolean; override;
|
||||||
|
procedure CheckOptionsValidity; override;
|
||||||
|
published
|
||||||
|
{ Controls Jpeg save compression quality. It is number in range 1..100.
|
||||||
|
1 means small/ugly file, 100 means large/nice file. Accessible trough
|
||||||
|
ImagingJpegQuality option.}
|
||||||
|
property Quality: LongInt read FQuality write FQuality;
|
||||||
|
{ If True Jpeg images are saved in progressive format. Accessible trough
|
||||||
|
ImagingJpegProgressive option.}
|
||||||
|
property Progressive: LongBool read FProgressive write FProgressive;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
SJpegFormatName = 'Joint Photographic Experts Group Image';
|
||||||
|
SJpegMasks = '*.jpg,*.jpeg,*.jfif,*.jpe,*.jif';
|
||||||
|
JpegSupportedFormats: TImageFormats = [ifR8G8B8, ifGray8];
|
||||||
|
JpegDefaultQuality = 90;
|
||||||
|
JpegDefaultProgressive = False;
|
||||||
|
|
||||||
|
const
|
||||||
|
{ Jpeg file identifiers.}
|
||||||
|
JpegMagic: TChar2 = #$FF#$D8;
|
||||||
|
JFIFSignature: TChar4 = 'JFIF';
|
||||||
|
EXIFSignature: TChar4 = 'Exif';
|
||||||
|
BufferSize = 16384;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJpegContext = record
|
||||||
|
case Byte of
|
||||||
|
0: (common: jpeg_common_struct);
|
||||||
|
1: (d: jpeg_decompress_struct);
|
||||||
|
2: (c: jpeg_compress_struct);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TSourceMgr = record
|
||||||
|
Pub: jpeg_source_mgr;
|
||||||
|
Input: TImagingHandle;
|
||||||
|
Buffer: JOCTETPTR;
|
||||||
|
StartOfFile: Boolean;
|
||||||
|
end;
|
||||||
|
PSourceMgr = ^TSourceMgr;
|
||||||
|
|
||||||
|
TDestMgr = record
|
||||||
|
Pub: jpeg_destination_mgr;
|
||||||
|
Output: TImagingHandle;
|
||||||
|
Buffer: JOCTETPTR;
|
||||||
|
end;
|
||||||
|
PDestMgr = ^TDestMgr;
|
||||||
|
|
||||||
|
var
|
||||||
|
JIO: TIOFunctions;
|
||||||
|
|
||||||
|
|
||||||
|
{ Intenal unit jpeglib support functions }
|
||||||
|
|
||||||
|
procedure JpegError(CurInfo: j_common_ptr);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure EmitMessage(CurInfo: j_common_ptr; msg_level: Integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure OutputMessage(CurInfo: j_common_ptr);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FormatMessage(CurInfo: j_common_ptr; var buffer: string);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ResetErrorMgr(CurInfo: j_common_ptr);
|
||||||
|
begin
|
||||||
|
CurInfo^.err^.num_warnings := 0;
|
||||||
|
CurInfo^.err^.msg_code := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
JpegErrorRec: jpeg_error_mgr = (
|
||||||
|
error_exit: JpegError;
|
||||||
|
emit_message: EmitMessage;
|
||||||
|
output_message: OutputMessage;
|
||||||
|
format_message: FormatMessage;
|
||||||
|
reset_error_mgr: ResetErrorMgr);
|
||||||
|
|
||||||
|
procedure ReleaseContext(var jc: TJpegContext);
|
||||||
|
begin
|
||||||
|
if jc.common.err = nil then
|
||||||
|
Exit;
|
||||||
|
jpeg_destroy(@jc.common);
|
||||||
|
jpeg_destroy_decompress(@jc.d);
|
||||||
|
jpeg_destroy_compress(@jc.c);
|
||||||
|
jc.common.err := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitSource(cinfo: j_decompress_ptr);
|
||||||
|
begin
|
||||||
|
PSourceMgr(cinfo.src).StartOfFile := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FillInputBuffer(cinfo: j_decompress_ptr): Boolean;
|
||||||
|
var
|
||||||
|
NBytes: LongInt;
|
||||||
|
Src: PSourceMgr;
|
||||||
|
begin
|
||||||
|
Src := PSourceMgr(cinfo.src);
|
||||||
|
NBytes := JIO.Read(Src.Input, Src.Buffer, BufferSize);
|
||||||
|
|
||||||
|
if NBytes <= 0 then
|
||||||
|
begin
|
||||||
|
PChar(Src.Buffer)[0] := #$FF;
|
||||||
|
PChar(Src.Buffer)[1] := Char(JPEG_EOI);
|
||||||
|
NBytes := 2;
|
||||||
|
end;
|
||||||
|
Src.Pub.next_input_byte := Src.Buffer;
|
||||||
|
Src.Pub.bytes_in_buffer := NBytes;
|
||||||
|
Src.StartOfFile := False;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SkipInputData(cinfo: j_decompress_ptr; num_bytes: LongInt);
|
||||||
|
var
|
||||||
|
Src: PSourceMgr;
|
||||||
|
begin
|
||||||
|
Src := PSourceMgr(cinfo.src);
|
||||||
|
if num_bytes > 0 then
|
||||||
|
begin
|
||||||
|
while num_bytes > Src.Pub.bytes_in_buffer do
|
||||||
|
begin
|
||||||
|
Dec(num_bytes, Src.Pub.bytes_in_buffer);
|
||||||
|
FillInputBuffer(cinfo);
|
||||||
|
end;
|
||||||
|
Src.Pub.next_input_byte := @PByteArray(Src.Pub.next_input_byte)[num_bytes];
|
||||||
|
// Inc(LongInt(Src.Pub.next_input_byte), num_bytes);
|
||||||
|
Dec(Src.Pub.bytes_in_buffer, num_bytes);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TermSource(cinfo: j_decompress_ptr);
|
||||||
|
var
|
||||||
|
Src: PSourceMgr;
|
||||||
|
begin
|
||||||
|
Src := PSourceMgr(cinfo.src);
|
||||||
|
// Move stream position back just after EOI marker so that more that one
|
||||||
|
// JPEG images can be loaded from one stream
|
||||||
|
JIO.Seek(Src.Input, -Src.Pub.bytes_in_buffer, smFromCurrent);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure JpegStdioSrc(var cinfo: jpeg_decompress_struct; Handle:
|
||||||
|
TImagingHandle);
|
||||||
|
var
|
||||||
|
Src: PSourceMgr;
|
||||||
|
begin
|
||||||
|
if cinfo.src = nil then
|
||||||
|
begin
|
||||||
|
cinfo.src := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_PERMANENT,
|
||||||
|
SizeOf(TSourceMgr));
|
||||||
|
Src := PSourceMgr(cinfo.src);
|
||||||
|
Src.Buffer := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_PERMANENT,
|
||||||
|
BufferSize * SizeOf(JOCTET));
|
||||||
|
end;
|
||||||
|
Src := PSourceMgr(cinfo.src);
|
||||||
|
Src.Pub.init_source := InitSource;
|
||||||
|
Src.Pub.fill_input_buffer := FillInputBuffer;
|
||||||
|
Src.Pub.skip_input_data := SkipInputData;
|
||||||
|
Src.Pub.resync_to_restart := jpeg_resync_to_restart;
|
||||||
|
Src.Pub.term_source := TermSource;
|
||||||
|
Src.Input := Handle;
|
||||||
|
Src.Pub.bytes_in_buffer := 0;
|
||||||
|
Src.Pub.next_input_byte := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitDest(cinfo: j_compress_ptr);
|
||||||
|
var
|
||||||
|
Dest: PDestMgr;
|
||||||
|
begin
|
||||||
|
Dest := PDestMgr(cinfo.dest);
|
||||||
|
Dest.Pub.next_output_byte := Dest.Buffer;
|
||||||
|
Dest.Pub.free_in_buffer := BufferSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function EmptyOutput(cinfo: j_compress_ptr): Boolean;
|
||||||
|
var
|
||||||
|
Dest: PDestMgr;
|
||||||
|
begin
|
||||||
|
Dest := PDestMgr(cinfo.dest);
|
||||||
|
JIO.Write(Dest.Output, Dest.Buffer, BufferSize);
|
||||||
|
Dest.Pub.next_output_byte := Dest.Buffer;
|
||||||
|
Dest.Pub.free_in_buffer := BufferSize;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TermDest(cinfo: j_compress_ptr);
|
||||||
|
var
|
||||||
|
Dest: PDestMgr;
|
||||||
|
DataCount: LongInt;
|
||||||
|
begin
|
||||||
|
Dest := PDestMgr(cinfo.dest);
|
||||||
|
DataCount := BufferSize - Dest.Pub.free_in_buffer;
|
||||||
|
if DataCount > 0 then
|
||||||
|
JIO.Write(Dest.Output, Dest.Buffer, DataCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure JpegStdioDest(var cinfo: jpeg_compress_struct; Handle:
|
||||||
|
TImagingHandle);
|
||||||
|
var
|
||||||
|
Dest: PDestMgr;
|
||||||
|
begin
|
||||||
|
if cinfo.dest = nil then
|
||||||
|
cinfo.dest := cinfo.mem.alloc_small(j_common_ptr(@cinfo),
|
||||||
|
JPOOL_PERMANENT, SizeOf(TDestMgr));
|
||||||
|
Dest := PDestMgr(cinfo.dest);
|
||||||
|
Dest.Buffer := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_IMAGE,
|
||||||
|
BufferSize * SIZEOF(JOCTET));
|
||||||
|
Dest.Pub.init_destination := InitDest;
|
||||||
|
Dest.Pub.empty_output_buffer := EmptyOutput;
|
||||||
|
Dest.Pub.term_destination := TermDest;
|
||||||
|
Dest.Output := Handle;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitDecompressor(Handle: TImagingHandle; var jc: TJpegContext);
|
||||||
|
begin
|
||||||
|
FillChar(jc, sizeof(jc), 0);
|
||||||
|
jc.common.err := @JpegErrorRec;
|
||||||
|
jpeg_CreateDecompress(@jc.d, JPEG_LIB_VERSION, sizeof(jc.d));
|
||||||
|
JpegStdioSrc(jc.d, Handle);
|
||||||
|
jpeg_read_header(@jc.d, True);
|
||||||
|
jc.d.scale_num := 1;
|
||||||
|
jc.d.scale_denom := 1;
|
||||||
|
jc.d.do_block_smoothing := True;
|
||||||
|
if jc.d.out_color_space = JCS_GRAYSCALE then
|
||||||
|
begin
|
||||||
|
jc.d.quantize_colors := True;
|
||||||
|
jc.d.desired_number_of_colors := 256;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitCompressor(Handle: TImagingHandle; var jc: TJpegContext;
|
||||||
|
Saver: TJpegFileFormat);
|
||||||
|
begin
|
||||||
|
FillChar(jc, sizeof(jc), 0);
|
||||||
|
jc.common.err := @JpegErrorRec;
|
||||||
|
jpeg_CreateCompress(@jc.c, JPEG_LIB_VERSION, sizeof(jc.c));
|
||||||
|
JpegStdioDest(jc.c, Handle);
|
||||||
|
jpeg_set_defaults(@jc.c);
|
||||||
|
jpeg_set_quality(@jc.c, Saver.FQuality, True);
|
||||||
|
if Saver.FGrayScale then
|
||||||
|
jpeg_set_colorspace(@jc.c, JCS_GRAYSCALE)
|
||||||
|
else
|
||||||
|
jpeg_set_colorspace(@jc.c, JCS_YCbCr);
|
||||||
|
if Saver.FProgressive then
|
||||||
|
jpeg_simple_progression(@jc.c);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TJpegFileFormat class implementation }
|
||||||
|
|
||||||
|
constructor TJpegFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SJpegFormatName;
|
||||||
|
FCanLoad := True;
|
||||||
|
FCanSave := True;
|
||||||
|
FIsMultiImageFormat := False;
|
||||||
|
FSupportedFormats := JpegSupportedFormats;
|
||||||
|
|
||||||
|
FQuality := JpegDefaultQuality;
|
||||||
|
FProgressive := JpegDefaultProgressive;
|
||||||
|
|
||||||
|
AddMasks(SJpegMasks);
|
||||||
|
RegisterOption(ImagingJpegQuality, @FQuality);
|
||||||
|
RegisterOption(ImagingJpegProgressive, @FProgressive);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJpegFileFormat.CheckOptionsValidity;
|
||||||
|
begin
|
||||||
|
// Check if option values are valid
|
||||||
|
if not (FQuality in [1..100]) then
|
||||||
|
FQuality := JpegDefaultQuality;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJpegFileFormat.LoadData(Handle: TImagingHandle;
|
||||||
|
var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
PtrInc, LinesPerCall, LinesRead, I: Integer;
|
||||||
|
Dest: PByte;
|
||||||
|
jc: TJpegContext;
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
Format: TImageFormat;
|
||||||
|
Col32: PColor32Rec;
|
||||||
|
{$IFDEF RGBSWAPPED}
|
||||||
|
I: LongInt;
|
||||||
|
Pix: PColor24Rec;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
// Copy IO functions to global var used in JpegLib callbacks
|
||||||
|
SetJpegIO(GetIO);
|
||||||
|
SetLength(Images, 1);
|
||||||
|
with JIO, Images[0] do
|
||||||
|
try
|
||||||
|
InitDecompressor(Handle, jc);
|
||||||
|
case jc.d.out_color_space of
|
||||||
|
JCS_GRAYSCALE: Format := ifGray8;
|
||||||
|
JCS_RGB: Format := ifR8G8B8;
|
||||||
|
JCS_CMYK: Format := ifA8R8G8B8;
|
||||||
|
end;
|
||||||
|
NewImage(jc.d.image_width, jc.d.image_height, Format, Images[0]);
|
||||||
|
jpeg_start_decompress(@jc.d);
|
||||||
|
GetImageFormatInfo(Format, Info);
|
||||||
|
PtrInc := Width * Info.BytesPerPixel;
|
||||||
|
LinesPerCall := 1;
|
||||||
|
Dest := Bits;
|
||||||
|
|
||||||
|
while jc.d.output_scanline < jc.d.output_height do
|
||||||
|
begin
|
||||||
|
LinesRead := jpeg_read_scanlines(@jc.d, @Dest, LinesPerCall);
|
||||||
|
{$IFDEF RGBSWAPPED}
|
||||||
|
if Format = ifR8G8B8 then
|
||||||
|
begin
|
||||||
|
Pix := PColor24Rec(Dest);
|
||||||
|
for I := 0 to Width - 1 do
|
||||||
|
begin
|
||||||
|
SwapValues(Pix.R, Pix.B);
|
||||||
|
Inc(Pix);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
Inc(Dest, PtrInc * LinesRead);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if jc.d.out_color_space = JCS_CMYK then
|
||||||
|
begin
|
||||||
|
Col32 := Bits;
|
||||||
|
// Translate from CMYK to RGB
|
||||||
|
for I := 0 to Width * Height - 1 do
|
||||||
|
begin
|
||||||
|
CMYKToRGB(255 - Col32.B, 255 - Col32.G, 255 - Col32.R, 255 - Col32.A,
|
||||||
|
Col32.R, Col32.G, Col32.B);
|
||||||
|
Col32.A := 255;
|
||||||
|
Inc(Col32);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
jpeg_finish_output(@jc.d);
|
||||||
|
jpeg_finish_decompress(@jc.d);
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
ReleaseContext(jc);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJpegFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: LongInt): Boolean;
|
||||||
|
var
|
||||||
|
PtrInc, LinesWritten: LongInt;
|
||||||
|
Src, Line: PByte;
|
||||||
|
jc: TJpegContext;
|
||||||
|
ImageToSave: TImageData;
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
MustBeFreed: Boolean;
|
||||||
|
{$IFDEF RGBSWAPPED}
|
||||||
|
I: LongInt;
|
||||||
|
Pix: PColor24Rec;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
// Copy IO functions to global var used in JpegLib callbacks
|
||||||
|
SetJpegIO(GetIO);
|
||||||
|
// Makes image to save compatible with Jpeg saving capabilities
|
||||||
|
if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
|
||||||
|
with JIO, ImageToSave do
|
||||||
|
try
|
||||||
|
GetImageFormatInfo(Format, Info);
|
||||||
|
FGrayScale := Format = ifGray8;
|
||||||
|
InitCompressor(Handle, jc, Self);
|
||||||
|
jc.c.image_width := Width;
|
||||||
|
jc.c.image_height := Height;
|
||||||
|
if FGrayScale then
|
||||||
|
begin
|
||||||
|
jc.c.input_components := 1;
|
||||||
|
jc.c.in_color_space := JCS_GRAYSCALE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
jc.c.input_components := 3;
|
||||||
|
jc.c.in_color_space := JCS_RGB;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PtrInc := Width * Info.BytesPerPixel;
|
||||||
|
Src := Bits;
|
||||||
|
|
||||||
|
{$IFDEF RGBSWAPPED}
|
||||||
|
GetMem(Line, PtrInc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
jpeg_start_compress(@jc.c, True);
|
||||||
|
while (jc.c.next_scanline < jc.c.image_height) do
|
||||||
|
begin
|
||||||
|
{$IFDEF RGBSWAPPED}
|
||||||
|
if Format = ifR8G8B8 then
|
||||||
|
begin
|
||||||
|
Move(Src^, Line^, PtrInc);
|
||||||
|
Pix := PColor24Rec(Line);
|
||||||
|
for I := 0 to Width - 1 do
|
||||||
|
begin
|
||||||
|
SwapValues(Pix.R, Pix.B);
|
||||||
|
Inc(Pix, 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ELSE}
|
||||||
|
Line := Src;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
LinesWritten := jpeg_write_scanlines(@jc.c, @Line, 1);
|
||||||
|
Inc(Src, PtrInc * LinesWritten);
|
||||||
|
end;
|
||||||
|
|
||||||
|
jpeg_finish_compress(@jc.c);
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
ReleaseContext(jc);
|
||||||
|
if MustBeFreed then
|
||||||
|
FreeImage(ImageToSave);
|
||||||
|
{$IFDEF RGBSWAPPED}
|
||||||
|
FreeMem(Line);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJpegFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
begin
|
||||||
|
if Info.HasGrayChannel then
|
||||||
|
ConvertImage(Image, ifGray8)
|
||||||
|
else
|
||||||
|
ConvertImage(Image, ifR8G8B8);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJpegFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
|
||||||
|
var
|
||||||
|
ReadCount: LongInt;
|
||||||
|
ID: array[0..9] of Char;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if Handle <> nil then
|
||||||
|
with GetIO do
|
||||||
|
begin
|
||||||
|
FillChar(ID, SizeOf(ID), 0);
|
||||||
|
ReadCount := Read(Handle, @ID, SizeOf(ID));
|
||||||
|
Seek(Handle, -ReadCount, smFromCurrent);
|
||||||
|
Result := (ReadCount = SizeOf(ID)) and
|
||||||
|
CompareMem(@ID, @JpegMagic, SizeOf(JpegMagic));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJpegFileFormat.SetJpegIO(const JpegIO: TIOFunctions);
|
||||||
|
begin
|
||||||
|
JIO := JpegIO;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterImageFileFormat(TJpegFileFormat);
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
|
||||||
|
-- 0.24.1 Changes/Bug Fixes ---------------------------------
|
||||||
|
- Fixed loading of CMYK jpeg images. Could cause heap corruption
|
||||||
|
and loaded image looked wrong.
|
||||||
|
|
||||||
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Removed JFIF/EXIF detection from TestFormat. Found JPEGs
|
||||||
|
with different headers (Lavc) which weren't recognized.
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- MakeCompatible method moved to base class, put ConvertToSupported here.
|
||||||
|
GetSupportedFormats removed, it is now set in constructor.
|
||||||
|
- Made public properties for options registered to SetOption/GetOption
|
||||||
|
functions.
|
||||||
|
- Changed extensions to filename masks.
|
||||||
|
- Changed SaveData, LoadData, and MakeCompatible methods according
|
||||||
|
to changes in base class in Imaging unit.
|
||||||
|
- Changes in TestFormat, now reads JFIF and EXIF signatures too.
|
||||||
|
|
||||||
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
||||||
|
- input position is now set correctly to the end of the image
|
||||||
|
after loading is done. Loading of sequence of JPEG files stored in
|
||||||
|
single stream works now
|
||||||
|
- when loading and saving images in FPC with PASJPEG read and
|
||||||
|
blue channels are swapped to have the same chanel order as IMJPEGLIB
|
||||||
|
- you can now choose between IMJPEGLIB and PASJPEG implementations
|
||||||
|
|
||||||
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
||||||
|
- added SetJpegIO method which is used by JNG image format
|
||||||
|
}
|
||||||
|
end.
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,867 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingOpenGL.pas 106 2007-10-23 23:03:35Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains functions for loading and saving OpenGL textures
|
||||||
|
using Imaging and for converting images to textures and vice versa.}
|
||||||
|
unit ImagingOpenGL;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
{ Define this symbol if you want to use dglOpenGL header.}
|
||||||
|
{ $DEFINE USE_DGL_HEADERS}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats,
|
||||||
|
{$IFDEF USE_DGL_HEADERS}
|
||||||
|
dglOpenGL,
|
||||||
|
{$ELSE}
|
||||||
|
gl, glext,
|
||||||
|
{$ENDIF}
|
||||||
|
ImagingUtility;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Various texture capabilities of installed OpenGL driver.}
|
||||||
|
TGLTextureCaps = record
|
||||||
|
MaxTextureSize: LongInt;
|
||||||
|
PowerOfTwo: Boolean;
|
||||||
|
DXTCompression: Boolean;
|
||||||
|
FloatTextures: Boolean;
|
||||||
|
MaxAnisotropy: LongInt;
|
||||||
|
MaxSimultaneousTextures: LongInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Returns texture capabilities of installed OpenGL driver.}
|
||||||
|
function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean;
|
||||||
|
{ Function which can be used to retrieve GL extension functions.}
|
||||||
|
function GetGLProcAddress(const ProcName: string): Pointer;
|
||||||
|
{ Returns True if the given GL extension is supported.}
|
||||||
|
function IsGLExtensionSupported(const Extension: string): Boolean;
|
||||||
|
{ Returns True if the given image format can be represented as GL texture
|
||||||
|
format. GLFormat, GLType, and GLInternal are parameters for functions like
|
||||||
|
glTexImage. Note that GLU functions like gluBuildMipmaps cannot handle some
|
||||||
|
formats returned by this function (i.e. GL_UNSIGNED_SHORT_5_5_5_1 as GLType).
|
||||||
|
If you are using compressed or floating-point images make sure that they are
|
||||||
|
supported by hardware using GetGLTextureCaps, ImageFormatToGL does not
|
||||||
|
check this.}
|
||||||
|
function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum;
|
||||||
|
var GLType: GLenum; var GLInternal: GLint): Boolean;
|
||||||
|
|
||||||
|
{ All GL textures created by Imaging functions have default parameters set -
|
||||||
|
that means that no glTexParameter calls are made so default filtering,
|
||||||
|
wrapping, and other parameters are used. Created textures
|
||||||
|
are left bound by glBindTexture when function is exited.}
|
||||||
|
|
||||||
|
{ Creates GL texture from image in file in format supported by Imaging.
|
||||||
|
You can use CreatedWidth and Height parameters to query dimensions of created textures
|
||||||
|
(it could differ from dimensions of source image).}
|
||||||
|
function LoadGLTextureFromFile(const FileName: string; CreatedWidth: PLongInt = nil;
|
||||||
|
CreatedHeight: PLongInt = nil): GLuint;
|
||||||
|
{ Creates GL texture from image in stream in format supported by Imaging.
|
||||||
|
You can use CreatedWidth and Height parameters to query dimensions of created textures
|
||||||
|
(it could differ from dimensions of source image).}
|
||||||
|
function LoadGLTextureFromStream(Stream: TStream; CreatedWidth: PLongInt = nil;
|
||||||
|
CreatedHeight: PLongInt = nil): GLuint;
|
||||||
|
{ Creates GL texture from image in memory in format supported by Imaging.
|
||||||
|
You can use CreatedWidth and Height parameters to query dimensions of created textures
|
||||||
|
(it could differ from dimensions of source image).}
|
||||||
|
function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt;
|
||||||
|
CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint;
|
||||||
|
|
||||||
|
{ Converts TImageData structure to OpenGL texture.
|
||||||
|
Input images is used as main mipmap level and additional requested
|
||||||
|
levels are generated from this one. For the details on parameters
|
||||||
|
look at CreateGLTextureFromMultiImage function.}
|
||||||
|
function CreateGLTextureFromImage(const Image: TImageData;
|
||||||
|
Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True;
|
||||||
|
OverrideFormat: TImageFormat = ifUnknown; CreatedWidth: PLongInt = nil;
|
||||||
|
CreatedHeight: PLongInt = nil): GLuint;
|
||||||
|
{ Converts images in TDymImageDataArray to one OpenGL texture.
|
||||||
|
Image at index MainLevelIndex in the array is used as main mipmap level and
|
||||||
|
additional images are used as subsequent levels. If there is not enough images
|
||||||
|
in array missing levels are automatically generated (and if there is enough images
|
||||||
|
but they have wrong dimensions or format then they are resized/converted).
|
||||||
|
If driver supports only power of two sized textures images are resized.
|
||||||
|
OverrideFormat can be used to convert image into specific format before
|
||||||
|
it is passed to OpenGL, ifUnknown means no conversion.
|
||||||
|
If desired texture format is not supported by hardware default
|
||||||
|
A8R8G8B8 format is used instead for color images and ifGray8 is used
|
||||||
|
for luminance images. DXTC (S3TC) compressed and floating point textures
|
||||||
|
are created if supported by hardware.
|
||||||
|
Width and Height can be used to set size of main mipmap level according
|
||||||
|
to your needs, Width and Height of 0 mean use width and height of input
|
||||||
|
image that will become main level mipmap.
|
||||||
|
MipMaps set to True mean build all possible levels, False means use only level 0.
|
||||||
|
You can use CreatedWidth and CreatedHeight parameters to query dimensions of
|
||||||
|
created texture's largest mipmap level (it could differ from dimensions
|
||||||
|
of source image).}
|
||||||
|
function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray;
|
||||||
|
Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True;
|
||||||
|
MainLevelIndex: LongInt = 0; OverrideFormat: TImageFormat = ifUnknown;
|
||||||
|
CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint;
|
||||||
|
|
||||||
|
{ Saves GL texture to file in one of formats supported by Imaging.
|
||||||
|
Saves all present mipmap levels.}
|
||||||
|
function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean;
|
||||||
|
{ Saves GL texture to stream in one of formats supported by Imaging.
|
||||||
|
Saves all present mipmap levels.}
|
||||||
|
function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean;
|
||||||
|
{ Saves GL texture to memory in one of formats supported by Imaging.
|
||||||
|
Saves all present mipmap levels.}
|
||||||
|
function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean;
|
||||||
|
|
||||||
|
{ Converts main level of the GL texture to TImageData strucrue. OverrideFormat
|
||||||
|
can be used to convert output image to the specified format rather
|
||||||
|
than use the format taken from GL texture, ifUnknown means no conversion.}
|
||||||
|
function CreateImageFromGLTexture(const Texture: GLuint;
|
||||||
|
var Image: TImageData; OverrideFormat: TImageFormat = ifUnknown): Boolean;
|
||||||
|
{ Converts GL texture to TDynImageDataArray array of images. You can specify
|
||||||
|
how many mipmap levels of the input texture you want to be converted
|
||||||
|
(default is all levels). OverrideFormat can be used to convert output images to
|
||||||
|
the specified format rather than use the format taken from GL texture,
|
||||||
|
ifUnknown means no conversion.}
|
||||||
|
function CreateMultiImageFromGLTexture(const Texture: GLuint;
|
||||||
|
var Images: TDynImageDataArray; MipLevels: LongInt = 0;
|
||||||
|
OverrideFormat: TImageFormat = ifUnknown): Boolean;
|
||||||
|
|
||||||
|
var
|
||||||
|
{ Standard behaviour of image->texture functions like CreateGLTextureFrom(Multi)Image is:
|
||||||
|
If graphic card supports non power of 2 textures and image is nonpow2 then
|
||||||
|
texture is created directly from image.
|
||||||
|
If graphic card does not support them input image is rescaled (bilinear)
|
||||||
|
to power of 2 size.
|
||||||
|
If you set PasteNonPow2ImagesIntoPow2 to True then instead of rescaling, a new
|
||||||
|
pow2 texture is created and nonpow2 input image is pasted into it
|
||||||
|
keeping its original size. This could be useful for some 2D stuff
|
||||||
|
(and its faster than rescaling of course). Note that this is applied
|
||||||
|
to all rescaling smaller->bigger operations that might ocurr during
|
||||||
|
image->texture process (usually only pow2/nonpow2 stuff and when you
|
||||||
|
set custom Width & Height in CreateGLTextureFrom(Multi)Image).}
|
||||||
|
PasteNonPow2ImagesIntoPow2: Boolean = False;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
// cube map consts
|
||||||
|
GL_TEXTURE_BINDING_CUBE_MAP = $8514;
|
||||||
|
GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
|
||||||
|
GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
|
||||||
|
GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
|
||||||
|
GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
|
||||||
|
GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
|
||||||
|
GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
|
||||||
|
|
||||||
|
// texture formats
|
||||||
|
GL_COLOR_INDEX = $1900;
|
||||||
|
GL_STENCIL_INDEX = $1901;
|
||||||
|
GL_DEPTH_COMPONENT = $1902;
|
||||||
|
GL_RED = $1903;
|
||||||
|
GL_GREEN = $1904;
|
||||||
|
GL_BLUE = $1905;
|
||||||
|
GL_ALPHA = $1906;
|
||||||
|
GL_RGB = $1907;
|
||||||
|
GL_RGBA = $1908;
|
||||||
|
GL_LUMINANCE = $1909;
|
||||||
|
GL_LUMINANCE_ALPHA = $190A;
|
||||||
|
GL_BGR_EXT = $80E0;
|
||||||
|
GL_BGRA_EXT = $80E1;
|
||||||
|
|
||||||
|
// texture internal formats
|
||||||
|
GL_ALPHA4 = $803B;
|
||||||
|
GL_ALPHA8 = $803C;
|
||||||
|
GL_ALPHA12 = $803D;
|
||||||
|
GL_ALPHA16 = $803E;
|
||||||
|
GL_LUMINANCE4 = $803F;
|
||||||
|
GL_LUMINANCE8 = $8040;
|
||||||
|
GL_LUMINANCE12 = $8041;
|
||||||
|
GL_LUMINANCE16 = $8042;
|
||||||
|
GL_LUMINANCE4_ALPHA4 = $8043;
|
||||||
|
GL_LUMINANCE6_ALPHA2 = $8044;
|
||||||
|
GL_LUMINANCE8_ALPHA8 = $8045;
|
||||||
|
GL_LUMINANCE12_ALPHA4 = $8046;
|
||||||
|
GL_LUMINANCE12_ALPHA12 = $8047;
|
||||||
|
GL_LUMINANCE16_ALPHA16 = $8048;
|
||||||
|
GL_INTENSITY = $8049;
|
||||||
|
GL_INTENSITY4 = $804A;
|
||||||
|
GL_INTENSITY8 = $804B;
|
||||||
|
GL_INTENSITY12 = $804C;
|
||||||
|
GL_INTENSITY16 = $804D;
|
||||||
|
GL_R3_G3_B2 = $2A10;
|
||||||
|
GL_RGB4 = $804F;
|
||||||
|
GL_RGB5 = $8050;
|
||||||
|
GL_RGB8 = $8051;
|
||||||
|
GL_RGB10 = $8052;
|
||||||
|
GL_RGB12 = $8053;
|
||||||
|
GL_RGB16 = $8054;
|
||||||
|
GL_RGBA2 = $8055;
|
||||||
|
GL_RGBA4 = $8056;
|
||||||
|
GL_RGB5_A1 = $8057;
|
||||||
|
GL_RGBA8 = $8058;
|
||||||
|
GL_RGB10_A2 = $8059;
|
||||||
|
GL_RGBA12 = $805A;
|
||||||
|
GL_RGBA16 = $805B;
|
||||||
|
|
||||||
|
// floating point texture formats
|
||||||
|
GL_RGBA32F_ARB = $8814;
|
||||||
|
GL_INTENSITY32F_ARB = $8817;
|
||||||
|
GL_LUMINANCE32F_ARB = $8818;
|
||||||
|
GL_RGBA16F_ARB = $881A;
|
||||||
|
GL_INTENSITY16F_ARB = $881D;
|
||||||
|
GL_LUMINANCE16F_ARB = $881E;
|
||||||
|
|
||||||
|
// compressed texture formats
|
||||||
|
GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
|
||||||
|
GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
|
||||||
|
GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
|
||||||
|
|
||||||
|
// various GL extension constants
|
||||||
|
GL_MAX_TEXTURE_UNITS = $84E2;
|
||||||
|
GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
|
||||||
|
GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
|
||||||
|
|
||||||
|
// texture source data formats
|
||||||
|
GL_UNSIGNED_BYTE_3_3_2 = $8032;
|
||||||
|
GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
|
||||||
|
GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
|
||||||
|
GL_UNSIGNED_INT_8_8_8_8 = $8035;
|
||||||
|
GL_UNSIGNED_INT_10_10_10_2 = $8036;
|
||||||
|
GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
|
||||||
|
GL_UNSIGNED_SHORT_5_6_5 = $8363;
|
||||||
|
GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
|
||||||
|
GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
|
||||||
|
GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
|
||||||
|
GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
|
||||||
|
GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
|
||||||
|
GL_HALF_FLOAT_ARB = $140B;
|
||||||
|
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
GLLibName = 'opengl32.dll';
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF UNIX}
|
||||||
|
GLLibName = 'libGL.so';
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type
|
||||||
|
TglCompressedTexImage2D = procedure (Target: GLenum; Level: GLint;
|
||||||
|
InternalFormat: GLenum; Width: GLsizei; Height: GLsizei; Border: GLint;
|
||||||
|
ImageSize: GLsizei; const Data: PGLvoid);
|
||||||
|
{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
|
||||||
|
var
|
||||||
|
glCompressedTexImage2D: TglCompressedTexImage2D = nil;
|
||||||
|
ExtensionBuffer: string = '';
|
||||||
|
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
function wglGetProcAddress(ProcName: PChar): Pointer; stdcall; external GLLibName;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF UNIX}
|
||||||
|
function glXGetProcAddress(ProcName: PChar): Pointer; cdecl; external GLLibName;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
function IsGLExtensionSupported(const Extension: string): Boolean;
|
||||||
|
var
|
||||||
|
ExtPos: LongInt;
|
||||||
|
begin
|
||||||
|
if ExtensionBuffer = '' then
|
||||||
|
ExtensionBuffer := glGetString(GL_EXTENSIONS);
|
||||||
|
|
||||||
|
ExtPos := Pos(Extension, ExtensionBuffer);
|
||||||
|
Result := ExtPos > 0;
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
Result := ((ExtPos + Length(Extension) - 1) = Length(ExtensionBuffer)) or
|
||||||
|
not (ExtensionBuffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetGLProcAddress(const ProcName: string): Pointer;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
Result := wglGetProcAddress(PChar(ProcName));
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF UNIX}
|
||||||
|
Result := glXGetProcAddress(PChar(ProcName));
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean;
|
||||||
|
begin
|
||||||
|
// check DXTC support and load extension functions if necesary
|
||||||
|
Caps.DXTCompression := IsGLExtensionSupported('GL_ARB_texture_compression') and
|
||||||
|
IsGLExtensionSupported('GL_EXT_texture_compression_s3tc');
|
||||||
|
if Caps.DXTCompression then
|
||||||
|
glCompressedTexImage2D := GetGLProcAddress('glCompressedTexImage2D');
|
||||||
|
Caps.DXTCompression := Caps.DXTCompression and (@glCompressedTexImage2D <> nil);
|
||||||
|
// check non power of 2 textures
|
||||||
|
Caps.PowerOfTwo := not IsGLExtensionSupported('GL_ARB_texture_non_power_of_two');
|
||||||
|
// check for floating point textures support
|
||||||
|
Caps.FloatTextures := IsGLExtensionSupported('GL_ARB_texture_float');
|
||||||
|
// get max texture size
|
||||||
|
glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize);
|
||||||
|
// get max anisotropy
|
||||||
|
if IsGLExtensionSupported('GL_EXT_texture_filter_anisotropic') then
|
||||||
|
glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @Caps.MaxAnisotropy)
|
||||||
|
else
|
||||||
|
Caps.MaxAnisotropy := 0;
|
||||||
|
// get number of texture units
|
||||||
|
if IsGLExtensionSupported('GL_ARB_multitexture') then
|
||||||
|
glGetIntegerv(GL_MAX_TEXTURE_UNITS, @Caps.MaxSimultaneousTextures)
|
||||||
|
else
|
||||||
|
Caps.MaxSimultaneousTextures := 1;
|
||||||
|
// get max texture size
|
||||||
|
glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize);
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum;
|
||||||
|
var GLType: GLenum; var GLInternal: GLint): Boolean;
|
||||||
|
begin
|
||||||
|
GLFormat := 0;
|
||||||
|
GLType := 0;
|
||||||
|
GLInternal := 0;
|
||||||
|
case Format of
|
||||||
|
// Gray formats
|
||||||
|
ifGray8, ifGray16:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_LUMINANCE;
|
||||||
|
GLType := Iff(Format = ifGray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT);
|
||||||
|
GLInternal := Iff(Format = ifGray8, GL_LUMINANCE8, GL_LUMINANCE16);
|
||||||
|
end;
|
||||||
|
ifA8Gray8, ifA16Gray16:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_LUMINANCE_ALPHA;
|
||||||
|
GLType := Iff(Format = ifA8Gray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT);
|
||||||
|
GLInternal := Iff(Format = ifA8Gray8, GL_LUMINANCE8_ALPHA8, GL_LUMINANCE16_ALPHA16);
|
||||||
|
end;
|
||||||
|
// RGBA formats
|
||||||
|
ifR3G3B2:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_RGB;
|
||||||
|
GLType := GL_UNSIGNED_BYTE_3_3_2;
|
||||||
|
GLInternal := GL_R3_G3_B2;
|
||||||
|
end;
|
||||||
|
ifR5G6B5:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_RGB;
|
||||||
|
GLType := GL_UNSIGNED_SHORT_5_6_5;
|
||||||
|
GLInternal := GL_RGB5;
|
||||||
|
end;
|
||||||
|
ifA1R5G5B5, ifX1R5G5B5:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_BGRA_EXT;
|
||||||
|
GLType := GL_UNSIGNED_SHORT_1_5_5_5_REV;
|
||||||
|
GLInternal := Iff(Format = ifA1R5G5B5, GL_RGB5_A1, GL_RGB5);
|
||||||
|
end;
|
||||||
|
ifA4R4G4B4, ifX4R4G4B4:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_BGRA_EXT;
|
||||||
|
GLType := GL_UNSIGNED_SHORT_4_4_4_4_REV;
|
||||||
|
GLInternal := Iff(Format = ifA4R4G4B4, GL_RGBA4, GL_RGB4);
|
||||||
|
end;
|
||||||
|
ifR8G8B8:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_BGR_EXT;
|
||||||
|
GLType := GL_UNSIGNED_BYTE;
|
||||||
|
GLInternal := GL_RGB8;
|
||||||
|
end;
|
||||||
|
ifA8R8G8B8, ifX8R8G8B8:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_BGRA_EXT;
|
||||||
|
GLType := GL_UNSIGNED_BYTE;
|
||||||
|
GLInternal := Iff(Format = ifA8R8G8B8, GL_RGBA8, GL_RGB8);
|
||||||
|
end;
|
||||||
|
ifR16G16B16, ifB16G16R16:
|
||||||
|
begin
|
||||||
|
GLFormat := Iff(Format = ifR16G16B16, GL_BGR_EXT, GL_RGB);
|
||||||
|
GLType := GL_UNSIGNED_SHORT;
|
||||||
|
GLInternal := GL_RGB16;
|
||||||
|
end;
|
||||||
|
ifA16R16G16B16, ifA16B16G16R16:
|
||||||
|
begin
|
||||||
|
GLFormat := Iff(Format = ifA16R16G16B16, GL_BGRA_EXT, GL_RGBA);
|
||||||
|
GLType := GL_UNSIGNED_SHORT;
|
||||||
|
GLInternal := GL_RGBA16;
|
||||||
|
end;
|
||||||
|
// Floating-Point formats
|
||||||
|
ifR32F:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_RED;
|
||||||
|
GLType := GL_FLOAT;
|
||||||
|
GLInternal := GL_LUMINANCE32F_ARB;
|
||||||
|
end;
|
||||||
|
ifA32R32G32B32F, ifA32B32G32R32F:
|
||||||
|
begin
|
||||||
|
GLFormat := Iff(Format = ifA32R32G32B32F, GL_BGRA_EXT, GL_RGBA);
|
||||||
|
GLType := GL_FLOAT;
|
||||||
|
GLInternal := GL_RGBA32F_ARB;
|
||||||
|
end;
|
||||||
|
ifR16F:
|
||||||
|
begin
|
||||||
|
GLFormat := GL_RED;
|
||||||
|
GLType := GL_HALF_FLOAT_ARB;
|
||||||
|
GLInternal := GL_LUMINANCE16F_ARB;
|
||||||
|
end;
|
||||||
|
ifA16R16G16B16F, ifA16B16G16R16F:
|
||||||
|
begin
|
||||||
|
GLFormat := Iff(Format = ifA16R16G16B16F, GL_BGRA_EXT, GL_RGBA);
|
||||||
|
GLType := GL_HALF_FLOAT_ARB;
|
||||||
|
GLInternal := GL_RGBA16F_ARB;
|
||||||
|
end;
|
||||||
|
// Special formats
|
||||||
|
ifDXT1: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
|
||||||
|
ifDXT3: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
|
||||||
|
ifDXT5: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
|
||||||
|
end;
|
||||||
|
Result := GLInternal <> 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LoadGLTextureFromFile(const FileName: string; CreatedWidth, CreatedHeight: PLongInt): GLuint;
|
||||||
|
var
|
||||||
|
Images: TDynImageDataArray;
|
||||||
|
begin
|
||||||
|
if LoadMultiImageFromFile(FileName, Images) and (Length(Images) > 0) then
|
||||||
|
begin
|
||||||
|
Result := CreateGLTextureFromMultiImage(Images, Images[0].Width,
|
||||||
|
Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
FreeImagesInArray(Images);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LoadGLTextureFromStream(Stream: TStream; CreatedWidth, CreatedHeight: PLongInt): GLuint;
|
||||||
|
var
|
||||||
|
Images: TDynImageDataArray;
|
||||||
|
begin
|
||||||
|
if LoadMultiImageFromStream(Stream, Images) and (Length(Images) > 0) then
|
||||||
|
begin
|
||||||
|
Result := CreateGLTextureFromMultiImage(Images, Images[0].Width,
|
||||||
|
Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
FreeImagesInArray(Images);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt; CreatedWidth, CreatedHeight: PLongInt): GLuint;
|
||||||
|
var
|
||||||
|
Images: TDynImageDataArray;
|
||||||
|
begin
|
||||||
|
if LoadMultiImageFromMemory(Data, Size, Images) and (Length(Images) > 0) then
|
||||||
|
begin
|
||||||
|
Result := CreateGLTextureFromMultiImage(Images, Images[0].Width,
|
||||||
|
Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
FreeImagesInArray(Images);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateGLTextureFromImage(const Image: TImageData;
|
||||||
|
Width, Height: LongInt; MipMaps: Boolean; OverrideFormat: TImageFormat;
|
||||||
|
CreatedWidth, CreatedHeight: PLongInt): GLuint;
|
||||||
|
var
|
||||||
|
Arr: TDynImageDataArray;
|
||||||
|
begin
|
||||||
|
// Just calls function operating on image arrays
|
||||||
|
SetLength(Arr, 1);
|
||||||
|
Arr[0] := Image;
|
||||||
|
Result := CreateGLTextureFromMultiImage(Arr, Width, Height, MipMaps, 0,
|
||||||
|
OverrideFormat, CreatedWidth, CreatedHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray;
|
||||||
|
Width, Height: LongInt; MipMaps: Boolean; MainLevelIndex: LongInt; OverrideFormat: TImageFormat;
|
||||||
|
CreatedWidth, CreatedHeight: PLongInt): GLuint;
|
||||||
|
const
|
||||||
|
CompressedFormats: TImageFormats = [ifDXT1, ifDXT3, ifDXT5];
|
||||||
|
var
|
||||||
|
I, MipLevels, PossibleLevels, ExistingLevels, CurrentWidth, CurrentHeight: LongInt;
|
||||||
|
Caps: TGLTextureCaps;
|
||||||
|
GLFormat: GLenum;
|
||||||
|
GLType: GLenum;
|
||||||
|
GLInternal: GLint;
|
||||||
|
Desired, ConvTo: TImageFormat;
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
LevelsArray: TDynImageDataArray;
|
||||||
|
NeedsResize, NeedsConvert: Boolean;
|
||||||
|
UnpackAlignment, UnpackSkipRows, UnpackSkipPixels, UnpackRowLength: LongInt;
|
||||||
|
|
||||||
|
procedure PasteImage(var Image: TImageData; Width, Height: LongInt);
|
||||||
|
var
|
||||||
|
Clone: TImageData;
|
||||||
|
begin
|
||||||
|
CloneImage(Image, Clone);
|
||||||
|
NewImage(Width, Height, Clone.Format, Image);
|
||||||
|
FillRect(Image, 0, 0, Width, Height, Clone.Bits);
|
||||||
|
CopyRect(Clone, 0, 0, Clone.Width, Clone.Height, Image, 0, 0);
|
||||||
|
FreeImage(Clone);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
ExistingLevels := Length(Images);
|
||||||
|
|
||||||
|
if GetGLTextureCaps(Caps) and (ExistingLevels > 0) then
|
||||||
|
try
|
||||||
|
// Check if requested main level is at valid index
|
||||||
|
if (MainLevelIndex < 0) or (MainLevelIndex > High(Images)) then
|
||||||
|
MainLevelIndex := 0;
|
||||||
|
|
||||||
|
// First check desired size and modify it if necessary
|
||||||
|
if Width <= 0 then Width := Images[MainLevelIndex].Width;
|
||||||
|
if Height <= 0 then Height := Images[MainLevelIndex].Height;
|
||||||
|
if Caps.PowerOfTwo then
|
||||||
|
begin
|
||||||
|
// If device supports only power of 2 texture sizes
|
||||||
|
Width := NextPow2(Width);
|
||||||
|
Height := NextPow2(Height);
|
||||||
|
end;
|
||||||
|
Width := ClampInt(Width, 1, Caps.MaxTextureSize);
|
||||||
|
Height := ClampInt(Height, 1, Caps.MaxTextureSize);
|
||||||
|
|
||||||
|
// Get various mipmap level counts and modify
|
||||||
|
// desired MipLevels if its value is invalid
|
||||||
|
PossibleLevels := GetNumMipMapLevels(Width, Height);
|
||||||
|
if MipMaps then
|
||||||
|
MipLevels := PossibleLevels
|
||||||
|
else
|
||||||
|
MipLevels := 1;
|
||||||
|
|
||||||
|
// Prepare array for mipmap levels. Make it larger than necessary - that
|
||||||
|
// way we can use the same index for input images and levels in the large loop below
|
||||||
|
SetLength(LevelsArray, MipLevels + MainLevelIndex);
|
||||||
|
|
||||||
|
// Now determine which image format will be used
|
||||||
|
if OverrideFormat = ifUnknown then
|
||||||
|
Desired := Images[MainLevelIndex].Format
|
||||||
|
else
|
||||||
|
Desired := OverrideFormat;
|
||||||
|
|
||||||
|
// Check if the hardware supports floating point and compressed textures
|
||||||
|
GetImageFormatInfo(Desired, Info);
|
||||||
|
if Info.IsFloatingPoint and not Caps.FloatTextures then
|
||||||
|
Desired := ifA8R8G8B8;
|
||||||
|
if (Desired in [ifDXT1, ifDXT3, ifDXT5]) and not Caps.DXTCompression then
|
||||||
|
Desired := ifA8R8G8B8;
|
||||||
|
|
||||||
|
// Try to find GL format equivalent to image format and if it is not
|
||||||
|
// found use one of default formats
|
||||||
|
if not ImageFormatToGL(Desired, GLFormat, GLType, GLInternal) then
|
||||||
|
begin
|
||||||
|
GetImageFormatInfo(Desired, Info);
|
||||||
|
if Info.HasGrayChannel then
|
||||||
|
ConvTo := ifGray8
|
||||||
|
else
|
||||||
|
ConvTo := ifA8R8G8B8;
|
||||||
|
if not ImageFormatToGL(ConvTo, GLFormat, GLType, GLInternal) then
|
||||||
|
Exit;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ConvTo := Desired;
|
||||||
|
|
||||||
|
CurrentWidth := Width;
|
||||||
|
CurrentHeight := Height;
|
||||||
|
// If user is interested in width and height of created texture lets
|
||||||
|
// give him that
|
||||||
|
if CreatedWidth <> nil then CreatedWidth^ := CurrentWidth;
|
||||||
|
if CreatedHeight <> nil then CreatedHeight^ := CurrentHeight;
|
||||||
|
|
||||||
|
// Store old pixel unpacking settings
|
||||||
|
glGetIntegerv(GL_UNPACK_ALIGNMENT, @UnpackAlignment);
|
||||||
|
glGetIntegerv(GL_UNPACK_SKIP_ROWS, @UnpackSkipRows);
|
||||||
|
glGetIntegerv(GL_UNPACK_SKIP_PIXELS, @UnpackSkipPixels);
|
||||||
|
glGetIntegerv(GL_UNPACK_ROW_LENGTH, @UnpackRowLength);
|
||||||
|
// Set new pixel unpacking settings
|
||||||
|
glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
|
||||||
|
glPixelStorei(GL_UNPACK_SKIP_ROWS, 0);
|
||||||
|
glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0);
|
||||||
|
glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
|
||||||
|
|
||||||
|
// Generate new texture, bind it and set
|
||||||
|
glGenTextures(1, @Result);
|
||||||
|
glBindTexture(GL_TEXTURE_2D, Result);
|
||||||
|
if Byte(glIsTexture(Result)) <> GL_TRUE then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
for I := MainLevelIndex to MipLevels - 1 + MainLevelIndex do
|
||||||
|
begin
|
||||||
|
// Check if we can use input image array as a source for this mipmap level
|
||||||
|
if I < ExistingLevels then
|
||||||
|
begin
|
||||||
|
// Check if input image for this mipmap level has the right
|
||||||
|
// size and format
|
||||||
|
NeedsConvert := not (Images[I].Format = ConvTo);
|
||||||
|
if ConvTo in CompressedFormats then
|
||||||
|
begin
|
||||||
|
// Input images in DXTC will have min dimensions of 4, but we need
|
||||||
|
// current Width and Height to be lesser (for glCompressedTexImage2D)
|
||||||
|
NeedsResize := not ((Images[I].Width = Max(4, CurrentWidth)) and
|
||||||
|
(Images[I].Height = Max(4, CurrentHeight)));
|
||||||
|
end
|
||||||
|
else
|
||||||
|
NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight));
|
||||||
|
|
||||||
|
if NeedsResize or NeedsConvert then
|
||||||
|
begin
|
||||||
|
// Input image must be resized or converted to different format
|
||||||
|
// to become valid mipmap level
|
||||||
|
CloneImage(Images[I], LevelsArray[I]);
|
||||||
|
if NeedsConvert then
|
||||||
|
ConvertImage(LevelsArray[I], ConvTo);
|
||||||
|
if NeedsResize then
|
||||||
|
begin
|
||||||
|
if (not PasteNonPow2ImagesIntoPow2) or (LevelsArray[I].Width > CurrentWidth) or
|
||||||
|
(LevelsArray[I].Height > CurrentHeight)then
|
||||||
|
begin
|
||||||
|
// If pasteNP2toP2 is disabled or if source is bigger than target
|
||||||
|
// we rescale image, otherwise we paste it with the same size
|
||||||
|
ResizeImage(LevelsArray[I], CurrentWidth, CurrentHeight, rfBilinear)
|
||||||
|
end
|
||||||
|
else
|
||||||
|
PasteImage(LevelsArray[I], CurrentWidth, CurrentHeight);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
// Input image can be used without any changes
|
||||||
|
LevelsArray[I] := Images[I];
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// This mipmap level is not present in the input image array
|
||||||
|
// so we create a new level
|
||||||
|
FillMipMapLevel(LevelsArray[I - 1], CurrentWidth, CurrentHeight, LevelsArray[I]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if ConvTo in CompressedFormats then
|
||||||
|
begin
|
||||||
|
// Note: GL DXTC texture snaller than 4x4 must have width and height
|
||||||
|
// as expected for non-DXTC texture (like 1x1 - we cannot
|
||||||
|
// use LevelsArray[I].Width and LevelsArray[I].Height - they are
|
||||||
|
// at least 4 for DXTC images). But Bits and Size passed to
|
||||||
|
// glCompressedTexImage2D must contain regular 4x4 DXTC block.
|
||||||
|
glCompressedTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth,
|
||||||
|
CurrentHeight, 0, LevelsArray[I].Size, LevelsArray[I].Bits)
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
glTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth,
|
||||||
|
CurrentHeight, 0, GLFormat, GLType, LevelsArray[I].Bits);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Calculate width and height of the next mipmap level
|
||||||
|
CurrentWidth := ClampInt(CurrentWidth div 2, 1, CurrentWidth);
|
||||||
|
CurrentHeight := ClampInt(CurrentHeight div 2, 1, CurrentHeight);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Restore old pixel unpacking settings
|
||||||
|
glPixelStorei(GL_UNPACK_ALIGNMENT, UnpackAlignment);
|
||||||
|
glPixelStorei(GL_UNPACK_SKIP_ROWS, UnpackSkipRows);
|
||||||
|
glPixelStorei(GL_UNPACK_SKIP_PIXELS, UnpackSkipPixels);
|
||||||
|
glPixelStorei(GL_UNPACK_ROW_LENGTH, UnpackRowLength);
|
||||||
|
finally
|
||||||
|
// Free local image copies
|
||||||
|
for I := 0 to Length(LevelsArray) - 1 do
|
||||||
|
begin
|
||||||
|
if ((I < ExistingLevels) and (LevelsArray[I].Bits <> Images[I].Bits)) or
|
||||||
|
(I >= ExistingLevels) then
|
||||||
|
FreeImage(LevelsArray[I]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean;
|
||||||
|
var
|
||||||
|
Arr: TDynImageDataArray;
|
||||||
|
Fmt: TImageFileFormat;
|
||||||
|
IsDDS: Boolean;
|
||||||
|
begin
|
||||||
|
Result := CreateMultiImageFromGLTexture(Texture, Arr);
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
Fmt := FindImageFileFormatByName(FileName);
|
||||||
|
if Fmt <> nil then
|
||||||
|
begin
|
||||||
|
IsDDS := SameText(Fmt.Extensions[0], 'dds');
|
||||||
|
if IsDDS then
|
||||||
|
begin
|
||||||
|
PushOptions;
|
||||||
|
SetOption(ImagingDDSSaveMipMapCount, Length(Arr));
|
||||||
|
end;
|
||||||
|
Result := SaveMultiImageToFile(FileName, Arr);
|
||||||
|
if IsDDS then
|
||||||
|
PopOptions;
|
||||||
|
end;
|
||||||
|
FreeImagesInArray(Arr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean;
|
||||||
|
var
|
||||||
|
Arr: TDynImageDataArray;
|
||||||
|
Fmt: TImageFileFormat;
|
||||||
|
IsDDS: Boolean;
|
||||||
|
begin
|
||||||
|
Result := CreateMultiImageFromGLTexture(Texture, Arr);
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
Fmt := FindImageFileFormatByExt(Ext);
|
||||||
|
if Fmt <> nil then
|
||||||
|
begin
|
||||||
|
IsDDS := SameText(Fmt.Extensions[0], 'dds');
|
||||||
|
if IsDDS then
|
||||||
|
begin
|
||||||
|
PushOptions;
|
||||||
|
SetOption(ImagingDDSSaveMipMapCount, Length(Arr));
|
||||||
|
end;
|
||||||
|
Result := SaveMultiImageToStream(Ext, Stream, Arr);
|
||||||
|
if IsDDS then
|
||||||
|
PopOptions;
|
||||||
|
end;
|
||||||
|
FreeImagesInArray(Arr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean;
|
||||||
|
var
|
||||||
|
Arr: TDynImageDataArray;
|
||||||
|
Fmt: TImageFileFormat;
|
||||||
|
IsDDS: Boolean;
|
||||||
|
begin
|
||||||
|
Result := CreateMultiImageFromGLTexture(Texture, Arr);
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
Fmt := FindImageFileFormatByExt(Ext);
|
||||||
|
if Fmt <> nil then
|
||||||
|
begin
|
||||||
|
IsDDS := SameText(Fmt.Extensions[0], 'dds');
|
||||||
|
if IsDDS then
|
||||||
|
begin
|
||||||
|
PushOptions;
|
||||||
|
SetOption(ImagingDDSSaveMipMapCount, Length(Arr));
|
||||||
|
end;
|
||||||
|
Result := SaveMultiImageToMemory(Ext, Data, Size, Arr);
|
||||||
|
if IsDDS then
|
||||||
|
PopOptions;
|
||||||
|
end;
|
||||||
|
FreeImagesInArray(Arr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateImageFromGLTexture(const Texture: GLuint;
|
||||||
|
var Image: TImageData; OverrideFormat: TImageFormat): Boolean;
|
||||||
|
var
|
||||||
|
Arr: TDynImageDataArray;
|
||||||
|
begin
|
||||||
|
// Just calls function operating on image arrays
|
||||||
|
FreeImage(Image);
|
||||||
|
SetLength(Arr, 1);
|
||||||
|
Result := CreateMultiImageFromGLTexture(Texture, Arr, 1, OverrideFormat);
|
||||||
|
Image := Arr[0];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateMultiImageFromGLTexture(const Texture: GLuint;
|
||||||
|
var Images: TDynImageDataArray; MipLevels: LongInt; OverrideFormat: TImageFormat): Boolean;
|
||||||
|
var
|
||||||
|
I, Width, Height, ExistingLevels: LongInt;
|
||||||
|
begin
|
||||||
|
FreeImagesInArray(Images);
|
||||||
|
SetLength(Images, 0);
|
||||||
|
Result := False;
|
||||||
|
if Byte(glIsTexture(Texture)) = GL_TRUE then
|
||||||
|
begin
|
||||||
|
// Check if desired mipmap level count is valid
|
||||||
|
glBindTexture(GL_TEXTURE_2D, Texture);
|
||||||
|
if MipLevels <= 0 then
|
||||||
|
MipLevels := GetNumMipMapLevels(Width, Height);
|
||||||
|
SetLength(Images, MipLevels);
|
||||||
|
ExistingLevels := 0;
|
||||||
|
|
||||||
|
for I := 0 to MipLevels - 1 do
|
||||||
|
begin
|
||||||
|
// Get the current level size
|
||||||
|
glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_WIDTH, @Width);
|
||||||
|
glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_HEIGHT, @Height);
|
||||||
|
// Break when the mipmap chain is broken
|
||||||
|
if (Width = 0) or (Height = 0) then
|
||||||
|
Break;
|
||||||
|
// Create new image and copy texture data
|
||||||
|
NewImage(Width, Height, ifA8R8G8B8, Images[I]);
|
||||||
|
glGetTexImage(GL_TEXTURE_2D, I, GL_BGRA_EXT, GL_UNSIGNED_BYTE, Images[I].Bits);
|
||||||
|
Inc(ExistingLevels);
|
||||||
|
end;
|
||||||
|
// Resize mipmap array if necessary
|
||||||
|
if MipLevels <> ExistingLevels then
|
||||||
|
SetLength(Images, ExistingLevels);
|
||||||
|
// Convert images to desired format if set
|
||||||
|
if OverrideFormat <> ifUnknown then
|
||||||
|
for I := 0 to Length(Images) - 1 do
|
||||||
|
ConvertImage(Images[I], OverrideFormat);
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- use internal format of texture in CreateMultiImageFromGLTexture
|
||||||
|
not only A8R8G8B8
|
||||||
|
- support for cube and 3D maps
|
||||||
|
|
||||||
|
-- 0.24.1 Changes/Bug Fixes ---------------------------------
|
||||||
|
- Added PasteNonPow2ImagesIntoPow2 option and related functionality.
|
||||||
|
- Better NeedsResize determination for small DXTC textures -
|
||||||
|
avoids needless resizing.
|
||||||
|
- Added MainLevelIndex to CreateMultiImageFromGLTexture.
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Added CreatedWidth and CreatedHeight parameters to most
|
||||||
|
LoadGLTextureFromXXX/CreateGLTextureFromXXX functions.
|
||||||
|
|
||||||
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
||||||
|
- fixed bug in CreateGLTextureFromMultiImage which caused assert failure
|
||||||
|
when creating mipmaps (using FillMipMapLevel) for DXTC formats
|
||||||
|
- changed single channel floating point texture formats from
|
||||||
|
GL_INTENSITY..._ARB to GL_LUMINANCE..._ARB
|
||||||
|
- added support for half float texture formats (GL_RGBA16F_ARB etc.)
|
||||||
|
|
||||||
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
||||||
|
- filtered mipmap creation
|
||||||
|
- more texture caps added
|
||||||
|
- fixed memory leaks in SaveGLTextureTo... functions
|
||||||
|
|
||||||
|
-- 0.15 Changes/Bug Fixes -----------------------------------
|
||||||
|
- unit created and initial stuff added
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,240 @@
|
||||||
|
{ $Id: ImagingOptions.inc 100 2007-06-28 21:09:52Z galfar $ }
|
||||||
|
|
||||||
|
{
|
||||||
|
User Options
|
||||||
|
Following defines and options can be changed by user.
|
||||||
|
}
|
||||||
|
|
||||||
|
{ Source options. }
|
||||||
|
|
||||||
|
{$DEFINE USE_INLINE} // use function inlining for some functions
|
||||||
|
// works in Free Pascal and Delphi 9+
|
||||||
|
{$DEFINE USE_ASM} // if defined, assembler versions of some
|
||||||
|
// functions will be used (only for x86)
|
||||||
|
{ $DEFINE DEBUG} // if defined, debug info, range/IO/overflow
|
||||||
|
// checking, stack frames, assertions, and
|
||||||
|
// other debugging options will be turned on
|
||||||
|
|
||||||
|
{ File format support linking options. Undefine formats which you don't want
|
||||||
|
to be registred automatically. }
|
||||||
|
|
||||||
|
{.$DEFINE LINK_JPEG} // link support for Jpeg images
|
||||||
|
{.$DEFINE LINK_PNG} // link support for PNG images
|
||||||
|
{$DEFINE LINK_TARGA} // link support for Targa images
|
||||||
|
{$DEFINE LINK_BITMAP} // link support for Windows Bitmap images
|
||||||
|
{.$DEFINE LINK_DDS} // link support for DDS images
|
||||||
|
{.$DEFINE LINK_GIF} // link support for GIF images
|
||||||
|
{.$DEFINE LINK_MNG} // link support for MNG images
|
||||||
|
{.$DEFINE LINK_JNG} // link support for JNG images
|
||||||
|
{.$DEFINE LINK_PNM} // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
|
||||||
|
|
||||||
|
{.$DEFINE LINK_EXTRAS} // link support for file formats defined in
|
||||||
|
// Extras package. Exactly which formats will be
|
||||||
|
// registered depends on settings in
|
||||||
|
// ImagingExtras.pas unit.
|
||||||
|
|
||||||
|
{ Component set used in ImagignComponents.pas unit. You usually don't need
|
||||||
|
to be concerned with this - proper component library is selected automatically
|
||||||
|
according to your compiler (only exception is using CLX in Delphi 6/7). }
|
||||||
|
|
||||||
|
{$DEFINE COMPONENT_SET_VCL} // use Borland's VCL
|
||||||
|
{ $DEFINE COMPONENT_SET_CLX} // use Borland's CLX (set automatically when using Kylix,
|
||||||
|
// must be se manually when compiling with Delphi 6/7)
|
||||||
|
{ $DEFINE COMPONENT_SET_LCL} // use Lazarus' LCL (set automatically when
|
||||||
|
// compiling with FPC)
|
||||||
|
|
||||||
|
{
|
||||||
|
Auto Options
|
||||||
|
Following options and defines are set automatically and some
|
||||||
|
are required for Imaging to compile successfully. Do not change
|
||||||
|
anything here if you don't know what you are doing.
|
||||||
|
}
|
||||||
|
|
||||||
|
{ Compiler options }
|
||||||
|
|
||||||
|
{$ALIGN ON} // Field alignment: 8 Bytes (in D6+)
|
||||||
|
{$BOOLEVAL OFF} // Boolean eval: off
|
||||||
|
{$EXTENDEDSYNTAX ON} // Extended syntax: on
|
||||||
|
{$LONGSTRINGS ON} // string = AnsiString: on
|
||||||
|
{$MINENUMSIZE 4} // Min enum size: 4 B
|
||||||
|
{$TYPEDADDRESS OFF} // Typed pointers: off
|
||||||
|
{$WRITEABLECONST OFF} // Writeable constants: off
|
||||||
|
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$DEFINE DCC} // if not using FPC then DCC compiler is used (Delphi/Kylix)
|
||||||
|
// others are not supported
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DCC}
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
{$DEFINE KYLIX} // using Kylix
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DCC}
|
||||||
|
{$IFNDEF KYLIX}
|
||||||
|
{$DEFINE DELPHI} // using Delphi
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IF (Defined(DCC) and (CompilerVersion >= 18.5))}
|
||||||
|
{$IFDEF RELEASE}
|
||||||
|
{$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set
|
||||||
|
// DEBUG/RELEASE mode in project options and RELEASE
|
||||||
|
// is currently set we undef DEBUG mode
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFEND}
|
||||||
|
|
||||||
|
{$IFDEF DEBUG}
|
||||||
|
{$ASSERTIONS ON}
|
||||||
|
{$DEBUGINFO ON}
|
||||||
|
{$RANGECHECKS ON}
|
||||||
|
{$IOCHECKS ON}
|
||||||
|
{$OVERFLOWCHECKS ON}
|
||||||
|
{$IFDEF DCC}
|
||||||
|
{$OPTIMIZATION OFF}
|
||||||
|
{$STACKFRAMES ON}
|
||||||
|
{$LOCALSYMBOLS ON}
|
||||||
|
{ $DEFINE MEMCHECK}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$S+}
|
||||||
|
{$CHECKPOINTER ON}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ELSE}
|
||||||
|
{$ASSERTIONS OFF}
|
||||||
|
{$DEBUGINFO OFF}
|
||||||
|
{$RANGECHECKS OFF}
|
||||||
|
{$IOCHECKS OFF}
|
||||||
|
{$OVERFLOWCHECKS OFF}
|
||||||
|
{$IFDEF DCC}
|
||||||
|
{$OPTIMIZATION ON}
|
||||||
|
{$STACKFRAMES OFF}
|
||||||
|
{$LOCALSYMBOLS OFF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$S-}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ Compiler capabilities }
|
||||||
|
|
||||||
|
// Define if compiler supports inlining of functions and procedures
|
||||||
|
// Note that FPC inline support crashed in older versions (1.9.8)
|
||||||
|
{$IF (Defined(DCC) and (CompilerVersion >= 17)) or (Defined(FPC) and Defined(CPU86))}
|
||||||
|
{$DEFINE HAS_INLINE}
|
||||||
|
{$IFEND}
|
||||||
|
|
||||||
|
// Define if compiler supports advanced records with methods
|
||||||
|
{$IF (Defined(DCC) and (CompilerVersion >= 18)) }
|
||||||
|
{$DEFINE HAS_ADVANCED_RECORDS}
|
||||||
|
{$IFEND}
|
||||||
|
|
||||||
|
// Define if compiler supports operator overloading
|
||||||
|
// (unfortunately Delphi and FPC operator overloaing is not compatible)
|
||||||
|
{$IF (Defined(DCC) and (CompilerVersion >= 18)) or Defined(FPC)}
|
||||||
|
{$DEFINE HAS_OPERATOR_OVERLOADING}
|
||||||
|
{$IFEND}
|
||||||
|
|
||||||
|
{ Imaging options check}
|
||||||
|
|
||||||
|
{$IFNDEF HAS_INLINE}
|
||||||
|
{$UNDEF USE_INLINE}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$IFNDEF CPU86}
|
||||||
|
{$UNDEF USE_ASM}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$DEFINE COMPONENT_SET_LCL}
|
||||||
|
{$UNDEF COMPONENT_SET_VCL}
|
||||||
|
{$UNDEF COMPONENT_SET_CLX}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF KYLIX}
|
||||||
|
{$DEFINE COMPONENT_SET_CLX}
|
||||||
|
{$UNDEF COMPONENT_SET_VCL}
|
||||||
|
{$UNDEF COMPONENT_SET_LCL}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DELPHI}
|
||||||
|
{$UNDEF COMPONENT_SET_LCL}
|
||||||
|
{$IF CompilerVersion >= 17}
|
||||||
|
{$UNDEF COMPONENT_SET_CLX} // Delphi 9+ has no CLX
|
||||||
|
{$IFEND}
|
||||||
|
{$IFNDEF COMPONENT_SET_VCL}
|
||||||
|
{$IFNDEF COMPONENT_SET_CLX}
|
||||||
|
{$DEFINE COMPONENT_SET_VCL} // use VCL as default if not set
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF COMPONENT_SET_VCL}
|
||||||
|
{$UNDEF COMPONENT_SET_CLX}
|
||||||
|
{$UNDEF COMPONENT_SET_LCL}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF COMPONENT_SET_CLX}
|
||||||
|
{$UNDEF COMPONENT_SET_VCL}
|
||||||
|
{$UNDEF COMPONENT_SET_LCL}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF COMPONENT_SET_LCL}
|
||||||
|
{$UNDEF COMPONENT_SET_VCL}
|
||||||
|
{$UNDEF COMPONENT_SET_CLX}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ Platform options }
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$DEFINE MSWINDOWS}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF DPMI}
|
||||||
|
{$DEFINE MSDOS}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
{$DEFINE UNIX}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ More compiler options }
|
||||||
|
|
||||||
|
{$IFDEF FPC} // Free Pascal options - some options set above (like min enum size)
|
||||||
|
// are reset to defaults by setting {$MODE} so they are
|
||||||
|
// redeclared here
|
||||||
|
{$MODE DELPHI} // compatible with delphi
|
||||||
|
{$GOTO ON} // alow goto
|
||||||
|
{$PACKRECORDS 8} // same as ALING 8 for Delphi
|
||||||
|
{$PACKENUM 4} // Min enum size: 4 B
|
||||||
|
{$CALLING REGISTER} // default calling convention is register
|
||||||
|
{$IFDEF CPU86}
|
||||||
|
{$IFNDEF DYN_LIBRARY}
|
||||||
|
{$SMARTLINK ON} // smartlinking on, but not for dll/so -
|
||||||
|
// nothing gets exported from library when it is on
|
||||||
|
// in FPC 1.9.8
|
||||||
|
{$ENDIF}
|
||||||
|
{$ASMMODE INTEL} // intel assembler mode
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF HAS_INLINE}
|
||||||
|
{$INLINE ON} // turns inlining on for compilers that support it
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ Extension dependencies check }
|
||||||
|
|
||||||
|
{$IFDEF LINK_MNG} // MNG uses internaly both PNG and JNG
|
||||||
|
{$DEFINE LINK_JNG}
|
||||||
|
{$DEFINE LINK_PNG}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINK_JNG} // JNG uses internaly both PNG and JPEG
|
||||||
|
{$DEFINE LINK_PNG}
|
||||||
|
{$DEFINE LINK_JPEG}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -0,0 +1,965 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingPortableMaps.pas 107 2007-11-06 23:37:48Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains loader/saver for Portable Maps file format family (or PNM).
|
||||||
|
That includes PBM, PGM, PPM, PAM, and PFM formats.}
|
||||||
|
unit ImagingPortableMaps;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, ImagingTypes, Imaging, ImagingFormats, ImagingUtility;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Types of pixels of PNM images.}
|
||||||
|
TTupleType = (ttInvalid, ttBlackAndWhite, ttGrayScale, ttRGB, ttBlackAndWhiteAlpha,
|
||||||
|
ttGrayScaleAlpha, ttRGBAlpha, ttGrayScaleFP, ttRGBFP);
|
||||||
|
|
||||||
|
{ Record with info about PNM image used in both loading and saving functions.}
|
||||||
|
TPortableMapInfo = record
|
||||||
|
Width: LongInt;
|
||||||
|
Height: LongInt;
|
||||||
|
FormatId: Char;
|
||||||
|
MaxVal: LongInt;
|
||||||
|
BitCount: LongInt;
|
||||||
|
Depth: LongInt;
|
||||||
|
TupleType: TTupleType;
|
||||||
|
Binary: Boolean;
|
||||||
|
HasPAMHeader: Boolean;
|
||||||
|
IsBigEndian: Boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Base class for Portable Map file formats (or Portable AnyMaps or PNM).
|
||||||
|
There are several types of PNM file formats that share common
|
||||||
|
(simple) structure. This class can actually load all supported PNM formats.
|
||||||
|
Saving is also done by this class but descendants (each for different PNM
|
||||||
|
format) control it.}
|
||||||
|
TPortableMapFileFormat = class(TImageFileFormat)
|
||||||
|
protected
|
||||||
|
FIdNumbers: TChar2;
|
||||||
|
FSaveBinary: LongBool;
|
||||||
|
FMapInfo: TPortableMapInfo;
|
||||||
|
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
|
||||||
|
OnlyFirstLevel: Boolean): Boolean; override;
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
function TestFormat(Handle: TImagingHandle): Boolean; override;
|
||||||
|
published
|
||||||
|
{ If set to True images will be saved in binary format. If it is False
|
||||||
|
they will be saved in text format (which could result in 5-10x bigger file).
|
||||||
|
Default is value True. Note that PAM and PFM files are always saved in binary.}
|
||||||
|
property SaveBinary: LongBool read FSaveBinary write FSaveBinary;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Portable Bit Map is used to store monochrome 1bit images. Raster data
|
||||||
|
can be saved as text or binary data. Either way value of 0 represents white
|
||||||
|
and 1 is black. As Imaging does not have support for 1bit data formats
|
||||||
|
PBM images can be loaded but not saved. Loaded images are returned in
|
||||||
|
ifGray8 format (witch pixel values scaled from 1bit to 8bit).}
|
||||||
|
TPBMFileFormat = class(TPortableMapFileFormat)
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Portable Gray Map is used to store grayscale 8bit or 16bit images.
|
||||||
|
Raster data can be saved as text or binary data.}
|
||||||
|
TPGMFileFormat = class(TPortableMapFileFormat)
|
||||||
|
protected
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Portable Pixel Map is used to store RGB images with 8bit or 16bit channels.
|
||||||
|
Raster data can be saved as text or binary data.}
|
||||||
|
TPPMFileFormat = class(TPortableMapFileFormat)
|
||||||
|
protected
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Portable Arbitrary Map is format that can store image data formats
|
||||||
|
of PBM, PGM, and PPM formats with optional alpha channel. Raster data
|
||||||
|
can be stored only in binary format. All data formats supported
|
||||||
|
by this format are ifGray8, ifGray16, ifA8Gray8, ifA16Gray16,
|
||||||
|
ifR8G8B8, ifR16G16R16, ifA8R8G8B8, and ifA16R16G16B16.}
|
||||||
|
TPAMFileFormat = class(TPortableMapFileFormat)
|
||||||
|
protected
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Portable Float Map is unofficial extension of PNM format family which
|
||||||
|
can store images with floating point pixels. Raster data is saved in
|
||||||
|
binary format as array of IEEE 32 bit floating point numbers. One channel
|
||||||
|
or RGB images are supported by PFM format (so no alpha).}
|
||||||
|
TPFMFileFormat = class(TPortableMapFileFormat)
|
||||||
|
protected
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
PortableMapDefaultBinary = True;
|
||||||
|
|
||||||
|
SPBMFormatName = 'Portable Bit Map';
|
||||||
|
SPBMMasks = '*.pbm';
|
||||||
|
SPGMFormatName = 'Portable Gray Map';
|
||||||
|
SPGMMasks = '*.pgm';
|
||||||
|
PGMSupportedFormats = [ifGray8, ifGray16];
|
||||||
|
SPPMFormatName = 'Portable Pixel Map';
|
||||||
|
SPPMMasks = '*.ppm';
|
||||||
|
PPMSupportedFormats = [ifR8G8B8, ifR16G16B16];
|
||||||
|
SPAMFormatName = 'Portable Arbitrary Map';
|
||||||
|
SPAMMasks = '*.pam';
|
||||||
|
PAMSupportedFormats = [ifGray8, ifGray16, ifA8Gray8, ifA16Gray16,
|
||||||
|
ifR8G8B8, ifR16G16B16, ifA8R8G8B8, ifA16R16G16B16];
|
||||||
|
SPFMFormatName = 'Portable Float Map';
|
||||||
|
SPFMMasks = '*.pfm';
|
||||||
|
PFMSupportedFormats = [ifR32F, ifA32B32G32R32F];
|
||||||
|
|
||||||
|
const
|
||||||
|
{ TAB, CR, LF, and Space are used as seperators in Portable map headers and data.}
|
||||||
|
WhiteSpaces = [#9, #10, #13, #32];
|
||||||
|
SPAMWidth = 'WIDTH';
|
||||||
|
SPAMHeight = 'HEIGHT';
|
||||||
|
SPAMDepth = 'DEPTH';
|
||||||
|
SPAMMaxVal = 'MAXVAL';
|
||||||
|
SPAMTupleType = 'TUPLTYPE';
|
||||||
|
SPAMEndHdr = 'ENDHDR';
|
||||||
|
|
||||||
|
{ Size of buffer used to speed up text PNM loading/saving.}
|
||||||
|
LineBufferCapacity = 16 * 1024;
|
||||||
|
|
||||||
|
TupleTypeNames: array[TTupleType] of string = (
|
||||||
|
'INVALID', 'BLACKANDWHITE', 'GRAYSCALE', 'RGB',
|
||||||
|
'BLACKANDWHITE_ALPHA', 'GRAYSCALE_ALPHA', 'RGB_ALPHA', 'GRAYSCALEFP',
|
||||||
|
'RGBFP');
|
||||||
|
|
||||||
|
{ TPortableMapFileFormat }
|
||||||
|
|
||||||
|
constructor TPortableMapFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FCanLoad := True;
|
||||||
|
FCanSave := True;
|
||||||
|
FIsMultiImageFormat := False;
|
||||||
|
FSaveBinary := PortableMapDefaultBinary;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPortableMapFileFormat.LoadData(Handle: TImagingHandle;
|
||||||
|
var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
I, ScanLineSize, MonoSize: LongInt;
|
||||||
|
Dest: PByte;
|
||||||
|
MonoData: Pointer;
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
PixelFP: TColorFPRec;
|
||||||
|
LineBuffer: array[0..LineBufferCapacity - 1] of Char;
|
||||||
|
LineEnd, LinePos: LongInt;
|
||||||
|
|
||||||
|
procedure CheckBuffer;
|
||||||
|
begin
|
||||||
|
if (LineEnd = 0) or (LinePos = LineEnd) then
|
||||||
|
begin
|
||||||
|
// Reload buffer if its is empty or its end was reached
|
||||||
|
LineEnd := GetIO.Read(Handle, @LineBuffer[0], LineBufferCapacity);
|
||||||
|
LinePos := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FixInputPos;
|
||||||
|
begin
|
||||||
|
// Sets input's position to its real pos as it would be without buffering
|
||||||
|
if LineEnd > 0 then
|
||||||
|
begin
|
||||||
|
GetIO.Seek(Handle, -LineEnd + LinePos, smFromCurrent);
|
||||||
|
LineEnd := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ReadString: string;
|
||||||
|
var
|
||||||
|
S: AnsiString;
|
||||||
|
C: Char;
|
||||||
|
begin
|
||||||
|
// First skip all whitespace chars
|
||||||
|
SetLength(S, 1);
|
||||||
|
repeat
|
||||||
|
CheckBuffer;
|
||||||
|
S[1] := LineBuffer[LinePos];
|
||||||
|
Inc(LinePos);
|
||||||
|
if S[1] = '#' then
|
||||||
|
repeat
|
||||||
|
// Comment detected, skip everything until next line is reached
|
||||||
|
CheckBuffer;
|
||||||
|
S[1] := LineBuffer[LinePos];
|
||||||
|
Inc(LinePos);
|
||||||
|
until S[1] = #10;
|
||||||
|
until not(S[1] in WhiteSpaces);
|
||||||
|
// Now we have reached some chars other than white space, read them until
|
||||||
|
// there is whitespace again
|
||||||
|
repeat
|
||||||
|
SetLength(S, Length(S) + 1);
|
||||||
|
CheckBuffer;
|
||||||
|
S[Length(S)] := LineBuffer[LinePos];
|
||||||
|
Inc(LinePos);
|
||||||
|
// Repeat until current char is whitespace or end of file is reached
|
||||||
|
// (Line buffer has 0 bytes which happens only on EOF)
|
||||||
|
until (S[Length(S)] in WhiteSpaces) or (LineEnd = 0);
|
||||||
|
// Get rid of last char - whitespace or null
|
||||||
|
SetLength(S, Length(S) - 1);
|
||||||
|
// Move position to the beginning of next string (skip white space - needed
|
||||||
|
// to make the loader stop at the right input position)
|
||||||
|
repeat
|
||||||
|
CheckBuffer;
|
||||||
|
C := LineBuffer[LinePos];
|
||||||
|
Inc(LinePos);
|
||||||
|
until not (C in WhiteSpaces) or (LineEnd = 0);
|
||||||
|
// Dec pos, current is the beggining of the the string
|
||||||
|
Dec(LinePos);
|
||||||
|
|
||||||
|
Result := S;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ReadIntValue: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
|
begin
|
||||||
|
Result := StrToInt(ReadString);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ParseHeader: Boolean;
|
||||||
|
var
|
||||||
|
Id: TChar2;
|
||||||
|
I: TTupleType;
|
||||||
|
TupleTypeName: string;
|
||||||
|
Scale: Single;
|
||||||
|
OldSeparator: Char;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
with GetIO do
|
||||||
|
begin
|
||||||
|
FillChar(FMapInfo, SizeOf(FMapInfo), 0);
|
||||||
|
Read(Handle, @Id, SizeOf(Id));
|
||||||
|
if Id[1] in ['1'..'6'] then
|
||||||
|
begin
|
||||||
|
// Read header for PBM, PGM, and PPM files
|
||||||
|
FMapInfo.Width := ReadIntValue;
|
||||||
|
FMapInfo.Height := ReadIntValue;
|
||||||
|
if Id[1] in ['1', '4'] then
|
||||||
|
begin
|
||||||
|
FMapInfo.MaxVal := 1;
|
||||||
|
FMapInfo.BitCount := 1
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Read channel max value, <=255 for 8bit images, >255 for 16bit images
|
||||||
|
// but some programs think its max colors so put <=256 here
|
||||||
|
FMapInfo.MaxVal := ReadIntValue;
|
||||||
|
FMapInfo.BitCount := Iff(FMapInfo.MaxVal <= 256, 8, 16);
|
||||||
|
end;
|
||||||
|
|
||||||
|
FMapInfo.Depth := 1;
|
||||||
|
case Id[1] of
|
||||||
|
'1', '4': FMapInfo.TupleType := ttBlackAndWhite;
|
||||||
|
'2', '5': FMapInfo.TupleType := ttGrayScale;
|
||||||
|
'3', '6':
|
||||||
|
begin
|
||||||
|
FMapInfo.TupleType := ttRGB;
|
||||||
|
FMapInfo.Depth := 3;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else if Id[1] = '7' then
|
||||||
|
begin
|
||||||
|
// Read values from PAM header
|
||||||
|
// WIDTH
|
||||||
|
if (ReadString <> SPAMWidth) then Exit;
|
||||||
|
FMapInfo.Width := ReadIntValue;
|
||||||
|
// HEIGHT
|
||||||
|
if (ReadString <> SPAMheight) then Exit;
|
||||||
|
FMapInfo.Height := ReadIntValue;
|
||||||
|
// DEPTH
|
||||||
|
if (ReadString <> SPAMDepth) then Exit;
|
||||||
|
FMapInfo.Depth := ReadIntValue;
|
||||||
|
// MAXVAL
|
||||||
|
if (ReadString <> SPAMMaxVal) then Exit;
|
||||||
|
FMapInfo.MaxVal := ReadIntValue;
|
||||||
|
FMapInfo.BitCount := Iff(FMapInfo.MaxVal <= 256, 8, 16);
|
||||||
|
// TUPLETYPE
|
||||||
|
if (ReadString <> SPAMTupleType) then Exit;
|
||||||
|
TupleTypeName := ReadString;
|
||||||
|
for I := Low(TTupleType) to High(TTupleType) do
|
||||||
|
if SameText(TupleTypeName, TupleTypeNames[I]) then
|
||||||
|
begin
|
||||||
|
FMapInfo.TupleType := I;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
// ENDHDR
|
||||||
|
if (ReadString <> SPAMEndHdr) then Exit;
|
||||||
|
end
|
||||||
|
else if Id[1] in ['F', 'f'] then
|
||||||
|
begin
|
||||||
|
// Read header of PFM file
|
||||||
|
FMapInfo.Width := ReadIntValue;
|
||||||
|
FMapInfo.Height := ReadIntValue;
|
||||||
|
OldSeparator := DecimalSeparator;
|
||||||
|
DecimalSeparator := '.';
|
||||||
|
Scale := StrToFloatDef(ReadString, 0);
|
||||||
|
DecimalSeparator := OldSeparator;
|
||||||
|
FMapInfo.IsBigEndian := Scale > 0.0;
|
||||||
|
if Id[1] = 'F' then
|
||||||
|
FMapInfo.TupleType := ttRGBFP
|
||||||
|
else
|
||||||
|
FMapInfo.TupleType := ttGrayScaleFP;
|
||||||
|
FMapInfo.Depth := Iff(FMapInfo.TupleType = ttRGBFP, 3, 1);
|
||||||
|
FMapInfo.BitCount := Iff(FMapInfo.TupleType = ttRGBFP, 96, 32);
|
||||||
|
end;
|
||||||
|
|
||||||
|
FixInputPos;
|
||||||
|
FMapInfo.Binary := (Id[1] in ['4', '5', '6', '7', 'F', 'f']);
|
||||||
|
// Check if values found in header are valid
|
||||||
|
Result := (FMapInfo.Width > 0) and (FMapInfo.Height > 0) and
|
||||||
|
(FMapInfo.BitCount in [1, 8, 16, 32, 96]) and (FMapInfo.TupleType <> ttInvalid);
|
||||||
|
// Now check if image has proper number of channels (PAM)
|
||||||
|
if Result then
|
||||||
|
case FMapInfo.TupleType of
|
||||||
|
ttBlackAndWhite, ttGrayScale: Result := FMapInfo.Depth = 1;
|
||||||
|
ttBlackAndWhiteAlpha, ttGrayScaleAlpha: Result := FMapInfo.Depth = 2;
|
||||||
|
ttRGB: Result := FMapInfo.Depth = 3;
|
||||||
|
ttRGBAlpha: Result := FMapInfo.Depth = 4;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
LineEnd := 0;
|
||||||
|
LinePos := 0;
|
||||||
|
SetLength(Images, 1);
|
||||||
|
with GetIO, Images[0] do
|
||||||
|
begin
|
||||||
|
Format := ifUnknown;
|
||||||
|
// Try to parse file header
|
||||||
|
if not ParseHeader then Exit;
|
||||||
|
// Select appropriate data format based on values read from file header
|
||||||
|
case FMapInfo.TupleType of
|
||||||
|
ttBlackAndWhite: Format := ifGray8;
|
||||||
|
ttBlackAndWhiteAlpha: Format := ifA8Gray8;
|
||||||
|
ttGrayScale: Format := IffFormat(FMapInfo.BitCount = 8, ifGray8, ifGray16);
|
||||||
|
ttGrayScaleAlpha: Format := IffFormat(FMapInfo.BitCount = 8, ifA8Gray8, ifA16Gray16);
|
||||||
|
ttRGB: Format := IffFormat(FMapInfo.BitCount = 8, ifR8G8B8, ifR16G16B16);
|
||||||
|
ttRGBAlpha: Format := IffFormat(FMapInfo.BitCount = 8, ifA8R8G8B8, ifA16R16G16B16);
|
||||||
|
ttGrayScaleFP: Format := ifR32F;
|
||||||
|
ttRGBFP: Format := ifA32B32G32R32F;
|
||||||
|
end;
|
||||||
|
// Exit if no matching data format was found
|
||||||
|
if Format = ifUnknown then Exit;
|
||||||
|
|
||||||
|
NewImage(FMapInfo.Width, FMapInfo.Height, Format, Images[0]);
|
||||||
|
Info := GetFormatInfo(Format);
|
||||||
|
|
||||||
|
// Now read pixels from file to dest image
|
||||||
|
if not FMapInfo.Binary then
|
||||||
|
begin
|
||||||
|
Dest := Bits;
|
||||||
|
for I := 0 to Width * Height - 1 do
|
||||||
|
begin
|
||||||
|
case Format of
|
||||||
|
ifGray8:
|
||||||
|
begin
|
||||||
|
Dest^ := ReadIntValue;
|
||||||
|
if FMapInfo.BitCount = 1 then
|
||||||
|
// If source is 1bit mono image (where 0=white, 1=black)
|
||||||
|
// we must scale it to 8bits
|
||||||
|
Dest^ := 255 - Dest^ * 255;
|
||||||
|
end;
|
||||||
|
ifGray16: PWord(Dest)^ := ReadIntValue;
|
||||||
|
ifR8G8B8:
|
||||||
|
with PColor24Rec(Dest)^ do
|
||||||
|
begin
|
||||||
|
R := ReadIntValue;
|
||||||
|
G := ReadIntValue;
|
||||||
|
B := ReadIntValue;
|
||||||
|
end;
|
||||||
|
ifR16G16B16:
|
||||||
|
with PColor48Rec(Dest)^ do
|
||||||
|
begin
|
||||||
|
R := ReadIntValue;
|
||||||
|
G := ReadIntValue;
|
||||||
|
B := ReadIntValue;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(Dest, Info.BytesPerPixel);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if FMapInfo.BitCount > 1 then
|
||||||
|
begin
|
||||||
|
if not (FMapInfo.TupleType in [ttGrayScaleFP, ttRGBFP]) then
|
||||||
|
begin
|
||||||
|
// Just copy bytes from binary Portable Maps (non 1bit, non FP)
|
||||||
|
Read(Handle, Bits, Size);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Dest := Bits;
|
||||||
|
// FP images are in BGR order and endian swap maybe needed.
|
||||||
|
// Some programs store scanlines in bottom-up order but
|
||||||
|
// I will stick with Photoshops behaviour here
|
||||||
|
for I := 0 to Width * Height - 1 do
|
||||||
|
begin
|
||||||
|
Read(Handle, @PixelFP, FMapInfo.BitCount shr 3);
|
||||||
|
if FMapInfo.TupleType = ttRGBFP then
|
||||||
|
with PColorFPRec(Dest)^ do
|
||||||
|
begin
|
||||||
|
A := 1.0;
|
||||||
|
R := PixelFP.R;
|
||||||
|
G := PixelFP.G;
|
||||||
|
B := PixelFP.B;
|
||||||
|
if FMapInfo.IsBigEndian then
|
||||||
|
SwapEndianLongWord(PLongWord(Dest), 3);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
PSingle(Dest)^ := PixelFP.B;
|
||||||
|
if FMapInfo.IsBigEndian then
|
||||||
|
SwapEndianLongWord(PLongWord(Dest), 1);
|
||||||
|
end;
|
||||||
|
Inc(Dest, Info.BytesPerPixel);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FMapInfo.TupleType in [ttBlackAndWhite, ttBlackAndWhiteAlpha] then
|
||||||
|
begin
|
||||||
|
// Black and white PAM files must be scaled to 8bits. Note that
|
||||||
|
// in PAM files 1=white, 0=black (reverse of PBM)
|
||||||
|
for I := 0 to Width * Height * Iff(FMapInfo.TupleType = ttBlackAndWhiteAlpha, 2, 1) - 1 do
|
||||||
|
PByteArray(Bits)[I] := PByteArray(Bits)[I] * 255;
|
||||||
|
end;
|
||||||
|
if FMapInfo.TupleType in [ttRGB, ttRGBAlpha] then
|
||||||
|
begin
|
||||||
|
// Swap channels of RGB/ARGB images. Binary RGB image files use BGR order.
|
||||||
|
SwapChannels(Images[0], ChannelBlue, ChannelRed);
|
||||||
|
end;
|
||||||
|
if FMapInfo.BitCount = 16 then
|
||||||
|
begin
|
||||||
|
Dest := Bits;
|
||||||
|
for I := 0 to Width * Height * Info.BytesPerPixel div SizeOf(Word) - 1 do
|
||||||
|
begin
|
||||||
|
PWord(Dest)^ := SwapEndianWord(PWord(Dest)^);
|
||||||
|
Inc(Dest, SizeOf(Word));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Handle binary PBM files (ttBlackAndWhite 1bit)
|
||||||
|
ScanLineSize := (Width + 7) div 8;
|
||||||
|
// Get total binary data size, read it from file to temp
|
||||||
|
// buffer and convert the data to Gray8
|
||||||
|
MonoSize := ScanLineSize * Height;
|
||||||
|
GetMem(MonoData, MonoSize);
|
||||||
|
try
|
||||||
|
Read(Handle, MonoData, MonoSize);
|
||||||
|
Convert1To8(MonoData, Bits, Width, Height, ScanLineSize);
|
||||||
|
// 1bit mono images must be scaled to 8bit (where 0=white, 1=black)
|
||||||
|
for I := 0 to Width * Height - 1 do
|
||||||
|
PByteArray(Bits)[I] := 255 - PByteArray(Bits)[I] * 255;
|
||||||
|
finally
|
||||||
|
FreeMem(MonoData);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FixInputPos;
|
||||||
|
|
||||||
|
if (FMapInfo.MaxVal <> Pow2Int(FMapInfo.BitCount) - 1) and
|
||||||
|
(FMapInfo.TupleType in [ttGrayScale, ttGrayScaleAlpha, ttRGB, ttRGBAlpha]) then
|
||||||
|
begin
|
||||||
|
Dest := Bits;
|
||||||
|
// Scale color values according to MaxVal we got from header
|
||||||
|
// if necessary.
|
||||||
|
for I := 0 to Width * Height * Info.BytesPerPixel div (FMapInfo.BitCount shr 3) - 1 do
|
||||||
|
begin
|
||||||
|
if FMapInfo.BitCount = 8 then
|
||||||
|
Dest^ := Dest^ * 255 div FMapInfo.MaxVal
|
||||||
|
else
|
||||||
|
PWord(Dest)^ := PWord(Dest)^ * 65535 div FMapInfo.MaxVal;
|
||||||
|
Inc(Dest, FMapInfo.BitCount shr 3);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPortableMapFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: Integer): Boolean;
|
||||||
|
const
|
||||||
|
LineDelimiter = #10;
|
||||||
|
PixelDelimiter = #32;
|
||||||
|
var
|
||||||
|
ImageToSave: TImageData;
|
||||||
|
MustBeFreed: Boolean;
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
I, LineLength: LongInt;
|
||||||
|
Src: PByte;
|
||||||
|
Pixel32: TColor32Rec;
|
||||||
|
Pixel64: TColor64Rec;
|
||||||
|
W: Word;
|
||||||
|
|
||||||
|
procedure WriteString(S: string; Delimiter: Char = LineDelimiter);
|
||||||
|
begin
|
||||||
|
SetLength(S, Length(S) + 1);
|
||||||
|
S[Length(S)] := Delimiter;
|
||||||
|
GetIO.Write(Handle, @S[1], Length(S));
|
||||||
|
Inc(LineLength, Length(S));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure WriteHeader;
|
||||||
|
var
|
||||||
|
OldSeparator: Char;
|
||||||
|
begin
|
||||||
|
WriteString('P' + FMapInfo.FormatId);
|
||||||
|
if not FMapInfo.HasPAMHeader then
|
||||||
|
begin
|
||||||
|
// Write header of PGM, PPM, and PFM files
|
||||||
|
WriteString(IntToStr(ImageToSave.Width));
|
||||||
|
WriteString(IntToStr(ImageToSave.Height));
|
||||||
|
case FMapInfo.TupleType of
|
||||||
|
ttGrayScale, ttRGB: WriteString(IntToStr(Pow2Int(FMapInfo.BitCount) - 1));
|
||||||
|
ttGrayScaleFP, ttRGBFP:
|
||||||
|
begin
|
||||||
|
OldSeparator := DecimalSeparator;
|
||||||
|
DecimalSeparator := '.';
|
||||||
|
// Negative value indicates that raster data is saved in little endian
|
||||||
|
WriteString(FloatToStr(-1.0));
|
||||||
|
DecimalSeparator := OldSeparator;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Write PAM file header
|
||||||
|
WriteString(Format('%s %d', [SPAMWidth, ImageToSave.Width]));
|
||||||
|
WriteString(Format('%s %d', [SPAMHeight, ImageToSave.Height]));
|
||||||
|
WriteString(Format('%s %d', [SPAMDepth, FMapInfo.Depth]));
|
||||||
|
WriteString(Format('%s %d', [SPAMMaxVal, Pow2Int(FMapInfo.BitCount) - 1]));
|
||||||
|
WriteString(Format('%s %s', [SPAMTupleType, TupleTypeNames[FMapInfo.TupleType]]));
|
||||||
|
WriteString(SPAMEndHdr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
|
||||||
|
with GetIO, ImageToSave do
|
||||||
|
try
|
||||||
|
Info := GetFormatInfo(Format);
|
||||||
|
// Fill values of MapInfo record that were not filled by
|
||||||
|
// descendants in their SaveData methods
|
||||||
|
FMapInfo.BitCount := (Info.BytesPerPixel div Info.ChannelCount) * 8;
|
||||||
|
FMapInfo.Depth := Info.ChannelCount;
|
||||||
|
if FMapInfo.TupleType = ttInvalid then
|
||||||
|
begin
|
||||||
|
if Info.HasGrayChannel then
|
||||||
|
begin
|
||||||
|
if Info.HasAlphaChannel then
|
||||||
|
FMapInfo.TupleType := ttGrayScaleAlpha
|
||||||
|
else
|
||||||
|
FMapInfo.TupleType := ttGrayScale;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if Info.HasAlphaChannel then
|
||||||
|
FMapInfo.TupleType := ttRGBAlpha
|
||||||
|
else
|
||||||
|
FMapInfo.TupleType := ttRGB;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// Write file header
|
||||||
|
WriteHeader;
|
||||||
|
|
||||||
|
if not FMapInfo.Binary then
|
||||||
|
begin
|
||||||
|
Src := Bits;
|
||||||
|
LineLength := 0;
|
||||||
|
// For each pixel find its text representation and write it to file
|
||||||
|
for I := 0 to Width * Height - 1 do
|
||||||
|
begin
|
||||||
|
case Format of
|
||||||
|
ifGray8: WriteString(IntToStr(Src^), PixelDelimiter);
|
||||||
|
ifGray16: WriteString(IntToStr(PWord(Src)^), PixelDelimiter);
|
||||||
|
ifR8G8B8:
|
||||||
|
with PColor24Rec(Src)^ do
|
||||||
|
WriteString(SysUtils.Format('%d %d %d', [R, G, B]), PixelDelimiter);
|
||||||
|
ifR16G16B16:
|
||||||
|
with PColor48Rec(Src)^ do
|
||||||
|
WriteString(SysUtils.Format('%d %d %d', [R, G, B]), PixelDelimiter);
|
||||||
|
end;
|
||||||
|
// Lines in text PNM images should have length <70
|
||||||
|
if LineLength > 65 then
|
||||||
|
begin
|
||||||
|
LineLength := 0;
|
||||||
|
WriteString('', LineDelimiter);
|
||||||
|
end;
|
||||||
|
Inc(Src, Info.BytesPerPixel);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Write binary images
|
||||||
|
if not (FMapInfo.TupleType in [ttGrayScaleFP, ttRGBFP]) then
|
||||||
|
begin
|
||||||
|
// Save integer binary images
|
||||||
|
if FMapInfo.BitCount = 8 then
|
||||||
|
begin
|
||||||
|
if FMapInfo.TupleType in [ttGrayScale, ttGrayScaleAlpha] then
|
||||||
|
begin
|
||||||
|
// 8bit grayscale images can be written in one Write call
|
||||||
|
Write(Handle, Bits, Size);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// 8bit RGB/ARGB images: read and blue must be swapped and
|
||||||
|
// 3 or 4 bytes must be written
|
||||||
|
Src := Bits;
|
||||||
|
for I := 0 to Width * Height - 1 do
|
||||||
|
with PColor32Rec(Src)^ do
|
||||||
|
begin
|
||||||
|
if FMapInfo.TupleType = ttRGBAlpha then
|
||||||
|
Pixel32.A := A;
|
||||||
|
Pixel32.R := B;
|
||||||
|
Pixel32.G := G;
|
||||||
|
Pixel32.B := R;
|
||||||
|
Write(Handle, @Pixel32, Info.BytesPerPixel);
|
||||||
|
Inc(Src, Info.BytesPerPixel);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Images with 16bit channels: make sure that channel values are saved in big endian
|
||||||
|
Src := Bits;
|
||||||
|
if FMapInfo.TupleType in [ttGrayScale, ttGrayScaleAlpha] then
|
||||||
|
begin
|
||||||
|
// 16bit grayscale image
|
||||||
|
for I := 0 to Width * Height * Info.BytesPerPixel div SizeOf(Word) - 1 do
|
||||||
|
begin
|
||||||
|
W := SwapEndianWord(PWord(Src)^);
|
||||||
|
Write(Handle, @W, SizeOf(Word));
|
||||||
|
Inc(Src, SizeOf(Word));
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// RGB images with 16bit channels: swap RB and endian too
|
||||||
|
for I := 0 to Width * Height - 1 do
|
||||||
|
with PColor64Rec(Src)^ do
|
||||||
|
begin
|
||||||
|
if FMapInfo.TupleType = ttRGBAlpha then
|
||||||
|
Pixel64.A := SwapEndianWord(A);
|
||||||
|
Pixel64.R := SwapEndianWord(B);
|
||||||
|
Pixel64.G := SwapEndianWord(G);
|
||||||
|
Pixel64.B := SwapEndianWord(R);
|
||||||
|
Write(Handle, @Pixel64, Info.BytesPerPixel);
|
||||||
|
Inc(Src, Info.BytesPerPixel);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Floating point images (no need to swap endian here - little
|
||||||
|
// endian is specified in file header)
|
||||||
|
if FMapInfo.TupleType = ttGrayScaleFP then
|
||||||
|
begin
|
||||||
|
// Grayscale images can be written in one Write call
|
||||||
|
Write(Handle, Bits, Size);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Expected data format of PFM RGB file is B32G32R32F which is not
|
||||||
|
// supported by Imaging. We must write pixels one by one and
|
||||||
|
// write only RGB part of A32B32G32B32 image.
|
||||||
|
Src := Bits;
|
||||||
|
for I := 0 to Width * Height - 1 do
|
||||||
|
begin
|
||||||
|
Write(Handle, Src, SizeOf(Single) * 3);
|
||||||
|
Inc(Src, Info.BytesPerPixel);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
if MustBeFreed then
|
||||||
|
FreeImage(ImageToSave);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPortableMapFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
|
||||||
|
var
|
||||||
|
Id: TChar4;
|
||||||
|
ReadCount: LongInt;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if Handle <> nil then
|
||||||
|
with GetIO do
|
||||||
|
begin
|
||||||
|
ReadCount := Read(Handle, @Id, SizeOf(Id));
|
||||||
|
Seek(Handle, -ReadCount, smFromCurrent);
|
||||||
|
Result := (Id[0] = 'P') and (Id[1] in [FIdNumbers[0], FIdNumbers[1]]) and
|
||||||
|
(Id[2] in WhiteSpaces);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPBMFileFormat }
|
||||||
|
|
||||||
|
constructor TPBMFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SPBMFormatName;
|
||||||
|
FCanSave := False;
|
||||||
|
AddMasks(SPBMMasks);
|
||||||
|
FIdNumbers := '14';
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPGMFileFormat }
|
||||||
|
|
||||||
|
constructor TPGMFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SPGMFormatName;
|
||||||
|
FSupportedFormats := PGMSupportedFormats;
|
||||||
|
AddMasks(SPGMMasks);
|
||||||
|
|
||||||
|
RegisterOption(ImagingPGMSaveBinary, @FSaveBinary);
|
||||||
|
FIdNumbers := '25';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPGMFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
FillChar(FMapInfo, SizeOf(FMapInfo), 0);
|
||||||
|
FMapInfo.FormatId := Iff(FSaveBinary, FIdNumbers[1], FIdNumbers[0]);
|
||||||
|
FMapInfo.Binary := FSaveBinary;
|
||||||
|
Result := inherited SaveData(Handle, Images, Index);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPGMFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
var
|
||||||
|
ConvFormat: TImageFormat;
|
||||||
|
begin
|
||||||
|
if Info.IsFloatingPoint then
|
||||||
|
// All FP images go to 16bit
|
||||||
|
ConvFormat := ifGray16
|
||||||
|
else if Info.HasGrayChannel then
|
||||||
|
// Grayscale will be 8 or 16 bit - depends on input's bitcount
|
||||||
|
ConvFormat := IffFormat(Info.BytesPerPixel div Info.ChannelCount > 1,
|
||||||
|
ifGray16, ifGray8)
|
||||||
|
else if Info.BytesPerPixel > 4 then
|
||||||
|
// Large bitcounts -> 16bit
|
||||||
|
ConvFormat := ifGray16
|
||||||
|
else
|
||||||
|
// Rest of the formats -> 8bit
|
||||||
|
ConvFormat := ifGray8;
|
||||||
|
|
||||||
|
ConvertImage(Image, ConvFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPPMFileFormat }
|
||||||
|
|
||||||
|
constructor TPPMFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SPPMFormatName;
|
||||||
|
FSupportedFormats := PPMSupportedFormats;
|
||||||
|
AddMasks(SPPMMasks);
|
||||||
|
|
||||||
|
RegisterOption(ImagingPPMSaveBinary, @FSaveBinary);
|
||||||
|
FIdNumbers := '36';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPPMFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
FillChar(FMapInfo, SizeOf(FMapInfo), 0);
|
||||||
|
FMapInfo.FormatId := Iff(FSaveBinary, FIdNumbers[1], FIdNumbers[0]);
|
||||||
|
FMapInfo.Binary := FSaveBinary;
|
||||||
|
Result := inherited SaveData(Handle, Images, Index);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPPMFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
var
|
||||||
|
ConvFormat: TImageFormat;
|
||||||
|
begin
|
||||||
|
if Info.IsFloatingPoint then
|
||||||
|
// All FP images go to 48bit RGB
|
||||||
|
ConvFormat := ifR16G16B16
|
||||||
|
else if Info.HasGrayChannel then
|
||||||
|
// Grayscale will be 24 or 48 bit RGB - depends on input's bitcount
|
||||||
|
ConvFormat := IffFormat(Info.BytesPerPixel div Info.ChannelCount > 1,
|
||||||
|
ifR16G16B16, ifR8G8B8)
|
||||||
|
else if Info.BytesPerPixel > 4 then
|
||||||
|
// Large bitcounts -> 48bit RGB
|
||||||
|
ConvFormat := ifR16G16B16
|
||||||
|
else
|
||||||
|
// Rest of the formats -> 24bit RGB
|
||||||
|
ConvFormat := ifR8G8B8;
|
||||||
|
|
||||||
|
ConvertImage(Image, ConvFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPAMFileFormat }
|
||||||
|
|
||||||
|
constructor TPAMFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SPAMFormatName;
|
||||||
|
FSupportedFormats := PAMSupportedFormats;
|
||||||
|
AddMasks(SPAMMasks);
|
||||||
|
FIdNumbers := '77';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPAMFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
FillChar(FMapInfo, SizeOf(FMapInfo), 0);
|
||||||
|
FMapInfo.FormatId := FIdNumbers[0];
|
||||||
|
FMapInfo.Binary := True;
|
||||||
|
FMapInfo.HasPAMHeader := True;
|
||||||
|
Result := inherited SaveData(Handle, Images, Index);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPAMFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
var
|
||||||
|
ConvFormat: TImageFormat;
|
||||||
|
begin
|
||||||
|
if Info.IsFloatingPoint then
|
||||||
|
ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16R16G16B16, ifR16G16B16)
|
||||||
|
else if Info.HasGrayChannel then
|
||||||
|
ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray16)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if Info.BytesPerPixel <= 4 then
|
||||||
|
ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8)
|
||||||
|
else
|
||||||
|
ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16R16G16B16, ifR16G16B16);
|
||||||
|
end;
|
||||||
|
ConvertImage(Image, ConvFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPFMFileFormat }
|
||||||
|
|
||||||
|
constructor TPFMFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := SPFMFormatName;
|
||||||
|
AddMasks(SPFMMasks);
|
||||||
|
FIdNumbers := 'Ff';
|
||||||
|
FSupportedFormats := PFMSupportedFormats;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPFMFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: Integer): Boolean;
|
||||||
|
var
|
||||||
|
Info: TImageFormatInfo;
|
||||||
|
begin
|
||||||
|
FillChar(FMapInfo, SizeOf(FMapInfo), 0);
|
||||||
|
Info := GetFormatInfo(Images[Index].Format);
|
||||||
|
if (Info.ChannelCount > 1) or Info.IsIndexed then
|
||||||
|
FMapInfo.TupleType := ttRGBFP
|
||||||
|
else
|
||||||
|
FMapInfo.TupleType := ttGrayScaleFP;
|
||||||
|
FMapInfo.FormatId := Iff(FMapInfo.TupleType = ttGrayScaleFP, FIdNumbers[1], FIdNumbers[0]);
|
||||||
|
FMapInfo.Binary := True;
|
||||||
|
Result := inherited SaveData(Handle, Images, Index);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPFMFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
begin
|
||||||
|
if (Info.ChannelCount > 1) or Info.IsIndexed then
|
||||||
|
ConvertImage(Image, ifA32B32G32R32F)
|
||||||
|
else
|
||||||
|
ConvertImage(Image, ifR32F);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterImageFileFormat(TPBMFileFormat);
|
||||||
|
RegisterImageFileFormat(TPGMFileFormat);
|
||||||
|
RegisterImageFileFormat(TPPMFileFormat);
|
||||||
|
RegisterImageFileFormat(TPAMFileFormat);
|
||||||
|
RegisterImageFileFormat(TPFMFileFormat);
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Made modifications to ASCII PNM loading to be more "stream-safe".
|
||||||
|
- Fixed bug: indexed images saved as grayscale in PFM.
|
||||||
|
- Changed converting to supported formats little bit.
|
||||||
|
- Added scaling of channel values (non-FP and non-mono images) according
|
||||||
|
to MaxVal.
|
||||||
|
- Added buffering to loading of PNM files. More than 10x faster now
|
||||||
|
for text files.
|
||||||
|
- Added saving support to PGM, PPM, PAM, and PFM format.
|
||||||
|
- Added PFM file format.
|
||||||
|
- Initial version created.
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,623 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingTarga.pas 84 2007-05-27 13:54:27Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains image format loader/saver for Targa images.}
|
||||||
|
unit ImagingTarga;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
ImagingTypes, Imaging, ImagingFormats, ImagingUtility;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Class for loading and saving Truevision Targa images.
|
||||||
|
It can load/save 8bit indexed or grayscale, 16 bit RGB or grayscale,
|
||||||
|
24 bit RGB and 32 bit ARGB images with or without RLE compression.}
|
||||||
|
TTargaFileFormat = class(TImageFileFormat)
|
||||||
|
protected
|
||||||
|
FUseRLE: LongBool;
|
||||||
|
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
|
||||||
|
OnlyFirstLevel: Boolean): Boolean; override;
|
||||||
|
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
|
||||||
|
Index: LongInt): Boolean; override;
|
||||||
|
procedure ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo); override;
|
||||||
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
function TestFormat(Handle: TImagingHandle): Boolean; override;
|
||||||
|
published
|
||||||
|
{ Controls that RLE compression is used during saving. Accessible trough
|
||||||
|
ImagingTargaRLE option.}
|
||||||
|
property UseRLE: LongBool read FUseRLE write FUseRLE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
STargaFormatName = 'Truevision Targa Image';
|
||||||
|
STargaMasks = '*.tga';
|
||||||
|
TargaSupportedFormats: TImageFormats = [ifIndex8, ifGray8, ifA1R5G5B5,
|
||||||
|
ifR8G8B8, ifA8R8G8B8];
|
||||||
|
TargaDefaultRLE = False;
|
||||||
|
|
||||||
|
const
|
||||||
|
STargaSignature = 'TRUEVISION-XFILE';
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Targa file header.}
|
||||||
|
TTargaHeader = packed record
|
||||||
|
IDLength: Byte;
|
||||||
|
ColorMapType: Byte;
|
||||||
|
ImageType: Byte;
|
||||||
|
ColorMapOff: Word;
|
||||||
|
ColorMapLength: Word;
|
||||||
|
ColorEntrySize: Byte;
|
||||||
|
XOrg: SmallInt;
|
||||||
|
YOrg: SmallInt;
|
||||||
|
Width: SmallInt;
|
||||||
|
Height: SmallInt;
|
||||||
|
PixelSize: Byte;
|
||||||
|
Desc: Byte;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Footer at the end of TGA file.}
|
||||||
|
TTargaFooter = packed record
|
||||||
|
ExtOff: LongWord; // Extension Area Offset
|
||||||
|
DevDirOff: LongWord; // Developer Directory Offset
|
||||||
|
Signature: array[0..15] of Char; // TRUEVISION-XFILE
|
||||||
|
Reserved: Byte; // ASCII period '.'
|
||||||
|
NullChar: Byte; // 0
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TTargaFileFormat class implementation }
|
||||||
|
|
||||||
|
constructor TTargaFileFormat.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FName := STargaFormatName;
|
||||||
|
FCanLoad := True;
|
||||||
|
FCanSave := True;
|
||||||
|
FIsMultiImageFormat := False;
|
||||||
|
FSupportedFormats := TargaSupportedFormats;
|
||||||
|
|
||||||
|
FUseRLE := TargaDefaultRLE;
|
||||||
|
|
||||||
|
AddMasks(STargaMasks);
|
||||||
|
RegisterOption(ImagingTargaRLE, @FUseRLE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TTargaFileFormat.LoadData(Handle: TImagingHandle;
|
||||||
|
var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
|
||||||
|
var
|
||||||
|
Hdr: TTargaHeader;
|
||||||
|
Foo: TTargaFooter;
|
||||||
|
FooterFound, ExtFound: Boolean;
|
||||||
|
I, PSize, PalSize: LongWord;
|
||||||
|
Pal: Pointer;
|
||||||
|
FmtInfo: TImageFormatInfo;
|
||||||
|
WordValue: Word;
|
||||||
|
|
||||||
|
procedure LoadRLE;
|
||||||
|
var
|
||||||
|
I, CPixel, Cnt: LongInt;
|
||||||
|
Bpp, Rle: Byte;
|
||||||
|
Buffer, Dest, Src: PByte;
|
||||||
|
BufSize: LongInt;
|
||||||
|
begin
|
||||||
|
with GetIO, Images[0] do
|
||||||
|
begin
|
||||||
|
// Alocates buffer large enough to hold the worst case
|
||||||
|
// RLE compressed data and reads then from input
|
||||||
|
BufSize := Width * Height * FmtInfo.BytesPerPixel;
|
||||||
|
BufSize := BufSize + BufSize div 2 + 1;
|
||||||
|
GetMem(Buffer, BufSize);
|
||||||
|
Src := Buffer;
|
||||||
|
Dest := Bits;
|
||||||
|
BufSize := Read(Handle, Buffer, BufSize);
|
||||||
|
|
||||||
|
Cnt := Width * Height;
|
||||||
|
Bpp := FmtInfo.BytesPerPixel;
|
||||||
|
CPixel := 0;
|
||||||
|
while CPixel < Cnt do
|
||||||
|
begin
|
||||||
|
Rle := Src^;
|
||||||
|
Inc(Src);
|
||||||
|
if Rle < 128 then
|
||||||
|
begin
|
||||||
|
// Process uncompressed pixel
|
||||||
|
Rle := Rle + 1;
|
||||||
|
CPixel := CPixel + Rle;
|
||||||
|
for I := 0 to Rle - 1 do
|
||||||
|
begin
|
||||||
|
// Copy pixel from src to dest
|
||||||
|
case Bpp of
|
||||||
|
1: Dest^ := Src^;
|
||||||
|
2: PWord(Dest)^ := PWord(Src)^;
|
||||||
|
3: PColor24Rec(Dest)^ := PColor24Rec(Src)^;
|
||||||
|
4: PLongWord(Dest)^ := PLongWord(Src)^;
|
||||||
|
end;
|
||||||
|
Inc(Src, Bpp);
|
||||||
|
Inc(Dest, Bpp);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Process compressed pixels
|
||||||
|
Rle := Rle - 127;
|
||||||
|
CPixel := CPixel + Rle;
|
||||||
|
// Copy one pixel from src to dest (many times there)
|
||||||
|
for I := 0 to Rle - 1 do
|
||||||
|
begin
|
||||||
|
case Bpp of
|
||||||
|
1: Dest^ := Src^;
|
||||||
|
2: PWord(Dest)^ := PWord(Src)^;
|
||||||
|
3: PColor24Rec(Dest)^ := PColor24Rec(Src)^;
|
||||||
|
4: PLongWord(Dest)^ := PLongWord(Src)^;
|
||||||
|
end;
|
||||||
|
Inc(Dest, Bpp);
|
||||||
|
end;
|
||||||
|
Inc(Src, Bpp);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// set position in source to real end of compressed data
|
||||||
|
Seek(Handle, -(BufSize - LongInt(LongWord(Src) - LongWord(Buffer))),
|
||||||
|
smFromCurrent);
|
||||||
|
FreeMem(Buffer);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
SetLength(Images, 1);
|
||||||
|
with GetIO, Images[0] do
|
||||||
|
begin
|
||||||
|
// Read targa header
|
||||||
|
Read(Handle, @Hdr, SizeOf(Hdr));
|
||||||
|
// Skip image ID info
|
||||||
|
Seek(Handle, Hdr.IDLength, smFromCurrent);
|
||||||
|
// Determine image format
|
||||||
|
Format := ifUnknown;
|
||||||
|
case Hdr.ImageType of
|
||||||
|
1, 9: Format := ifIndex8;
|
||||||
|
2, 10: case Hdr.PixelSize of
|
||||||
|
15: Format := ifX1R5G5B5;
|
||||||
|
16: Format := ifA1R5G5B5;
|
||||||
|
24: Format := ifR8G8B8;
|
||||||
|
32: Format := ifA8R8G8B8;
|
||||||
|
end;
|
||||||
|
3, 11: Format := ifGray8;
|
||||||
|
end;
|
||||||
|
// Format was not assigned by previous testing (it should be in
|
||||||
|
// well formed targas), so formats which reflects bit dept are selected
|
||||||
|
if Format = ifUnknown then
|
||||||
|
case Hdr.PixelSize of
|
||||||
|
8: Format := ifGray8;
|
||||||
|
15: Format := ifX1R5G5B5;
|
||||||
|
16: Format := ifA1R5G5B5;
|
||||||
|
24: Format := ifR8G8B8;
|
||||||
|
32: Format := ifA8R8G8B8;
|
||||||
|
end;
|
||||||
|
NewImage(Hdr.Width, Hdr.Height, Format, Images[0]);
|
||||||
|
FmtInfo := GetFormatInfo(Format);
|
||||||
|
|
||||||
|
if (Hdr.ColorMapType = 1) and (Hdr.ImageType in [1, 9]) then
|
||||||
|
begin
|
||||||
|
// Read palette
|
||||||
|
PSize := Hdr.ColorMapLength * (Hdr.ColorEntrySize shr 3);
|
||||||
|
GetMem(Pal, PSize);
|
||||||
|
try
|
||||||
|
Read(Handle, Pal, PSize);
|
||||||
|
// Process palette
|
||||||
|
PalSize := Iff(Hdr.ColorMapLength > FmtInfo.PaletteEntries,
|
||||||
|
FmtInfo.PaletteEntries, Hdr.ColorMapLength);
|
||||||
|
for I := 0 to PalSize - 1 do
|
||||||
|
case Hdr.ColorEntrySize of
|
||||||
|
24:
|
||||||
|
with Palette[I] do
|
||||||
|
begin
|
||||||
|
A := $FF;
|
||||||
|
R := PPalette24(Pal)[I].R;
|
||||||
|
G := PPalette24(Pal)[I].G;
|
||||||
|
B := PPalette24(Pal)[I].B;
|
||||||
|
end;
|
||||||
|
// I've never seen tga with these palettes so they are untested
|
||||||
|
16:
|
||||||
|
with Palette[I] do
|
||||||
|
begin
|
||||||
|
A := (PWordArray(Pal)[I] and $8000) shr 12;
|
||||||
|
R := (PWordArray(Pal)[I] and $FC00) shr 7;
|
||||||
|
G := (PWordArray(Pal)[I] and $03E0) shr 2;
|
||||||
|
B := (PWordArray(Pal)[I] and $001F) shl 3;
|
||||||
|
end;
|
||||||
|
32:
|
||||||
|
with Palette[I] do
|
||||||
|
begin
|
||||||
|
A := PPalette32(Pal)[I].A;
|
||||||
|
R := PPalette32(Pal)[I].R;
|
||||||
|
G := PPalette32(Pal)[I].G;
|
||||||
|
B := PPalette32(Pal)[I].B;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FreeMemNil(Pal);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case Hdr.ImageType of
|
||||||
|
0, 1, 2, 3:
|
||||||
|
// Load uncompressed mode images
|
||||||
|
Read(Handle, Bits, Size);
|
||||||
|
9, 10, 11:
|
||||||
|
// Load RLE compressed mode images
|
||||||
|
LoadRLE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Check if there is alpha channel present in A1R5GB5 images, if it is not
|
||||||
|
// change format to X1R5G5B5
|
||||||
|
if Format = ifA1R5G5B5 then
|
||||||
|
begin
|
||||||
|
if not Has16BitImageAlpha(Width * Height, Bits) then
|
||||||
|
Format := ifX1R5G5B5;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// We must find true end of file and set input' position to it
|
||||||
|
// paint programs appends extra info at the end of Targas
|
||||||
|
// some of them multiple times (PSP Pro 8)
|
||||||
|
repeat
|
||||||
|
ExtFound := False;
|
||||||
|
FooterFound := False;
|
||||||
|
|
||||||
|
if Read(Handle, @WordValue, 2) = 2 then
|
||||||
|
begin
|
||||||
|
// 495 = size of Extension Area
|
||||||
|
if WordValue = 495 then
|
||||||
|
begin
|
||||||
|
Seek(Handle, 493, smFromCurrent);
|
||||||
|
ExtFound := True;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Seek(Handle, -2, smFromCurrent);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Read(Handle, @Foo, SizeOf(Foo)) = SizeOf(Foo) then
|
||||||
|
begin
|
||||||
|
if Foo.Signature = STargaSignature then
|
||||||
|
FooterFound := True
|
||||||
|
else
|
||||||
|
Seek(Handle, -SizeOf(Foo), smFromCurrent);
|
||||||
|
end;
|
||||||
|
until (not ExtFound) and (not FooterFound);
|
||||||
|
|
||||||
|
// Some editors save targas flipped
|
||||||
|
if Hdr.Desc < 31 then
|
||||||
|
FlipImage(Images[0]);
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TTargaFileFormat.SaveData(Handle: TImagingHandle;
|
||||||
|
const Images: TDynImageDataArray; Index: LongInt): Boolean;
|
||||||
|
var
|
||||||
|
I: LongInt;
|
||||||
|
Hdr: TTargaHeader;
|
||||||
|
FmtInfo: TImageFormatInfo;
|
||||||
|
Pal: PPalette24;
|
||||||
|
ImageToSave: TImageData;
|
||||||
|
MustBeFreed: Boolean;
|
||||||
|
|
||||||
|
procedure SaveRLE;
|
||||||
|
var
|
||||||
|
Dest: PByte;
|
||||||
|
WidthBytes, Written, I, Total, DestSize: LongInt;
|
||||||
|
|
||||||
|
function CountDiff(Data: PByte; Bpp, PixelCount: Longint): LongInt;
|
||||||
|
var
|
||||||
|
Pixel: LongWord;
|
||||||
|
NextPixel: LongWord;
|
||||||
|
N: LongInt;
|
||||||
|
begin
|
||||||
|
N := 0;
|
||||||
|
Pixel := 0;
|
||||||
|
NextPixel := 0;
|
||||||
|
if PixelCount = 1 then
|
||||||
|
begin
|
||||||
|
Result := PixelCount;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
case Bpp of
|
||||||
|
1: Pixel := Data^;
|
||||||
|
2: Pixel := PWord(Data)^;
|
||||||
|
3: PColor24Rec(@Pixel)^ := PColor24Rec(Data)^;
|
||||||
|
4: Pixel := PLongWord(Data)^;
|
||||||
|
end;
|
||||||
|
while PixelCount > 1 do
|
||||||
|
begin
|
||||||
|
Inc(Data, Bpp);
|
||||||
|
case Bpp of
|
||||||
|
1: NextPixel := Data^;
|
||||||
|
2: NextPixel := PWord(Data)^;
|
||||||
|
3: PColor24Rec(@NextPixel)^ := PColor24Rec(Data)^;
|
||||||
|
4: NextPixel := PLongWord(Data)^;
|
||||||
|
end;
|
||||||
|
if NextPixel = Pixel then
|
||||||
|
Break;
|
||||||
|
Pixel := NextPixel;
|
||||||
|
N := N + 1;
|
||||||
|
PixelCount := PixelCount - 1;
|
||||||
|
end;
|
||||||
|
if NextPixel = Pixel then
|
||||||
|
Result := N
|
||||||
|
else
|
||||||
|
Result := N + 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CountSame(Data: PByte; Bpp, PixelCount: LongInt): LongInt;
|
||||||
|
var
|
||||||
|
Pixel: LongWord;
|
||||||
|
NextPixel: LongWord;
|
||||||
|
N: LongInt;
|
||||||
|
begin
|
||||||
|
N := 1;
|
||||||
|
Pixel := 0;
|
||||||
|
NextPixel := 0;
|
||||||
|
case Bpp of
|
||||||
|
1: Pixel := Data^;
|
||||||
|
2: Pixel := PWord(Data)^;
|
||||||
|
3: PColor24Rec(@Pixel)^ := PColor24Rec(Data)^;
|
||||||
|
4: Pixel := PLongWord(Data)^;
|
||||||
|
end;
|
||||||
|
PixelCount := PixelCount - 1;
|
||||||
|
while PixelCount > 0 do
|
||||||
|
begin
|
||||||
|
Inc(Data, Bpp);
|
||||||
|
case Bpp of
|
||||||
|
1: NextPixel := Data^;
|
||||||
|
2: NextPixel := PWord(Data)^;
|
||||||
|
3: PColor24Rec(@NextPixel)^ := PColor24Rec(Data)^;
|
||||||
|
4: NextPixel := PLongWord(Data)^;
|
||||||
|
end;
|
||||||
|
if NextPixel <> Pixel then
|
||||||
|
Break;
|
||||||
|
N := N + 1;
|
||||||
|
PixelCount := PixelCount - 1;
|
||||||
|
end;
|
||||||
|
Result := N;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RleCompressLine(Data: PByte; PixelCount, Bpp: LongInt; Dest:
|
||||||
|
PByte; var Written: LongInt);
|
||||||
|
const
|
||||||
|
MaxRun = 128;
|
||||||
|
var
|
||||||
|
DiffCount: LongInt;
|
||||||
|
SameCount: LongInt;
|
||||||
|
RleBufSize: LongInt;
|
||||||
|
begin
|
||||||
|
RleBufSize := 0;
|
||||||
|
while PixelCount > 0 do
|
||||||
|
begin
|
||||||
|
DiffCount := CountDiff(Data, Bpp, PixelCount);
|
||||||
|
SameCount := CountSame(Data, Bpp, PixelCount);
|
||||||
|
if (DiffCount > MaxRun) then
|
||||||
|
DiffCount := MaxRun;
|
||||||
|
if (SameCount > MaxRun) then
|
||||||
|
SameCount := MaxRun;
|
||||||
|
if (DiffCount > 0) then
|
||||||
|
begin
|
||||||
|
Dest^ := Byte(DiffCount - 1);
|
||||||
|
Inc(Dest);
|
||||||
|
PixelCount := PixelCount - DiffCount;
|
||||||
|
RleBufSize := RleBufSize + (DiffCount * Bpp) + 1;
|
||||||
|
Move(Data^, Dest^, DiffCount * Bpp);
|
||||||
|
Inc(Data, DiffCount * Bpp);
|
||||||
|
Inc(Dest, DiffCount * Bpp);
|
||||||
|
end;
|
||||||
|
if SameCount > 1 then
|
||||||
|
begin
|
||||||
|
Dest^ := Byte((SameCount - 1) or $80);
|
||||||
|
Inc(Dest);
|
||||||
|
PixelCount := PixelCount - SameCount;
|
||||||
|
RleBufSize := RleBufSize + Bpp + 1;
|
||||||
|
Inc(Data, (SameCount - 1) * Bpp);
|
||||||
|
case Bpp of
|
||||||
|
1: Dest^ := Data^;
|
||||||
|
2: PWord(Dest)^ := PWord(Data)^;
|
||||||
|
3: PColor24Rec(Dest)^ := PColor24Rec(Data)^;
|
||||||
|
4: PLongWord(Dest)^ := PLongWord(Data)^;
|
||||||
|
end;
|
||||||
|
Inc(Data, Bpp);
|
||||||
|
Inc(Dest, Bpp);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Written := RleBufSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
with ImageToSave do
|
||||||
|
begin
|
||||||
|
// Allocate enough space to hold the worst case compression
|
||||||
|
// result and then compress source's scanlines
|
||||||
|
WidthBytes := Width * FmtInfo.BytesPerPixel;
|
||||||
|
DestSize := WidthBytes * Height;
|
||||||
|
DestSize := DestSize + DestSize div 2 + 1;
|
||||||
|
GetMem(Dest, DestSize);
|
||||||
|
Total := 0;
|
||||||
|
try
|
||||||
|
for I := 0 to Height - 1 do
|
||||||
|
begin
|
||||||
|
RleCompressLine(@PByteArray(Bits)[I * WidthBytes], Width,
|
||||||
|
FmtInfo.BytesPerPixel, @PByteArray(Dest)[Total], Written);
|
||||||
|
Total := Total + Written;
|
||||||
|
end;
|
||||||
|
GetIO.Write(Handle, Dest, Total);
|
||||||
|
finally
|
||||||
|
FreeMem(Dest);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
|
||||||
|
with GetIO, ImageToSave do
|
||||||
|
try
|
||||||
|
FmtInfo := GetFormatInfo(Format);
|
||||||
|
// Fill targa header
|
||||||
|
FillChar(Hdr, SizeOf(Hdr), 0);
|
||||||
|
Hdr.IDLength := 0;
|
||||||
|
Hdr.ColorMapType := Iff(FmtInfo.PaletteEntries > 0, 1, 0);
|
||||||
|
Hdr.Width := Width;
|
||||||
|
Hdr.Height := Height;
|
||||||
|
Hdr.PixelSize := FmtInfo.BytesPerPixel * 8;
|
||||||
|
Hdr.ColorMapLength := FmtInfo.PaletteEntries;
|
||||||
|
Hdr.ColorEntrySize := Iff(FmtInfo.PaletteEntries > 0, 24, 0);
|
||||||
|
Hdr.ColorMapOff := 0;
|
||||||
|
// This indicates that targa is stored in top-left format
|
||||||
|
// as our images -> no flipping is needed.
|
||||||
|
Hdr.Desc := 32;
|
||||||
|
// Set alpha channel size in descriptor (mostly ignored by other software though)
|
||||||
|
if Format = ifA8R8G8B8 then
|
||||||
|
Hdr.Desc := Hdr.Desc or 8
|
||||||
|
else if Format = ifA1R5G5B5 then
|
||||||
|
Hdr.Desc := Hdr.Desc or 1;
|
||||||
|
|
||||||
|
// Choose image type
|
||||||
|
if FmtInfo.IsIndexed then
|
||||||
|
Hdr.ImageType := Iff(FUseRLE, 9, 1)
|
||||||
|
else
|
||||||
|
if FmtInfo.HasGrayChannel then
|
||||||
|
Hdr.ImageType := Iff(FUseRLE, 11, 3)
|
||||||
|
else
|
||||||
|
Hdr.ImageType := Iff(FUseRLE, 10, 2);
|
||||||
|
|
||||||
|
Write(Handle, @Hdr, SizeOf(Hdr));
|
||||||
|
|
||||||
|
// Write palette
|
||||||
|
if FmtInfo.PaletteEntries > 0 then
|
||||||
|
begin
|
||||||
|
GetMem(Pal, FmtInfo.PaletteEntries * SizeOf(TColor24Rec));
|
||||||
|
try
|
||||||
|
for I := 0 to FmtInfo.PaletteEntries - 1 do
|
||||||
|
with Pal[I] do
|
||||||
|
begin
|
||||||
|
R := Palette[I].R;
|
||||||
|
G := Palette[I].G;
|
||||||
|
B := Palette[I].B;
|
||||||
|
end;
|
||||||
|
Write(Handle, Pal, FmtInfo.PaletteEntries * SizeOf(TColor24Rec));
|
||||||
|
finally
|
||||||
|
FreeMemNil(Pal);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if FUseRLE then
|
||||||
|
// Save rle compressed mode images
|
||||||
|
SaveRLE
|
||||||
|
else
|
||||||
|
// Save uncompressed mode images
|
||||||
|
Write(Handle, Bits, Size);
|
||||||
|
|
||||||
|
Result := True;
|
||||||
|
finally
|
||||||
|
if MustBeFreed then
|
||||||
|
FreeImage(ImageToSave);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTargaFileFormat.ConvertToSupported(var Image: TImageData;
|
||||||
|
const Info: TImageFormatInfo);
|
||||||
|
var
|
||||||
|
ConvFormat: TImageFormat;
|
||||||
|
begin
|
||||||
|
if Info.HasGrayChannel then
|
||||||
|
// Convert all grayscale images to Gray8 (preserve alpha of AxGrayx formats)
|
||||||
|
ConvFormat := IffFormat(not Info.HasAlphaChannel, ifGray8, ifA8R8G8B8)
|
||||||
|
else if Info.IsIndexed then
|
||||||
|
// Convert all indexed images to Index8
|
||||||
|
ConvFormat := ifIndex8
|
||||||
|
else if Info.HasAlphaChannel then
|
||||||
|
// Convert images with alpha channel to A8R8G8B8
|
||||||
|
ConvFormat := ifA8R8G8B8
|
||||||
|
else if Info.UsePixelFormat then
|
||||||
|
// Convert 16bit images (without alpha channel) to A1R5G5B5
|
||||||
|
ConvFormat := ifA1R5G5B5
|
||||||
|
else
|
||||||
|
// Convert all other formats to R8G8B8
|
||||||
|
ConvFormat := ifR8G8B8;
|
||||||
|
|
||||||
|
ConvertImage(Image, ConvFormat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TTargaFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
|
||||||
|
var
|
||||||
|
Hdr: TTargaHeader;
|
||||||
|
ReadCount: LongInt;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if Handle <> nil then
|
||||||
|
begin
|
||||||
|
ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr));
|
||||||
|
GetIO.Seek(Handle, -ReadCount, smFromCurrent);
|
||||||
|
Result := (ReadCount >= SizeOf(Hdr)) and
|
||||||
|
(Hdr.ImageType in [0, 1, 2, 3, 9, 10, 11]) and
|
||||||
|
(Hdr.PixelSize in [1, 8, 15, 16, 24, 32]) and
|
||||||
|
(Hdr.ColorEntrySize in [0, 16, 24, 32]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterImageFileFormat(TTargaFileFormat);
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- nothing now
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- MakeCompatible method moved to base class, put ConvertToSupported here.
|
||||||
|
GetSupportedFormats removed, it is now set in constructor.
|
||||||
|
- Made public properties for options registered to SetOption/GetOption
|
||||||
|
functions.
|
||||||
|
- Changed extensions to filename masks.
|
||||||
|
- Changed SaveData, LoadData, and MakeCompatible methods according
|
||||||
|
to changes in base class in Imaging unit.
|
||||||
|
|
||||||
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
||||||
|
- 16 bit images are usually without alpha but some has alpha
|
||||||
|
channel and there is no indication of it - so I have added
|
||||||
|
a check: if all pixels of image are with alpha = 0 image is treated
|
||||||
|
as X1R5G5B5 otherwise as A1R5G5B5
|
||||||
|
- fixed problems with some nonstandard 15 bit images
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,488 @@
|
||||||
|
{
|
||||||
|
$Id: ImagingTypes.pas 112 2007-12-11 19:43:15Z galfar $
|
||||||
|
Vampyre Imaging Library
|
||||||
|
by Marek Mauder
|
||||||
|
http://imaginglib.sourceforge.net
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to the Mozilla
|
||||||
|
Public License Version 1.1 (the "License"); you may not use this file except
|
||||||
|
in compliance with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
Alternatively, the contents of this file may be used under the terms of the
|
||||||
|
GNU Lesser General Public License (the "LGPL License"), in which case the
|
||||||
|
provisions of the LGPL License are applicable instead of those above.
|
||||||
|
If you wish to allow use of your version of this file only under the terms
|
||||||
|
of the LGPL License and not to allow others to use your version of this file
|
||||||
|
under the MPL, indicate your decision by deleting the provisions above and
|
||||||
|
replace them with the notice and other provisions required by the LGPL
|
||||||
|
License. If you do not delete the provisions above, a recipient may use
|
||||||
|
your version of this file under either the MPL or the LGPL License.
|
||||||
|
|
||||||
|
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||||
|
}
|
||||||
|
|
||||||
|
{ This unit contains basic types and constants used by Imaging library.}
|
||||||
|
unit ImagingTypes;
|
||||||
|
|
||||||
|
{$I ImagingOptions.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
const
|
||||||
|
{ Current Major version of Imaging.}
|
||||||
|
ImagingVersionMajor = 0;
|
||||||
|
{ Current Minor version of Imaging.}
|
||||||
|
ImagingVersionMinor = 24;
|
||||||
|
{ Current patch of Imaging.}
|
||||||
|
ImagingVersionPatch = 2;
|
||||||
|
|
||||||
|
{ Imaging Option Ids whose values can be set/get by SetOption/
|
||||||
|
GetOption functions.}
|
||||||
|
|
||||||
|
{ Defines Jpeg compression quality, ranges from 1 (ugly/small) to 100 (nice/large).
|
||||||
|
Default value is 90.}
|
||||||
|
ImagingJpegQuality = 10;
|
||||||
|
{ Specifies whether Jpeg images are saved in progressive format,
|
||||||
|
can be 0 or 1. Default value is 0.}
|
||||||
|
ImagingJpegProgressive = 11;
|
||||||
|
|
||||||
|
{ Specifies whether Windows Bitmaps are saved using RLE compression
|
||||||
|
(only for 1/4/8 bit images), can be 0 or 1. Default value is 1.}
|
||||||
|
ImagingBitmapRLE = 12;
|
||||||
|
|
||||||
|
{ Specifies whether Targa images are saved using RLE compression,
|
||||||
|
can be 0 or 1. Default value is 0.}
|
||||||
|
ImagingTargaRLE = 13;
|
||||||
|
|
||||||
|
{ Value of this option is non-zero if last loaded DDS file was cube map.}
|
||||||
|
ImagingDDSLoadedCubeMap = 14;
|
||||||
|
{ Value of this option is non-zero if last loaded DDS file was volume texture.}
|
||||||
|
ImagingDDSLoadedVolume = 15;
|
||||||
|
{ Value of this option is number of mipmap levels of last loaded DDS image.}
|
||||||
|
ImagingDDSLoadedMipMapCount = 16;
|
||||||
|
{ Value of this option is depth (slices of volume texture or faces of
|
||||||
|
cube map) of last loaded DDS image.}
|
||||||
|
ImagingDDSLoadedDepth = 17;
|
||||||
|
{ If it is non-zero next saved DDS file should be stored as cube map.}
|
||||||
|
ImagingDDSSaveCubeMap = 18;
|
||||||
|
{ If it is non-zero next saved DDS file should be stored as volume texture.}
|
||||||
|
ImagingDDSSaveVolume = 19;
|
||||||
|
{ Sets the number of mipmaps which should be stored in the next saved DDS file.
|
||||||
|
Only applies to cube maps and volumes, ordinary 2D textures save all
|
||||||
|
levels present in input.}
|
||||||
|
ImagingDDSSaveMipMapCount = 20;
|
||||||
|
{ Sets the depth (slices of volume texture or faces of cube map)
|
||||||
|
of the next saved DDS file.}
|
||||||
|
ImagingDDSSaveDepth = 21;
|
||||||
|
|
||||||
|
{ Sets precompression filter used when saving PNG images. Allowed values
|
||||||
|
are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth),
|
||||||
|
5 (use 0 for indexed/gray images and 4 for RGB/ARGB images),
|
||||||
|
6 (adaptive filtering - use best filter for each scanline - very slow).
|
||||||
|
Note that filters 3 and 4 are much slower than filters 1 and 2.
|
||||||
|
Default value is 5.}
|
||||||
|
ImagingPNGPreFilter = 25;
|
||||||
|
{ Sets ZLib compression level used when saving PNG images.
|
||||||
|
Allowed values are in range 0 (no compresstion) to 9 (best compression).
|
||||||
|
Default value is 5.}
|
||||||
|
ImagingPNGCompressLevel = 26;
|
||||||
|
|
||||||
|
{ Specifies whether MNG animation frames are saved with lossy or lossless
|
||||||
|
compression. Lossless frames are saved as PNG images and lossy frames are
|
||||||
|
saved as JNG images. Allowed values are 0 (False) and 1 (True).
|
||||||
|
Default value is 0.}
|
||||||
|
ImagingMNGLossyCompression = 28;
|
||||||
|
{ Defines whether alpha channel of lossy compressed MNG frames
|
||||||
|
(when ImagingMNGLossyCompression is 1) is lossy compressed too.
|
||||||
|
Allowed values are 0 (False) and 1 (True). Default value is 0.}
|
||||||
|
ImagingMNGLossyAlpha = 29;
|
||||||
|
{ Sets precompression filter used when saving MNG frames as PNG images.
|
||||||
|
For details look at ImagingPNGPreFilter.}
|
||||||
|
ImagingMNGPreFilter = 30;
|
||||||
|
{ Sets ZLib compression level used when saving MNG frames as PNG images.
|
||||||
|
For details look at ImagingPNGCompressLevel.}
|
||||||
|
ImagingMNGCompressLevel = 31;
|
||||||
|
{ Specifies compression quality used when saving MNG frames as JNG images.
|
||||||
|
For details look at ImagingJpegQuality.}
|
||||||
|
ImagingMNGQuality = 32;
|
||||||
|
{ Specifies whether images are saved in progressive format when saving MNG
|
||||||
|
frames as JNG images. For details look at ImagingJpegProgressive.}
|
||||||
|
ImagingMNGProgressive = 33;
|
||||||
|
|
||||||
|
{ Specifies whether alpha channels of JNG images are lossy compressed.
|
||||||
|
Allowed values are 0 (False) and 1 (True). Default value is 0.}
|
||||||
|
ImagingJNGLossyAlpha = 40;
|
||||||
|
{ Sets precompression filter used when saving lossless alpha channels.
|
||||||
|
For details look at ImagingPNGPreFilter.}
|
||||||
|
ImagingJNGAlphaPreFilter = 41;
|
||||||
|
{ Sets ZLib compression level used when saving lossless alpha channels.
|
||||||
|
For details look at ImagingPNGCompressLevel.}
|
||||||
|
ImagingJNGAlphaCompressLevel = 42;
|
||||||
|
{ Defines compression quality used when saving JNG images (and lossy alpha channels).
|
||||||
|
For details look at ImagingJpegQuality.}
|
||||||
|
ImagingJNGQuality = 43;
|
||||||
|
{ Specifies whether JNG images are saved in progressive format.
|
||||||
|
For details look at ImagingJpegProgressive.}
|
||||||
|
ImagingJNGProgressive = 44;
|
||||||
|
{ Specifies whether PGM files are stored in text or in binary format.
|
||||||
|
Allowed values are 0 (store as text - very! large files) and 1 (save binary).
|
||||||
|
Default value is 1.}
|
||||||
|
ImagingPGMSaveBinary = 50;
|
||||||
|
{ Specifies whether PPM files are stored in text or in binary format.
|
||||||
|
Allowed values are 0 (store as text - very! large files) and 1 (save binary).
|
||||||
|
Default value is 1.}
|
||||||
|
ImagingPPMSaveBinary = 51;
|
||||||
|
|
||||||
|
|
||||||
|
{ This option is used when reducing number of colors used in
|
||||||
|
image (mainly when converting from ARGB image to indexed
|
||||||
|
format). Mask is 'anded' (bitwise AND) with every pixel's
|
||||||
|
channel value when creating color histogram. If $FF is used
|
||||||
|
all 8bits of color channels are used which can result in very
|
||||||
|
slow proccessing of large images with many colors so you can
|
||||||
|
use lower masks to speed it up (FC, F8 and F0 are good
|
||||||
|
choices). Allowed values are in range <0, $FF> and default is
|
||||||
|
$FE. }
|
||||||
|
ImagingColorReductionMask = 128;
|
||||||
|
{ This option can be used to override image data format during image
|
||||||
|
loading. If set to format different from ifUnknown all loaded images
|
||||||
|
are automaticaly converted to this format. Useful when you have
|
||||||
|
many files in various formats but you want them all in one format for
|
||||||
|
further proccessing. Allowed values are in
|
||||||
|
range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))> and
|
||||||
|
default value is ifUnknown.}
|
||||||
|
ImagingLoadOverrideFormat = 129;
|
||||||
|
{ This option can be used to override image data format during image
|
||||||
|
saving. If set to format different from ifUnknown all images
|
||||||
|
to be saved are automaticaly internaly converted to this format.
|
||||||
|
Note that image file formats support only a subset of Imaging data formats
|
||||||
|
so final saved file may in different format than this override.
|
||||||
|
Allowed values are in range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))>
|
||||||
|
and default value is ifUnknown.}
|
||||||
|
ImagingSaveOverrideFormat = 130;
|
||||||
|
{ Specifies resampling filter used when generating mipmaps. It is used
|
||||||
|
in GenerateMipMaps low level function and Direct3D and OpenGL extensions.
|
||||||
|
Allowed values are in range
|
||||||
|
<Ord(Low(ImagingFormats.TSamplingFilter)), Ord(High(ImagingFormats.TSamplingFilter))>
|
||||||
|
and default value is 1 (linear filter).}
|
||||||
|
ImagingMipMapFilter = 131;
|
||||||
|
|
||||||
|
{ Returned by GetOption if given Option Id is invalid.}
|
||||||
|
InvalidOption = -$7FFFFFFF;
|
||||||
|
|
||||||
|
{ Indices that can be used to access channel values in array parts
|
||||||
|
of structures like TColor32Rec. Note that this order can be
|
||||||
|
used only for ARGB images. For ABGR image you must swap Red and Blue.}
|
||||||
|
ChannelBlue = 0;
|
||||||
|
ChannelGreen = 1;
|
||||||
|
ChannelRed = 2;
|
||||||
|
ChannelAlpha = 3;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Enum defining image data format. In formats with more channels,
|
||||||
|
first channel after "if" is stored in the most significant bits and channel
|
||||||
|
before end is stored in the least significant.}
|
||||||
|
TImageFormat = (
|
||||||
|
ifUnknown = 0,
|
||||||
|
ifDefault = 1,
|
||||||
|
{ Indexed formats using palette.}
|
||||||
|
ifIndex8 = 10,
|
||||||
|
{ Grayscale/Luminance formats.}
|
||||||
|
ifGray8 = 40,
|
||||||
|
ifA8Gray8 = 41,
|
||||||
|
ifGray16 = 42,
|
||||||
|
ifGray32 = 43,
|
||||||
|
ifGray64 = 44,
|
||||||
|
ifA16Gray16 = 45,
|
||||||
|
{ ARGB formats.}
|
||||||
|
ifX5R1G1B1 = 80,
|
||||||
|
ifR3G3B2 = 81,
|
||||||
|
ifR5G6B5 = 82,
|
||||||
|
ifA1R5G5B5 = 83,
|
||||||
|
ifA4R4G4B4 = 84,
|
||||||
|
ifX1R5G5B5 = 85,
|
||||||
|
ifX4R4G4B4 = 86,
|
||||||
|
ifR8G8B8 = 87,
|
||||||
|
ifA8R8G8B8 = 88,
|
||||||
|
ifX8R8G8B8 = 89,
|
||||||
|
ifR16G16B16 = 90,
|
||||||
|
ifA16R16G16B16 = 91,
|
||||||
|
ifB16G16R16 = 92,
|
||||||
|
ifA16B16G16R16 = 93,
|
||||||
|
{ Floating point formats.}
|
||||||
|
ifR32F = 170,
|
||||||
|
ifA32R32G32B32F = 171,
|
||||||
|
ifA32B32G32R32F = 172,
|
||||||
|
ifR16F = 173,
|
||||||
|
ifA16R16G16B16F = 174,
|
||||||
|
ifA16B16G16R16F = 175,
|
||||||
|
{ Special formats.}
|
||||||
|
ifDXT1 = 220,
|
||||||
|
ifDXT3 = 221,
|
||||||
|
ifDXT5 = 222,
|
||||||
|
ifBTC = 223);
|
||||||
|
|
||||||
|
{ Color value for 32 bit images.}
|
||||||
|
TColor32 = LongWord;
|
||||||
|
PColor32 = ^TColor32;
|
||||||
|
|
||||||
|
{ Color value for 64 bit images.}
|
||||||
|
TColor64 = type Int64;
|
||||||
|
PColor64 = ^TColor64;
|
||||||
|
|
||||||
|
{ Color record for 24 bit images, which allows access to individual color
|
||||||
|
channels.}
|
||||||
|
TColor24Rec = packed record
|
||||||
|
case LongInt of
|
||||||
|
0: (B, G, R: Byte);
|
||||||
|
1: (Channels: array[0..2] of Byte);
|
||||||
|
end;
|
||||||
|
PColor24Rec = ^TColor24Rec;
|
||||||
|
TColor24RecArray = array[0..MaxInt div SizeOf(TColor24Rec) - 1] of TColor24Rec;
|
||||||
|
PColor24RecArray = ^TColor24RecArray;
|
||||||
|
|
||||||
|
{ Color record for 32 bit images, which allows access to individual color
|
||||||
|
channels.}
|
||||||
|
TColor32Rec = packed record
|
||||||
|
case LongInt of
|
||||||
|
0: (Color: TColor32);
|
||||||
|
1: (B, G, R, A: Byte);
|
||||||
|
2: (Channels: array[0..3] of Byte);
|
||||||
|
3: (Color24Rec: TColor24Rec);
|
||||||
|
end;
|
||||||
|
PColor32Rec = ^TColor32Rec;
|
||||||
|
TColor32RecArray = array[0..MaxInt div SizeOf(TColor32Rec) - 1] of TColor32Rec;
|
||||||
|
PColor32RecArray = ^TColor32RecArray;
|
||||||
|
|
||||||
|
{ Color record for 48 bit images, which allows access to individual color
|
||||||
|
channels.}
|
||||||
|
TColor48Rec = packed record
|
||||||
|
case LongInt of
|
||||||
|
0: (B, G, R: Word);
|
||||||
|
1: (Channels: array[0..2] of Word);
|
||||||
|
end;
|
||||||
|
PColor48Rec = ^TColor48Rec;
|
||||||
|
TColor48RecArray = array[0..MaxInt div SizeOf(TColor48Rec) - 1] of TColor48Rec;
|
||||||
|
PColor48RecArray = ^TColor48RecArray;
|
||||||
|
|
||||||
|
{ Color record for 64 bit images, which allows access to individual color
|
||||||
|
channels.}
|
||||||
|
TColor64Rec = packed record
|
||||||
|
case LongInt of
|
||||||
|
0: (Color: TColor64);
|
||||||
|
1: (B, G, R, A: Word);
|
||||||
|
2: (Channels: array[0..3] of Word);
|
||||||
|
3: (Color48Rec: TColor48Rec);
|
||||||
|
end;
|
||||||
|
PColor64Rec = ^TColor64Rec;
|
||||||
|
TColor64RecArray = array[0..MaxInt div SizeOf(TColor64Rec) - 1] of TColor64Rec;
|
||||||
|
PColor64RecArray = ^TColor64RecArray;
|
||||||
|
|
||||||
|
{ Color record for 128 bit floating point images, which allows access to
|
||||||
|
individual color channels.}
|
||||||
|
TColorFPRec = packed record
|
||||||
|
case LongInt of
|
||||||
|
0: (B, G, R, A: Single);
|
||||||
|
1: (Channels: array[0..3] of Single);
|
||||||
|
end;
|
||||||
|
PColorFPRec = ^TColorFPRec;
|
||||||
|
TColorFPRecArray = array[0..MaxInt div SizeOf(TColorFPRec) - 1] of TColorFPRec;
|
||||||
|
PColorFPRecArray = ^TColorFPRecArray;
|
||||||
|
|
||||||
|
{ 16 bit floating-point value. It has 1 sign bit, 5 exponent bits,
|
||||||
|
and 10 mantissa bits.}
|
||||||
|
THalfFloat = type Word;
|
||||||
|
PHalfFloat = ^THalfFloat;
|
||||||
|
|
||||||
|
{ Color record for 64 bit floating point images, which allows access to
|
||||||
|
individual color channels.}
|
||||||
|
TColorHFRec = packed record
|
||||||
|
case LongInt of
|
||||||
|
0: (B, G, R, A: THalfFloat);
|
||||||
|
1: (Channels: array[0..3] of THalfFloat);
|
||||||
|
end;
|
||||||
|
PColorHFRec = ^TColorHFRec;
|
||||||
|
TColorHFRecArray = array[0..MaxInt div SizeOf(TColorHFRec) - 1] of TColorHFRec;
|
||||||
|
PColorHFRecArray = ^TColorHFRecArray;
|
||||||
|
|
||||||
|
{ Palette for indexed mode images with 32 bit colors.}
|
||||||
|
TPalette32 = TColor32RecArray;
|
||||||
|
TPalette32Size256 = array[0..255] of TColor32Rec;
|
||||||
|
PPalette32 = ^TPalette32;
|
||||||
|
|
||||||
|
{ Palette for indexd mode images with 24 bit colors.}
|
||||||
|
TPalette24 = TColor24RecArray;
|
||||||
|
TPalette24Size256 = array[0..255] of TColor24Rec;
|
||||||
|
PPalette24 = ^TPalette24;
|
||||||
|
|
||||||
|
{ Record that stores single image data and information describing it.}
|
||||||
|
TImageData = packed record
|
||||||
|
Width: LongInt; // Width of image in pixels
|
||||||
|
Height: LongInt; // Height of image in pixels
|
||||||
|
Format: TImageFormat; // Data format of image
|
||||||
|
Size: LongInt; // Size of image bits in Bytes
|
||||||
|
Bits: Pointer; // Pointer to memory containing image bits
|
||||||
|
Palette: PPalette32; // Image palette for indexed images
|
||||||
|
end;
|
||||||
|
PImageData = ^TImageData;
|
||||||
|
|
||||||
|
{ Pixel format information used in conversions to/from 16 and 8 bit ARGB
|
||||||
|
image formats.}
|
||||||
|
TPixelFormatInfo = packed record
|
||||||
|
ABitCount, RBitCount, GBitCount, BBitCount: Byte;
|
||||||
|
ABitMask, RBitMask, GBitMask, BBitMask: LongWord;
|
||||||
|
AShift, RShift, GShift, BShift: Byte;
|
||||||
|
ARecDiv, RRecDiv, GRecDiv, BRecDiv: Byte;
|
||||||
|
end;
|
||||||
|
PPixelFormatInfo = ^TPixelFormatInfo;
|
||||||
|
|
||||||
|
PImageFormatInfo = ^TImageFormatInfo;
|
||||||
|
|
||||||
|
{ Look at TImageFormatInfo.GetPixelsSize for details.}
|
||||||
|
TFormatGetPixelsSizeFunc = function(Format: TImageFormat; Width,
|
||||||
|
Height: LongInt): LongInt;
|
||||||
|
{ Look at TImageFormatInfo.CheckDimensions for details.}
|
||||||
|
TFormatCheckDimensionsProc = procedure(Format: TImageFormat; var Width,
|
||||||
|
Height: LongInt);
|
||||||
|
{ Function for getting pixel colors. Native pixel is read from Image and
|
||||||
|
then translated to 32 bit ARGB.}
|
||||||
|
TGetPixel32Func = function(Bits: Pointer; Info: PImageFormatInfo;
|
||||||
|
Palette: PPalette32): TColor32Rec;
|
||||||
|
{ Function for getting pixel colors. Native pixel is read from Image and
|
||||||
|
then translated to FP ARGB.}
|
||||||
|
TGetPixelFPFunc = function(Bits: Pointer; Info: PImageFormatInfo;
|
||||||
|
Palette: PPalette32): TColorFPRec;
|
||||||
|
{ Procedure for setting pixel colors. Input 32 bit ARGB color is translated to
|
||||||
|
native format and then written to Image.}
|
||||||
|
TSetPixel32Proc = procedure(Bits: Pointer; Info: PImageFormatInfo;
|
||||||
|
Palette: PPalette32;const Color: TColor32Rec);
|
||||||
|
{ Procedure for setting pixel colors. Input FP ARGB color is translated to
|
||||||
|
native format and then written to Image.}
|
||||||
|
TSetPixelFPProc = procedure(Bits: Pointer; Info: PImageFormatInfo;
|
||||||
|
Palette: PPalette32; const Color: TColorFPRec);
|
||||||
|
|
||||||
|
{ Additional information for each TImageFormat value.}
|
||||||
|
TImageFormatInfo = packed record
|
||||||
|
Format: TImageFormat; // Format described by this record
|
||||||
|
Name: array[0..15] of Char; // Symbolic name of format
|
||||||
|
BytesPerPixel: LongInt; // Number of bytes per pixel (note: it is
|
||||||
|
// 0 for formats where BitsPerPixel < 8 (e.g. DXT).
|
||||||
|
// Use GetPixelsSize function to get size of
|
||||||
|
// image data.
|
||||||
|
ChannelCount: LongInt; // Number of image channels (R, G, B, A, Gray)
|
||||||
|
PaletteEntries: LongInt; // Number of palette entries
|
||||||
|
HasGrayChannel: Boolean; // True if image has grayscale channel
|
||||||
|
HasAlphaChannel: Boolean; // True if image has alpha channel
|
||||||
|
IsFloatingPoint: Boolean; // True if image has floating point pixels
|
||||||
|
UsePixelFormat: Boolean; // True if image uses pixel format
|
||||||
|
IsRBSwapped: Boolean; // True if Red and Blue channels are swapped
|
||||||
|
// e.g. A16B16G16R16 has IsRBSwapped True
|
||||||
|
RBSwapFormat: TImageFormat; // Indicates supported format with swapped
|
||||||
|
// Red and Blue channels, ifUnknown if such
|
||||||
|
// format does not exist
|
||||||
|
IsIndexed: Boolean; // True if image uses palette
|
||||||
|
IsSpecial: Boolean; // True if image is in special format
|
||||||
|
PixelFormat: PPixelFormatInfo; // Pixel format structure
|
||||||
|
GetPixelsSize: TFormatGetPixelsSizeFunc; // Returns size in bytes of
|
||||||
|
// Width * Height pixels of image
|
||||||
|
CheckDimensions: TFormatCheckDimensionsProc; // some formats have limited
|
||||||
|
// values of Width and Height. This
|
||||||
|
// procedure checks and changes dimensions
|
||||||
|
// to be valid for given format.
|
||||||
|
GetPixel32: TGetPixel32Func; // 32bit ARGB pixel get function
|
||||||
|
GetPixelFP: TGetPixelFPFunc; // FP ARGB pixel get function
|
||||||
|
SetPixel32: TSetPixel32Proc; // 32bit ARGB pixel set procedure
|
||||||
|
SetPixelFP: TSetPixelFPProc; // FP ARGB pixel set procedure
|
||||||
|
SpecialNearestFormat: TImageFormat; // Regular image format used when
|
||||||
|
// compressing/decompressing special images
|
||||||
|
// as source/target
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Handle to list of image data records.}
|
||||||
|
TImageDataList = Pointer;
|
||||||
|
PImageDataList = ^TImageDataList;
|
||||||
|
|
||||||
|
{ Handle to input/output.}
|
||||||
|
TImagingHandle = Pointer;
|
||||||
|
|
||||||
|
{ Filters used in functions that resize images or their portions.}
|
||||||
|
TResizeFilter = (
|
||||||
|
rfNearest = 0,
|
||||||
|
rfBilinear = 1,
|
||||||
|
rfBicubic = 2);
|
||||||
|
|
||||||
|
{ Seek origin mode for IO function Seek.}
|
||||||
|
TSeekMode = (
|
||||||
|
smFromBeginning = 0,
|
||||||
|
smFromCurrent = 1,
|
||||||
|
smFromEnd = 2);
|
||||||
|
|
||||||
|
{ IO functions used for reading and writing images from/to input/output.}
|
||||||
|
TOpenReadProc = function(Source: PChar): TImagingHandle; cdecl;
|
||||||
|
TOpenWriteProc = function(Source: PChar): TImagingHandle; cdecl;
|
||||||
|
TCloseProc = procedure(Handle: TImagingHandle); cdecl;
|
||||||
|
TEofProc = function(Handle: TImagingHandle): Boolean; cdecl;
|
||||||
|
TSeekProc = function(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): LongInt; cdecl;
|
||||||
|
TTellProc = function(Handle: TImagingHandle): LongInt; cdecl;
|
||||||
|
TReadProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl;
|
||||||
|
TWriteProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{
|
||||||
|
File Notes:
|
||||||
|
|
||||||
|
-- TODOS ----------------------------------------------------
|
||||||
|
- add lookup tables to pixel formats for fast conversions
|
||||||
|
- change TImageFormatInfo - add new fields that shoudl replace old chaos
|
||||||
|
like not knowing whether it is RGB without checking all other fields for False
|
||||||
|
(add something like FormatType = (ftIndexed, ftRGB, ftIntensity, ftCompressed,
|
||||||
|
ftFloatingPoint, ftRGBBitFields) and additional infos like HasAlphaChannel,
|
||||||
|
ChannelSize, ChannelCount, ...)
|
||||||
|
|
||||||
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Added ifBTC image format and SpecialNearestFormat field
|
||||||
|
to TImageFormatInfo.
|
||||||
|
|
||||||
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
- Added option constants for PGM and PPM file formats.
|
||||||
|
- Added TPalette32Size256 and TPalette24Size256 types.
|
||||||
|
|
||||||
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
||||||
|
- added ImagingVersionPatch constant so bug fix only releases
|
||||||
|
can be distinguished from ordinary major/minor releases
|
||||||
|
- renamed TPixelFormat to TPixelFormatInfo to avoid name collisions
|
||||||
|
with Graphics.TPixelFormat
|
||||||
|
- added new image data formats: ifR16F, ifA16R16G16B16F,
|
||||||
|
ifA16B16G16R16F
|
||||||
|
- added pixel get/set function pointers to TImageFormatInfo
|
||||||
|
- added 16bit half float type and color record
|
||||||
|
- renamed TColorFRec to TColorFPRec (and related types too)
|
||||||
|
|
||||||
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
||||||
|
- added option ImagingMipMapFilter which now controls resampling filter
|
||||||
|
used when generating mipmaps
|
||||||
|
- added TResizeFilter type
|
||||||
|
- added ChannelCount to TImageFormatInfo
|
||||||
|
- added new option constants for MNG and JNG images
|
||||||
|
|
||||||
|
-- 0.15 Changes/Bug Fixes -----------------------------------
|
||||||
|
- added RBSwapFormat to TImageFormatInfo for faster conversions
|
||||||
|
between swapped formats (it just calls SwapChannels now if
|
||||||
|
RBSwapFormat is not ifUnknown)
|
||||||
|
- moved TImageFormatInfo and required types from Imaging unit
|
||||||
|
here, removed TImageFormatShortInfo
|
||||||
|
- added new options: ImagingLoadOverrideFormat, ImagingSaveOverrideFormat
|
||||||
|
|
||||||
|
-- 0.13 Changes/Bug Fixes -----------------------------------
|
||||||
|
- new ImagingColorReductionMask option added
|
||||||
|
- new image format added: ifA16Gray16
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,401 @@
|
||||||
|
unit imjcapimin;
|
||||||
|
{$N+}
|
||||||
|
{ This file contains application interface code for the compression half
|
||||||
|
of the JPEG library. These are the "minimum" API routines that may be
|
||||||
|
needed in either the normal full-compression case or the transcoding-only
|
||||||
|
case.
|
||||||
|
|
||||||
|
Most of the routines intended to be called directly by an application
|
||||||
|
are in this file or in jcapistd.c. But also see jcparam.c for
|
||||||
|
parameter-setup helper routines, jcomapi.c for routines shared by
|
||||||
|
compression and decompression, and jctrans.c for the transcoding case. }
|
||||||
|
|
||||||
|
{ jcapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. }
|
||||||
|
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib,
|
||||||
|
imjcomapi,
|
||||||
|
imjmemmgr,
|
||||||
|
imjcmarker;
|
||||||
|
|
||||||
|
{ Initialization of JPEG compression objects.
|
||||||
|
Nomssi: This is a macro in the original code.
|
||||||
|
|
||||||
|
jpeg_create_compress() and jpeg_create_decompress() are the exported
|
||||||
|
names that applications should call. These expand to calls on
|
||||||
|
jpeg_CreateCompress and jpeg_CreateDecompress with additional information
|
||||||
|
passed for version mismatch checking.
|
||||||
|
NB: you must set up the error-manager BEFORE calling jpeg_create_xxx. }
|
||||||
|
|
||||||
|
procedure jpeg_create_compress(cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialization of a JPEG compression object.
|
||||||
|
The error manager must already be set up (in case memory manager fails). }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_CreateCompress (cinfo : j_compress_ptr;
|
||||||
|
version : int;
|
||||||
|
structsize : size_t);
|
||||||
|
|
||||||
|
{ Destruction of a JPEG compression object }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_destroy_compress (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
|
||||||
|
{ Abort processing of a JPEG compression operation,
|
||||||
|
but don't destroy the object itself. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_abort_compress (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
|
||||||
|
{ Forcibly suppress or un-suppress all quantization and Huffman tables.
|
||||||
|
Marks all currently defined tables as already written (if suppress)
|
||||||
|
or not written (if !suppress). This will control whether they get emitted
|
||||||
|
by a subsequent jpeg_start_compress call.
|
||||||
|
|
||||||
|
This routine is exported for use by applications that want to produce
|
||||||
|
abbreviated JPEG datastreams. It logically belongs in jcparam.c, but
|
||||||
|
since it is called by jpeg_start_compress, we put it here --- otherwise
|
||||||
|
jcparam.o would be linked whether the application used it or not. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_suppress_tables (cinfo : j_compress_ptr;
|
||||||
|
suppress : boolean);
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish JPEG compression.
|
||||||
|
|
||||||
|
If a multipass operating mode was selected, this may do a great deal of
|
||||||
|
work including most of the actual output. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_finish_compress (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
{ Write a special marker.
|
||||||
|
This is only recommended for writing COM or APPn markers.
|
||||||
|
Must be called after jpeg_start_compress() and before
|
||||||
|
first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_write_marker (cinfo : j_compress_ptr;
|
||||||
|
marker : int;
|
||||||
|
dataptr : JOCTETptr;
|
||||||
|
datalen : uInt);
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_write_m_header (cinfo : j_compress_ptr;
|
||||||
|
marker : int;
|
||||||
|
datalen : uint);
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int);
|
||||||
|
|
||||||
|
{ Alternate compression function: just write an abbreviated table file.
|
||||||
|
Before calling this, all parameters and a data destination must be set up.
|
||||||
|
|
||||||
|
To produce a pair of files containing abbreviated tables and abbreviated
|
||||||
|
image data, one would proceed as follows:
|
||||||
|
|
||||||
|
initialize JPEG object
|
||||||
|
set JPEG parameters
|
||||||
|
set destination to table file
|
||||||
|
jpeg_write_tables(cinfo);
|
||||||
|
set destination to image file
|
||||||
|
jpeg_start_compress(cinfo, FALSE);
|
||||||
|
write data...
|
||||||
|
jpeg_finish_compress(cinfo);
|
||||||
|
|
||||||
|
jpeg_write_tables has the side effect of marking all tables written
|
||||||
|
(same as jpeg_suppress_tables(..., TRUE)). Thus a subsequent start_compress
|
||||||
|
will not re-emit the tables unless it is passed write_all_tables=TRUE. }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_write_tables (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure jpeg_create_compress(cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
jpeg_CreateCompress(cinfo, JPEG_LIB_VERSION,
|
||||||
|
size_t(sizeof(jpeg_compress_struct)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Initialization of a JPEG compression object.
|
||||||
|
The error manager must already be set up (in case memory manager fails). }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_CreateCompress (cinfo : j_compress_ptr;
|
||||||
|
version : int;
|
||||||
|
structsize : size_t);
|
||||||
|
var
|
||||||
|
i : int;
|
||||||
|
var
|
||||||
|
err : jpeg_error_mgr_ptr;
|
||||||
|
client_data : voidp;
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ Guard against version mismatches between library and caller. }
|
||||||
|
cinfo^.mem := NIL; { so jpeg_destroy knows mem mgr not called }
|
||||||
|
if (version <> JPEG_LIB_VERSION) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_LIB_VERSION, JPEG_LIB_VERSION, version);
|
||||||
|
if (structsize <> SIZEOF(jpeg_compress_struct)) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE,
|
||||||
|
int(SIZEOF(jpeg_compress_struct)), int(structsize));
|
||||||
|
|
||||||
|
{ For debugging purposes, we zero the whole master structure.
|
||||||
|
But the application has already set the err pointer, and may have set
|
||||||
|
client_data, so we have to save and restore those fields.
|
||||||
|
Note: if application hasn't set client_data, tools like Purify may
|
||||||
|
complain here. }
|
||||||
|
|
||||||
|
err := cinfo^.err;
|
||||||
|
client_data := cinfo^.client_data; { ignore Purify complaint here }
|
||||||
|
MEMZERO(cinfo, SIZEOF(jpeg_compress_struct));
|
||||||
|
cinfo^.err := err;
|
||||||
|
cinfo^.is_decompressor := FALSE;
|
||||||
|
|
||||||
|
{ Initialize a memory manager instance for this object }
|
||||||
|
jinit_memory_mgr(j_common_ptr(cinfo));
|
||||||
|
|
||||||
|
{ Zero out pointers to permanent structures. }
|
||||||
|
cinfo^.progress := NIL;
|
||||||
|
cinfo^.dest := NIL;
|
||||||
|
|
||||||
|
cinfo^.comp_info := NIL;
|
||||||
|
|
||||||
|
for i := 0 to pred(NUM_QUANT_TBLS) do
|
||||||
|
cinfo^.quant_tbl_ptrs[i] := NIL;
|
||||||
|
|
||||||
|
for i := 0 to pred(NUM_HUFF_TBLS) do
|
||||||
|
begin
|
||||||
|
cinfo^.dc_huff_tbl_ptrs[i] := NIL;
|
||||||
|
cinfo^.ac_huff_tbl_ptrs[i] := NIL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
cinfo^.script_space := NIL;
|
||||||
|
|
||||||
|
cinfo^.input_gamma := 1.0; { in case application forgets }
|
||||||
|
|
||||||
|
{ OK, I'm ready }
|
||||||
|
cinfo^.global_state := CSTATE_START;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Destruction of a JPEG compression object }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_destroy_compress (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
jpeg_destroy(j_common_ptr(cinfo)); { use common routine }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Abort processing of a JPEG compression operation,
|
||||||
|
but don't destroy the object itself. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_abort_compress (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
jpeg_abort(j_common_ptr(cinfo)); { use common routine }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Forcibly suppress or un-suppress all quantization and Huffman tables.
|
||||||
|
Marks all currently defined tables as already written (if suppress)
|
||||||
|
or not written (if !suppress). This will control whether they get emitted
|
||||||
|
by a subsequent jpeg_start_compress call.
|
||||||
|
|
||||||
|
This routine is exported for use by applications that want to produce
|
||||||
|
abbreviated JPEG datastreams. It logically belongs in jcparam.c, but
|
||||||
|
since it is called by jpeg_start_compress, we put it here --- otherwise
|
||||||
|
jcparam.o would be linked whether the application used it or not. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_suppress_tables (cinfo : j_compress_ptr;
|
||||||
|
suppress : boolean);
|
||||||
|
var
|
||||||
|
i : int;
|
||||||
|
qtbl : JQUANT_TBL_PTR;
|
||||||
|
htbl : JHUFF_TBL_PTR;
|
||||||
|
begin
|
||||||
|
for i := 0 to pred(NUM_QUANT_TBLS) do
|
||||||
|
begin
|
||||||
|
qtbl := cinfo^.quant_tbl_ptrs[i];
|
||||||
|
if (qtbl <> NIL) then
|
||||||
|
qtbl^.sent_table := suppress;
|
||||||
|
end;
|
||||||
|
|
||||||
|
for i := 0 to pred(NUM_HUFF_TBLS) do
|
||||||
|
begin
|
||||||
|
htbl := cinfo^.dc_huff_tbl_ptrs[i];
|
||||||
|
if (htbl <> NIL) then
|
||||||
|
htbl^.sent_table := suppress;
|
||||||
|
htbl := cinfo^.ac_huff_tbl_ptrs[i];
|
||||||
|
if (htbl <> NIL) then
|
||||||
|
htbl^.sent_table := suppress;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish JPEG compression.
|
||||||
|
|
||||||
|
If a multipass operating mode was selected, this may do a great deal of
|
||||||
|
work including most of the actual output. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_finish_compress (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
iMCU_row : JDIMENSION;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state = CSTATE_SCANNING) or
|
||||||
|
(cinfo^.global_state = CSTATE_RAW_OK) then
|
||||||
|
begin
|
||||||
|
{ Terminate first pass }
|
||||||
|
if (cinfo^.next_scanline < cinfo^.image_height) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA);
|
||||||
|
cinfo^.master^.finish_pass (cinfo);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.global_state <> CSTATE_WRCOEFS) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
{ Perform any remaining passes }
|
||||||
|
while (not cinfo^.master^.is_last_pass) do
|
||||||
|
begin
|
||||||
|
cinfo^.master^.prepare_for_pass (cinfo);
|
||||||
|
for iMCU_row := 0 to pred(cinfo^.total_iMCU_rows) do
|
||||||
|
begin
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.progress^.pass_counter := long (iMCU_row);
|
||||||
|
cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows);
|
||||||
|
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
|
||||||
|
end;
|
||||||
|
{ We bypass the main controller and invoke coef controller directly;
|
||||||
|
all work is being done from the coefficient buffer. }
|
||||||
|
|
||||||
|
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(NIL))) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
|
||||||
|
end;
|
||||||
|
cinfo^.master^.finish_pass (cinfo);
|
||||||
|
end;
|
||||||
|
{ Write EOI, do final cleanup }
|
||||||
|
cinfo^.marker^.write_file_trailer (cinfo);
|
||||||
|
cinfo^.dest^.term_destination (cinfo);
|
||||||
|
{ We can use jpeg_abort to release memory and reset global_state }
|
||||||
|
jpeg_abort(j_common_ptr(cinfo));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Write a special marker.
|
||||||
|
This is only recommended for writing COM or APPn markers.
|
||||||
|
Must be called after jpeg_start_compress() and before
|
||||||
|
first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_write_marker (cinfo : j_compress_ptr;
|
||||||
|
marker : int;
|
||||||
|
dataptr : JOCTETptr;
|
||||||
|
datalen : uInt);
|
||||||
|
var
|
||||||
|
write_marker_byte : procedure(info : j_compress_ptr; val : int);
|
||||||
|
begin
|
||||||
|
if (cinfo^.next_scanline <> 0) or
|
||||||
|
((cinfo^.global_state <> CSTATE_SCANNING) and
|
||||||
|
(cinfo^.global_state <> CSTATE_RAW_OK) and
|
||||||
|
(cinfo^.global_state <> CSTATE_WRCOEFS)) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
cinfo^.marker^.write_marker_header (cinfo, marker, datalen);
|
||||||
|
write_marker_byte := cinfo^.marker^.write_marker_byte; { copy for speed }
|
||||||
|
while (datalen <> 0) do
|
||||||
|
begin
|
||||||
|
Dec(datalen);
|
||||||
|
write_marker_byte (cinfo, dataptr^);
|
||||||
|
Inc(dataptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Same, but piecemeal. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_write_m_header (cinfo : j_compress_ptr;
|
||||||
|
marker : int;
|
||||||
|
datalen : uint);
|
||||||
|
begin
|
||||||
|
if (cinfo^.next_scanline <> 0) or
|
||||||
|
((cinfo^.global_state <> CSTATE_SCANNING) and
|
||||||
|
(cinfo^.global_state <> CSTATE_RAW_OK) and
|
||||||
|
(cinfo^.global_state <> CSTATE_WRCOEFS)) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
cinfo^.marker^.write_marker_header (cinfo, marker, datalen);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int);
|
||||||
|
begin
|
||||||
|
cinfo^.marker^.write_marker_byte (cinfo, val);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Alternate compression function: just write an abbreviated table file.
|
||||||
|
Before calling this, all parameters and a data destination must be set up.
|
||||||
|
|
||||||
|
To produce a pair of files containing abbreviated tables and abbreviated
|
||||||
|
image data, one would proceed as follows:
|
||||||
|
|
||||||
|
initialize JPEG object
|
||||||
|
set JPEG parameters
|
||||||
|
set destination to table file
|
||||||
|
jpeg_write_tables(cinfo);
|
||||||
|
set destination to image file
|
||||||
|
jpeg_start_compress(cinfo, FALSE);
|
||||||
|
write data...
|
||||||
|
jpeg_finish_compress(cinfo);
|
||||||
|
|
||||||
|
jpeg_write_tables has the side effect of marking all tables written
|
||||||
|
(same as jpeg_suppress_tables(..., TRUE)). Thus a subsequent start_compress
|
||||||
|
will not re-emit the tables unless it is passed write_all_tables=TRUE. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_write_tables (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> CSTATE_START) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
{ (Re)initialize error mgr and destination modules }
|
||||||
|
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
|
||||||
|
cinfo^.dest^.init_destination (cinfo);
|
||||||
|
{ Initialize the marker writer ... bit of a crock to do it here. }
|
||||||
|
jinit_marker_writer(cinfo);
|
||||||
|
{ Write them tables! }
|
||||||
|
cinfo^.marker^.write_tables_only (cinfo);
|
||||||
|
{ And clean up. }
|
||||||
|
cinfo^.dest^.term_destination (cinfo);
|
||||||
|
|
||||||
|
{ In library releases up through v6a, we called jpeg_abort() here to free
|
||||||
|
any working memory allocated by the destination manager and marker
|
||||||
|
writer. Some applications had a problem with that: they allocated space
|
||||||
|
of their own from the library memory manager, and didn't want it to go
|
||||||
|
away during write_tables. So now we do nothing. This will cause a
|
||||||
|
memory leak if an app calls write_tables repeatedly without doing a full
|
||||||
|
compression cycle or otherwise resetting the JPEG object. However, that
|
||||||
|
seems less bad than unexpectedly freeing memory in the normal case.
|
||||||
|
An app that prefers the old behavior can call jpeg_abort for itself after
|
||||||
|
each call to jpeg_write_tables(). }
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,222 @@
|
||||||
|
unit imjcapistd;
|
||||||
|
|
||||||
|
{ Original : jcapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
{ This file is part of the Independent JPEG Group's software.
|
||||||
|
For conditions of distribution and use, see the accompanying README file.
|
||||||
|
|
||||||
|
This file contains application interface code for the compression half
|
||||||
|
of the JPEG library. These are the "standard" API routines that are
|
||||||
|
used in the normal full-compression case. They are not used by a
|
||||||
|
transcoding-only application. Note that if an application links in
|
||||||
|
jpeg_start_compress, it will end up linking in the entire compressor.
|
||||||
|
We thus must separate this file from jcapimin.c to avoid linking the
|
||||||
|
whole compression library into a transcoder. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib,
|
||||||
|
imjcapimin, imjcinit;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ Compression initialization.
|
||||||
|
Before calling this, all parameters and a data destination must be set up.
|
||||||
|
|
||||||
|
We require a write_all_tables parameter as a failsafe check when writing
|
||||||
|
multiple datastreams from the same compression object. Since prior runs
|
||||||
|
will have left all the tables marked sent_table=TRUE, a subsequent run
|
||||||
|
would emit an abbreviated stream (no tables) by default. This may be what
|
||||||
|
is wanted, but for safety's sake it should not be the default behavior:
|
||||||
|
programmers should have to make a deliberate choice to emit abbreviated
|
||||||
|
images. Therefore the documentation and examples should encourage people
|
||||||
|
to pass write_all_tables=TRUE; then it will take active thought to do the
|
||||||
|
wrong thing. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_start_compress (cinfo : j_compress_ptr;
|
||||||
|
write_all_tables : boolean);
|
||||||
|
|
||||||
|
|
||||||
|
{ Write some scanlines of data to the JPEG compressor.
|
||||||
|
|
||||||
|
The return value will be the number of lines actually written.
|
||||||
|
This should be less than the supplied num_lines only in case that
|
||||||
|
the data destination module has requested suspension of the compressor,
|
||||||
|
or if more than image_height scanlines are passed in.
|
||||||
|
|
||||||
|
Note: we warn about excess calls to jpeg_write_scanlines() since
|
||||||
|
this likely signals an application programmer error. However,
|
||||||
|
excess scanlines passed in the last valid call are *silently* ignored,
|
||||||
|
so that the application need not adjust num_lines for end-of-image
|
||||||
|
when using a multiple-scanline buffer. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_write_scanlines (cinfo : j_compress_ptr;
|
||||||
|
scanlines : JSAMPARRAY;
|
||||||
|
num_lines : JDIMENSION) : JDIMENSION;
|
||||||
|
|
||||||
|
{ Alternate entry point to write raw data.
|
||||||
|
Processes exactly one iMCU row per call, unless suspended. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_write_raw_data (cinfo : j_compress_ptr;
|
||||||
|
data : JSAMPIMAGE;
|
||||||
|
num_lines : JDIMENSION) : JDIMENSION;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Compression initialization.
|
||||||
|
Before calling this, all parameters and a data destination must be set up.
|
||||||
|
|
||||||
|
We require a write_all_tables parameter as a failsafe check when writing
|
||||||
|
multiple datastreams from the same compression object. Since prior runs
|
||||||
|
will have left all the tables marked sent_table=TRUE, a subsequent run
|
||||||
|
would emit an abbreviated stream (no tables) by default. This may be what
|
||||||
|
is wanted, but for safety's sake it should not be the default behavior:
|
||||||
|
programmers should have to make a deliberate choice to emit abbreviated
|
||||||
|
images. Therefore the documentation and examples should encourage people
|
||||||
|
to pass write_all_tables=TRUE; then it will take active thought to do the
|
||||||
|
wrong thing. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_start_compress (cinfo : j_compress_ptr;
|
||||||
|
write_all_tables : boolean);
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> CSTATE_START) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
if (write_all_tables) then
|
||||||
|
jpeg_suppress_tables(cinfo, FALSE); { mark all tables to be written }
|
||||||
|
|
||||||
|
{ (Re)initialize error mgr and destination modules }
|
||||||
|
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
|
||||||
|
cinfo^.dest^.init_destination (cinfo);
|
||||||
|
{ Perform master selection of active modules }
|
||||||
|
jinit_compress_master(cinfo);
|
||||||
|
{ Set up for the first pass }
|
||||||
|
cinfo^.master^.prepare_for_pass (cinfo);
|
||||||
|
{ Ready for application to drive first pass through jpeg_write_scanlines
|
||||||
|
or jpeg_write_raw_data. }
|
||||||
|
|
||||||
|
cinfo^.next_scanline := 0;
|
||||||
|
if cinfo^.raw_data_in then
|
||||||
|
cinfo^.global_state := CSTATE_RAW_OK
|
||||||
|
else
|
||||||
|
cinfo^.global_state := CSTATE_SCANNING;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Write some scanlines of data to the JPEG compressor.
|
||||||
|
|
||||||
|
The return value will be the number of lines actually written.
|
||||||
|
This should be less than the supplied num_lines only in case that
|
||||||
|
the data destination module has requested suspension of the compressor,
|
||||||
|
or if more than image_height scanlines are passed in.
|
||||||
|
|
||||||
|
Note: we warn about excess calls to jpeg_write_scanlines() since
|
||||||
|
this likely signals an application programmer error. However,
|
||||||
|
excess scanlines passed in the last valid call are *silently* ignored,
|
||||||
|
so that the application need not adjust num_lines for end-of-image
|
||||||
|
when using a multiple-scanline buffer. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_write_scanlines (cinfo : j_compress_ptr;
|
||||||
|
scanlines : JSAMPARRAY;
|
||||||
|
num_lines : JDIMENSION) : JDIMENSION;
|
||||||
|
var
|
||||||
|
row_ctr, rows_left : JDIMENSION;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> CSTATE_SCANNING) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
if (cinfo^.next_scanline >= cinfo^.image_height) then
|
||||||
|
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
|
||||||
|
|
||||||
|
{ Call progress monitor hook if present }
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.progress^.pass_counter := long (cinfo^.next_scanline);
|
||||||
|
cinfo^.progress^.pass_limit := long (cinfo^.image_height);
|
||||||
|
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Give master control module another chance if this is first call to
|
||||||
|
jpeg_write_scanlines. This lets output of the frame/scan headers be
|
||||||
|
delayed so that application can write COM, etc, markers between
|
||||||
|
jpeg_start_compress and jpeg_write_scanlines. }
|
||||||
|
if (cinfo^.master^.call_pass_startup) then
|
||||||
|
cinfo^.master^.pass_startup (cinfo);
|
||||||
|
|
||||||
|
{ Ignore any extra scanlines at bottom of image. }
|
||||||
|
rows_left := cinfo^.image_height - cinfo^.next_scanline;
|
||||||
|
if (num_lines > rows_left) then
|
||||||
|
num_lines := rows_left;
|
||||||
|
|
||||||
|
row_ctr := 0;
|
||||||
|
cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, num_lines);
|
||||||
|
Inc(cinfo^.next_scanline, row_ctr);
|
||||||
|
jpeg_write_scanlines := row_ctr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Alternate entry point to write raw data.
|
||||||
|
Processes exactly one iMCU row per call, unless suspended. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_write_raw_data (cinfo : j_compress_ptr;
|
||||||
|
data : JSAMPIMAGE;
|
||||||
|
num_lines : JDIMENSION) : JDIMENSION;
|
||||||
|
var
|
||||||
|
lines_per_iMCU_row : JDIMENSION;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> CSTATE_RAW_OK) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
if (cinfo^.next_scanline >= cinfo^.image_height) then
|
||||||
|
begin
|
||||||
|
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
|
||||||
|
jpeg_write_raw_data := 0;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Call progress monitor hook if present }
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.progress^.pass_counter := long(cinfo^.next_scanline);
|
||||||
|
cinfo^.progress^.pass_limit := long(cinfo^.image_height);
|
||||||
|
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Give master control module another chance if this is first call to
|
||||||
|
jpeg_write_raw_data. This lets output of the frame/scan headers be
|
||||||
|
delayed so that application can write COM, etc, markers between
|
||||||
|
jpeg_start_compress and jpeg_write_raw_data. }
|
||||||
|
|
||||||
|
if (cinfo^.master^.call_pass_startup) then
|
||||||
|
cinfo^.master^.pass_startup (cinfo);
|
||||||
|
|
||||||
|
{ Verify that at least one iMCU row has been passed. }
|
||||||
|
lines_per_iMCU_row := cinfo^.max_v_samp_factor * DCTSIZE;
|
||||||
|
if (num_lines < lines_per_iMCU_row) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE);
|
||||||
|
|
||||||
|
{ Directly compress the row. }
|
||||||
|
if (not cinfo^.coef^.compress_data (cinfo, data)) then
|
||||||
|
begin
|
||||||
|
{ If compressor did not consume the whole row, suspend processing. }
|
||||||
|
jpeg_write_raw_data := 0;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ OK, we processed one iMCU row. }
|
||||||
|
Inc(cinfo^.next_scanline, lines_per_iMCU_row);
|
||||||
|
jpeg_write_raw_data := lines_per_iMCU_row;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,521 @@
|
||||||
|
unit imjccoefct;
|
||||||
|
|
||||||
|
{ This file contains the coefficient buffer controller for compression.
|
||||||
|
This controller is the top level of the JPEG compressor proper.
|
||||||
|
The coefficient buffer lies between forward-DCT and entropy encoding steps.}
|
||||||
|
|
||||||
|
{ Original: jccoefct.c; Copyright (C) 1994-1997, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjerror,
|
||||||
|
imjdeferr,
|
||||||
|
imjutils,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
{ We use a full-image coefficient buffer when doing Huffman optimization,
|
||||||
|
and also for writing multiple-scan JPEG files. In all cases, the DCT
|
||||||
|
step is run during the first pass, and subsequent passes need only read
|
||||||
|
the buffered coefficients. }
|
||||||
|
{$ifdef ENTROPY_OPT_SUPPORTED}
|
||||||
|
{$define FULL_COEF_BUFFER_SUPPORTED}
|
||||||
|
{$else}
|
||||||
|
{$ifdef C_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
{$define FULL_COEF_BUFFER_SUPPORTED}
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{ Initialize coefficient buffer controller. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_c_coef_controller (cinfo : j_compress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Private buffer controller object }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_coef_ptr = ^my_coef_controller;
|
||||||
|
my_coef_controller = record
|
||||||
|
pub : jpeg_c_coef_controller; { public fields }
|
||||||
|
|
||||||
|
iMCU_row_num : JDIMENSION; { iMCU row # within image }
|
||||||
|
mcu_ctr : JDIMENSION; { counts MCUs processed in current row }
|
||||||
|
MCU_vert_offset : int; { counts MCU rows within iMCU row }
|
||||||
|
MCU_rows_per_iMCU_row : int; { number of such rows needed }
|
||||||
|
|
||||||
|
{ For single-pass compression, it's sufficient to buffer just one MCU
|
||||||
|
(although this may prove a bit slow in practice). We allocate a
|
||||||
|
workspace of C_MAX_BLOCKS_IN_MCU coefficient blocks, and reuse it for each
|
||||||
|
MCU constructed and sent. (On 80x86, the workspace is FAR even though
|
||||||
|
it's not really very big; this is to keep the module interfaces unchanged
|
||||||
|
when a large coefficient buffer is necessary.)
|
||||||
|
In multi-pass modes, this array points to the current MCU's blocks
|
||||||
|
within the virtual arrays. }
|
||||||
|
|
||||||
|
MCU_buffer : array[0..C_MAX_BLOCKS_IN_MCU-1] of JBLOCKROW;
|
||||||
|
|
||||||
|
{ In multi-pass modes, we need a virtual block array for each component. }
|
||||||
|
whole_image : array[0..MAX_COMPONENTS-1] of jvirt_barray_ptr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Forward declarations }
|
||||||
|
{METHODDEF}
|
||||||
|
function compress_data(cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE) : boolean; forward;
|
||||||
|
{$ifdef FULL_COEF_BUFFER_SUPPORTED}
|
||||||
|
{METHODDEF}
|
||||||
|
function compress_first_pass(cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE) : boolean; forward;
|
||||||
|
{METHODDEF}
|
||||||
|
function compress_output(cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE) : boolean; forward;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure start_iMCU_row (cinfo : j_compress_ptr);
|
||||||
|
{ Reset within-iMCU-row counters for a new row }
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
|
||||||
|
{ In an interleaved scan, an MCU row is the same as an iMCU row.
|
||||||
|
In a noninterleaved scan, an iMCU row has v_samp_factor MCU rows.
|
||||||
|
But at the bottom of the image, process only what's left. }
|
||||||
|
if (cinfo^.comps_in_scan > 1) then
|
||||||
|
begin
|
||||||
|
coef^.MCU_rows_per_iMCU_row := 1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (coef^.iMCU_row_num < (cinfo^.total_iMCU_rows-1)) then
|
||||||
|
coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.v_samp_factor
|
||||||
|
else
|
||||||
|
coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.last_row_height;
|
||||||
|
end;
|
||||||
|
|
||||||
|
coef^.mcu_ctr := 0;
|
||||||
|
coef^.MCU_vert_offset := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for a processing pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass_coef (cinfo : j_compress_ptr;
|
||||||
|
pass_mode : J_BUF_MODE);
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
|
||||||
|
coef^.iMCU_row_num := 0;
|
||||||
|
start_iMCU_row(cinfo);
|
||||||
|
|
||||||
|
case (pass_mode) of
|
||||||
|
JBUF_PASS_THRU:
|
||||||
|
begin
|
||||||
|
if (coef^.whole_image[0] <> NIL) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
coef^.pub.compress_data := compress_data;
|
||||||
|
end;
|
||||||
|
{$ifdef FULL_COEF_BUFFER_SUPPORTED}
|
||||||
|
JBUF_SAVE_AND_PASS:
|
||||||
|
begin
|
||||||
|
if (coef^.whole_image[0] = NIL) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
coef^.pub.compress_data := compress_first_pass;
|
||||||
|
end;
|
||||||
|
JBUF_CRANK_DEST:
|
||||||
|
begin
|
||||||
|
if (coef^.whole_image[0] = NIL) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
coef^.pub.compress_data := compress_output;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Process some data in the single-pass case.
|
||||||
|
We process the equivalent of one fully interleaved MCU row ("iMCU" row)
|
||||||
|
per call, ie, v_samp_factor block rows for each component in the image.
|
||||||
|
Returns TRUE if the iMCU row is completed, FALSE if suspended.
|
||||||
|
|
||||||
|
NB: input_buf contains a plane for each component in image,
|
||||||
|
which we index according to the component's SOF position. }
|
||||||
|
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function compress_data (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE) : boolean;
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
MCU_col_num : JDIMENSION; { index of current MCU within row }
|
||||||
|
last_MCU_col : JDIMENSION;
|
||||||
|
last_iMCU_row : JDIMENSION;
|
||||||
|
blkn, bi, ci, yindex, yoffset, blockcnt : int;
|
||||||
|
ypos, xpos : JDIMENSION;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
last_MCU_col := cinfo^.MCUs_per_row - 1;
|
||||||
|
last_iMCU_row := cinfo^.total_iMCU_rows - 1;
|
||||||
|
|
||||||
|
{ Loop to write as much as one whole iMCU row }
|
||||||
|
for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do
|
||||||
|
begin
|
||||||
|
for MCU_col_num := coef^.mcu_ctr to last_MCU_col do
|
||||||
|
begin
|
||||||
|
{ Determine where data comes from in input_buf and do the DCT thing.
|
||||||
|
Each call on forward_DCT processes a horizontal row of DCT blocks
|
||||||
|
as wide as an MCU; we rely on having allocated the MCU_buffer[] blocks
|
||||||
|
sequentially. Dummy blocks at the right or bottom edge are filled in
|
||||||
|
specially. The data in them does not matter for image reconstruction,
|
||||||
|
so we fill them with values that will encode to the smallest amount of
|
||||||
|
data, viz: all zeroes in the AC entries, DC entries equal to previous
|
||||||
|
block's DC value. (Thanks to Thomas Kinsman for this idea.) }
|
||||||
|
|
||||||
|
blkn := 0;
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
if (MCU_col_num < last_MCU_col) then
|
||||||
|
blockcnt := compptr^.MCU_width
|
||||||
|
else
|
||||||
|
blockcnt := compptr^.last_col_width;
|
||||||
|
xpos := MCU_col_num * JDIMENSION(compptr^.MCU_sample_width);
|
||||||
|
ypos := yoffset * DCTSIZE; { ypos = (yoffset+yindex) * DCTSIZE }
|
||||||
|
for yindex := 0 to pred(compptr^.MCU_height) do
|
||||||
|
begin
|
||||||
|
if (coef^.iMCU_row_num < last_iMCU_row) or
|
||||||
|
(yoffset+yindex < compptr^.last_row_height) then
|
||||||
|
begin
|
||||||
|
cinfo^.fdct^.forward_DCT (cinfo, compptr,
|
||||||
|
input_buf^[compptr^.component_index],
|
||||||
|
coef^.MCU_buffer[blkn],
|
||||||
|
ypos, xpos, JDIMENSION (blockcnt));
|
||||||
|
|
||||||
|
if (blockcnt < compptr^.MCU_width) then
|
||||||
|
begin
|
||||||
|
{ Create some dummy blocks at the right edge of the image. }
|
||||||
|
jzero_far({FAR}pointer(coef^.MCU_buffer[blkn + blockcnt]),
|
||||||
|
(compptr^.MCU_width - blockcnt) * SIZEOF(JBLOCK));
|
||||||
|
for bi := blockcnt to pred(compptr^.MCU_width) do
|
||||||
|
begin
|
||||||
|
coef^.MCU_buffer[blkn+bi]^[0][0] := coef^.MCU_buffer[blkn+bi-1]^[0][0];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Create a row of dummy blocks at the bottom of the image. }
|
||||||
|
jzero_far({FAR}pointer(coef^.MCU_buffer[blkn]),
|
||||||
|
compptr^.MCU_width * SIZEOF(JBLOCK));
|
||||||
|
for bi := 0 to pred(compptr^.MCU_width) do
|
||||||
|
begin
|
||||||
|
coef^.MCU_buffer[blkn+bi]^[0][0] := coef^.MCU_buffer[blkn-1]^[0][0];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(blkn, compptr^.MCU_width);
|
||||||
|
Inc(ypos, DCTSIZE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Try to write the MCU. In event of a suspension failure, we will
|
||||||
|
re-DCT the MCU on restart (a bit inefficient, could be fixed...) }
|
||||||
|
|
||||||
|
if (not cinfo^.entropy^.encode_mcu (cinfo, JBLOCKARRAY(@coef^.MCU_buffer)^)) then
|
||||||
|
begin
|
||||||
|
{ Suspension forced; update state counters and exit }
|
||||||
|
coef^.MCU_vert_offset := yoffset;
|
||||||
|
coef^.mcu_ctr := MCU_col_num;
|
||||||
|
compress_data := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Completed an MCU row, but perhaps not an iMCU row }
|
||||||
|
coef^.mcu_ctr := 0;
|
||||||
|
end;
|
||||||
|
{ Completed the iMCU row, advance counters for next one }
|
||||||
|
Inc(coef^.iMCU_row_num);
|
||||||
|
start_iMCU_row(cinfo);
|
||||||
|
compress_data := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef FULL_COEF_BUFFER_SUPPORTED}
|
||||||
|
|
||||||
|
{ Process some data in the first pass of a multi-pass case.
|
||||||
|
We process the equivalent of one fully interleaved MCU row ("iMCU" row)
|
||||||
|
per call, ie, v_samp_factor block rows for each component in the image.
|
||||||
|
This amount of data is read from the source buffer, DCT'd and quantized,
|
||||||
|
and saved into the virtual arrays. We also generate suitable dummy blocks
|
||||||
|
as needed at the right and lower edges. (The dummy blocks are constructed
|
||||||
|
in the virtual arrays, which have been padded appropriately.) This makes
|
||||||
|
it possible for subsequent passes not to worry about real vs. dummy blocks.
|
||||||
|
|
||||||
|
We must also emit the data to the entropy encoder. This is conveniently
|
||||||
|
done by calling compress_output() after we've loaded the current strip
|
||||||
|
of the virtual arrays.
|
||||||
|
|
||||||
|
NB: input_buf contains a plane for each component in image. All
|
||||||
|
components are DCT'd and loaded into the virtual arrays in this pass.
|
||||||
|
However, it may be that only a subset of the components are emitted to
|
||||||
|
the entropy encoder during this first pass; be careful about looking
|
||||||
|
at the scan-dependent variables (MCU dimensions, etc). }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function compress_first_pass (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE) : boolean;
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
last_iMCU_row : JDIMENSION;
|
||||||
|
blocks_across, MCUs_across, MCUindex : JDIMENSION;
|
||||||
|
bi, ci, h_samp_factor, block_row, block_rows, ndummy : int;
|
||||||
|
lastDC : JCOEF;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
buffer : JBLOCKARRAY;
|
||||||
|
thisblockrow, lastblockrow : JBLOCKROW;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
last_iMCU_row := cinfo^.total_iMCU_rows - 1;
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ Align the virtual buffer for this component. }
|
||||||
|
buffer := cinfo^.mem^.access_virt_barray
|
||||||
|
(j_common_ptr(cinfo), coef^.whole_image[ci],
|
||||||
|
coef^.iMCU_row_num * JDIMENSION(compptr^.v_samp_factor),
|
||||||
|
JDIMENSION (compptr^.v_samp_factor), TRUE);
|
||||||
|
{ Count non-dummy DCT block rows in this iMCU row. }
|
||||||
|
if (coef^.iMCU_row_num < last_iMCU_row) then
|
||||||
|
block_rows := compptr^.v_samp_factor
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ NB: can't use last_row_height here, since may not be set! }
|
||||||
|
block_rows := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor;
|
||||||
|
if (block_rows = 0) then
|
||||||
|
block_rows := compptr^.v_samp_factor;
|
||||||
|
end;
|
||||||
|
blocks_across := compptr^.width_in_blocks;
|
||||||
|
h_samp_factor := compptr^.h_samp_factor;
|
||||||
|
{ Count number of dummy blocks to be added at the right margin. }
|
||||||
|
ndummy := int (blocks_across) mod h_samp_factor;
|
||||||
|
if (ndummy > 0) then
|
||||||
|
ndummy := h_samp_factor - ndummy;
|
||||||
|
{ Perform DCT for all non-dummy blocks in this iMCU row. Each call
|
||||||
|
on forward_DCT processes a complete horizontal row of DCT blocks. }
|
||||||
|
|
||||||
|
for block_row := 0 to pred(block_rows) do
|
||||||
|
begin
|
||||||
|
thisblockrow := buffer^[block_row];
|
||||||
|
cinfo^.fdct^.forward_DCT (cinfo, compptr,
|
||||||
|
input_buf^[ci],
|
||||||
|
thisblockrow,
|
||||||
|
JDIMENSION (block_row * DCTSIZE),
|
||||||
|
JDIMENSION (0),
|
||||||
|
blocks_across);
|
||||||
|
if (ndummy > 0) then
|
||||||
|
begin
|
||||||
|
{ Create dummy blocks at the right edge of the image. }
|
||||||
|
Inc(JBLOCK_PTR(thisblockrow), blocks_across); { => first dummy block }
|
||||||
|
jzero_far({FAR}pointer(thisblockrow), ndummy * SIZEOF(JBLOCK));
|
||||||
|
{lastDC := thisblockrow^[-1][0];}
|
||||||
|
{ work around Range Checking }
|
||||||
|
Dec(JBLOCK_PTR(thisblockrow));
|
||||||
|
lastDC := thisblockrow^[0][0];
|
||||||
|
Inc(JBLOCK_PTR(thisblockrow));
|
||||||
|
|
||||||
|
for bi := 0 to pred(ndummy) do
|
||||||
|
begin
|
||||||
|
thisblockrow^[bi][0] := lastDC;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ If at end of image, create dummy block rows as needed.
|
||||||
|
The tricky part here is that within each MCU, we want the DC values
|
||||||
|
of the dummy blocks to match the last real block's DC value.
|
||||||
|
This squeezes a few more bytes out of the resulting file... }
|
||||||
|
|
||||||
|
if (coef^.iMCU_row_num = last_iMCU_row) then
|
||||||
|
begin
|
||||||
|
Inc(blocks_across, ndummy); { include lower right corner }
|
||||||
|
MCUs_across := blocks_across div JDIMENSION(h_samp_factor);
|
||||||
|
for block_row := block_rows to pred(compptr^.v_samp_factor) do
|
||||||
|
begin
|
||||||
|
thisblockrow := buffer^[block_row];
|
||||||
|
lastblockrow := buffer^[block_row-1];
|
||||||
|
jzero_far({FAR} pointer(thisblockrow),
|
||||||
|
size_t(blocks_across * SIZEOF(JBLOCK)));
|
||||||
|
for MCUindex := 0 to pred(MCUs_across) do
|
||||||
|
begin
|
||||||
|
lastDC := lastblockrow^[h_samp_factor-1][0];
|
||||||
|
for bi := 0 to pred(h_samp_factor) do
|
||||||
|
begin
|
||||||
|
thisblockrow^[bi][0] := lastDC;
|
||||||
|
end;
|
||||||
|
Inc(JBLOCK_PTR(thisblockrow), h_samp_factor); { advance to next MCU in row }
|
||||||
|
Inc(JBLOCK_PTR(lastblockrow), h_samp_factor);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
{ NB: compress_output will increment iMCU_row_num if successful.
|
||||||
|
A suspension return will result in redoing all the work above next time.}
|
||||||
|
|
||||||
|
|
||||||
|
{ Emit data to the entropy encoder, sharing code with subsequent passes }
|
||||||
|
compress_first_pass := compress_output(cinfo, input_buf);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Process some data in subsequent passes of a multi-pass case.
|
||||||
|
We process the equivalent of one fully interleaved MCU row ("iMCU" row)
|
||||||
|
per call, ie, v_samp_factor block rows for each component in the scan.
|
||||||
|
The data is obtained from the virtual arrays and fed to the entropy coder.
|
||||||
|
Returns TRUE if the iMCU row is completed, FALSE if suspended.
|
||||||
|
|
||||||
|
NB: input_buf is ignored; it is likely to be a NIL pointer. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function compress_output (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE) : boolean;
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
MCU_col_num : JDIMENSION; { index of current MCU within row }
|
||||||
|
blkn, ci, xindex, yindex, yoffset : int;
|
||||||
|
start_col : JDIMENSION;
|
||||||
|
buffer : array[0..MAX_COMPS_IN_SCAN-1] of JBLOCKARRAY;
|
||||||
|
buffer_ptr : JBLOCKROW;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
|
||||||
|
{ Align the virtual buffers for the components used in this scan.
|
||||||
|
NB: during first pass, this is safe only because the buffers will
|
||||||
|
already be aligned properly, so jmemmgr.c won't need to do any I/O. }
|
||||||
|
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
buffer[ci] := cinfo^.mem^.access_virt_barray (
|
||||||
|
j_common_ptr(cinfo), coef^.whole_image[compptr^.component_index],
|
||||||
|
coef^.iMCU_row_num * JDIMENSION(compptr^.v_samp_factor),
|
||||||
|
JDIMENSION (compptr^.v_samp_factor), FALSE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Loop to process one whole iMCU row }
|
||||||
|
for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do
|
||||||
|
begin
|
||||||
|
for MCU_col_num := coef^.mcu_ctr to pred(cinfo^.MCUs_per_row) do
|
||||||
|
begin
|
||||||
|
{ Construct list of pointers to DCT blocks belonging to this MCU }
|
||||||
|
blkn := 0; { index of current DCT block within MCU }
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
start_col := MCU_col_num * JDIMENSION(compptr^.MCU_width);
|
||||||
|
for yindex := 0 to pred(compptr^.MCU_height) do
|
||||||
|
begin
|
||||||
|
buffer_ptr := JBLOCKROW(@ buffer[ci]^[yindex+yoffset]^[start_col]);
|
||||||
|
for xindex := 0 to pred(compptr^.MCU_width) do
|
||||||
|
begin
|
||||||
|
coef^.MCU_buffer[blkn] := buffer_ptr;
|
||||||
|
Inc(blkn);
|
||||||
|
Inc(JBLOCK_PTR(buffer_ptr));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Try to write the MCU. }
|
||||||
|
if (not cinfo^.entropy^.encode_mcu (cinfo, coef^.MCU_buffer)) then
|
||||||
|
begin
|
||||||
|
{ Suspension forced; update state counters and exit }
|
||||||
|
coef^.MCU_vert_offset := yoffset;
|
||||||
|
coef^.mcu_ctr := MCU_col_num;
|
||||||
|
compress_output := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Completed an MCU row, but perhaps not an iMCU row }
|
||||||
|
coef^.mcu_ctr := 0;
|
||||||
|
end;
|
||||||
|
{ Completed the iMCU row, advance counters for next one }
|
||||||
|
Inc(coef^.iMCU_row_num);
|
||||||
|
start_iMCU_row(cinfo);
|
||||||
|
compress_output := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { FULL_COEF_BUFFER_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize coefficient buffer controller. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_c_coef_controller (cinfo : j_compress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
var
|
||||||
|
buffer : JBLOCKROW;
|
||||||
|
i : int;
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_coef_controller)) );
|
||||||
|
cinfo^.coef := jpeg_c_coef_controller_ptr(coef);
|
||||||
|
coef^.pub.start_pass := start_pass_coef;
|
||||||
|
|
||||||
|
{ Create the coefficient buffer. }
|
||||||
|
if (need_full_buffer) then
|
||||||
|
begin
|
||||||
|
{$ifdef FULL_COEF_BUFFER_SUPPORTED}
|
||||||
|
{ Allocate a full-image virtual array for each component, }
|
||||||
|
{ padded to a multiple of samp_factor DCT blocks in each direction. }
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
coef^.whole_image[ci] := cinfo^.mem^.request_virt_barray
|
||||||
|
(j_common_ptr(cinfo), JPOOL_IMAGE, FALSE,
|
||||||
|
JDIMENSION (jround_up( long (compptr^.width_in_blocks),
|
||||||
|
long (compptr^.h_samp_factor) )),
|
||||||
|
JDIMENSION (jround_up(long (compptr^.height_in_blocks),
|
||||||
|
long (compptr^.v_samp_factor))),
|
||||||
|
JDIMENSION (compptr^.v_samp_factor));
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ We only need a single-MCU buffer. }
|
||||||
|
buffer := JBLOCKROW (
|
||||||
|
cinfo^.mem^.alloc_large (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
C_MAX_BLOCKS_IN_MCU * SIZEOF(JBLOCK)) );
|
||||||
|
for i := 0 to pred(C_MAX_BLOCKS_IN_MCU) do
|
||||||
|
begin
|
||||||
|
coef^.MCU_buffer[i] := JBLOCKROW(@ buffer^[i]);
|
||||||
|
end;
|
||||||
|
coef^.whole_image[0] := NIL; { flag for no virtual arrays }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,533 @@
|
||||||
|
unit imjccolor;
|
||||||
|
|
||||||
|
{ This file contains input colorspace conversion routines. }
|
||||||
|
|
||||||
|
{ Original : jccolor.c ; Copyright (C) 1991-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
{ Module initialization routine for input colorspace conversion. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_color_converter (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Private subobject }
|
||||||
|
type
|
||||||
|
jTInt32 = 0..Pred(MaxInt div SizeOf(INT32));
|
||||||
|
INT32_FIELD = array[jTInt32] of INT32;
|
||||||
|
INT32_FIELD_PTR = ^INT32_FIELD;
|
||||||
|
|
||||||
|
type
|
||||||
|
my_cconvert_ptr = ^my_color_converter;
|
||||||
|
my_color_converter = record
|
||||||
|
pub : jpeg_color_converter; { public fields }
|
||||||
|
|
||||||
|
{ Private state for RGB -> YCC conversion }
|
||||||
|
rgb_ycc_tab : INT32_FIELD_PTR; { => table for RGB to YCbCr conversion }
|
||||||
|
end; {my_color_converter;}
|
||||||
|
|
||||||
|
|
||||||
|
{*************** RGB -> YCbCr conversion: most common case *************}
|
||||||
|
|
||||||
|
{
|
||||||
|
YCbCr is defined per CCIR 601-1, except that Cb and Cr are
|
||||||
|
normalized to the range 0..MAXJSAMPLE rather than -0.5 .. 0.5.
|
||||||
|
The conversion equations to be implemented are therefore
|
||||||
|
Y = 0.29900 * R + 0.58700 * G + 0.11400 * B
|
||||||
|
Cb = -0.16874 * R - 0.33126 * G + 0.50000 * B + CENTERJSAMPLE
|
||||||
|
Cr = 0.50000 * R - 0.41869 * G - 0.08131 * B + CENTERJSAMPLE
|
||||||
|
(These numbers are derived from TIFF 6.0 section 21, dated 3-June-92.)
|
||||||
|
Note: older versions of the IJG code used a zero offset of MAXJSAMPLE/2,
|
||||||
|
rather than CENTERJSAMPLE, for Cb and Cr. This gave equal positive and
|
||||||
|
negative swings for Cb/Cr, but meant that grayscale values (Cb=Cr=0)
|
||||||
|
were not represented exactly. Now we sacrifice exact representation of
|
||||||
|
maximum red and maximum blue in order to get exact grayscales.
|
||||||
|
|
||||||
|
To avoid floating-point arithmetic, we represent the fractional constants
|
||||||
|
as integers scaled up by 2^16 (about 4 digits precision); we have to divide
|
||||||
|
the products by 2^16, with appropriate rounding, to get the correct answer.
|
||||||
|
|
||||||
|
For even more speed, we avoid doing any multiplications in the inner loop
|
||||||
|
by precalculating the constants times R,G,B for all possible values.
|
||||||
|
For 8-bit JSAMPLEs this is very reasonable (only 256 entries per table);
|
||||||
|
for 12-bit samples it is still acceptable. It's not very reasonable for
|
||||||
|
16-bit samples, but if you want lossless storage you shouldn't be changing
|
||||||
|
colorspace anyway.
|
||||||
|
The CENTERJSAMPLE offsets and the rounding fudge-factor of 0.5 are included
|
||||||
|
in the tables to save adding them separately in the inner loop. }
|
||||||
|
const
|
||||||
|
SCALEBITS = 16; { speediest right-shift on some machines }
|
||||||
|
CBCR_OFFSET = INT32(CENTERJSAMPLE shl SCALEBITS);
|
||||||
|
ONE_HALF = INT32(1) shl (SCALEBITS-1);
|
||||||
|
|
||||||
|
|
||||||
|
{ We allocate one big table and divide it up into eight parts, instead of
|
||||||
|
doing eight alloc_small requests. This lets us use a single table base
|
||||||
|
address, which can be held in a register in the inner loops on many
|
||||||
|
machines (more than can hold all eight addresses, anyway). }
|
||||||
|
|
||||||
|
R_Y_OFF = 0; { offset to R => Y section }
|
||||||
|
G_Y_OFF = 1*(MAXJSAMPLE+1); { offset to G => Y section }
|
||||||
|
B_Y_OFF = 2*(MAXJSAMPLE+1); { etc. }
|
||||||
|
R_CB_OFF = 3*(MAXJSAMPLE+1);
|
||||||
|
G_CB_OFF = 4*(MAXJSAMPLE+1);
|
||||||
|
B_CB_OFF = 5*(MAXJSAMPLE+1);
|
||||||
|
R_CR_OFF = B_CB_OFF; { B=>Cb, R=>Cr are the same }
|
||||||
|
G_CR_OFF = 6*(MAXJSAMPLE+1);
|
||||||
|
B_CR_OFF = 7*(MAXJSAMPLE+1);
|
||||||
|
TABLE_SIZE = 8*(MAXJSAMPLE+1);
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for RGB->YCC colorspace conversion. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure rgb_ycc_start (cinfo : j_compress_ptr);
|
||||||
|
const
|
||||||
|
FIX_0_29900 = INT32(Round (0.29900 * (1 shl SCALEBITS)) );
|
||||||
|
FIX_0_58700 = INT32(Round (0.58700 * (1 shl SCALEBITS)) );
|
||||||
|
FIX_0_11400 = INT32(Round (0.11400 * (1 shl SCALEBITS)) );
|
||||||
|
FIX_0_16874 = INT32(Round (0.16874 * (1 shl SCALEBITS)) );
|
||||||
|
FIX_0_33126 = INT32(Round (0.33126 * (1 shl SCALEBITS)) );
|
||||||
|
FIX_0_50000 = INT32(Round (0.50000 * (1 shl SCALEBITS)) );
|
||||||
|
FIX_0_41869 = INT32(Round (0.41869 * (1 shl SCALEBITS)) );
|
||||||
|
FIX_0_08131 = INT32(Round (0.08131 * (1 shl SCALEBITS)) );
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
rgb_ycc_tab : INT32_FIELD_PTR;
|
||||||
|
i : INT32;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr (cinfo^.cconvert);
|
||||||
|
|
||||||
|
{ Allocate and fill in the conversion tables. }
|
||||||
|
rgb_ycc_tab := INT32_FIELD_PTR(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
(TABLE_SIZE * SIZEOF(INT32))) );
|
||||||
|
cconvert^.rgb_ycc_tab := rgb_ycc_tab;
|
||||||
|
|
||||||
|
for i := 0 to MAXJSAMPLE do
|
||||||
|
begin
|
||||||
|
rgb_ycc_tab^[i+R_Y_OFF] := FIX_0_29900 * i;
|
||||||
|
rgb_ycc_tab^[i+G_Y_OFF] := FIX_0_58700 * i;
|
||||||
|
rgb_ycc_tab^[i+B_Y_OFF] := FIX_0_11400 * i + ONE_HALF;
|
||||||
|
rgb_ycc_tab^[i+R_CB_OFF] := (-FIX_0_16874) * i;
|
||||||
|
rgb_ycc_tab^[i+G_CB_OFF] := (-FIX_0_33126) * i;
|
||||||
|
{ We use a rounding fudge-factor of 0.5-epsilon for Cb and Cr.
|
||||||
|
This ensures that the maximum output will round to MAXJSAMPLE
|
||||||
|
not MAXJSAMPLE+1, and thus that we don't have to range-limit. }
|
||||||
|
|
||||||
|
rgb_ycc_tab^[i+B_CB_OFF] := FIX_0_50000 * i + CBCR_OFFSET + ONE_HALF-1;
|
||||||
|
{ B=>Cb and R=>Cr tables are the same
|
||||||
|
rgb_ycc_tab^[i+R_CR_OFF] := FIX_0_50000 * i + CBCR_OFFSET + ONE_HALF-1;
|
||||||
|
}
|
||||||
|
rgb_ycc_tab^[i+G_CR_OFF] := (-FIX_0_41869) * i;
|
||||||
|
rgb_ycc_tab^[i+B_CR_OFF] := (-FIX_0_08131) * i;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Convert some rows of samples to the JPEG colorspace.
|
||||||
|
|
||||||
|
Note that we change from the application's interleaved-pixel format
|
||||||
|
to our internal noninterleaved, one-plane-per-component format.
|
||||||
|
The input buffer is therefore three times as wide as the output buffer.
|
||||||
|
|
||||||
|
A starting row offset is provided only for the output buffer. The caller
|
||||||
|
can easily adjust the passed input_buf value to accommodate any row
|
||||||
|
offset required on that side. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure rgb_ycc_convert (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
output_buf : JSAMPIMAGE;
|
||||||
|
output_row : JDIMENSION;
|
||||||
|
num_rows : int);
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
{register} r, g, b : int;
|
||||||
|
{register} ctab : INT32_FIELD_PTR;
|
||||||
|
{register} inptr : JSAMPROW;
|
||||||
|
{register} outptr0, outptr1, outptr2 : JSAMPROW;
|
||||||
|
{register} col : JDIMENSION;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr (cinfo^.cconvert);
|
||||||
|
ctab := cconvert^.rgb_ycc_tab;
|
||||||
|
num_cols := cinfo^.image_width;
|
||||||
|
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
Dec(num_rows);
|
||||||
|
inptr := input_buf^[0];
|
||||||
|
Inc(JSAMPROW_PTR(input_buf));
|
||||||
|
outptr0 := output_buf^[0]^[output_row];
|
||||||
|
outptr1 := output_buf^[1]^[output_row];
|
||||||
|
outptr2 := output_buf^[2]^[output_row];
|
||||||
|
Inc(output_row);
|
||||||
|
for col := 0 to pred(num_cols) do
|
||||||
|
begin
|
||||||
|
r := GETJSAMPLE(inptr^[RGB_RED]);
|
||||||
|
g := GETJSAMPLE(inptr^[RGB_GREEN]);
|
||||||
|
b := GETJSAMPLE(inptr^[RGB_BLUE]);
|
||||||
|
Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE);
|
||||||
|
{ If the inputs are 0..MAXJSAMPLE, the outputs of these equations
|
||||||
|
must be too; we do not need an explicit range-limiting operation.
|
||||||
|
Hence the value being shifted is never negative, and we don't
|
||||||
|
need the general RIGHT_SHIFT macro. }
|
||||||
|
|
||||||
|
{ Y }
|
||||||
|
outptr0^[col] := JSAMPLE(
|
||||||
|
((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF])
|
||||||
|
shr SCALEBITS) );
|
||||||
|
{ Cb }
|
||||||
|
outptr1^[col] := JSAMPLE(
|
||||||
|
((ctab^[r+R_CB_OFF] + ctab^[g+G_CB_OFF] + ctab^[b+B_CB_OFF])
|
||||||
|
shr SCALEBITS) );
|
||||||
|
{ Cr }
|
||||||
|
outptr2^[col] := JSAMPLE(
|
||||||
|
((ctab^[r+R_CR_OFF] + ctab^[g+G_CR_OFF] + ctab^[b+B_CR_OFF])
|
||||||
|
shr SCALEBITS) );
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*************** Cases other than RGB -> YCbCr *************}
|
||||||
|
|
||||||
|
|
||||||
|
{ Convert some rows of samples to the JPEG colorspace.
|
||||||
|
This version handles RGB -> grayscale conversion, which is the same
|
||||||
|
as the RGB -> Y portion of RGB -> YCbCr.
|
||||||
|
We assume rgb_ycc_start has been called (we only use the Y tables). }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure rgb_gray_convert (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
output_buf : JSAMPIMAGE;
|
||||||
|
output_row : JDIMENSION;
|
||||||
|
num_rows : int);
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
{register} r, g, b : int;
|
||||||
|
{register} ctab :INT32_FIELD_PTR;
|
||||||
|
{register} inptr : JSAMPROW;
|
||||||
|
{register} outptr : JSAMPROW;
|
||||||
|
{register} col : JDIMENSION;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr (cinfo^.cconvert);
|
||||||
|
ctab := cconvert^.rgb_ycc_tab;
|
||||||
|
num_cols := cinfo^.image_width;
|
||||||
|
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
Dec(num_rows);
|
||||||
|
inptr := input_buf^[0];
|
||||||
|
Inc(JSAMPROW_PTR(input_buf));
|
||||||
|
outptr := output_buf^[0]^[output_row];
|
||||||
|
Inc(output_row);
|
||||||
|
for col := 0 to pred(num_cols) do
|
||||||
|
begin
|
||||||
|
r := GETJSAMPLE(inptr^[RGB_RED]);
|
||||||
|
g := GETJSAMPLE(inptr^[RGB_GREEN]);
|
||||||
|
b := GETJSAMPLE(inptr^[RGB_BLUE]);
|
||||||
|
Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE);
|
||||||
|
(* Y *)
|
||||||
|
// kylix 3 compiler crashes on this
|
||||||
|
{$IF (not Defined(LINUX)) or Defined(FPC)}
|
||||||
|
outptr^[col] := JSAMPLE (
|
||||||
|
((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF])
|
||||||
|
shr SCALEBITS) );
|
||||||
|
{$IFEND}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Convert some rows of samples to the JPEG colorspace.
|
||||||
|
This version handles Adobe-style CMYK -> YCCK conversion,
|
||||||
|
where we convert R=1-C, G=1-M, and B=1-Y to YCbCr using the same
|
||||||
|
conversion as above, while passing K (black) unchanged.
|
||||||
|
We assume rgb_ycc_start has been called. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure cmyk_ycck_convert (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
output_buf : JSAMPIMAGE;
|
||||||
|
output_row : JDIMENSION;
|
||||||
|
num_rows : int);
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
{register} r, g, b : int;
|
||||||
|
{register} ctab : INT32_FIELD_PTR;
|
||||||
|
{register} inptr : JSAMPROW;
|
||||||
|
{register} outptr0, outptr1, outptr2, outptr3 : JSAMPROW;
|
||||||
|
{register} col : JDIMENSION;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr (cinfo^.cconvert);
|
||||||
|
ctab := cconvert^.rgb_ycc_tab;
|
||||||
|
num_cols := cinfo^.image_width;
|
||||||
|
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
Dec(num_rows);
|
||||||
|
inptr := input_buf^[0];
|
||||||
|
Inc(JSAMPROW_PTR(input_buf));
|
||||||
|
outptr0 := output_buf^[0]^[output_row];
|
||||||
|
outptr1 := output_buf^[1]^[output_row];
|
||||||
|
outptr2 := output_buf^[2]^[output_row];
|
||||||
|
outptr3 := output_buf^[3]^[output_row];
|
||||||
|
Inc(output_row);
|
||||||
|
for col := 0 to pred(num_cols) do
|
||||||
|
begin
|
||||||
|
r := MAXJSAMPLE - GETJSAMPLE(inptr^[0]);
|
||||||
|
g := MAXJSAMPLE - GETJSAMPLE(inptr^[1]);
|
||||||
|
b := MAXJSAMPLE - GETJSAMPLE(inptr^[2]);
|
||||||
|
{ K passes through as-is }
|
||||||
|
outptr3^[col] := inptr^[3]; { don't need GETJSAMPLE here }
|
||||||
|
Inc(JSAMPLE_PTR(inptr), 4);
|
||||||
|
{ If the inputs are 0..MAXJSAMPLE, the outputs of these equations
|
||||||
|
must be too; we do not need an explicit range-limiting operation.
|
||||||
|
Hence the value being shifted is never negative, and we don't
|
||||||
|
need the general RIGHT_SHIFT macro. }
|
||||||
|
|
||||||
|
{ Y }
|
||||||
|
outptr0^[col] := JSAMPLE (
|
||||||
|
((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF])
|
||||||
|
shr SCALEBITS) );
|
||||||
|
{ Cb }
|
||||||
|
outptr1^[col] := JSAMPLE(
|
||||||
|
((ctab^[r+R_CB_OFF] + ctab^[g+G_CB_OFF] + ctab^[b+B_CB_OFF])
|
||||||
|
shr SCALEBITS) );
|
||||||
|
{ Cr }
|
||||||
|
outptr2^[col] := JSAMPLE (
|
||||||
|
((ctab^[r+R_CR_OFF] + ctab^[g+G_CR_OFF] + ctab^[b+B_CR_OFF])
|
||||||
|
shr SCALEBITS) );
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Convert some rows of samples to the JPEG colorspace.
|
||||||
|
This version handles grayscale output with no conversion.
|
||||||
|
The source can be either plain grayscale or YCbCr (since Y = gray). }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure grayscale_convert (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
output_buf : JSAMPIMAGE;
|
||||||
|
output_row : JDIMENSION;
|
||||||
|
num_rows: int);
|
||||||
|
var
|
||||||
|
{register} inptr : JSAMPROW;
|
||||||
|
{register} outptr : JSAMPROW;
|
||||||
|
{register} col : JDIMENSION;
|
||||||
|
num_cols :JDIMENSION;
|
||||||
|
instride : int;
|
||||||
|
begin
|
||||||
|
num_cols := cinfo^.image_width;
|
||||||
|
instride := cinfo^.input_components;
|
||||||
|
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
Dec(num_rows);
|
||||||
|
inptr := input_buf^[0];
|
||||||
|
Inc(JSAMPROW_PTR(input_buf));
|
||||||
|
outptr := output_buf^[0]^[output_row];
|
||||||
|
Inc(output_row);
|
||||||
|
for col := 0 to pred(num_cols) do
|
||||||
|
begin
|
||||||
|
outptr^[col] := inptr^[0]; { don't need GETJSAMPLE() here }
|
||||||
|
Inc(JSAMPLE_PTR(inptr), instride);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Convert some rows of samples to the JPEG colorspace.
|
||||||
|
This version handles multi-component colorspaces without conversion.
|
||||||
|
We assume input_components = num_components. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure null_convert (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
output_buf : JSAMPIMAGE;
|
||||||
|
output_row : JDIMENSION;
|
||||||
|
num_rows : int);
|
||||||
|
var
|
||||||
|
{register} inptr : JSAMPROW;
|
||||||
|
{register} outptr : JSAMPROW;
|
||||||
|
{register} col : JDIMENSION;
|
||||||
|
{register} ci : int;
|
||||||
|
nc : int;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
begin
|
||||||
|
nc := cinfo^.num_components;
|
||||||
|
num_cols := cinfo^.image_width;
|
||||||
|
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
Dec(num_rows);
|
||||||
|
{ It seems fastest to make a separate pass for each component. }
|
||||||
|
for ci := 0 to pred(nc) do
|
||||||
|
begin
|
||||||
|
inptr := input_buf^[0];
|
||||||
|
outptr := output_buf^[ci]^[output_row];
|
||||||
|
for col := 0 to pred(num_cols) do
|
||||||
|
begin
|
||||||
|
outptr^[col] := inptr^[ci]; { don't need GETJSAMPLE() here }
|
||||||
|
Inc(JSAMPLE_PTR(inptr), nc);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(JSAMPROW_PTR(input_buf));
|
||||||
|
Inc(output_row);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Empty method for start_pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure null_method (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
{ no work needed }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Module initialization routine for input colorspace conversion. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_color_converter (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_color_converter)) );
|
||||||
|
cinfo^.cconvert := jpeg_color_converter_ptr(cconvert);
|
||||||
|
{ set start_pass to null method until we find out differently }
|
||||||
|
cconvert^.pub.start_pass := null_method;
|
||||||
|
|
||||||
|
{ Make sure input_components agrees with in_color_space }
|
||||||
|
case (cinfo^.in_color_space) of
|
||||||
|
JCS_GRAYSCALE:
|
||||||
|
if (cinfo^.input_components <> 1) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE);
|
||||||
|
|
||||||
|
{$ifdef RGB_PIXELSIZE <> 3}
|
||||||
|
JCS_RGB:
|
||||||
|
if (cinfo^.input_components <> RGB_PIXELSIZE) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE);
|
||||||
|
{$else} { share code with YCbCr }
|
||||||
|
JCS_RGB,
|
||||||
|
{$endif}
|
||||||
|
JCS_YCbCr:
|
||||||
|
if (cinfo^.input_components <> 3) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE);
|
||||||
|
|
||||||
|
JCS_CMYK,
|
||||||
|
JCS_YCCK:
|
||||||
|
if (cinfo^.input_components <> 4) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE);
|
||||||
|
|
||||||
|
else { JCS_UNKNOWN can be anything }
|
||||||
|
if (cinfo^.input_components < 1) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Check num_components, set conversion method based on requested space }
|
||||||
|
case (cinfo^.jpeg_color_space) of
|
||||||
|
JCS_GRAYSCALE:
|
||||||
|
begin
|
||||||
|
if (cinfo^.num_components <> 1) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
if (cinfo^.in_color_space = JCS_GRAYSCALE) then
|
||||||
|
cconvert^.pub.color_convert := grayscale_convert
|
||||||
|
else
|
||||||
|
if (cinfo^.in_color_space = JCS_RGB) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.start_pass := rgb_ycc_start;
|
||||||
|
cconvert^.pub.color_convert := rgb_gray_convert;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.in_color_space = JCS_YCbCr) then
|
||||||
|
cconvert^.pub.color_convert := grayscale_convert
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
JCS_RGB:
|
||||||
|
begin
|
||||||
|
if (cinfo^.num_components <> 3) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
if (cinfo^.in_color_space = JCS_RGB) and (RGB_PIXELSIZE = 3) then
|
||||||
|
cconvert^.pub.color_convert := null_convert
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
JCS_YCbCr:
|
||||||
|
begin
|
||||||
|
if (cinfo^.num_components <> 3) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
if (cinfo^.in_color_space = JCS_RGB) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.start_pass := rgb_ycc_start;
|
||||||
|
cconvert^.pub.color_convert := rgb_ycc_convert;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.in_color_space = JCS_YCbCr) then
|
||||||
|
cconvert^.pub.color_convert := null_convert
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
JCS_CMYK:
|
||||||
|
begin
|
||||||
|
if (cinfo^.num_components <> 4) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
if (cinfo^.in_color_space = JCS_CMYK) then
|
||||||
|
cconvert^.pub.color_convert := null_convert
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
JCS_YCCK:
|
||||||
|
begin
|
||||||
|
if (cinfo^.num_components <> 4) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
if (cinfo^.in_color_space = JCS_CMYK) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.start_pass := rgb_ycc_start;
|
||||||
|
cconvert^.pub.color_convert := cmyk_ycck_convert;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.in_color_space = JCS_YCCK) then
|
||||||
|
cconvert^.pub.color_convert := null_convert
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
else { allow null conversion of JCS_UNKNOWN }
|
||||||
|
begin
|
||||||
|
if (cinfo^.jpeg_color_space <> cinfo^.in_color_space) or
|
||||||
|
(cinfo^.num_components <> cinfo^.input_components) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
cconvert^.pub.color_convert := null_convert;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,514 @@
|
||||||
|
unit imjcdctmgr;
|
||||||
|
|
||||||
|
{ Original : jcdctmgr.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
{ This file is part of the Independent JPEG Group's software.
|
||||||
|
For conditions of distribution and use, see the accompanying README file.
|
||||||
|
|
||||||
|
This file contains the forward-DCT management logic.
|
||||||
|
This code selects a particular DCT implementation to be used,
|
||||||
|
and it performs related housekeeping chores including coefficient
|
||||||
|
quantization. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$N+}
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib,
|
||||||
|
imjdct, { Private declarations for DCT subsystem }
|
||||||
|
imjfdctint, imjfdctfst, imjfdctflt;
|
||||||
|
|
||||||
|
{ Initialize FDCT manager. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_forward_dct (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{ Private subobject for this module }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_fdct_ptr = ^my_fdct_controller;
|
||||||
|
my_fdct_controller = record
|
||||||
|
pub : jpeg_forward_dct; { public fields }
|
||||||
|
|
||||||
|
{ Pointer to the DCT routine actually in use }
|
||||||
|
do_dct : forward_DCT_method_ptr;
|
||||||
|
|
||||||
|
{ The actual post-DCT divisors --- not identical to the quant table
|
||||||
|
entries, because of scaling (especially for an unnormalized DCT).
|
||||||
|
Each table is given in normal array order. }
|
||||||
|
|
||||||
|
divisors : array[0..NUM_QUANT_TBLS-1] of DCTELEM_FIELD_PTR;
|
||||||
|
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
{ Same as above for the floating-point case. }
|
||||||
|
do_float_dct : float_DCT_method_ptr;
|
||||||
|
float_divisors : array[0..NUM_QUANT_TBLS-1] of FAST_FLOAT_FIELD_PTR;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for a processing pass.
|
||||||
|
Verify that all referenced Q-tables are present, and set up
|
||||||
|
the divisor table for each one.
|
||||||
|
In the current implementation, DCT of all components is done during
|
||||||
|
the first pass, even if only some components will be output in the
|
||||||
|
first scan. Hence all components should be examined here. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass_fdctmgr (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
fdct : my_fdct_ptr;
|
||||||
|
ci, qtblno, i : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
qtbl : JQUANT_TBL_PTR;
|
||||||
|
dtbl : DCTELEM_FIELD_PTR;
|
||||||
|
{$ifdef DCT_IFAST_SUPPORTED}
|
||||||
|
const
|
||||||
|
CONST_BITS = 14;
|
||||||
|
aanscales : array[0..DCTSIZE2-1] of INT16 =
|
||||||
|
({ precomputed values scaled up by 14 bits }
|
||||||
|
16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520,
|
||||||
|
22725, 31521, 29692, 26722, 22725, 17855, 12299, 6270,
|
||||||
|
21407, 29692, 27969, 25172, 21407, 16819, 11585, 5906,
|
||||||
|
19266, 26722, 25172, 22654, 19266, 15137, 10426, 5315,
|
||||||
|
16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520,
|
||||||
|
12873, 17855, 16819, 15137, 12873, 10114, 6967, 3552,
|
||||||
|
8867, 12299, 11585, 10426, 8867, 6967, 4799, 2446,
|
||||||
|
4520, 6270, 5906, 5315, 4520, 3552, 2446, 1247);
|
||||||
|
{SHIFT_TEMPS}
|
||||||
|
|
||||||
|
{ Descale and correctly round an INT32 value that's scaled by N bits.
|
||||||
|
We assume RIGHT_SHIFT rounds towards minus infinity, so adding
|
||||||
|
the fudge factor is correct for either sign of X. }
|
||||||
|
|
||||||
|
function DESCALE(x : INT32; n : int) : INT32;
|
||||||
|
var
|
||||||
|
shift_temp : INT32;
|
||||||
|
begin
|
||||||
|
shift_temp := x + (INT32(1) shl (n-1));
|
||||||
|
{$ifdef RIGHT_SHIFT_IS_UNSIGNED}
|
||||||
|
if shift_temp < 0 then
|
||||||
|
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
|
||||||
|
else
|
||||||
|
{$endif}
|
||||||
|
Descale := (shift_temp shr n);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
var
|
||||||
|
fdtbl : FAST_FLOAT_FIELD_PTR;
|
||||||
|
row, col : int;
|
||||||
|
const
|
||||||
|
aanscalefactor : array[0..DCTSIZE-1] of double =
|
||||||
|
(1.0, 1.387039845, 1.306562965, 1.175875602,
|
||||||
|
1.0, 0.785694958, 0.541196100, 0.275899379);
|
||||||
|
{$endif}
|
||||||
|
begin
|
||||||
|
fdct := my_fdct_ptr (cinfo^.fdct);
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
qtblno := compptr^.quant_tbl_no;
|
||||||
|
{ Make sure specified quantization table is present }
|
||||||
|
if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or
|
||||||
|
(cinfo^.quant_tbl_ptrs[qtblno] = NIL) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno);
|
||||||
|
qtbl := cinfo^.quant_tbl_ptrs[qtblno];
|
||||||
|
{ Compute divisors for this quant table }
|
||||||
|
{ We may do this more than once for same table, but it's not a big deal }
|
||||||
|
case (cinfo^.dct_method) of
|
||||||
|
{$ifdef DCT_ISLOW_SUPPORTED}
|
||||||
|
JDCT_ISLOW:
|
||||||
|
begin
|
||||||
|
{ For LL&M IDCT method, divisors are equal to raw quantization
|
||||||
|
coefficients multiplied by 8 (to counteract scaling). }
|
||||||
|
|
||||||
|
if (fdct^.divisors[qtblno] = NIL) then
|
||||||
|
begin
|
||||||
|
fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
DCTSIZE2 * SIZEOF(DCTELEM)) );
|
||||||
|
end;
|
||||||
|
dtbl := fdct^.divisors[qtblno];
|
||||||
|
for i := 0 to pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
dtbl^[i] := (DCTELEM(qtbl^.quantval[i])) shl 3;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_IFAST_SUPPORTED}
|
||||||
|
JDCT_IFAST:
|
||||||
|
begin
|
||||||
|
{ For AA&N IDCT method, divisors are equal to quantization
|
||||||
|
coefficients scaled by scalefactor[row]*scalefactor[col], where
|
||||||
|
scalefactor[0] := 1
|
||||||
|
scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7
|
||||||
|
We apply a further scale factor of 8. }
|
||||||
|
|
||||||
|
|
||||||
|
if (fdct^.divisors[qtblno] = NIL) then
|
||||||
|
begin
|
||||||
|
fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
DCTSIZE2 * SIZEOF(DCTELEM)) );
|
||||||
|
end;
|
||||||
|
dtbl := fdct^.divisors[qtblno];
|
||||||
|
for i := 0 to pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
dtbl^[i] := DCTELEM(
|
||||||
|
{MULTIPLY16V16}
|
||||||
|
DESCALE( INT32(qtbl^.quantval[i]) * INT32 (aanscales[i]),
|
||||||
|
CONST_BITS-3) );
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
|
||||||
|
JDCT_FLOAT:
|
||||||
|
begin
|
||||||
|
{ For float AA&N IDCT method, divisors are equal to quantization
|
||||||
|
coefficients scaled by scalefactor[row]*scalefactor[col], where
|
||||||
|
scalefactor[0] := 1
|
||||||
|
scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7
|
||||||
|
We apply a further scale factor of 8.
|
||||||
|
What's actually stored is 1/divisor so that the inner loop can
|
||||||
|
use a multiplication rather than a division. }
|
||||||
|
|
||||||
|
if (fdct^.float_divisors[qtblno] = NIL) then
|
||||||
|
begin
|
||||||
|
fdct^.float_divisors[qtblno] := FAST_FLOAT_FIELD_PTR(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
DCTSIZE2 * SIZEOF(FAST_FLOAT)) );
|
||||||
|
end;
|
||||||
|
fdtbl := fdct^.float_divisors[qtblno];
|
||||||
|
i := 0;
|
||||||
|
for row := 0 to pred(DCTSIZE) do
|
||||||
|
begin
|
||||||
|
for col := 0 to pred(DCTSIZE) do
|
||||||
|
begin
|
||||||
|
fdtbl^[i] := {FAST_FLOAT}
|
||||||
|
(1.0 / (( {double}(qtbl^.quantval[i]) *
|
||||||
|
aanscalefactor[row] * aanscalefactor[col] * 8.0)));
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
end;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Perform forward DCT on one or more blocks of a component.
|
||||||
|
|
||||||
|
The input samples are taken from the sample_data[] array starting at
|
||||||
|
position start_row/start_col, and moving to the right for any additional
|
||||||
|
blocks. The quantized coefficients are returned in coef_blocks[]. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure forward_DCT (cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
sample_data : JSAMPARRAY;
|
||||||
|
coef_blocks : JBLOCKROW;
|
||||||
|
start_row : JDIMENSION;
|
||||||
|
start_col : JDIMENSION;
|
||||||
|
num_blocks : JDIMENSION);
|
||||||
|
{ This version is used for integer DCT implementations. }
|
||||||
|
var
|
||||||
|
{ This routine is heavily used, so it's worth coding it tightly. }
|
||||||
|
fdct : my_fdct_ptr;
|
||||||
|
do_dct : forward_DCT_method_ptr;
|
||||||
|
divisors : DCTELEM_FIELD_PTR;
|
||||||
|
workspace : array[0..DCTSIZE2-1] of DCTELEM; { work area for FDCT subroutine }
|
||||||
|
bi : JDIMENSION;
|
||||||
|
var
|
||||||
|
{register} workspaceptr : DCTELEMPTR;
|
||||||
|
{register} elemptr : JSAMPLE_PTR;
|
||||||
|
{register} elemr : int;
|
||||||
|
{$ifndef DCTSIZE_IS_8}
|
||||||
|
var
|
||||||
|
{register} elemc : int;
|
||||||
|
{$endif}
|
||||||
|
var
|
||||||
|
{register} temp, qval : DCTELEM;
|
||||||
|
{register} i : int;
|
||||||
|
{register} output_ptr : JCOEFPTR;
|
||||||
|
begin
|
||||||
|
fdct := my_fdct_ptr (cinfo^.fdct);
|
||||||
|
do_dct := fdct^.do_dct;
|
||||||
|
divisors := fdct^.divisors[compptr^.quant_tbl_no];
|
||||||
|
|
||||||
|
Inc(JSAMPROW_PTR(sample_data), start_row); { fold in the vertical offset once }
|
||||||
|
|
||||||
|
for bi := 0 to pred(num_blocks) do
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ Load data into workspace, applying unsigned->signed conversion }
|
||||||
|
|
||||||
|
workspaceptr := @workspace[0];
|
||||||
|
for elemr := 0 to pred(DCTSIZE) do
|
||||||
|
begin
|
||||||
|
elemptr := @sample_data^[elemr]^[start_col];
|
||||||
|
{$ifdef DCTSIZE_IS_8} { unroll the inner loop }
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
{Inc(elemptr); - Value never used }
|
||||||
|
{$else}
|
||||||
|
for elemc := pred(DCTSIZE) downto 0 do
|
||||||
|
begin
|
||||||
|
workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Perform the DCT }
|
||||||
|
do_dct (workspace);
|
||||||
|
|
||||||
|
{ Quantize/descale the coefficients, and store into coef_blocks[] }
|
||||||
|
|
||||||
|
output_ptr := JCOEFPTR(@coef_blocks^[bi]);
|
||||||
|
for i := 0 to pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
qval := divisors^[i];
|
||||||
|
temp := workspace[i];
|
||||||
|
{ Divide the coefficient value by qval, ensuring proper rounding.
|
||||||
|
Since C does not specify the direction of rounding for negative
|
||||||
|
quotients, we have to force the dividend positive for portability.
|
||||||
|
|
||||||
|
In most files, at least half of the output values will be zero
|
||||||
|
(at default quantization settings, more like three-quarters...)
|
||||||
|
so we should ensure that this case is fast. On many machines,
|
||||||
|
a comparison is enough cheaper than a divide to make a special test
|
||||||
|
a win. Since both inputs will be nonnegative, we need only test
|
||||||
|
for a < b to discover whether a/b is 0.
|
||||||
|
If your machine's division is fast enough, define FAST_DIVIDE. }
|
||||||
|
|
||||||
|
if (temp < 0) then
|
||||||
|
begin
|
||||||
|
temp := -temp;
|
||||||
|
Inc(temp, qval shr 1); { for rounding }
|
||||||
|
{DIVIDE_BY(temp, qval);}
|
||||||
|
{$ifdef FAST_DIVIDE}
|
||||||
|
temp := temp div qval;
|
||||||
|
{$else}
|
||||||
|
if (temp >= qval) then
|
||||||
|
temp := temp div qval
|
||||||
|
else
|
||||||
|
temp := 0;
|
||||||
|
{$endif}
|
||||||
|
temp := -temp;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Inc(temp, qval shr 1); { for rounding }
|
||||||
|
{DIVIDE_BY(temp, qval);}
|
||||||
|
{$ifdef FAST_DIVIDE}
|
||||||
|
temp := temp div qval;
|
||||||
|
{$else}
|
||||||
|
if (temp >= qval) then
|
||||||
|
temp := temp div qval
|
||||||
|
else
|
||||||
|
temp := 0;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
output_ptr^[i] := JCOEF (temp);
|
||||||
|
end;
|
||||||
|
Inc(start_col, DCTSIZE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure forward_DCT_float (cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
sample_data : JSAMPARRAY;
|
||||||
|
coef_blocks : JBLOCKROW;
|
||||||
|
start_row : JDIMENSION;
|
||||||
|
start_col : JDIMENSION;
|
||||||
|
num_blocks : JDIMENSION);
|
||||||
|
{ This version is used for floating-point DCT implementations. }
|
||||||
|
var
|
||||||
|
{ This routine is heavily used, so it's worth coding it tightly. }
|
||||||
|
fdct : my_fdct_ptr;
|
||||||
|
do_dct : float_DCT_method_ptr;
|
||||||
|
divisors : FAST_FLOAT_FIELD_PTR;
|
||||||
|
workspace : array[0..DCTSIZE2-1] of FAST_FLOAT; { work area for FDCT subroutine }
|
||||||
|
bi : JDIMENSION;
|
||||||
|
var
|
||||||
|
{register} workspaceptr : FAST_FLOAT_PTR;
|
||||||
|
{register} elemptr : JSAMPLE_PTR;
|
||||||
|
{register} elemr : int;
|
||||||
|
{$ifndef DCTSIZE_IS_8}
|
||||||
|
var
|
||||||
|
{register} elemc : int;
|
||||||
|
{$endif}
|
||||||
|
var
|
||||||
|
{register} temp : FAST_FLOAT;
|
||||||
|
{register} i : int;
|
||||||
|
{register} output_ptr : JCOEFPTR;
|
||||||
|
begin
|
||||||
|
fdct := my_fdct_ptr (cinfo^.fdct);
|
||||||
|
do_dct := fdct^.do_float_dct;
|
||||||
|
divisors := fdct^.float_divisors[compptr^.quant_tbl_no];
|
||||||
|
|
||||||
|
Inc(JSAMPROW_PTR(sample_data), start_row); { fold in the vertical offset once }
|
||||||
|
|
||||||
|
for bi := 0 to pred(num_blocks) do
|
||||||
|
begin
|
||||||
|
{ Load data into workspace, applying unsigned->signed conversion }
|
||||||
|
|
||||||
|
workspaceptr := @workspace[0];
|
||||||
|
for elemr := 0 to pred(DCTSIZE) do
|
||||||
|
begin
|
||||||
|
elemptr := @(sample_data^[elemr]^[start_col]);
|
||||||
|
{$ifdef DCTSIZE_IS_8} { unroll the inner loop }
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
|
||||||
|
Inc(workspaceptr);
|
||||||
|
{Inc(elemptr); - value never used }
|
||||||
|
{$else}
|
||||||
|
for elemc := pred(DCTSIZE) downto 0 do
|
||||||
|
begin
|
||||||
|
workspaceptr^ := {FAST_FLOAT}(
|
||||||
|
(GETJSAMPLE(elemptr^) - CENTERJSAMPLE) );
|
||||||
|
Inc(workspaceptr);
|
||||||
|
Inc(elemptr);
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Perform the DCT }
|
||||||
|
do_dct (workspace);
|
||||||
|
|
||||||
|
{ Quantize/descale the coefficients, and store into coef_blocks[] }
|
||||||
|
|
||||||
|
output_ptr := JCOEFPTR(@(coef_blocks^[bi]));
|
||||||
|
|
||||||
|
for i := 0 to pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
{ Apply the quantization and scaling factor }
|
||||||
|
temp := workspace[i] * divisors^[i];
|
||||||
|
{ Round to nearest integer.
|
||||||
|
Since C does not specify the direction of rounding for negative
|
||||||
|
quotients, we have to force the dividend positive for portability.
|
||||||
|
The maximum coefficient size is +-16K (for 12-bit data), so this
|
||||||
|
code should work for either 16-bit or 32-bit ints. }
|
||||||
|
output_ptr^[i] := JCOEF ( int(Trunc (temp + {FAST_FLOAT}(16384.5))) - 16384);
|
||||||
|
end;
|
||||||
|
Inc(start_col, DCTSIZE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { DCT_FLOAT_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize FDCT manager. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_forward_dct (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
fdct : my_fdct_ptr;
|
||||||
|
i : int;
|
||||||
|
begin
|
||||||
|
fdct := my_fdct_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_fdct_controller)) );
|
||||||
|
cinfo^.fdct := jpeg_forward_dct_ptr (fdct);
|
||||||
|
fdct^.pub.start_pass := start_pass_fdctmgr;
|
||||||
|
|
||||||
|
case (cinfo^.dct_method) of
|
||||||
|
{$ifdef DCT_ISLOW_SUPPORTED}
|
||||||
|
JDCT_ISLOW:
|
||||||
|
begin
|
||||||
|
fdct^.pub.forward_DCT := forward_DCT;
|
||||||
|
fdct^.do_dct := jpeg_fdct_islow;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_IFAST_SUPPORTED}
|
||||||
|
JDCT_IFAST:
|
||||||
|
begin
|
||||||
|
fdct^.pub.forward_DCT := forward_DCT;
|
||||||
|
fdct^.do_dct := jpeg_fdct_ifast;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
JDCT_FLOAT:
|
||||||
|
begin
|
||||||
|
fdct^.pub.forward_DCT := forward_DCT_float;
|
||||||
|
fdct^.do_float_dct := jpeg_fdct_float;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Mark divisor tables unallocated }
|
||||||
|
for i := 0 to pred(NUM_QUANT_TBLS) do
|
||||||
|
begin
|
||||||
|
fdct^.divisors[i] := NIL;
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
fdct^.float_divisors[i] := NIL;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,95 @@
|
||||||
|
unit imjcinit;
|
||||||
|
|
||||||
|
{ Original: jcinit.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
|
||||||
|
|
||||||
|
{ This file contains initialization logic for the JPEG compressor.
|
||||||
|
This routine is in charge of selecting the modules to be executed and
|
||||||
|
making an initialization call to each one.
|
||||||
|
|
||||||
|
Logically, this code belongs in jcmaster.c. It's split out because
|
||||||
|
linking this routine implies linking the entire compression library.
|
||||||
|
For a transcoding-only application, we want to be able to use jcmaster.c
|
||||||
|
without linking in the whole library. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib,
|
||||||
|
{$ifdef C_PROGRESSIVE_SUPPORTED}
|
||||||
|
imjcphuff,
|
||||||
|
{$endif}
|
||||||
|
imjchuff, imjcmaster, imjccolor, imjcsample, imjcprepct,
|
||||||
|
imjcdctmgr, imjccoefct, imjcmainct, imjcmarker;
|
||||||
|
|
||||||
|
{ Master selection of compression modules.
|
||||||
|
This is done once at the start of processing an image. We determine
|
||||||
|
which modules will be used and give them appropriate initialization calls. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_compress_master (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ Master selection of compression modules.
|
||||||
|
This is done once at the start of processing an image. We determine
|
||||||
|
which modules will be used and give them appropriate initialization calls. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_compress_master (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
{ Initialize master control (includes parameter checking/processing) }
|
||||||
|
jinit_c_master_control(cinfo, FALSE { full compression });
|
||||||
|
|
||||||
|
{ Preprocessing }
|
||||||
|
if (not cinfo^.raw_data_in) then
|
||||||
|
begin
|
||||||
|
jinit_color_converter(cinfo);
|
||||||
|
jinit_downsampler(cinfo);
|
||||||
|
jinit_c_prep_controller(cinfo, FALSE { never need full buffer here });
|
||||||
|
end;
|
||||||
|
{ Forward DCT }
|
||||||
|
jinit_forward_dct(cinfo);
|
||||||
|
{ Entropy encoding: either Huffman or arithmetic coding. }
|
||||||
|
if (cinfo^.arith_code) then
|
||||||
|
begin
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_ARITH_NOTIMPL);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
begin
|
||||||
|
{$ifdef C_PROGRESSIVE_SUPPORTED}
|
||||||
|
jinit_phuff_encoder(cinfo);
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
jinit_huff_encoder(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Need a full-image coefficient buffer in any multi-pass mode. }
|
||||||
|
jinit_c_coef_controller(cinfo,
|
||||||
|
(cinfo^.num_scans > 1) or (cinfo^.optimize_coding));
|
||||||
|
jinit_c_main_controller(cinfo, FALSE { never need full buffer here });
|
||||||
|
|
||||||
|
jinit_marker_writer(cinfo);
|
||||||
|
|
||||||
|
{ We can now tell the memory manager to allocate virtual arrays. }
|
||||||
|
cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo));
|
||||||
|
|
||||||
|
{ Write the datastream header (SOI) immediately.
|
||||||
|
Frame and scan headers are postponed till later.
|
||||||
|
This lets application insert special markers after the SOI. }
|
||||||
|
|
||||||
|
cinfo^.marker^.write_file_header (cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,343 @@
|
||||||
|
unit imjcmainct;
|
||||||
|
|
||||||
|
{ This file contains the main buffer controller for compression.
|
||||||
|
The main buffer lies between the pre-processor and the JPEG
|
||||||
|
compressor proper; it holds downsampled data in the JPEG colorspace. }
|
||||||
|
|
||||||
|
{ Original : jcmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
{ Note: currently, there is no operating mode in which a full-image buffer
|
||||||
|
is needed at this step. If there were, that mode could not be used with
|
||||||
|
"raw data" input, since this module is bypassed in that case. However,
|
||||||
|
we've left the code here for possible use in special applications. }
|
||||||
|
|
||||||
|
{$undef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
imjutils,
|
||||||
|
{$endif}
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
{ Initialize main buffer controller. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_c_main_controller (cinfo : j_compress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{ Private buffer controller object }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_main_ptr = ^my_main_controller;
|
||||||
|
my_main_controller = record
|
||||||
|
pub : jpeg_c_main_controller; { public fields }
|
||||||
|
|
||||||
|
cur_iMCU_row : JDIMENSION; { number of current iMCU row }
|
||||||
|
rowgroup_ctr : JDIMENSION; { counts row groups received in iMCU row }
|
||||||
|
suspended : boolean; { remember if we suspended output }
|
||||||
|
pass_mode : J_BUF_MODE; { current operating mode }
|
||||||
|
|
||||||
|
{ If using just a strip buffer, this points to the entire set of buffers
|
||||||
|
(we allocate one for each component). In the full-image case, this
|
||||||
|
points to the currently accessible strips of the virtual arrays. }
|
||||||
|
|
||||||
|
buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
|
||||||
|
|
||||||
|
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
{ If using full-image storage, this array holds pointers to virtual-array
|
||||||
|
control blocks for each component. Unused if not full-image storage. }
|
||||||
|
|
||||||
|
whole_image : array[0..MAX_COMPONENTS-1] of jvirt_sarray_ptr;
|
||||||
|
{$endif}
|
||||||
|
end; {my_main_controller}
|
||||||
|
|
||||||
|
|
||||||
|
{ Forward declarations }
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_simple_main(cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
var in_row_ctr: JDIMENSION;
|
||||||
|
in_rows_avail : JDIMENSION); forward;
|
||||||
|
|
||||||
|
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_buffer_main(cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
var in_row_ctr : JDIMENSION;
|
||||||
|
in_rows_avail : JDIMENSION); forward;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for a processing pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass_main (cinfo : j_compress_ptr;
|
||||||
|
pass_mode : J_BUF_MODE);
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
|
||||||
|
{ Do nothing in raw-data mode. }
|
||||||
|
if (cinfo^.raw_data_in) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
main^.cur_iMCU_row := 0; { initialize counters }
|
||||||
|
main^.rowgroup_ctr := 0;
|
||||||
|
main^.suspended := FALSE;
|
||||||
|
main^.pass_mode := pass_mode; { save mode for use by process_data }
|
||||||
|
|
||||||
|
case (pass_mode) of
|
||||||
|
JBUF_PASS_THRU:
|
||||||
|
begin
|
||||||
|
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
if (main^.whole_image[0] <> NIL) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
{$endif}
|
||||||
|
main^.pub.process_data := process_data_simple_main;
|
||||||
|
end;
|
||||||
|
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
JBUF_SAVE_SOURCE,
|
||||||
|
JBUF_CRANK_DEST,
|
||||||
|
JBUF_SAVE_AND_PASS:
|
||||||
|
begin
|
||||||
|
if (main^.whole_image[0] = NIL) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
main^.pub.process_data := process_data_buffer_main;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Process some data.
|
||||||
|
This routine handles the simple pass-through mode,
|
||||||
|
where we have only a strip buffer. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_simple_main (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
var in_row_ctr : JDIMENSION;
|
||||||
|
in_rows_avail : JDIMENSION);
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
|
||||||
|
while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do
|
||||||
|
begin
|
||||||
|
{ Read input data if we haven't filled the main buffer yet }
|
||||||
|
if (main^.rowgroup_ctr < DCTSIZE) then
|
||||||
|
cinfo^.prep^.pre_process_data (cinfo,
|
||||||
|
input_buf,
|
||||||
|
in_row_ctr,
|
||||||
|
in_rows_avail,
|
||||||
|
JSAMPIMAGE(@main^.buffer),
|
||||||
|
main^.rowgroup_ctr,
|
||||||
|
JDIMENSION(DCTSIZE));
|
||||||
|
|
||||||
|
{ If we don't have a full iMCU row buffered, return to application for
|
||||||
|
more data. Note that preprocessor will always pad to fill the iMCU row
|
||||||
|
at the bottom of the image. }
|
||||||
|
if (main^.rowgroup_ctr <> DCTSIZE) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
{ Send the completed row to the compressor }
|
||||||
|
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(@main^.buffer))) then
|
||||||
|
begin
|
||||||
|
{ If compressor did not consume the whole row, then we must need to
|
||||||
|
suspend processing and return to the application. In this situation
|
||||||
|
we pretend we didn't yet consume the last input row; otherwise, if
|
||||||
|
it happened to be the last row of the image, the application would
|
||||||
|
think we were done. }
|
||||||
|
|
||||||
|
if (not main^.suspended) then
|
||||||
|
begin
|
||||||
|
Dec(in_row_ctr);
|
||||||
|
main^.suspended := TRUE;
|
||||||
|
end;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ We did finish the row. Undo our little suspension hack if a previous
|
||||||
|
call suspended; then mark the main buffer empty. }
|
||||||
|
|
||||||
|
if (main^.suspended) then
|
||||||
|
begin
|
||||||
|
Inc(in_row_ctr);
|
||||||
|
main^.suspended := FALSE;
|
||||||
|
end;
|
||||||
|
main^.rowgroup_ctr := 0;
|
||||||
|
Inc(main^.cur_iMCU_row);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
|
||||||
|
{ Process some data.
|
||||||
|
This routine handles all of the modes that use a full-size buffer. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_buffer_main (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
var in_row_ctr : JDIMENSION;
|
||||||
|
in_rows_avail : JDIMENSION);
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
writing : boolean;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
writing := (main^.pass_mode <> JBUF_CRANK_DEST);
|
||||||
|
|
||||||
|
while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do
|
||||||
|
begin
|
||||||
|
{ Realign the virtual buffers if at the start of an iMCU row. }
|
||||||
|
if (main^.rowgroup_ctr = 0) then
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.comp_info;
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
main^.buffer[ci] := cinfo^.mem^.access_virt_sarray
|
||||||
|
(j_common_ptr (cinfo), main^.whole_image[ci],
|
||||||
|
main^.cur_iMCU_row * (compptr^.v_samp_factor * DCTSIZE),
|
||||||
|
JDIMENSION (compptr^.v_samp_factor * DCTSIZE), writing);
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
{ In a read pass, pretend we just read some source data. }
|
||||||
|
if (not writing) then
|
||||||
|
begin
|
||||||
|
Inc(in_row_ctr, cinfo^.max_v_samp_factor * DCTSIZE);
|
||||||
|
main^.rowgroup_ctr := DCTSIZE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ If a write pass, read input data until the current iMCU row is full. }
|
||||||
|
{ Note: preprocessor will pad if necessary to fill the last iMCU row. }
|
||||||
|
if (writing) then
|
||||||
|
begin
|
||||||
|
cinfo^.prep^.pre_process_data (cinfo,
|
||||||
|
input_buf, in_row_ctr, in_rows_avail,
|
||||||
|
JSAMPIMAGE(@main^.buffer),
|
||||||
|
main^.rowgroup_ctr,
|
||||||
|
JDIMENSION (DCTSIZE));
|
||||||
|
|
||||||
|
{ Return to application if we need more data to fill the iMCU row. }
|
||||||
|
if (main^.rowgroup_ctr < DCTSIZE) then
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Emit data, unless this is a sink-only pass. }
|
||||||
|
if (main^.pass_mode <> JBUF_SAVE_SOURCE) then
|
||||||
|
begin
|
||||||
|
if (not cinfo^.coef^.compress_data (cinfo,
|
||||||
|
JSAMPIMAGE(@main^.buffer))) then
|
||||||
|
begin
|
||||||
|
{ If compressor did not consume the whole row, then we must need to
|
||||||
|
suspend processing and return to the application. In this situation
|
||||||
|
we pretend we didn't yet consume the last input row; otherwise, if
|
||||||
|
it happened to be the last row of the image, the application would
|
||||||
|
think we were done. }
|
||||||
|
|
||||||
|
if (not main^.suspended) then
|
||||||
|
begin
|
||||||
|
Dec(in_row_ctr);
|
||||||
|
main^.suspended := TRUE;
|
||||||
|
end;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ We did finish the row. Undo our little suspension hack if a previous
|
||||||
|
call suspended; then mark the main buffer empty. }
|
||||||
|
|
||||||
|
if (main^.suspended) then
|
||||||
|
begin
|
||||||
|
Inc(in_row_ctr);
|
||||||
|
main^.suspended := FALSE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ If get here, we are done with this iMCU row. Mark buffer empty. }
|
||||||
|
main^.rowgroup_ctr := 0;
|
||||||
|
Inc(main^.cur_iMCU_row);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { FULL_MAIN_BUFFER_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize main buffer controller. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_c_main_controller (cinfo : j_compress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_main_controller)) );
|
||||||
|
cinfo^.main := jpeg_c_main_controller_ptr(main);
|
||||||
|
main^.pub.start_pass := start_pass_main;
|
||||||
|
|
||||||
|
{ We don't need to create a buffer in raw-data mode. }
|
||||||
|
if (cinfo^.raw_data_in) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
{ Create the buffer. It holds downsampled data, so each component
|
||||||
|
may be of a different size. }
|
||||||
|
|
||||||
|
if (need_full_buffer) then
|
||||||
|
begin
|
||||||
|
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
{ Allocate a full-image virtual array for each component }
|
||||||
|
{ Note we pad the bottom to a multiple of the iMCU height }
|
||||||
|
compptr := cinfo^.comp_info;
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
main^.whole_image[ci] := cinfo^.mem^.request_virt_sarray
|
||||||
|
(j_common_ptr(cinfo), JPOOL_IMAGE, FALSE,
|
||||||
|
compptr^.width_in_blocks * DCTSIZE,
|
||||||
|
JDIMENSION (jround_up( long (compptr^.height_in_blocks),
|
||||||
|
long (compptr^.v_samp_factor)) * DCTSIZE),
|
||||||
|
JDIMENSION (compptr^.v_samp_factor * DCTSIZE));
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
main^.whole_image[0] := NIL; { flag for no virtual arrays }
|
||||||
|
{$endif}
|
||||||
|
{ Allocate a strip buffer for each component }
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
main^.buffer[ci] := cinfo^.mem^.alloc_sarray
|
||||||
|
(j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
compptr^.width_in_blocks * DCTSIZE,
|
||||||
|
JDIMENSION (compptr^.v_samp_factor * DCTSIZE));
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,724 @@
|
||||||
|
unit imjcmarker;
|
||||||
|
|
||||||
|
{ This file contains routines to write JPEG datastream markers. }
|
||||||
|
|
||||||
|
{ Original: jcmarker.c; Copyright (C) 1991-1998, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjinclude, imjmorecfg, imjerror,
|
||||||
|
imjdeferr, imjpeglib, imjutils;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
{ JPEG marker codes }
|
||||||
|
M_SOF0 = $c0;
|
||||||
|
M_SOF1 = $c1;
|
||||||
|
M_SOF2 = $c2;
|
||||||
|
M_SOF3 = $c3;
|
||||||
|
|
||||||
|
M_SOF5 = $c5;
|
||||||
|
M_SOF6 = $c6;
|
||||||
|
M_SOF7 = $c7;
|
||||||
|
|
||||||
|
M_JPG = $c8;
|
||||||
|
M_SOF9 = $c9;
|
||||||
|
M_SOF10 = $ca;
|
||||||
|
M_SOF11 = $cb;
|
||||||
|
|
||||||
|
M_SOF13 = $cd;
|
||||||
|
M_SOF14 = $ce;
|
||||||
|
M_SOF15 = $cf;
|
||||||
|
|
||||||
|
M_DHT = $c4;
|
||||||
|
|
||||||
|
M_DAC = $cc;
|
||||||
|
|
||||||
|
M_RST0 = $d0;
|
||||||
|
M_RST1 = $d1;
|
||||||
|
M_RST2 = $d2;
|
||||||
|
M_RST3 = $d3;
|
||||||
|
M_RST4 = $d4;
|
||||||
|
M_RST5 = $d5;
|
||||||
|
M_RST6 = $d6;
|
||||||
|
M_RST7 = $d7;
|
||||||
|
|
||||||
|
M_SOI = $d8;
|
||||||
|
M_EOI = $d9;
|
||||||
|
M_SOS = $da;
|
||||||
|
M_DQT = $db;
|
||||||
|
M_DNL = $dc;
|
||||||
|
M_DRI = $dd;
|
||||||
|
M_DHP = $de;
|
||||||
|
M_EXP = $df;
|
||||||
|
|
||||||
|
M_APP0 = $e0;
|
||||||
|
M_APP1 = $e1;
|
||||||
|
M_APP2 = $e2;
|
||||||
|
M_APP3 = $e3;
|
||||||
|
M_APP4 = $e4;
|
||||||
|
M_APP5 = $e5;
|
||||||
|
M_APP6 = $e6;
|
||||||
|
M_APP7 = $e7;
|
||||||
|
M_APP8 = $e8;
|
||||||
|
M_APP9 = $e9;
|
||||||
|
M_APP10 = $ea;
|
||||||
|
M_APP11 = $eb;
|
||||||
|
M_APP12 = $ec;
|
||||||
|
M_APP13 = $ed;
|
||||||
|
M_APP14 = $ee;
|
||||||
|
M_APP15 = $ef;
|
||||||
|
|
||||||
|
M_JPG0 = $f0;
|
||||||
|
M_JPG13 = $fd;
|
||||||
|
M_COM = $fe;
|
||||||
|
|
||||||
|
M_TEM = $01;
|
||||||
|
|
||||||
|
M_ERROR = $100;
|
||||||
|
|
||||||
|
type
|
||||||
|
JPEG_MARKER = Word;
|
||||||
|
|
||||||
|
{ Private state }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_marker_ptr = ^my_marker_writer;
|
||||||
|
my_marker_writer = record
|
||||||
|
pub : jpeg_marker_writer; { public fields }
|
||||||
|
|
||||||
|
last_restart_interval : uint; { last DRI value emitted; 0 after SOI }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_marker_writer (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Basic output routines.
|
||||||
|
|
||||||
|
Note that we do not support suspension while writing a marker.
|
||||||
|
Therefore, an application using suspension must ensure that there is
|
||||||
|
enough buffer space for the initial markers (typ. 600-700 bytes) before
|
||||||
|
calling jpeg_start_compress, and enough space to write the trailing EOI
|
||||||
|
(a few bytes) before calling jpeg_finish_compress. Multipass compression
|
||||||
|
modes are not supported at all with suspension, so those two are the only
|
||||||
|
points where markers will be written. }
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_byte (cinfo : j_compress_ptr; val : int);
|
||||||
|
{ Emit a byte }
|
||||||
|
var
|
||||||
|
dest : jpeg_destination_mgr_ptr;
|
||||||
|
begin
|
||||||
|
dest := cinfo^.dest;
|
||||||
|
|
||||||
|
dest^.next_output_byte^ := JOCTET(val);
|
||||||
|
Inc(dest^.next_output_byte);
|
||||||
|
|
||||||
|
Dec(dest^.free_in_buffer);
|
||||||
|
if (dest^.free_in_buffer = 0) then
|
||||||
|
begin
|
||||||
|
if not dest^.empty_output_buffer(cinfo) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_marker(cinfo : j_compress_ptr; mark : JPEG_MARKER);
|
||||||
|
{ Emit a marker code }
|
||||||
|
begin
|
||||||
|
emit_byte(cinfo, $FF);
|
||||||
|
emit_byte(cinfo, int(mark));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_2bytes (cinfo : j_compress_ptr; value : int);
|
||||||
|
{ Emit a 2-byte integer; these are always MSB first in JPEG files }
|
||||||
|
begin
|
||||||
|
emit_byte(cinfo, (value shr 8) and $FF);
|
||||||
|
emit_byte(cinfo, value and $FF);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Routines to write specific marker types. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
function emit_dqt (cinfo : j_compress_ptr; index : int) : int;
|
||||||
|
{ Emit a DQT marker }
|
||||||
|
{ Returns the precision used (0 = 8bits, 1 = 16bits) for baseline checking }
|
||||||
|
var
|
||||||
|
qtbl : JQUANT_TBL_PTR;
|
||||||
|
prec : int;
|
||||||
|
i : int;
|
||||||
|
var
|
||||||
|
qval : uint;
|
||||||
|
begin
|
||||||
|
qtbl := cinfo^.quant_tbl_ptrs[index];
|
||||||
|
if (qtbl = NIL) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, index);
|
||||||
|
|
||||||
|
prec := 0;
|
||||||
|
for i := 0 to Pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
if (qtbl^.quantval[i] > 255) then
|
||||||
|
prec := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not qtbl^.sent_table then
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, M_DQT);
|
||||||
|
|
||||||
|
if (prec <> 0) then
|
||||||
|
emit_2bytes(cinfo, DCTSIZE2*2 + 1 + 2)
|
||||||
|
else
|
||||||
|
emit_2bytes(cinfo, DCTSIZE2 + 1 + 2);
|
||||||
|
|
||||||
|
emit_byte(cinfo, index + (prec shl 4));
|
||||||
|
|
||||||
|
for i := 0 to Pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
{ The table entries must be emitted in zigzag order. }
|
||||||
|
qval := qtbl^.quantval[jpeg_natural_order[i]];
|
||||||
|
if (prec <> 0) then
|
||||||
|
emit_byte(cinfo, int(qval shr 8));
|
||||||
|
emit_byte(cinfo, int(qval and $FF));
|
||||||
|
end;
|
||||||
|
|
||||||
|
qtbl^.sent_table := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
emit_dqt := prec;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_dht (cinfo : j_compress_ptr; index : int; is_ac : boolean);
|
||||||
|
{ Emit a DHT marker }
|
||||||
|
var
|
||||||
|
htbl : JHUFF_TBL_PTR;
|
||||||
|
length, i : int;
|
||||||
|
begin
|
||||||
|
if (is_ac) then
|
||||||
|
begin
|
||||||
|
htbl := cinfo^.ac_huff_tbl_ptrs[index];
|
||||||
|
index := index + $10; { output index has AC bit set }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
htbl := cinfo^.dc_huff_tbl_ptrs[index];
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (htbl = NIL) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, index);
|
||||||
|
|
||||||
|
if not htbl^.sent_table then
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, M_DHT);
|
||||||
|
|
||||||
|
length := 0;
|
||||||
|
for i := 1 to 16 do
|
||||||
|
length := length + htbl^.bits[i];
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, length + 2 + 1 + 16);
|
||||||
|
emit_byte(cinfo, index);
|
||||||
|
|
||||||
|
for i := 1 to 16 do
|
||||||
|
emit_byte(cinfo, htbl^.bits[i]);
|
||||||
|
|
||||||
|
for i := 0 to Pred(length) do
|
||||||
|
emit_byte(cinfo, htbl^.huffval[i]);
|
||||||
|
|
||||||
|
htbl^.sent_table := TRUE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_dac (cinfo : j_compress_ptr);
|
||||||
|
{ Emit a DAC marker }
|
||||||
|
{ Since the useful info is so small, we want to emit all the tables in }
|
||||||
|
{ one DAC marker. Therefore this routine does its own scan of the table. }
|
||||||
|
{$ifdef C_ARITH_CODING_SUPPORTED}
|
||||||
|
var
|
||||||
|
dc_in_use : array[0..NUM_ARITH_TBLS] of byte;
|
||||||
|
ac_in_use : array[0..NUM_ARITH_TBLS] of byte;
|
||||||
|
length, i : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
for i := 0 to pred(NUM_ARITH_TBLS) do
|
||||||
|
begin
|
||||||
|
dc_in_use[i] := 0;
|
||||||
|
ac_in_use[i] := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
for i := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[i];
|
||||||
|
dc_in_use[compptr^.dc_tbl_no] := 1;
|
||||||
|
ac_in_use[compptr^.ac_tbl_no] := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
length := 0;
|
||||||
|
for i := 0 to pred(NUM_ARITH_TBLS) do
|
||||||
|
Inc(length, dc_in_use[i] + ac_in_use[i]);
|
||||||
|
|
||||||
|
emit_marker(cinfo, M_DAC);
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, length*2 + 2);
|
||||||
|
|
||||||
|
for i := 0 to pred(NUM_ARITH_TBLS) do
|
||||||
|
begin
|
||||||
|
if (dc_in_use[i] <> 0) then
|
||||||
|
begin
|
||||||
|
emit_byte(cinfo, i);
|
||||||
|
emit_byte(cinfo, cinfo^.arith_dc_L[i] + (cinfo^.arith_dc_U[i] shl 4));
|
||||||
|
end;
|
||||||
|
if (ac_in_use[i] <> 0) then
|
||||||
|
begin
|
||||||
|
emit_byte(cinfo, i + $10);
|
||||||
|
emit_byte(cinfo, cinfo^.arith_ac_K[i]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
{$endif} {C_ARITH_CODING_SUPPORTED}
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_dri (cinfo : j_compress_ptr);
|
||||||
|
{ Emit a DRI marker }
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, M_DRI);
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, 4); { fixed length }
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, int(cinfo^.restart_interval));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_sof (cinfo : j_compress_ptr; code : JPEG_MARKER);
|
||||||
|
{ Emit a SOF marker }
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, code);
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, 3 * cinfo^.num_components + 2 + 5 + 1); { length }
|
||||||
|
|
||||||
|
{ Make sure image isn't bigger than SOF field can handle }
|
||||||
|
if (long(cinfo^.image_height) > long(65535)) or
|
||||||
|
(long(cinfo^.image_width) > long(65535)) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(65535));
|
||||||
|
|
||||||
|
emit_byte(cinfo, cinfo^.data_precision);
|
||||||
|
emit_2bytes(cinfo, int(cinfo^.image_height));
|
||||||
|
emit_2bytes(cinfo, int(cinfo^.image_width));
|
||||||
|
|
||||||
|
emit_byte(cinfo, cinfo^.num_components);
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to Pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
emit_byte(cinfo, compptr^.component_id);
|
||||||
|
emit_byte(cinfo, (compptr^.h_samp_factor shl 4) + compptr^.v_samp_factor);
|
||||||
|
emit_byte(cinfo, compptr^.quant_tbl_no);
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_sos (cinfo : j_compress_ptr);
|
||||||
|
{ Emit a SOS marker }
|
||||||
|
var
|
||||||
|
i, td, ta : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, M_SOS);
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, 2 * cinfo^.comps_in_scan + 2 + 1 + 3); { length }
|
||||||
|
|
||||||
|
emit_byte(cinfo, cinfo^.comps_in_scan);
|
||||||
|
|
||||||
|
for i := 0 to Pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[i];
|
||||||
|
emit_byte(cinfo, compptr^.component_id);
|
||||||
|
td := compptr^.dc_tbl_no;
|
||||||
|
ta := compptr^.ac_tbl_no;
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
begin
|
||||||
|
{ Progressive mode: only DC or only AC tables are used in one scan;
|
||||||
|
furthermore, Huffman coding of DC refinement uses no table at all.
|
||||||
|
We emit 0 for unused field(s); this is recommended by the P&M text
|
||||||
|
but does not seem to be specified in the standard. }
|
||||||
|
|
||||||
|
if (cinfo^.Ss = 0) then
|
||||||
|
begin
|
||||||
|
ta := 0; { DC scan }
|
||||||
|
if (cinfo^.Ah <> 0) and not cinfo^.arith_code then
|
||||||
|
td := 0; { no DC table either }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
td := 0; { AC scan }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
emit_byte(cinfo, (td shl 4) + ta);
|
||||||
|
end;
|
||||||
|
|
||||||
|
emit_byte(cinfo, cinfo^.Ss);
|
||||||
|
emit_byte(cinfo, cinfo^.Se);
|
||||||
|
emit_byte(cinfo, (cinfo^.Ah shl 4) + cinfo^.Al);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_jfif_app0 (cinfo : j_compress_ptr);
|
||||||
|
{ Emit a JFIF-compliant APP0 marker }
|
||||||
|
{
|
||||||
|
Length of APP0 block (2 bytes)
|
||||||
|
Block ID (4 bytes - ASCII "JFIF")
|
||||||
|
Zero byte (1 byte to terminate the ID string)
|
||||||
|
Version Major, Minor (2 bytes - major first)
|
||||||
|
Units (1 byte - $00 = none, $01 = inch, $02 = cm)
|
||||||
|
Xdpu (2 bytes - dots per unit horizontal)
|
||||||
|
Ydpu (2 bytes - dots per unit vertical)
|
||||||
|
Thumbnail X size (1 byte)
|
||||||
|
Thumbnail Y size (1 byte)
|
||||||
|
}
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, M_APP0);
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, 2 + 4 + 1 + 2 + 1 + 2 + 2 + 1 + 1); { length }
|
||||||
|
|
||||||
|
emit_byte(cinfo, $4A); { Identifier: ASCII "JFIF" }
|
||||||
|
emit_byte(cinfo, $46);
|
||||||
|
emit_byte(cinfo, $49);
|
||||||
|
emit_byte(cinfo, $46);
|
||||||
|
emit_byte(cinfo, 0);
|
||||||
|
emit_byte(cinfo, cinfo^.JFIF_major_version); { Version fields }
|
||||||
|
emit_byte(cinfo, cinfo^.JFIF_minor_version);
|
||||||
|
emit_byte(cinfo, cinfo^.density_unit); { Pixel size information }
|
||||||
|
emit_2bytes(cinfo, int(cinfo^.X_density));
|
||||||
|
emit_2bytes(cinfo, int(cinfo^.Y_density));
|
||||||
|
emit_byte(cinfo, 0); { No thumbnail image }
|
||||||
|
emit_byte(cinfo, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_adobe_app14 (cinfo : j_compress_ptr);
|
||||||
|
{ Emit an Adobe APP14 marker }
|
||||||
|
{
|
||||||
|
Length of APP14 block (2 bytes)
|
||||||
|
Block ID (5 bytes - ASCII "Adobe")
|
||||||
|
Version Number (2 bytes - currently 100)
|
||||||
|
Flags0 (2 bytes - currently 0)
|
||||||
|
Flags1 (2 bytes - currently 0)
|
||||||
|
Color transform (1 byte)
|
||||||
|
|
||||||
|
Although Adobe TN 5116 mentions Version = 101, all the Adobe files
|
||||||
|
now in circulation seem to use Version = 100, so that's what we write.
|
||||||
|
|
||||||
|
We write the color transform byte as 1 if the JPEG color space is
|
||||||
|
YCbCr, 2 if it's YCCK, 0 otherwise. Adobe's definition has to do with
|
||||||
|
whether the encoder performed a transformation, which is pretty useless.
|
||||||
|
}
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, M_APP14);
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, 2 + 5 + 2 + 2 + 2 + 1); { length }
|
||||||
|
|
||||||
|
emit_byte(cinfo, $41); { Identifier: ASCII "Adobe" }
|
||||||
|
emit_byte(cinfo, $64);
|
||||||
|
emit_byte(cinfo, $6F);
|
||||||
|
emit_byte(cinfo, $62);
|
||||||
|
emit_byte(cinfo, $65);
|
||||||
|
emit_2bytes(cinfo, 100); { Version }
|
||||||
|
emit_2bytes(cinfo, 0); { Flags0 }
|
||||||
|
emit_2bytes(cinfo, 0); { Flags1 }
|
||||||
|
case (cinfo^.jpeg_color_space) of
|
||||||
|
JCS_YCbCr:
|
||||||
|
emit_byte(cinfo, 1); { Color transform = 1 }
|
||||||
|
JCS_YCCK:
|
||||||
|
emit_byte(cinfo, 2); { Color transform = 2 }
|
||||||
|
else
|
||||||
|
emit_byte(cinfo, 0); { Color transform = 0 }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ These routines allow writing an arbitrary marker with parameters.
|
||||||
|
The only intended use is to emit COM or APPn markers after calling
|
||||||
|
write_file_header and before calling write_frame_header.
|
||||||
|
Other uses are not guaranteed to produce desirable results.
|
||||||
|
Counting the parameter bytes properly is the caller's responsibility. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure write_marker_header (cinfo : j_compress_ptr;
|
||||||
|
marker : int;
|
||||||
|
datalen : uint);
|
||||||
|
{ Emit an arbitrary marker header }
|
||||||
|
begin
|
||||||
|
if (datalen > uint(65533)) then { safety check }
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH);
|
||||||
|
|
||||||
|
emit_marker(cinfo, JPEG_MARKER(marker));
|
||||||
|
|
||||||
|
emit_2bytes(cinfo, int(datalen + 2)); { total length }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure write_marker_byte (cinfo : j_compress_ptr; val : int);
|
||||||
|
{ Emit one byte of marker parameters following write_marker_header }
|
||||||
|
begin
|
||||||
|
emit_byte(cinfo, val);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Write datastream header.
|
||||||
|
This consists of an SOI and optional APPn markers.
|
||||||
|
We recommend use of the JFIF marker, but not the Adobe marker,
|
||||||
|
when using YCbCr or grayscale data. The JFIF marker should NOT
|
||||||
|
be used for any other JPEG colorspace. The Adobe marker is helpful
|
||||||
|
to distinguish RGB, CMYK, and YCCK colorspaces.
|
||||||
|
Note that an application can write additional header markers after
|
||||||
|
jpeg_start_compress returns. }
|
||||||
|
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure write_file_header (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
marker : my_marker_ptr;
|
||||||
|
begin
|
||||||
|
marker := my_marker_ptr(cinfo^.marker);
|
||||||
|
|
||||||
|
emit_marker(cinfo, M_SOI); { first the SOI }
|
||||||
|
|
||||||
|
{ SOI is defined to reset restart interval to 0 }
|
||||||
|
marker^.last_restart_interval := 0;
|
||||||
|
|
||||||
|
if (cinfo^.write_JFIF_header) then { next an optional JFIF APP0 }
|
||||||
|
emit_jfif_app0(cinfo);
|
||||||
|
if (cinfo^.write_Adobe_marker) then { next an optional Adobe APP14 }
|
||||||
|
emit_adobe_app14(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Write frame header.
|
||||||
|
This consists of DQT and SOFn markers.
|
||||||
|
Note that we do not emit the SOF until we have emitted the DQT(s).
|
||||||
|
This avoids compatibility problems with incorrect implementations that
|
||||||
|
try to error-check the quant table numbers as soon as they see the SOF. }
|
||||||
|
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure write_frame_header (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
ci, prec : int;
|
||||||
|
is_baseline : boolean;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
{ Emit DQT for each quantization table.
|
||||||
|
Note that emit_dqt() suppresses any duplicate tables. }
|
||||||
|
|
||||||
|
prec := 0;
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to Pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
prec := prec + emit_dqt(cinfo, compptr^.quant_tbl_no);
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
{ now prec is nonzero iff there are any 16-bit quant tables. }
|
||||||
|
|
||||||
|
{ Check for a non-baseline specification.
|
||||||
|
Note we assume that Huffman table numbers won't be changed later. }
|
||||||
|
|
||||||
|
if (cinfo^.arith_code) or (cinfo^.progressive_mode)
|
||||||
|
or (cinfo^.data_precision <> 8) then
|
||||||
|
begin
|
||||||
|
is_baseline := FALSE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
is_baseline := TRUE;
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to Pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
if (compptr^.dc_tbl_no > 1) or (compptr^.ac_tbl_no > 1) then
|
||||||
|
is_baseline := FALSE;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
if (prec <> 0) and (is_baseline) then
|
||||||
|
begin
|
||||||
|
is_baseline := FALSE;
|
||||||
|
{ If it's baseline except for quantizer size, warn the user }
|
||||||
|
{$IFDEF DEBUG}
|
||||||
|
TRACEMS(j_common_ptr(cinfo), 0, JTRC_16BIT_TABLES);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Emit the proper SOF marker }
|
||||||
|
if (cinfo^.arith_code) then
|
||||||
|
begin
|
||||||
|
emit_sof(cinfo, M_SOF9); { SOF code for arithmetic coding }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
emit_sof(cinfo, M_SOF2) { SOF code for progressive Huffman }
|
||||||
|
else if (is_baseline) then
|
||||||
|
emit_sof(cinfo, M_SOF0) { SOF code for baseline implementation }
|
||||||
|
else
|
||||||
|
emit_sof(cinfo, M_SOF1); { SOF code for non-baseline Huffman file }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Write scan header.
|
||||||
|
This consists of DHT or DAC markers, optional DRI, and SOS.
|
||||||
|
Compressed data will be written following the SOS. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure write_scan_header (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
marker : my_marker_ptr;
|
||||||
|
i : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
marker := my_marker_ptr(cinfo^.marker);
|
||||||
|
if (cinfo^.arith_code) then
|
||||||
|
begin
|
||||||
|
{ Emit arith conditioning info. We may have some duplication
|
||||||
|
if the file has multiple scans, but it's so small it's hardly
|
||||||
|
worth worrying about. }
|
||||||
|
emit_dac(cinfo);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Emit Huffman tables.
|
||||||
|
Note that emit_dht() suppresses any duplicate tables. }
|
||||||
|
for i := 0 to Pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[i];
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
begin
|
||||||
|
{ Progressive mode: only DC or only AC tables are used in one scan }
|
||||||
|
if (cinfo^.Ss = 0) then
|
||||||
|
begin
|
||||||
|
if (cinfo^.Ah = 0) then { DC needs no table for refinement scan }
|
||||||
|
emit_dht(cinfo, compptr^.dc_tbl_no, FALSE);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
emit_dht(cinfo, compptr^.ac_tbl_no, TRUE);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Sequential mode: need both DC and AC tables }
|
||||||
|
emit_dht(cinfo, compptr^.dc_tbl_no, FALSE);
|
||||||
|
emit_dht(cinfo, compptr^.ac_tbl_no, TRUE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Emit DRI if required --- note that DRI value could change for each scan.
|
||||||
|
We avoid wasting space with unnecessary DRIs, however. }
|
||||||
|
|
||||||
|
if (cinfo^.restart_interval <> marker^.last_restart_interval) then
|
||||||
|
begin
|
||||||
|
emit_dri(cinfo);
|
||||||
|
marker^.last_restart_interval := cinfo^.restart_interval;
|
||||||
|
end;
|
||||||
|
|
||||||
|
emit_sos(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ Write datastream trailer. }
|
||||||
|
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure write_file_trailer (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, M_EOI);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Write an abbreviated table-specification datastream.
|
||||||
|
This consists of SOI, DQT and DHT tables, and EOI.
|
||||||
|
Any table that is defined and not marked sent_table = TRUE will be
|
||||||
|
emitted. Note that all tables will be marked sent_table = TRUE at exit. }
|
||||||
|
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure write_tables_only (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
i : int;
|
||||||
|
begin
|
||||||
|
emit_marker(cinfo, M_SOI);
|
||||||
|
|
||||||
|
for i := 0 to Pred(NUM_QUANT_TBLS) do
|
||||||
|
begin
|
||||||
|
if (cinfo^.quant_tbl_ptrs[i] <> NIL) then
|
||||||
|
emit_dqt(cinfo, i); { dummy := ... }
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (not cinfo^.arith_code) then
|
||||||
|
begin
|
||||||
|
for i := 0 to Pred(NUM_HUFF_TBLS) do
|
||||||
|
begin
|
||||||
|
if (cinfo^.dc_huff_tbl_ptrs[i] <> NIL) then
|
||||||
|
emit_dht(cinfo, i, FALSE);
|
||||||
|
if (cinfo^.ac_huff_tbl_ptrs[i] <> NIL) then
|
||||||
|
emit_dht(cinfo, i, TRUE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
emit_marker(cinfo, M_EOI);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize the marker writer module. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_marker_writer (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
marker : my_marker_ptr;
|
||||||
|
begin
|
||||||
|
{ Create the subobject }
|
||||||
|
marker := my_marker_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_marker_writer)) );
|
||||||
|
cinfo^.marker := jpeg_marker_writer_ptr(marker);
|
||||||
|
{ Initialize method pointers }
|
||||||
|
marker^.pub.write_file_header := write_file_header;
|
||||||
|
marker^.pub.write_frame_header := write_frame_header;
|
||||||
|
marker^.pub.write_scan_header := write_scan_header;
|
||||||
|
marker^.pub.write_file_trailer := write_file_trailer;
|
||||||
|
marker^.pub.write_tables_only := write_tables_only;
|
||||||
|
marker^.pub.write_marker_header := write_marker_header;
|
||||||
|
marker^.pub.write_marker_byte := write_marker_byte;
|
||||||
|
{ Initialize private state }
|
||||||
|
marker^.last_restart_interval := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,701 @@
|
||||||
|
unit imjcmaster;
|
||||||
|
|
||||||
|
{ This file contains master control logic for the JPEG compressor.
|
||||||
|
These routines are concerned with parameter validation, initial setup,
|
||||||
|
and inter-pass control (determining the number of passes and the work
|
||||||
|
to be done in each pass). }
|
||||||
|
|
||||||
|
{ Original: jcmaster.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjutils,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
{ Initialize master compression control. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_c_master_control (cinfo : j_compress_ptr;
|
||||||
|
transcode_only : boolean);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Private state }
|
||||||
|
|
||||||
|
type
|
||||||
|
c_pass_type = (
|
||||||
|
main_pass, { input data, also do first output step }
|
||||||
|
huff_opt_pass, { Huffman code optimization pass }
|
||||||
|
output_pass { data output pass }
|
||||||
|
);
|
||||||
|
|
||||||
|
type
|
||||||
|
my_master_ptr = ^my_comp_master;
|
||||||
|
my_comp_master = record
|
||||||
|
pub : jpeg_comp_master; { public fields }
|
||||||
|
|
||||||
|
pass_type : c_pass_type; { the type of the current pass }
|
||||||
|
|
||||||
|
pass_number : int; { # of passes completed }
|
||||||
|
total_passes : int; { total # of passes needed }
|
||||||
|
|
||||||
|
scan_number : int; { current index in scan_info[] }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Support routines that do various essential calculations. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure initial_setup (cinfo : j_compress_ptr);
|
||||||
|
{ Do computations that are needed before master selection phase }
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
samplesperrow : long;
|
||||||
|
jd_samplesperrow : JDIMENSION;
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ Sanity check on image dimensions }
|
||||||
|
if (cinfo^.image_height <= 0) or (cinfo^.image_width <= 0) or
|
||||||
|
(cinfo^.num_components <= 0) or (cinfo^.input_components <= 0) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_EMPTY_IMAGE);
|
||||||
|
|
||||||
|
{ Make sure image isn't bigger than I can handle }
|
||||||
|
if ( long(cinfo^.image_height) > long(JPEG_MAX_DIMENSION)) or
|
||||||
|
( long(cinfo^.image_width) > long(JPEG_MAX_DIMENSION)) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG,
|
||||||
|
uInt(JPEG_MAX_DIMENSION));
|
||||||
|
|
||||||
|
{ Width of an input scanline must be representable as JDIMENSION. }
|
||||||
|
samplesperrow := long (cinfo^.image_width) * long (cinfo^.input_components);
|
||||||
|
jd_samplesperrow := JDIMENSION (samplesperrow);
|
||||||
|
if ( long(jd_samplesperrow) <> samplesperrow) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_WIDTH_OVERFLOW);
|
||||||
|
|
||||||
|
{ For now, precision must match compiled-in value... }
|
||||||
|
if (cinfo^.data_precision <> BITS_IN_JSAMPLE) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PRECISION, cinfo^.data_precision);
|
||||||
|
|
||||||
|
{ Check that number of components won't exceed internal array sizes }
|
||||||
|
if (cinfo^.num_components > MAX_COMPONENTS) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components,
|
||||||
|
MAX_COMPONENTS);
|
||||||
|
|
||||||
|
{ Compute maximum sampling factors; check factor validity }
|
||||||
|
cinfo^.max_h_samp_factor := 1;
|
||||||
|
cinfo^.max_v_samp_factor := 1;
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
if (compptr^.h_samp_factor<=0) or (compptr^.h_samp_factor>MAX_SAMP_FACTOR)
|
||||||
|
or (compptr^.v_samp_factor<=0) or (compptr^.v_samp_factor>MAX_SAMP_FACTOR) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_SAMPLING);
|
||||||
|
{ MAX }
|
||||||
|
if cinfo^.max_h_samp_factor > compptr^.h_samp_factor then
|
||||||
|
cinfo^.max_h_samp_factor := cinfo^.max_h_samp_factor
|
||||||
|
else
|
||||||
|
cinfo^.max_h_samp_factor := compptr^.h_samp_factor;
|
||||||
|
{ MAX }
|
||||||
|
if cinfo^.max_v_samp_factor > compptr^.v_samp_factor then
|
||||||
|
cinfo^.max_v_samp_factor := cinfo^.max_v_samp_factor
|
||||||
|
else
|
||||||
|
cinfo^.max_v_samp_factor := compptr^.v_samp_factor;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Compute dimensions of components }
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ Fill in the correct component_index value; don't rely on application }
|
||||||
|
compptr^.component_index := ci;
|
||||||
|
{ For compression, we never do DCT scaling. }
|
||||||
|
compptr^.DCT_scaled_size := DCTSIZE;
|
||||||
|
{ Size in DCT blocks }
|
||||||
|
compptr^.width_in_blocks := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_width) * long (compptr^.h_samp_factor),
|
||||||
|
long (cinfo^.max_h_samp_factor * DCTSIZE)) );
|
||||||
|
compptr^.height_in_blocks := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_height) * long (compptr^.v_samp_factor),
|
||||||
|
long (cinfo^.max_v_samp_factor * DCTSIZE)) );
|
||||||
|
{ Size in samples }
|
||||||
|
compptr^.downsampled_width := JDIMENSION (
|
||||||
|
jdiv_round_up(long(cinfo^.image_width) * long(compptr^.h_samp_factor),
|
||||||
|
long(cinfo^.max_h_samp_factor)) );
|
||||||
|
compptr^.downsampled_height := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
|
||||||
|
long (cinfo^.max_v_samp_factor)) );
|
||||||
|
{ Mark component needed (this flag isn't actually used for compression) }
|
||||||
|
compptr^.component_needed := TRUE;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Compute number of fully interleaved MCU rows (number of times that
|
||||||
|
main controller will call coefficient controller). }
|
||||||
|
|
||||||
|
cinfo^.total_iMCU_rows := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_height),
|
||||||
|
long (cinfo^.max_v_samp_factor*DCTSIZE)) );
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef C_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure validate_script (cinfo : j_compress_ptr);
|
||||||
|
{ Verify that the scan script in cinfo^.scan_info[] is valid; also
|
||||||
|
determine whether it uses progressive JPEG, and set cinfo^.progressive_mode. }
|
||||||
|
type
|
||||||
|
IntRow = array[0..DCTSIZE2-1] of int;
|
||||||
|
introw_ptr = ^IntRow;
|
||||||
|
var
|
||||||
|
{const}scanptr : jpeg_scan_info_ptr;
|
||||||
|
scanno, ncomps, ci, coefi, thisi : int;
|
||||||
|
Ss, Se, Ah, Al : int;
|
||||||
|
component_sent : array[0..MAX_COMPONENTS-1] of boolean;
|
||||||
|
{$ifdef C_PROGRESSIVE_SUPPORTED}
|
||||||
|
last_bitpos_int_ptr : int_ptr;
|
||||||
|
last_bitpos_ptr : introw_ptr;
|
||||||
|
last_bitpos : array[0..MAX_COMPONENTS-1] of IntRow;
|
||||||
|
{ -1 until that coefficient has been seen; then last Al for it }
|
||||||
|
{ The JPEG spec simply gives the ranges 0..13 for Ah and Al, but that
|
||||||
|
seems wrong: the upper bound ought to depend on data precision.
|
||||||
|
Perhaps they really meant 0..N+1 for N-bit precision.
|
||||||
|
Here we allow 0..10 for 8-bit data; Al larger than 10 results in
|
||||||
|
out-of-range reconstructed DC values during the first DC scan,
|
||||||
|
which might cause problems for some decoders. }
|
||||||
|
{$ifdef BITS_IN_JSAMPLE_IS_8}
|
||||||
|
const
|
||||||
|
MAX_AH_AL = 10;
|
||||||
|
{$else}
|
||||||
|
const
|
||||||
|
MAX_AH_AL = 13;
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
begin
|
||||||
|
|
||||||
|
if (cinfo^.num_scans <= 0) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, 0);
|
||||||
|
|
||||||
|
{ For sequential JPEG, all scans must have Ss=0, Se=DCTSIZE2-1;
|
||||||
|
for progressive JPEG, no scan can have this. }
|
||||||
|
|
||||||
|
scanptr := cinfo^.scan_info;
|
||||||
|
if (scanptr^.Ss <> 0) or (scanptr^.Se <> DCTSIZE2-1) then
|
||||||
|
begin
|
||||||
|
{$ifdef C_PROGRESSIVE_SUPPORTED}
|
||||||
|
cinfo^.progressive_mode := TRUE;
|
||||||
|
last_bitpos_int_ptr := @(last_bitpos[0][0]);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
for coefi := 0 to pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
last_bitpos_int_ptr^ := -1;
|
||||||
|
Inc(last_bitpos_int_ptr);
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
cinfo^.progressive_mode := FALSE;
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
component_sent[ci] := FALSE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
for scanno := 1 to cinfo^.num_scans do
|
||||||
|
begin
|
||||||
|
{ Validate component indexes }
|
||||||
|
ncomps := scanptr^.comps_in_scan;
|
||||||
|
if (ncomps <= 0) or (ncomps > MAX_COMPS_IN_SCAN) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, ncomps, MAX_COMPS_IN_SCAN);
|
||||||
|
for ci := 0 to pred(ncomps) do
|
||||||
|
begin
|
||||||
|
thisi := scanptr^.component_index[ci];
|
||||||
|
if (thisi < 0) or (thisi >= cinfo^.num_components) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno);
|
||||||
|
{ Components must appear in SOF order within each scan }
|
||||||
|
if (ci > 0) and (thisi <= scanptr^.component_index[ci-1]) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno);
|
||||||
|
end;
|
||||||
|
{ Validate progression parameters }
|
||||||
|
Ss := scanptr^.Ss;
|
||||||
|
Se := scanptr^.Se;
|
||||||
|
Ah := scanptr^.Ah;
|
||||||
|
Al := scanptr^.Al;
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
begin
|
||||||
|
{$ifdef C_PROGRESSIVE_SUPPORTED}
|
||||||
|
if (Ss < 0) or (Ss >= DCTSIZE2) or (Se < Ss) or (Se >= DCTSIZE2) or
|
||||||
|
(Ah < 0) or (Ah > MAX_AH_AL) or (Al < 0) or (Al > MAX_AH_AL) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno);
|
||||||
|
|
||||||
|
if (Ss < 0) or (Ss >= DCTSIZE2) or (Se < Ss) or (Se >= DCTSIZE2)
|
||||||
|
or (Ah < 0) or (Ah > MAX_AH_AL) or (Al < 0) or (Al > MAX_AH_AL) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno);
|
||||||
|
if (Ss = 0) then
|
||||||
|
begin
|
||||||
|
if (Se <> 0) then { DC and AC together not OK }
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (ncomps <> 1) then { AC scans must be for only one component }
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno);
|
||||||
|
end;
|
||||||
|
for ci := 0 to pred(ncomps) do
|
||||||
|
begin
|
||||||
|
last_bitpos_ptr := @( last_bitpos[scanptr^.component_index[ci]]);
|
||||||
|
if (Ss <> 0) and (last_bitpos_ptr^[0] < 0) then { AC without prior DC scan }
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno);
|
||||||
|
for coefi := Ss to Se do
|
||||||
|
begin
|
||||||
|
if (last_bitpos_ptr^[coefi] < 0) then
|
||||||
|
begin
|
||||||
|
{ first scan of this coefficient }
|
||||||
|
if (Ah <> 0) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ not first scan }
|
||||||
|
if (Ah <> last_bitpos_ptr^[coefi]) or (Al <> Ah-1) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno);
|
||||||
|
end;
|
||||||
|
last_bitpos_ptr^[coefi] := Al;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ For sequential JPEG, all progression parameters must be these: }
|
||||||
|
if (Ss <> 0) or (Se <> DCTSIZE2-1) or (Ah <> 0) or (Al <> 0) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno);
|
||||||
|
{ Make sure components are not sent twice }
|
||||||
|
for ci := 0 to pred(ncomps) do
|
||||||
|
begin
|
||||||
|
thisi := scanptr^.component_index[ci];
|
||||||
|
if (component_sent[thisi]) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno);
|
||||||
|
component_sent[thisi] := TRUE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(scanptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Now verify that everything got sent. }
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
begin
|
||||||
|
{$ifdef C_PROGRESSIVE_SUPPORTED}
|
||||||
|
{ For progressive mode, we only check that at least some DC data
|
||||||
|
got sent for each component; the spec does not require that all bits
|
||||||
|
of all coefficients be transmitted. Would it be wiser to enforce
|
||||||
|
transmission of all coefficient bits?? }
|
||||||
|
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
if (last_bitpos[ci][0] < 0) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_MISSING_DATA);
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
if (not component_sent[ci]) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_MISSING_DATA);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { C_MULTISCAN_FILES_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure select_scan_parameters (cinfo : j_compress_ptr);
|
||||||
|
{ Set up the scan parameters for the current scan }
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
{const} scanptr : jpeg_scan_info_ptr;
|
||||||
|
ci : int;
|
||||||
|
var
|
||||||
|
comp_infos : jpeg_component_info_list_ptr;
|
||||||
|
begin
|
||||||
|
{$ifdef C_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
if (cinfo^.scan_info <> NIL) then
|
||||||
|
begin
|
||||||
|
{ Prepare for current scan --- the script is already validated }
|
||||||
|
master := my_master_ptr (cinfo^.master);
|
||||||
|
scanptr := cinfo^.scan_info;
|
||||||
|
Inc(scanptr, master^.scan_number);
|
||||||
|
|
||||||
|
cinfo^.comps_in_scan := scanptr^.comps_in_scan;
|
||||||
|
comp_infos := cinfo^.comp_info;
|
||||||
|
for ci := 0 to pred(scanptr^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
cinfo^.cur_comp_info[ci] :=
|
||||||
|
@(comp_infos^[scanptr^.component_index[ci]]);
|
||||||
|
end;
|
||||||
|
cinfo^.Ss := scanptr^.Ss;
|
||||||
|
cinfo^.Se := scanptr^.Se;
|
||||||
|
cinfo^.Ah := scanptr^.Ah;
|
||||||
|
cinfo^.Al := scanptr^.Al;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{$endif}
|
||||||
|
begin
|
||||||
|
{ Prepare for single sequential-JPEG scan containing all components }
|
||||||
|
if (cinfo^.num_components > MAX_COMPS_IN_SCAN) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components,
|
||||||
|
MAX_COMPS_IN_SCAN);
|
||||||
|
cinfo^.comps_in_scan := cinfo^.num_components;
|
||||||
|
comp_infos := cinfo^.comp_info;
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
cinfo^.cur_comp_info[ci] := @(comp_infos^[ci]);
|
||||||
|
end;
|
||||||
|
cinfo^.Ss := 0;
|
||||||
|
cinfo^.Se := DCTSIZE2-1;
|
||||||
|
cinfo^.Ah := 0;
|
||||||
|
cinfo^.Al := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure per_scan_setup (cinfo : j_compress_ptr);
|
||||||
|
{ Do computations that are needed before processing a JPEG scan }
|
||||||
|
{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] are already set }
|
||||||
|
var
|
||||||
|
ci, mcublks, tmp : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
nominal : long;
|
||||||
|
begin
|
||||||
|
if (cinfo^.comps_in_scan = 1) then
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ Noninterleaved (single-component) scan }
|
||||||
|
compptr := cinfo^.cur_comp_info[0];
|
||||||
|
|
||||||
|
{ Overall image size in MCUs }
|
||||||
|
cinfo^.MCUs_per_row := compptr^.width_in_blocks;
|
||||||
|
cinfo^.MCU_rows_in_scan := compptr^.height_in_blocks;
|
||||||
|
|
||||||
|
{ For noninterleaved scan, always one block per MCU }
|
||||||
|
compptr^.MCU_width := 1;
|
||||||
|
compptr^.MCU_height := 1;
|
||||||
|
compptr^.MCU_blocks := 1;
|
||||||
|
compptr^.MCU_sample_width := DCTSIZE;
|
||||||
|
compptr^.last_col_width := 1;
|
||||||
|
{ For noninterleaved scans, it is convenient to define last_row_height
|
||||||
|
as the number of block rows present in the last iMCU row. }
|
||||||
|
|
||||||
|
tmp := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor;
|
||||||
|
if (tmp = 0) then
|
||||||
|
tmp := compptr^.v_samp_factor;
|
||||||
|
compptr^.last_row_height := tmp;
|
||||||
|
|
||||||
|
{ Prepare array describing MCU composition }
|
||||||
|
cinfo^.blocks_in_MCU := 1;
|
||||||
|
cinfo^.MCU_membership[0] := 0;
|
||||||
|
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ Interleaved (multi-component) scan }
|
||||||
|
if (cinfo^.comps_in_scan <= 0) or
|
||||||
|
(cinfo^.comps_in_scan > MAX_COMPS_IN_SCAN) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT,
|
||||||
|
cinfo^.comps_in_scan, MAX_COMPS_IN_SCAN);
|
||||||
|
|
||||||
|
{ Overall image size in MCUs }
|
||||||
|
cinfo^.MCUs_per_row := JDIMENSION (
|
||||||
|
jdiv_round_up( long (cinfo^.image_width),
|
||||||
|
long (cinfo^.max_h_samp_factor*DCTSIZE)) );
|
||||||
|
cinfo^.MCU_rows_in_scan := JDIMENSION (
|
||||||
|
jdiv_round_up( long (cinfo^.image_height),
|
||||||
|
long (cinfo^.max_v_samp_factor*DCTSIZE)) );
|
||||||
|
|
||||||
|
cinfo^.blocks_in_MCU := 0;
|
||||||
|
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
{ Sampling factors give # of blocks of component in each MCU }
|
||||||
|
compptr^.MCU_width := compptr^.h_samp_factor;
|
||||||
|
compptr^.MCU_height := compptr^.v_samp_factor;
|
||||||
|
compptr^.MCU_blocks := compptr^.MCU_width * compptr^.MCU_height;
|
||||||
|
compptr^.MCU_sample_width := compptr^.MCU_width * DCTSIZE;
|
||||||
|
{ Figure number of non-dummy blocks in last MCU column & row }
|
||||||
|
tmp := int (compptr^.width_in_blocks) mod compptr^.MCU_width;
|
||||||
|
if (tmp = 0) then
|
||||||
|
tmp := compptr^.MCU_width;
|
||||||
|
compptr^.last_col_width := tmp;
|
||||||
|
tmp := int (compptr^.height_in_blocks) mod compptr^.MCU_height;
|
||||||
|
if (tmp = 0) then
|
||||||
|
tmp := compptr^.MCU_height;
|
||||||
|
compptr^.last_row_height := tmp;
|
||||||
|
{ Prepare array describing MCU composition }
|
||||||
|
mcublks := compptr^.MCU_blocks;
|
||||||
|
if (cinfo^.blocks_in_MCU + mcublks > C_MAX_BLOCKS_IN_MCU) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_MCU_SIZE);
|
||||||
|
while (mcublks > 0) do
|
||||||
|
begin
|
||||||
|
Dec(mcublks);
|
||||||
|
cinfo^.MCU_membership[cinfo^.blocks_in_MCU] := ci;
|
||||||
|
Inc(cinfo^.blocks_in_MCU);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Convert restart specified in rows to actual MCU count. }
|
||||||
|
{ Note that count must fit in 16 bits, so we provide limiting. }
|
||||||
|
if (cinfo^.restart_in_rows > 0) then
|
||||||
|
begin
|
||||||
|
nominal := long(cinfo^.restart_in_rows) * long(cinfo^.MCUs_per_row);
|
||||||
|
if nominal < long(65535) then
|
||||||
|
cinfo^.restart_interval := uInt (nominal)
|
||||||
|
else
|
||||||
|
cinfo^.restart_interval := long(65535);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Per-pass setup.
|
||||||
|
This is called at the beginning of each pass. We determine which modules
|
||||||
|
will be active during this pass and give them appropriate start_pass calls.
|
||||||
|
We also set is_last_pass to indicate whether any more passes will be
|
||||||
|
required. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure prepare_for_pass (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
var
|
||||||
|
fallthrough : boolean;
|
||||||
|
begin
|
||||||
|
master := my_master_ptr (cinfo^.master);
|
||||||
|
fallthrough := true;
|
||||||
|
|
||||||
|
case (master^.pass_type) of
|
||||||
|
main_pass:
|
||||||
|
begin
|
||||||
|
{ Initial pass: will collect input data, and do either Huffman
|
||||||
|
optimization or data output for the first scan. }
|
||||||
|
select_scan_parameters(cinfo);
|
||||||
|
per_scan_setup(cinfo);
|
||||||
|
if (not cinfo^.raw_data_in) then
|
||||||
|
begin
|
||||||
|
cinfo^.cconvert^.start_pass (cinfo);
|
||||||
|
cinfo^.downsample^.start_pass (cinfo);
|
||||||
|
cinfo^.prep^.start_pass (cinfo, JBUF_PASS_THRU);
|
||||||
|
end;
|
||||||
|
cinfo^.fdct^.start_pass (cinfo);
|
||||||
|
cinfo^.entropy^.start_pass (cinfo, cinfo^.optimize_coding);
|
||||||
|
if master^.total_passes > 1 then
|
||||||
|
cinfo^.coef^.start_pass (cinfo, JBUF_SAVE_AND_PASS)
|
||||||
|
else
|
||||||
|
cinfo^.coef^.start_pass (cinfo, JBUF_PASS_THRU);
|
||||||
|
cinfo^.main^.start_pass (cinfo, JBUF_PASS_THRU);
|
||||||
|
if (cinfo^.optimize_coding) then
|
||||||
|
begin
|
||||||
|
{ No immediate data output; postpone writing frame/scan headers }
|
||||||
|
master^.pub.call_pass_startup := FALSE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Will write frame/scan headers at first jpeg_write_scanlines call }
|
||||||
|
master^.pub.call_pass_startup := TRUE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$ifdef ENTROPY_OPT_SUPPORTED}
|
||||||
|
huff_opt_pass,
|
||||||
|
output_pass:
|
||||||
|
begin
|
||||||
|
if (master^.pass_type = huff_opt_pass) then
|
||||||
|
begin
|
||||||
|
{ Do Huffman optimization for a scan after the first one. }
|
||||||
|
select_scan_parameters(cinfo);
|
||||||
|
per_scan_setup(cinfo);
|
||||||
|
if (cinfo^.Ss <> 0) or (cinfo^.Ah = 0) or (cinfo^.arith_code) then
|
||||||
|
begin
|
||||||
|
cinfo^.entropy^.start_pass (cinfo, TRUE);
|
||||||
|
cinfo^.coef^.start_pass (cinfo, JBUF_CRANK_DEST);
|
||||||
|
master^.pub.call_pass_startup := FALSE;
|
||||||
|
fallthrough := false;
|
||||||
|
end;
|
||||||
|
{ Special case: Huffman DC refinement scans need no Huffman table
|
||||||
|
and therefore we can skip the optimization pass for them. }
|
||||||
|
if fallthrough then
|
||||||
|
begin
|
||||||
|
master^.pass_type := output_pass;
|
||||||
|
Inc(master^.pass_number);
|
||||||
|
{FALLTHROUGH}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
|
output_pass:
|
||||||
|
begin
|
||||||
|
{$endif}
|
||||||
|
if fallthrough then
|
||||||
|
begin
|
||||||
|
{ Do a data-output pass. }
|
||||||
|
{ We need not repeat per-scan setup if prior optimization pass did it. }
|
||||||
|
if (not cinfo^.optimize_coding) then
|
||||||
|
begin
|
||||||
|
select_scan_parameters(cinfo);
|
||||||
|
per_scan_setup(cinfo);
|
||||||
|
end;
|
||||||
|
cinfo^.entropy^.start_pass (cinfo, FALSE);
|
||||||
|
cinfo^.coef^.start_pass (cinfo, JBUF_CRANK_DEST);
|
||||||
|
{ We emit frame/scan headers now }
|
||||||
|
if (master^.scan_number = 0) then
|
||||||
|
cinfo^.marker^.write_frame_header (cinfo);
|
||||||
|
cinfo^.marker^.write_scan_header (cinfo);
|
||||||
|
master^.pub.call_pass_startup := FALSE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
end;
|
||||||
|
|
||||||
|
master^.pub.is_last_pass := (master^.pass_number = master^.total_passes-1);
|
||||||
|
|
||||||
|
{ Set up progress monitor's pass info if present }
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.progress^.completed_passes := master^.pass_number;
|
||||||
|
cinfo^.progress^.total_passes := master^.total_passes;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Special start-of-pass hook.
|
||||||
|
This is called by jpeg_write_scanlines if call_pass_startup is TRUE.
|
||||||
|
In single-pass processing, we need this hook because we don't want to
|
||||||
|
write frame/scan headers during jpeg_start_compress; we want to let the
|
||||||
|
application write COM markers etc. between jpeg_start_compress and the
|
||||||
|
jpeg_write_scanlines loop.
|
||||||
|
In multi-pass processing, this routine is not used. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure pass_startup (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
cinfo^.master^.call_pass_startup := FALSE; { reset flag so call only once }
|
||||||
|
|
||||||
|
cinfo^.marker^.write_frame_header (cinfo);
|
||||||
|
cinfo^.marker^.write_scan_header (cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish up at end of pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure finish_pass_master (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
begin
|
||||||
|
master := my_master_ptr (cinfo^.master);
|
||||||
|
|
||||||
|
{ The entropy coder always needs an end-of-pass call,
|
||||||
|
either to analyze statistics or to flush its output buffer. }
|
||||||
|
cinfo^.entropy^.finish_pass (cinfo);
|
||||||
|
|
||||||
|
{ Update state for next pass }
|
||||||
|
case (master^.pass_type) of
|
||||||
|
main_pass:
|
||||||
|
begin
|
||||||
|
{ next pass is either output of scan 0 (after optimization)
|
||||||
|
or output of scan 1 (if no optimization). }
|
||||||
|
|
||||||
|
master^.pass_type := output_pass;
|
||||||
|
if (not cinfo^.optimize_coding) then
|
||||||
|
Inc(master^.scan_number);
|
||||||
|
end;
|
||||||
|
huff_opt_pass:
|
||||||
|
{ next pass is always output of current scan }
|
||||||
|
master^.pass_type := output_pass;
|
||||||
|
output_pass:
|
||||||
|
begin
|
||||||
|
{ next pass is either optimization or output of next scan }
|
||||||
|
if (cinfo^.optimize_coding) then
|
||||||
|
master^.pass_type := huff_opt_pass;
|
||||||
|
Inc(master^.scan_number);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Inc(master^.pass_number);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize master compression control. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_c_master_control (cinfo : j_compress_ptr;
|
||||||
|
transcode_only : boolean);
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
begin
|
||||||
|
master := my_master_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_comp_master)) );
|
||||||
|
cinfo^.master := jpeg_comp_master_ptr(master);
|
||||||
|
master^.pub.prepare_for_pass := prepare_for_pass;
|
||||||
|
master^.pub.pass_startup := pass_startup;
|
||||||
|
master^.pub.finish_pass := finish_pass_master;
|
||||||
|
master^.pub.is_last_pass := FALSE;
|
||||||
|
|
||||||
|
{ Validate parameters, determine derived values }
|
||||||
|
initial_setup(cinfo);
|
||||||
|
|
||||||
|
if (cinfo^.scan_info <> NIL) then
|
||||||
|
begin
|
||||||
|
{$ifdef C_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
validate_script(cinfo);
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
cinfo^.progressive_mode := FALSE;
|
||||||
|
cinfo^.num_scans := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (cinfo^.progressive_mode) then { TEMPORARY HACK ??? }
|
||||||
|
cinfo^.optimize_coding := TRUE; { assume default tables no good for progressive mode }
|
||||||
|
|
||||||
|
{ Initialize my private state }
|
||||||
|
if (transcode_only) then
|
||||||
|
begin
|
||||||
|
{ no main pass in transcoding }
|
||||||
|
if (cinfo^.optimize_coding) then
|
||||||
|
master^.pass_type := huff_opt_pass
|
||||||
|
else
|
||||||
|
master^.pass_type := output_pass;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ for normal compression, first pass is always this type: }
|
||||||
|
master^.pass_type := main_pass;
|
||||||
|
end;
|
||||||
|
master^.scan_number := 0;
|
||||||
|
master^.pass_number := 0;
|
||||||
|
if (cinfo^.optimize_coding) then
|
||||||
|
master^.total_passes := cinfo^.num_scans * 2
|
||||||
|
else
|
||||||
|
master^.total_passes := cinfo^.num_scans;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,130 @@
|
||||||
|
unit imjcomapi;
|
||||||
|
|
||||||
|
{ This file contains application interface routines that are used for both
|
||||||
|
compression and decompression. }
|
||||||
|
|
||||||
|
{ Original: jcomapi.c; Copyright (C) 1994-1997, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
{ Abort processing of a JPEG compression or decompression operation,
|
||||||
|
but don't destroy the object itself. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_abort (cinfo : j_common_ptr);
|
||||||
|
|
||||||
|
|
||||||
|
{ Destruction of a JPEG object. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_destroy (cinfo : j_common_ptr);
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR;
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Abort processing of a JPEG compression or decompression operation,
|
||||||
|
but don't destroy the object itself.
|
||||||
|
|
||||||
|
For this, we merely clean up all the nonpermanent memory pools.
|
||||||
|
Note that temp files (virtual arrays) are not allowed to belong to
|
||||||
|
the permanent pool, so we will be able to close all temp files here.
|
||||||
|
Closing a data source or destination, if necessary, is the application's
|
||||||
|
responsibility. }
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_abort (cinfo : j_common_ptr);
|
||||||
|
var
|
||||||
|
pool : int;
|
||||||
|
begin
|
||||||
|
{ Do nothing if called on a not-initialized or destroyed JPEG object. }
|
||||||
|
if (cinfo^.mem = NIL) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
{ Releasing pools in reverse order might help avoid fragmentation
|
||||||
|
with some (brain-damaged) malloc libraries. }
|
||||||
|
|
||||||
|
for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT+1 do
|
||||||
|
begin
|
||||||
|
cinfo^.mem^.free_pool (cinfo, pool);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Reset overall state for possible reuse of object }
|
||||||
|
if (cinfo^.is_decompressor) then
|
||||||
|
begin
|
||||||
|
cinfo^.global_state := DSTATE_START;
|
||||||
|
{ Try to keep application from accessing now-deleted marker list.
|
||||||
|
A bit kludgy to do it here, but this is the most central place. }
|
||||||
|
j_decompress_ptr(cinfo)^.marker_list := NIL;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
cinfo^.global_state := CSTATE_START;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Destruction of a JPEG object.
|
||||||
|
|
||||||
|
Everything gets deallocated except the master jpeg_compress_struct itself
|
||||||
|
and the error manager struct. Both of these are supplied by the application
|
||||||
|
and must be freed, if necessary, by the application. (Often they are on
|
||||||
|
the stack and so don't need to be freed anyway.)
|
||||||
|
Closing a data source or destination, if necessary, is the application's
|
||||||
|
responsibility. }
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_destroy (cinfo : j_common_ptr);
|
||||||
|
begin
|
||||||
|
{ We need only tell the memory manager to release everything. }
|
||||||
|
{ NB: mem pointer is NIL if memory mgr failed to initialize. }
|
||||||
|
if (cinfo^.mem <> NIL) then
|
||||||
|
cinfo^.mem^.self_destruct (cinfo);
|
||||||
|
cinfo^.mem := NIL; { be safe if jpeg_destroy is called twice }
|
||||||
|
cinfo^.global_state := 0; { mark it destroyed }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Convenience routines for allocating quantization and Huffman tables.
|
||||||
|
(Would jutils.c be a more reasonable place to put these?) }
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR;
|
||||||
|
var
|
||||||
|
tbl : JQUANT_TBL_PTR;
|
||||||
|
begin
|
||||||
|
tbl := JQUANT_TBL_PTR(
|
||||||
|
cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JQUANT_TBL))
|
||||||
|
);
|
||||||
|
tbl^.sent_table := FALSE; { make sure this is false in any new table }
|
||||||
|
jpeg_alloc_quant_table := tbl;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR;
|
||||||
|
var
|
||||||
|
tbl : JHUFF_TBL_PTR;
|
||||||
|
begin
|
||||||
|
tbl := JHUFF_TBL_PTR(
|
||||||
|
cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JHUFF_TBL))
|
||||||
|
);
|
||||||
|
tbl^.sent_table := FALSE; { make sure this is false in any new table }
|
||||||
|
jpeg_alloc_huff_table := tbl;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,124 @@
|
||||||
|
{ ----------------------- JPEG_INTERNAL_OPTIONS ---------------------- }
|
||||||
|
|
||||||
|
|
||||||
|
{ These defines indicate whether to include various optional functions.
|
||||||
|
Undefining some of these symbols will produce a smaller but less capable
|
||||||
|
library. Note that you can leave certain source files out of the
|
||||||
|
compilation/linking process if you've #undef'd the corresponding symbols.
|
||||||
|
(You may HAVE to do that if your compiler doesn't like null source files.)}
|
||||||
|
|
||||||
|
|
||||||
|
{ Arithmetic coding is unsupported for legal reasons. Complaints to IBM. }
|
||||||
|
|
||||||
|
{ Capability options common to encoder and decoder: }
|
||||||
|
|
||||||
|
{$define DCT_ISLOW_SUPPORTED} { slow but accurate integer algorithm }
|
||||||
|
{$define DCT_IFAST_SUPPORTED} { faster, less accurate integer method }
|
||||||
|
{$define DCT_FLOAT_SUPPORTED} { floating-point: accurate, fast on fast HW }
|
||||||
|
|
||||||
|
{ Encoder capability options: }
|
||||||
|
|
||||||
|
{$undef C_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? }
|
||||||
|
{$define C_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? }
|
||||||
|
{$define C_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)}
|
||||||
|
{$define ENTROPY_OPT_SUPPORTED} { Optimization of entropy coding parms? }
|
||||||
|
{ Note: if you selected 12-bit data precision, it is dangerous to turn off
|
||||||
|
ENTROPY_OPT_SUPPORTED. The standard Huffman tables are only good for 8-bit
|
||||||
|
precision, so jchuff.c normally uses entropy optimization to compute
|
||||||
|
usable tables for higher precision. If you don't want to do optimization,
|
||||||
|
you'll have to supply different default Huffman tables.
|
||||||
|
The exact same statements apply for progressive JPEG: the default tables
|
||||||
|
don't work for progressive mode. (This may get fixed, however.) }
|
||||||
|
|
||||||
|
{$define INPUT_SMOOTHING_SUPPORTED} { Input image smoothing option? }
|
||||||
|
|
||||||
|
{ Decoder capability options: }
|
||||||
|
|
||||||
|
{$undef D_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? }
|
||||||
|
{$define D_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? }
|
||||||
|
{$define D_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)}
|
||||||
|
{$define SAVE_MARKERS_SUPPORTED} { jpeg_save_markers() needed? }
|
||||||
|
{$define BLOCK_SMOOTHING_SUPPORTED} { Block smoothing? (Progressive only) }
|
||||||
|
{$define IDCT_SCALING_SUPPORTED} { Output rescaling via IDCT? }
|
||||||
|
{$undef UPSAMPLE_SCALING_SUPPORTED} { Output rescaling at upsample stage? }
|
||||||
|
{$define UPSAMPLE_MERGING_SUPPORTED} { Fast path for sloppy upsampling? }
|
||||||
|
{$define QUANT_1PASS_SUPPORTED} { 1-pass color quantization? }
|
||||||
|
{$define QUANT_2PASS_SUPPORTED} { 2-pass color quantization? }
|
||||||
|
|
||||||
|
{ If you happen not to want the image transform support, disable it here }
|
||||||
|
{$define TRANSFORMS_SUPPORTED}
|
||||||
|
|
||||||
|
{ more capability options later, no doubt }
|
||||||
|
|
||||||
|
{$ifopt I+} {$define IOcheck} {$endif}
|
||||||
|
|
||||||
|
{ ------------------------------------------------------------------------ }
|
||||||
|
|
||||||
|
{$define USE_FMEM} { Borland has _fmemcpy() and _fmemset() }
|
||||||
|
|
||||||
|
{$define FMEMCOPY}
|
||||||
|
{$define FMEMZERO}
|
||||||
|
|
||||||
|
{$define DCTSIZE_IS_8} { e.g. unroll the inner loop }
|
||||||
|
{$define RIGHT_SHIFT_IS_UNSIGNED}
|
||||||
|
{$undef AVOID_TABLES}
|
||||||
|
{$undef FAST_DIVIDE}
|
||||||
|
|
||||||
|
{$define BITS_IN_JSAMPLE_IS_8}
|
||||||
|
|
||||||
|
{----------------------------------------------------------------}
|
||||||
|
{ for test of 12 bit JPEG code only. !! }
|
||||||
|
{-- $undef BITS_IN_JSAMPLE_IS_8}
|
||||||
|
{----------------------------------------------------------------}
|
||||||
|
|
||||||
|
//{$define RGB_RED_IS_0}
|
||||||
|
{ !CHANGE: This must be defined for Delphi/Kylix/FPC }
|
||||||
|
{$define RGB_RED_IS_2} { RGB byte order }
|
||||||
|
|
||||||
|
|
||||||
|
{$define RGB_PIXELSIZE_IS_3}
|
||||||
|
{$define SLOW_SHIFT_32}
|
||||||
|
{$undef NO_ZERO_ROW_TEST}
|
||||||
|
|
||||||
|
{$define USE_MSDOS_MEMMGR} { Define this if you use jmemdos.c }
|
||||||
|
{$define XMS_SUPPORTED}
|
||||||
|
{$define EMS_SUPPORTED}
|
||||||
|
|
||||||
|
{$undef MEM_STATS} { Write out memory usage }
|
||||||
|
{$define AM_MEMORY_MANAGER} { we define jvirt_Xarray_control structs }
|
||||||
|
|
||||||
|
{$undef FULL_MAIN_BUFFER_SUPPORTED}
|
||||||
|
|
||||||
|
{$define PROGRESS_REPORT}
|
||||||
|
{$define TWO_FILE_COMMANDLINE}
|
||||||
|
{$undef BMP_SUPPORTED}
|
||||||
|
{$undef PPM_SUPPORTED}
|
||||||
|
{$undef GIF_SUPPORTED}
|
||||||
|
{$undef RLE_SUPPORTED}
|
||||||
|
{$undef TARGA_SUPPORTED}
|
||||||
|
{$define EXT_SWITCH}
|
||||||
|
|
||||||
|
{$ifndef BITS_IN_JSAMPLE_IS_8} { for 12 bit samples }
|
||||||
|
{$undef BMP_SUPPORTED}
|
||||||
|
{$undef RLE_SUPPORTED}
|
||||||
|
{$undef TARGA_SUPPORTED}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{!CHANGE: Allowed only for Delphi}
|
||||||
|
{$undef BASM16} { for TP7 - use BASM for fast multiply }
|
||||||
|
{$ifdef Win32}
|
||||||
|
{$ifndef FPC}
|
||||||
|
{$define BASM} { jidctint with BASM for Delphi 2/3 }
|
||||||
|
{$undef RGB_RED_IS_0} { BGR byte order in JQUANT2 }
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef FPC}
|
||||||
|
{$MODE DELPHI}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{!CHANGE: Added this}
|
||||||
|
{$define Delphi_Stream}
|
||||||
|
{$Q-}
|
||||||
|
|
||||||
|
|
@ -0,0 +1,701 @@
|
||||||
|
unit imjcparam;
|
||||||
|
|
||||||
|
{ This file contains optional default-setting code for the JPEG compressor.
|
||||||
|
Applications do not have to use this file, but those that don't use it
|
||||||
|
must know a lot more about the innards of the JPEG code. }
|
||||||
|
|
||||||
|
{ Original: jcparam.c ; Copyright (C) 1991-1998, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjcomapi,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
{ Quantization table setup routines }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_add_quant_table (cinfo : j_compress_ptr;
|
||||||
|
which_tbl : int;
|
||||||
|
const basic_table : array of uInt;
|
||||||
|
scale_factor : int;
|
||||||
|
force_baseline : boolean);
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_set_linear_quality (cinfo : j_compress_ptr;
|
||||||
|
scale_factor : int;
|
||||||
|
force_baseline : boolean);
|
||||||
|
{ Set or change the 'quality' (quantization) setting, using default tables
|
||||||
|
and a straight percentage-scaling quality scale. In most cases it's better
|
||||||
|
to use jpeg_set_quality (below); this entry point is provided for
|
||||||
|
applications that insist on a linear percentage scaling. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_quality_scaling (quality : int) : int;
|
||||||
|
{ Convert a user-specified quality rating to a percentage scaling factor
|
||||||
|
for an underlying quantization table, using our recommended scaling curve.
|
||||||
|
The input 'quality' factor should be 0 (terrible) to 100 (very good). }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_set_quality (cinfo : j_compress_ptr;
|
||||||
|
quality : int;
|
||||||
|
force_baseline : boolean);
|
||||||
|
{ Set or change the 'quality' (quantization) setting, using default tables.
|
||||||
|
This is the standard quality-adjusting entry point for typical user
|
||||||
|
interfaces; only those who want detailed control over quantization tables
|
||||||
|
would use the preceding three routines directly. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_set_defaults (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
{ Create a recommended progressive-JPEG script.
|
||||||
|
cinfo^.num_components and cinfo^.jpeg_color_space must be correct. }
|
||||||
|
|
||||||
|
{ Set the JPEG colorspace, and choose colorspace-dependent default values. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_set_colorspace (cinfo : j_compress_ptr;
|
||||||
|
colorspace : J_COLOR_SPACE);
|
||||||
|
|
||||||
|
{ Select an appropriate JPEG colorspace for in_color_space. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_default_colorspace (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_simple_progression (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Quantization table setup routines }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_add_quant_table (cinfo : j_compress_ptr;
|
||||||
|
which_tbl : int;
|
||||||
|
const basic_table : array of uInt;
|
||||||
|
scale_factor : int;
|
||||||
|
force_baseline : boolean);
|
||||||
|
{ Define a quantization table equal to the basic_table times
|
||||||
|
a scale factor (given as a percentage).
|
||||||
|
If force_baseline is TRUE, the computed quantization table entries
|
||||||
|
are limited to 1..255 for JPEG baseline compatibility. }
|
||||||
|
var
|
||||||
|
qtblptr :^JQUANT_TBL_PTR;
|
||||||
|
i : int;
|
||||||
|
temp : long;
|
||||||
|
begin
|
||||||
|
{ Safety check to ensure start_compress not called yet. }
|
||||||
|
if (cinfo^.global_state <> CSTATE_START) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
if (which_tbl < 0) or (which_tbl >= NUM_QUANT_TBLS) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_DQT_INDEX, which_tbl);
|
||||||
|
|
||||||
|
qtblptr := @(cinfo^.quant_tbl_ptrs[which_tbl]);
|
||||||
|
|
||||||
|
if (qtblptr^ = NIL) then
|
||||||
|
qtblptr^ := jpeg_alloc_quant_table(j_common_ptr(cinfo));
|
||||||
|
|
||||||
|
for i := 0 to pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
temp := (long(basic_table[i]) * scale_factor + long(50)) div long(100);
|
||||||
|
{ limit the values to the valid range }
|
||||||
|
if (temp <= long(0)) then
|
||||||
|
temp := long(1);
|
||||||
|
if (temp > long(32767)) then
|
||||||
|
temp := long(32767); { max quantizer needed for 12 bits }
|
||||||
|
if (force_baseline) and (temp > long(255)) then
|
||||||
|
temp := long(255); { limit to baseline range if requested }
|
||||||
|
(qtblptr^)^.quantval[i] := UINT16 (temp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Initialize sent_table FALSE so table will be written to JPEG file. }
|
||||||
|
(qtblptr^)^.sent_table := FALSE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_set_linear_quality (cinfo : j_compress_ptr;
|
||||||
|
scale_factor : int;
|
||||||
|
force_baseline : boolean);
|
||||||
|
{ Set or change the 'quality' (quantization) setting, using default tables
|
||||||
|
and a straight percentage-scaling quality scale. In most cases it's better
|
||||||
|
to use jpeg_set_quality (below); this entry point is provided for
|
||||||
|
applications that insist on a linear percentage scaling. }
|
||||||
|
|
||||||
|
{ These are the sample quantization tables given in JPEG spec section K.1.
|
||||||
|
The spec says that the values given produce "good" quality, and
|
||||||
|
when divided by 2, "very good" quality. }
|
||||||
|
|
||||||
|
const
|
||||||
|
std_luminance_quant_tbl : array[0..DCTSIZE2-1] of uInt =
|
||||||
|
(16, 11, 10, 16, 24, 40, 51, 61,
|
||||||
|
12, 12, 14, 19, 26, 58, 60, 55,
|
||||||
|
14, 13, 16, 24, 40, 57, 69, 56,
|
||||||
|
14, 17, 22, 29, 51, 87, 80, 62,
|
||||||
|
18, 22, 37, 56, 68, 109, 103, 77,
|
||||||
|
24, 35, 55, 64, 81, 104, 113, 92,
|
||||||
|
49, 64, 78, 87, 103, 121, 120, 101,
|
||||||
|
72, 92, 95, 98, 112, 100, 103, 99);
|
||||||
|
|
||||||
|
const
|
||||||
|
std_chrominance_quant_tbl : array[0..DCTSIZE2-1] of uInt =
|
||||||
|
(17, 18, 24, 47, 99, 99, 99, 99,
|
||||||
|
18, 21, 26, 66, 99, 99, 99, 99,
|
||||||
|
24, 26, 56, 99, 99, 99, 99, 99,
|
||||||
|
47, 66, 99, 99, 99, 99, 99, 99,
|
||||||
|
99, 99, 99, 99, 99, 99, 99, 99,
|
||||||
|
99, 99, 99, 99, 99, 99, 99, 99,
|
||||||
|
99, 99, 99, 99, 99, 99, 99, 99,
|
||||||
|
99, 99, 99, 99, 99, 99, 99, 99);
|
||||||
|
begin
|
||||||
|
{ Set up two quantization tables using the specified scaling }
|
||||||
|
jpeg_add_quant_table(cinfo, 0, std_luminance_quant_tbl,
|
||||||
|
scale_factor, force_baseline);
|
||||||
|
jpeg_add_quant_table(cinfo, 1, std_chrominance_quant_tbl,
|
||||||
|
scale_factor, force_baseline);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_quality_scaling (quality : int) : int;
|
||||||
|
{ Convert a user-specified quality rating to a percentage scaling factor
|
||||||
|
for an underlying quantization table, using our recommended scaling curve.
|
||||||
|
The input 'quality' factor should be 0 (terrible) to 100 (very good). }
|
||||||
|
begin
|
||||||
|
{ Safety limit on quality factor. Convert 0 to 1 to avoid zero divide. }
|
||||||
|
if (quality <= 0) then
|
||||||
|
quality := 1;
|
||||||
|
if (quality > 100) then
|
||||||
|
quality := 100;
|
||||||
|
|
||||||
|
{ The basic table is used as-is (scaling 100) for a quality of 50.
|
||||||
|
Qualities 50..100 are converted to scaling percentage 200 - 2*Q;
|
||||||
|
note that at Q=100 the scaling is 0, which will cause jpeg_add_quant_table
|
||||||
|
to make all the table entries 1 (hence, minimum quantization loss).
|
||||||
|
Qualities 1..50 are converted to scaling percentage 5000/Q. }
|
||||||
|
if (quality < 50) then
|
||||||
|
quality := 5000 div quality
|
||||||
|
else
|
||||||
|
quality := 200 - quality*2;
|
||||||
|
|
||||||
|
jpeg_quality_scaling := quality;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_set_quality (cinfo : j_compress_ptr;
|
||||||
|
quality : int;
|
||||||
|
force_baseline : boolean);
|
||||||
|
{ Set or change the 'quality' (quantization) setting, using default tables.
|
||||||
|
This is the standard quality-adjusting entry point for typical user
|
||||||
|
interfaces; only those who want detailed control over quantization tables
|
||||||
|
would use the preceding three routines directly. }
|
||||||
|
begin
|
||||||
|
{ Convert user 0-100 rating to percentage scaling }
|
||||||
|
quality := jpeg_quality_scaling(quality);
|
||||||
|
|
||||||
|
{ Set up standard quality tables }
|
||||||
|
jpeg_set_linear_quality(cinfo, quality, force_baseline);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Huffman table setup routines }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure add_huff_table (cinfo : j_compress_ptr;
|
||||||
|
var htblptr : JHUFF_TBL_PTR;
|
||||||
|
var bits : array of UINT8;
|
||||||
|
var val : array of UINT8);
|
||||||
|
{ Define a Huffman table }
|
||||||
|
var
|
||||||
|
nsymbols, len : int;
|
||||||
|
begin
|
||||||
|
if (htblptr = NIL) then
|
||||||
|
htblptr := jpeg_alloc_huff_table(j_common_ptr(cinfo));
|
||||||
|
|
||||||
|
{ Copy the number-of-symbols-of-each-code-length counts }
|
||||||
|
MEMCOPY(@htblptr^.bits, @bits, SIZEOF(htblptr^.bits));
|
||||||
|
|
||||||
|
|
||||||
|
{ Validate the counts. We do this here mainly so we can copy the right
|
||||||
|
number of symbols from the val[] array, without risking marching off
|
||||||
|
the end of memory. jchuff.c will do a more thorough test later. }
|
||||||
|
|
||||||
|
nsymbols := 0;
|
||||||
|
for len := 1 to 16 do
|
||||||
|
Inc(nsymbols, bits[len]);
|
||||||
|
if (nsymbols < 1) or (nsymbols > 256) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE);
|
||||||
|
|
||||||
|
MEMCOPY(@htblptr^.huffval, @val, nsymbols * SIZEOF(UINT8));
|
||||||
|
|
||||||
|
{ Initialize sent_table FALSE so table will be written to JPEG file. }
|
||||||
|
(htblptr)^.sent_table := FALSE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$J+}
|
||||||
|
{LOCAL}
|
||||||
|
procedure std_huff_tables (cinfo : j_compress_ptr);
|
||||||
|
{ Set up the standard Huffman tables (cf. JPEG standard section K.3) }
|
||||||
|
{ IMPORTANT: these are only valid for 8-bit data precision! }
|
||||||
|
const bits_dc_luminance : array[0..17-1] of UINT8 =
|
||||||
|
({ 0-base } 0, 0, 1, 5, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0);
|
||||||
|
const val_dc_luminance : array[0..11] of UINT8 =
|
||||||
|
(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11);
|
||||||
|
|
||||||
|
const bits_dc_chrominance : array[0..17-1] of UINT8 =
|
||||||
|
( { 0-base } 0, 0, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 );
|
||||||
|
const val_dc_chrominance : array[0..11] of UINT8 =
|
||||||
|
( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 );
|
||||||
|
|
||||||
|
const bits_ac_luminance : array[0..17-1] of UINT8 =
|
||||||
|
( { 0-base } 0, 0, 2, 1, 3, 3, 2, 4, 3, 5, 5, 4, 4, 0, 0, 1, $7d );
|
||||||
|
const val_ac_luminance : array[0..161] of UINT8 =
|
||||||
|
( $01, $02, $03, $00, $04, $11, $05, $12,
|
||||||
|
$21, $31, $41, $06, $13, $51, $61, $07,
|
||||||
|
$22, $71, $14, $32, $81, $91, $a1, $08,
|
||||||
|
$23, $42, $b1, $c1, $15, $52, $d1, $f0,
|
||||||
|
$24, $33, $62, $72, $82, $09, $0a, $16,
|
||||||
|
$17, $18, $19, $1a, $25, $26, $27, $28,
|
||||||
|
$29, $2a, $34, $35, $36, $37, $38, $39,
|
||||||
|
$3a, $43, $44, $45, $46, $47, $48, $49,
|
||||||
|
$4a, $53, $54, $55, $56, $57, $58, $59,
|
||||||
|
$5a, $63, $64, $65, $66, $67, $68, $69,
|
||||||
|
$6a, $73, $74, $75, $76, $77, $78, $79,
|
||||||
|
$7a, $83, $84, $85, $86, $87, $88, $89,
|
||||||
|
$8a, $92, $93, $94, $95, $96, $97, $98,
|
||||||
|
$99, $9a, $a2, $a3, $a4, $a5, $a6, $a7,
|
||||||
|
$a8, $a9, $aa, $b2, $b3, $b4, $b5, $b6,
|
||||||
|
$b7, $b8, $b9, $ba, $c2, $c3, $c4, $c5,
|
||||||
|
$c6, $c7, $c8, $c9, $ca, $d2, $d3, $d4,
|
||||||
|
$d5, $d6, $d7, $d8, $d9, $da, $e1, $e2,
|
||||||
|
$e3, $e4, $e5, $e6, $e7, $e8, $e9, $ea,
|
||||||
|
$f1, $f2, $f3, $f4, $f5, $f6, $f7, $f8,
|
||||||
|
$f9, $fa );
|
||||||
|
|
||||||
|
const bits_ac_chrominance : array[0..17-1] of UINT8 =
|
||||||
|
( { 0-base } 0, 0, 2, 1, 2, 4, 4, 3, 4, 7, 5, 4, 4, 0, 1, 2, $77 );
|
||||||
|
const val_ac_chrominance : array[0..161] of UINT8 =
|
||||||
|
( $00, $01, $02, $03, $11, $04, $05, $21,
|
||||||
|
$31, $06, $12, $41, $51, $07, $61, $71,
|
||||||
|
$13, $22, $32, $81, $08, $14, $42, $91,
|
||||||
|
$a1, $b1, $c1, $09, $23, $33, $52, $f0,
|
||||||
|
$15, $62, $72, $d1, $0a, $16, $24, $34,
|
||||||
|
$e1, $25, $f1, $17, $18, $19, $1a, $26,
|
||||||
|
$27, $28, $29, $2a, $35, $36, $37, $38,
|
||||||
|
$39, $3a, $43, $44, $45, $46, $47, $48,
|
||||||
|
$49, $4a, $53, $54, $55, $56, $57, $58,
|
||||||
|
$59, $5a, $63, $64, $65, $66, $67, $68,
|
||||||
|
$69, $6a, $73, $74, $75, $76, $77, $78,
|
||||||
|
$79, $7a, $82, $83, $84, $85, $86, $87,
|
||||||
|
$88, $89, $8a, $92, $93, $94, $95, $96,
|
||||||
|
$97, $98, $99, $9a, $a2, $a3, $a4, $a5,
|
||||||
|
$a6, $a7, $a8, $a9, $aa, $b2, $b3, $b4,
|
||||||
|
$b5, $b6, $b7, $b8, $b9, $ba, $c2, $c3,
|
||||||
|
$c4, $c5, $c6, $c7, $c8, $c9, $ca, $d2,
|
||||||
|
$d3, $d4, $d5, $d6, $d7, $d8, $d9, $da,
|
||||||
|
$e2, $e3, $e4, $e5, $e6, $e7, $e8, $e9,
|
||||||
|
$ea, $f2, $f3, $f4, $f5, $f6, $f7, $f8,
|
||||||
|
$f9, $fa );
|
||||||
|
begin
|
||||||
|
add_huff_table(cinfo, cinfo^.dc_huff_tbl_ptrs[0],
|
||||||
|
bits_dc_luminance, val_dc_luminance);
|
||||||
|
add_huff_table(cinfo, cinfo^.ac_huff_tbl_ptrs[0],
|
||||||
|
bits_ac_luminance, val_ac_luminance);
|
||||||
|
add_huff_table(cinfo, cinfo^.dc_huff_tbl_ptrs[1],
|
||||||
|
bits_dc_chrominance, val_dc_chrominance);
|
||||||
|
add_huff_table(cinfo, cinfo^.ac_huff_tbl_ptrs[1],
|
||||||
|
bits_ac_chrominance, val_ac_chrominance);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Default parameter setup for compression.
|
||||||
|
|
||||||
|
Applications that don't choose to use this routine must do their
|
||||||
|
own setup of all these parameters. Alternately, you can call this
|
||||||
|
to establish defaults and then alter parameters selectively. This
|
||||||
|
is the recommended approach since, if we add any new parameters,
|
||||||
|
your code will still work (they'll be set to reasonable defaults). }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_set_defaults (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
i : int;
|
||||||
|
begin
|
||||||
|
{ Safety check to ensure start_compress not called yet. }
|
||||||
|
if (cinfo^.global_state <> CSTATE_START) then
|
||||||
|
ERREXIT1(J_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
{ Allocate comp_info array large enough for maximum component count.
|
||||||
|
Array is made permanent in case application wants to compress
|
||||||
|
multiple images at same param settings. }
|
||||||
|
|
||||||
|
if (cinfo^.comp_info = NIL) then
|
||||||
|
cinfo^.comp_info := jpeg_component_info_list_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
|
||||||
|
MAX_COMPONENTS * SIZEOF(jpeg_component_info)) );
|
||||||
|
|
||||||
|
{ Initialize everything not dependent on the color space }
|
||||||
|
|
||||||
|
cinfo^.data_precision := BITS_IN_JSAMPLE;
|
||||||
|
{ Set up two quantization tables using default quality of 75 }
|
||||||
|
jpeg_set_quality(cinfo, 75, TRUE);
|
||||||
|
{ Set up two Huffman tables }
|
||||||
|
std_huff_tables(cinfo);
|
||||||
|
|
||||||
|
{ Initialize default arithmetic coding conditioning }
|
||||||
|
for i := 0 to pred(NUM_ARITH_TBLS) do
|
||||||
|
begin
|
||||||
|
cinfo^.arith_dc_L[i] := 0;
|
||||||
|
cinfo^.arith_dc_U[i] := 1;
|
||||||
|
cinfo^.arith_ac_K[i] := 5;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Default is no multiple-scan output }
|
||||||
|
cinfo^.scan_info := NIL;
|
||||||
|
cinfo^.num_scans := 0;
|
||||||
|
|
||||||
|
{ Expect normal source image, not raw downsampled data }
|
||||||
|
cinfo^.raw_data_in := FALSE;
|
||||||
|
|
||||||
|
{ Use Huffman coding, not arithmetic coding, by default }
|
||||||
|
cinfo^.arith_code := FALSE;
|
||||||
|
|
||||||
|
{ By default, don't do extra passes to optimize entropy coding }
|
||||||
|
cinfo^.optimize_coding := FALSE;
|
||||||
|
{ The standard Huffman tables are only valid for 8-bit data precision.
|
||||||
|
If the precision is higher, force optimization on so that usable
|
||||||
|
tables will be computed. This test can be removed if default tables
|
||||||
|
are supplied that are valid for the desired precision. }
|
||||||
|
|
||||||
|
if (cinfo^.data_precision > 8) then
|
||||||
|
cinfo^.optimize_coding := TRUE;
|
||||||
|
|
||||||
|
{ By default, use the simpler non-cosited sampling alignment }
|
||||||
|
cinfo^.CCIR601_sampling := FALSE;
|
||||||
|
|
||||||
|
{ No input smoothing }
|
||||||
|
cinfo^.smoothing_factor := 0;
|
||||||
|
|
||||||
|
{ DCT algorithm preference }
|
||||||
|
cinfo^.dct_method := JDCT_DEFAULT;
|
||||||
|
|
||||||
|
{ No restart markers }
|
||||||
|
cinfo^.restart_interval := 0;
|
||||||
|
cinfo^.restart_in_rows := 0;
|
||||||
|
|
||||||
|
{ Fill in default JFIF marker parameters. Note that whether the marker
|
||||||
|
will actually be written is determined by jpeg_set_colorspace.
|
||||||
|
|
||||||
|
By default, the library emits JFIF version code 1.01.
|
||||||
|
An application that wants to emit JFIF 1.02 extension markers should set
|
||||||
|
JFIF_minor_version to 2. We could probably get away with just defaulting
|
||||||
|
to 1.02, but there may still be some decoders in use that will complain
|
||||||
|
about that; saying 1.01 should minimize compatibility problems. }
|
||||||
|
|
||||||
|
cinfo^.JFIF_major_version := 1; { Default JFIF version = 1.01 }
|
||||||
|
cinfo^.JFIF_minor_version := 1;
|
||||||
|
cinfo^.density_unit := 0; { Pixel size is unknown by default }
|
||||||
|
cinfo^.X_density := 1; { Pixel aspect ratio is square by default }
|
||||||
|
cinfo^.Y_density := 1;
|
||||||
|
|
||||||
|
{ Choose JPEG colorspace based on input space, set defaults accordingly }
|
||||||
|
|
||||||
|
jpeg_default_colorspace(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Select an appropriate JPEG colorspace for in_color_space. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_default_colorspace (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
case (cinfo^.in_color_space) of
|
||||||
|
JCS_GRAYSCALE:
|
||||||
|
jpeg_set_colorspace(cinfo, JCS_GRAYSCALE);
|
||||||
|
JCS_RGB:
|
||||||
|
jpeg_set_colorspace(cinfo, JCS_YCbCr);
|
||||||
|
JCS_YCbCr:
|
||||||
|
jpeg_set_colorspace(cinfo, JCS_YCbCr);
|
||||||
|
JCS_CMYK:
|
||||||
|
jpeg_set_colorspace(cinfo, JCS_CMYK); { By default, no translation }
|
||||||
|
JCS_YCCK:
|
||||||
|
jpeg_set_colorspace(cinfo, JCS_YCCK);
|
||||||
|
JCS_UNKNOWN:
|
||||||
|
jpeg_set_colorspace(cinfo, JCS_UNKNOWN);
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Set the JPEG colorspace, and choose colorspace-dependent default values. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_set_colorspace (cinfo : j_compress_ptr;
|
||||||
|
colorspace : J_COLOR_SPACE);
|
||||||
|
{ macro }
|
||||||
|
procedure SET_COMP(index,id,hsamp,vsamp,quant,dctbl,actbl : int);
|
||||||
|
begin
|
||||||
|
with cinfo^.comp_info^[index] do
|
||||||
|
begin
|
||||||
|
component_id := (id);
|
||||||
|
h_samp_factor := (hsamp);
|
||||||
|
v_samp_factor := (vsamp);
|
||||||
|
quant_tbl_no := (quant);
|
||||||
|
dc_tbl_no := (dctbl);
|
||||||
|
ac_tbl_no := (actbl);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
begin
|
||||||
|
{ Safety check to ensure start_compress not called yet. }
|
||||||
|
if (cinfo^.global_state <> CSTATE_START) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
{ For all colorspaces, we use Q and Huff tables 0 for luminance components,
|
||||||
|
tables 1 for chrominance components. }
|
||||||
|
|
||||||
|
cinfo^.jpeg_color_space := colorspace;
|
||||||
|
|
||||||
|
cinfo^.write_JFIF_header := FALSE; { No marker for non-JFIF colorspaces }
|
||||||
|
cinfo^.write_Adobe_marker := FALSE; { write no Adobe marker by default }
|
||||||
|
|
||||||
|
case (colorspace) of
|
||||||
|
JCS_GRAYSCALE:
|
||||||
|
begin
|
||||||
|
cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker }
|
||||||
|
cinfo^.num_components := 1;
|
||||||
|
{ JFIF specifies component ID 1 }
|
||||||
|
SET_COMP(0, 1, 1,1, 0, 0,0);
|
||||||
|
end;
|
||||||
|
JCS_RGB:
|
||||||
|
begin
|
||||||
|
cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag RGB }
|
||||||
|
cinfo^.num_components := 3;
|
||||||
|
SET_COMP(0, $52 { 'R' }, 1,1, 0, 0,0);
|
||||||
|
SET_COMP(1, $47 { 'G' }, 1,1, 0, 0,0);
|
||||||
|
SET_COMP(2, $42 { 'B' }, 1,1, 0, 0,0);
|
||||||
|
end;
|
||||||
|
JCS_YCbCr:
|
||||||
|
begin
|
||||||
|
cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker }
|
||||||
|
cinfo^.num_components := 3;
|
||||||
|
{ JFIF specifies component IDs 1,2,3 }
|
||||||
|
{ We default to 2x2 subsamples of chrominance }
|
||||||
|
SET_COMP(0, 1, 2,2, 0, 0,0);
|
||||||
|
SET_COMP(1, 2, 1,1, 1, 1,1);
|
||||||
|
SET_COMP(2, 3, 1,1, 1, 1,1);
|
||||||
|
end;
|
||||||
|
JCS_CMYK:
|
||||||
|
begin
|
||||||
|
cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag CMYK }
|
||||||
|
cinfo^.num_components := 4;
|
||||||
|
SET_COMP(0, $43 { 'C' }, 1,1, 0, 0,0);
|
||||||
|
SET_COMP(1, $4D { 'M' }, 1,1, 0, 0,0);
|
||||||
|
SET_COMP(2, $59 { 'Y' }, 1,1, 0, 0,0);
|
||||||
|
SET_COMP(3, $4B { 'K' }, 1,1, 0, 0,0);
|
||||||
|
end;
|
||||||
|
JCS_YCCK:
|
||||||
|
begin
|
||||||
|
cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag YCCK }
|
||||||
|
cinfo^.num_components := 4;
|
||||||
|
SET_COMP(0, 1, 2,2, 0, 0,0);
|
||||||
|
SET_COMP(1, 2, 1,1, 1, 1,1);
|
||||||
|
SET_COMP(2, 3, 1,1, 1, 1,1);
|
||||||
|
SET_COMP(3, 4, 2,2, 0, 0,0);
|
||||||
|
end;
|
||||||
|
JCS_UNKNOWN:
|
||||||
|
begin
|
||||||
|
cinfo^.num_components := cinfo^.input_components;
|
||||||
|
if (cinfo^.num_components < 1)
|
||||||
|
or (cinfo^.num_components > MAX_COMPONENTS) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT,
|
||||||
|
cinfo^.num_components, MAX_COMPONENTS);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
SET_COMP(ci, ci, 1,1, 0, 0,0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef C_PROGRESSIVE_SUPPORTED}
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
function fill_a_scan (scanptr : jpeg_scan_info_ptr;
|
||||||
|
ci : int; Ss : int;
|
||||||
|
Se : int; Ah : int;
|
||||||
|
Al : int) : jpeg_scan_info_ptr;
|
||||||
|
{ Support routine: generate one scan for specified component }
|
||||||
|
begin
|
||||||
|
scanptr^.comps_in_scan := 1;
|
||||||
|
scanptr^.component_index[0] := ci;
|
||||||
|
scanptr^.Ss := Ss;
|
||||||
|
scanptr^.Se := Se;
|
||||||
|
scanptr^.Ah := Ah;
|
||||||
|
scanptr^.Al := Al;
|
||||||
|
Inc(scanptr);
|
||||||
|
fill_a_scan := scanptr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
function fill_scans (scanptr : jpeg_scan_info_ptr;
|
||||||
|
ncomps : int;
|
||||||
|
Ss : int; Se : int;
|
||||||
|
Ah : int; Al : int) : jpeg_scan_info_ptr;
|
||||||
|
{ Support routine: generate one scan for each component }
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
begin
|
||||||
|
|
||||||
|
for ci := 0 to pred(ncomps) do
|
||||||
|
begin
|
||||||
|
scanptr^.comps_in_scan := 1;
|
||||||
|
scanptr^.component_index[0] := ci;
|
||||||
|
scanptr^.Ss := Ss;
|
||||||
|
scanptr^.Se := Se;
|
||||||
|
scanptr^.Ah := Ah;
|
||||||
|
scanptr^.Al := Al;
|
||||||
|
Inc(scanptr);
|
||||||
|
end;
|
||||||
|
fill_scans := scanptr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
function fill_dc_scans (scanptr : jpeg_scan_info_ptr;
|
||||||
|
ncomps : int;
|
||||||
|
Ah : int; Al : int) : jpeg_scan_info_ptr;
|
||||||
|
{ Support routine: generate interleaved DC scan if possible, else N scans }
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
begin
|
||||||
|
|
||||||
|
if (ncomps <= MAX_COMPS_IN_SCAN) then
|
||||||
|
begin
|
||||||
|
{ Single interleaved DC scan }
|
||||||
|
scanptr^.comps_in_scan := ncomps;
|
||||||
|
for ci := 0 to pred(ncomps) do
|
||||||
|
scanptr^.component_index[ci] := ci;
|
||||||
|
scanptr^.Ss := 0;
|
||||||
|
scanptr^.Se := 0;
|
||||||
|
scanptr^.Ah := Ah;
|
||||||
|
scanptr^.Al := Al;
|
||||||
|
Inc(scanptr);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Noninterleaved DC scan for each component }
|
||||||
|
scanptr := fill_scans(scanptr, ncomps, 0, 0, Ah, Al);
|
||||||
|
end;
|
||||||
|
fill_dc_scans := scanptr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Create a recommended progressive-JPEG script.
|
||||||
|
cinfo^.num_components and cinfo^.jpeg_color_space must be correct. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_simple_progression (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
ncomps : int;
|
||||||
|
nscans : int;
|
||||||
|
scanptr : jpeg_scan_info_ptr;
|
||||||
|
begin
|
||||||
|
ncomps := cinfo^.num_components;
|
||||||
|
|
||||||
|
{ Safety check to ensure start_compress not called yet. }
|
||||||
|
if (cinfo^.global_state <> CSTATE_START) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
{ Figure space needed for script. Calculation must match code below! }
|
||||||
|
if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then
|
||||||
|
begin
|
||||||
|
{ Custom script for YCbCr color images. }
|
||||||
|
nscans := 10;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ All-purpose script for other color spaces. }
|
||||||
|
if (ncomps > MAX_COMPS_IN_SCAN) then
|
||||||
|
nscans := 6 * ncomps { 2 DC + 4 AC scans per component }
|
||||||
|
else
|
||||||
|
nscans := 2 + 4 * ncomps; { 2 DC scans; 4 AC scans per component }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Allocate space for script.
|
||||||
|
We need to put it in the permanent pool in case the application performs
|
||||||
|
multiple compressions without changing the settings. To avoid a memory
|
||||||
|
leak if jpeg_simple_progression is called repeatedly for the same JPEG
|
||||||
|
object, we try to re-use previously allocated space, and we allocate
|
||||||
|
enough space to handle YCbCr even if initially asked for grayscale. }
|
||||||
|
|
||||||
|
if (cinfo^.script_space = NIL) or (cinfo^.script_space_size < nscans) then
|
||||||
|
begin
|
||||||
|
if nscans > 10 then
|
||||||
|
cinfo^.script_space_size := nscans
|
||||||
|
else
|
||||||
|
cinfo^.script_space_size := 10;
|
||||||
|
|
||||||
|
cinfo^.script_space := jpeg_scan_info_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
|
||||||
|
cinfo^.script_space_size * SIZEOF(jpeg_scan_info)) );
|
||||||
|
end;
|
||||||
|
scanptr := cinfo^.script_space;
|
||||||
|
|
||||||
|
cinfo^.scan_info := scanptr;
|
||||||
|
cinfo^.num_scans := nscans;
|
||||||
|
|
||||||
|
if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then
|
||||||
|
begin
|
||||||
|
{ Custom script for YCbCr color images. }
|
||||||
|
{ Initial DC scan }
|
||||||
|
scanptr := fill_dc_scans(scanptr, ncomps, 0, 1);
|
||||||
|
{ Initial AC scan: get some luma data out in a hurry }
|
||||||
|
scanptr := fill_a_scan(scanptr, 0, 1, 5, 0, 2);
|
||||||
|
{ Chroma data is too small to be worth expending many scans on }
|
||||||
|
scanptr := fill_a_scan(scanptr, 2, 1, 63, 0, 1);
|
||||||
|
scanptr := fill_a_scan(scanptr, 1, 1, 63, 0, 1);
|
||||||
|
{ Complete spectral selection for luma AC }
|
||||||
|
scanptr := fill_a_scan(scanptr, 0, 6, 63, 0, 2);
|
||||||
|
{ Refine next bit of luma AC }
|
||||||
|
scanptr := fill_a_scan(scanptr, 0, 1, 63, 2, 1);
|
||||||
|
{ Finish DC successive approximation }
|
||||||
|
scanptr := fill_dc_scans(scanptr, ncomps, 1, 0);
|
||||||
|
{ Finish AC successive approximation }
|
||||||
|
scanptr := fill_a_scan(scanptr, 2, 1, 63, 1, 0);
|
||||||
|
scanptr := fill_a_scan(scanptr, 1, 1, 63, 1, 0);
|
||||||
|
{ Luma bottom bit comes last since it's usually largest scan }
|
||||||
|
scanptr := fill_a_scan(scanptr, 0, 1, 63, 1, 0);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ All-purpose script for other color spaces. }
|
||||||
|
{ Successive approximation first pass }
|
||||||
|
scanptr := fill_dc_scans(scanptr, ncomps, 0, 1);
|
||||||
|
scanptr := fill_scans(scanptr, ncomps, 1, 5, 0, 2);
|
||||||
|
scanptr := fill_scans(scanptr, ncomps, 6, 63, 0, 2);
|
||||||
|
{ Successive approximation second pass }
|
||||||
|
scanptr := fill_scans(scanptr, ncomps, 1, 63, 2, 1);
|
||||||
|
{ Successive approximation final pass }
|
||||||
|
scanptr := fill_dc_scans(scanptr, ncomps, 1, 0);
|
||||||
|
scanptr := fill_scans(scanptr, ncomps, 1, 63, 1, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif}
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,962 @@
|
||||||
|
unit imjcphuff;
|
||||||
|
|
||||||
|
{ This file contains Huffman entropy encoding routines for progressive JPEG.
|
||||||
|
|
||||||
|
We do not support output suspension in this module, since the library
|
||||||
|
currently does not allow multiple-scan files to be written with output
|
||||||
|
suspension. }
|
||||||
|
|
||||||
|
{ Original: jcphuff.c; Copyright (C) 1995-1997, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjpeglib,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjutils,
|
||||||
|
imjcomapi,
|
||||||
|
imjchuff; { Declarations shared with jchuff.c }
|
||||||
|
|
||||||
|
{ Module initialization routine for progressive Huffman entropy encoding. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_phuff_encoder (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Expanded entropy encoder object for progressive Huffman encoding. }
|
||||||
|
type
|
||||||
|
phuff_entropy_ptr = ^phuff_entropy_encoder;
|
||||||
|
phuff_entropy_encoder = record
|
||||||
|
pub : jpeg_entropy_encoder; { public fields }
|
||||||
|
|
||||||
|
{ Mode flag: TRUE for optimization, FALSE for actual data output }
|
||||||
|
gather_statistics : boolean;
|
||||||
|
|
||||||
|
{ Bit-level coding status.
|
||||||
|
next_output_byte/free_in_buffer are local copies of cinfo^.dest fields.}
|
||||||
|
|
||||||
|
next_output_byte : JOCTETptr; { => next byte to write in buffer }
|
||||||
|
free_in_buffer : size_t; { # of byte spaces remaining in buffer }
|
||||||
|
put_buffer : INT32; { current bit-accumulation buffer }
|
||||||
|
put_bits : int; { # of bits now in it }
|
||||||
|
cinfo : j_compress_ptr; { link to cinfo (needed for dump_buffer) }
|
||||||
|
|
||||||
|
{ Coding status for DC components }
|
||||||
|
last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int;
|
||||||
|
{ last DC coef for each component }
|
||||||
|
|
||||||
|
{ Coding status for AC components }
|
||||||
|
ac_tbl_no : int; { the table number of the single component }
|
||||||
|
EOBRUN : uInt; { run length of EOBs }
|
||||||
|
BE : uInt; { # of buffered correction bits before MCU }
|
||||||
|
bit_buffer : JBytePtr; { buffer for correction bits (1 per char) }
|
||||||
|
{ packing correction bits tightly would save some space but cost time... }
|
||||||
|
|
||||||
|
restarts_to_go : uInt; { MCUs left in this restart interval }
|
||||||
|
next_restart_num : int; { next restart number to write (0-7) }
|
||||||
|
|
||||||
|
{ Pointers to derived tables (these workspaces have image lifespan).
|
||||||
|
Since any one scan codes only DC or only AC, we only need one set
|
||||||
|
of tables, not one for DC and one for AC. }
|
||||||
|
|
||||||
|
derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr;
|
||||||
|
|
||||||
|
{ Statistics tables for optimization; again, one set is enough }
|
||||||
|
count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ MAX_CORR_BITS is the number of bits the AC refinement correction-bit
|
||||||
|
buffer can hold. Larger sizes may slightly improve compression, but
|
||||||
|
1000 is already well into the realm of overkill.
|
||||||
|
The minimum safe size is 64 bits. }
|
||||||
|
|
||||||
|
const
|
||||||
|
MAX_CORR_BITS = 1000; { Max # of correction bits I can buffer }
|
||||||
|
|
||||||
|
|
||||||
|
{ Forward declarations }
|
||||||
|
{METHODDEF}
|
||||||
|
function encode_mcu_DC_first (cinfo : j_compress_ptr;
|
||||||
|
const MCU_data: array of JBLOCKROW) : boolean;
|
||||||
|
forward;
|
||||||
|
{METHODDEF}
|
||||||
|
function encode_mcu_AC_first (cinfo : j_compress_ptr;
|
||||||
|
const MCU_data: array of JBLOCKROW) : boolean;
|
||||||
|
forward;
|
||||||
|
{METHODDEF}
|
||||||
|
function encode_mcu_DC_refine (cinfo : j_compress_ptr;
|
||||||
|
const MCU_data: array of JBLOCKROW) : boolean;
|
||||||
|
forward;
|
||||||
|
{METHODDEF}
|
||||||
|
function encode_mcu_AC_refine (cinfo : j_compress_ptr;
|
||||||
|
const MCU_data: array of JBLOCKROW) : boolean;
|
||||||
|
forward;
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure finish_pass_phuff (cinfo : j_compress_ptr); forward;
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure finish_pass_gather_phuff (cinfo : j_compress_ptr); forward;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for a Huffman-compressed scan using progressive JPEG. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass_phuff (cinfo : j_compress_ptr;
|
||||||
|
gather_statistics : boolean);
|
||||||
|
var
|
||||||
|
entropy : phuff_entropy_ptr;
|
||||||
|
is_DC_band : boolean;
|
||||||
|
ci, tbl : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
tbl := 0;
|
||||||
|
entropy := phuff_entropy_ptr (cinfo^.entropy);
|
||||||
|
|
||||||
|
entropy^.cinfo := cinfo;
|
||||||
|
entropy^.gather_statistics := gather_statistics;
|
||||||
|
|
||||||
|
is_DC_band := (cinfo^.Ss = 0);
|
||||||
|
|
||||||
|
{ We assume jcmaster.c already validated the scan parameters. }
|
||||||
|
|
||||||
|
{ Select execution routines }
|
||||||
|
if (cinfo^.Ah = 0) then
|
||||||
|
begin
|
||||||
|
if (is_DC_band) then
|
||||||
|
entropy^.pub.encode_mcu := encode_mcu_DC_first
|
||||||
|
else
|
||||||
|
entropy^.pub.encode_mcu := encode_mcu_AC_first;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (is_DC_band) then
|
||||||
|
entropy^.pub.encode_mcu := encode_mcu_DC_refine
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
entropy^.pub.encode_mcu := encode_mcu_AC_refine;
|
||||||
|
{ AC refinement needs a correction bit buffer }
|
||||||
|
if (entropy^.bit_buffer = NIL) then
|
||||||
|
entropy^.bit_buffer := JBytePtr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
MAX_CORR_BITS * SIZEOF(byte)) );
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if (gather_statistics) then
|
||||||
|
entropy^.pub.finish_pass := finish_pass_gather_phuff
|
||||||
|
else
|
||||||
|
entropy^.pub.finish_pass := finish_pass_phuff;
|
||||||
|
|
||||||
|
{ Only DC coefficients may be interleaved, so cinfo^.comps_in_scan = 1
|
||||||
|
for AC coefficients. }
|
||||||
|
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
{ Initialize DC predictions to 0 }
|
||||||
|
entropy^.last_dc_val[ci] := 0;
|
||||||
|
{ Get table index }
|
||||||
|
if (is_DC_band) then
|
||||||
|
begin
|
||||||
|
if (cinfo^.Ah <> 0) then { DC refinement needs no table }
|
||||||
|
continue;
|
||||||
|
tbl := compptr^.dc_tbl_no;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
tbl := compptr^.ac_tbl_no;
|
||||||
|
entropy^.ac_tbl_no := tbl;
|
||||||
|
end;
|
||||||
|
if (gather_statistics) then
|
||||||
|
begin
|
||||||
|
{ Check for invalid table index }
|
||||||
|
{ (make_c_derived_tbl does this in the other path) }
|
||||||
|
if (tbl < 0) or (tbl >= NUM_HUFF_TBLS) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tbl);
|
||||||
|
{ Allocate and zero the statistics tables }
|
||||||
|
{ Note that jpeg_gen_optimal_table expects 257 entries in each table! }
|
||||||
|
if (entropy^.count_ptrs[tbl] = NIL) then
|
||||||
|
entropy^.count_ptrs[tbl] := TLongTablePtr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
257 * SIZEOF(long)) );
|
||||||
|
MEMZERO(entropy^.count_ptrs[tbl], 257 * SIZEOF(long));
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
{ Compute derived values for Huffman table }
|
||||||
|
{ We may do this more than once for a table, but it's not expensive }
|
||||||
|
jpeg_make_c_derived_tbl(cinfo, is_DC_band, tbl,
|
||||||
|
entropy^.derived_tbls[tbl]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Initialize AC stuff }
|
||||||
|
entropy^.EOBRUN := 0;
|
||||||
|
entropy^.BE := 0;
|
||||||
|
|
||||||
|
{ Initialize bit buffer to empty }
|
||||||
|
entropy^.put_buffer := 0;
|
||||||
|
entropy^.put_bits := 0;
|
||||||
|
|
||||||
|
{ Initialize restart stuff }
|
||||||
|
entropy^.restarts_to_go := cinfo^.restart_interval;
|
||||||
|
entropy^.next_restart_num := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure dump_buffer (entropy : phuff_entropy_ptr);
|
||||||
|
{ Empty the output buffer; we do not support suspension in this module. }
|
||||||
|
var
|
||||||
|
dest : jpeg_destination_mgr_ptr;
|
||||||
|
begin
|
||||||
|
dest := entropy^.cinfo^.dest;
|
||||||
|
|
||||||
|
if (not dest^.empty_output_buffer (entropy^.cinfo)) then
|
||||||
|
ERREXIT(j_common_ptr(entropy^.cinfo), JERR_CANT_SUSPEND);
|
||||||
|
{ After a successful buffer dump, must reset buffer pointers }
|
||||||
|
entropy^.next_output_byte := dest^.next_output_byte;
|
||||||
|
entropy^.free_in_buffer := dest^.free_in_buffer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Outputting bits to the file }
|
||||||
|
|
||||||
|
{ Only the right 24 bits of put_buffer are used; the valid bits are
|
||||||
|
left-justified in this part. At most 16 bits can be passed to emit_bits
|
||||||
|
in one call, and we never retain more than 7 bits in put_buffer
|
||||||
|
between calls, so 24 bits are sufficient. }
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_bits (entropy : phuff_entropy_ptr;
|
||||||
|
code : uInt;
|
||||||
|
size : int); {INLINE}
|
||||||
|
{ Emit some bits, unless we are in gather mode }
|
||||||
|
var
|
||||||
|
{register} put_buffer : INT32;
|
||||||
|
{register} put_bits : int;
|
||||||
|
var
|
||||||
|
c : int;
|
||||||
|
begin
|
||||||
|
{ This routine is heavily used, so it's worth coding tightly. }
|
||||||
|
put_buffer := INT32 (code);
|
||||||
|
put_bits := entropy^.put_bits;
|
||||||
|
|
||||||
|
{ if size is 0, caller used an invalid Huffman table entry }
|
||||||
|
if (size = 0) then
|
||||||
|
ERREXIT(j_common_ptr(entropy^.cinfo), JERR_HUFF_MISSING_CODE);
|
||||||
|
|
||||||
|
if (entropy^.gather_statistics) then
|
||||||
|
exit; { do nothing if we're only getting stats }
|
||||||
|
|
||||||
|
put_buffer := put_buffer and ((INT32(1) shl size) - 1);
|
||||||
|
{ mask off any extra bits in code }
|
||||||
|
|
||||||
|
Inc(put_bits, size); { new number of bits in buffer }
|
||||||
|
|
||||||
|
put_buffer := put_buffer shl (24 - put_bits); { align incoming bits }
|
||||||
|
|
||||||
|
put_buffer := put_buffer or entropy^.put_buffer;
|
||||||
|
{ and merge with old buffer contents }
|
||||||
|
|
||||||
|
while (put_bits >= 8) do
|
||||||
|
begin
|
||||||
|
c := int ((put_buffer shr 16) and $FF);
|
||||||
|
|
||||||
|
{emit_byte(entropy, c);}
|
||||||
|
{ Outputting bytes to the file.
|
||||||
|
NB: these must be called only when actually outputting,
|
||||||
|
that is, entropy^.gather_statistics = FALSE. }
|
||||||
|
{ Emit a byte }
|
||||||
|
entropy^.next_output_byte^ := JOCTET(c);
|
||||||
|
Inc(entropy^.next_output_byte);
|
||||||
|
Dec(entropy^.free_in_buffer);
|
||||||
|
if (entropy^.free_in_buffer = 0) then
|
||||||
|
dump_buffer(entropy);
|
||||||
|
|
||||||
|
if (c = $FF) then
|
||||||
|
begin { need to stuff a zero byte? }
|
||||||
|
{emit_byte(entropy, 0);}
|
||||||
|
entropy^.next_output_byte^ := JOCTET(0);
|
||||||
|
Inc(entropy^.next_output_byte);
|
||||||
|
Dec(entropy^.free_in_buffer);
|
||||||
|
if (entropy^.free_in_buffer = 0) then
|
||||||
|
dump_buffer(entropy);
|
||||||
|
end;
|
||||||
|
put_buffer := put_buffer shl 8;
|
||||||
|
Dec(put_bits, 8);
|
||||||
|
end;
|
||||||
|
|
||||||
|
entropy^.put_buffer := put_buffer; { update variables }
|
||||||
|
entropy^.put_bits := put_bits;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure flush_bits (entropy : phuff_entropy_ptr);
|
||||||
|
begin
|
||||||
|
emit_bits(entropy, $7F, 7); { fill any partial byte with ones }
|
||||||
|
entropy^.put_buffer := 0; { and reset bit-buffer to empty }
|
||||||
|
entropy^.put_bits := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Emit (or just count) a Huffman symbol. }
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_symbol (entropy : phuff_entropy_ptr;
|
||||||
|
tbl_no : int;
|
||||||
|
symbol : int); {INLINE}
|
||||||
|
var
|
||||||
|
tbl : c_derived_tbl_ptr;
|
||||||
|
begin
|
||||||
|
if (entropy^.gather_statistics) then
|
||||||
|
Inc(entropy^.count_ptrs[tbl_no]^[symbol])
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
tbl := entropy^.derived_tbls[tbl_no];
|
||||||
|
emit_bits(entropy, tbl^.ehufco[symbol], tbl^.ehufsi[symbol]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Emit bits from a correction bit buffer. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_buffered_bits (entropy : phuff_entropy_ptr;
|
||||||
|
bufstart : JBytePtr;
|
||||||
|
nbits : uInt);
|
||||||
|
var
|
||||||
|
bufptr : byteptr;
|
||||||
|
begin
|
||||||
|
if (entropy^.gather_statistics) then
|
||||||
|
exit; { no real work }
|
||||||
|
|
||||||
|
bufptr := byteptr(bufstart);
|
||||||
|
while (nbits > 0) do
|
||||||
|
begin
|
||||||
|
emit_bits(entropy, uInt(bufptr^), 1);
|
||||||
|
Inc(bufptr);
|
||||||
|
Dec(nbits);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Emit any pending EOBRUN symbol. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_eobrun (entropy : phuff_entropy_ptr);
|
||||||
|
var
|
||||||
|
{register} temp, nbits : int;
|
||||||
|
begin
|
||||||
|
if (entropy^.EOBRUN > 0) then
|
||||||
|
begin { if there is any pending EOBRUN }
|
||||||
|
temp := entropy^.EOBRUN;
|
||||||
|
nbits := 0;
|
||||||
|
temp := temp shr 1;
|
||||||
|
while (temp <> 0) do
|
||||||
|
begin
|
||||||
|
Inc(nbits);
|
||||||
|
temp := temp shr 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ safety check: shouldn't happen given limited correction-bit buffer }
|
||||||
|
if (nbits > 14) then
|
||||||
|
ERREXIT(j_common_ptr(entropy^.cinfo), JERR_HUFF_MISSING_CODE);
|
||||||
|
|
||||||
|
emit_symbol(entropy, entropy^.ac_tbl_no, nbits shl 4);
|
||||||
|
if (nbits <> 0) then
|
||||||
|
emit_bits(entropy, entropy^.EOBRUN, nbits);
|
||||||
|
|
||||||
|
entropy^.EOBRUN := 0;
|
||||||
|
|
||||||
|
{ Emit any buffered correction bits }
|
||||||
|
emit_buffered_bits(entropy, entropy^.bit_buffer, entropy^.BE);
|
||||||
|
entropy^.BE := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Emit a restart marker & resynchronize predictions. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure emit_restart (entropy : phuff_entropy_ptr;
|
||||||
|
restart_num : int);
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
begin
|
||||||
|
emit_eobrun(entropy);
|
||||||
|
|
||||||
|
if (not entropy^.gather_statistics) then
|
||||||
|
begin
|
||||||
|
flush_bits(entropy);
|
||||||
|
{emit_byte(entropy, $FF);}
|
||||||
|
{ Outputting bytes to the file.
|
||||||
|
NB: these must be called only when actually outputting,
|
||||||
|
that is, entropy^.gather_statistics = FALSE. }
|
||||||
|
|
||||||
|
entropy^.next_output_byte^ := JOCTET($FF);
|
||||||
|
Inc(entropy^.next_output_byte);
|
||||||
|
Dec(entropy^.free_in_buffer);
|
||||||
|
if (entropy^.free_in_buffer = 0) then
|
||||||
|
dump_buffer(entropy);
|
||||||
|
|
||||||
|
{emit_byte(entropy, JPEG_RST0 + restart_num);}
|
||||||
|
entropy^.next_output_byte^ := JOCTET(JPEG_RST0 + restart_num);
|
||||||
|
Inc(entropy^.next_output_byte);
|
||||||
|
Dec(entropy^.free_in_buffer);
|
||||||
|
if (entropy^.free_in_buffer = 0) then
|
||||||
|
dump_buffer(entropy);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (entropy^.cinfo^.Ss = 0) then
|
||||||
|
begin
|
||||||
|
{ Re-initialize DC predictions to 0 }
|
||||||
|
for ci := 0 to pred(entropy^.cinfo^.comps_in_scan) do
|
||||||
|
entropy^.last_dc_val[ci] := 0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Re-initialize all AC-related fields to 0 }
|
||||||
|
entropy^.EOBRUN := 0;
|
||||||
|
entropy^.BE := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ MCU encoding for DC initial scan (either spectral selection,
|
||||||
|
or first pass of successive approximation). }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function encode_mcu_DC_first (cinfo : j_compress_ptr;
|
||||||
|
const MCU_data: array of JBLOCKROW) : boolean;
|
||||||
|
var
|
||||||
|
entropy : phuff_entropy_ptr;
|
||||||
|
{register} temp, temp2 : int;
|
||||||
|
{register} nbits : int;
|
||||||
|
blkn, ci : int;
|
||||||
|
Al : int;
|
||||||
|
block : JBLOCK_PTR;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
ishift_temp : int;
|
||||||
|
begin
|
||||||
|
entropy := phuff_entropy_ptr (cinfo^.entropy);
|
||||||
|
Al := cinfo^.Al;
|
||||||
|
|
||||||
|
entropy^.next_output_byte := cinfo^.dest^.next_output_byte;
|
||||||
|
entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Emit restart marker if needed }
|
||||||
|
if (cinfo^.restart_interval <> 0) then
|
||||||
|
if (entropy^.restarts_to_go = 0) then
|
||||||
|
emit_restart(entropy, entropy^.next_restart_num);
|
||||||
|
|
||||||
|
{ Encode the MCU data blocks }
|
||||||
|
for blkn := 0 to pred(cinfo^.blocks_in_MCU) do
|
||||||
|
begin
|
||||||
|
block := JBLOCK_PTR(MCU_data[blkn]);
|
||||||
|
ci := cinfo^.MCU_membership[blkn];
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
|
||||||
|
{ Compute the DC value after the required point transform by Al.
|
||||||
|
This is simply an arithmetic right shift. }
|
||||||
|
|
||||||
|
{temp2 := IRIGHT_SHIFT( int(block^[0]), Al);}
|
||||||
|
{IRIGHT_SHIFT_IS_UNSIGNED}
|
||||||
|
ishift_temp := int(block^[0]);
|
||||||
|
if ishift_temp < 0 then
|
||||||
|
temp2 := (ishift_temp shr Al) or ((not 0) shl (16-Al))
|
||||||
|
else
|
||||||
|
temp2 := ishift_temp shr Al;
|
||||||
|
|
||||||
|
|
||||||
|
{ DC differences are figured on the point-transformed values. }
|
||||||
|
temp := temp2 - entropy^.last_dc_val[ci];
|
||||||
|
entropy^.last_dc_val[ci] := temp2;
|
||||||
|
|
||||||
|
{ Encode the DC coefficient difference per section G.1.2.1 }
|
||||||
|
temp2 := temp;
|
||||||
|
if (temp < 0) then
|
||||||
|
begin
|
||||||
|
temp := -temp; { temp is abs value of input }
|
||||||
|
{ For a negative input, want temp2 := bitwise complement of abs(input) }
|
||||||
|
{ This code assumes we are on a two's complement machine }
|
||||||
|
Dec(temp2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Find the number of bits needed for the magnitude of the coefficient }
|
||||||
|
nbits := 0;
|
||||||
|
while (temp <> 0) do
|
||||||
|
begin
|
||||||
|
Inc(nbits);
|
||||||
|
temp := temp shr 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Check for out-of-range coefficient values.
|
||||||
|
Since we're encoding a difference, the range limit is twice as much. }
|
||||||
|
|
||||||
|
if (nbits > MAX_COEF_BITS+1) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF);
|
||||||
|
|
||||||
|
{ Count/emit the Huffman-coded symbol for the number of bits }
|
||||||
|
emit_symbol(entropy, compptr^.dc_tbl_no, nbits);
|
||||||
|
|
||||||
|
{ Emit that number of bits of the value, if positive, }
|
||||||
|
{ or the complement of its magnitude, if negative. }
|
||||||
|
if (nbits <> 0) then { emit_bits rejects calls with size 0 }
|
||||||
|
emit_bits(entropy, uInt(temp2), nbits);
|
||||||
|
end;
|
||||||
|
|
||||||
|
cinfo^.dest^.next_output_byte := entropy^.next_output_byte;
|
||||||
|
cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Update restart-interval state too }
|
||||||
|
if (cinfo^.restart_interval <> 0) then
|
||||||
|
begin
|
||||||
|
if (entropy^.restarts_to_go = 0) then
|
||||||
|
begin
|
||||||
|
entropy^.restarts_to_go := cinfo^.restart_interval;
|
||||||
|
Inc(entropy^.next_restart_num);
|
||||||
|
with entropy^ do
|
||||||
|
next_restart_num := next_restart_num and 7;
|
||||||
|
end;
|
||||||
|
Dec(entropy^.restarts_to_go);
|
||||||
|
end;
|
||||||
|
|
||||||
|
encode_mcu_DC_first := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ MCU encoding for AC initial scan (either spectral selection,
|
||||||
|
or first pass of successive approximation). }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function encode_mcu_AC_first (cinfo : j_compress_ptr;
|
||||||
|
const MCU_data: array of JBLOCKROW) : boolean;
|
||||||
|
var
|
||||||
|
entropy : phuff_entropy_ptr;
|
||||||
|
{register} temp, temp2 : int;
|
||||||
|
{register} nbits : int;
|
||||||
|
{register} r, k : int;
|
||||||
|
Se : int;
|
||||||
|
Al : int;
|
||||||
|
block : JBLOCK_PTR;
|
||||||
|
begin
|
||||||
|
entropy := phuff_entropy_ptr (cinfo^.entropy);
|
||||||
|
Se := cinfo^.Se;
|
||||||
|
Al := cinfo^.Al;
|
||||||
|
|
||||||
|
entropy^.next_output_byte := cinfo^.dest^.next_output_byte;
|
||||||
|
entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Emit restart marker if needed }
|
||||||
|
if (cinfo^.restart_interval <> 0) then
|
||||||
|
if (entropy^.restarts_to_go = 0) then
|
||||||
|
emit_restart(entropy, entropy^.next_restart_num);
|
||||||
|
|
||||||
|
{ Encode the MCU data block }
|
||||||
|
block := JBLOCK_PTR(MCU_data[0]);
|
||||||
|
|
||||||
|
{ Encode the AC coefficients per section G.1.2.2, fig. G.3 }
|
||||||
|
|
||||||
|
r := 0; { r := run length of zeros }
|
||||||
|
|
||||||
|
for k := cinfo^.Ss to Se do
|
||||||
|
begin
|
||||||
|
temp := (block^[jpeg_natural_order[k]]);
|
||||||
|
if (temp = 0) then
|
||||||
|
begin
|
||||||
|
Inc(r);
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
|
{ We must apply the point transform by Al. For AC coefficients this
|
||||||
|
is an integer division with rounding towards 0. To do this portably
|
||||||
|
in C, we shift after obtaining the absolute value; so the code is
|
||||||
|
interwoven with finding the abs value (temp) and output bits (temp2). }
|
||||||
|
|
||||||
|
if (temp < 0) then
|
||||||
|
begin
|
||||||
|
temp := -temp; { temp is abs value of input }
|
||||||
|
temp := temp shr Al; { apply the point transform }
|
||||||
|
{ For a negative coef, want temp2 := bitwise complement of abs(coef) }
|
||||||
|
temp2 := not temp;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
temp := temp shr Al; { apply the point transform }
|
||||||
|
temp2 := temp;
|
||||||
|
end;
|
||||||
|
{ Watch out for case that nonzero coef is zero after point transform }
|
||||||
|
if (temp = 0) then
|
||||||
|
begin
|
||||||
|
Inc(r);
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Emit any pending EOBRUN }
|
||||||
|
if (entropy^.EOBRUN > 0) then
|
||||||
|
emit_eobrun(entropy);
|
||||||
|
{ if run length > 15, must emit special run-length-16 codes ($F0) }
|
||||||
|
while (r > 15) do
|
||||||
|
begin
|
||||||
|
emit_symbol(entropy, entropy^.ac_tbl_no, $F0);
|
||||||
|
Dec(r, 16);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Find the number of bits needed for the magnitude of the coefficient }
|
||||||
|
nbits := 0; { there must be at least one 1 bit }
|
||||||
|
repeat
|
||||||
|
Inc(nbits);
|
||||||
|
temp := temp shr 1;
|
||||||
|
until (temp = 0);
|
||||||
|
|
||||||
|
{ Check for out-of-range coefficient values }
|
||||||
|
if (nbits > MAX_COEF_BITS) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF);
|
||||||
|
|
||||||
|
{ Count/emit Huffman symbol for run length / number of bits }
|
||||||
|
emit_symbol(entropy, entropy^.ac_tbl_no, (r shl 4) + nbits);
|
||||||
|
|
||||||
|
{ Emit that number of bits of the value, if positive, }
|
||||||
|
{ or the complement of its magnitude, if negative. }
|
||||||
|
emit_bits(entropy, uInt(temp2), nbits);
|
||||||
|
|
||||||
|
r := 0; { reset zero run length }
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (r > 0) then
|
||||||
|
begin { If there are trailing zeroes, }
|
||||||
|
Inc(entropy^.EOBRUN); { count an EOB }
|
||||||
|
if (entropy^.EOBRUN = $7FFF) then
|
||||||
|
emit_eobrun(entropy); { force it out to avoid overflow }
|
||||||
|
end;
|
||||||
|
|
||||||
|
cinfo^.dest^.next_output_byte := entropy^.next_output_byte;
|
||||||
|
cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Update restart-interval state too }
|
||||||
|
if (cinfo^.restart_interval <> 0) then
|
||||||
|
begin
|
||||||
|
if (entropy^.restarts_to_go = 0) then
|
||||||
|
begin
|
||||||
|
entropy^.restarts_to_go := cinfo^.restart_interval;
|
||||||
|
Inc(entropy^.next_restart_num);
|
||||||
|
with entropy^ do
|
||||||
|
next_restart_num := next_restart_num and 7;
|
||||||
|
end;
|
||||||
|
Dec(entropy^.restarts_to_go);
|
||||||
|
end;
|
||||||
|
|
||||||
|
encode_mcu_AC_first := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ MCU encoding for DC successive approximation refinement scan.
|
||||||
|
Note: we assume such scans can be multi-component, although the spec
|
||||||
|
is not very clear on the point. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function encode_mcu_DC_refine (cinfo : j_compress_ptr;
|
||||||
|
const MCU_data: array of JBLOCKROW) : boolean;
|
||||||
|
var
|
||||||
|
entropy : phuff_entropy_ptr;
|
||||||
|
{register} temp : int;
|
||||||
|
blkn : int;
|
||||||
|
Al : int;
|
||||||
|
block : JBLOCK_PTR;
|
||||||
|
begin
|
||||||
|
entropy := phuff_entropy_ptr (cinfo^.entropy);
|
||||||
|
Al := cinfo^.Al;
|
||||||
|
|
||||||
|
entropy^.next_output_byte := cinfo^.dest^.next_output_byte;
|
||||||
|
entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Emit restart marker if needed }
|
||||||
|
if (cinfo^.restart_interval <> 0) then
|
||||||
|
if (entropy^.restarts_to_go = 0) then
|
||||||
|
emit_restart(entropy, entropy^.next_restart_num);
|
||||||
|
|
||||||
|
{ Encode the MCU data blocks }
|
||||||
|
for blkn := 0 to pred(cinfo^.blocks_in_MCU) do
|
||||||
|
begin
|
||||||
|
block := JBLOCK_PTR(MCU_data[blkn]);
|
||||||
|
|
||||||
|
{ We simply emit the Al'th bit of the DC coefficient value. }
|
||||||
|
temp := block^[0];
|
||||||
|
emit_bits(entropy, uInt(temp shr Al), 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
cinfo^.dest^.next_output_byte := entropy^.next_output_byte;
|
||||||
|
cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Update restart-interval state too }
|
||||||
|
if (cinfo^.restart_interval <> 0) then
|
||||||
|
begin
|
||||||
|
if (entropy^.restarts_to_go = 0) then
|
||||||
|
begin
|
||||||
|
entropy^.restarts_to_go := cinfo^.restart_interval;
|
||||||
|
Inc(entropy^.next_restart_num);
|
||||||
|
with entropy^ do
|
||||||
|
next_restart_num := next_restart_num and 7;
|
||||||
|
end;
|
||||||
|
Dec(entropy^.restarts_to_go);
|
||||||
|
end;
|
||||||
|
|
||||||
|
encode_mcu_DC_refine := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ MCU encoding for AC successive approximation refinement scan. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function encode_mcu_AC_refine (cinfo : j_compress_ptr;
|
||||||
|
const MCU_data: array of JBLOCKROW) : boolean;
|
||||||
|
|
||||||
|
var
|
||||||
|
entropy : phuff_entropy_ptr;
|
||||||
|
{register} temp : int;
|
||||||
|
{register} r, k : int;
|
||||||
|
EOB : int;
|
||||||
|
BR_buffer : JBytePtr;
|
||||||
|
BR : uInt;
|
||||||
|
Se : int;
|
||||||
|
Al : int;
|
||||||
|
block : JBLOCK_PTR;
|
||||||
|
absvalues : array[0..DCTSIZE2-1] of int;
|
||||||
|
begin
|
||||||
|
entropy := phuff_entropy_ptr(cinfo^.entropy);
|
||||||
|
Se := cinfo^.Se;
|
||||||
|
Al := cinfo^.Al;
|
||||||
|
|
||||||
|
entropy^.next_output_byte := cinfo^.dest^.next_output_byte;
|
||||||
|
entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Emit restart marker if needed }
|
||||||
|
if (cinfo^.restart_interval <> 0) then
|
||||||
|
if (entropy^.restarts_to_go = 0) then
|
||||||
|
emit_restart(entropy, entropy^.next_restart_num);
|
||||||
|
|
||||||
|
{ Encode the MCU data block }
|
||||||
|
block := JBLOCK_PTR(MCU_data[0]);
|
||||||
|
|
||||||
|
{ It is convenient to make a pre-pass to determine the transformed
|
||||||
|
coefficients' absolute values and the EOB position. }
|
||||||
|
|
||||||
|
EOB := 0;
|
||||||
|
for k := cinfo^.Ss to Se do
|
||||||
|
begin
|
||||||
|
temp := block^[jpeg_natural_order[k]];
|
||||||
|
{ We must apply the point transform by Al. For AC coefficients this
|
||||||
|
is an integer division with rounding towards 0. To do this portably
|
||||||
|
in C, we shift after obtaining the absolute value. }
|
||||||
|
|
||||||
|
if (temp < 0) then
|
||||||
|
temp := -temp; { temp is abs value of input }
|
||||||
|
temp := temp shr Al; { apply the point transform }
|
||||||
|
absvalues[k] := temp; { save abs value for main pass }
|
||||||
|
if (temp = 1) then
|
||||||
|
EOB := k; { EOB := index of last newly-nonzero coef }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Encode the AC coefficients per section G.1.2.3, fig. G.7 }
|
||||||
|
|
||||||
|
r := 0; { r := run length of zeros }
|
||||||
|
BR := 0; { BR := count of buffered bits added now }
|
||||||
|
BR_buffer := JBytePtr(@(entropy^.bit_buffer^[entropy^.BE]));
|
||||||
|
{ Append bits to buffer }
|
||||||
|
|
||||||
|
for k := cinfo^.Ss to Se do
|
||||||
|
begin
|
||||||
|
temp := absvalues[k];
|
||||||
|
if (temp = 0) then
|
||||||
|
begin
|
||||||
|
Inc(r);
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Emit any required ZRLs, but not if they can be folded into EOB }
|
||||||
|
while (r > 15) and (k <= EOB) do
|
||||||
|
begin
|
||||||
|
{ emit any pending EOBRUN and the BE correction bits }
|
||||||
|
emit_eobrun(entropy);
|
||||||
|
{ Emit ZRL }
|
||||||
|
emit_symbol(entropy, entropy^.ac_tbl_no, $F0);
|
||||||
|
Dec(r, 16);
|
||||||
|
{ Emit buffered correction bits that must be associated with ZRL }
|
||||||
|
emit_buffered_bits(entropy, BR_buffer, BR);
|
||||||
|
BR_buffer := entropy^.bit_buffer; { BE bits are gone now }
|
||||||
|
BR := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ If the coef was previously nonzero, it only needs a correction bit.
|
||||||
|
NOTE: a straight translation of the spec's figure G.7 would suggest
|
||||||
|
that we also need to test r > 15. But if r > 15, we can only get here
|
||||||
|
if k > EOB, which implies that this coefficient is not 1. }
|
||||||
|
if (temp > 1) then
|
||||||
|
begin
|
||||||
|
{ The correction bit is the next bit of the absolute value. }
|
||||||
|
BR_buffer^[BR] := byte (temp and 1);
|
||||||
|
Inc(BR);
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Emit any pending EOBRUN and the BE correction bits }
|
||||||
|
emit_eobrun(entropy);
|
||||||
|
|
||||||
|
{ Count/emit Huffman symbol for run length / number of bits }
|
||||||
|
emit_symbol(entropy, entropy^.ac_tbl_no, (r shl 4) + 1);
|
||||||
|
|
||||||
|
{ Emit output bit for newly-nonzero coef }
|
||||||
|
if (block^[jpeg_natural_order[k]] < 0) then
|
||||||
|
temp := 0
|
||||||
|
else
|
||||||
|
temp := 1;
|
||||||
|
emit_bits(entropy, uInt(temp), 1);
|
||||||
|
|
||||||
|
{ Emit buffered correction bits that must be associated with this code }
|
||||||
|
emit_buffered_bits(entropy, BR_buffer, BR);
|
||||||
|
BR_buffer := entropy^.bit_buffer; { BE bits are gone now }
|
||||||
|
BR := 0;
|
||||||
|
r := 0; { reset zero run length }
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (r > 0) or (BR > 0) then
|
||||||
|
begin { If there are trailing zeroes, }
|
||||||
|
Inc(entropy^.EOBRUN); { count an EOB }
|
||||||
|
Inc(entropy^.BE, BR); { concat my correction bits to older ones }
|
||||||
|
{ We force out the EOB if we risk either:
|
||||||
|
1. overflow of the EOB counter;
|
||||||
|
2. overflow of the correction bit buffer during the next MCU. }
|
||||||
|
|
||||||
|
if (entropy^.EOBRUN = $7FFF) or
|
||||||
|
(entropy^.BE > (MAX_CORR_BITS-DCTSIZE2+1)) then
|
||||||
|
emit_eobrun(entropy);
|
||||||
|
end;
|
||||||
|
|
||||||
|
cinfo^.dest^.next_output_byte := entropy^.next_output_byte;
|
||||||
|
cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Update restart-interval state too }
|
||||||
|
if (cinfo^.restart_interval <> 0) then
|
||||||
|
begin
|
||||||
|
if (entropy^.restarts_to_go = 0) then
|
||||||
|
begin
|
||||||
|
entropy^.restarts_to_go := cinfo^.restart_interval;
|
||||||
|
Inc(entropy^.next_restart_num);
|
||||||
|
with entropy^ do
|
||||||
|
next_restart_num := next_restart_num and 7;
|
||||||
|
end;
|
||||||
|
Dec(entropy^.restarts_to_go);
|
||||||
|
end;
|
||||||
|
|
||||||
|
encode_mcu_AC_refine := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish up at the end of a Huffman-compressed progressive scan. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure finish_pass_phuff (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
entropy : phuff_entropy_ptr;
|
||||||
|
begin
|
||||||
|
entropy := phuff_entropy_ptr (cinfo^.entropy);
|
||||||
|
|
||||||
|
entropy^.next_output_byte := cinfo^.dest^.next_output_byte;
|
||||||
|
entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer;
|
||||||
|
|
||||||
|
{ Flush out any buffered data }
|
||||||
|
emit_eobrun(entropy);
|
||||||
|
flush_bits(entropy);
|
||||||
|
|
||||||
|
cinfo^.dest^.next_output_byte := entropy^.next_output_byte;
|
||||||
|
cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish up a statistics-gathering pass and create the new Huffman tables. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure finish_pass_gather_phuff (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
entropy : phuff_entropy_ptr;
|
||||||
|
is_DC_band : boolean;
|
||||||
|
ci, tbl : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
htblptr : ^JHUFF_TBL_PTR;
|
||||||
|
did : array[0..NUM_HUFF_TBLS-1] of boolean;
|
||||||
|
begin
|
||||||
|
tbl := 0;
|
||||||
|
entropy := phuff_entropy_ptr (cinfo^.entropy);
|
||||||
|
|
||||||
|
{ Flush out buffered data (all we care about is counting the EOB symbol) }
|
||||||
|
emit_eobrun(entropy);
|
||||||
|
|
||||||
|
is_DC_band := (cinfo^.Ss = 0);
|
||||||
|
|
||||||
|
{ It's important not to apply jpeg_gen_optimal_table more than once
|
||||||
|
per table, because it clobbers the input frequency counts! }
|
||||||
|
|
||||||
|
MEMZERO(@did, SIZEOF(did));
|
||||||
|
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
if (is_DC_band) then
|
||||||
|
begin
|
||||||
|
if (cinfo^.Ah <> 0) then { DC refinement needs no table }
|
||||||
|
continue;
|
||||||
|
tbl := compptr^.dc_tbl_no;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
tbl := compptr^.ac_tbl_no;
|
||||||
|
end;
|
||||||
|
if (not did[tbl]) then
|
||||||
|
begin
|
||||||
|
if (is_DC_band) then
|
||||||
|
htblptr := @(cinfo^.dc_huff_tbl_ptrs[tbl])
|
||||||
|
else
|
||||||
|
htblptr := @(cinfo^.ac_huff_tbl_ptrs[tbl]);
|
||||||
|
if (htblptr^ = NIL) then
|
||||||
|
htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo));
|
||||||
|
jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.count_ptrs[tbl]^);
|
||||||
|
did[tbl] := TRUE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Module initialization routine for progressive Huffman entropy encoding. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_phuff_encoder (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
entropy : phuff_entropy_ptr;
|
||||||
|
i : int;
|
||||||
|
begin
|
||||||
|
entropy := phuff_entropy_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(phuff_entropy_encoder)) );
|
||||||
|
cinfo^.entropy := jpeg_entropy_encoder_ptr(entropy);
|
||||||
|
entropy^.pub.start_pass := start_pass_phuff;
|
||||||
|
|
||||||
|
{ Mark tables unallocated }
|
||||||
|
for i := 0 to pred(NUM_HUFF_TBLS) do
|
||||||
|
begin
|
||||||
|
entropy^.derived_tbls[i] := NIL;
|
||||||
|
entropy^.count_ptrs[i] := NIL;
|
||||||
|
end;
|
||||||
|
entropy^.bit_buffer := NIL; { needed only in AC refinement scan }
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,406 @@
|
||||||
|
unit imjcprepct;
|
||||||
|
|
||||||
|
{ Original : jcprepct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
{ This file contains the compression preprocessing controller.
|
||||||
|
This controller manages the color conversion, downsampling,
|
||||||
|
and edge expansion steps.
|
||||||
|
|
||||||
|
Most of the complexity here is associated with buffering input rows
|
||||||
|
as required by the downsampler. See the comments at the head of
|
||||||
|
jcsample.c for the downsampler's needs. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjpeglib,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjinclude,
|
||||||
|
imjutils;
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_c_prep_controller (cinfo : j_compress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{ At present, jcsample.c can request context rows only for smoothing.
|
||||||
|
In the future, we might also need context rows for CCIR601 sampling
|
||||||
|
or other more-complex downsampling procedures. The code to support
|
||||||
|
context rows should be compiled only if needed. }
|
||||||
|
|
||||||
|
{$ifdef INPUT_SMOOTHING_SUPPORTED}
|
||||||
|
{$define CONTEXT_ROWS_SUPPORTED}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{ For the simple (no-context-row) case, we just need to buffer one
|
||||||
|
row group's worth of pixels for the downsampling step. At the bottom of
|
||||||
|
the image, we pad to a full row group by replicating the last pixel row.
|
||||||
|
The downsampler's last output row is then replicated if needed to pad
|
||||||
|
out to a full iMCU row.
|
||||||
|
|
||||||
|
When providing context rows, we must buffer three row groups' worth of
|
||||||
|
pixels. Three row groups are physically allocated, but the row pointer
|
||||||
|
arrays are made five row groups high, with the extra pointers above and
|
||||||
|
below "wrapping around" to point to the last and first real row groups.
|
||||||
|
This allows the downsampler to access the proper context rows.
|
||||||
|
At the top and bottom of the image, we create dummy context rows by
|
||||||
|
copying the first or last real pixel row. This copying could be avoided
|
||||||
|
by pointer hacking as is done in jdmainct.c, but it doesn't seem worth the
|
||||||
|
trouble on the compression side. }
|
||||||
|
|
||||||
|
|
||||||
|
{ Private buffer controller object }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_prep_ptr = ^my_prep_controller;
|
||||||
|
my_prep_controller = record
|
||||||
|
pub : jpeg_c_prep_controller; { public fields }
|
||||||
|
|
||||||
|
{ Downsampling input buffer. This buffer holds color-converted data
|
||||||
|
until we have enough to do a downsample step. }
|
||||||
|
|
||||||
|
color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
|
||||||
|
|
||||||
|
rows_to_go : JDIMENSION; { counts rows remaining in source image }
|
||||||
|
next_buf_row : int; { index of next row to store in color_buf }
|
||||||
|
|
||||||
|
{$ifdef CONTEXT_ROWS_SUPPORTED} { only needed for context case }
|
||||||
|
this_row_group : int; { starting row index of group to process }
|
||||||
|
next_buf_stop : int; { downsample when we reach this index }
|
||||||
|
{$endif}
|
||||||
|
end; {my_prep_controller;}
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for a processing pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass_prep (cinfo : j_compress_ptr;
|
||||||
|
pass_mode : J_BUF_MODE );
|
||||||
|
var
|
||||||
|
prep : my_prep_ptr;
|
||||||
|
begin
|
||||||
|
prep := my_prep_ptr (cinfo^.prep);
|
||||||
|
|
||||||
|
if (pass_mode <> JBUF_PASS_THRU) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
|
||||||
|
{ Initialize total-height counter for detecting bottom of image }
|
||||||
|
prep^.rows_to_go := cinfo^.image_height;
|
||||||
|
{ Mark the conversion buffer empty }
|
||||||
|
prep^.next_buf_row := 0;
|
||||||
|
{$ifdef CONTEXT_ROWS_SUPPORTED}
|
||||||
|
{ Preset additional state variables for context mode.
|
||||||
|
These aren't used in non-context mode, so we needn't test which mode. }
|
||||||
|
prep^.this_row_group := 0;
|
||||||
|
{ Set next_buf_stop to stop after two row groups have been read in. }
|
||||||
|
prep^.next_buf_stop := 2 * cinfo^.max_v_samp_factor;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Expand an image vertically from height input_rows to height output_rows,
|
||||||
|
by duplicating the bottom row. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure expand_bottom_edge (image_data : JSAMPARRAY;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
input_rows : int;
|
||||||
|
output_rows : int);
|
||||||
|
var
|
||||||
|
{register} row : int;
|
||||||
|
begin
|
||||||
|
for row := input_rows to pred(output_rows) do
|
||||||
|
begin
|
||||||
|
jcopy_sample_rows(image_data, input_rows-1, image_data, row,
|
||||||
|
1, num_cols);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Process some data in the simple no-context case.
|
||||||
|
|
||||||
|
Preprocessor output data is counted in "row groups". A row group
|
||||||
|
is defined to be v_samp_factor sample rows of each component.
|
||||||
|
Downsampling will produce this much data from each max_v_samp_factor
|
||||||
|
input rows. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure pre_process_data (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
var in_row_ctr : JDIMENSION;
|
||||||
|
in_rows_avail : JDIMENSION;
|
||||||
|
output_buf : JSAMPIMAGE;
|
||||||
|
var out_row_group_ctr : JDIMENSION;
|
||||||
|
out_row_groups_avail : JDIMENSION);
|
||||||
|
var
|
||||||
|
prep : my_prep_ptr;
|
||||||
|
numrows, ci : int;
|
||||||
|
inrows : JDIMENSION;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
var
|
||||||
|
local_input_buf : JSAMPARRAY;
|
||||||
|
begin
|
||||||
|
prep := my_prep_ptr (cinfo^.prep);
|
||||||
|
|
||||||
|
while (in_row_ctr < in_rows_avail) and
|
||||||
|
(out_row_group_ctr < out_row_groups_avail) do
|
||||||
|
begin
|
||||||
|
{ Do color conversion to fill the conversion buffer. }
|
||||||
|
inrows := in_rows_avail - in_row_ctr;
|
||||||
|
numrows := cinfo^.max_v_samp_factor - prep^.next_buf_row;
|
||||||
|
{numrows := int( MIN(JDIMENSION(numrows), inrows) );}
|
||||||
|
if inrows < JDIMENSION(numrows) then
|
||||||
|
numrows := int(inrows);
|
||||||
|
local_input_buf := JSAMPARRAY(@(input_buf^[in_row_ctr]));
|
||||||
|
cinfo^.cconvert^.color_convert (cinfo, local_input_buf,
|
||||||
|
JSAMPIMAGE(@prep^.color_buf),
|
||||||
|
JDIMENSION(prep^.next_buf_row),
|
||||||
|
numrows);
|
||||||
|
Inc(in_row_ctr, numrows);
|
||||||
|
Inc(prep^.next_buf_row, numrows);
|
||||||
|
Dec(prep^.rows_to_go, numrows);
|
||||||
|
{ If at bottom of image, pad to fill the conversion buffer. }
|
||||||
|
if (prep^.rows_to_go = 0) and
|
||||||
|
(prep^.next_buf_row < cinfo^.max_v_samp_factor) then
|
||||||
|
begin
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width,
|
||||||
|
prep^.next_buf_row, cinfo^.max_v_samp_factor);
|
||||||
|
end;
|
||||||
|
prep^.next_buf_row := cinfo^.max_v_samp_factor;
|
||||||
|
end;
|
||||||
|
{ If we've filled the conversion buffer, empty it. }
|
||||||
|
if (prep^.next_buf_row = cinfo^.max_v_samp_factor) then
|
||||||
|
begin
|
||||||
|
cinfo^.downsample^.downsample (cinfo,
|
||||||
|
JSAMPIMAGE(@prep^.color_buf),
|
||||||
|
JDIMENSION (0),
|
||||||
|
output_buf,
|
||||||
|
out_row_group_ctr);
|
||||||
|
prep^.next_buf_row := 0;
|
||||||
|
Inc(out_row_group_ctr);;
|
||||||
|
end;
|
||||||
|
{ If at bottom of image, pad the output to a full iMCU height.
|
||||||
|
Note we assume the caller is providing a one-iMCU-height output buffer! }
|
||||||
|
if (prep^.rows_to_go = 0) and
|
||||||
|
(out_row_group_ctr < out_row_groups_avail) then
|
||||||
|
begin
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
expand_bottom_edge(output_buf^[ci],
|
||||||
|
compptr^.width_in_blocks * DCTSIZE,
|
||||||
|
int (out_row_group_ctr) * compptr^.v_samp_factor,
|
||||||
|
int (out_row_groups_avail) * compptr^.v_samp_factor);
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
out_row_group_ctr := out_row_groups_avail;
|
||||||
|
break; { can exit outer loop without test }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef CONTEXT_ROWS_SUPPORTED}
|
||||||
|
|
||||||
|
{ Process some data in the context case. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure pre_process_context (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPARRAY;
|
||||||
|
var in_row_ctr : JDIMENSION;
|
||||||
|
in_rows_avail : JDIMENSION;
|
||||||
|
output_buf : JSAMPIMAGE;
|
||||||
|
var out_row_group_ctr : JDIMENSION;
|
||||||
|
out_row_groups_avail : JDIMENSION);
|
||||||
|
var
|
||||||
|
prep : my_prep_ptr;
|
||||||
|
numrows, ci : int;
|
||||||
|
buf_height : int;
|
||||||
|
inrows : JDIMENSION;
|
||||||
|
var
|
||||||
|
row : int;
|
||||||
|
|
||||||
|
begin
|
||||||
|
prep := my_prep_ptr (cinfo^.prep);
|
||||||
|
buf_height := cinfo^.max_v_samp_factor * 3;
|
||||||
|
|
||||||
|
while (out_row_group_ctr < out_row_groups_avail) do
|
||||||
|
begin
|
||||||
|
if (in_row_ctr < in_rows_avail) then
|
||||||
|
begin
|
||||||
|
{ Do color conversion to fill the conversion buffer. }
|
||||||
|
inrows := in_rows_avail - in_row_ctr;
|
||||||
|
numrows := prep^.next_buf_stop - prep^.next_buf_row;
|
||||||
|
{numrows := int ( MIN( JDIMENSION(numrows), inrows) );}
|
||||||
|
if inrows < JDIMENSION(numrows) then
|
||||||
|
numrows := int(inrows);
|
||||||
|
cinfo^.cconvert^.color_convert (cinfo,
|
||||||
|
JSAMPARRAY(@input_buf^[in_row_ctr]),
|
||||||
|
JSAMPIMAGE(@prep^.color_buf),
|
||||||
|
JDIMENSION (prep^.next_buf_row),
|
||||||
|
numrows);
|
||||||
|
{ Pad at top of image, if first time through }
|
||||||
|
if (prep^.rows_to_go = cinfo^.image_height) then
|
||||||
|
begin
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
for row := 1 to cinfo^.max_v_samp_factor do
|
||||||
|
begin
|
||||||
|
jcopy_sample_rows(prep^.color_buf[ci], 0,
|
||||||
|
prep^.color_buf[ci], -row,
|
||||||
|
1, cinfo^.image_width);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(in_row_ctr, numrows);
|
||||||
|
Inc(prep^.next_buf_row, numrows);
|
||||||
|
Dec(prep^.rows_to_go, numrows);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Return for more data, unless we are at the bottom of the image. }
|
||||||
|
if (prep^.rows_to_go <> 0) then
|
||||||
|
break;
|
||||||
|
{ When at bottom of image, pad to fill the conversion buffer. }
|
||||||
|
if (prep^.next_buf_row < prep^.next_buf_stop) then
|
||||||
|
begin
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width,
|
||||||
|
prep^.next_buf_row, prep^.next_buf_stop);
|
||||||
|
end;
|
||||||
|
prep^.next_buf_row := prep^.next_buf_stop;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ If we've gotten enough data, downsample a row group. }
|
||||||
|
if (prep^.next_buf_row = prep^.next_buf_stop) then
|
||||||
|
begin
|
||||||
|
cinfo^.downsample^.downsample (cinfo,
|
||||||
|
JSAMPIMAGE(@prep^.color_buf),
|
||||||
|
JDIMENSION(prep^.this_row_group),
|
||||||
|
output_buf,
|
||||||
|
out_row_group_ctr);
|
||||||
|
Inc(out_row_group_ctr);
|
||||||
|
{ Advance pointers with wraparound as necessary. }
|
||||||
|
Inc(prep^.this_row_group, cinfo^.max_v_samp_factor);
|
||||||
|
if (prep^.this_row_group >= buf_height) then
|
||||||
|
prep^.this_row_group := 0;
|
||||||
|
if (prep^.next_buf_row >= buf_height) then
|
||||||
|
prep^.next_buf_row := 0;
|
||||||
|
prep^.next_buf_stop := prep^.next_buf_row + cinfo^.max_v_samp_factor;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Create the wrapped-around downsampling input buffer needed for context mode. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure create_context_buffer (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
prep : my_prep_ptr;
|
||||||
|
rgroup_height : int;
|
||||||
|
ci, i : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
true_buffer, fake_buffer : JSAMPARRAY;
|
||||||
|
begin
|
||||||
|
prep := my_prep_ptr (cinfo^.prep);
|
||||||
|
rgroup_height := cinfo^.max_v_samp_factor;
|
||||||
|
{ Grab enough space for fake row pointers for all the components;
|
||||||
|
we need five row groups' worth of pointers for each component. }
|
||||||
|
|
||||||
|
fake_buffer := JSAMPARRAY(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
(cinfo^.num_components * 5 * rgroup_height) *
|
||||||
|
SIZEOF(JSAMPROW)) );
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ Allocate the actual buffer space (3 row groups) for this component.
|
||||||
|
We make the buffer wide enough to allow the downsampler to edge-expand
|
||||||
|
horizontally within the buffer, if it so chooses. }
|
||||||
|
true_buffer := cinfo^.mem^.alloc_sarray
|
||||||
|
(j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE *
|
||||||
|
cinfo^.max_h_samp_factor) div compptr^.h_samp_factor),
|
||||||
|
JDIMENSION (3 * rgroup_height));
|
||||||
|
{ Copy true buffer row pointers into the middle of the fake row array }
|
||||||
|
MEMCOPY(JSAMPARRAY(@ fake_buffer^[rgroup_height]), true_buffer,
|
||||||
|
3 * rgroup_height * SIZEOF(JSAMPROW));
|
||||||
|
{ Fill in the above and below wraparound pointers }
|
||||||
|
for i := 0 to pred(rgroup_height) do
|
||||||
|
begin
|
||||||
|
fake_buffer^[i] := true_buffer^[2 * rgroup_height + i];
|
||||||
|
fake_buffer^[4 * rgroup_height + i] := true_buffer^[i];
|
||||||
|
end;
|
||||||
|
prep^.color_buf[ci] := JSAMPARRAY(@ fake_buffer^[rgroup_height]);
|
||||||
|
Inc(JSAMPROW_PTR(fake_buffer), 5 * rgroup_height); { point to space for next component }
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { CONTEXT_ROWS_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize preprocessing controller. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_c_prep_controller (cinfo : j_compress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
var
|
||||||
|
prep : my_prep_ptr;
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
|
||||||
|
if (need_full_buffer) then { safety check }
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
|
||||||
|
prep := my_prep_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_prep_controller)) );
|
||||||
|
cinfo^.prep := jpeg_c_prep_controller_ptr(prep);
|
||||||
|
prep^.pub.start_pass := start_pass_prep;
|
||||||
|
|
||||||
|
{ Allocate the color conversion buffer.
|
||||||
|
We make the buffer wide enough to allow the downsampler to edge-expand
|
||||||
|
horizontally within the buffer, if it so chooses. }
|
||||||
|
|
||||||
|
if (cinfo^.downsample^.need_context_rows) then
|
||||||
|
begin
|
||||||
|
{ Set up to provide context rows }
|
||||||
|
{$ifdef CONTEXT_ROWS_SUPPORTED}
|
||||||
|
prep^.pub.pre_process_data := pre_process_context;
|
||||||
|
create_context_buffer(cinfo);
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ No context, just make it tall enough for one row group }
|
||||||
|
prep^.pub.pre_process_data := pre_process_data;
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
prep^.color_buf[ci] := cinfo^.mem^.alloc_sarray
|
||||||
|
(j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE *
|
||||||
|
cinfo^.max_h_samp_factor) div compptr^.h_samp_factor),
|
||||||
|
JDIMENSION(cinfo^.max_v_samp_factor) );
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,631 @@
|
||||||
|
unit imjcsample;
|
||||||
|
|
||||||
|
{ This file contains downsampling routines.
|
||||||
|
|
||||||
|
Downsampling input data is counted in "row groups". A row group
|
||||||
|
is defined to be max_v_samp_factor pixel rows of each component,
|
||||||
|
from which the downsampler produces v_samp_factor sample rows.
|
||||||
|
A single row group is processed in each call to the downsampler module.
|
||||||
|
|
||||||
|
The downsampler is responsible for edge-expansion of its output data
|
||||||
|
to fill an integral number of DCT blocks horizontally. The source buffer
|
||||||
|
may be modified if it is helpful for this purpose (the source buffer is
|
||||||
|
allocated wide enough to correspond to the desired output width).
|
||||||
|
The caller (the prep controller) is responsible for vertical padding.
|
||||||
|
|
||||||
|
The downsampler may request "context rows" by setting need_context_rows
|
||||||
|
during startup. In this case, the input arrays will contain at least
|
||||||
|
one row group's worth of pixels above and below the passed-in data;
|
||||||
|
the caller will create dummy rows at image top and bottom by replicating
|
||||||
|
the first or last real pixel row.
|
||||||
|
|
||||||
|
An excellent reference for image resampling is
|
||||||
|
Digital Image Warping, George Wolberg, 1990.
|
||||||
|
Pub. by IEEE Computer Society Press, Los Alamitos, CA. ISBN 0-8186-8944-7.
|
||||||
|
|
||||||
|
The downsampling algorithm used here is a simple average of the source
|
||||||
|
pixels covered by the output pixel. The hi-falutin sampling literature
|
||||||
|
refers to this as a "box filter". In general the characteristics of a box
|
||||||
|
filter are not very good, but for the specific cases we normally use (1:1
|
||||||
|
and 2:1 ratios) the box is equivalent to a "triangle filter" which is not
|
||||||
|
nearly so bad. If you intend to use other sampling ratios, you'd be well
|
||||||
|
advised to improve this code.
|
||||||
|
|
||||||
|
A simple input-smoothing capability is provided. This is mainly intended
|
||||||
|
for cleaning up color-dithered GIF input files (if you find it inadequate,
|
||||||
|
we suggest using an external filtering program such as pnmconvol). When
|
||||||
|
enabled, each input pixel P is replaced by a weighted sum of itself and its
|
||||||
|
eight neighbors. P's weight is 1-8*SF and each neighbor's weight is SF,
|
||||||
|
where SF := (smoothing_factor / 1024).
|
||||||
|
Currently, smoothing is only supported for 2h2v sampling factors. }
|
||||||
|
|
||||||
|
{ Original: jcsample.c ; Copyright (C) 1991-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjutils,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
|
||||||
|
{ Module initialization routine for downsampling.
|
||||||
|
Note that we must select a routine for each component. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_downsampler (cinfo : j_compress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Pointer to routine to downsample a single component }
|
||||||
|
type
|
||||||
|
downsample1_ptr = procedure(cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
input_data : JSAMPARRAY;
|
||||||
|
output_data : JSAMPARRAY);
|
||||||
|
|
||||||
|
{ Private subobject }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_downsample_ptr = ^my_downsampler;
|
||||||
|
my_downsampler = record
|
||||||
|
pub : jpeg_downsampler; { public fields }
|
||||||
|
|
||||||
|
{ Downsampling method pointers, one per component }
|
||||||
|
methods : array[0..MAX_COMPONENTS-1] of downsample1_ptr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Initialize for a downsampling pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass_downsample (cinfo : j_compress_ptr);
|
||||||
|
begin
|
||||||
|
{ no work for now }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Expand a component horizontally from width input_cols to width output_cols,
|
||||||
|
by duplicating the rightmost samples. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure expand_right_edge (image_data : JSAMPARRAY;
|
||||||
|
num_rows : int;
|
||||||
|
input_cols : JDIMENSION;
|
||||||
|
output_cols : JDIMENSION);
|
||||||
|
var
|
||||||
|
{register} ptr : JSAMPLE_PTR;
|
||||||
|
{register} pixval : JSAMPLE;
|
||||||
|
{register} count : int;
|
||||||
|
row : int;
|
||||||
|
numcols : int;
|
||||||
|
begin
|
||||||
|
numcols := int (output_cols - input_cols);
|
||||||
|
|
||||||
|
if (numcols > 0) then
|
||||||
|
begin
|
||||||
|
for row := 0 to pred(num_rows) do
|
||||||
|
begin
|
||||||
|
ptr := JSAMPLE_PTR(@(image_data^[row]^[input_cols-1]));
|
||||||
|
pixval := ptr^; { don't need GETJSAMPLE() here }
|
||||||
|
for count := pred(numcols) downto 0 do
|
||||||
|
begin
|
||||||
|
Inc(ptr);
|
||||||
|
ptr^ := pixval;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Do downsampling for a whole row group (all components).
|
||||||
|
|
||||||
|
In this version we simply downsample each component independently. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure sep_downsample (cinfo : j_compress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE;
|
||||||
|
in_row_index : JDIMENSION;
|
||||||
|
output_buf : JSAMPIMAGE;
|
||||||
|
out_row_group_index : JDIMENSION);
|
||||||
|
var
|
||||||
|
downsample : my_downsample_ptr;
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
in_ptr, out_ptr : JSAMPARRAY;
|
||||||
|
begin
|
||||||
|
downsample := my_downsample_ptr (cinfo^.downsample);
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
in_ptr := JSAMPARRAY(@ input_buf^[ci]^[in_row_index]);
|
||||||
|
out_ptr := JSAMPARRAY(@ output_buf^[ci]^
|
||||||
|
[out_row_group_index * JDIMENSION(compptr^.v_samp_factor)]);
|
||||||
|
downsample^.methods[ci] (cinfo, compptr, in_ptr, out_ptr);
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Downsample pixel values of a single component.
|
||||||
|
One row group is processed per call.
|
||||||
|
This version handles arbitrary integral sampling ratios, without smoothing.
|
||||||
|
Note that this version is not actually used for customary sampling ratios. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure int_downsample (cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
input_data : JSAMPARRAY;
|
||||||
|
output_data : JSAMPARRAY);
|
||||||
|
var
|
||||||
|
inrow, outrow, h_expand, v_expand, numpix, numpix2, h, v : int;
|
||||||
|
outcol, outcol_h : JDIMENSION; { outcol_h = outcol*h_expand }
|
||||||
|
output_cols : JDIMENSION;
|
||||||
|
inptr,
|
||||||
|
outptr : JSAMPLE_PTR;
|
||||||
|
outvalue : INT32;
|
||||||
|
begin
|
||||||
|
output_cols := compptr^.width_in_blocks * DCTSIZE;
|
||||||
|
|
||||||
|
h_expand := cinfo^.max_h_samp_factor div compptr^.h_samp_factor;
|
||||||
|
v_expand := cinfo^.max_v_samp_factor div compptr^.v_samp_factor;
|
||||||
|
numpix := h_expand * v_expand;
|
||||||
|
numpix2 := numpix div 2;
|
||||||
|
|
||||||
|
{ Expand input data enough to let all the output samples be generated
|
||||||
|
by the standard loop. Special-casing padded output would be more
|
||||||
|
efficient. }
|
||||||
|
|
||||||
|
expand_right_edge(input_data, cinfo^.max_v_samp_factor,
|
||||||
|
cinfo^.image_width, output_cols * JDIMENSION(h_expand));
|
||||||
|
|
||||||
|
inrow := 0;
|
||||||
|
for outrow := 0 to pred(compptr^.v_samp_factor) do
|
||||||
|
begin
|
||||||
|
outptr := JSAMPLE_PTR(output_data^[outrow]);
|
||||||
|
outcol_h := 0;
|
||||||
|
for outcol := 0 to pred(output_cols) do
|
||||||
|
begin
|
||||||
|
outvalue := 0;
|
||||||
|
for v := 0 to pred(v_expand) do
|
||||||
|
begin
|
||||||
|
inptr := @(input_data^[inrow+v]^[outcol_h]);
|
||||||
|
for h := 0 to pred(h_expand) do
|
||||||
|
begin
|
||||||
|
Inc(outvalue, INT32 (GETJSAMPLE(inptr^)) );
|
||||||
|
Inc(inptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
outptr^ := JSAMPLE ((outvalue + numpix2) div numpix);
|
||||||
|
Inc(outptr);
|
||||||
|
Inc(outcol_h, h_expand);
|
||||||
|
end;
|
||||||
|
Inc(inrow, v_expand);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Downsample pixel values of a single component.
|
||||||
|
This version handles the special case of a full-size component,
|
||||||
|
without smoothing. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure fullsize_downsample (cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
input_data : JSAMPARRAY;
|
||||||
|
output_data : JSAMPARRAY);
|
||||||
|
begin
|
||||||
|
{ Copy the data }
|
||||||
|
jcopy_sample_rows(input_data, 0, output_data, 0,
|
||||||
|
cinfo^.max_v_samp_factor, cinfo^.image_width);
|
||||||
|
{ Edge-expand }
|
||||||
|
expand_right_edge(output_data, cinfo^.max_v_samp_factor,
|
||||||
|
cinfo^.image_width, compptr^.width_in_blocks * DCTSIZE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Downsample pixel values of a single component.
|
||||||
|
This version handles the common case of 2:1 horizontal and 1:1 vertical,
|
||||||
|
without smoothing.
|
||||||
|
|
||||||
|
A note about the "bias" calculations: when rounding fractional values to
|
||||||
|
integer, we do not want to always round 0.5 up to the next integer.
|
||||||
|
If we did that, we'd introduce a noticeable bias towards larger values.
|
||||||
|
Instead, this code is arranged so that 0.5 will be rounded up or down at
|
||||||
|
alternate pixel locations (a simple ordered dither pattern). }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure h2v1_downsample (cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
input_data : JSAMPARRAY;
|
||||||
|
output_data : JSAMPARRAY);
|
||||||
|
var
|
||||||
|
outrow : int;
|
||||||
|
outcol : JDIMENSION;
|
||||||
|
output_cols : JDIMENSION;
|
||||||
|
{register} inptr, outptr : JSAMPLE_PTR;
|
||||||
|
{register} bias : int;
|
||||||
|
begin
|
||||||
|
output_cols := compptr^.width_in_blocks * DCTSIZE;
|
||||||
|
|
||||||
|
{ Expand input data enough to let all the output samples be generated
|
||||||
|
by the standard loop. Special-casing padded output would be more
|
||||||
|
efficient. }
|
||||||
|
|
||||||
|
expand_right_edge(input_data, cinfo^.max_v_samp_factor,
|
||||||
|
cinfo^.image_width, output_cols * 2);
|
||||||
|
|
||||||
|
for outrow := 0 to pred(compptr^.v_samp_factor) do
|
||||||
|
begin
|
||||||
|
outptr := JSAMPLE_PTR(output_data^[outrow]);
|
||||||
|
inptr := JSAMPLE_PTR(input_data^[outrow]);
|
||||||
|
bias := 0; { bias := 0,1,0,1,... for successive samples }
|
||||||
|
for outcol := 0 to pred(output_cols) do
|
||||||
|
begin
|
||||||
|
outptr^ := JSAMPLE ((GETJSAMPLE(inptr^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(inptr)^[1]) + bias) shr 1);
|
||||||
|
Inc(outptr);
|
||||||
|
bias := bias xor 1; { 0=>1, 1=>0 }
|
||||||
|
Inc(inptr, 2);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Downsample pixel values of a single component.
|
||||||
|
This version handles the standard case of 2:1 horizontal and 2:1 vertical,
|
||||||
|
without smoothing. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure h2v2_downsample (cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
input_data : JSAMPARRAY;
|
||||||
|
output_data : JSAMPARRAY);
|
||||||
|
var
|
||||||
|
inrow, outrow : int;
|
||||||
|
outcol : JDIMENSION;
|
||||||
|
output_cols : JDIMENSION;
|
||||||
|
{register} inptr0, inptr1, outptr : JSAMPLE_PTR;
|
||||||
|
{register} bias : int;
|
||||||
|
begin
|
||||||
|
output_cols := compptr^.width_in_blocks * DCTSIZE;
|
||||||
|
|
||||||
|
{ Expand input data enough to let all the output samples be generated
|
||||||
|
by the standard loop. Special-casing padded output would be more
|
||||||
|
efficient. }
|
||||||
|
|
||||||
|
expand_right_edge(input_data, cinfo^.max_v_samp_factor,
|
||||||
|
cinfo^.image_width, output_cols * 2);
|
||||||
|
|
||||||
|
inrow := 0;
|
||||||
|
for outrow := 0 to pred(compptr^.v_samp_factor) do
|
||||||
|
begin
|
||||||
|
outptr := JSAMPLE_PTR(output_data^[outrow]);
|
||||||
|
inptr0 := JSAMPLE_PTR(input_data^[inrow]);
|
||||||
|
inptr1 := JSAMPLE_PTR(input_data^[inrow+1]);
|
||||||
|
bias := 1; { bias := 1,2,1,2,... for successive samples }
|
||||||
|
for outcol := 0 to pred(output_cols) do
|
||||||
|
begin
|
||||||
|
outptr^ := JSAMPLE ((GETJSAMPLE(inptr0^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(inptr0)^[1]) +
|
||||||
|
GETJSAMPLE(inptr1^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(inptr1)^[1]) + bias) shr 2);
|
||||||
|
Inc(outptr);
|
||||||
|
bias := bias xor 3; { 1=>2, 2=>1 }
|
||||||
|
Inc(inptr0, 2);
|
||||||
|
Inc(inptr1, 2);
|
||||||
|
end;
|
||||||
|
Inc(inrow, 2);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef INPUT_SMOOTHING_SUPPORTED}
|
||||||
|
|
||||||
|
{ Downsample pixel values of a single component.
|
||||||
|
This version handles the standard case of 2:1 horizontal and 2:1 vertical,
|
||||||
|
with smoothing. One row of context is required. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure h2v2_smooth_downsample (cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
input_data : JSAMPARRAY;
|
||||||
|
output_data : JSAMPARRAY);
|
||||||
|
var
|
||||||
|
inrow, outrow : int;
|
||||||
|
colctr : JDIMENSION;
|
||||||
|
output_cols : JDIMENSION;
|
||||||
|
{register} inptr0, inptr1, above_ptr, below_ptr, outptr : JSAMPLE_PTR;
|
||||||
|
membersum, neighsum, memberscale, neighscale : INT32;
|
||||||
|
var
|
||||||
|
prev_input_data : JSAMPARRAY;
|
||||||
|
prev_inptr0, prev_inptr1, prev_above_ptr, prev_below_ptr : JSAMPLE_PTR;
|
||||||
|
begin
|
||||||
|
output_cols := compptr^.width_in_blocks * DCTSIZE;
|
||||||
|
|
||||||
|
{ Expand input data enough to let all the output samples be generated
|
||||||
|
by the standard loop. Special-casing padded output would be more
|
||||||
|
efficient. }
|
||||||
|
|
||||||
|
prev_input_data := input_data;
|
||||||
|
Dec(JSAMPROW_PTR(prev_input_data));
|
||||||
|
expand_right_edge(prev_input_data, cinfo^.max_v_samp_factor + 2,
|
||||||
|
cinfo^.image_width, output_cols * 2);
|
||||||
|
|
||||||
|
{ We don't bother to form the individual "smoothed" input pixel values;
|
||||||
|
we can directly compute the output which is the average of the four
|
||||||
|
smoothed values. Each of the four member pixels contributes a fraction
|
||||||
|
(1-8*SF) to its own smoothed image and a fraction SF to each of the three
|
||||||
|
other smoothed pixels, therefore a total fraction (1-5*SF)/4 to the final
|
||||||
|
output. The four corner-adjacent neighbor pixels contribute a fraction
|
||||||
|
SF to just one smoothed pixel, or SF/4 to the final output; while the
|
||||||
|
eight edge-adjacent neighbors contribute SF to each of two smoothed
|
||||||
|
pixels, or SF/2 overall. In order to use integer arithmetic, these
|
||||||
|
factors are scaled by 2^16 := 65536.
|
||||||
|
Also recall that SF := smoothing_factor / 1024. }
|
||||||
|
|
||||||
|
memberscale := 16384 - cinfo^.smoothing_factor * 80; { scaled (1-5*SF)/4 }
|
||||||
|
neighscale := cinfo^.smoothing_factor * 16; { scaled SF/4 }
|
||||||
|
|
||||||
|
inrow := 0;
|
||||||
|
for outrow := 0 to pred(compptr^.v_samp_factor) do
|
||||||
|
begin
|
||||||
|
outptr := JSAMPLE_PTR(output_data^[outrow]);
|
||||||
|
inptr0 := JSAMPLE_PTR(input_data^[inrow]);
|
||||||
|
inptr1 := JSAMPLE_PTR(input_data^[inrow+1]);
|
||||||
|
above_ptr := JSAMPLE_PTR(input_data^[inrow-1]);
|
||||||
|
below_ptr := JSAMPLE_PTR(input_data^[inrow+2]);
|
||||||
|
|
||||||
|
{ Special case for first column: pretend column -1 is same as column 0 }
|
||||||
|
membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) +
|
||||||
|
GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]);
|
||||||
|
neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) +
|
||||||
|
GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) +
|
||||||
|
GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[2]) +
|
||||||
|
GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[2]);
|
||||||
|
Inc(neighsum, neighsum);
|
||||||
|
Inc(neighsum, GETJSAMPLE(above_ptr^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(above_ptr)^[2]) +
|
||||||
|
GETJSAMPLE(below_ptr^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(below_ptr)^[2]) );
|
||||||
|
membersum := membersum * memberscale + neighsum * neighscale;
|
||||||
|
outptr^ := JSAMPLE ((membersum + 32768) shr 16);
|
||||||
|
Inc(outptr);
|
||||||
|
prev_inptr0 := inptr0;
|
||||||
|
prev_inptr1 := inptr1;
|
||||||
|
Inc(prev_inptr0);
|
||||||
|
Inc(prev_inptr1);
|
||||||
|
Inc(inptr0, 2);
|
||||||
|
Inc(inptr1, 2);
|
||||||
|
prev_above_ptr := above_ptr;
|
||||||
|
prev_below_ptr := below_ptr;
|
||||||
|
Inc(above_ptr, 2);
|
||||||
|
Inc(below_ptr, 2);
|
||||||
|
Inc(prev_above_ptr, 1);
|
||||||
|
Inc(prev_below_ptr, 1);
|
||||||
|
|
||||||
|
for colctr := pred(output_cols - 2) downto 0 do
|
||||||
|
begin
|
||||||
|
{ sum of pixels directly mapped to this output element }
|
||||||
|
membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) +
|
||||||
|
GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]);
|
||||||
|
{ sum of edge-neighbor pixels }
|
||||||
|
neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) +
|
||||||
|
GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) +
|
||||||
|
GETJSAMPLE(prev_inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[2]) +
|
||||||
|
GETJSAMPLE(prev_inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[2]);
|
||||||
|
{ The edge-neighbors count twice as much as corner-neighbors }
|
||||||
|
Inc(neighsum, neighsum);
|
||||||
|
{ Add in the corner-neighbors }
|
||||||
|
Inc(neighsum, GETJSAMPLE(prev_above_ptr^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(above_ptr)^[2]) +
|
||||||
|
GETJSAMPLE(prev_below_ptr^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(below_ptr)^[2]) );
|
||||||
|
{ form final output scaled up by 2^16 }
|
||||||
|
membersum := membersum * memberscale + neighsum * neighscale;
|
||||||
|
{ round, descale and output it }
|
||||||
|
outptr^ := JSAMPLE ((membersum + 32768) shr 16);
|
||||||
|
Inc(outptr);
|
||||||
|
Inc(inptr0, 2);
|
||||||
|
Inc(inptr1, 2);
|
||||||
|
Inc(prev_inptr0, 2);
|
||||||
|
Inc(prev_inptr1, 2);
|
||||||
|
Inc(above_ptr, 2);
|
||||||
|
Inc(below_ptr, 2);
|
||||||
|
Inc(prev_above_ptr, 2);
|
||||||
|
Inc(prev_below_ptr, 2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Special case for last column }
|
||||||
|
membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) +
|
||||||
|
GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]);
|
||||||
|
neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) +
|
||||||
|
GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) +
|
||||||
|
GETJSAMPLE(prev_inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) +
|
||||||
|
GETJSAMPLE(prev_inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]);
|
||||||
|
Inc(neighsum, neighsum);
|
||||||
|
Inc(neighsum, GETJSAMPLE(prev_above_ptr^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(above_ptr)^[1]) +
|
||||||
|
GETJSAMPLE(prev_below_ptr^) +
|
||||||
|
GETJSAMPLE(JSAMPROW(below_ptr)^[1]) );
|
||||||
|
membersum := membersum * memberscale + neighsum * neighscale;
|
||||||
|
outptr^ := JSAMPLE ((membersum + 32768) shr 16);
|
||||||
|
|
||||||
|
Inc(inrow, 2);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Downsample pixel values of a single component.
|
||||||
|
This version handles the special case of a full-size component,
|
||||||
|
with smoothing. One row of context is required. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure fullsize_smooth_downsample (cinfo : j_compress_ptr;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
input_data : JSAMPARRAY;
|
||||||
|
output_data : JSAMPARRAY);
|
||||||
|
var
|
||||||
|
outrow : int;
|
||||||
|
colctr : JDIMENSION;
|
||||||
|
output_cols : JDIMENSION;
|
||||||
|
{register} inptr, above_ptr, below_ptr, outptr : JSAMPLE_PTR;
|
||||||
|
membersum, neighsum, memberscale, neighscale : INT32;
|
||||||
|
colsum, lastcolsum, nextcolsum : int;
|
||||||
|
var
|
||||||
|
prev_input_data : JSAMPARRAY;
|
||||||
|
begin
|
||||||
|
output_cols := compptr^.width_in_blocks * DCTSIZE;
|
||||||
|
|
||||||
|
{ Expand input data enough to let all the output samples be generated
|
||||||
|
by the standard loop. Special-casing padded output would be more
|
||||||
|
efficient. }
|
||||||
|
|
||||||
|
prev_input_data := input_data;
|
||||||
|
Dec(JSAMPROW_PTR(prev_input_data));
|
||||||
|
expand_right_edge(prev_input_data, cinfo^.max_v_samp_factor + 2,
|
||||||
|
cinfo^.image_width, output_cols);
|
||||||
|
|
||||||
|
{ Each of the eight neighbor pixels contributes a fraction SF to the
|
||||||
|
smoothed pixel, while the main pixel contributes (1-8*SF). In order
|
||||||
|
to use integer arithmetic, these factors are multiplied by 2^16 := 65536.
|
||||||
|
Also recall that SF := smoothing_factor / 1024. }
|
||||||
|
|
||||||
|
memberscale := long(65536) - cinfo^.smoothing_factor * long(512); { scaled 1-8*SF }
|
||||||
|
neighscale := cinfo^.smoothing_factor * 64; { scaled SF }
|
||||||
|
|
||||||
|
for outrow := 0 to pred(compptr^.v_samp_factor) do
|
||||||
|
begin
|
||||||
|
outptr := JSAMPLE_PTR(output_data^[outrow]);
|
||||||
|
inptr := JSAMPLE_PTR(input_data^[outrow]);
|
||||||
|
above_ptr := JSAMPLE_PTR(input_data^[outrow-1]);
|
||||||
|
below_ptr := JSAMPLE_PTR(input_data^[outrow+1]);
|
||||||
|
|
||||||
|
{ Special case for first column }
|
||||||
|
colsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) +
|
||||||
|
GETJSAMPLE(inptr^);
|
||||||
|
Inc(above_ptr);
|
||||||
|
Inc(below_ptr);
|
||||||
|
membersum := GETJSAMPLE(inptr^);
|
||||||
|
Inc(inptr);
|
||||||
|
nextcolsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) +
|
||||||
|
GETJSAMPLE(inptr^);
|
||||||
|
neighsum := colsum + (colsum - membersum) + nextcolsum;
|
||||||
|
membersum := membersum * memberscale + neighsum * neighscale;
|
||||||
|
outptr^ := JSAMPLE ((membersum + 32768) shr 16);
|
||||||
|
Inc(outptr);
|
||||||
|
lastcolsum := colsum; colsum := nextcolsum;
|
||||||
|
|
||||||
|
for colctr := pred(output_cols - 2) downto 0 do
|
||||||
|
begin
|
||||||
|
membersum := GETJSAMPLE(inptr^);
|
||||||
|
Inc(inptr);
|
||||||
|
Inc(above_ptr);
|
||||||
|
Inc(below_ptr);
|
||||||
|
nextcolsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) +
|
||||||
|
GETJSAMPLE(inptr^);
|
||||||
|
neighsum := lastcolsum + (colsum - membersum) + nextcolsum;
|
||||||
|
membersum := membersum * memberscale + neighsum * neighscale;
|
||||||
|
outptr^ := JSAMPLE ((membersum + 32768) shr 16);
|
||||||
|
Inc(outptr);
|
||||||
|
lastcolsum := colsum; colsum := nextcolsum;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Special case for last column }
|
||||||
|
membersum := GETJSAMPLE(inptr^);
|
||||||
|
neighsum := lastcolsum + (colsum - membersum) + colsum;
|
||||||
|
membersum := membersum * memberscale + neighsum * neighscale;
|
||||||
|
outptr^ := JSAMPLE ((membersum + 32768) shr 16);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { INPUT_SMOOTHING_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{ Module initialization routine for downsampling.
|
||||||
|
Note that we must select a routine for each component. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_downsampler (cinfo : j_compress_ptr);
|
||||||
|
var
|
||||||
|
downsample : my_downsample_ptr;
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
smoothok : boolean;
|
||||||
|
begin
|
||||||
|
smoothok := TRUE;
|
||||||
|
|
||||||
|
downsample := my_downsample_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_downsampler)) );
|
||||||
|
cinfo^.downsample := jpeg_downsampler_ptr (downsample);
|
||||||
|
downsample^.pub.start_pass := start_pass_downsample;
|
||||||
|
downsample^.pub.downsample := sep_downsample;
|
||||||
|
downsample^.pub.need_context_rows := FALSE;
|
||||||
|
|
||||||
|
if (cinfo^.CCIR601_sampling) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CCIR601_NOTIMPL);
|
||||||
|
|
||||||
|
{ Verify we can handle the sampling factors, and set up method pointers }
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
if (compptr^.h_samp_factor = cinfo^.max_h_samp_factor) and
|
||||||
|
(compptr^.v_samp_factor = cinfo^.max_v_samp_factor) then
|
||||||
|
begin
|
||||||
|
{$ifdef INPUT_SMOOTHING_SUPPORTED}
|
||||||
|
if (cinfo^.smoothing_factor <> 0) then
|
||||||
|
begin
|
||||||
|
downsample^.methods[ci] := fullsize_smooth_downsample;
|
||||||
|
downsample^.pub.need_context_rows := TRUE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{$endif}
|
||||||
|
downsample^.methods[ci] := fullsize_downsample;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (compptr^.h_samp_factor * 2 = cinfo^.max_h_samp_factor) and
|
||||||
|
(compptr^.v_samp_factor = cinfo^.max_v_samp_factor) then
|
||||||
|
begin
|
||||||
|
smoothok := FALSE;
|
||||||
|
downsample^.methods[ci] := h2v1_downsample;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (compptr^.h_samp_factor * 2 = cinfo^.max_h_samp_factor) and
|
||||||
|
(compptr^.v_samp_factor * 2 = cinfo^.max_v_samp_factor) then
|
||||||
|
begin
|
||||||
|
{$ifdef INPUT_SMOOTHING_SUPPORTED}
|
||||||
|
if (cinfo^.smoothing_factor <> 0) then
|
||||||
|
begin
|
||||||
|
downsample^.methods[ci] := h2v2_smooth_downsample;
|
||||||
|
downsample^.pub.need_context_rows := TRUE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{$endif}
|
||||||
|
downsample^.methods[ci] := h2v2_downsample;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if ((cinfo^.max_h_samp_factor mod compptr^.h_samp_factor) = 0) and
|
||||||
|
((cinfo^.max_v_samp_factor mod compptr^.v_samp_factor) = 0) then
|
||||||
|
begin
|
||||||
|
smoothok := FALSE;
|
||||||
|
downsample^.methods[ci] := int_downsample;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_FRACT_SAMPLE_NOTIMPL);
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifdef INPUT_SMOOTHING_SUPPORTED}
|
||||||
|
if (cinfo^.smoothing_factor <> 0) and (not smoothok) then
|
||||||
|
TRACEMS(j_common_ptr(cinfo), 0, JTRC_SMOOTH_NOTIMPL);
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,505 @@
|
||||||
|
unit imjdapimin;
|
||||||
|
|
||||||
|
{$N+} { Nomssi: cinfo^.output_gamma }
|
||||||
|
|
||||||
|
{ This file contains application interface code for the decompression half
|
||||||
|
of the JPEG library. These are the "minimum" API routines that may be
|
||||||
|
needed in either the normal full-decompression case or the
|
||||||
|
transcoding-only case.
|
||||||
|
|
||||||
|
Most of the routines intended to be called directly by an application
|
||||||
|
are in this file or in jdapistd.c. But also see jcomapi.c for routines
|
||||||
|
shared by compression and decompression, and jdtrans.c for the transcoding
|
||||||
|
case. }
|
||||||
|
|
||||||
|
{ Original : jdapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib,
|
||||||
|
imjmemmgr, imjdmarker, imjdinput, imjcomapi;
|
||||||
|
|
||||||
|
{ Nomssi }
|
||||||
|
procedure jpeg_create_decompress(cinfo : j_decompress_ptr);
|
||||||
|
|
||||||
|
{ Initialization of a JPEG decompression object.
|
||||||
|
The error manager must already be set up (in case memory manager fails). }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_CreateDecompress (cinfo : j_decompress_ptr;
|
||||||
|
version : int;
|
||||||
|
structsize : size_t);
|
||||||
|
|
||||||
|
{ Destruction of a JPEG decompression object }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_destroy_decompress (cinfo : j_decompress_ptr);
|
||||||
|
|
||||||
|
|
||||||
|
{ Decompression startup: read start of JPEG datastream to see what's there.
|
||||||
|
Need only initialize JPEG object and supply a data source before calling.
|
||||||
|
|
||||||
|
This routine will read as far as the first SOS marker (ie, actual start of
|
||||||
|
compressed data), and will save all tables and parameters in the JPEG
|
||||||
|
object. It will also initialize the decompression parameters to default
|
||||||
|
values, and finally return JPEG_HEADER_OK. On return, the application may
|
||||||
|
adjust the decompression parameters and then call jpeg_start_decompress.
|
||||||
|
(Or, if the application only wanted to determine the image parameters,
|
||||||
|
the data need not be decompressed. In that case, call jpeg_abort or
|
||||||
|
jpeg_destroy to release any temporary space.)
|
||||||
|
If an abbreviated (tables only) datastream is presented, the routine will
|
||||||
|
return JPEG_HEADER_TABLES_ONLY upon reaching EOI. The application may then
|
||||||
|
re-use the JPEG object to read the abbreviated image datastream(s).
|
||||||
|
It is unnecessary (but OK) to call jpeg_abort in this case.
|
||||||
|
The JPEG_SUSPENDED return code only occurs if the data source module
|
||||||
|
requests suspension of the decompressor. In this case the application
|
||||||
|
should load more source data and then re-call jpeg_read_header to resume
|
||||||
|
processing.
|
||||||
|
If a non-suspending data source is used and require_image is TRUE, then the
|
||||||
|
return code need not be inspected since only JPEG_HEADER_OK is possible.
|
||||||
|
|
||||||
|
This routine is now just a front end to jpeg_consume_input, with some
|
||||||
|
extra error checking. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_read_header (cinfo : j_decompress_ptr;
|
||||||
|
require_image : boolean) : int;
|
||||||
|
|
||||||
|
{ Consume data in advance of what the decompressor requires.
|
||||||
|
This can be called at any time once the decompressor object has
|
||||||
|
been created and a data source has been set up.
|
||||||
|
|
||||||
|
This routine is essentially a state machine that handles a couple
|
||||||
|
of critical state-transition actions, namely initial setup and
|
||||||
|
transition from header scanning to ready-for-start_decompress.
|
||||||
|
All the actual input is done via the input controller's consume_input
|
||||||
|
method. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_consume_input (cinfo : j_decompress_ptr) : int;
|
||||||
|
|
||||||
|
{ Have we finished reading the input file? }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_input_complete (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
|
||||||
|
{ Is there more than one scan? }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_has_multiple_scans (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish JPEG decompression.
|
||||||
|
|
||||||
|
This will normally just verify the file trailer and release temp storage.
|
||||||
|
|
||||||
|
Returns FALSE if suspended. The return value need be inspected only if
|
||||||
|
a suspending data source is used. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_finish_decompress (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure jpeg_create_decompress(cinfo : j_decompress_ptr);
|
||||||
|
begin
|
||||||
|
jpeg_CreateDecompress(cinfo, JPEG_LIB_VERSION,
|
||||||
|
size_t(sizeof(jpeg_decompress_struct)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Initialization of a JPEG decompression object.
|
||||||
|
The error manager must already be set up (in case memory manager fails). }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_CreateDecompress (cinfo : j_decompress_ptr;
|
||||||
|
version : int;
|
||||||
|
structsize : size_t);
|
||||||
|
var
|
||||||
|
i : int;
|
||||||
|
var
|
||||||
|
err : jpeg_error_mgr_ptr;
|
||||||
|
client_data : voidp;
|
||||||
|
begin
|
||||||
|
{ Guard against version mismatches between library and caller. }
|
||||||
|
cinfo^.mem := NIL; { so jpeg_destroy knows mem mgr not called }
|
||||||
|
if (version <> JPEG_LIB_VERSION) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_LIB_VERSION, JPEG_LIB_VERSION, version);
|
||||||
|
if (structsize <> SIZEOF(jpeg_decompress_struct)) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE,
|
||||||
|
int(SIZEOF(jpeg_decompress_struct)), int(structsize));
|
||||||
|
|
||||||
|
{ For debugging purposes, we zero the whole master structure.
|
||||||
|
But the application has already set the err pointer, and may have set
|
||||||
|
client_data, so we have to save and restore those fields.
|
||||||
|
Note: if application hasn't set client_data, tools like Purify may
|
||||||
|
complain here. }
|
||||||
|
begin
|
||||||
|
err := cinfo^.err;
|
||||||
|
client_data := cinfo^.client_data; { ignore Purify complaint here }
|
||||||
|
MEMZERO(j_common_ptr(cinfo), SIZEOF(jpeg_decompress_struct));
|
||||||
|
cinfo^.err := err;
|
||||||
|
cinfo^.client_data := client_data;
|
||||||
|
end;
|
||||||
|
cinfo^.is_decompressor := TRUE;
|
||||||
|
|
||||||
|
{ Initialize a memory manager instance for this object }
|
||||||
|
jinit_memory_mgr(j_common_ptr(cinfo));
|
||||||
|
|
||||||
|
{ Zero out pointers to permanent structures. }
|
||||||
|
cinfo^.progress := NIL;
|
||||||
|
cinfo^.src := NIL;
|
||||||
|
|
||||||
|
for i := 0 to pred(NUM_QUANT_TBLS) do
|
||||||
|
cinfo^.quant_tbl_ptrs[i] := NIL;
|
||||||
|
|
||||||
|
for i := 0 to pred(NUM_HUFF_TBLS) do
|
||||||
|
begin
|
||||||
|
cinfo^.dc_huff_tbl_ptrs[i] := NIL;
|
||||||
|
cinfo^.ac_huff_tbl_ptrs[i] := NIL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Initialize marker processor so application can override methods
|
||||||
|
for COM, APPn markers before calling jpeg_read_header. }
|
||||||
|
cinfo^.marker_list := NIL;
|
||||||
|
jinit_marker_reader(cinfo);
|
||||||
|
|
||||||
|
{ And initialize the overall input controller. }
|
||||||
|
jinit_input_controller(cinfo);
|
||||||
|
|
||||||
|
{ OK, I'm ready }
|
||||||
|
cinfo^.global_state := DSTATE_START;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Destruction of a JPEG decompression object }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_destroy_decompress (cinfo : j_decompress_ptr);
|
||||||
|
begin
|
||||||
|
jpeg_destroy(j_common_ptr(cinfo)); { use common routine }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Abort processing of a JPEG decompression operation,
|
||||||
|
but don't destroy the object itself. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_abort_decompress (cinfo : j_decompress_ptr);
|
||||||
|
begin
|
||||||
|
jpeg_abort(j_common_ptr(cinfo)); { use common routine }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Set default decompression parameters. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure default_decompress_parms (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
cid0 : int;
|
||||||
|
cid1 : int;
|
||||||
|
cid2 : int;
|
||||||
|
begin
|
||||||
|
{ Guess the input colorspace, and set output colorspace accordingly. }
|
||||||
|
{ (Wish JPEG committee had provided a real way to specify this...) }
|
||||||
|
{ Note application may override our guesses. }
|
||||||
|
case (cinfo^.num_components) of
|
||||||
|
1: begin
|
||||||
|
cinfo^.jpeg_color_space := JCS_GRAYSCALE;
|
||||||
|
cinfo^.out_color_space := JCS_GRAYSCALE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
3: begin
|
||||||
|
if (cinfo^.saw_JFIF_marker) then
|
||||||
|
begin
|
||||||
|
cinfo^.jpeg_color_space := JCS_YCbCr; { JFIF implies YCbCr }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.saw_Adobe_marker) then
|
||||||
|
begin
|
||||||
|
case (cinfo^.Adobe_transform) of
|
||||||
|
0: cinfo^.jpeg_color_space := JCS_RGB;
|
||||||
|
1: cinfo^.jpeg_color_space := JCS_YCbCr;
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
WARNMS1(j_common_ptr(cinfo), JWRN_ADOBE_XFORM, cinfo^.Adobe_transform);
|
||||||
|
cinfo^.jpeg_color_space := JCS_YCbCr; { assume it's YCbCr }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Saw no special markers, try to guess from the component IDs }
|
||||||
|
cid0 := cinfo^.comp_info^[0].component_id;
|
||||||
|
cid1 := cinfo^.comp_info^[1].component_id;
|
||||||
|
cid2 := cinfo^.comp_info^[2].component_id;
|
||||||
|
|
||||||
|
if (cid0 = 1) and (cid1 = 2) and (cid2 = 3) then
|
||||||
|
cinfo^.jpeg_color_space := JCS_YCbCr { assume JFIF w/out marker }
|
||||||
|
else
|
||||||
|
if (cid0 = 82) and (cid1 = 71) and (cid2 = 66) then
|
||||||
|
cinfo^.jpeg_color_space := JCS_RGB { ASCII 'R', 'G', 'B' }
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{$IFDEF DEBUG}
|
||||||
|
TRACEMS3(j_common_ptr(cinfo), 1, JTRC_UNKNOWN_IDS, cid0, cid1, cid2);
|
||||||
|
{$ENDIF}
|
||||||
|
cinfo^.jpeg_color_space := JCS_YCbCr; { assume it's YCbCr }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Always guess RGB is proper output colorspace. }
|
||||||
|
cinfo^.out_color_space := JCS_RGB;
|
||||||
|
end;
|
||||||
|
|
||||||
|
4: begin
|
||||||
|
if (cinfo^.saw_Adobe_marker) then
|
||||||
|
begin
|
||||||
|
case (cinfo^.Adobe_transform) of
|
||||||
|
0: cinfo^.jpeg_color_space := JCS_CMYK;
|
||||||
|
2: cinfo^.jpeg_color_space := JCS_YCCK;
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
WARNMS1(j_common_ptr(cinfo), JWRN_ADOBE_XFORM, cinfo^.Adobe_transform);
|
||||||
|
cinfo^.jpeg_color_space := JCS_YCCK; { assume it's YCCK }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ No special markers, assume straight CMYK. }
|
||||||
|
cinfo^.jpeg_color_space := JCS_CMYK;
|
||||||
|
end;
|
||||||
|
cinfo^.out_color_space := JCS_CMYK;
|
||||||
|
end;
|
||||||
|
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
cinfo^.jpeg_color_space := JCS_UNKNOWN;
|
||||||
|
cinfo^.out_color_space := JCS_UNKNOWN;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Set defaults for other decompression parameters. }
|
||||||
|
cinfo^.scale_num := 1; { 1:1 scaling }
|
||||||
|
cinfo^.scale_denom := 1;
|
||||||
|
cinfo^.output_gamma := 1.0;
|
||||||
|
cinfo^.buffered_image := FALSE;
|
||||||
|
cinfo^.raw_data_out := FALSE;
|
||||||
|
cinfo^.dct_method := JDCT_DEFAULT;
|
||||||
|
cinfo^.do_fancy_upsampling := TRUE;
|
||||||
|
cinfo^.do_block_smoothing := TRUE;
|
||||||
|
cinfo^.quantize_colors := FALSE;
|
||||||
|
{ We set these in case application only sets quantize_colors. }
|
||||||
|
cinfo^.dither_mode := JDITHER_FS;
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
cinfo^.two_pass_quantize := TRUE;
|
||||||
|
{$else}
|
||||||
|
cinfo^.two_pass_quantize := FALSE;
|
||||||
|
{$endif}
|
||||||
|
cinfo^.desired_number_of_colors := 256;
|
||||||
|
cinfo^.colormap := NIL;
|
||||||
|
{ Initialize for no mode change in buffered-image mode. }
|
||||||
|
cinfo^.enable_1pass_quant := FALSE;
|
||||||
|
cinfo^.enable_external_quant := FALSE;
|
||||||
|
cinfo^.enable_2pass_quant := FALSE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Decompression startup: read start of JPEG datastream to see what's there.
|
||||||
|
Need only initialize JPEG object and supply a data source before calling.
|
||||||
|
|
||||||
|
This routine will read as far as the first SOS marker (ie, actual start of
|
||||||
|
compressed data), and will save all tables and parameters in the JPEG
|
||||||
|
object. It will also initialize the decompression parameters to default
|
||||||
|
values, and finally return JPEG_HEADER_OK. On return, the application may
|
||||||
|
adjust the decompression parameters and then call jpeg_start_decompress.
|
||||||
|
(Or, if the application only wanted to determine the image parameters,
|
||||||
|
the data need not be decompressed. In that case, call jpeg_abort or
|
||||||
|
jpeg_destroy to release any temporary space.)
|
||||||
|
If an abbreviated (tables only) datastream is presented, the routine will
|
||||||
|
return JPEG_HEADER_TABLES_ONLY upon reaching EOI. The application may then
|
||||||
|
re-use the JPEG object to read the abbreviated image datastream(s).
|
||||||
|
It is unnecessary (but OK) to call jpeg_abort in this case.
|
||||||
|
The JPEG_SUSPENDED return code only occurs if the data source module
|
||||||
|
requests suspension of the decompressor. In this case the application
|
||||||
|
should load more source data and then re-call jpeg_read_header to resume
|
||||||
|
processing.
|
||||||
|
If a non-suspending data source is used and require_image is TRUE, then the
|
||||||
|
return code need not be inspected since only JPEG_HEADER_OK is possible.
|
||||||
|
|
||||||
|
This routine is now just a front end to jpeg_consume_input, with some
|
||||||
|
extra error checking. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_read_header (cinfo : j_decompress_ptr;
|
||||||
|
require_image : boolean) : int;
|
||||||
|
var
|
||||||
|
retcode : int;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> DSTATE_START) and
|
||||||
|
(cinfo^.global_state <> DSTATE_INHEADER) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
retcode := jpeg_consume_input(cinfo);
|
||||||
|
|
||||||
|
case (retcode) of
|
||||||
|
JPEG_REACHED_SOS:
|
||||||
|
retcode := JPEG_HEADER_OK;
|
||||||
|
JPEG_REACHED_EOI:
|
||||||
|
begin
|
||||||
|
if (require_image) then { Complain if application wanted an image }
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NO_IMAGE);
|
||||||
|
{ Reset to start state; it would be safer to require the application to
|
||||||
|
call jpeg_abort, but we can't change it now for compatibility reasons.
|
||||||
|
A side effect is to free any temporary memory (there shouldn't be any). }
|
||||||
|
|
||||||
|
jpeg_abort(j_common_ptr(cinfo)); { sets state := DSTATE_START }
|
||||||
|
retcode := JPEG_HEADER_TABLES_ONLY;
|
||||||
|
end;
|
||||||
|
JPEG_SUSPENDED: ; { no work }
|
||||||
|
end;
|
||||||
|
|
||||||
|
jpeg_read_header := retcode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Consume data in advance of what the decompressor requires.
|
||||||
|
This can be called at any time once the decompressor object has
|
||||||
|
been created and a data source has been set up.
|
||||||
|
|
||||||
|
This routine is essentially a state machine that handles a couple
|
||||||
|
of critical state-transition actions, namely initial setup and
|
||||||
|
transition from header scanning to ready-for-start_decompress.
|
||||||
|
All the actual input is done via the input controller's consume_input
|
||||||
|
method. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_consume_input (cinfo : j_decompress_ptr) : int;
|
||||||
|
var
|
||||||
|
retcode : int;
|
||||||
|
begin
|
||||||
|
retcode := JPEG_SUSPENDED;
|
||||||
|
|
||||||
|
{ NB: every possible DSTATE value should be listed in this switch }
|
||||||
|
|
||||||
|
if (cinfo^.global_state) = DSTATE_START then
|
||||||
|
begin {work around the FALLTHROUGH}
|
||||||
|
{ Start-of-datastream actions: reset appropriate modules }
|
||||||
|
cinfo^.inputctl^.reset_input_controller (cinfo);
|
||||||
|
{ Initialize application's data source module }
|
||||||
|
cinfo^.src^.init_source (cinfo);
|
||||||
|
cinfo^.global_state := DSTATE_INHEADER;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case (cinfo^.global_state) of
|
||||||
|
DSTATE_START,
|
||||||
|
DSTATE_INHEADER:
|
||||||
|
begin
|
||||||
|
retcode := cinfo^.inputctl^.consume_input (cinfo);
|
||||||
|
if (retcode = JPEG_REACHED_SOS) then
|
||||||
|
begin { Found SOS, prepare to decompress }
|
||||||
|
{ Set up default parameters based on header data }
|
||||||
|
default_decompress_parms(cinfo);
|
||||||
|
{ Set global state: ready for start_decompress }
|
||||||
|
cinfo^.global_state := DSTATE_READY;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
DSTATE_READY:
|
||||||
|
{ Can't advance past first SOS until start_decompress is called }
|
||||||
|
retcode := JPEG_REACHED_SOS;
|
||||||
|
|
||||||
|
DSTATE_PRELOAD,
|
||||||
|
DSTATE_PRESCAN,
|
||||||
|
DSTATE_SCANNING,
|
||||||
|
DSTATE_RAW_OK,
|
||||||
|
DSTATE_BUFIMAGE,
|
||||||
|
DSTATE_BUFPOST,
|
||||||
|
DSTATE_STOPPING:
|
||||||
|
retcode := cinfo^.inputctl^.consume_input (cinfo);
|
||||||
|
else
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
end;
|
||||||
|
jpeg_consume_input := retcode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Have we finished reading the input file? }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_input_complete (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
begin
|
||||||
|
{ Check for valid jpeg object }
|
||||||
|
if (cinfo^.global_state < DSTATE_START) or
|
||||||
|
(cinfo^.global_state > DSTATE_STOPPING) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
jpeg_input_complete := cinfo^.inputctl^.eoi_reached;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Is there more than one scan? }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_has_multiple_scans (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
begin
|
||||||
|
{ Only valid after jpeg_read_header completes }
|
||||||
|
if (cinfo^.global_state < DSTATE_READY) or
|
||||||
|
(cinfo^.global_state > DSTATE_STOPPING) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
jpeg_has_multiple_scans := cinfo^.inputctl^.has_multiple_scans;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish JPEG decompression.
|
||||||
|
|
||||||
|
This will normally just verify the file trailer and release temp storage.
|
||||||
|
|
||||||
|
Returns FALSE if suspended. The return value need be inspected only if
|
||||||
|
a suspending data source is used. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_finish_decompress (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
begin
|
||||||
|
if ((cinfo^.global_state = DSTATE_SCANNING) or
|
||||||
|
(cinfo^.global_state = DSTATE_RAW_OK) and (not cinfo^.buffered_image)) then
|
||||||
|
begin
|
||||||
|
{ Terminate final pass of non-buffered mode }
|
||||||
|
if (cinfo^.output_scanline < cinfo^.output_height) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA);
|
||||||
|
cinfo^.master^.finish_output_pass (cinfo);
|
||||||
|
cinfo^.global_state := DSTATE_STOPPING;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.global_state = DSTATE_BUFIMAGE) then
|
||||||
|
begin
|
||||||
|
{ Finishing after a buffered-image operation }
|
||||||
|
cinfo^.global_state := DSTATE_STOPPING;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.global_state <> DSTATE_STOPPING) then
|
||||||
|
begin
|
||||||
|
{ STOPPING := repeat call after a suspension, anything else is error }
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
end;
|
||||||
|
{ Read until EOI }
|
||||||
|
while (not cinfo^.inputctl^.eoi_reached) do
|
||||||
|
begin
|
||||||
|
if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then
|
||||||
|
begin
|
||||||
|
jpeg_finish_decompress := FALSE; { Suspend, come back later }
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Do final cleanup }
|
||||||
|
cinfo^.src^.term_source (cinfo);
|
||||||
|
{ We can use jpeg_abort to release memory and reset global_state }
|
||||||
|
jpeg_abort(j_common_ptr(cinfo));
|
||||||
|
jpeg_finish_decompress := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,377 @@
|
||||||
|
unit imjdapistd;
|
||||||
|
|
||||||
|
{ Original : jdapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
{ This file is part of the Independent JPEG Group's software.
|
||||||
|
For conditions of distribution and use, see the accompanying README file.
|
||||||
|
|
||||||
|
This file contains application interface code for the decompression half
|
||||||
|
of the JPEG library. These are the "standard" API routines that are
|
||||||
|
used in the normal full-decompression case. They are not used by a
|
||||||
|
transcoding-only application. Note that if an application links in
|
||||||
|
jpeg_start_decompress, it will end up linking in the entire decompressor.
|
||||||
|
We thus must separate this file from jdapimin.c to avoid linking the
|
||||||
|
whole decompression library into a transcoder. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib,
|
||||||
|
imjdmaster;
|
||||||
|
|
||||||
|
{ Read some scanlines of data from the JPEG decompressor.
|
||||||
|
|
||||||
|
The return value will be the number of lines actually read.
|
||||||
|
This may be less than the number requested in several cases,
|
||||||
|
including bottom of image, data source suspension, and operating
|
||||||
|
modes that emit multiple scanlines at a time.
|
||||||
|
|
||||||
|
Note: we warn about excess calls to jpeg_read_scanlines() since
|
||||||
|
this likely signals an application programmer error. However,
|
||||||
|
an oversize buffer (max_lines > scanlines remaining) is not an error. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_read_scanlines (cinfo : j_decompress_ptr;
|
||||||
|
scanlines : JSAMPARRAY;
|
||||||
|
max_lines : JDIMENSION) : JDIMENSION;
|
||||||
|
|
||||||
|
|
||||||
|
{ Alternate entry point to read raw data.
|
||||||
|
Processes exactly one iMCU row per call, unless suspended. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_read_raw_data (cinfo : j_decompress_ptr;
|
||||||
|
data : JSAMPIMAGE;
|
||||||
|
max_lines : JDIMENSION) : JDIMENSION;
|
||||||
|
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
|
||||||
|
{ Initialize for an output pass in buffered-image mode. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_start_output (cinfo : j_decompress_ptr;
|
||||||
|
scan_number : int) : boolean;
|
||||||
|
|
||||||
|
{ Finish up after an output pass in buffered-image mode.
|
||||||
|
|
||||||
|
Returns FALSE if suspended. The return value need be inspected only if
|
||||||
|
a suspending data source is used. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
|
||||||
|
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
|
||||||
|
|
||||||
|
{ Decompression initialization.
|
||||||
|
jpeg_read_header must be completed before calling this.
|
||||||
|
|
||||||
|
If a multipass operating mode was selected, this will do all but the
|
||||||
|
last pass, and thus may take a great deal of time.
|
||||||
|
|
||||||
|
Returns FALSE if suspended. The return value need be inspected only if
|
||||||
|
a suspending data source is used. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Forward declarations }
|
||||||
|
{LOCAL}
|
||||||
|
function output_pass_setup (cinfo : j_decompress_ptr) : boolean; forward;
|
||||||
|
|
||||||
|
{ Decompression initialization.
|
||||||
|
jpeg_read_header must be completed before calling this.
|
||||||
|
|
||||||
|
If a multipass operating mode was selected, this will do all but the
|
||||||
|
last pass, and thus may take a great deal of time.
|
||||||
|
|
||||||
|
Returns FALSE if suspended. The return value need be inspected only if
|
||||||
|
a suspending data source is used. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
var
|
||||||
|
retcode : int;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state = DSTATE_READY) then
|
||||||
|
begin
|
||||||
|
{ First call: initialize master control, select active modules }
|
||||||
|
jinit_master_decompress(cinfo);
|
||||||
|
if (cinfo^.buffered_image) then
|
||||||
|
begin
|
||||||
|
{ No more work here; expecting jpeg_start_output next }
|
||||||
|
cinfo^.global_state := DSTATE_BUFIMAGE;
|
||||||
|
jpeg_start_decompress := TRUE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
cinfo^.global_state := DSTATE_PRELOAD;
|
||||||
|
end;
|
||||||
|
if (cinfo^.global_state = DSTATE_PRELOAD) then
|
||||||
|
begin
|
||||||
|
{ If file has multiple scans, absorb them all into the coef buffer }
|
||||||
|
if (cinfo^.inputctl^.has_multiple_scans) then
|
||||||
|
begin
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
while TRUE do
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ Call progress monitor hook if present }
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
|
||||||
|
{ Absorb some more input }
|
||||||
|
retcode := cinfo^.inputctl^.consume_input (cinfo);
|
||||||
|
if (retcode = JPEG_SUSPENDED) then
|
||||||
|
begin
|
||||||
|
jpeg_start_decompress := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if (retcode = JPEG_REACHED_EOI) then
|
||||||
|
break;
|
||||||
|
{ Advance progress counter if appropriate }
|
||||||
|
if (cinfo^.progress <> NIL) and
|
||||||
|
((retcode = JPEG_ROW_COMPLETED) or (retcode = JPEG_REACHED_SOS)) then
|
||||||
|
begin
|
||||||
|
Inc(cinfo^.progress^.pass_counter);
|
||||||
|
if (cinfo^.progress^.pass_counter >= cinfo^.progress^.pass_limit) then
|
||||||
|
begin
|
||||||
|
{ jdmaster underestimated number of scans; ratchet up one scan }
|
||||||
|
Inc(cinfo^.progress^.pass_limit, long(cinfo^.total_iMCU_rows));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
|
||||||
|
end;
|
||||||
|
cinfo^.output_scan_number := cinfo^.input_scan_number;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.global_state <> DSTATE_PRESCAN) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
{ Perform any dummy output passes, and set up for the final pass }
|
||||||
|
jpeg_start_decompress := output_pass_setup(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Set up for an output pass, and perform any dummy pass(es) needed.
|
||||||
|
Common subroutine for jpeg_start_decompress and jpeg_start_output.
|
||||||
|
Entry: global_state := DSTATE_PRESCAN only if previously suspended.
|
||||||
|
Exit: If done, returns TRUE and sets global_state for proper output mode.
|
||||||
|
If suspended, returns FALSE and sets global_state := DSTATE_PRESCAN. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
function output_pass_setup (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
var
|
||||||
|
last_scanline : JDIMENSION;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> DSTATE_PRESCAN) then
|
||||||
|
begin
|
||||||
|
{ First call: do pass setup }
|
||||||
|
cinfo^.master^.prepare_for_output_pass (cinfo);
|
||||||
|
cinfo^.output_scanline := 0;
|
||||||
|
cinfo^.global_state := DSTATE_PRESCAN;
|
||||||
|
end;
|
||||||
|
{ Loop over any required dummy passes }
|
||||||
|
while (cinfo^.master^.is_dummy_pass) do
|
||||||
|
begin
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
{ Crank through the dummy pass }
|
||||||
|
while (cinfo^.output_scanline < cinfo^.output_height) do
|
||||||
|
begin
|
||||||
|
{ Call progress monitor hook if present }
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
|
||||||
|
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
|
||||||
|
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
|
||||||
|
end;
|
||||||
|
{ Process some data }
|
||||||
|
last_scanline := cinfo^.output_scanline;
|
||||||
|
cinfo^.main^.process_data (cinfo, JSAMPARRAY(NIL),
|
||||||
|
cinfo^.output_scanline, {var}
|
||||||
|
JDIMENSION(0));
|
||||||
|
if (cinfo^.output_scanline = last_scanline) then
|
||||||
|
begin
|
||||||
|
output_pass_setup := FALSE; { No progress made, must suspend }
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Finish up dummy pass, and set up for another one }
|
||||||
|
cinfo^.master^.finish_output_pass (cinfo);
|
||||||
|
cinfo^.master^.prepare_for_output_pass (cinfo);
|
||||||
|
cinfo^.output_scanline := 0;
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif} { QUANT_2PASS_SUPPORTED }
|
||||||
|
end;
|
||||||
|
{ Ready for application to drive output pass through
|
||||||
|
jpeg_read_scanlines or jpeg_read_raw_data. }
|
||||||
|
if cinfo^.raw_data_out then
|
||||||
|
cinfo^.global_state := DSTATE_RAW_OK
|
||||||
|
else
|
||||||
|
cinfo^.global_state := DSTATE_SCANNING;
|
||||||
|
output_pass_setup := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Read some scanlines of data from the JPEG decompressor.
|
||||||
|
|
||||||
|
The return value will be the number of lines actually read.
|
||||||
|
This may be less than the number requested in several cases,
|
||||||
|
including bottom of image, data source suspension, and operating
|
||||||
|
modes that emit multiple scanlines at a time.
|
||||||
|
|
||||||
|
Note: we warn about excess calls to jpeg_read_scanlines() since
|
||||||
|
this likely signals an application programmer error. However,
|
||||||
|
an oversize buffer (max_lines > scanlines remaining) is not an error. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_read_scanlines (cinfo : j_decompress_ptr;
|
||||||
|
scanlines : JSAMPARRAY;
|
||||||
|
max_lines : JDIMENSION) : JDIMENSION;
|
||||||
|
var
|
||||||
|
row_ctr : JDIMENSION;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> DSTATE_SCANNING) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
if (cinfo^.output_scanline >= cinfo^.output_height) then
|
||||||
|
begin
|
||||||
|
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
|
||||||
|
jpeg_read_scanlines := 0;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Call progress monitor hook if present }
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
|
||||||
|
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
|
||||||
|
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Process some data }
|
||||||
|
row_ctr := 0;
|
||||||
|
cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, max_lines);
|
||||||
|
Inc(cinfo^.output_scanline, row_ctr);
|
||||||
|
jpeg_read_scanlines := row_ctr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Alternate entry point to read raw data.
|
||||||
|
Processes exactly one iMCU row per call, unless suspended. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_read_raw_data (cinfo : j_decompress_ptr;
|
||||||
|
data : JSAMPIMAGE;
|
||||||
|
max_lines : JDIMENSION) : JDIMENSION;
|
||||||
|
var
|
||||||
|
lines_per_iMCU_row : JDIMENSION;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> DSTATE_RAW_OK) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
if (cinfo^.output_scanline >= cinfo^.output_height) then
|
||||||
|
begin
|
||||||
|
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
|
||||||
|
jpeg_read_raw_data := 0;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Call progress monitor hook if present }
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
|
||||||
|
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
|
||||||
|
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Verify that at least one iMCU row can be returned. }
|
||||||
|
lines_per_iMCU_row := cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size;
|
||||||
|
if (max_lines < lines_per_iMCU_row) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE);
|
||||||
|
|
||||||
|
{ Decompress directly into user's buffer. }
|
||||||
|
if (cinfo^.coef^.decompress_data (cinfo, data) = 0) then
|
||||||
|
begin
|
||||||
|
jpeg_read_raw_data := 0; { suspension forced, can do nothing more }
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ OK, we processed one iMCU row. }
|
||||||
|
Inc(cinfo^.output_scanline, lines_per_iMCU_row);
|
||||||
|
jpeg_read_raw_data := lines_per_iMCU_row;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Additional entry points for buffered-image mode. }
|
||||||
|
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
|
||||||
|
{ Initialize for an output pass in buffered-image mode. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_start_output (cinfo : j_decompress_ptr;
|
||||||
|
scan_number : int) : boolean;
|
||||||
|
begin
|
||||||
|
if (cinfo^.global_state <> DSTATE_BUFIMAGE) and
|
||||||
|
(cinfo^.global_state <> DSTATE_PRESCAN) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
{ Limit scan number to valid range }
|
||||||
|
if (scan_number <= 0) then
|
||||||
|
scan_number := 1;
|
||||||
|
if (cinfo^.inputctl^.eoi_reached) and
|
||||||
|
(scan_number > cinfo^.input_scan_number) then
|
||||||
|
scan_number := cinfo^.input_scan_number;
|
||||||
|
cinfo^.output_scan_number := scan_number;
|
||||||
|
{ Perform any dummy output passes, and set up for the real pass }
|
||||||
|
jpeg_start_output := output_pass_setup(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish up after an output pass in buffered-image mode.
|
||||||
|
|
||||||
|
Returns FALSE if suspended. The return value need be inspected only if
|
||||||
|
a suspending data source is used. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
begin
|
||||||
|
if ((cinfo^.global_state = DSTATE_SCANNING) or
|
||||||
|
(cinfo^.global_state = DSTATE_RAW_OK) and cinfo^.buffered_image) then
|
||||||
|
begin
|
||||||
|
{ Terminate this pass. }
|
||||||
|
{ We do not require the whole pass to have been completed. }
|
||||||
|
cinfo^.master^.finish_output_pass (cinfo);
|
||||||
|
cinfo^.global_state := DSTATE_BUFPOST;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.global_state <> DSTATE_BUFPOST) then
|
||||||
|
begin
|
||||||
|
{ BUFPOST := repeat call after a suspension, anything else is error }
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
end;
|
||||||
|
{ Read markers looking for SOS or EOI }
|
||||||
|
while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and
|
||||||
|
(not cinfo^.inputctl^.eoi_reached) do
|
||||||
|
begin
|
||||||
|
if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then
|
||||||
|
begin
|
||||||
|
jpeg_finish_output := FALSE; { Suspend, come back later }
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
cinfo^.global_state := DSTATE_BUFIMAGE;
|
||||||
|
jpeg_finish_output := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
@ -0,0 +1,895 @@
|
||||||
|
unit imjdcoefct;
|
||||||
|
|
||||||
|
{ This file contains the coefficient buffer controller for decompression.
|
||||||
|
This controller is the top level of the JPEG decompressor proper.
|
||||||
|
The coefficient buffer lies between entropy decoding and inverse-DCT steps.
|
||||||
|
|
||||||
|
In buffered-image mode, this controller is the interface between
|
||||||
|
input-oriented processing and output-oriented processing.
|
||||||
|
Also, the input side (only) is used when reading a file for transcoding. }
|
||||||
|
|
||||||
|
{ Original: jdcoefct.c ; Copyright (C) 1994-1997, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjutils,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_d_coef_controller (cinfo : j_decompress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{ Block smoothing is only applicable for progressive JPEG, so: }
|
||||||
|
{$ifndef D_PROGRESSIVE_SUPPORTED}
|
||||||
|
{$undef BLOCK_SMOOTHING_SUPPORTED}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{ Private buffer controller object }
|
||||||
|
|
||||||
|
{$ifdef BLOCK_SMOOTHING_SUPPORTED}
|
||||||
|
const
|
||||||
|
SAVED_COEFS = 6; { we save coef_bits[0..5] }
|
||||||
|
type
|
||||||
|
Latch = array[0..SAVED_COEFS-1] of int;
|
||||||
|
Latch_ptr = ^Latch;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
type
|
||||||
|
my_coef_ptr = ^my_coef_controller;
|
||||||
|
my_coef_controller = record
|
||||||
|
pub : jpeg_d_coef_controller; { public fields }
|
||||||
|
|
||||||
|
{ These variables keep track of the current location of the input side. }
|
||||||
|
{ cinfo^.input_iMCU_row is also used for this. }
|
||||||
|
MCU_ctr : JDIMENSION; { counts MCUs processed in current row }
|
||||||
|
MCU_vert_offset : int; { counts MCU rows within iMCU row }
|
||||||
|
MCU_rows_per_iMCU_row : int; { number of such rows needed }
|
||||||
|
|
||||||
|
{ The output side's location is represented by cinfo^.output_iMCU_row. }
|
||||||
|
|
||||||
|
{ In single-pass modes, it's sufficient to buffer just one MCU.
|
||||||
|
We allocate a workspace of D_MAX_BLOCKS_IN_MCU coefficient blocks,
|
||||||
|
and let the entropy decoder write into that workspace each time.
|
||||||
|
(On 80x86, the workspace is FAR even though it's not really very big;
|
||||||
|
this is to keep the module interfaces unchanged when a large coefficient
|
||||||
|
buffer is necessary.)
|
||||||
|
In multi-pass modes, this array points to the current MCU's blocks
|
||||||
|
within the virtual arrays; it is used only by the input side. }
|
||||||
|
|
||||||
|
MCU_buffer : array[0..D_MAX_BLOCKS_IN_MCU-1] of JBLOCKROW;
|
||||||
|
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
{ In multi-pass modes, we need a virtual block array for each component. }
|
||||||
|
whole_image : jvirt_barray_tbl;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef BLOCK_SMOOTHING_SUPPORTED}
|
||||||
|
{ When doing block smoothing, we latch coefficient Al values here }
|
||||||
|
coef_bits_latch : Latch_Ptr;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Forward declarations }
|
||||||
|
{METHODDEF}
|
||||||
|
function decompress_onepass (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPIMAGE) : int; forward;
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
{METHODDEF}
|
||||||
|
function decompress_data (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPIMAGE) : int; forward;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef BLOCK_SMOOTHING_SUPPORTED}
|
||||||
|
{LOCAL}
|
||||||
|
function smoothing_ok (cinfo : j_decompress_ptr) : boolean; forward;
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function decompress_smooth_data (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPIMAGE) : int; forward;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure start_iMCU_row (cinfo : j_decompress_ptr);
|
||||||
|
{ Reset within-iMCU-row counters for a new row (input side) }
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
|
||||||
|
{ In an interleaved scan, an MCU row is the same as an iMCU row.
|
||||||
|
In a noninterleaved scan, an iMCU row has v_samp_factor MCU rows.
|
||||||
|
But at the bottom of the image, process only what's left. }
|
||||||
|
|
||||||
|
if (cinfo^.comps_in_scan > 1) then
|
||||||
|
begin
|
||||||
|
coef^.MCU_rows_per_iMCU_row := 1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (cinfo^.input_iMCU_row < (cinfo^.total_iMCU_rows-1)) then
|
||||||
|
coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.v_samp_factor
|
||||||
|
else
|
||||||
|
coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.last_row_height;
|
||||||
|
end;
|
||||||
|
|
||||||
|
coef^.MCU_ctr := 0;
|
||||||
|
coef^.MCU_vert_offset := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for an input processing pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_input_pass (cinfo : j_decompress_ptr);
|
||||||
|
begin
|
||||||
|
cinfo^.input_iMCU_row := 0;
|
||||||
|
start_iMCU_row(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for an output processing pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_output_pass (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
begin
|
||||||
|
{$ifdef BLOCK_SMOOTHING_SUPPORTED}
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
|
||||||
|
{ If multipass, check to see whether to use block smoothing on this pass }
|
||||||
|
if (coef^.pub.coef_arrays <> NIL) then
|
||||||
|
begin
|
||||||
|
if (cinfo^.do_block_smoothing) and smoothing_ok(cinfo) then
|
||||||
|
coef^.pub.decompress_data := decompress_smooth_data
|
||||||
|
else
|
||||||
|
coef^.pub.decompress_data := decompress_data;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
cinfo^.output_iMCU_row := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Decompress and return some data in the single-pass case.
|
||||||
|
Always attempts to emit one fully interleaved MCU row ("iMCU" row).
|
||||||
|
Input and output must run in lockstep since we have only a one-MCU buffer.
|
||||||
|
Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED.
|
||||||
|
|
||||||
|
NB: output_buf contains a plane for each component in image,
|
||||||
|
which we index according to the component's SOF position.}
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function decompress_onepass (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPIMAGE) : int;
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
MCU_col_num : JDIMENSION; { index of current MCU within row }
|
||||||
|
last_MCU_col : JDIMENSION;
|
||||||
|
last_iMCU_row : JDIMENSION;
|
||||||
|
blkn, ci, xindex, yindex, yoffset, useful_width : int;
|
||||||
|
output_ptr : JSAMPARRAY;
|
||||||
|
start_col, output_col : JDIMENSION;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
inverse_DCT : inverse_DCT_method_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
last_MCU_col := cinfo^.MCUs_per_row - 1;
|
||||||
|
last_iMCU_row := cinfo^.total_iMCU_rows - 1;
|
||||||
|
|
||||||
|
{ Loop to process as much as one whole iMCU row }
|
||||||
|
for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do
|
||||||
|
begin
|
||||||
|
for MCU_col_num := coef^.MCU_ctr to last_MCU_col do
|
||||||
|
begin
|
||||||
|
{ Try to fetch an MCU. Entropy decoder expects buffer to be zeroed. }
|
||||||
|
jzero_far( coef^.MCU_buffer[0],
|
||||||
|
size_t (cinfo^.blocks_in_MCU * SIZEOF(JBLOCK)));
|
||||||
|
if (not cinfo^.entropy^.decode_mcu (cinfo, coef^.MCU_buffer)) then
|
||||||
|
begin
|
||||||
|
{ Suspension forced; update state counters and exit }
|
||||||
|
coef^.MCU_vert_offset := yoffset;
|
||||||
|
coef^.MCU_ctr := MCU_col_num;
|
||||||
|
decompress_onepass := JPEG_SUSPENDED;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Determine where data should go in output_buf and do the IDCT thing.
|
||||||
|
We skip dummy blocks at the right and bottom edges (but blkn gets
|
||||||
|
incremented past them!). Note the inner loop relies on having
|
||||||
|
allocated the MCU_buffer[] blocks sequentially. }
|
||||||
|
|
||||||
|
blkn := 0; { index of current DCT block within MCU }
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
{ Don't bother to IDCT an uninteresting component. }
|
||||||
|
if (not compptr^.component_needed) then
|
||||||
|
begin
|
||||||
|
Inc(blkn, compptr^.MCU_blocks);
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
|
inverse_DCT := cinfo^.idct^.inverse_DCT[compptr^.component_index];
|
||||||
|
if (MCU_col_num < last_MCU_col) then
|
||||||
|
useful_width := compptr^.MCU_width
|
||||||
|
else
|
||||||
|
useful_width := compptr^.last_col_width;
|
||||||
|
|
||||||
|
output_ptr := JSAMPARRAY(@ output_buf^[compptr^.component_index]^
|
||||||
|
[yoffset * compptr^.DCT_scaled_size]);
|
||||||
|
start_col := LongInt(MCU_col_num) * compptr^.MCU_sample_width;
|
||||||
|
for yindex := 0 to pred(compptr^.MCU_height) do
|
||||||
|
begin
|
||||||
|
if (cinfo^.input_iMCU_row < last_iMCU_row) or
|
||||||
|
(yoffset+yindex < compptr^.last_row_height) then
|
||||||
|
begin
|
||||||
|
output_col := start_col;
|
||||||
|
for xindex := 0 to pred(useful_width) do
|
||||||
|
begin
|
||||||
|
inverse_DCT (cinfo, compptr,
|
||||||
|
JCOEFPTR(coef^.MCU_buffer[blkn+xindex]),
|
||||||
|
output_ptr, output_col);
|
||||||
|
Inc(output_col, compptr^.DCT_scaled_size);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(blkn, compptr^.MCU_width);
|
||||||
|
Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Completed an MCU row, but perhaps not an iMCU row }
|
||||||
|
coef^.MCU_ctr := 0;
|
||||||
|
end;
|
||||||
|
{ Completed the iMCU row, advance counters for next one }
|
||||||
|
Inc(cinfo^.output_iMCU_row);
|
||||||
|
|
||||||
|
Inc(cinfo^.input_iMCU_row);
|
||||||
|
if (cinfo^.input_iMCU_row < cinfo^.total_iMCU_rows) then
|
||||||
|
begin
|
||||||
|
start_iMCU_row(cinfo);
|
||||||
|
decompress_onepass := JPEG_ROW_COMPLETED;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Completed the scan }
|
||||||
|
cinfo^.inputctl^.finish_input_pass (cinfo);
|
||||||
|
decompress_onepass := JPEG_SCAN_COMPLETED;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Dummy consume-input routine for single-pass operation. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function dummy_consume_data (cinfo : j_decompress_ptr) : int;
|
||||||
|
begin
|
||||||
|
dummy_consume_data := JPEG_SUSPENDED; { Always indicate nothing was done }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
|
||||||
|
{ Consume input data and store it in the full-image coefficient buffer.
|
||||||
|
We read as much as one fully interleaved MCU row ("iMCU" row) per call,
|
||||||
|
ie, v_samp_factor block rows for each component in the scan.
|
||||||
|
Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED.}
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function consume_data (cinfo : j_decompress_ptr) : int;
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
MCU_col_num : JDIMENSION; { index of current MCU within row }
|
||||||
|
blkn, ci, xindex, yindex, yoffset : int;
|
||||||
|
start_col : JDIMENSION;
|
||||||
|
buffer : array[0..MAX_COMPS_IN_SCAN-1] of JBLOCKARRAY;
|
||||||
|
buffer_ptr : JBLOCKROW;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
|
||||||
|
{ Align the virtual buffers for the components used in this scan. }
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
buffer[ci] := cinfo^.mem^.access_virt_barray
|
||||||
|
(j_common_ptr (cinfo), coef^.whole_image[compptr^.component_index],
|
||||||
|
LongInt(cinfo^.input_iMCU_row) * compptr^.v_samp_factor,
|
||||||
|
JDIMENSION (compptr^.v_samp_factor), TRUE);
|
||||||
|
{ Note: entropy decoder expects buffer to be zeroed,
|
||||||
|
but this is handled automatically by the memory manager
|
||||||
|
because we requested a pre-zeroed array. }
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Loop to process one whole iMCU row }
|
||||||
|
for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do
|
||||||
|
begin
|
||||||
|
for MCU_col_num := coef^.MCU_ctr to pred(cinfo^.MCUs_per_row) do
|
||||||
|
begin
|
||||||
|
{ Construct list of pointers to DCT blocks belonging to this MCU }
|
||||||
|
blkn := 0; { index of current DCT block within MCU }
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
start_col := LongInt(MCU_col_num) * compptr^.MCU_width;
|
||||||
|
for yindex := 0 to pred(compptr^.MCU_height) do
|
||||||
|
begin
|
||||||
|
buffer_ptr := JBLOCKROW(@ buffer[ci]^[yindex+yoffset]^[start_col]);
|
||||||
|
for xindex := 0 to pred(compptr^.MCU_width) do
|
||||||
|
begin
|
||||||
|
coef^.MCU_buffer[blkn] := buffer_ptr;
|
||||||
|
Inc(blkn);
|
||||||
|
Inc(JBLOCK_PTR(buffer_ptr));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Try to fetch the MCU. }
|
||||||
|
if (not cinfo^.entropy^.decode_mcu (cinfo, coef^.MCU_buffer)) then
|
||||||
|
begin
|
||||||
|
{ Suspension forced; update state counters and exit }
|
||||||
|
coef^.MCU_vert_offset := yoffset;
|
||||||
|
coef^.MCU_ctr := MCU_col_num;
|
||||||
|
consume_data := JPEG_SUSPENDED;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Completed an MCU row, but perhaps not an iMCU row }
|
||||||
|
coef^.MCU_ctr := 0;
|
||||||
|
end;
|
||||||
|
{ Completed the iMCU row, advance counters for next one }
|
||||||
|
Inc(cinfo^.input_iMCU_row);
|
||||||
|
if (cinfo^.input_iMCU_row < cinfo^.total_iMCU_rows) then
|
||||||
|
begin
|
||||||
|
start_iMCU_row(cinfo);
|
||||||
|
consume_data := JPEG_ROW_COMPLETED;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Completed the scan }
|
||||||
|
cinfo^.inputctl^.finish_input_pass (cinfo);
|
||||||
|
consume_data := JPEG_SCAN_COMPLETED;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Decompress and return some data in the multi-pass case.
|
||||||
|
Always attempts to emit one fully interleaved MCU row ("iMCU" row).
|
||||||
|
Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED.
|
||||||
|
|
||||||
|
NB: output_buf contains a plane for each component in image. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function decompress_data (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPIMAGE) : int;
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
last_iMCU_row : JDIMENSION;
|
||||||
|
block_num : JDIMENSION;
|
||||||
|
ci, block_row, block_rows : int;
|
||||||
|
buffer : JBLOCKARRAY;
|
||||||
|
buffer_ptr : JBLOCKROW;
|
||||||
|
output_ptr : JSAMPARRAY;
|
||||||
|
output_col : JDIMENSION;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
inverse_DCT : inverse_DCT_method_ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
last_iMCU_row := cinfo^.total_iMCU_rows - 1;
|
||||||
|
|
||||||
|
{ Force some input to be done if we are getting ahead of the input. }
|
||||||
|
while (cinfo^.input_scan_number < cinfo^.output_scan_number) or
|
||||||
|
((cinfo^.input_scan_number = cinfo^.output_scan_number) and
|
||||||
|
(LongInt(cinfo^.input_iMCU_row) <= cinfo^.output_iMCU_row)) do
|
||||||
|
begin
|
||||||
|
if (cinfo^.inputctl^.consume_input(cinfo) = JPEG_SUSPENDED) then
|
||||||
|
begin
|
||||||
|
decompress_data := JPEG_SUSPENDED;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ OK, output from the virtual arrays. }
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ Don't bother to IDCT an uninteresting component. }
|
||||||
|
if (not compptr^.component_needed) then
|
||||||
|
continue;
|
||||||
|
{ Align the virtual buffer for this component. }
|
||||||
|
buffer := cinfo^.mem^.access_virt_barray
|
||||||
|
(j_common_ptr (cinfo), coef^.whole_image[ci],
|
||||||
|
cinfo^.output_iMCU_row * compptr^.v_samp_factor,
|
||||||
|
JDIMENSION (compptr^.v_samp_factor), FALSE);
|
||||||
|
{ Count non-dummy DCT block rows in this iMCU row. }
|
||||||
|
if (cinfo^.output_iMCU_row < LongInt(last_iMCU_row)) then
|
||||||
|
block_rows := compptr^.v_samp_factor
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ NB: can't use last_row_height here; it is input-side-dependent! }
|
||||||
|
block_rows := int(LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor);
|
||||||
|
if (block_rows = 0) then
|
||||||
|
block_rows := compptr^.v_samp_factor;
|
||||||
|
end;
|
||||||
|
inverse_DCT := cinfo^.idct^.inverse_DCT[ci];
|
||||||
|
output_ptr := output_buf^[ci];
|
||||||
|
{ Loop over all DCT blocks to be processed. }
|
||||||
|
for block_row := 0 to pred(block_rows) do
|
||||||
|
begin
|
||||||
|
buffer_ptr := buffer^[block_row];
|
||||||
|
output_col := 0;
|
||||||
|
for block_num := 0 to pred(compptr^.width_in_blocks) do
|
||||||
|
begin
|
||||||
|
inverse_DCT (cinfo, compptr, JCOEFPTR (buffer_ptr),
|
||||||
|
output_ptr, output_col);
|
||||||
|
Inc(JBLOCK_PTR(buffer_ptr));
|
||||||
|
Inc(output_col, compptr^.DCT_scaled_size);
|
||||||
|
end;
|
||||||
|
Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size);
|
||||||
|
end;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Inc(cinfo^.output_iMCU_row);
|
||||||
|
if (cinfo^.output_iMCU_row < LongInt(cinfo^.total_iMCU_rows)) then
|
||||||
|
begin
|
||||||
|
decompress_data := JPEG_ROW_COMPLETED;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
decompress_data := JPEG_SCAN_COMPLETED;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef BLOCK_SMOOTHING_SUPPORTED}
|
||||||
|
|
||||||
|
{ This code applies interblock smoothing as described by section K.8
|
||||||
|
of the JPEG standard: the first 5 AC coefficients are estimated from
|
||||||
|
the DC values of a DCT block and its 8 neighboring blocks.
|
||||||
|
We apply smoothing only for progressive JPEG decoding, and only if
|
||||||
|
the coefficients it can estimate are not yet known to full precision. }
|
||||||
|
|
||||||
|
{ Natural-order array positions of the first 5 zigzag-order coefficients }
|
||||||
|
const
|
||||||
|
Q01_POS = 1;
|
||||||
|
Q10_POS = 8;
|
||||||
|
Q20_POS = 16;
|
||||||
|
Q11_POS = 9;
|
||||||
|
Q02_POS = 2;
|
||||||
|
|
||||||
|
{ Determine whether block smoothing is applicable and safe.
|
||||||
|
We also latch the current states of the coef_bits[] entries for the
|
||||||
|
AC coefficients; otherwise, if the input side of the decompressor
|
||||||
|
advances into a new scan, we might think the coefficients are known
|
||||||
|
more accurately than they really are. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
function smoothing_ok (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
smoothing_useful : boolean;
|
||||||
|
ci, coefi : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
qtable : JQUANT_TBL_PTR;
|
||||||
|
coef_bits : coef_bits_ptr;
|
||||||
|
coef_bits_latch : Latch_Ptr;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
smoothing_useful := FALSE;
|
||||||
|
|
||||||
|
if (not cinfo^.progressive_mode) or (cinfo^.coef_bits = NIL) then
|
||||||
|
begin
|
||||||
|
smoothing_ok := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Allocate latch area if not already done }
|
||||||
|
if (coef^.coef_bits_latch = NIL) then
|
||||||
|
coef^.coef_bits_latch := Latch_Ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE,
|
||||||
|
cinfo^.num_components *
|
||||||
|
(SAVED_COEFS * SIZEOF(int))) );
|
||||||
|
coef_bits_latch := (coef^.coef_bits_latch);
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ All components' quantization values must already be latched. }
|
||||||
|
qtable := compptr^.quant_table;
|
||||||
|
if (qtable = NIL) then
|
||||||
|
begin
|
||||||
|
smoothing_ok := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Verify DC & first 5 AC quantizers are nonzero to avoid zero-divide. }
|
||||||
|
if (qtable^.quantval[0] = 0) or
|
||||||
|
(qtable^.quantval[Q01_POS] = 0) or
|
||||||
|
(qtable^.quantval[Q10_POS] = 0) or
|
||||||
|
(qtable^.quantval[Q20_POS] = 0) or
|
||||||
|
(qtable^.quantval[Q11_POS] = 0) or
|
||||||
|
(qtable^.quantval[Q02_POS] = 0) then
|
||||||
|
begin
|
||||||
|
smoothing_ok := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ DC values must be at least partly known for all components. }
|
||||||
|
coef_bits := @cinfo^.coef_bits^[ci]; { Nomssi }
|
||||||
|
if (coef_bits^[0] < 0) then
|
||||||
|
begin
|
||||||
|
smoothing_ok := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ Block smoothing is helpful if some AC coefficients remain inaccurate. }
|
||||||
|
for coefi := 1 to 5 do
|
||||||
|
begin
|
||||||
|
coef_bits_latch^[coefi] := coef_bits^[coefi];
|
||||||
|
if (coef_bits^[coefi] <> 0) then
|
||||||
|
smoothing_useful := TRUE;
|
||||||
|
end;
|
||||||
|
Inc(coef_bits_latch {SAVED_COEFS});
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
smoothing_ok := smoothing_useful;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Variant of decompress_data for use when doing block smoothing. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function decompress_smooth_data (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPIMAGE) : int;
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
last_iMCU_row : JDIMENSION;
|
||||||
|
block_num, last_block_column : JDIMENSION;
|
||||||
|
ci, block_row, block_rows, access_rows : int;
|
||||||
|
buffer : JBLOCKARRAY;
|
||||||
|
buffer_ptr, prev_block_row, next_block_row : JBLOCKROW;
|
||||||
|
output_ptr : JSAMPARRAY;
|
||||||
|
output_col : JDIMENSION;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
inverse_DCT : inverse_DCT_method_ptr;
|
||||||
|
first_row, last_row : boolean;
|
||||||
|
workspace : JBLOCK;
|
||||||
|
coef_bits : Latch_Ptr; { coef_bits_ptr; }
|
||||||
|
quanttbl : JQUANT_TBL_PTR;
|
||||||
|
Q00,Q01,Q02,Q10,Q11,Q20, num : INT32;
|
||||||
|
DC1,DC2,DC3,DC4,DC5,DC6,DC7,DC8,DC9 : int;
|
||||||
|
Al, pred : int;
|
||||||
|
var
|
||||||
|
delta : JDIMENSION;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr (cinfo^.coef);
|
||||||
|
last_iMCU_row := cinfo^.total_iMCU_rows - 1;
|
||||||
|
|
||||||
|
{ Force some input to be done if we are getting ahead of the input. }
|
||||||
|
while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and
|
||||||
|
(not cinfo^.inputctl^.eoi_reached) do
|
||||||
|
begin
|
||||||
|
if (cinfo^.input_scan_number = cinfo^.output_scan_number) then
|
||||||
|
begin
|
||||||
|
{ If input is working on current scan, we ordinarily want it to
|
||||||
|
have completed the current row. But if input scan is DC,
|
||||||
|
we want it to keep one row ahead so that next block row's DC
|
||||||
|
values are up to date. }
|
||||||
|
|
||||||
|
if (cinfo^.Ss = 0) then
|
||||||
|
delta := 1
|
||||||
|
else
|
||||||
|
delta := 0;
|
||||||
|
if (LongInt(cinfo^.input_iMCU_row) > cinfo^.output_iMCU_row+LongInt(delta)) then
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
if (cinfo^.inputctl^.consume_input(cinfo) = JPEG_SUSPENDED) then
|
||||||
|
begin
|
||||||
|
decompress_smooth_data := JPEG_SUSPENDED;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ OK, output from the virtual arrays. }
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to (cinfo^.num_components-1) do
|
||||||
|
begin
|
||||||
|
{ Don't bother to IDCT an uninteresting component. }
|
||||||
|
if (not compptr^.component_needed) then
|
||||||
|
continue;
|
||||||
|
{ Count non-dummy DCT block rows in this iMCU row. }
|
||||||
|
if (cinfo^.output_iMCU_row < LongInt(last_iMCU_row)) then
|
||||||
|
begin
|
||||||
|
block_rows := compptr^.v_samp_factor;
|
||||||
|
access_rows := block_rows * 2; { this and next iMCU row }
|
||||||
|
last_row := FALSE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ NB: can't use last_row_height here; it is input-side-dependent! }
|
||||||
|
block_rows := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor;
|
||||||
|
if (block_rows = 0) then
|
||||||
|
block_rows := compptr^.v_samp_factor;
|
||||||
|
access_rows := block_rows; { this iMCU row only }
|
||||||
|
last_row := TRUE;
|
||||||
|
end;
|
||||||
|
{ Align the virtual buffer for this component. }
|
||||||
|
if (cinfo^.output_iMCU_row > 0) then
|
||||||
|
begin
|
||||||
|
Inc(access_rows, compptr^.v_samp_factor); { prior iMCU row too }
|
||||||
|
buffer := cinfo^.mem^.access_virt_barray
|
||||||
|
(j_common_ptr (cinfo), coef^.whole_image[ci],
|
||||||
|
(cinfo^.output_iMCU_row - 1) * compptr^.v_samp_factor,
|
||||||
|
JDIMENSION (access_rows), FALSE);
|
||||||
|
Inc(JBLOCKROW_PTR(buffer), compptr^.v_samp_factor); { point to current iMCU row }
|
||||||
|
first_row := FALSE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
buffer := cinfo^.mem^.access_virt_barray
|
||||||
|
(j_common_ptr (cinfo), coef^.whole_image[ci],
|
||||||
|
JDIMENSION (0), JDIMENSION (access_rows), FALSE);
|
||||||
|
first_row := TRUE;
|
||||||
|
end;
|
||||||
|
{ Fetch component-dependent info }
|
||||||
|
coef_bits := coef^.coef_bits_latch;
|
||||||
|
Inc(coef_bits, ci); { ci * SAVED_COEFS}
|
||||||
|
quanttbl := compptr^.quant_table;
|
||||||
|
Q00 := quanttbl^.quantval[0];
|
||||||
|
Q01 := quanttbl^.quantval[Q01_POS];
|
||||||
|
Q10 := quanttbl^.quantval[Q10_POS];
|
||||||
|
Q20 := quanttbl^.quantval[Q20_POS];
|
||||||
|
Q11 := quanttbl^.quantval[Q11_POS];
|
||||||
|
Q02 := quanttbl^.quantval[Q02_POS];
|
||||||
|
inverse_DCT := cinfo^.idct^.inverse_DCT[ci];
|
||||||
|
output_ptr := output_buf^[ci];
|
||||||
|
{ Loop over all DCT blocks to be processed. }
|
||||||
|
for block_row := 0 to (block_rows-1) do
|
||||||
|
begin
|
||||||
|
buffer_ptr := buffer^[block_row];
|
||||||
|
if (first_row) and (block_row = 0) then
|
||||||
|
prev_block_row := buffer_ptr
|
||||||
|
else
|
||||||
|
prev_block_row := buffer^[block_row-1];
|
||||||
|
if (last_row) and (block_row = block_rows-1) then
|
||||||
|
next_block_row := buffer_ptr
|
||||||
|
else
|
||||||
|
next_block_row := buffer^[block_row+1];
|
||||||
|
{ We fetch the surrounding DC values using a sliding-register approach.
|
||||||
|
Initialize all nine here so as to do the right thing on narrow pics.}
|
||||||
|
|
||||||
|
DC3 := int(prev_block_row^[0][0]);
|
||||||
|
DC2 := DC3;
|
||||||
|
DC1 := DC2;
|
||||||
|
DC6 := int(buffer_ptr^[0][0]);
|
||||||
|
DC5 := DC6;
|
||||||
|
DC4 := DC5;
|
||||||
|
DC9 := int(next_block_row^[0][0]);
|
||||||
|
DC8 := DC9;
|
||||||
|
DC7 := DC8 ;
|
||||||
|
output_col := 0;
|
||||||
|
last_block_column := compptr^.width_in_blocks - 1;
|
||||||
|
for block_num := 0 to last_block_column do
|
||||||
|
begin
|
||||||
|
{ Fetch current DCT block into workspace so we can modify it. }
|
||||||
|
jcopy_block_row(buffer_ptr, JBLOCKROW (@workspace), JDIMENSION(1));
|
||||||
|
{ Update DC values }
|
||||||
|
if (block_num < last_block_column) then
|
||||||
|
begin
|
||||||
|
DC3 := int (prev_block_row^[1][0]);
|
||||||
|
DC6 := int (buffer_ptr^[1][0]);
|
||||||
|
DC9 := int (next_block_row^[1][0]);
|
||||||
|
end;
|
||||||
|
{ Compute coefficient estimates per K.8.
|
||||||
|
An estimate is applied only if coefficient is still zero,
|
||||||
|
and is not known to be fully accurate. }
|
||||||
|
|
||||||
|
{ AC01 }
|
||||||
|
Al := coef_bits^[1];
|
||||||
|
if (Al <> 0) and (workspace[1] = 0) then
|
||||||
|
begin
|
||||||
|
num := 36 * Q00 * (DC4 - DC6);
|
||||||
|
if (num >= 0) then
|
||||||
|
begin
|
||||||
|
pred := int (((Q01 shl 7) + num) div (Q01 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
pred := int (((Q01 shl 7) - num) div (Q01 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
pred := -pred;
|
||||||
|
end;
|
||||||
|
workspace[1] := JCOEF (pred);
|
||||||
|
end;
|
||||||
|
{ AC10 }
|
||||||
|
Al := coef_bits^[2];
|
||||||
|
if (Al <> 0) and (workspace[8] = 0) then
|
||||||
|
begin
|
||||||
|
num := 36 * Q00 * (DC2 - DC8);
|
||||||
|
if (num >= 0) then
|
||||||
|
begin
|
||||||
|
pred := int (((Q10 shl 7) + num) div (Q10 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
pred := int (((Q10 shl 7) - num) div (Q10 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
pred := -pred;
|
||||||
|
end;
|
||||||
|
workspace[8] := JCOEF (pred);
|
||||||
|
end;
|
||||||
|
{ AC20 }
|
||||||
|
Al := coef_bits^[3];
|
||||||
|
if (Al <> 0) and (workspace[16] = 0) then
|
||||||
|
begin
|
||||||
|
num := 9 * Q00 * (DC2 + DC8 - 2*DC5);
|
||||||
|
if (num >= 0) then
|
||||||
|
begin
|
||||||
|
pred := int (((Q20 shl 7) + num) div (Q20 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
pred := int (((Q20 shl 7) - num) div (Q20 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
pred := -pred;
|
||||||
|
end;
|
||||||
|
workspace[16] := JCOEF (pred);
|
||||||
|
end;
|
||||||
|
{ AC11 }
|
||||||
|
Al := coef_bits^[4];
|
||||||
|
if (Al <> 0) and (workspace[9] = 0) then
|
||||||
|
begin
|
||||||
|
num := 5 * Q00 * (DC1 - DC3 - DC7 + DC9);
|
||||||
|
if (num >= 0) then
|
||||||
|
begin
|
||||||
|
pred := int (((Q11 shl 7) + num) div (Q11 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
pred := int (((Q11 shl 7) - num) div (Q11 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
pred := -pred;
|
||||||
|
end;
|
||||||
|
workspace[9] := JCOEF (pred);
|
||||||
|
end;
|
||||||
|
{ AC02 }
|
||||||
|
Al := coef_bits^[5];
|
||||||
|
if (Al <> 0) and (workspace[2] = 0) then
|
||||||
|
begin
|
||||||
|
num := 9 * Q00 * (DC4 + DC6 - 2*DC5);
|
||||||
|
if (num >= 0) then
|
||||||
|
begin
|
||||||
|
pred := int (((Q02 shl 7) + num) div (Q02 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
pred := int (((Q02 shl 7) - num) div (Q02 shl 8));
|
||||||
|
if (Al > 0) and (pred >= (1 shl Al)) then
|
||||||
|
pred := (1 shl Al)-1;
|
||||||
|
pred := -pred;
|
||||||
|
end;
|
||||||
|
workspace[2] := JCOEF (pred);
|
||||||
|
end;
|
||||||
|
{ OK, do the IDCT }
|
||||||
|
inverse_DCT (cinfo, compptr, JCOEFPTR (@workspace),
|
||||||
|
output_ptr, output_col);
|
||||||
|
{ Advance for next column }
|
||||||
|
DC1 := DC2; DC2 := DC3;
|
||||||
|
DC4 := DC5; DC5 := DC6;
|
||||||
|
DC7 := DC8; DC8 := DC9;
|
||||||
|
Inc(JBLOCK_PTR(buffer_ptr));
|
||||||
|
Inc(JBLOCK_PTR(prev_block_row));
|
||||||
|
Inc(JBLOCK_PTR(next_block_row));
|
||||||
|
Inc(output_col, compptr^.DCT_scaled_size);
|
||||||
|
end;
|
||||||
|
Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size);
|
||||||
|
end;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Inc(cinfo^.output_iMCU_row);
|
||||||
|
if (cinfo^.output_iMCU_row < LongInt(cinfo^.total_iMCU_rows)) then
|
||||||
|
begin
|
||||||
|
decompress_smooth_data := JPEG_ROW_COMPLETED;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
decompress_smooth_data := JPEG_SCAN_COMPLETED;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { BLOCK_SMOOTHING_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize coefficient buffer controller. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_d_coef_controller (cinfo : j_decompress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
var
|
||||||
|
coef : my_coef_ptr;
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
var
|
||||||
|
ci, access_rows : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
{$endif}
|
||||||
|
var
|
||||||
|
buffer : JBLOCK_PTR;
|
||||||
|
i : int;
|
||||||
|
begin
|
||||||
|
coef := my_coef_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_coef_controller)) );
|
||||||
|
cinfo^.coef := jpeg_d_coef_controller_ptr(coef);
|
||||||
|
coef^.pub.start_input_pass := start_input_pass;
|
||||||
|
coef^.pub.start_output_pass := start_output_pass;
|
||||||
|
{$ifdef BLOCK_SMOOTHING_SUPPORTED}
|
||||||
|
coef^.coef_bits_latch := NIL;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{ Create the coefficient buffer. }
|
||||||
|
if (need_full_buffer) then
|
||||||
|
begin
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
{ Allocate a full-image virtual array for each component, }
|
||||||
|
{ padded to a multiple of samp_factor DCT blocks in each direction. }
|
||||||
|
{ Note we ask for a pre-zeroed array. }
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
access_rows := compptr^.v_samp_factor;
|
||||||
|
{$ifdef BLOCK_SMOOTHING_SUPPORTED}
|
||||||
|
{ If block smoothing could be used, need a bigger window }
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
access_rows := access_rows * 3;
|
||||||
|
{$endif}
|
||||||
|
coef^.whole_image[ci] := cinfo^.mem^.request_virt_barray
|
||||||
|
(j_common_ptr (cinfo), JPOOL_IMAGE, TRUE,
|
||||||
|
JDIMENSION (jround_up( long(compptr^.width_in_blocks),
|
||||||
|
long(compptr^.h_samp_factor) )),
|
||||||
|
JDIMENSION (jround_up( long(compptr^.height_in_blocks),
|
||||||
|
long(compptr^.v_samp_factor) )),
|
||||||
|
JDIMENSION (access_rows));
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
coef^.pub.consume_data := consume_data;
|
||||||
|
coef^.pub.decompress_data := decompress_data;
|
||||||
|
coef^.pub.coef_arrays := @(coef^.whole_image);
|
||||||
|
{ link to virtual arrays }
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ We only need a single-MCU buffer. }
|
||||||
|
buffer := JBLOCK_PTR (
|
||||||
|
cinfo^.mem^.alloc_large (j_common_ptr (cinfo), JPOOL_IMAGE,
|
||||||
|
D_MAX_BLOCKS_IN_MCU * SIZEOF(JBLOCK)) );
|
||||||
|
for i := 0 to pred(D_MAX_BLOCKS_IN_MCU) do
|
||||||
|
begin
|
||||||
|
coef^.MCU_buffer[i] := JBLOCKROW(buffer);
|
||||||
|
Inc(buffer);
|
||||||
|
end;
|
||||||
|
coef^.pub.consume_data := dummy_consume_data;
|
||||||
|
coef^.pub.decompress_data := decompress_onepass;
|
||||||
|
coef^.pub.coef_arrays := NIL; { flag for no virtual arrays }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,501 @@
|
||||||
|
unit imjdcolor;
|
||||||
|
|
||||||
|
{ This file contains output colorspace conversion routines. }
|
||||||
|
|
||||||
|
{ Original: jdcolor.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjutils,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
{ Module initialization routine for output colorspace conversion. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_color_deconverter (cinfo : j_decompress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Private subobject }
|
||||||
|
type
|
||||||
|
int_Color_Table = array[0..MAXJSAMPLE+1-1] of int;
|
||||||
|
int_table_ptr = ^int_Color_Table;
|
||||||
|
INT32_Color_Table = array[0..MAXJSAMPLE+1-1] of INT32;
|
||||||
|
INT32_table_ptr = ^INT32_Color_Table;
|
||||||
|
type
|
||||||
|
my_cconvert_ptr = ^my_color_deconverter;
|
||||||
|
my_color_deconverter = record
|
||||||
|
pub : jpeg_color_deconverter; { public fields }
|
||||||
|
|
||||||
|
{ Private state for YCC^.RGB conversion }
|
||||||
|
Cr_r_tab : int_table_ptr; { => table for Cr to R conversion }
|
||||||
|
Cb_b_tab : int_table_ptr; { => table for Cb to B conversion }
|
||||||
|
Cr_g_tab : INT32_table_ptr; { => table for Cr to G conversion }
|
||||||
|
Cb_g_tab : INT32_table_ptr; { => table for Cb to G conversion }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{*************** YCbCr ^. RGB conversion: most common case *************}
|
||||||
|
|
||||||
|
{ YCbCr is defined per CCIR 601-1, except that Cb and Cr are
|
||||||
|
normalized to the range 0..MAXJSAMPLE rather than -0.5 .. 0.5.
|
||||||
|
The conversion equations to be implemented are therefore
|
||||||
|
R = Y + 1.40200 * Cr
|
||||||
|
G = Y - 0.34414 * Cb - 0.71414 * Cr
|
||||||
|
B = Y + 1.77200 * Cb
|
||||||
|
where Cb and Cr represent the incoming values less CENTERJSAMPLE.
|
||||||
|
(These numbers are derived from TIFF 6.0 section 21, dated 3-June-92.)
|
||||||
|
|
||||||
|
To avoid floating-point arithmetic, we represent the fractional constants
|
||||||
|
as integers scaled up by 2^16 (about 4 digits precision); we have to divide
|
||||||
|
the products by 2^16, with appropriate rounding, to get the correct answer.
|
||||||
|
Notice that Y, being an integral input, does not contribute any fraction
|
||||||
|
so it need not participate in the rounding.
|
||||||
|
|
||||||
|
For even more speed, we avoid doing any multiplications in the inner loop
|
||||||
|
by precalculating the constants times Cb and Cr for all possible values.
|
||||||
|
For 8-bit JSAMPLEs this is very reasonable (only 256 entries per table);
|
||||||
|
for 12-bit samples it is still acceptable. It's not very reasonable for
|
||||||
|
16-bit samples, but if you want lossless storage you shouldn't be changing
|
||||||
|
colorspace anyway.
|
||||||
|
The Cr=>R and Cb=>B values can be rounded to integers in advance; the
|
||||||
|
values for the G calculation are left scaled up, since we must add them
|
||||||
|
together before rounding. }
|
||||||
|
|
||||||
|
const
|
||||||
|
SCALEBITS = 16; { speediest right-shift on some machines }
|
||||||
|
ONE_HALF = (INT32(1) shl (SCALEBITS-1));
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize tables for YCC->RGB colorspace conversion. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure build_ycc_rgb_table (cinfo : j_decompress_ptr);
|
||||||
|
const
|
||||||
|
FIX_1_40200 = INT32(Round( 1.40200 * (1 shl SCALEBITS)));
|
||||||
|
FIX_1_77200 = INT32(Round( 1.77200 * (1 shl SCALEBITS)));
|
||||||
|
FIX_0_71414 = INT32(Round( 0.71414 * (1 shl SCALEBITS)));
|
||||||
|
FIX_0_34414 = INT32(Round( 0.34414 * (1 shl SCALEBITS)));
|
||||||
|
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
i : int;
|
||||||
|
x : INT32;
|
||||||
|
var
|
||||||
|
shift_temp : INT32;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr (cinfo^.cconvert);
|
||||||
|
|
||||||
|
|
||||||
|
cconvert^.Cr_r_tab := int_table_ptr(
|
||||||
|
cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
(MAXJSAMPLE+1) * SIZEOF(int)) );
|
||||||
|
cconvert^.Cb_b_tab := int_table_ptr (
|
||||||
|
cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
(MAXJSAMPLE+1) * SIZEOF(int)) );
|
||||||
|
cconvert^.Cr_g_tab := INT32_table_ptr (
|
||||||
|
cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
(MAXJSAMPLE+1) * SIZEOF(INT32)) );
|
||||||
|
cconvert^.Cb_g_tab := INT32_table_ptr (
|
||||||
|
cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
(MAXJSAMPLE+1) * SIZEOF(INT32)) );
|
||||||
|
|
||||||
|
|
||||||
|
x := -CENTERJSAMPLE;
|
||||||
|
for i := 0 to MAXJSAMPLE do
|
||||||
|
begin
|
||||||
|
{ i is the actual input pixel value, in the range 0..MAXJSAMPLE }
|
||||||
|
{ The Cb or Cr value we are thinking of is x := i - CENTERJSAMPLE }
|
||||||
|
{ Cr=>R value is nearest int to 1.40200 * x }
|
||||||
|
|
||||||
|
shift_temp := FIX_1_40200 * x + ONE_HALF;
|
||||||
|
if shift_temp < 0 then { SHIFT arithmetic RIGHT }
|
||||||
|
cconvert^.Cr_r_tab^[i] := int((shift_temp shr SCALEBITS)
|
||||||
|
or ( (not INT32(0)) shl (32-SCALEBITS)))
|
||||||
|
else
|
||||||
|
cconvert^.Cr_r_tab^[i] := int(shift_temp shr SCALEBITS);
|
||||||
|
|
||||||
|
{ Cb=>B value is nearest int to 1.77200 * x }
|
||||||
|
shift_temp := FIX_1_77200 * x + ONE_HALF;
|
||||||
|
if shift_temp < 0 then { SHIFT arithmetic RIGHT }
|
||||||
|
cconvert^.Cb_b_tab^[i] := int((shift_temp shr SCALEBITS)
|
||||||
|
or ( (not INT32(0)) shl (32-SCALEBITS)))
|
||||||
|
else
|
||||||
|
cconvert^.Cb_b_tab^[i] := int(shift_temp shr SCALEBITS);
|
||||||
|
|
||||||
|
{ Cr=>G value is scaled-up -0.71414 * x }
|
||||||
|
cconvert^.Cr_g_tab^[i] := (- FIX_0_71414 ) * x;
|
||||||
|
{ Cb=>G value is scaled-up -0.34414 * x }
|
||||||
|
{ We also add in ONE_HALF so that need not do it in inner loop }
|
||||||
|
cconvert^.Cb_g_tab^[i] := (- FIX_0_34414 ) * x + ONE_HALF;
|
||||||
|
Inc(x);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Convert some rows of samples to the output colorspace.
|
||||||
|
|
||||||
|
Note that we change from noninterleaved, one-plane-per-component format
|
||||||
|
to interleaved-pixel format. The output buffer is therefore three times
|
||||||
|
as wide as the input buffer.
|
||||||
|
A starting row offset is provided only for the input buffer. The caller
|
||||||
|
can easily adjust the passed output_buf value to accommodate any row
|
||||||
|
offset required on that side. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure ycc_rgb_convert (cinfo : j_decompress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE;
|
||||||
|
input_row : JDIMENSION;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
num_rows : int);
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
{register} y, cb, cr : int;
|
||||||
|
{register} outptr : JSAMPROW;
|
||||||
|
{register} inptr0, inptr1, inptr2 : JSAMPROW;
|
||||||
|
{register} col : JDIMENSION;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
{ copy these pointers into registers if possible }
|
||||||
|
{register} range_limit : range_limit_table_ptr;
|
||||||
|
{register} Crrtab : int_table_ptr;
|
||||||
|
{register} Cbbtab : int_table_ptr;
|
||||||
|
{register} Crgtab : INT32_table_ptr;
|
||||||
|
{register} Cbgtab : INT32_table_ptr;
|
||||||
|
var
|
||||||
|
shift_temp : INT32;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr (cinfo^.cconvert);
|
||||||
|
num_cols := cinfo^.output_width;
|
||||||
|
range_limit := cinfo^.sample_range_limit;
|
||||||
|
Crrtab := cconvert^.Cr_r_tab;
|
||||||
|
Cbbtab := cconvert^.Cb_b_tab;
|
||||||
|
Crgtab := cconvert^.Cr_g_tab;
|
||||||
|
Cbgtab := cconvert^.Cb_g_tab;
|
||||||
|
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
Dec(num_rows);
|
||||||
|
inptr0 := input_buf^[0]^[input_row];
|
||||||
|
inptr1 := input_buf^[1]^[input_row];
|
||||||
|
inptr2 := input_buf^[2]^[input_row];
|
||||||
|
Inc(input_row);
|
||||||
|
outptr := output_buf^[0];
|
||||||
|
Inc(JSAMPROW_PTR(output_buf));
|
||||||
|
for col := 0 to pred(num_cols) do
|
||||||
|
begin
|
||||||
|
y := GETJSAMPLE(inptr0^[col]);
|
||||||
|
cb := GETJSAMPLE(inptr1^[col]);
|
||||||
|
cr := GETJSAMPLE(inptr2^[col]);
|
||||||
|
{ Range-limiting is essential due to noise introduced by DCT losses. }
|
||||||
|
outptr^[RGB_RED] := range_limit^[y + Crrtab^[cr]];
|
||||||
|
shift_temp := Cbgtab^[cb] + Crgtab^[cr];
|
||||||
|
if shift_temp < 0 then { SHIFT arithmetic RIGHT }
|
||||||
|
outptr^[RGB_GREEN] := range_limit^[y + int((shift_temp shr SCALEBITS)
|
||||||
|
or ( (not INT32(0)) shl (32-SCALEBITS)))]
|
||||||
|
else
|
||||||
|
outptr^[RGB_GREEN] := range_limit^[y + int(shift_temp shr SCALEBITS)];
|
||||||
|
|
||||||
|
outptr^[RGB_BLUE] := range_limit^[y + Cbbtab^[cb]];
|
||||||
|
Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{*************** Cases other than YCbCr -> RGB *************}
|
||||||
|
|
||||||
|
|
||||||
|
{ Color conversion for no colorspace change: just copy the data,
|
||||||
|
converting from separate-planes to interleaved representation. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure null_convert (cinfo : j_decompress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE;
|
||||||
|
input_row : JDIMENSION;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
num_rows : int);
|
||||||
|
var
|
||||||
|
{register} inptr,
|
||||||
|
outptr : JSAMPLE_PTR;
|
||||||
|
{register} count : JDIMENSION;
|
||||||
|
{register} num_components : int;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
ci : int;
|
||||||
|
begin
|
||||||
|
num_components := cinfo^.num_components;
|
||||||
|
num_cols := cinfo^.output_width;
|
||||||
|
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
Dec(num_rows);
|
||||||
|
for ci := 0 to pred(num_components) do
|
||||||
|
begin
|
||||||
|
inptr := JSAMPLE_PTR(input_buf^[ci]^[input_row]);
|
||||||
|
outptr := JSAMPLE_PTR(@(output_buf^[0]^[ci]));
|
||||||
|
|
||||||
|
for count := pred(num_cols) downto 0 do
|
||||||
|
begin
|
||||||
|
outptr^ := inptr^; { needn't bother with GETJSAMPLE() here }
|
||||||
|
Inc(inptr);
|
||||||
|
Inc(outptr, num_components);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Inc(input_row);
|
||||||
|
Inc(JSAMPROW_PTR(output_buf));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Color conversion for grayscale: just copy the data.
|
||||||
|
This also works for YCbCr -> grayscale conversion, in which
|
||||||
|
we just copy the Y (luminance) component and ignore chrominance. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure grayscale_convert (cinfo : j_decompress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE;
|
||||||
|
input_row : JDIMENSION;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
num_rows : int);
|
||||||
|
begin
|
||||||
|
jcopy_sample_rows(input_buf^[0], int(input_row), output_buf, 0,
|
||||||
|
num_rows, cinfo^.output_width);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Convert grayscale to RGB: just duplicate the graylevel three times.
|
||||||
|
This is provided to support applications that don't want to cope
|
||||||
|
with grayscale as a separate case. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure gray_rgb_convert (cinfo : j_decompress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE;
|
||||||
|
input_row : JDIMENSION;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
num_rows : int);
|
||||||
|
var
|
||||||
|
{register} inptr, outptr : JSAMPLE_PTR;
|
||||||
|
{register} col : JDIMENSION;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
begin
|
||||||
|
num_cols := cinfo^.output_width;
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
inptr := JSAMPLE_PTR(input_buf^[0]^[input_row]);
|
||||||
|
Inc(input_row);
|
||||||
|
outptr := JSAMPLE_PTR(@output_buf^[0]);
|
||||||
|
Inc(JSAMPROW_PTR(output_buf));
|
||||||
|
for col := 0 to pred(num_cols) do
|
||||||
|
begin
|
||||||
|
{ We can dispense with GETJSAMPLE() here }
|
||||||
|
JSAMPROW(outptr)^[RGB_RED] := inptr^;
|
||||||
|
JSAMPROW(outptr)^[RGB_GREEN] := inptr^;
|
||||||
|
JSAMPROW(outptr)^[RGB_BLUE] := inptr^;
|
||||||
|
Inc(inptr);
|
||||||
|
Inc(outptr, RGB_PIXELSIZE);
|
||||||
|
end;
|
||||||
|
Dec(num_rows);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Adobe-style YCCK -> CMYK conversion.
|
||||||
|
We convert YCbCr to R=1-C, G=1-M, and B=1-Y using the same
|
||||||
|
conversion as above, while passing K (black) unchanged.
|
||||||
|
We assume build_ycc_rgb_table has been called. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure ycck_cmyk_convert (cinfo : j_decompress_ptr;
|
||||||
|
input_buf : JSAMPIMAGE;
|
||||||
|
input_row : JDIMENSION;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
num_rows : int);
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
{register} y, cb, cr : int;
|
||||||
|
{register} outptr : JSAMPROW;
|
||||||
|
{register} inptr0, inptr1, inptr2, inptr3 : JSAMPROW;
|
||||||
|
{register} col : JDIMENSION;
|
||||||
|
num_cols : JDIMENSION;
|
||||||
|
{ copy these pointers into registers if possible }
|
||||||
|
{register} range_limit : range_limit_table_ptr;
|
||||||
|
{register} Crrtab : int_table_ptr;
|
||||||
|
{register} Cbbtab : int_table_ptr;
|
||||||
|
{register} Crgtab : INT32_table_ptr;
|
||||||
|
{register} Cbgtab : INT32_table_ptr;
|
||||||
|
var
|
||||||
|
shift_temp : INT32;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr (cinfo^.cconvert);
|
||||||
|
num_cols := cinfo^.output_width;
|
||||||
|
{ copy these pointers into registers if possible }
|
||||||
|
range_limit := cinfo^.sample_range_limit;
|
||||||
|
Crrtab := cconvert^.Cr_r_tab;
|
||||||
|
Cbbtab := cconvert^.Cb_b_tab;
|
||||||
|
Crgtab := cconvert^.Cr_g_tab;
|
||||||
|
Cbgtab := cconvert^.Cb_g_tab;
|
||||||
|
|
||||||
|
while (num_rows > 0) do
|
||||||
|
begin
|
||||||
|
Dec(num_rows);
|
||||||
|
inptr0 := input_buf^[0]^[input_row];
|
||||||
|
inptr1 := input_buf^[1]^[input_row];
|
||||||
|
inptr2 := input_buf^[2]^[input_row];
|
||||||
|
inptr3 := input_buf^[3]^[input_row];
|
||||||
|
Inc(input_row);
|
||||||
|
outptr := output_buf^[0];
|
||||||
|
Inc(JSAMPROW_PTR(output_buf));
|
||||||
|
for col := 0 to pred(num_cols) do
|
||||||
|
begin
|
||||||
|
y := GETJSAMPLE(inptr0^[col]);
|
||||||
|
cb := GETJSAMPLE(inptr1^[col]);
|
||||||
|
cr := GETJSAMPLE(inptr2^[col]);
|
||||||
|
{ Range-limiting is essential due to noise introduced by DCT losses. }
|
||||||
|
outptr^[0] := range_limit^[MAXJSAMPLE - (y + Crrtab^[cr])]; { red }
|
||||||
|
shift_temp := Cbgtab^[cb] + Crgtab^[cr];
|
||||||
|
if shift_temp < 0 then
|
||||||
|
outptr^[1] := range_limit^[MAXJSAMPLE - (y + int(
|
||||||
|
(shift_temp shr SCALEBITS) or ((not INT32(0)) shl (32-SCALEBITS))
|
||||||
|
) )]
|
||||||
|
else
|
||||||
|
outptr^[1] := range_limit^[MAXJSAMPLE - { green }
|
||||||
|
(y + int(shift_temp shr SCALEBITS) )];
|
||||||
|
outptr^[2] := range_limit^[MAXJSAMPLE - (y + Cbbtab^[cb])]; { blue }
|
||||||
|
{ K passes through unchanged }
|
||||||
|
outptr^[3] := inptr3^[col]; { don't need GETJSAMPLE here }
|
||||||
|
Inc(JSAMPLE_PTR(outptr), 4);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Empty method for start_pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass_dcolor (cinfo : j_decompress_ptr);
|
||||||
|
begin
|
||||||
|
{ no work needed }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Module initialization routine for output colorspace conversion. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_color_deconverter (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
cconvert : my_cconvert_ptr;
|
||||||
|
ci : int;
|
||||||
|
begin
|
||||||
|
cconvert := my_cconvert_ptr (
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_color_deconverter)) );
|
||||||
|
cinfo^.cconvert := jpeg_color_deconverter_ptr (cconvert);
|
||||||
|
cconvert^.pub.start_pass := start_pass_dcolor;
|
||||||
|
|
||||||
|
{ Make sure num_components agrees with jpeg_color_space }
|
||||||
|
case (cinfo^.jpeg_color_space) of
|
||||||
|
JCS_GRAYSCALE:
|
||||||
|
if (cinfo^.num_components <> 1) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
|
||||||
|
JCS_RGB,
|
||||||
|
JCS_YCbCr:
|
||||||
|
if (cinfo^.num_components <> 3) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
|
||||||
|
JCS_CMYK,
|
||||||
|
JCS_YCCK:
|
||||||
|
if (cinfo^.num_components <> 4) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
|
||||||
|
else { JCS_UNKNOWN can be anything }
|
||||||
|
if (cinfo^.num_components < 1) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Set out_color_components and conversion method based on requested space.
|
||||||
|
Also clear the component_needed flags for any unused components,
|
||||||
|
so that earlier pipeline stages can avoid useless computation. }
|
||||||
|
|
||||||
|
case (cinfo^.out_color_space) of
|
||||||
|
JCS_GRAYSCALE:
|
||||||
|
begin
|
||||||
|
cinfo^.out_color_components := 1;
|
||||||
|
if (cinfo^.jpeg_color_space = JCS_GRAYSCALE)
|
||||||
|
or (cinfo^.jpeg_color_space = JCS_YCbCr) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.color_convert := grayscale_convert;
|
||||||
|
{ For color -> grayscale conversion, only the
|
||||||
|
Y (0) component is needed }
|
||||||
|
for ci := 1 to pred(cinfo^.num_components) do
|
||||||
|
cinfo^.comp_info^[ci].component_needed := FALSE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
JCS_RGB:
|
||||||
|
begin
|
||||||
|
cinfo^.out_color_components := RGB_PIXELSIZE;
|
||||||
|
if (cinfo^.jpeg_color_space = JCS_YCbCr) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.color_convert := ycc_rgb_convert;
|
||||||
|
build_ycc_rgb_table(cinfo);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.jpeg_color_space = JCS_GRAYSCALE) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.color_convert := gray_rgb_convert;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.jpeg_color_space = JCS_RGB) and (RGB_PIXELSIZE = 3) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.color_convert := null_convert;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
JCS_CMYK:
|
||||||
|
begin
|
||||||
|
cinfo^.out_color_components := 4;
|
||||||
|
if (cinfo^.jpeg_color_space = JCS_YCCK) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.color_convert := ycck_cmyk_convert;
|
||||||
|
build_ycc_rgb_table(cinfo);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.jpeg_color_space = JCS_CMYK) then
|
||||||
|
begin
|
||||||
|
cconvert^.pub.color_convert := null_convert;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
|
||||||
|
else
|
||||||
|
begin { Permit null conversion to same output space }
|
||||||
|
if (cinfo^.out_color_space = cinfo^.jpeg_color_space) then
|
||||||
|
begin
|
||||||
|
cinfo^.out_color_components := cinfo^.num_components;
|
||||||
|
cconvert^.pub.color_convert := null_convert;
|
||||||
|
end
|
||||||
|
else { unsupported non-null conversion }
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (cinfo^.quantize_colors) then
|
||||||
|
cinfo^.output_components := 1 { single colormapped output component }
|
||||||
|
else
|
||||||
|
cinfo^.output_components := cinfo^.out_color_components;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,109 @@
|
||||||
|
unit imjdct;
|
||||||
|
|
||||||
|
{ Orignal: jdct.h; Copyright (C) 1994-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
{ This include file contains common declarations for the forward and
|
||||||
|
inverse DCT modules. These declarations are private to the DCT managers
|
||||||
|
(jcdctmgr.c, jddctmgr.c) and the individual DCT algorithms.
|
||||||
|
The individual DCT algorithms are kept in separate files to ease
|
||||||
|
machine-dependent tuning (e.g., assembly coding). }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg;
|
||||||
|
|
||||||
|
|
||||||
|
{ A forward DCT routine is given a pointer to a work area of type DCTELEM[];
|
||||||
|
the DCT is to be performed in-place in that buffer. Type DCTELEM is int
|
||||||
|
for 8-bit samples, INT32 for 12-bit samples. (NOTE: Floating-point DCT
|
||||||
|
implementations use an array of type FAST_FLOAT, instead.)
|
||||||
|
The DCT inputs are expected to be signed (range +-CENTERJSAMPLE).
|
||||||
|
The DCT outputs are returned scaled up by a factor of 8; they therefore
|
||||||
|
have a range of +-8K for 8-bit data, +-128K for 12-bit data. This
|
||||||
|
convention improves accuracy in integer implementations and saves some
|
||||||
|
work in floating-point ones.
|
||||||
|
Quantization of the output coefficients is done by jcdctmgr.c. }
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef BITS_IN_JSAMPLE_IS_8}
|
||||||
|
type
|
||||||
|
DCTELEM = int; { 16 or 32 bits is fine }
|
||||||
|
{$else}
|
||||||
|
type { must have 32 bits }
|
||||||
|
DCTELEM = INT32;
|
||||||
|
{$endif}
|
||||||
|
type
|
||||||
|
jTDctElem = 0..(MaxInt div SizeOf(DCTELEM))-1;
|
||||||
|
DCTELEM_FIELD = array[jTDctElem] of DCTELEM;
|
||||||
|
DCTELEM_FIELD_PTR = ^DCTELEM_FIELD;
|
||||||
|
DCTELEMPTR = ^DCTELEM;
|
||||||
|
|
||||||
|
type
|
||||||
|
forward_DCT_method_ptr = procedure(var data : array of DCTELEM);
|
||||||
|
float_DCT_method_ptr = procedure(var data : array of FAST_FLOAT);
|
||||||
|
|
||||||
|
|
||||||
|
{ An inverse DCT routine is given a pointer to the input JBLOCK and a pointer
|
||||||
|
to an output sample array. The routine must dequantize the input data as
|
||||||
|
well as perform the IDCT; for dequantization, it uses the multiplier table
|
||||||
|
pointed to by compptr->dct_table. The output data is to be placed into the
|
||||||
|
sample array starting at a specified column. (Any row offset needed will
|
||||||
|
be applied to the array pointer before it is passed to the IDCT code.)
|
||||||
|
Note that the number of samples emitted by the IDCT routine is
|
||||||
|
DCT_scaled_size * DCT_scaled_size. }
|
||||||
|
|
||||||
|
|
||||||
|
{ typedef inverse_DCT_method_ptr is declared in jpegint.h }
|
||||||
|
|
||||||
|
|
||||||
|
{ Each IDCT routine has its own ideas about the best dct_table element type. }
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
ISLOW_MULT_TYPE = MULTIPLIER; { short or int, whichever is faster }
|
||||||
|
|
||||||
|
{$ifdef BITS_IN_JSAMPLE_IS_8}
|
||||||
|
type
|
||||||
|
IFAST_MULT_TYPE = MULTIPLIER; { 16 bits is OK, use short if faster }
|
||||||
|
const
|
||||||
|
IFAST_SCALE_BITS = 2; { fractional bits in scale factors }
|
||||||
|
{$else}
|
||||||
|
type
|
||||||
|
IFAST_MULT_TYPE = INT32; { need 32 bits for scaled quantizers }
|
||||||
|
const
|
||||||
|
IFAST_SCALE_BITS = 13; { fractional bits in scale factors }
|
||||||
|
{$endif}
|
||||||
|
type
|
||||||
|
FLOAT_MULT_TYPE = FAST_FLOAT; { preferred floating type }
|
||||||
|
|
||||||
|
const
|
||||||
|
RANGE_MASK = (MAXJSAMPLE * 4 + 3); { 2 bits wider than legal samples }
|
||||||
|
|
||||||
|
type
|
||||||
|
jTMultType = 0..(MaxInt div SizeOf(ISLOW_MULT_TYPE))-1;
|
||||||
|
ISLOW_MULT_TYPE_FIELD = array[jTMultType] of ISLOW_MULT_TYPE;
|
||||||
|
ISLOW_MULT_TYPE_FIELD_PTR = ^ISLOW_MULT_TYPE_FIELD;
|
||||||
|
ISLOW_MULT_TYPE_PTR = ^ISLOW_MULT_TYPE;
|
||||||
|
|
||||||
|
jTFloatType = 0..(MaxInt div SizeOf(FLOAT_MULT_TYPE))-1;
|
||||||
|
FLOAT_MULT_TYPE_FIELD = array[jTFloatType] of FLOAT_MULT_TYPE;
|
||||||
|
FLOAT_MULT_TYPE_FIELD_PTR = ^FLOAT_MULT_TYPE_FIELD;
|
||||||
|
FLOAT_MULT_TYPE_PTR = ^FLOAT_MULT_TYPE;
|
||||||
|
|
||||||
|
jTFastType = 0..(MaxInt div SizeOf(IFAST_MULT_TYPE))-1;
|
||||||
|
IFAST_MULT_TYPE_FIELD = array[jTFastType] of IFAST_MULT_TYPE;
|
||||||
|
IFAST_MULT_TYPE_FIELD_PTR = ^IFAST_MULT_TYPE_FIELD;
|
||||||
|
IFAST_MULT_TYPE_PTR = ^IFAST_MULT_TYPE;
|
||||||
|
|
||||||
|
type
|
||||||
|
jTFastFloat = 0..(MaxInt div SizeOf(FAST_FLOAT))-1;
|
||||||
|
FAST_FLOAT_FIELD = array[jTFastFloat] of FAST_FLOAT;
|
||||||
|
FAST_FLOAT_FIELD_PTR = ^FAST_FLOAT_FIELD;
|
||||||
|
FAST_FLOAT_PTR = ^FAST_FLOAT;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,330 @@
|
||||||
|
unit imjddctmgr;
|
||||||
|
|
||||||
|
{ Original : jddctmgr.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
{ This file contains the inverse-DCT management logic.
|
||||||
|
This code selects a particular IDCT implementation to be used,
|
||||||
|
and it performs related housekeeping chores. No code in this file
|
||||||
|
is executed per IDCT step, only during output pass setup.
|
||||||
|
|
||||||
|
Note that the IDCT routines are responsible for performing coefficient
|
||||||
|
dequantization as well as the IDCT proper. This module sets up the
|
||||||
|
dequantization multiplier table needed by the IDCT routine. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
{$N+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib,
|
||||||
|
imjdct, { Private declarations for DCT subsystem }
|
||||||
|
imjidctfst,
|
||||||
|
{$IFDEF BASM}
|
||||||
|
imjidctasm,
|
||||||
|
{$ELSE}
|
||||||
|
imjidctint,
|
||||||
|
{$ENDIF}
|
||||||
|
imjidctflt,
|
||||||
|
imjidctred;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize IDCT manager. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_inverse_dct (cinfo : j_decompress_ptr);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ The decompressor input side (jdinput.c) saves away the appropriate
|
||||||
|
quantization table for each component at the start of the first scan
|
||||||
|
involving that component. (This is necessary in order to correctly
|
||||||
|
decode files that reuse Q-table slots.)
|
||||||
|
When we are ready to make an output pass, the saved Q-table is converted
|
||||||
|
to a multiplier table that will actually be used by the IDCT routine.
|
||||||
|
The multiplier table contents are IDCT-method-dependent. To support
|
||||||
|
application changes in IDCT method between scans, we can remake the
|
||||||
|
multiplier tables if necessary.
|
||||||
|
In buffered-image mode, the first output pass may occur before any data
|
||||||
|
has been seen for some components, and thus before their Q-tables have
|
||||||
|
been saved away. To handle this case, multiplier tables are preset
|
||||||
|
to zeroes; the result of the IDCT will be a neutral gray level. }
|
||||||
|
|
||||||
|
|
||||||
|
{ Private subobject for this module }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_idct_ptr = ^my_idct_controller;
|
||||||
|
my_idct_controller = record
|
||||||
|
pub : jpeg_inverse_dct; { public fields }
|
||||||
|
|
||||||
|
{ This array contains the IDCT method code that each multiplier table
|
||||||
|
is currently set up for, or -1 if it's not yet set up.
|
||||||
|
The actual multiplier tables are pointed to by dct_table in the
|
||||||
|
per-component comp_info structures. }
|
||||||
|
|
||||||
|
cur_method : array[0..MAX_COMPONENTS-1] of int;
|
||||||
|
end; {my_idct_controller;}
|
||||||
|
|
||||||
|
|
||||||
|
{ Allocated multiplier tables: big enough for any supported variant }
|
||||||
|
|
||||||
|
type
|
||||||
|
multiplier_table = record
|
||||||
|
case byte of
|
||||||
|
0:(islow_array : array[0..DCTSIZE2-1] of ISLOW_MULT_TYPE);
|
||||||
|
{$ifdef DCT_IFAST_SUPPORTED}
|
||||||
|
1:(ifast_array : array[0..DCTSIZE2-1] of IFAST_MULT_TYPE);
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
2:(float_array : array[0..DCTSIZE2-1] of FLOAT_MULT_TYPE);
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ The current scaled-IDCT routines require ISLOW-style multiplier tables,
|
||||||
|
so be sure to compile that code if either ISLOW or SCALING is requested. }
|
||||||
|
|
||||||
|
{$ifdef DCT_ISLOW_SUPPORTED}
|
||||||
|
{$define PROVIDE_ISLOW_TABLES}
|
||||||
|
{$else}
|
||||||
|
{$ifdef IDCT_SCALING_SUPPORTED}
|
||||||
|
{$define PROVIDE_ISLOW_TABLES}
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{ Prepare for an output pass.
|
||||||
|
Here we select the proper IDCT routine for each component and build
|
||||||
|
a matching multiplier table. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
idct : my_idct_ptr;
|
||||||
|
ci, i : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
method : J_DCT_METHOD;
|
||||||
|
method_ptr : inverse_DCT_method_ptr;
|
||||||
|
qtbl : JQUANT_TBL_PTR;
|
||||||
|
{$ifdef PROVIDE_ISLOW_TABLES}
|
||||||
|
var
|
||||||
|
ismtbl : ISLOW_MULT_TYPE_FIELD_PTR;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_IFAST_SUPPORTED}
|
||||||
|
const
|
||||||
|
CONST_BITS = 14;
|
||||||
|
const
|
||||||
|
aanscales : array[0..DCTSIZE2-1] of INT16 =
|
||||||
|
({ precomputed values scaled up by 14 bits }
|
||||||
|
16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520,
|
||||||
|
22725, 31521, 29692, 26722, 22725, 17855, 12299, 6270,
|
||||||
|
21407, 29692, 27969, 25172, 21407, 16819, 11585, 5906,
|
||||||
|
19266, 26722, 25172, 22654, 19266, 15137, 10426, 5315,
|
||||||
|
16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520,
|
||||||
|
12873, 17855, 16819, 15137, 12873, 10114, 6967, 3552,
|
||||||
|
8867, 12299, 11585, 10426, 8867, 6967, 4799, 2446,
|
||||||
|
4520, 6270, 5906, 5315, 4520, 3552, 2446, 1247);
|
||||||
|
var
|
||||||
|
ifmtbl : IFAST_MULT_TYPE_FIELD_PTR;
|
||||||
|
{SHIFT_TEMPS}
|
||||||
|
|
||||||
|
{ Descale and correctly round an INT32 value that's scaled by N bits.
|
||||||
|
We assume RIGHT_SHIFT rounds towards minus infinity, so adding
|
||||||
|
the fudge factor is correct for either sign of X. }
|
||||||
|
|
||||||
|
function DESCALE(x : INT32; n : int) : INT32;
|
||||||
|
var
|
||||||
|
shift_temp : INT32;
|
||||||
|
begin
|
||||||
|
{$ifdef RIGHT_SHIFT_IS_UNSIGNED}
|
||||||
|
shift_temp := x + (INT32(1) shl (n-1));
|
||||||
|
if shift_temp < 0 then
|
||||||
|
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
|
||||||
|
else
|
||||||
|
Descale := (shift_temp shr n);
|
||||||
|
{$else}
|
||||||
|
Descale := (x + (INT32(1) shl (n-1)) shr n;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
const
|
||||||
|
aanscalefactor : array[0..DCTSIZE-1] of double =
|
||||||
|
(1.0, 1.387039845, 1.306562965, 1.175875602,
|
||||||
|
1.0, 0.785694958, 0.541196100, 0.275899379);
|
||||||
|
var
|
||||||
|
fmtbl : FLOAT_MULT_TYPE_FIELD_PTR;
|
||||||
|
row, col : int;
|
||||||
|
{$endif}
|
||||||
|
begin
|
||||||
|
idct := my_idct_ptr (cinfo^.idct);
|
||||||
|
method := J_DCT_METHOD(0);
|
||||||
|
method_ptr := NIL;
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ Select the proper IDCT routine for this component's scaling }
|
||||||
|
case (compptr^.DCT_scaled_size) of
|
||||||
|
{$ifdef IDCT_SCALING_SUPPORTED}
|
||||||
|
1:begin
|
||||||
|
method_ptr := jpeg_idct_1x1;
|
||||||
|
method := JDCT_ISLOW; { jidctred uses islow-style table }
|
||||||
|
end;
|
||||||
|
2:begin
|
||||||
|
method_ptr := jpeg_idct_2x2;
|
||||||
|
method := JDCT_ISLOW; { jidctred uses islow-style table }
|
||||||
|
end;
|
||||||
|
4:begin
|
||||||
|
method_ptr := jpeg_idct_4x4;
|
||||||
|
method := JDCT_ISLOW; { jidctred uses islow-style table }
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
DCTSIZE:
|
||||||
|
case (cinfo^.dct_method) of
|
||||||
|
{$ifdef DCT_ISLOW_SUPPORTED}
|
||||||
|
JDCT_ISLOW:
|
||||||
|
begin
|
||||||
|
method_ptr := @jpeg_idct_islow;
|
||||||
|
method := JDCT_ISLOW;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_IFAST_SUPPORTED}
|
||||||
|
JDCT_IFAST:
|
||||||
|
begin
|
||||||
|
method_ptr := @jpeg_idct_ifast;
|
||||||
|
method := JDCT_IFAST;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
JDCT_FLOAT:
|
||||||
|
begin
|
||||||
|
method_ptr := @jpeg_idct_float;
|
||||||
|
method := JDCT_FLOAT;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_DCTSIZE, compptr^.DCT_scaled_size);
|
||||||
|
end;
|
||||||
|
idct^.pub.inverse_DCT[ci] := method_ptr;
|
||||||
|
{ Create multiplier table from quant table.
|
||||||
|
However, we can skip this if the component is uninteresting
|
||||||
|
or if we already built the table. Also, if no quant table
|
||||||
|
has yet been saved for the component, we leave the
|
||||||
|
multiplier table all-zero; we'll be reading zeroes from the
|
||||||
|
coefficient controller's buffer anyway. }
|
||||||
|
|
||||||
|
if (not compptr^.component_needed) or (idct^.cur_method[ci] = int(method)) then
|
||||||
|
continue;
|
||||||
|
qtbl := compptr^.quant_table;
|
||||||
|
if (qtbl = NIL) then { happens if no data yet for component }
|
||||||
|
continue;
|
||||||
|
idct^.cur_method[ci] := int(method);
|
||||||
|
case (method) of
|
||||||
|
{$ifdef PROVIDE_ISLOW_TABLES}
|
||||||
|
JDCT_ISLOW:
|
||||||
|
begin
|
||||||
|
{ For LL&M IDCT method, multipliers are equal to raw quantization
|
||||||
|
coefficients, but are stored as ints to ensure access efficiency. }
|
||||||
|
|
||||||
|
ismtbl := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
|
||||||
|
for i := 0 to pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
ismtbl^[i] := ISLOW_MULT_TYPE (qtbl^.quantval[i]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_IFAST_SUPPORTED}
|
||||||
|
JDCT_IFAST:
|
||||||
|
begin
|
||||||
|
{ For AA&N IDCT method, multipliers are equal to quantization
|
||||||
|
coefficients scaled by scalefactor[row]*scalefactor[col], where
|
||||||
|
scalefactor[0] := 1
|
||||||
|
scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7
|
||||||
|
For integer operation, the multiplier table is to be scaled by
|
||||||
|
IFAST_SCALE_BITS. }
|
||||||
|
|
||||||
|
ifmtbl := IFAST_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
|
||||||
|
|
||||||
|
for i := 0 to pred(DCTSIZE2) do
|
||||||
|
begin
|
||||||
|
ifmtbl^[i] := IFAST_MULT_TYPE(
|
||||||
|
DESCALE( INT32 (qtbl^.quantval[i]) * INT32 (aanscales[i]),
|
||||||
|
CONST_BITS-IFAST_SCALE_BITS) );
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef DCT_FLOAT_SUPPORTED}
|
||||||
|
JDCT_FLOAT:
|
||||||
|
begin
|
||||||
|
{ For float AA&N IDCT method, multipliers are equal to quantization
|
||||||
|
coefficients scaled by scalefactor[row]*scalefactor[col], where
|
||||||
|
scalefactor[0] := 1
|
||||||
|
scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 }
|
||||||
|
|
||||||
|
fmtbl := FLOAT_MULT_TYPE_FIELD_PTR(compptr^.dct_table);
|
||||||
|
|
||||||
|
i := 0;
|
||||||
|
for row := 0 to pred(DCTSIZE) do
|
||||||
|
begin
|
||||||
|
for col := 0 to pred(DCTSIZE) do
|
||||||
|
begin
|
||||||
|
fmtbl^[i] := {FLOAT_MULT_TYPE} (
|
||||||
|
{double} qtbl^.quantval[i] *
|
||||||
|
aanscalefactor[row] * aanscalefactor[col] );
|
||||||
|
Inc(i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif}
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize IDCT manager. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_inverse_dct (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
idct : my_idct_ptr;
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
idct := my_idct_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_idct_controller)) );
|
||||||
|
cinfo^.idct := jpeg_inverse_dct_ptr (idct);
|
||||||
|
idct^.pub.start_pass := start_pass;
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ Allocate and pre-zero a multiplier table for each component }
|
||||||
|
compptr^.dct_table :=
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(multiplier_table));
|
||||||
|
MEMZERO(compptr^.dct_table, SIZEOF(multiplier_table));
|
||||||
|
{ Mark multiplier table not yet set up for any method }
|
||||||
|
idct^.cur_method[ci] := -1;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,497 @@
|
||||||
|
unit imjdeferr;
|
||||||
|
|
||||||
|
{ This file defines the error and message codes for the cjpeg/djpeg
|
||||||
|
applications. These strings are not needed as part of the JPEG library
|
||||||
|
proper.
|
||||||
|
Edit this file to add new codes, or to translate the message strings to
|
||||||
|
some other language. }
|
||||||
|
|
||||||
|
{ Original cderror.h ; Copyright (C) 1994, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
{ To define the enum list of message codes, include this file without
|
||||||
|
defining macro JMESSAGE. To create a message string table, include it
|
||||||
|
again with a suitable JMESSAGE definition (see jerror.c for an example). }
|
||||||
|
|
||||||
|
|
||||||
|
{ Original: jversion.h ; Copyright (C) 1991-1996, Thomas G. Lane. }
|
||||||
|
{ This file contains software version identification. }
|
||||||
|
|
||||||
|
const
|
||||||
|
JVERSION = '6a 7-Feb-96';
|
||||||
|
|
||||||
|
JCOPYRIGHT = 'Copyright (C) 1996, Thomas G. Lane';
|
||||||
|
|
||||||
|
JNOTICE = 'Pascal Translation, Copyright (C) 1996, Jacques Nomssi Nzali';
|
||||||
|
|
||||||
|
{ Create the message string table.
|
||||||
|
We do this from the master message list in jerror.h by re-reading
|
||||||
|
jerror.h with a suitable definition for macro JMESSAGE.
|
||||||
|
The message table is made an external symbol just in case any applications
|
||||||
|
want to refer to it directly. }
|
||||||
|
|
||||||
|
type
|
||||||
|
J_MESSAGE_CODE =(
|
||||||
|
JMSG_NOMESSAGE,
|
||||||
|
JERR_ARITH_NOTIMPL,
|
||||||
|
JERR_BAD_ALIGN_TYPE,
|
||||||
|
JERR_BAD_ALLOC_CHUNK,
|
||||||
|
JERR_BAD_BUFFER_MODE,
|
||||||
|
JERR_BAD_COMPONENT_ID,
|
||||||
|
JERR_BAD_DCT_COEF,
|
||||||
|
JERR_BAD_DCTSIZE,
|
||||||
|
JERR_BAD_HUFF_TABLE,
|
||||||
|
JERR_BAD_IN_COLORSPACE,
|
||||||
|
JERR_BAD_J_COLORSPACE,
|
||||||
|
JERR_BAD_LENGTH,
|
||||||
|
JERR_BAD_LIB_VERSION,
|
||||||
|
JERR_BAD_MCU_SIZE,
|
||||||
|
JERR_BAD_POOL_ID,
|
||||||
|
JERR_BAD_PRECISION,
|
||||||
|
JERR_BAD_PROGRESSION,
|
||||||
|
JERR_BAD_PROG_SCRIPT,
|
||||||
|
JERR_BAD_SAMPLING,
|
||||||
|
JERR_BAD_SCAN_SCRIPT,
|
||||||
|
JERR_BAD_STATE,
|
||||||
|
JERR_BAD_STRUCT_SIZE,
|
||||||
|
JERR_BAD_VIRTUAL_ACCESS,
|
||||||
|
JERR_BUFFER_SIZE,
|
||||||
|
JERR_CANT_SUSPEND,
|
||||||
|
JERR_CCIR601_NOTIMPL,
|
||||||
|
JERR_COMPONENT_COUNT,
|
||||||
|
JERR_CONVERSION_NOTIMPL,
|
||||||
|
JERR_DAC_INDEX,
|
||||||
|
JERR_DAC_VALUE,
|
||||||
|
JERR_DHT_COUNTS,
|
||||||
|
JERR_DHT_INDEX,
|
||||||
|
JERR_DQT_INDEX,
|
||||||
|
JERR_EMPTY_IMAGE,
|
||||||
|
JERR_EMS_READ,
|
||||||
|
JERR_EMS_WRITE,
|
||||||
|
JERR_EOI_EXPECTED,
|
||||||
|
JERR_FILE_READ,
|
||||||
|
JERR_FILE_WRITE,
|
||||||
|
JERR_FRACT_SAMPLE_NOTIMPL,
|
||||||
|
JERR_HUFF_CLEN_OVERFLOW,
|
||||||
|
JERR_HUFF_MISSING_CODE,
|
||||||
|
JERR_IMAGE_TOO_BIG,
|
||||||
|
JERR_INPUT_EMPTY,
|
||||||
|
JERR_INPUT_EOF,
|
||||||
|
JERR_MISMATCHED_QUANT_TABLE,
|
||||||
|
JERR_MISSING_DATA,
|
||||||
|
JERR_MODE_CHANGE,
|
||||||
|
JERR_NOTIMPL,
|
||||||
|
JERR_NOT_COMPILED,
|
||||||
|
JERR_NO_BACKING_STORE,
|
||||||
|
JERR_NO_HUFF_TABLE,
|
||||||
|
JERR_NO_IMAGE,
|
||||||
|
JERR_NO_QUANT_TABLE,
|
||||||
|
JERR_NO_SOI,
|
||||||
|
JERR_OUT_OF_MEMORY,
|
||||||
|
JERR_QUANT_COMPONENTS,
|
||||||
|
JERR_QUANT_FEW_COLORS,
|
||||||
|
JERR_QUANT_MANY_COLORS,
|
||||||
|
JERR_SOF_DUPLICATE,
|
||||||
|
JERR_SOF_NO_SOS,
|
||||||
|
JERR_SOF_UNSUPPORTED,
|
||||||
|
JERR_SOI_DUPLICATE,
|
||||||
|
JERR_SOS_NO_SOF,
|
||||||
|
JERR_TFILE_CREATE,
|
||||||
|
JERR_TFILE_READ,
|
||||||
|
JERR_TFILE_SEEK,
|
||||||
|
JERR_TFILE_WRITE,
|
||||||
|
JERR_TOO_LITTLE_DATA,
|
||||||
|
JERR_UNKNOWN_MARKER,
|
||||||
|
JERR_VIRTUAL_BUG,
|
||||||
|
JERR_WIDTH_OVERFLOW,
|
||||||
|
JERR_XMS_READ,
|
||||||
|
JERR_XMS_WRITE,
|
||||||
|
JMSG_COPYRIGHT,
|
||||||
|
JMSG_VERSION,
|
||||||
|
JTRC_16BIT_TABLES,
|
||||||
|
JTRC_ADOBE,
|
||||||
|
JTRC_APP0,
|
||||||
|
JTRC_APP14,
|
||||||
|
JTRC_DAC,
|
||||||
|
JTRC_DHT,
|
||||||
|
JTRC_DQT,
|
||||||
|
JTRC_DRI,
|
||||||
|
JTRC_EMS_CLOSE,
|
||||||
|
JTRC_EMS_OPEN,
|
||||||
|
JTRC_EOI,
|
||||||
|
JTRC_HUFFBITS,
|
||||||
|
JTRC_JFIF,
|
||||||
|
JTRC_JFIF_BADTHUMBNAILSIZE,
|
||||||
|
JTRC_JFIF_EXTENSION,
|
||||||
|
JTRC_JFIF_THUMBNAIL,
|
||||||
|
JTRC_MISC_MARKER,
|
||||||
|
JTRC_PARMLESS_MARKER,
|
||||||
|
JTRC_QUANTVALS,
|
||||||
|
JTRC_QUANT_3_NCOLORS,
|
||||||
|
JTRC_QUANT_NCOLORS,
|
||||||
|
JTRC_QUANT_SELECTED,
|
||||||
|
JTRC_RECOVERY_ACTION,
|
||||||
|
JTRC_RST,
|
||||||
|
JTRC_SMOOTH_NOTIMPL,
|
||||||
|
JTRC_SOF,
|
||||||
|
JTRC_SOF_COMPONENT,
|
||||||
|
JTRC_SOI,
|
||||||
|
JTRC_SOS,
|
||||||
|
JTRC_SOS_COMPONENT,
|
||||||
|
JTRC_SOS_PARAMS,
|
||||||
|
JTRC_TFILE_CLOSE,
|
||||||
|
JTRC_TFILE_OPEN,
|
||||||
|
JTRC_THUMB_JPEG,
|
||||||
|
JTRC_THUMB_PALETTE,
|
||||||
|
JTRC_THUMB_RGB,
|
||||||
|
JTRC_UNKNOWN_IDS,
|
||||||
|
JTRC_XMS_CLOSE,
|
||||||
|
JTRC_XMS_OPEN,
|
||||||
|
JWRN_ADOBE_XFORM,
|
||||||
|
JWRN_BOGUS_PROGRESSION,
|
||||||
|
JWRN_EXTRANEOUS_DATA,
|
||||||
|
JWRN_HIT_MARKER,
|
||||||
|
JWRN_HUFF_BAD_CODE,
|
||||||
|
JWRN_JFIF_MAJOR,
|
||||||
|
JWRN_JPEG_EOF,
|
||||||
|
JWRN_MUST_RESYNC,
|
||||||
|
JWRN_NOT_SEQUENTIAL,
|
||||||
|
JWRN_TOO_MUCH_DATA,
|
||||||
|
|
||||||
|
|
||||||
|
JMSG_FIRSTADDONCODE, { Must be first entry! }
|
||||||
|
|
||||||
|
{$ifdef BMP_SUPPORTED}
|
||||||
|
JERR_BMP_BADCMAP, { Unsupported BMP colormap format }
|
||||||
|
JERR_BMP_BADDEPTH, { Only 8- and 24-bit BMP files are supported }
|
||||||
|
JERR_BMP_BADHEADER, { Invalid BMP file: bad header length }
|
||||||
|
JERR_BMP_BADPLANES, { Invalid BMP file: biPlanes not equal to 1 }
|
||||||
|
JERR_BMP_COLORSPACE, { BMP output must be grayscale or RGB }
|
||||||
|
JERR_BMP_COMPRESSED, { Sorry, compressed BMPs not yet supported }
|
||||||
|
JERR_BMP_NOT, { Not a BMP file - does not start with BM }
|
||||||
|
JTRC_BMP, { %dx%d 24-bit BMP image }
|
||||||
|
JTRC_BMP_MAPPED, { %dx%d 8-bit colormapped BMP image }
|
||||||
|
JTRC_BMP_OS2, { %dx%d 24-bit OS2 BMP image }
|
||||||
|
JTRC_BMP_OS2_MAPPED, { %dx%d 8-bit colormapped OS2 BMP image }
|
||||||
|
{$endif} { BMP_SUPPORTED }
|
||||||
|
|
||||||
|
{$ifdef GIF_SUPPORTED}
|
||||||
|
JERR_GIF_BUG, { GIF output got confused }
|
||||||
|
JERR_GIF_CODESIZE, { Bogus GIF codesize %d }
|
||||||
|
JERR_GIF_COLORSPACE, { GIF output must be grayscale or RGB }
|
||||||
|
JERR_GIF_IMAGENOTFOUND, { Too few images in GIF file }
|
||||||
|
JERR_GIF_NOT, { Not a GIF file }
|
||||||
|
JTRC_GIF, { %dx%dx%d GIF image }
|
||||||
|
JTRC_GIF_BADVERSION,
|
||||||
|
{ Warning: unexpected GIF version number '%c%c%c' }
|
||||||
|
JTRC_GIF_EXTENSION, { Ignoring GIF extension block of type 0x%02x }
|
||||||
|
JTRC_GIF_NONSQUARE, { Caution: nonsquare pixels in input }
|
||||||
|
JWRN_GIF_BADDATA, { Corrupt data in GIF file }
|
||||||
|
JWRN_GIF_CHAR, { Bogus char 0x%02x in GIF file, ignoring }
|
||||||
|
JWRN_GIF_ENDCODE, { Premature end of GIF image }
|
||||||
|
JWRN_GIF_NOMOREDATA, { Ran out of GIF bits }
|
||||||
|
{$endif} { GIF_SUPPORTED }
|
||||||
|
|
||||||
|
{$ifdef PPM_SUPPORTED}
|
||||||
|
JERR_PPM_COLORSPACE, { PPM output must be grayscale or RGB }
|
||||||
|
JERR_PPM_NONNUMERIC, { Nonnumeric data in PPM file }
|
||||||
|
JERR_PPM_NOT, { Not a PPM file }
|
||||||
|
JTRC_PGM, { %dx%d PGM image }
|
||||||
|
JTRC_PGM_TEXT, { %dx%d text PGM image }
|
||||||
|
JTRC_PPM, { %dx%d PPM image }
|
||||||
|
JTRC_PPM_TEXT, { %dx%d text PPM image }
|
||||||
|
{$endif} { PPM_SUPPORTED }
|
||||||
|
|
||||||
|
{$ifdef RLE_SUPPORTED}
|
||||||
|
JERR_RLE_BADERROR, { Bogus error code from RLE library }
|
||||||
|
JERR_RLE_COLORSPACE, { RLE output must be grayscale or RGB }
|
||||||
|
JERR_RLE_DIMENSIONS, { Image dimensions (%dx%d) too large for RLE }
|
||||||
|
JERR_RLE_EMPTY, { Empty RLE file }
|
||||||
|
JERR_RLE_EOF, { Premature EOF in RLE header }
|
||||||
|
JERR_RLE_MEM, { Insufficient memory for RLE header }
|
||||||
|
JERR_RLE_NOT, { Not an RLE file }
|
||||||
|
JERR_RLE_TOOMANYCHANNELS, { Cannot handle %d output channels for RLE }
|
||||||
|
JERR_RLE_UNSUPPORTED, { Cannot handle this RLE setup }
|
||||||
|
JTRC_RLE, { %dx%d full-color RLE file }
|
||||||
|
JTRC_RLE_FULLMAP, { %dx%d full-color RLE file with map of length %d }
|
||||||
|
JTRC_RLE_GRAY, { %dx%d grayscale RLE file }
|
||||||
|
JTRC_RLE_MAPGRAY, { %dx%d grayscale RLE file with map of length %d }
|
||||||
|
JTRC_RLE_MAPPED, { %dx%d colormapped RLE file with map of length %d }
|
||||||
|
{$endif} { RLE_SUPPORTED }
|
||||||
|
|
||||||
|
{$ifdef TARGA_SUPPORTED}
|
||||||
|
JERR_TGA_BADCMAP, { Unsupported Targa colormap format }
|
||||||
|
JERR_TGA_BADPARMS, { Invalid or unsupported Targa file }
|
||||||
|
JERR_TGA_COLORSPACE, { Targa output must be grayscale or RGB }
|
||||||
|
JTRC_TGA, { %dx%d RGB Targa image }
|
||||||
|
JTRC_TGA_GRAY, { %dx%d grayscale Targa image }
|
||||||
|
JTRC_TGA_MAPPED, { %dx%d colormapped Targa image }
|
||||||
|
{$else}
|
||||||
|
JERR_TGA_NOTCOMP, { Targa support was not compiled }
|
||||||
|
{$endif} { TARGA_SUPPORTED }
|
||||||
|
|
||||||
|
JERR_BAD_CMAP_FILE,
|
||||||
|
{ Color map file is invalid or of unsupported format }
|
||||||
|
JERR_TOO_MANY_COLORS,
|
||||||
|
{ Output file format cannot handle %d colormap entries }
|
||||||
|
JERR_UNGETC_FAILED, { ungetc failed }
|
||||||
|
{$ifdef TARGA_SUPPORTED}
|
||||||
|
JERR_UNKNOWN_FORMAT,
|
||||||
|
{ Unrecognized input file format --- perhaps you need -targa }
|
||||||
|
{$else}
|
||||||
|
JERR_UNKNOWN_FORMAT, { Unrecognized input file format }
|
||||||
|
{$endif}
|
||||||
|
JERR_UNSUPPORTED_FORMAT, { Unsupported output file format }
|
||||||
|
|
||||||
|
JMSG_LASTADDONCODE
|
||||||
|
);
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
JMSG_LASTMSGCODE : J_MESSAGE_CODE = JMSG_LASTADDONCODE;
|
||||||
|
|
||||||
|
type
|
||||||
|
msg_table = Array[J_MESSAGE_CODE] of string[80];
|
||||||
|
const
|
||||||
|
jpeg_std_message_table : msg_table = (
|
||||||
|
|
||||||
|
{ JMSG_NOMESSAGE } 'Bogus message code %d', { Must be first entry! }
|
||||||
|
|
||||||
|
{ For maintenance convenience, list is alphabetical by message code name }
|
||||||
|
{ JERR_ARITH_NOTIMPL }
|
||||||
|
'Sorry, there are legal restrictions on arithmetic coding',
|
||||||
|
{ JERR_BAD_ALIGN_TYPE } 'ALIGN_TYPE is wrong, please fix',
|
||||||
|
{ JERR_BAD_ALLOC_CHUNK } 'MAX_ALLOC_CHUNK is wrong, please fix',
|
||||||
|
{ JERR_BAD_BUFFER_MODE } 'Bogus buffer control mode',
|
||||||
|
{ JERR_BAD_COMPONENT_ID } 'Invalid component ID %d in SOS',
|
||||||
|
{ JERR_BAD_DCT_COEF } 'DCT coefficient out of range',
|
||||||
|
{ JERR_BAD_DCTSIZE } 'IDCT output block size %d not supported',
|
||||||
|
{ JERR_BAD_HUFF_TABLE } 'Bogus Huffman table definition',
|
||||||
|
{ JERR_BAD_IN_COLORSPACE } 'Bogus input colorspace',
|
||||||
|
{ JERR_BAD_J_COLORSPACE } 'Bogus JPEG colorspace',
|
||||||
|
{ JERR_BAD_LENGTH } 'Bogus marker length',
|
||||||
|
{ JERR_BAD_LIB_VERSION }
|
||||||
|
'Wrong JPEG library version: library is %d, caller expects %d',
|
||||||
|
{ JERR_BAD_MCU_SIZE } 'Sampling factors too large for interleaved scan',
|
||||||
|
{ JERR_BAD_POOL_ID } 'Invalid memory pool code %d',
|
||||||
|
{ JERR_BAD_PRECISION } 'Unsupported JPEG data precision %d',
|
||||||
|
{ JERR_BAD_PROGRESSION }
|
||||||
|
'Invalid progressive parameters Ss=%d Se=%d Ah=%d Al=%d',
|
||||||
|
{ JERR_BAD_PROG_SCRIPT }
|
||||||
|
'Invalid progressive parameters at scan script entry %d',
|
||||||
|
{ JERR_BAD_SAMPLING } 'Bogus sampling factors',
|
||||||
|
{ JERR_BAD_SCAN_SCRIPT } 'Invalid scan script at entry %d',
|
||||||
|
{ JERR_BAD_STATE } 'Improper call to JPEG library in state %d',
|
||||||
|
{ JERR_BAD_STRUCT_SIZE }
|
||||||
|
'JPEG parameter struct mismatch: library thinks size is %d, caller expects %d',
|
||||||
|
{ JERR_BAD_VIRTUAL_ACCESS } 'Bogus virtual array access',
|
||||||
|
{ JERR_BUFFER_SIZE } 'Buffer passed to JPEG library is too small',
|
||||||
|
{ JERR_CANT_SUSPEND } 'Suspension not allowed here',
|
||||||
|
{ JERR_CCIR601_NOTIMPL } 'CCIR601 sampling not implemented yet',
|
||||||
|
{ JERR_COMPONENT_COUNT } 'Too many color components: %d, max %d',
|
||||||
|
{ JERR_CONVERSION_NOTIMPL } 'Unsupported color conversion request',
|
||||||
|
{ JERR_DAC_INDEX } 'Bogus DAC index %d',
|
||||||
|
{ JERR_DAC_VALUE } 'Bogus DAC value $%x',
|
||||||
|
{ JERR_DHT_COUNTS } 'Bogus DHT counts',
|
||||||
|
{ JERR_DHT_INDEX } 'Bogus DHT index %d',
|
||||||
|
{ JERR_DQT_INDEX } 'Bogus DQT index %d',
|
||||||
|
{ JERR_EMPTY_IMAGE } 'Empty JPEG image (DNL not supported)',
|
||||||
|
{ JERR_EMS_READ } 'Read from EMS failed',
|
||||||
|
{ JERR_EMS_WRITE } 'Write to EMS failed',
|
||||||
|
{ JERR_EOI_EXPECTED } 'Didn''t expect more than one scan',
|
||||||
|
{ JERR_FILE_READ } 'Input file read error',
|
||||||
|
{ JERR_FILE_WRITE } 'Output file write error --- out of disk space?',
|
||||||
|
{ JERR_FRACT_SAMPLE_NOTIMPL } 'Fractional sampling not implemented yet',
|
||||||
|
{ JERR_HUFF_CLEN_OVERFLOW } 'Huffman code size table overflow',
|
||||||
|
{ JERR_HUFF_MISSING_CODE } 'Missing Huffman code table entry',
|
||||||
|
{ JERR_IMAGE_TOO_BIG } 'Maximum supported image dimension is %d pixels',
|
||||||
|
{ JERR_INPUT_EMPTY } 'Empty input file',
|
||||||
|
{ JERR_INPUT_EOF } 'Premature end of input file',
|
||||||
|
{ JERR_MISMATCHED_QUANT_TABLE }
|
||||||
|
'Cannot transcode due to multiple use of quantization table %d',
|
||||||
|
{ JERR_MISSING_DATA } 'Scan script does not transmit all data',
|
||||||
|
{ JERR_MODE_CHANGE } 'Invalid color quantization mode change',
|
||||||
|
{ JERR_NOTIMPL } 'Not implemented yet',
|
||||||
|
{ JERR_NOT_COMPILED } 'Requested feature was omitted at compile time',
|
||||||
|
{ JERR_NO_BACKING_STORE } 'Backing store not supported',
|
||||||
|
{ JERR_NO_HUFF_TABLE } 'Huffman table $%02x was not defined',
|
||||||
|
{ JERR_NO_IMAGE } 'JPEG datastream contains no image',
|
||||||
|
{ JERR_NO_QUANT_TABLE } 'Quantization table $%02x was not defined',
|
||||||
|
{ JERR_NO_SOI } 'Not a JPEG file: starts with $%02x $%02x',
|
||||||
|
{ JERR_OUT_OF_MEMORY } 'Insufficient memory (case %d)',
|
||||||
|
{ JERR_QUANT_COMPONENTS }
|
||||||
|
'Cannot quantize more than %d color components',
|
||||||
|
{ JERR_QUANT_FEW_COLORS } 'Cannot quantize to fewer than %d colors',
|
||||||
|
{ JERR_QUANT_MANY_COLORS } 'Cannot quantize to more than %d colors',
|
||||||
|
{ JERR_SOF_DUPLICATE } 'Invalid JPEG file structure: two SOF markers',
|
||||||
|
{ JERR_SOF_NO_SOS } 'Invalid JPEG file structure: missing SOS marker',
|
||||||
|
{ JERR_SOF_UNSUPPORTED } 'Unsupported JPEG process: SOF type $%02x',
|
||||||
|
{ JERR_SOI_DUPLICATE } 'Invalid JPEG file structure: two SOI markers',
|
||||||
|
{ JERR_SOS_NO_SOF } 'Invalid JPEG file structure: SOS before SOF',
|
||||||
|
{ JERR_TFILE_CREATE } 'Failed to create temporary file %s',
|
||||||
|
{ JERR_TFILE_READ } 'Read failed on temporary file',
|
||||||
|
{ JERR_TFILE_SEEK } 'Seek failed on temporary file',
|
||||||
|
{ JERR_TFILE_WRITE }
|
||||||
|
'Write failed on temporary file --- out of disk space?',
|
||||||
|
{ JERR_TOO_LITTLE_DATA } 'Application transferred too few scanlines',
|
||||||
|
{ JERR_UNKNOWN_MARKER } 'Unsupported marker type $%02x',
|
||||||
|
{ JERR_VIRTUAL_BUG } 'Virtual array controller messed up',
|
||||||
|
{ JERR_WIDTH_OVERFLOW } 'Image too wide for this implementation',
|
||||||
|
{ JERR_XMS_READ } 'Read from XMS failed',
|
||||||
|
{ JERR_XMS_WRITE } 'Write to XMS failed',
|
||||||
|
{ JMSG_COPYRIGHT } JCOPYRIGHT,
|
||||||
|
{ JMSG_VERSION } JVERSION,
|
||||||
|
{ JTRC_16BIT_TABLES }
|
||||||
|
'Caution: quantization tables are too coarse for baseline JPEG',
|
||||||
|
{ JTRC_ADOBE }
|
||||||
|
'Adobe APP14 marker: version %d, flags $%04x $%04x, transform %d',
|
||||||
|
{ JTRC_APP0 } 'Unknown APP0 marker (not JFIF), length %d',
|
||||||
|
{ JTRC_APP14 } 'Unknown APP14 marker (not Adobe), length %d',
|
||||||
|
{ JTRC_DAC } 'Define Arithmetic Table $%02x: $%02x',
|
||||||
|
{ JTRC_DHT } 'Define Huffman Table $%02x',
|
||||||
|
{ JTRC_DQT } 'Define Quantization Table %d precision %d',
|
||||||
|
{ JTRC_DRI } 'Define Restart Interval %d',
|
||||||
|
{ JTRC_EMS_CLOSE } 'Freed EMS handle %d',
|
||||||
|
{ JTRC_EMS_OPEN } 'Obtained EMS handle %d',
|
||||||
|
{ JTRC_EOI } 'End Of Image',
|
||||||
|
{ JTRC_HUFFBITS } ' %3d %3d %3d %3d %3d %3d %3d %3d',
|
||||||
|
{ JTRC_JFIF } 'JFIF APP0 marker, density %dx%d %d',
|
||||||
|
{ JTRC_JFIF_BADTHUMBNAILSIZE }
|
||||||
|
'Warning: thumbnail image size does not match data length %d',
|
||||||
|
{ JTRC_JFIF_EXTENSION } 'JFIF extension marker: type 0x%02x, length %u',
|
||||||
|
{ JTRC_JFIF_THUMBNAIL } ' with %d x %d thumbnail image',
|
||||||
|
{ JTRC_MISC_MARKER } 'Skipping marker $%02x, length %d',
|
||||||
|
{ JTRC_PARMLESS_MARKER } 'Unexpected marker $%02x',
|
||||||
|
{ JTRC_QUANTVALS } ' %4d %4d %4d %4d %4d %4d %4d %4d',
|
||||||
|
{ JTRC_QUANT_3_NCOLORS } 'Quantizing to %d = %d*%d*%d colors',
|
||||||
|
{ JTRC_QUANT_NCOLORS } 'Quantizing to %d colors',
|
||||||
|
{ JTRC_QUANT_SELECTED } 'Selected %d colors for quantization',
|
||||||
|
{ JTRC_RECOVERY_ACTION } 'At marker $%02x, recovery action %d',
|
||||||
|
{ JTRC_RST } 'RST%d',
|
||||||
|
{ JTRC_SMOOTH_NOTIMPL }
|
||||||
|
'Smoothing not supported with nonstandard sampling ratios',
|
||||||
|
{ JTRC_SOF } 'Start Of Frame $%02x: width=%d, height=%d, components=%d',
|
||||||
|
{ JTRC_SOF_COMPONENT } ' Component %d: %dhx%dv q=%d',
|
||||||
|
{ JTRC_SOI } 'Start of Image',
|
||||||
|
{ JTRC_SOS } 'Start Of Scan: %d components',
|
||||||
|
{ JTRC_SOS_COMPONENT } ' Component %d: dc=%d ac=%d',
|
||||||
|
{ JTRC_SOS_PARAMS } ' Ss=%d, Se=%d, Ah=%d, Al=%d',
|
||||||
|
{ JTRC_TFILE_CLOSE } 'Closed temporary file %s',
|
||||||
|
{ JTRC_TFILE_OPEN } 'Opened temporary file %s',
|
||||||
|
{ JTRC_THUMB_JPEG }
|
||||||
|
'JFIF extension marker: JPEG-compressed thumbnail image, length %u',
|
||||||
|
{ JMESSAGE(JTRC_THUMB_PALETTE }
|
||||||
|
'JFIF extension marker: palette thumbnail image, length %u',
|
||||||
|
{ JMESSAGE(JTRC_THUMB_RGB }
|
||||||
|
'JFIF extension marker: RGB thumbnail image, length %u',
|
||||||
|
{ JTRC_UNKNOWN_IDS }
|
||||||
|
'Unrecognized component IDs %d %d %d, assuming YCbCr',
|
||||||
|
{ JTRC_XMS_CLOSE } 'Freed XMS handle %d',
|
||||||
|
{ JTRC_XMS_OPEN } 'Obtained XMS handle %d',
|
||||||
|
{ JWRN_ADOBE_XFORM } 'Unknown Adobe color transform code %d',
|
||||||
|
{ JWRN_BOGUS_PROGRESSION }
|
||||||
|
'Inconsistent progression sequence for component %d coefficient %d',
|
||||||
|
{ JWRN_EXTRANEOUS_DATA }
|
||||||
|
'Corrupt JPEG data: %d extraneous bytes before marker $%02x',
|
||||||
|
{ JWRN_HIT_MARKER } 'Corrupt JPEG data: premature end of data segment',
|
||||||
|
{ JWRN_HUFF_BAD_CODE } 'Corrupt JPEG data: bad Huffman code',
|
||||||
|
{ JWRN_JFIF_MAJOR } 'Warning: unknown JFIF revision number %d.%02d',
|
||||||
|
{ JWRN_JPEG_EOF } 'Premature end of JPEG file',
|
||||||
|
{ JWRN_MUST_RESYNC }
|
||||||
|
'Corrupt JPEG data: found marker $%02x instead of RST%d',
|
||||||
|
{ JWRN_NOT_SEQUENTIAL } 'Invalid SOS parameters for sequential JPEG',
|
||||||
|
{ JWRN_TOO_MUCH_DATA } 'Application transferred too many scanlines',
|
||||||
|
|
||||||
|
{ JMSG_FIRSTADDONCODE } '', { Must be first entry! }
|
||||||
|
|
||||||
|
{$ifdef BMP_SUPPORTED}
|
||||||
|
{ JERR_BMP_BADCMAP } 'Unsupported BMP colormap format',
|
||||||
|
{ JERR_BMP_BADDEPTH } 'Only 8- and 24-bit BMP files are supported',
|
||||||
|
{ JERR_BMP_BADHEADER } 'Invalid BMP file: bad header length',
|
||||||
|
{ JERR_BMP_BADPLANES } 'Invalid BMP file: biPlanes not equal to 1',
|
||||||
|
{ JERR_BMP_COLORSPACE } 'BMP output must be grayscale or RGB',
|
||||||
|
{ JERR_BMP_COMPRESSED } 'Sorry, compressed BMPs not yet supported',
|
||||||
|
{ JERR_BMP_NOT } 'Not a BMP file - does not start with BM',
|
||||||
|
{ JTRC_BMP } '%dx%d 24-bit BMP image',
|
||||||
|
{ JTRC_BMP_MAPPED } '%dx%d 8-bit colormapped BMP image',
|
||||||
|
{ JTRC_BMP_OS2 } '%dx%d 24-bit OS2 BMP image',
|
||||||
|
{ JTRC_BMP_OS2_MAPPED } '%dx%d 8-bit colormapped OS2 BMP image',
|
||||||
|
{$endif} { BMP_SUPPORTED }
|
||||||
|
|
||||||
|
{$ifdef GIF_SUPPORTED}
|
||||||
|
{ JERR_GIF_BUG } 'GIF output got confused',
|
||||||
|
{ JERR_GIF_CODESIZE } 'Bogus GIF codesize %d',
|
||||||
|
{ JERR_GIF_COLORSPACE } 'GIF output must be grayscale or RGB',
|
||||||
|
{ JERR_GIF_IMAGENOTFOUND } 'Too few images in GIF file',
|
||||||
|
{ JERR_GIF_NOT } 'Not a GIF file',
|
||||||
|
{ JTRC_GIF } '%dx%dx%d GIF image',
|
||||||
|
{ JTRC_GIF_BADVERSION }
|
||||||
|
'Warning: unexpected GIF version number "%c%c%c"',
|
||||||
|
{ JTRC_GIF_EXTENSION } 'Ignoring GIF extension block of type 0x%02x',
|
||||||
|
{ JTRC_GIF_NONSQUARE } 'Caution: nonsquare pixels in input',
|
||||||
|
{ JWRN_GIF_BADDATA } 'Corrupt data in GIF file',
|
||||||
|
{ JWRN_GIF_CHAR } 'Bogus char 0x%02x in GIF file, ignoring',
|
||||||
|
{ JWRN_GIF_ENDCODE } 'Premature end of GIF image',
|
||||||
|
{ JWRN_GIF_NOMOREDATA } 'Ran out of GIF bits',
|
||||||
|
{$endif} { GIF_SUPPORTED }
|
||||||
|
|
||||||
|
{$ifdef PPM_SUPPORTED}
|
||||||
|
{ JERR_PPM_COLORSPACE } 'PPM output must be grayscale or RGB',
|
||||||
|
{ JERR_PPM_NONNUMERIC } 'Nonnumeric data in PPM file',
|
||||||
|
{ JERR_PPM_NOT } 'Not a PPM file',
|
||||||
|
{ JTRC_PGM } '%dx%d PGM image',
|
||||||
|
{ JTRC_PGM_TEXT } '%dx%d text PGM image',
|
||||||
|
{ JTRC_PPM } '%dx%d PPM image',
|
||||||
|
{ JTRC_PPM_TEXT } '%dx%d text PPM image',
|
||||||
|
{$endif} { PPM_SUPPORTED }
|
||||||
|
|
||||||
|
{$ifdef RLE_SUPPORTED}
|
||||||
|
{ JERR_RLE_BADERROR } 'Bogus error code from RLE library',
|
||||||
|
{ JERR_RLE_COLORSPACE } 'RLE output must be grayscale or RGB',
|
||||||
|
{ JERR_RLE_DIMENSIONS } 'Image dimensions (%dx%d) too large for RLE',
|
||||||
|
{ JERR_RLE_EMPTY } 'Empty RLE file',
|
||||||
|
{ JERR_RLE_EOF } 'Premature EOF in RLE header',
|
||||||
|
{ JERR_RLE_MEM } 'Insufficient memory for RLE header',
|
||||||
|
{ JERR_RLE_NOT } 'Not an RLE file',
|
||||||
|
{ JERR_RLE_TOOMANYCHANNELS } 'Cannot handle %d output channels for RLE',
|
||||||
|
{ JERR_RLE_UNSUPPORTED } 'Cannot handle this RLE setup',
|
||||||
|
{ JTRC_RLE } '%dx%d full-color RLE file',
|
||||||
|
{ JTRC_RLE_FULLMAP } '%dx%d full-color RLE file with map of length %d',
|
||||||
|
{ JTRC_RLE_GRAY } '%dx%d grayscale RLE file',
|
||||||
|
{ JTRC_RLE_MAPGRAY } '%dx%d grayscale RLE file with map of length %d',
|
||||||
|
{ JTRC_RLE_MAPPED } '%dx%d colormapped RLE file with map of length %d',
|
||||||
|
{$endif} { RLE_SUPPORTED }
|
||||||
|
|
||||||
|
{$ifdef TARGA_SUPPORTED}
|
||||||
|
{ JERR_TGA_BADCMAP } 'Unsupported Targa colormap format',
|
||||||
|
{ JERR_TGA_BADPARMS } 'Invalid or unsupported Targa file',
|
||||||
|
{ JERR_TGA_COLORSPACE } 'Targa output must be grayscale or RGB',
|
||||||
|
{ JTRC_TGA } '%dx%d RGB Targa image',
|
||||||
|
{ JTRC_TGA_GRAY } '%dx%d grayscale Targa image',
|
||||||
|
{ JTRC_TGA_MAPPED } '%dx%d colormapped Targa image',
|
||||||
|
{$else}
|
||||||
|
{ JERR_TGA_NOTCOMP } 'Targa support was not compiled',
|
||||||
|
{$endif} { TARGA_SUPPORTED }
|
||||||
|
|
||||||
|
{ JERR_BAD_CMAP_FILE }
|
||||||
|
'Color map file is invalid or of unsupported format',
|
||||||
|
{ JERR_TOO_MANY_COLORS }
|
||||||
|
'Output file format cannot handle %d colormap entries',
|
||||||
|
{ JERR_UNGETC_FAILED } 'ungetc failed',
|
||||||
|
{$ifdef TARGA_SUPPORTED}
|
||||||
|
{ JERR_UNKNOWN_FORMAT }
|
||||||
|
'Unrecognized input file format --- perhaps you need -targa',
|
||||||
|
{$else}
|
||||||
|
{ JERR_UNKNOWN_FORMAT } 'Unrecognized input file format',
|
||||||
|
{$endif}
|
||||||
|
{ JERR_UNSUPPORTED_FORMAT } 'Unsupported output file format',
|
||||||
|
|
||||||
|
|
||||||
|
{ JMSG_LASTADDONCODE } '');
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,416 @@
|
||||||
|
unit imjdinput;
|
||||||
|
|
||||||
|
{ Original: jdinput.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
|
||||||
|
|
||||||
|
{ This file is part of the Independent JPEG Group's software.
|
||||||
|
For conditions of distribution and use, see the accompanying README file.
|
||||||
|
|
||||||
|
This file contains input control logic for the JPEG decompressor.
|
||||||
|
These routines are concerned with controlling the decompressor's input
|
||||||
|
processing (marker reading and coefficient decoding). The actual input
|
||||||
|
reading is done in jdmarker.c, jdhuff.c, and jdphuff.c. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjpeglib,
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjinclude, imjutils;
|
||||||
|
|
||||||
|
{ Initialize the input controller module.
|
||||||
|
This is called only once, when the decompression object is created. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_input_controller (cinfo : j_decompress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Private state }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_inputctl_ptr = ^my_input_controller;
|
||||||
|
my_input_controller = record
|
||||||
|
pub : jpeg_input_controller; { public fields }
|
||||||
|
|
||||||
|
inheaders : boolean; { TRUE until first SOS is reached }
|
||||||
|
end; {my_input_controller;}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ Forward declarations }
|
||||||
|
{METHODDEF}
|
||||||
|
function consume_markers (cinfo : j_decompress_ptr) : int; forward;
|
||||||
|
|
||||||
|
|
||||||
|
{ Routines to calculate various quantities related to the size of the image. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure initial_setup (cinfo : j_decompress_ptr);
|
||||||
|
{ Called once, when first SOS marker is reached }
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
{ Make sure image isn't bigger than I can handle }
|
||||||
|
if (long(cinfo^.image_height) > long (JPEG_MAX_DIMENSION)) or
|
||||||
|
(long(cinfo^.image_width) > long(JPEG_MAX_DIMENSION)) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(JPEG_MAX_DIMENSION));
|
||||||
|
|
||||||
|
{ For now, precision must match compiled-in value... }
|
||||||
|
if (cinfo^.data_precision <> BITS_IN_JSAMPLE) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PRECISION, cinfo^.data_precision);
|
||||||
|
|
||||||
|
{ Check that number of components won't exceed internal array sizes }
|
||||||
|
if (cinfo^.num_components > MAX_COMPONENTS) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components,
|
||||||
|
MAX_COMPONENTS);
|
||||||
|
|
||||||
|
{ Compute maximum sampling factors; check factor validity }
|
||||||
|
cinfo^.max_h_samp_factor := 1;
|
||||||
|
cinfo^.max_v_samp_factor := 1;
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
if (compptr^.h_samp_factor<=0) or (compptr^.h_samp_factor>MAX_SAMP_FACTOR) or
|
||||||
|
(compptr^.v_samp_factor<=0) or (compptr^.v_samp_factor>MAX_SAMP_FACTOR) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_SAMPLING);
|
||||||
|
{cinfo^.max_h_samp_factor := MAX(cinfo^.max_h_samp_factor,
|
||||||
|
compptr^.h_samp_factor);
|
||||||
|
cinfo^.max_v_samp_factor := MAX(cinfo^.max_v_samp_factor,
|
||||||
|
compptr^.v_samp_factor);}
|
||||||
|
if cinfo^.max_h_samp_factor < compptr^.h_samp_factor then
|
||||||
|
cinfo^.max_h_samp_factor := compptr^.h_samp_factor;
|
||||||
|
if cinfo^.max_v_samp_factor < compptr^.v_samp_factor then
|
||||||
|
cinfo^.max_v_samp_factor := compptr^.v_samp_factor;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ We initialize DCT_scaled_size and min_DCT_scaled_size to DCTSIZE.
|
||||||
|
In the full decompressor, this will be overridden by jdmaster.c;
|
||||||
|
but in the transcoder, jdmaster.c is not used, so we must do it here. }
|
||||||
|
|
||||||
|
cinfo^.min_DCT_scaled_size := DCTSIZE;
|
||||||
|
|
||||||
|
{ Compute dimensions of components }
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
compptr^.DCT_scaled_size := DCTSIZE;
|
||||||
|
{ Size in DCT blocks }
|
||||||
|
compptr^.width_in_blocks := JDIMENSION(
|
||||||
|
jdiv_round_up( long(cinfo^.image_width) * long(compptr^.h_samp_factor),
|
||||||
|
long(cinfo^.max_h_samp_factor * DCTSIZE)) );
|
||||||
|
compptr^.height_in_blocks := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
|
||||||
|
long (cinfo^.max_v_samp_factor * DCTSIZE)) );
|
||||||
|
{ downsampled_width and downsampled_height will also be overridden by
|
||||||
|
jdmaster.c if we are doing full decompression. The transcoder library
|
||||||
|
doesn't use these values, but the calling application might. }
|
||||||
|
|
||||||
|
{ Size in samples }
|
||||||
|
compptr^.downsampled_width := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_width) * long(compptr^.h_samp_factor),
|
||||||
|
long (cinfo^.max_h_samp_factor)) );
|
||||||
|
compptr^.downsampled_height := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
|
||||||
|
long (cinfo^.max_v_samp_factor)) );
|
||||||
|
{ Mark component needed, until color conversion says otherwise }
|
||||||
|
compptr^.component_needed := TRUE;
|
||||||
|
{ Mark no quantization table yet saved for component }
|
||||||
|
compptr^.quant_table := NIL;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Compute number of fully interleaved MCU rows. }
|
||||||
|
cinfo^.total_iMCU_rows := JDIMENSION(
|
||||||
|
jdiv_round_up(long(cinfo^.image_height),
|
||||||
|
long(cinfo^.max_v_samp_factor*DCTSIZE)) );
|
||||||
|
|
||||||
|
{ Decide whether file contains multiple scans }
|
||||||
|
if (cinfo^.comps_in_scan < cinfo^.num_components) or
|
||||||
|
(cinfo^.progressive_mode) then
|
||||||
|
cinfo^.inputctl^.has_multiple_scans := TRUE
|
||||||
|
else
|
||||||
|
cinfo^.inputctl^.has_multiple_scans := FALSE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure per_scan_setup (cinfo : j_decompress_ptr);
|
||||||
|
{ Do computations that are needed before processing a JPEG scan }
|
||||||
|
{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] were set from SOS marker }
|
||||||
|
var
|
||||||
|
ci, mcublks, tmp : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
if (cinfo^.comps_in_scan = 1) then
|
||||||
|
begin
|
||||||
|
{ Noninterleaved (single-component) scan }
|
||||||
|
compptr := cinfo^.cur_comp_info[0];
|
||||||
|
|
||||||
|
{ Overall image size in MCUs }
|
||||||
|
cinfo^.MCUs_per_row := compptr^.width_in_blocks;
|
||||||
|
cinfo^.MCU_rows_in_scan := compptr^.height_in_blocks;
|
||||||
|
|
||||||
|
{ For noninterleaved scan, always one block per MCU }
|
||||||
|
compptr^.MCU_width := 1;
|
||||||
|
compptr^.MCU_height := 1;
|
||||||
|
compptr^.MCU_blocks := 1;
|
||||||
|
compptr^.MCU_sample_width := compptr^.DCT_scaled_size;
|
||||||
|
compptr^.last_col_width := 1;
|
||||||
|
{ For noninterleaved scans, it is convenient to define last_row_height
|
||||||
|
as the number of block rows present in the last iMCU row. }
|
||||||
|
|
||||||
|
tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor);
|
||||||
|
if (tmp = 0) then
|
||||||
|
tmp := compptr^.v_samp_factor;
|
||||||
|
compptr^.last_row_height := tmp;
|
||||||
|
|
||||||
|
{ Prepare array describing MCU composition }
|
||||||
|
cinfo^.blocks_in_MCU := 1;
|
||||||
|
cinfo^.MCU_membership[0] := 0;
|
||||||
|
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ Interleaved (multi-component) scan }
|
||||||
|
if (cinfo^.comps_in_scan <= 0) or (cinfo^.comps_in_scan > MAX_COMPS_IN_SCAN) then
|
||||||
|
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.comps_in_scan,
|
||||||
|
MAX_COMPS_IN_SCAN);
|
||||||
|
|
||||||
|
{ Overall image size in MCUs }
|
||||||
|
cinfo^.MCUs_per_row := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_width),
|
||||||
|
long (cinfo^.max_h_samp_factor*DCTSIZE)) );
|
||||||
|
cinfo^.MCU_rows_in_scan := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_height),
|
||||||
|
long (cinfo^.max_v_samp_factor*DCTSIZE)) );
|
||||||
|
|
||||||
|
cinfo^.blocks_in_MCU := 0;
|
||||||
|
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
{ Sampling factors give # of blocks of component in each MCU }
|
||||||
|
compptr^.MCU_width := compptr^.h_samp_factor;
|
||||||
|
compptr^.MCU_height := compptr^.v_samp_factor;
|
||||||
|
compptr^.MCU_blocks := compptr^.MCU_width * compptr^.MCU_height;
|
||||||
|
compptr^.MCU_sample_width := compptr^.MCU_width * compptr^.DCT_scaled_size;
|
||||||
|
{ Figure number of non-dummy blocks in last MCU column & row }
|
||||||
|
tmp := int (LongInt(compptr^.width_in_blocks) mod compptr^.MCU_width);
|
||||||
|
if (tmp = 0) then
|
||||||
|
tmp := compptr^.MCU_width;
|
||||||
|
compptr^.last_col_width := tmp;
|
||||||
|
tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.MCU_height);
|
||||||
|
if (tmp = 0) then
|
||||||
|
tmp := compptr^.MCU_height;
|
||||||
|
compptr^.last_row_height := tmp;
|
||||||
|
{ Prepare array describing MCU composition }
|
||||||
|
mcublks := compptr^.MCU_blocks;
|
||||||
|
if (LongInt(cinfo^.blocks_in_MCU) + mcublks > D_MAX_BLOCKS_IN_MCU) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_MCU_SIZE);
|
||||||
|
while (mcublks > 0) do
|
||||||
|
begin
|
||||||
|
Dec(mcublks);
|
||||||
|
cinfo^.MCU_membership[cinfo^.blocks_in_MCU] := ci;
|
||||||
|
Inc(cinfo^.blocks_in_MCU);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Save away a copy of the Q-table referenced by each component present
|
||||||
|
in the current scan, unless already saved during a prior scan.
|
||||||
|
|
||||||
|
In a multiple-scan JPEG file, the encoder could assign different components
|
||||||
|
the same Q-table slot number, but change table definitions between scans
|
||||||
|
so that each component uses a different Q-table. (The IJG encoder is not
|
||||||
|
currently capable of doing this, but other encoders might.) Since we want
|
||||||
|
to be able to dequantize all the components at the end of the file, this
|
||||||
|
means that we have to save away the table actually used for each component.
|
||||||
|
We do this by copying the table at the start of the first scan containing
|
||||||
|
the component.
|
||||||
|
The JPEG spec prohibits the encoder from changing the contents of a Q-table
|
||||||
|
slot between scans of a component using that slot. If the encoder does so
|
||||||
|
anyway, this decoder will simply use the Q-table values that were current
|
||||||
|
at the start of the first scan for the component.
|
||||||
|
|
||||||
|
The decompressor output side looks only at the saved quant tables,
|
||||||
|
not at the current Q-table slots. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure latch_quant_tables (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
ci, qtblno : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
qtbl : JQUANT_TBL_PTR;
|
||||||
|
begin
|
||||||
|
for ci := 0 to pred(cinfo^.comps_in_scan) do
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.cur_comp_info[ci];
|
||||||
|
{ No work if we already saved Q-table for this component }
|
||||||
|
if (compptr^.quant_table <> NIL) then
|
||||||
|
continue;
|
||||||
|
{ Make sure specified quantization table is present }
|
||||||
|
qtblno := compptr^.quant_tbl_no;
|
||||||
|
if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or
|
||||||
|
(cinfo^.quant_tbl_ptrs[qtblno] = NIL) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno);
|
||||||
|
{ OK, save away the quantization table }
|
||||||
|
qtbl := JQUANT_TBL_PTR(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(JQUANT_TBL)) );
|
||||||
|
MEMCOPY(qtbl, cinfo^.quant_tbl_ptrs[qtblno], SIZEOF(JQUANT_TBL));
|
||||||
|
compptr^.quant_table := qtbl;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize the input modules to read a scan of compressed data.
|
||||||
|
The first call to this is done by jdmaster.c after initializing
|
||||||
|
the entire decompressor (during jpeg_start_decompress).
|
||||||
|
Subsequent calls come from consume_markers, below. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_input_pass (cinfo : j_decompress_ptr);
|
||||||
|
begin
|
||||||
|
per_scan_setup(cinfo);
|
||||||
|
latch_quant_tables(cinfo);
|
||||||
|
cinfo^.entropy^.start_pass (cinfo);
|
||||||
|
cinfo^.coef^.start_input_pass (cinfo);
|
||||||
|
cinfo^.inputctl^.consume_input := cinfo^.coef^.consume_data;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish up after inputting a compressed-data scan.
|
||||||
|
This is called by the coefficient controller after it's read all
|
||||||
|
the expected data of the scan. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure finish_input_pass (cinfo : j_decompress_ptr);
|
||||||
|
begin
|
||||||
|
cinfo^.inputctl^.consume_input := consume_markers;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Read JPEG markers before, between, or after compressed-data scans.
|
||||||
|
Change state as necessary when a new scan is reached.
|
||||||
|
Return value is JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI.
|
||||||
|
|
||||||
|
The consume_input method pointer points either here or to the
|
||||||
|
coefficient controller's consume_data routine, depending on whether
|
||||||
|
we are reading a compressed data segment or inter-segment markers. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
function consume_markers (cinfo : j_decompress_ptr) : int;
|
||||||
|
var
|
||||||
|
val : int;
|
||||||
|
inputctl : my_inputctl_ptr;
|
||||||
|
begin
|
||||||
|
inputctl := my_inputctl_ptr (cinfo^.inputctl);
|
||||||
|
|
||||||
|
if (inputctl^.pub.eoi_reached) then { After hitting EOI, read no further }
|
||||||
|
begin
|
||||||
|
consume_markers := JPEG_REACHED_EOI;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
val := cinfo^.marker^.read_markers (cinfo);
|
||||||
|
|
||||||
|
case (val) of
|
||||||
|
JPEG_REACHED_SOS: { Found SOS }
|
||||||
|
begin
|
||||||
|
if (inputctl^.inheaders) then
|
||||||
|
begin { 1st SOS }
|
||||||
|
initial_setup(cinfo);
|
||||||
|
inputctl^.inheaders := FALSE;
|
||||||
|
{ Note: start_input_pass must be called by jdmaster.c
|
||||||
|
before any more input can be consumed. jdapimin.c is
|
||||||
|
responsible for enforcing this sequencing. }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin { 2nd or later SOS marker }
|
||||||
|
if (not inputctl^.pub.has_multiple_scans) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_EOI_EXPECTED); { Oops, I wasn't expecting this! }
|
||||||
|
start_input_pass(cinfo);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
JPEG_REACHED_EOI: { Found EOI }
|
||||||
|
begin
|
||||||
|
inputctl^.pub.eoi_reached := TRUE;
|
||||||
|
if (inputctl^.inheaders) then
|
||||||
|
begin { Tables-only datastream, apparently }
|
||||||
|
if (cinfo^.marker^.saw_SOF) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_SOF_NO_SOS);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Prevent infinite loop in coef ctlr's decompress_data routine
|
||||||
|
if user set output_scan_number larger than number of scans. }
|
||||||
|
|
||||||
|
if (cinfo^.output_scan_number > cinfo^.input_scan_number) then
|
||||||
|
cinfo^.output_scan_number := cinfo^.input_scan_number;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
JPEG_SUSPENDED:;
|
||||||
|
end;
|
||||||
|
|
||||||
|
consume_markers := val;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Reset state to begin a fresh datastream. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure reset_input_controller (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
inputctl : my_inputctl_ptr;
|
||||||
|
begin
|
||||||
|
inputctl := my_inputctl_ptr (cinfo^.inputctl);
|
||||||
|
|
||||||
|
inputctl^.pub.consume_input := consume_markers;
|
||||||
|
inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better }
|
||||||
|
inputctl^.pub.eoi_reached := FALSE;
|
||||||
|
inputctl^.inheaders := TRUE;
|
||||||
|
{ Reset other modules }
|
||||||
|
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
|
||||||
|
cinfo^.marker^.reset_marker_reader (cinfo);
|
||||||
|
{ Reset progression state -- would be cleaner if entropy decoder did this }
|
||||||
|
cinfo^.coef_bits := NIL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize the input controller module.
|
||||||
|
This is called only once, when the decompression object is created. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_input_controller (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
inputctl : my_inputctl_ptr;
|
||||||
|
begin
|
||||||
|
{ Create subobject in permanent pool }
|
||||||
|
inputctl := my_inputctl_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
|
||||||
|
SIZEOF(my_input_controller)) );
|
||||||
|
cinfo^.inputctl := jpeg_input_controller_ptr(inputctl);
|
||||||
|
{ Initialize method pointers }
|
||||||
|
inputctl^.pub.consume_input := consume_markers;
|
||||||
|
inputctl^.pub.reset_input_controller := reset_input_controller;
|
||||||
|
inputctl^.pub.start_input_pass := start_input_pass;
|
||||||
|
inputctl^.pub.finish_input_pass := finish_input_pass;
|
||||||
|
{ Initialize state: can't use reset_input_controller since we don't
|
||||||
|
want to try to reset other modules yet. }
|
||||||
|
|
||||||
|
inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better }
|
||||||
|
inputctl^.pub.eoi_reached := FALSE;
|
||||||
|
inputctl^.inheaders := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,610 @@
|
||||||
|
unit imjdmainct;
|
||||||
|
|
||||||
|
|
||||||
|
{ This file is part of the Independent JPEG Group's software.
|
||||||
|
For conditions of distribution and use, see the accompanying README file.
|
||||||
|
|
||||||
|
This file contains the main buffer controller for decompression.
|
||||||
|
The main buffer lies between the JPEG decompressor proper and the
|
||||||
|
post-processor; it holds downsampled data in the JPEG colorspace.
|
||||||
|
|
||||||
|
Note that this code is bypassed in raw-data mode, since the application
|
||||||
|
supplies the equivalent of the main buffer in that case. }
|
||||||
|
|
||||||
|
{ Original: jdmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
|
||||||
|
|
||||||
|
|
||||||
|
{ In the current system design, the main buffer need never be a full-image
|
||||||
|
buffer; any full-height buffers will be found inside the coefficient or
|
||||||
|
postprocessing controllers. Nonetheless, the main controller is not
|
||||||
|
trivial. Its responsibility is to provide context rows for upsampling/
|
||||||
|
rescaling, and doing this in an efficient fashion is a bit tricky.
|
||||||
|
|
||||||
|
Postprocessor input data is counted in "row groups". A row group
|
||||||
|
is defined to be (v_samp_factor * DCT_scaled_size / min_DCT_scaled_size)
|
||||||
|
sample rows of each component. (We require DCT_scaled_size values to be
|
||||||
|
chosen such that these numbers are integers. In practice DCT_scaled_size
|
||||||
|
values will likely be powers of two, so we actually have the stronger
|
||||||
|
condition that DCT_scaled_size / min_DCT_scaled_size is an integer.)
|
||||||
|
Upsampling will typically produce max_v_samp_factor pixel rows from each
|
||||||
|
row group (times any additional scale factor that the upsampler is
|
||||||
|
applying).
|
||||||
|
|
||||||
|
The coefficient controller will deliver data to us one iMCU row at a time;
|
||||||
|
each iMCU row contains v_samp_factor * DCT_scaled_size sample rows, or
|
||||||
|
exactly min_DCT_scaled_size row groups. (This amount of data corresponds
|
||||||
|
to one row of MCUs when the image is fully interleaved.) Note that the
|
||||||
|
number of sample rows varies across components, but the number of row
|
||||||
|
groups does not. Some garbage sample rows may be included in the last iMCU
|
||||||
|
row at the bottom of the image.
|
||||||
|
|
||||||
|
Depending on the vertical scaling algorithm used, the upsampler may need
|
||||||
|
access to the sample row(s) above and below its current input row group.
|
||||||
|
The upsampler is required to set need_context_rows TRUE at global
|
||||||
|
selection
|
||||||
|
time if so. When need_context_rows is FALSE, this controller can simply
|
||||||
|
obtain one iMCU row at a time from the coefficient controller and dole it
|
||||||
|
out as row groups to the postprocessor.
|
||||||
|
|
||||||
|
When need_context_rows is TRUE, this controller guarantees that the buffer
|
||||||
|
passed to postprocessing contains at least one row group's worth of samples
|
||||||
|
above and below the row group(s) being processed. Note that the context
|
||||||
|
rows "above" the first passed row group appear at negative row offsets in
|
||||||
|
the passed buffer. At the top and bottom of the image, the required
|
||||||
|
context rows are manufactured by duplicating the first or last real sample
|
||||||
|
row; this avoids having special cases in the upsampling inner loops.
|
||||||
|
|
||||||
|
The amount of context is fixed at one row group just because that's a
|
||||||
|
convenient number for this controller to work with. The existing
|
||||||
|
upsamplers really only need one sample row of context. An upsampler
|
||||||
|
supporting arbitrary output rescaling might wish for more than one row
|
||||||
|
group of context when shrinking the image; tough, we don't handle that.
|
||||||
|
(This is justified by the assumption that downsizing will be handled mostly
|
||||||
|
by adjusting the DCT_scaled_size values, so that the actual scale factor at
|
||||||
|
the upsample step needn't be much less than one.)
|
||||||
|
|
||||||
|
To provide the desired context, we have to retain the last two row groups
|
||||||
|
of one iMCU row while reading in the next iMCU row. (The last row group
|
||||||
|
can't be processed until we have another row group for its below-context,
|
||||||
|
and so we have to save the next-to-last group too for its above-context.)
|
||||||
|
We could do this most simply by copying data around in our buffer, but
|
||||||
|
that'd be very slow. We can avoid copying any data by creating a rather
|
||||||
|
strange pointer structure. Here's how it works. We allocate a workspace
|
||||||
|
consisting of M+2 row groups (where M = min_DCT_scaled_size is the number
|
||||||
|
of row groups per iMCU row). We create two sets of redundant pointers to
|
||||||
|
the workspace. Labeling the physical row groups 0 to M+1, the synthesized
|
||||||
|
pointer lists look like this:
|
||||||
|
M+1 M-1
|
||||||
|
master pointer --> 0 master pointer --> 0
|
||||||
|
1 1
|
||||||
|
... ...
|
||||||
|
M-3 M-3
|
||||||
|
M-2 M
|
||||||
|
M-1 M+1
|
||||||
|
M M-2
|
||||||
|
M+1 M-1
|
||||||
|
0 0
|
||||||
|
We read alternate iMCU rows using each master pointer; thus the last two
|
||||||
|
row groups of the previous iMCU row remain un-overwritten in the workspace.
|
||||||
|
The pointer lists are set up so that the required context rows appear to
|
||||||
|
be adjacent to the proper places when we pass the pointer lists to the
|
||||||
|
upsampler.
|
||||||
|
|
||||||
|
The above pictures describe the normal state of the pointer lists.
|
||||||
|
At top and bottom of the image, we diddle the pointer lists to duplicate
|
||||||
|
the first or last sample row as necessary (this is cheaper than copying
|
||||||
|
sample rows around).
|
||||||
|
|
||||||
|
This scheme breaks down if M < 2, ie, min_DCT_scaled_size is 1. In that
|
||||||
|
situation each iMCU row provides only one row group so the buffering logic
|
||||||
|
must be different (eg, we must read two iMCU rows before we can emit the
|
||||||
|
first row group). For now, we simply do not support providing context
|
||||||
|
rows when min_DCT_scaled_size is 1. That combination seems unlikely to
|
||||||
|
be worth providing --- if someone wants a 1/8th-size preview, they probably
|
||||||
|
want it quick and dirty, so a context-free upsampler is sufficient. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
imjquant2,
|
||||||
|
{$endif}
|
||||||
|
imjdeferr,
|
||||||
|
imjerror,
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_d_main_controller (cinfo : j_decompress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Private buffer controller object }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_main_ptr = ^my_main_controller;
|
||||||
|
my_main_controller = record
|
||||||
|
pub : jpeg_d_main_controller; { public fields }
|
||||||
|
|
||||||
|
{ Pointer to allocated workspace (M or M+2 row groups). }
|
||||||
|
buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
|
||||||
|
|
||||||
|
buffer_full : boolean; { Have we gotten an iMCU row from decoder? }
|
||||||
|
rowgroup_ctr : JDIMENSION ; { counts row groups output to postprocessor }
|
||||||
|
|
||||||
|
{ Remaining fields are only used in the context case. }
|
||||||
|
|
||||||
|
{ These are the master pointers to the funny-order pointer lists. }
|
||||||
|
xbuffer : array[0..2-1] of JSAMPIMAGE; { pointers to weird pointer lists }
|
||||||
|
|
||||||
|
whichptr : int; { indicates which pointer set is now in use }
|
||||||
|
context_state : int; { process_data state machine status }
|
||||||
|
rowgroups_avail : JDIMENSION; { row groups available to postprocessor }
|
||||||
|
iMCU_row_ctr : JDIMENSION; { counts iMCU rows to detect image top/bot }
|
||||||
|
end; { my_main_controller; }
|
||||||
|
|
||||||
|
|
||||||
|
{ context_state values: }
|
||||||
|
const
|
||||||
|
CTX_PREPARE_FOR_IMCU = 0; { need to prepare for MCU row }
|
||||||
|
CTX_PROCESS_IMCU = 1; { feeding iMCU to postprocessor }
|
||||||
|
CTX_POSTPONED_ROW = 2; { feeding postponed row group }
|
||||||
|
|
||||||
|
|
||||||
|
{ Forward declarations }
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_simple_main(cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
var out_row_ctr : JDIMENSION;
|
||||||
|
out_rows_avail : JDIMENSION); forward;
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_context_main (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
var out_row_ctr : JDIMENSION;
|
||||||
|
out_rows_avail : JDIMENSION); forward;
|
||||||
|
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_crank_post (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
var out_row_ctr : JDIMENSION;
|
||||||
|
out_rows_avail : JDIMENSION); forward;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure alloc_funny_pointers (cinfo : j_decompress_ptr);
|
||||||
|
{ Allocate space for the funny pointer lists.
|
||||||
|
This is done only once, not once per pass. }
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
ci, rgroup : int;
|
||||||
|
M : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
xbuf : JSAMPARRAY;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
M := cinfo^.min_DCT_scaled_size;
|
||||||
|
|
||||||
|
{ Get top-level space for component array pointers.
|
||||||
|
We alloc both arrays with one call to save a few cycles. }
|
||||||
|
|
||||||
|
main^.xbuffer[0] := JSAMPIMAGE (
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
cinfo^.num_components * 2 * SIZEOF(JSAMPARRAY)) );
|
||||||
|
main^.xbuffer[1] := JSAMPIMAGE(@( main^.xbuffer[0]^[cinfo^.num_components] ));
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div
|
||||||
|
cinfo^.min_DCT_scaled_size; { height of a row group of component }
|
||||||
|
{ Get space for pointer lists --- M+4 row groups in each list.
|
||||||
|
We alloc both pointer lists with one call to save a few cycles. }
|
||||||
|
|
||||||
|
xbuf := JSAMPARRAY (
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
2 * (rgroup * (M + 4)) * SIZEOF(JSAMPROW)) );
|
||||||
|
Inc(JSAMPROW_PTR(xbuf), rgroup); { want one row group at negative offsets }
|
||||||
|
main^.xbuffer[0]^[ci] := xbuf;
|
||||||
|
Inc(JSAMPROW_PTR(xbuf), rgroup * (M + 4));
|
||||||
|
main^.xbuffer[1]^[ci] := xbuf;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure make_funny_pointers (cinfo : j_decompress_ptr);
|
||||||
|
{ Create the funny pointer lists discussed in the comments above.
|
||||||
|
The actual workspace is already allocated (in main^.buffer),
|
||||||
|
and the space for the pointer lists is allocated too.
|
||||||
|
This routine just fills in the curiously ordered lists.
|
||||||
|
This will be repeated at the beginning of each pass. }
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
ci, i, rgroup : int;
|
||||||
|
M : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
buf, xbuf0, xbuf1 : JSAMPARRAY;
|
||||||
|
var
|
||||||
|
help_xbuf0 : JSAMPARRAY; { work around negative offsets }
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
M := cinfo^.min_DCT_scaled_size;
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div
|
||||||
|
cinfo^.min_DCT_scaled_size; { height of a row group of component }
|
||||||
|
xbuf0 := main^.xbuffer[0]^[ci];
|
||||||
|
xbuf1 := main^.xbuffer[1]^[ci];
|
||||||
|
{ First copy the workspace pointers as-is }
|
||||||
|
buf := main^.buffer[ci];
|
||||||
|
for i := 0 to pred(rgroup * (M + 2)) do
|
||||||
|
begin
|
||||||
|
xbuf0^[i] := buf^[i];
|
||||||
|
xbuf1^[i] := buf^[i];
|
||||||
|
end;
|
||||||
|
{ In the second list, put the last four row groups in swapped order }
|
||||||
|
for i := 0 to pred(rgroup * 2) do
|
||||||
|
begin
|
||||||
|
xbuf1^[rgroup*(M-2) + i] := buf^[rgroup*M + i];
|
||||||
|
xbuf1^[rgroup*M + i] := buf^[rgroup*(M-2) + i];
|
||||||
|
end;
|
||||||
|
{ The wraparound pointers at top and bottom will be filled later
|
||||||
|
(see set_wraparound_pointers, below). Initially we want the "above"
|
||||||
|
pointers to duplicate the first actual data line. This only needs
|
||||||
|
to happen in xbuffer[0]. }
|
||||||
|
|
||||||
|
help_xbuf0 := xbuf0;
|
||||||
|
Dec(JSAMPROW_PTR(help_xbuf0), rgroup);
|
||||||
|
|
||||||
|
for i := 0 to pred(rgroup) do
|
||||||
|
begin
|
||||||
|
{xbuf0^[i - rgroup] := xbuf0^[0];}
|
||||||
|
help_xbuf0^[i] := xbuf0^[0];
|
||||||
|
end;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure set_wraparound_pointers (cinfo : j_decompress_ptr);
|
||||||
|
{ Set up the "wraparound" pointers at top and bottom of the pointer lists.
|
||||||
|
This changes the pointer list state from top-of-image to the normal state. }
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
ci, i, rgroup : int;
|
||||||
|
M : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
xbuf0, xbuf1 : JSAMPARRAY;
|
||||||
|
var
|
||||||
|
help_xbuf0,
|
||||||
|
help_xbuf1 : JSAMPARRAY; { work around negative offsets }
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
M := cinfo^.min_DCT_scaled_size;
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div
|
||||||
|
cinfo^.min_DCT_scaled_size; { height of a row group of component }
|
||||||
|
xbuf0 := main^.xbuffer[0]^[ci];
|
||||||
|
xbuf1 := main^.xbuffer[1]^[ci];
|
||||||
|
|
||||||
|
help_xbuf0 := xbuf0;
|
||||||
|
Dec(JSAMPROW_PTR(help_xbuf0), rgroup);
|
||||||
|
help_xbuf1 := xbuf1;
|
||||||
|
Dec(JSAMPROW_PTR(help_xbuf1), rgroup);
|
||||||
|
|
||||||
|
for i := 0 to pred(rgroup) do
|
||||||
|
begin
|
||||||
|
{xbuf0^[i - rgroup] := xbuf0^[rgroup*(M+1) + i];
|
||||||
|
xbuf1^[i - rgroup] := xbuf1^[rgroup*(M+1) + i];}
|
||||||
|
|
||||||
|
help_xbuf0^[i] := xbuf0^[rgroup*(M+1) + i];
|
||||||
|
help_xbuf1^[i] := xbuf1^[rgroup*(M+1) + i];
|
||||||
|
|
||||||
|
xbuf0^[rgroup*(M+2) + i] := xbuf0^[i];
|
||||||
|
xbuf1^[rgroup*(M+2) + i] := xbuf1^[i];
|
||||||
|
end;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure set_bottom_pointers (cinfo : j_decompress_ptr);
|
||||||
|
{ Change the pointer lists to duplicate the last sample row at the bottom
|
||||||
|
of the image. whichptr indicates which xbuffer holds the final iMCU row.
|
||||||
|
Also sets rowgroups_avail to indicate number of nondummy row groups in row. }
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
ci, i, rgroup, iMCUheight, rows_left : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
xbuf : JSAMPARRAY;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ Count sample rows in one iMCU row and in one row group }
|
||||||
|
iMCUheight := compptr^.v_samp_factor * compptr^.DCT_scaled_size;
|
||||||
|
rgroup := iMCUheight div cinfo^.min_DCT_scaled_size;
|
||||||
|
{ Count nondummy sample rows remaining for this component }
|
||||||
|
rows_left := int (compptr^.downsampled_height mod JDIMENSION (iMCUheight));
|
||||||
|
if (rows_left = 0) then
|
||||||
|
rows_left := iMCUheight;
|
||||||
|
{ Count nondummy row groups. Should get same answer for each component,
|
||||||
|
so we need only do it once. }
|
||||||
|
if (ci = 0) then
|
||||||
|
begin
|
||||||
|
main^.rowgroups_avail := JDIMENSION ((rows_left-1) div rgroup + 1);
|
||||||
|
end;
|
||||||
|
{ Duplicate the last real sample row rgroup*2 times; this pads out the
|
||||||
|
last partial rowgroup and ensures at least one full rowgroup of context. }
|
||||||
|
|
||||||
|
xbuf := main^.xbuffer[main^.whichptr]^[ci];
|
||||||
|
for i := 0 to pred(rgroup * 2) do
|
||||||
|
begin
|
||||||
|
xbuf^[rows_left + i] := xbuf^[rows_left-1];
|
||||||
|
end;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize for a processing pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure start_pass_main (cinfo : j_decompress_ptr;
|
||||||
|
pass_mode : J_BUF_MODE);
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
|
||||||
|
case (pass_mode) of
|
||||||
|
JBUF_PASS_THRU:
|
||||||
|
begin
|
||||||
|
if (cinfo^.upsample^.need_context_rows) then
|
||||||
|
begin
|
||||||
|
main^.pub.process_data := process_data_context_main;
|
||||||
|
make_funny_pointers(cinfo); { Create the xbuffer[] lists }
|
||||||
|
main^.whichptr := 0; { Read first iMCU row into xbuffer[0] }
|
||||||
|
main^.context_state := CTX_PREPARE_FOR_IMCU;
|
||||||
|
main^.iMCU_row_ctr := 0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Simple case with no context needed }
|
||||||
|
main^.pub.process_data := process_data_simple_main;
|
||||||
|
end;
|
||||||
|
main^.buffer_full := FALSE; { Mark buffer empty }
|
||||||
|
main^.rowgroup_ctr := 0;
|
||||||
|
end;
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
JBUF_CRANK_DEST:
|
||||||
|
{ For last pass of 2-pass quantization, just crank the postprocessor }
|
||||||
|
main^.pub.process_data := process_data_crank_post;
|
||||||
|
{$endif}
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Process some data.
|
||||||
|
This handles the simple case where no context is required. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_simple_main (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
var out_row_ctr : JDIMENSION;
|
||||||
|
out_rows_avail : JDIMENSION);
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
rowgroups_avail : JDIMENSION;
|
||||||
|
var
|
||||||
|
main_buffer_ptr : JSAMPIMAGE;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
main_buffer_ptr := JSAMPIMAGE(@(main^.buffer));
|
||||||
|
|
||||||
|
{ Read input data if we haven't filled the main buffer yet }
|
||||||
|
if (not main^.buffer_full) then
|
||||||
|
begin
|
||||||
|
if (cinfo^.coef^.decompress_data (cinfo, main_buffer_ptr)=0) then
|
||||||
|
exit; { suspension forced, can do nothing more }
|
||||||
|
main^.buffer_full := TRUE; { OK, we have an iMCU row to work with }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ There are always min_DCT_scaled_size row groups in an iMCU row. }
|
||||||
|
rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size);
|
||||||
|
{ Note: at the bottom of the image, we may pass extra garbage row groups
|
||||||
|
to the postprocessor. The postprocessor has to check for bottom
|
||||||
|
of image anyway (at row resolution), so no point in us doing it too. }
|
||||||
|
|
||||||
|
{ Feed the postprocessor }
|
||||||
|
cinfo^.post^.post_process_data (cinfo, main_buffer_ptr,
|
||||||
|
main^.rowgroup_ctr, rowgroups_avail,
|
||||||
|
output_buf, out_row_ctr, out_rows_avail);
|
||||||
|
|
||||||
|
{ Has postprocessor consumed all the data yet? If so, mark buffer empty }
|
||||||
|
if (main^.rowgroup_ctr >= rowgroups_avail) then
|
||||||
|
begin
|
||||||
|
main^.buffer_full := FALSE;
|
||||||
|
main^.rowgroup_ctr := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Process some data.
|
||||||
|
This handles the case where context rows must be provided. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_context_main (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
var out_row_ctr : JDIMENSION;
|
||||||
|
out_rows_avail : JDIMENSION);
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr (cinfo^.main);
|
||||||
|
|
||||||
|
{ Read input data if we haven't filled the main buffer yet }
|
||||||
|
if (not main^.buffer_full) then
|
||||||
|
begin
|
||||||
|
if (cinfo^.coef^.decompress_data (cinfo,
|
||||||
|
main^.xbuffer[main^.whichptr])=0) then
|
||||||
|
exit; { suspension forced, can do nothing more }
|
||||||
|
main^.buffer_full := TRUE; { OK, we have an iMCU row to work with }
|
||||||
|
Inc(main^.iMCU_row_ctr); { count rows received }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Postprocessor typically will not swallow all the input data it is handed
|
||||||
|
in one call (due to filling the output buffer first). Must be prepared
|
||||||
|
to exit and restart. This switch lets us keep track of how far we got.
|
||||||
|
Note that each case falls through to the next on successful completion. }
|
||||||
|
|
||||||
|
case (main^.context_state) of
|
||||||
|
CTX_POSTPONED_ROW:
|
||||||
|
begin
|
||||||
|
{ Call postprocessor using previously set pointers for postponed row }
|
||||||
|
cinfo^.post^.post_process_data (cinfo, main^.xbuffer[main^.whichptr],
|
||||||
|
main^.rowgroup_ctr, main^.rowgroups_avail,
|
||||||
|
output_buf, out_row_ctr, out_rows_avail);
|
||||||
|
if (main^.rowgroup_ctr < main^.rowgroups_avail) then
|
||||||
|
exit; { Need to suspend }
|
||||||
|
main^.context_state := CTX_PREPARE_FOR_IMCU;
|
||||||
|
if (out_row_ctr >= out_rows_avail) then
|
||||||
|
exit; { Postprocessor exactly filled output buf }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
case (main^.context_state) of
|
||||||
|
CTX_POSTPONED_ROW,
|
||||||
|
CTX_PREPARE_FOR_IMCU: {FALLTHROUGH}
|
||||||
|
begin
|
||||||
|
{ Prepare to process first M-1 row groups of this iMCU row }
|
||||||
|
main^.rowgroup_ctr := 0;
|
||||||
|
main^.rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size - 1);
|
||||||
|
{ Check for bottom of image: if so, tweak pointers to "duplicate"
|
||||||
|
the last sample row, and adjust rowgroups_avail to ignore padding rows. }
|
||||||
|
|
||||||
|
if (main^.iMCU_row_ctr = cinfo^.total_iMCU_rows) then
|
||||||
|
set_bottom_pointers(cinfo);
|
||||||
|
main^.context_state := CTX_PROCESS_IMCU;
|
||||||
|
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
case (main^.context_state) of
|
||||||
|
CTX_POSTPONED_ROW,
|
||||||
|
CTX_PREPARE_FOR_IMCU, {FALLTHROUGH}
|
||||||
|
CTX_PROCESS_IMCU:
|
||||||
|
begin
|
||||||
|
{ Call postprocessor using previously set pointers }
|
||||||
|
cinfo^.post^.post_process_data (cinfo, main^.xbuffer[main^.whichptr],
|
||||||
|
main^.rowgroup_ctr, main^.rowgroups_avail,
|
||||||
|
output_buf, out_row_ctr, out_rows_avail);
|
||||||
|
if (main^.rowgroup_ctr < main^.rowgroups_avail) then
|
||||||
|
exit; { Need to suspend }
|
||||||
|
{ After the first iMCU, change wraparound pointers to normal state }
|
||||||
|
if (main^.iMCU_row_ctr = 1) then
|
||||||
|
set_wraparound_pointers(cinfo);
|
||||||
|
{ Prepare to load new iMCU row using other xbuffer list }
|
||||||
|
main^.whichptr := main^.whichptr xor 1; { 0=>1 or 1=>0 }
|
||||||
|
main^.buffer_full := FALSE;
|
||||||
|
{ Still need to process last row group of this iMCU row, }
|
||||||
|
{ which is saved at index M+1 of the other xbuffer }
|
||||||
|
main^.rowgroup_ctr := JDIMENSION (cinfo^.min_DCT_scaled_size + 1);
|
||||||
|
main^.rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size + 2);
|
||||||
|
main^.context_state := CTX_POSTPONED_ROW;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Process some data.
|
||||||
|
Final pass of two-pass quantization: just call the postprocessor.
|
||||||
|
Source data will be the postprocessor controller's internal buffer. }
|
||||||
|
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure process_data_crank_post (cinfo : j_decompress_ptr;
|
||||||
|
output_buf : JSAMPARRAY;
|
||||||
|
var out_row_ctr : JDIMENSION;
|
||||||
|
out_rows_avail : JDIMENSION);
|
||||||
|
var
|
||||||
|
in_row_group_ctr : JDIMENSION;
|
||||||
|
begin
|
||||||
|
in_row_group_ctr := 0;
|
||||||
|
cinfo^.post^.post_process_data (cinfo, JSAMPIMAGE (NIL),
|
||||||
|
in_row_group_ctr,
|
||||||
|
JDIMENSION(0),
|
||||||
|
output_buf,
|
||||||
|
out_row_ctr,
|
||||||
|
out_rows_avail);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { QUANT_2PASS_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize main buffer controller. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_d_main_controller (cinfo : j_decompress_ptr;
|
||||||
|
need_full_buffer : boolean);
|
||||||
|
var
|
||||||
|
main : my_main_ptr;
|
||||||
|
ci, rgroup, ngroups : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
begin
|
||||||
|
main := my_main_ptr(
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_main_controller)) );
|
||||||
|
cinfo^.main := jpeg_d_main_controller_ptr(main);
|
||||||
|
main^.pub.start_pass := start_pass_main;
|
||||||
|
|
||||||
|
if (need_full_buffer) then { shouldn't happen }
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
|
||||||
|
|
||||||
|
{ Allocate the workspace.
|
||||||
|
ngroups is the number of row groups we need.}
|
||||||
|
|
||||||
|
if (cinfo^.upsample^.need_context_rows) then
|
||||||
|
begin
|
||||||
|
if (cinfo^.min_DCT_scaled_size < 2) then { unsupported, see comments above }
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL);
|
||||||
|
alloc_funny_pointers(cinfo); { Alloc space for xbuffer[] lists }
|
||||||
|
ngroups := cinfo^.min_DCT_scaled_size + 2;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ngroups := cinfo^.min_DCT_scaled_size;
|
||||||
|
end;
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div
|
||||||
|
cinfo^.min_DCT_scaled_size; { height of a row group of component }
|
||||||
|
main^.buffer[ci] := cinfo^.mem^.alloc_sarray
|
||||||
|
(j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
compptr^.width_in_blocks * LongWord(compptr^.DCT_scaled_size),
|
||||||
|
JDIMENSION (rgroup * ngroups));
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,679 @@
|
||||||
|
unit imjdmaster;
|
||||||
|
|
||||||
|
{ This file contains master control logic for the JPEG decompressor.
|
||||||
|
These routines are concerned with selecting the modules to be executed
|
||||||
|
and with determining the number of passes and the work to be done in each
|
||||||
|
pass. }
|
||||||
|
|
||||||
|
{ Original: jdmaster.c ; Copyright (C) 1991-1998, Thomas G. Lane. }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I imjconfig.inc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
imjmorecfg,
|
||||||
|
imjinclude,
|
||||||
|
imjutils,
|
||||||
|
imjerror,
|
||||||
|
imjdeferr,
|
||||||
|
imjdcolor, imjdsample, imjdpostct, imjddctmgr, imjdphuff,
|
||||||
|
imjdhuff, imjdcoefct, imjdmainct,
|
||||||
|
{$ifdef QUANT_1PASS_SUPPORTED}
|
||||||
|
imjquant1,
|
||||||
|
{$endif}
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
imjquant2,
|
||||||
|
{$endif}
|
||||||
|
{$ifdef UPSAMPLE_MERGING_SUPPORTED}
|
||||||
|
imjdmerge,
|
||||||
|
{$endif}
|
||||||
|
imjpeglib;
|
||||||
|
|
||||||
|
|
||||||
|
{ Compute output image dimensions and related values.
|
||||||
|
NOTE: this is exported for possible use by application.
|
||||||
|
Hence it mustn't do anything that can't be done twice.
|
||||||
|
Also note that it may be called before the master module is initialized! }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_calc_output_dimensions (cinfo : j_decompress_ptr);
|
||||||
|
{ Do computations that are needed before master selection phase }
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_new_colormap (cinfo : j_decompress_ptr);
|
||||||
|
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{ Initialize master decompression control and select active modules.
|
||||||
|
This is performed at the start of jpeg_start_decompress. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_master_decompress (cinfo : j_decompress_ptr);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ Private state }
|
||||||
|
|
||||||
|
type
|
||||||
|
my_master_ptr = ^my_decomp_master;
|
||||||
|
my_decomp_master = record
|
||||||
|
pub : jpeg_decomp_master; { public fields }
|
||||||
|
|
||||||
|
pass_number : int; { # of passes completed }
|
||||||
|
|
||||||
|
using_merged_upsample : boolean; { TRUE if using merged upsample/cconvert }
|
||||||
|
|
||||||
|
{ Saved references to initialized quantizer modules,
|
||||||
|
in case we need to switch modes. }
|
||||||
|
|
||||||
|
quantizer_1pass : jpeg_color_quantizer_ptr;
|
||||||
|
quantizer_2pass : jpeg_color_quantizer_ptr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Determine whether merged upsample/color conversion should be used.
|
||||||
|
CRUCIAL: this must match the actual capabilities of jdmerge.c! }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
function use_merged_upsample (cinfo : j_decompress_ptr) : boolean;
|
||||||
|
var
|
||||||
|
compptr : jpeg_component_info_list_ptr;
|
||||||
|
begin
|
||||||
|
compptr := cinfo^.comp_info;
|
||||||
|
|
||||||
|
{$ifdef UPSAMPLE_MERGING_SUPPORTED}
|
||||||
|
{ Merging is the equivalent of plain box-filter upsampling }
|
||||||
|
if (cinfo^.do_fancy_upsampling) or (cinfo^.CCIR601_sampling) then
|
||||||
|
begin
|
||||||
|
use_merged_upsample := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ jdmerge.c only supports YCC=>RGB color conversion }
|
||||||
|
if (cinfo^.jpeg_color_space <> JCS_YCbCr) or (cinfo^.num_components <> 3)
|
||||||
|
or (cinfo^.out_color_space <> JCS_RGB)
|
||||||
|
or (cinfo^.out_color_components <> RGB_PIXELSIZE) then
|
||||||
|
begin
|
||||||
|
use_merged_upsample := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ and it only handles 2h1v or 2h2v sampling ratios }
|
||||||
|
if (compptr^[0].h_samp_factor <> 2) or
|
||||||
|
(compptr^[1].h_samp_factor <> 1) or
|
||||||
|
(compptr^[2].h_samp_factor <> 1) or
|
||||||
|
(compptr^[0].v_samp_factor > 2) or
|
||||||
|
(compptr^[1].v_samp_factor <> 1) or
|
||||||
|
(compptr^[2].v_samp_factor <> 1) then
|
||||||
|
begin
|
||||||
|
use_merged_upsample := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ furthermore, it doesn't work if we've scaled the IDCTs differently }
|
||||||
|
if (compptr^[0].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) or
|
||||||
|
(compptr^[1].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) or
|
||||||
|
(compptr^[2].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) then
|
||||||
|
begin
|
||||||
|
use_merged_upsample := FALSE;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
{ ??? also need to test for upsample-time rescaling, when & if supported }
|
||||||
|
use_merged_upsample := TRUE; { by golly, it'll work... }
|
||||||
|
{$else}
|
||||||
|
use_merged_upsample := FALSE;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Compute output image dimensions and related values.
|
||||||
|
NOTE: this is exported for possible use by application.
|
||||||
|
Hence it mustn't do anything that can't be done twice.
|
||||||
|
Also note that it may be called before the master module is initialized! }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_calc_output_dimensions (cinfo : j_decompress_ptr);
|
||||||
|
{ Do computations that are needed before master selection phase }
|
||||||
|
{$ifdef IDCT_SCALING_SUPPORTED}
|
||||||
|
var
|
||||||
|
ci : int;
|
||||||
|
compptr : jpeg_component_info_ptr;
|
||||||
|
{$endif}
|
||||||
|
var
|
||||||
|
ssize : int;
|
||||||
|
begin
|
||||||
|
{ Prevent application from calling me at wrong times }
|
||||||
|
if (cinfo^.global_state <> DSTATE_READY) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
{$ifdef IDCT_SCALING_SUPPORTED}
|
||||||
|
|
||||||
|
{ Compute actual output image dimensions and DCT scaling choices. }
|
||||||
|
if (cinfo^.scale_num * 8 <= cinfo^.scale_denom) then
|
||||||
|
begin
|
||||||
|
{ Provide 1/8 scaling }
|
||||||
|
cinfo^.output_width := JDIMENSION (
|
||||||
|
jdiv_round_up( long(cinfo^.image_width), long(8)) );
|
||||||
|
cinfo^.output_height := JDIMENSION (
|
||||||
|
jdiv_round_up( long(cinfo^.image_height), long(8)) );
|
||||||
|
cinfo^.min_DCT_scaled_size := 1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.scale_num * 4 <= cinfo^.scale_denom) then
|
||||||
|
begin
|
||||||
|
{ Provide 1/4 scaling }
|
||||||
|
cinfo^.output_width := JDIMENSION (
|
||||||
|
jdiv_round_up( long (cinfo^.image_width), long(4)) );
|
||||||
|
cinfo^.output_height := JDIMENSION (
|
||||||
|
jdiv_round_up( long (cinfo^.image_height), long(4)) );
|
||||||
|
cinfo^.min_DCT_scaled_size := 2;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.scale_num * 2 <= cinfo^.scale_denom) then
|
||||||
|
begin
|
||||||
|
{ Provide 1/2 scaling }
|
||||||
|
cinfo^.output_width := JDIMENSION (
|
||||||
|
jdiv_round_up( long(cinfo^.image_width), long(2)) );
|
||||||
|
cinfo^.output_height := JDIMENSION (
|
||||||
|
jdiv_round_up( long(cinfo^.image_height), long(2)) );
|
||||||
|
cinfo^.min_DCT_scaled_size := 4;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Provide 1/1 scaling }
|
||||||
|
cinfo^.output_width := cinfo^.image_width;
|
||||||
|
cinfo^.output_height := cinfo^.image_height;
|
||||||
|
cinfo^.min_DCT_scaled_size := DCTSIZE;
|
||||||
|
end;
|
||||||
|
{ In selecting the actual DCT scaling for each component, we try to
|
||||||
|
scale up the chroma components via IDCT scaling rather than upsampling.
|
||||||
|
This saves time if the upsampler gets to use 1:1 scaling.
|
||||||
|
Note this code assumes that the supported DCT scalings are powers of 2. }
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
ssize := cinfo^.min_DCT_scaled_size;
|
||||||
|
while (ssize < DCTSIZE) and
|
||||||
|
((compptr^.h_samp_factor * ssize * 2 <=
|
||||||
|
cinfo^.max_h_samp_factor * cinfo^.min_DCT_scaled_size) and
|
||||||
|
(compptr^.v_samp_factor * ssize * 2 <=
|
||||||
|
cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size)) do
|
||||||
|
begin
|
||||||
|
ssize := ssize * 2;
|
||||||
|
end;
|
||||||
|
compptr^.DCT_scaled_size := ssize;
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Recompute downsampled dimensions of components;
|
||||||
|
application needs to know these if using raw downsampled data. }
|
||||||
|
|
||||||
|
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
|
||||||
|
for ci := 0 to pred(cinfo^.num_components) do
|
||||||
|
begin
|
||||||
|
{ Size in samples, after IDCT scaling }
|
||||||
|
compptr^.downsampled_width := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_width) *
|
||||||
|
long (compptr^.h_samp_factor * compptr^.DCT_scaled_size),
|
||||||
|
long (cinfo^.max_h_samp_factor * DCTSIZE)) );
|
||||||
|
compptr^.downsampled_height := JDIMENSION (
|
||||||
|
jdiv_round_up(long (cinfo^.image_height) *
|
||||||
|
long (compptr^.v_samp_factor * compptr^.DCT_scaled_size),
|
||||||
|
long (cinfo^.max_v_samp_factor * DCTSIZE)) );
|
||||||
|
Inc(compptr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$else} { !IDCT_SCALING_SUPPORTED }
|
||||||
|
|
||||||
|
{ Hardwire it to "no scaling" }
|
||||||
|
cinfo^.output_width := cinfo^.image_width;
|
||||||
|
cinfo^.output_height := cinfo^.image_height;
|
||||||
|
{ jdinput.c has already initialized DCT_scaled_size to DCTSIZE,
|
||||||
|
and has computed unscaled downsampled_width and downsampled_height. }
|
||||||
|
|
||||||
|
{$endif} { IDCT_SCALING_SUPPORTED }
|
||||||
|
|
||||||
|
{ Report number of components in selected colorspace. }
|
||||||
|
{ Probably this should be in the color conversion module... }
|
||||||
|
case (cinfo^.out_color_space) of
|
||||||
|
JCS_GRAYSCALE:
|
||||||
|
cinfo^.out_color_components := 1;
|
||||||
|
{$ifndef RGB_PIXELSIZE_IS_3}
|
||||||
|
JCS_RGB:
|
||||||
|
cinfo^.out_color_components := RGB_PIXELSIZE;
|
||||||
|
{$else}
|
||||||
|
JCS_RGB,
|
||||||
|
{$endif} { else share code with YCbCr }
|
||||||
|
JCS_YCbCr:
|
||||||
|
cinfo^.out_color_components := 3;
|
||||||
|
JCS_CMYK,
|
||||||
|
JCS_YCCK:
|
||||||
|
cinfo^.out_color_components := 4;
|
||||||
|
else { else must be same colorspace as in file }
|
||||||
|
cinfo^.out_color_components := cinfo^.num_components;
|
||||||
|
end;
|
||||||
|
if (cinfo^.quantize_colors) then
|
||||||
|
cinfo^.output_components := 1
|
||||||
|
else
|
||||||
|
cinfo^.output_components := cinfo^.out_color_components;
|
||||||
|
|
||||||
|
{ See if upsampler will want to emit more than one row at a time }
|
||||||
|
if (use_merged_upsample(cinfo)) then
|
||||||
|
cinfo^.rec_outbuf_height := cinfo^.max_v_samp_factor
|
||||||
|
else
|
||||||
|
cinfo^.rec_outbuf_height := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Several decompression processes need to range-limit values to the range
|
||||||
|
0..MAXJSAMPLE; the input value may fall somewhat outside this range
|
||||||
|
due to noise introduced by quantization, roundoff error, etc. These
|
||||||
|
processes are inner loops and need to be as fast as possible. On most
|
||||||
|
machines, particularly CPUs with pipelines or instruction prefetch,
|
||||||
|
a (subscript-check-less) C table lookup
|
||||||
|
x := sample_range_limit[x];
|
||||||
|
is faster than explicit tests
|
||||||
|
if (x < 0) x := 0;
|
||||||
|
else if (x > MAXJSAMPLE) x := MAXJSAMPLE;
|
||||||
|
These processes all use a common table prepared by the routine below.
|
||||||
|
|
||||||
|
For most steps we can mathematically guarantee that the initial value
|
||||||
|
of x is within MAXJSAMPLE+1 of the legal range, so a table running from
|
||||||
|
-(MAXJSAMPLE+1) to 2*MAXJSAMPLE+1 is sufficient. But for the initial
|
||||||
|
limiting step (just after the IDCT), a wildly out-of-range value is
|
||||||
|
possible if the input data is corrupt. To avoid any chance of indexing
|
||||||
|
off the end of memory and getting a bad-pointer trap, we perform the
|
||||||
|
post-IDCT limiting thus:
|
||||||
|
x := range_limit[x & MASK];
|
||||||
|
where MASK is 2 bits wider than legal sample data, ie 10 bits for 8-bit
|
||||||
|
samples. Under normal circumstances this is more than enough range and
|
||||||
|
a correct output will be generated; with bogus input data the mask will
|
||||||
|
cause wraparound, and we will safely generate a bogus-but-in-range output.
|
||||||
|
For the post-IDCT step, we want to convert the data from signed to unsigned
|
||||||
|
representation by adding CENTERJSAMPLE at the same time that we limit it.
|
||||||
|
So the post-IDCT limiting table ends up looking like this:
|
||||||
|
CENTERJSAMPLE,CENTERJSAMPLE+1,...,MAXJSAMPLE,
|
||||||
|
MAXJSAMPLE (repeat 2*(MAXJSAMPLE+1)-CENTERJSAMPLE times),
|
||||||
|
0 (repeat 2*(MAXJSAMPLE+1)-CENTERJSAMPLE times),
|
||||||
|
0,1,...,CENTERJSAMPLE-1
|
||||||
|
Negative inputs select values from the upper half of the table after
|
||||||
|
masking.
|
||||||
|
|
||||||
|
We can save some space by overlapping the start of the post-IDCT table
|
||||||
|
with the simpler range limiting table. The post-IDCT table begins at
|
||||||
|
sample_range_limit + CENTERJSAMPLE.
|
||||||
|
|
||||||
|
Note that the table is allocated in near data space on PCs; it's small
|
||||||
|
enough and used often enough to justify this. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure prepare_range_limit_table (cinfo : j_decompress_ptr);
|
||||||
|
{ Allocate and fill in the sample_range_limit table }
|
||||||
|
var
|
||||||
|
table : range_limit_table_ptr;
|
||||||
|
idct_table : JSAMPROW;
|
||||||
|
i : int;
|
||||||
|
begin
|
||||||
|
table := range_limit_table_ptr (
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
(5 * (MAXJSAMPLE+1) + CENTERJSAMPLE) * SIZEOF(JSAMPLE)) );
|
||||||
|
|
||||||
|
{ First segment of "simple" table: limit[x] := 0 for x < 0 }
|
||||||
|
MEMZERO(table, (MAXJSAMPLE+1) * SIZEOF(JSAMPLE));
|
||||||
|
|
||||||
|
cinfo^.sample_range_limit := (table);
|
||||||
|
{ allow negative subscripts of simple table }
|
||||||
|
{ is noop, handled via type definition (Nomssi) }
|
||||||
|
{ Main part of "simple" table: limit[x] := x }
|
||||||
|
for i := 0 to MAXJSAMPLE do
|
||||||
|
table^[i] := JSAMPLE (i);
|
||||||
|
idct_table := JSAMPROW(@ table^[CENTERJSAMPLE]);
|
||||||
|
{ Point to where post-IDCT table starts }
|
||||||
|
{ End of simple table, rest of first half of post-IDCT table }
|
||||||
|
for i := CENTERJSAMPLE to pred(2*(MAXJSAMPLE+1)) do
|
||||||
|
idct_table^[i] := MAXJSAMPLE;
|
||||||
|
{ Second half of post-IDCT table }
|
||||||
|
MEMZERO(@(idct_table^[2 * (MAXJSAMPLE+1)]),
|
||||||
|
(2 * (MAXJSAMPLE+1) - CENTERJSAMPLE) * SIZEOF(JSAMPLE));
|
||||||
|
MEMCOPY(@(idct_table^[(4 * (MAXJSAMPLE+1) - CENTERJSAMPLE)]),
|
||||||
|
@cinfo^.sample_range_limit^[0], CENTERJSAMPLE * SIZEOF(JSAMPLE));
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Master selection of decompression modules.
|
||||||
|
This is done once at jpeg_start_decompress time. We determine
|
||||||
|
which modules will be used and give them appropriate initialization calls.
|
||||||
|
We also initialize the decompressor input side to begin consuming data.
|
||||||
|
|
||||||
|
Since jpeg_read_header has finished, we know what is in the SOF
|
||||||
|
and (first) SOS markers. We also have all the application parameter
|
||||||
|
settings. }
|
||||||
|
|
||||||
|
{LOCAL}
|
||||||
|
procedure master_selection (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
use_c_buffer : boolean;
|
||||||
|
samplesperrow : long;
|
||||||
|
jd_samplesperrow : JDIMENSION;
|
||||||
|
var
|
||||||
|
nscans : int;
|
||||||
|
begin
|
||||||
|
master := my_master_ptr (cinfo^.master);
|
||||||
|
|
||||||
|
{ Initialize dimensions and other stuff }
|
||||||
|
jpeg_calc_output_dimensions(cinfo);
|
||||||
|
prepare_range_limit_table(cinfo);
|
||||||
|
|
||||||
|
{ Width of an output scanline must be representable as JDIMENSION. }
|
||||||
|
samplesperrow := long(cinfo^.output_width) * long (cinfo^.out_color_components);
|
||||||
|
jd_samplesperrow := JDIMENSION (samplesperrow);
|
||||||
|
if (long(jd_samplesperrow) <> samplesperrow) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_WIDTH_OVERFLOW);
|
||||||
|
|
||||||
|
{ Initialize my private state }
|
||||||
|
master^.pass_number := 0;
|
||||||
|
master^.using_merged_upsample := use_merged_upsample(cinfo);
|
||||||
|
|
||||||
|
{ Color quantizer selection }
|
||||||
|
master^.quantizer_1pass := NIL;
|
||||||
|
master^.quantizer_2pass := NIL;
|
||||||
|
{ No mode changes if not using buffered-image mode. }
|
||||||
|
if (not cinfo^.quantize_colors) or (not cinfo^.buffered_image) then
|
||||||
|
begin
|
||||||
|
cinfo^.enable_1pass_quant := FALSE;
|
||||||
|
cinfo^.enable_external_quant := FALSE;
|
||||||
|
cinfo^.enable_2pass_quant := FALSE;
|
||||||
|
end;
|
||||||
|
if (cinfo^.quantize_colors) then
|
||||||
|
begin
|
||||||
|
if (cinfo^.raw_data_out) then
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL);
|
||||||
|
{ 2-pass quantizer only works in 3-component color space. }
|
||||||
|
if (cinfo^.out_color_components <> 3) then
|
||||||
|
begin
|
||||||
|
cinfo^.enable_1pass_quant := TRUE;
|
||||||
|
cinfo^.enable_external_quant := FALSE;
|
||||||
|
cinfo^.enable_2pass_quant := FALSE;
|
||||||
|
cinfo^.colormap := NIL;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.colormap <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.enable_external_quant := TRUE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.two_pass_quantize) then
|
||||||
|
begin
|
||||||
|
cinfo^.enable_2pass_quant := TRUE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
cinfo^.enable_1pass_quant := TRUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (cinfo^.enable_1pass_quant) then
|
||||||
|
begin
|
||||||
|
{$ifdef QUANT_1PASS_SUPPORTED}
|
||||||
|
jinit_1pass_quantizer(cinfo);
|
||||||
|
master^.quantizer_1pass := cinfo^.cquantize;
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ We use the 2-pass code to map to external colormaps. }
|
||||||
|
if (cinfo^.enable_2pass_quant) or (cinfo^.enable_external_quant) then
|
||||||
|
begin
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
jinit_2pass_quantizer(cinfo);
|
||||||
|
master^.quantizer_2pass := cinfo^.cquantize;
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
{ If both quantizers are initialized, the 2-pass one is left active;
|
||||||
|
this is necessary for starting with quantization to an external map. }
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Post-processing: in particular, color conversion first }
|
||||||
|
if (not cinfo^.raw_data_out) then
|
||||||
|
begin
|
||||||
|
if (master^.using_merged_upsample) then
|
||||||
|
begin
|
||||||
|
{$ifdef UPSAMPLE_MERGING_SUPPORTED}
|
||||||
|
jinit_merged_upsampler(cinfo); { does color conversion too }
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
jinit_color_deconverter(cinfo);
|
||||||
|
jinit_upsampler(cinfo);
|
||||||
|
end;
|
||||||
|
jinit_d_post_controller(cinfo, cinfo^.enable_2pass_quant);
|
||||||
|
end;
|
||||||
|
{ Inverse DCT }
|
||||||
|
jinit_inverse_dct(cinfo);
|
||||||
|
{ Entropy decoding: either Huffman or arithmetic coding. }
|
||||||
|
if (cinfo^.arith_code) then
|
||||||
|
begin
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_ARITH_NOTIMPL);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
begin
|
||||||
|
{$ifdef D_PROGRESSIVE_SUPPORTED}
|
||||||
|
jinit_phuff_decoder(cinfo);
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
else
|
||||||
|
jinit_huff_decoder(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Initialize principal buffer controllers. }
|
||||||
|
use_c_buffer := cinfo^.inputctl^.has_multiple_scans or cinfo^.buffered_image;
|
||||||
|
jinit_d_coef_controller(cinfo, use_c_buffer);
|
||||||
|
|
||||||
|
if (not cinfo^.raw_data_out) then
|
||||||
|
jinit_d_main_controller(cinfo, FALSE { never need full buffer here });
|
||||||
|
|
||||||
|
{ We can now tell the memory manager to allocate virtual arrays. }
|
||||||
|
cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo));
|
||||||
|
|
||||||
|
{ Initialize input side of decompressor to consume first scan. }
|
||||||
|
cinfo^.inputctl^.start_input_pass (cinfo);
|
||||||
|
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
{ If jpeg_start_decompress will read the whole file, initialize
|
||||||
|
progress monitoring appropriately. The input step is counted
|
||||||
|
as one pass. }
|
||||||
|
|
||||||
|
if (cinfo^.progress <> NIL) and (not cinfo^.buffered_image) and
|
||||||
|
(cinfo^.inputctl^.has_multiple_scans) then
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ Estimate number of scans to set pass_limit. }
|
||||||
|
if (cinfo^.progressive_mode) then
|
||||||
|
begin
|
||||||
|
{ Arbitrarily estimate 2 interleaved DC scans + 3 AC scans/component. }
|
||||||
|
nscans := 2 + 3 * cinfo^.num_components;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ For a nonprogressive multiscan file, estimate 1 scan per component. }
|
||||||
|
nscans := cinfo^.num_components;
|
||||||
|
end;
|
||||||
|
cinfo^.progress^.pass_counter := Long(0);
|
||||||
|
cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows) * nscans;
|
||||||
|
cinfo^.progress^.completed_passes := 0;
|
||||||
|
if cinfo^.enable_2pass_quant then
|
||||||
|
cinfo^.progress^.total_passes := 3
|
||||||
|
else
|
||||||
|
cinfo^.progress^.total_passes := 2;
|
||||||
|
{ Count the input pass as done }
|
||||||
|
Inc(master^.pass_number);
|
||||||
|
end;
|
||||||
|
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Per-pass setup.
|
||||||
|
This is called at the beginning of each output pass. We determine which
|
||||||
|
modules will be active during this pass and give them appropriate
|
||||||
|
start_pass calls. We also set is_dummy_pass to indicate whether this
|
||||||
|
is a "real" output pass or a dummy pass for color quantization.
|
||||||
|
(In the latter case, jdapistd.c will crank the pass to completion.) }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure prepare_for_output_pass (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
begin
|
||||||
|
master := my_master_ptr (cinfo^.master);
|
||||||
|
|
||||||
|
if (master^.pub.is_dummy_pass) then
|
||||||
|
begin
|
||||||
|
{$ifdef QUANT_2PASS_SUPPORTED}
|
||||||
|
{ Final pass of 2-pass quantization }
|
||||||
|
master^.pub.is_dummy_pass := FALSE;
|
||||||
|
cinfo^.cquantize^.start_pass (cinfo, FALSE);
|
||||||
|
cinfo^.post^.start_pass (cinfo, JBUF_CRANK_DEST);
|
||||||
|
cinfo^.main^.start_pass (cinfo, JBUF_CRANK_DEST);
|
||||||
|
{$else}
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
|
||||||
|
{$endif} { QUANT_2PASS_SUPPORTED }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (cinfo^.quantize_colors) and (cinfo^.colormap = NIL) then
|
||||||
|
begin
|
||||||
|
{ Select new quantization method }
|
||||||
|
if (cinfo^.two_pass_quantize) and (cinfo^.enable_2pass_quant) then
|
||||||
|
begin
|
||||||
|
cinfo^.cquantize := master^.quantizer_2pass;
|
||||||
|
master^.pub.is_dummy_pass := TRUE;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if (cinfo^.enable_1pass_quant) then
|
||||||
|
begin
|
||||||
|
cinfo^.cquantize := master^.quantizer_1pass;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
cinfo^.idct^.start_pass (cinfo);
|
||||||
|
cinfo^.coef^.start_output_pass (cinfo);
|
||||||
|
if (not cinfo^.raw_data_out) then
|
||||||
|
begin
|
||||||
|
if (not master^.using_merged_upsample) then
|
||||||
|
cinfo^.cconvert^.start_pass (cinfo);
|
||||||
|
cinfo^.upsample^.start_pass (cinfo);
|
||||||
|
if (cinfo^.quantize_colors) then
|
||||||
|
cinfo^.cquantize^.start_pass (cinfo, master^.pub.is_dummy_pass);
|
||||||
|
if master^.pub.is_dummy_pass then
|
||||||
|
cinfo^.post^.start_pass (cinfo, JBUF_SAVE_AND_PASS)
|
||||||
|
else
|
||||||
|
cinfo^.post^.start_pass (cinfo, JBUF_PASS_THRU);
|
||||||
|
cinfo^.main^.start_pass (cinfo, JBUF_PASS_THRU);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Set up progress monitor's pass info if present }
|
||||||
|
if (cinfo^.progress <> NIL) then
|
||||||
|
begin
|
||||||
|
cinfo^.progress^.completed_passes := master^.pass_number;
|
||||||
|
if master^.pub.is_dummy_pass then
|
||||||
|
cinfo^.progress^.total_passes := master^.pass_number + 2
|
||||||
|
else
|
||||||
|
cinfo^.progress^.total_passes := master^.pass_number + 1;
|
||||||
|
{ In buffered-image mode, we assume one more output pass if EOI not
|
||||||
|
yet reached, but no more passes if EOI has been reached. }
|
||||||
|
|
||||||
|
if (cinfo^.buffered_image) and (not cinfo^.inputctl^.eoi_reached) then
|
||||||
|
begin
|
||||||
|
if cinfo^.enable_2pass_quant then
|
||||||
|
Inc(cinfo^.progress^.total_passes, 2)
|
||||||
|
else
|
||||||
|
Inc(cinfo^.progress^.total_passes, 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Finish up at end of an output pass. }
|
||||||
|
|
||||||
|
{METHODDEF}
|
||||||
|
procedure finish_output_pass (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
begin
|
||||||
|
master := my_master_ptr (cinfo^.master);
|
||||||
|
|
||||||
|
if (cinfo^.quantize_colors) then
|
||||||
|
cinfo^.cquantize^.finish_pass (cinfo);
|
||||||
|
Inc(master^.pass_number);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
|
||||||
|
|
||||||
|
{ Switch to a new external colormap between output passes. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jpeg_new_colormap (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
begin
|
||||||
|
master := my_master_ptr (cinfo^.master);
|
||||||
|
|
||||||
|
{ Prevent application from calling me at wrong times }
|
||||||
|
if (cinfo^.global_state <> DSTATE_BUFIMAGE) then
|
||||||
|
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
|
||||||
|
|
||||||
|
if (cinfo^.quantize_colors) and (cinfo^.enable_external_quant) and
|
||||||
|
(cinfo^.colormap <> NIL) then
|
||||||
|
begin
|
||||||
|
{ Select 2-pass quantizer for external colormap use }
|
||||||
|
cinfo^.cquantize := master^.quantizer_2pass;
|
||||||
|
{ Notify quantizer of colormap change }
|
||||||
|
cinfo^.cquantize^.new_color_map (cinfo);
|
||||||
|
master^.pub.is_dummy_pass := FALSE; { just in case }
|
||||||
|
end
|
||||||
|
else
|
||||||
|
ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
|
||||||
|
|
||||||
|
|
||||||
|
{ Initialize master decompression control and select active modules.
|
||||||
|
This is performed at the start of jpeg_start_decompress. }
|
||||||
|
|
||||||
|
{GLOBAL}
|
||||||
|
procedure jinit_master_decompress (cinfo : j_decompress_ptr);
|
||||||
|
var
|
||||||
|
master : my_master_ptr;
|
||||||
|
begin
|
||||||
|
master := my_master_ptr (
|
||||||
|
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
|
||||||
|
SIZEOF(my_decomp_master)) );
|
||||||
|
cinfo^.master := jpeg_decomp_master_ptr(master);
|
||||||
|
master^.pub.prepare_for_output_pass := prepare_for_output_pass;
|
||||||
|
master^.pub.finish_output_pass := finish_output_pass;
|
||||||
|
|
||||||
|
master^.pub.is_dummy_pass := FALSE;
|
||||||
|
|
||||||
|
master_selection(cinfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue