aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

* Added password change support (references #95) 

* Fixed 64bit support
* Repaired line endings
* Bumped protocol version
This commit is contained in:
Andreas Schneider 2013-11-20 18:12:52 +01:00
parent 9676549ac3
commit 829a604c30
35 changed files with 21115 additions and 20710 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1056
Client/CentrED.lpi
View File

File diff suppressed because it is too large Load Diff

1
Client/UPacketHandlers.pas
View File

@ -141,6 +141,7 @@ initialization
//$06-$0B --> handled by TLandscape
//$0C --> ClientHandling, done by TfrmMain
//$0D --> RadarMapHandling, done by TfrmRadarMap
//$0E --> LargeScaleCommands, done by TfrmLargeScaleCommands
finalization
for i := 0 to $FF do
if PacketHandlers[i] <> nil then

18
Client/UPackets.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
* Portions Copyright 2013 Andreas Schneider
*)
unit UPackets;
@ -133,6 +133,12 @@ type
TGotoClientPosPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TChangePasswordPacket }
TChangePasswordPacket = class(TPacket)
constructor Create(AOldPassword, ANewPassword: String);
end;
{ TRequestRadarChecksumPacket }
@ -346,6 +352,16 @@ begin
FStream.WriteStringNull(AUsername);
end;
{ TChangePasswordPacket }
constructor TChangePasswordPacket.Create(AOldPassword, ANewPassword: String);
begin
inherited Create($0C, 0);
FStream.WriteByte($08);
FStream.WriteStringNull(AOldPassword);
FStream.WriteStringNull(ANewPassword);
end;
{ TRequestRadarChecksumPacket }
constructor TRequestRadarChecksumPacket.Create;

5
Client/UdmNetwork.pas
View File

@ -78,7 +78,8 @@ uses
UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel;
UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel,
UfrmChangePassword;
{$I version.inc}
@ -212,6 +213,7 @@ begin
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
frmLightlevel := TfrmLightlevel.Create(frmMain);
frmAbout := TfrmAbout.Create(frmMain);
frmChangePassword := TfrmChangePassword.Create(frmMain);
frmMain.Show;
frmInitialize.Hide;
tmNoOp.Enabled := True;
@ -308,6 +310,7 @@ begin
FreeAndNil(frmLargeScaleCommand);
FreeAndNil(frmRadarMap);
FreeAndNil(frmLightlevel);
FreeAndNil(frmChangePassword);
if frmMain <> nil then
begin

129
Client/UfrmChangePassword.lfm Normal file
View File

@ -0,0 +1,129 @@
object frmChangePassword: TfrmChangePassword
Left = 283
Height = 145
Top = 193
Width = 315
BorderStyle = bsDialog
Caption = 'Change Password'
ClientHeight = 145
ClientWidth = 315
OnShow = FormShow
Position = poMainFormCenter
LCLVersion = '1.3'
object Label1: TLabel
AnchorSideTop.Control = edOldPwd
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = edOldPwd
Left = 32
Height = 15
Top = 13
Width = 88
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Old Password:'
ParentColor = False
end
object Label2: TLabel
AnchorSideTop.Control = edNewPwd
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = edNewPwd
Left = 26
Height = 15
Top = 46
Width = 94
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'New Password:'
ParentColor = False
end
object lblNewPwdRepeat: TLabel
AnchorSideTop.Control = edNewPwdRepeat
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = edNewPwdRepeat
Left = 9
Height = 15
Top = 79
Width = 111
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Repeat Password:'
ParentColor = False
end
object edOldPwd: TEdit
Left = 128
Height = 25
Top = 8
Width = 176
EchoMode = emPassword
PasswordChar = '*'
TabOrder = 0
end
object edNewPwd: TEdit
AnchorSideLeft.Control = edOldPwd
AnchorSideTop.Control = edOldPwd
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edOldPwd
AnchorSideRight.Side = asrBottom
Left = 128
Height = 25
Top = 41
Width = 176
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
EchoMode = emPassword
OnChange = edNewPwdChange
PasswordChar = '*'
TabOrder = 1
end
object edNewPwdRepeat: TEdit
AnchorSideLeft.Control = edNewPwd
AnchorSideTop.Control = edNewPwd
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edNewPwd
AnchorSideRight.Side = asrBottom
Left = 128
Height = 25
Top = 74
Width = 176
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
EchoMode = emPassword
OnChange = edNewPwdChange
PasswordChar = '*'
TabOrder = 2
end
object btnOK: TButton
AnchorSideTop.Control = btnCancel
AnchorSideRight.Control = btnCancel
Left = 149
Height = 25
Top = 112
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = '&OK'
Default = True
Enabled = False
ModalResult = 1
OnClick = btnOKClick
TabOrder = 3
end
object btnCancel: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 232
Height = 25
Top = 112
Width = 75
Anchors = [akRight, akBottom]
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Cancel = True
Caption = 'Cancel'
ModalResult = 2
OnClick = btnCancelClick
TabOrder = 4
end
end

81
Client/UfrmChangePassword.pas Normal file
View File

@ -0,0 +1,81 @@
unit UfrmChangePassword;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TfrmChangePassword }
TfrmChangePassword = class(TForm)
btnOK: TButton;
btnCancel: TButton;
edOldPwd: TEdit;
edNewPwd: TEdit;
edNewPwdRepeat: TEdit;
Label1: TLabel;
Label2: TLabel;
lblNewPwdRepeat: TLabel;
procedure btnCancelClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure edNewPwdChange(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
frmChangePassword: TfrmChangePassword;
implementation
uses
UdmNetwork, UPackets, UEnums;
{$R *.lfm}
{ TfrmChangePassword }
procedure TfrmChangePassword.FormShow(Sender: TObject);
begin
edOldPwd.Text := '';
edNewPwd.Text := '';
edNewPwdRepeat.Text := '';
end;
procedure TfrmChangePassword.btnCancelClick(Sender: TObject);
begin
Close;
end;
procedure TfrmChangePassword.btnOKClick(Sender: TObject);
begin
dmNetwork.Send(TChangePasswordPacket.Create(edOldPwd.Text,
edNewPwd.Text));
end;
procedure TfrmChangePassword.edNewPwdChange(Sender: TObject);
var
pwdValid: Boolean;
begin
if edNewPwd.Text <> edNewPwdRepeat.Text then
begin
pwdValid := False;
lblNewPwdRepeat.Font.Color := clRed;
end else
begin
pwdValid := True;
lblNewPwdRepeat.Font.Color := clDefault;
end;
btnOK.Enabled := (Length(edNewPwd.Text) > 0) and pwdValid;
end;
end.

5468
Client/UfrmMain.lfm
View File

File diff suppressed because it is too large Load Diff

27
Client/UfrmMain.pas
View File

@ -103,6 +103,7 @@ type
lblY: TLabel;
lbClients: TListBox;
MainMenu1: TMainMenu;
mnuChangePassword: TMenuItem;
mnuWhiteBackground: TMenuItem;
mnuSecurityQuestion: TMenuItem;
mnuShowAnimations: TMenuItem;
@ -222,6 +223,7 @@ type
procedure lblChatHeaderCaptionClick(Sender: TObject);
procedure lblChatHeaderCaptionMouseEnter(Sender: TObject);
procedure lblChatHeaderCaptionMouseLeave(Sender: TObject);
procedure mnuChangePasswordClick(Sender: TObject);
procedure mnuAboutClick(Sender: TObject);
procedure mnuAccountControlClick(Sender: TObject);
procedure mnuDisconnectClick(Sender: TObject);
@ -407,7 +409,7 @@ uses
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmRegionControl,
Logging, LConvEncoding, LCLType, UfrmLightlevel;
Logging, LConvEncoding, LCLType, UfrmLightlevel, UfrmChangePassword;
type
TGLArrayf4 = array[0..3] of GLfloat;
@ -1417,6 +1419,11 @@ begin
lblChatHeaderCaption.Font.Underline := False;
end;
procedure TfrmMain.mnuChangePasswordClick(Sender: TObject);
begin
frmChangePassword.ShowModal;
end;
procedure TfrmMain.mnuAboutClick(Sender: TObject);
begin
frmAbout.ShowModal;
@ -3060,6 +3067,7 @@ var
i: Integer;
accessLevel: TAccessLevel;
accessChangedListener: TAccessChangedListener;
pwdChangeStatus: TPasswordChangeStatus;
begin
case ABuffer.ReadByte of
$01: //client connected
@ -3117,6 +3125,23 @@ begin
for accessChangedListener in FAccessChangedListeners.Reversed do
accessChangedListener(accessLevel);
end;
$08: //password change status
begin
pwdChangeStatus := TPasswordChangeStatus(ABuffer.ReadByte);
case pwdChangeStatus of
pcSuccess:
Messagedlg('Password Change', 'Your password has been changed', mtInformation, [mbOK], 0);
pcOldPwInvalid:
Messagedlg('Password Change', 'The old password is wrong.' + sLineBreak +
'Your password has NOT been changed.', mtWarning, [mbOK], 0);
pcNewPwInvalid:
Messagedlg('Password Change', 'The new password is not allowed.' + sLineBreak +
'Your password has NOT been changed.', mtWarning, [mbOK], 0);
pcIdentical:
Messagedlg('Password Change', 'The new password matched the old password.' + sLineBreak +
'Your password has NOT been changed.', mtWarning, [mbOK], 0);
end;
end;
end;
end;

1714
Imaging/ImagingBitmap.pas
View File

File diff suppressed because it is too large Load Diff

4354
Imaging/ImagingCanvases.pas
View File

File diff suppressed because it is too large Load Diff

1994
Imaging/ImagingClasses.pas
View File

File diff suppressed because it is too large Load Diff

490
Imaging/ImagingColors.pas
View File

@ -1,245 +1,245 @@
{
$Id: ImagingColors.pas 173 2009-09-04 17:05: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 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);
{ Converts RGB color to YCoCg.}
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
{ Converts YCoCg to RGB color.}
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
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 = 255 then
begin
C := 0;
M := 0;
Y := 0;
end
else
begin
C := ClampToByte(Round((C - K) / (255 - K) * 255));
M := ClampToByte(Round((M - K) / (255 - K) * 255));
Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
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 = 65535 then
begin
C := 0;
M := 0;
Y := 0;
end
else
begin
C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
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;
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
begin
// C and Delphi's SHR behaviour differs for negative numbers, use div instead.
Y := ClampToByte(( R + G shl 1 + B + 2) div 4);
Co := ClampToByte(( R shl 1 - B shl 1 + 2) div 4 + 128);
Cg := ClampToByte((-R + G shl 1 - B + 2) div 4 + 128);
end;
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
var
CoInt, CgInt: Integer;
begin
CoInt := Co - 128;
CgInt := Cg - 128;
R := ClampToByte(Y + CoInt - CgInt);
G := ClampToByte(Y + CgInt);
B := ClampToByte(Y - CoInt - CgInt);
end;
{
File Notes:
-- TODOS ----------------------------------------------------
- nothing now
-- 0.26.3 Changes/Bug Fixes ---------------------------------
- Added RGB<>YCoCg conversion functions.
- Fixed RGB>>CMYK conversions.
-- 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.
{
$Id: ImagingColors.pas 173 2009-09-04 17:05: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 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);
{ Converts RGB color to YCoCg.}
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
{ Converts YCoCg to RGB color.}
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
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 = 255 then
begin
C := 0;
M := 0;
Y := 0;
end
else
begin
C := ClampToByte(Round((C - K) / (255 - K) * 255));
M := ClampToByte(Round((M - K) / (255 - K) * 255));
Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
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 = 65535 then
begin
C := 0;
M := 0;
Y := 0;
end
else
begin
C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
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;
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
begin
// C and Delphi's SHR behaviour differs for negative numbers, use div instead.
Y := ClampToByte(( R + G shl 1 + B + 2) div 4);
Co := ClampToByte(( R shl 1 - B shl 1 + 2) div 4 + 128);
Cg := ClampToByte((-R + G shl 1 - B + 2) div 4 + 128);
end;
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
var
CoInt, CgInt: Integer;
begin
CoInt := Co - 128;
CgInt := Cg - 128;
R := ClampToByte(Y + CoInt - CgInt);
G := ClampToByte(Y + CgInt);
B := ClampToByte(Y - CoInt - CgInt);
end;
{
File Notes:
-- TODOS ----------------------------------------------------
- nothing now
-- 0.26.3 Changes/Bug Fixes ---------------------------------
- Added RGB<>YCoCg conversion functions.
- Fixed RGB>>CMYK conversions.
-- 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.

2
Imaging/ImagingComponents.pas
View File

@ -336,7 +336,7 @@ implementation
uses
{$IF Defined(LCL)}
{$IF Defined(LCLGTK2)}
GLib2, GDK2, GTK2, GTKDef, GTKProc,
GLib2, GDK2, GTK2, Gtk2Def, Gtk2Proc,
{$ELSEIF Defined(LCLGTK)}
GDK, GTK, GTKDef, GTKProc,
{$IFEND}

1728
Imaging/ImagingDds.pas
View File

File diff suppressed because it is too large Load Diff

1782
Imaging/ImagingExport.pas
View File

File diff suppressed because it is too large Load Diff

8576
Imaging/ImagingFormats.pas
View File

File diff suppressed because it is too large Load Diff

2478
Imaging/ImagingGif.pas
View File

File diff suppressed because it is too large Load Diff

1148
Imaging/ImagingIO.pas
View File

File diff suppressed because it is too large Load Diff

1194
Imaging/ImagingJpeg.pas
View File

File diff suppressed because it is too large Load Diff

5146
Imaging/ImagingNetworkGraphics.pas
View File

File diff suppressed because it is too large Load Diff

2040
Imaging/ImagingPortableMaps.pas
View File

File diff suppressed because it is too large Load Diff

1246
Imaging/ImagingTarga.pas
View File

File diff suppressed because it is too large Load Diff

998
Imaging/ImagingTypes.pas
View File

@ -1,499 +1,499 @@
{
$Id: ImagingTypes.pas 171 2009-09-02 01:34:19Z 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 = 26;
{ Current patch of Imaging.}
ImagingVersionPatch = 4;
{ 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;
{ Boolean option that specifies whether PNG images with more frames (APNG format)
are animated by Imaging (according to frame disposal/blend methods) or just
raw frames are loaded and sent to user (if you want to animate APNG yourself).
Default value is 1.}
ImagingPNGLoadAnimated = 27;
{ 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;
{ Boolean option that specifies whether GIF images with more frames
are animated by Imaging (according to frame disposal methods) or just
raw frames are loaded and sent to user (if you want to animate GIF yourself).
Default value is 1.
Raw frames are 256 color indexed images (ifIndex8), whereas
animated frames are always in 32bit ifA8R8G8B8 format (simplifies animating).}
ImagingGIFLoadAnimated = 56;
{ 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,
ifATI1N = 224,
ifATI2N = 225);
{ 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
-- 0.24.3 Changes/Bug Fixes ---------------------------------
- Added ifATI1N and ifATI2N image data formats.
-- 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.
{
$Id: ImagingTypes.pas 171 2009-09-02 01:34:19Z 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 = 26;
{ Current patch of Imaging.}
ImagingVersionPatch = 4;
{ 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;
{ Boolean option that specifies whether PNG images with more frames (APNG format)
are animated by Imaging (according to frame disposal/blend methods) or just
raw frames are loaded and sent to user (if you want to animate APNG yourself).
Default value is 1.}
ImagingPNGLoadAnimated = 27;
{ 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;
{ Boolean option that specifies whether GIF images with more frames
are animated by Imaging (according to frame disposal methods) or just
raw frames are loaded and sent to user (if you want to animate GIF yourself).
Default value is 1.
Raw frames are 256 color indexed images (ifIndex8), whereas
animated frames are always in 32bit ifA8R8G8B8 format (simplifies animating).}
ImagingGIFLoadAnimated = 56;
{ 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,
ifATI1N = 224,
ifATI2N = 225);
{ 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
-- 0.24.3 Changes/Bug Fixes ---------------------------------
- Added ifATI1N and ifATI2N image data formats.
-- 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.

28
Server/UAccount.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2008 Andreas Schneider
* Portions Copyright 2013 Andreas Schneider
*)
unit UAccount;
@ -37,7 +37,7 @@ type
{ TAccount }
TAccount = class(TObject, ISerializable, IInvalidate)
constructor Create(AOwner: IInvalidate; AName, APasswordHash: string;
constructor Create(AOwner: IInvalidate; AName, APassword: string;
AAccessLevel: TAccessLevel; ARegions: TStringList);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
destructor Destroy; override;
@ -58,7 +58,9 @@ type
property PasswordHash: string read FPasswordHash write SetPasswordHash;
property LastPos: TPoint read FLastPos write SetLastPos;
property Regions: TStringList read FRegions;
function CheckPassword(APassword: String): Boolean;
procedure Invalidate;
procedure UpdatePassword(APassword: String);
end;
{ TAccountList }
@ -79,17 +81,17 @@ type
implementation
uses
UCEDServer, UConfig;
UCEDServer, UConfig, md5;
{ TAccount }
constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string;
constructor TAccount.Create(AOwner: IInvalidate; AName, APassword: string;
AAccessLevel: TAccessLevel; ARegions: TStringList);
begin
inherited Create;
FOwner := AOwner;
FName := AName;
FPasswordHash := APasswordHash;
FPasswordHash := MD5Print(MD5String(APassword));
FAccessLevel := AAccessLevel;
if ARegions <> nil then
FRegions := ARegions
@ -154,11 +156,27 @@ begin
Invalidate;
end;
function TAccount.CheckPassword(APassword: String): Boolean;
var
testHash: String;
begin
//Since I want to change to PBKDF2 sometime, we compare strings instead
//of MD5Digest, so we can (later) check what type of hash the string has
//been created with.
testHash := MD5Print(MD5String(APassword));
Result := FPasswordHash = testHash;
end;
procedure TAccount.Invalidate;
begin
FOwner.Invalidate;
end;
procedure TAccount.UpdatePassword(APassword: String);
begin
PasswordHash := MD5Print(MD5String(APassword));
end;
procedure TAccount.Serialize(AElement: TDOMElement);
var
i: Integer;

10
Server/UAdminHandling.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2008 Andreas Schneider
* Portions Copyright 2013 Andreas Schneider
*)
unit UAdminHandling;
@ -88,7 +88,7 @@ var
implementation
uses
md5, UCEDServer, UPackets, UClientHandling;
UCEDServer, UPackets, UClientHandling;
procedure AdminBroadcast(AAccessLevel: TAccessLevel; APacket: TPacket);
var
@ -146,7 +146,7 @@ begin
if account <> nil then
begin
if password <> '' then
account.PasswordHash := MD5Print(MD5String(password));
account.UpdatePassword(password);
account.AccessLevel := accessLevel;
@ -181,8 +181,8 @@ begin
for i := 0 to regionCount - 1 do
regions.Add(ABuffer.ReadStringNull);
account := TAccount.Create(Config.Accounts, username,
MD5Print(MD5String(password)), accessLevel, regions);
account := TAccount.Create(Config.Accounts, username, password,
accessLevel, regions);
Config.Accounts.Add(account);
Config.Accounts.Invalidate;

8
Server/UCEDServer.pas
View File

@ -217,7 +217,7 @@ begin
try
buffer := ANetState.ReceiveQueue;
buffer.Position := 0;
while (buffer.Size >= 1) and ANetState.Socket.Connected do
while (buffer.Size >= 1) and (ANetState.Socket.ConnectionStatus = scConnected) do
begin
packetID := buffer.ReadByte;
packetHandler := PacketHandlers[packetID];
@ -268,7 +268,7 @@ begin
netState := TNetState(FTCPServer.Iterator.UserData);
if netState <> nil then
begin
if FTCPServer.Iterator.Connected then
if FTCPServer.Iterator.ConnectionStatus = scConnected then
begin
if (SecondsBetween(netState.LastAction, Now) > 120) then
begin
@ -326,7 +326,7 @@ begin
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if (netState <> nil) and (FTCPServer.Iterator.Connected) then
if (netState <> nil) and (FTCPServer.Iterator.ConnectionStatus = scConnected) then
begin
netState.SendQueue.Seek(0, soFromEnd);
netState.SendQueue.CopyFrom(APacket.Stream, 0);
@ -340,7 +340,7 @@ end;
procedure TCEDServer.Disconnect(ASocket: TLSocket);
begin
if ASocket.Connected then
if ASocket.ConnectionStatus = scConnected then
begin
ASocket.Disconnect;
//OnDisconnect(ASocket);

56
Server/UClientHandling.pas
View File

@ -71,6 +71,12 @@ type
constructor Create(AAccount: TAccount);
end;
{ TPasswordChangeStatusPacket }
TPasswordChangeStatusPacket = class(TPacket)
constructor Create(AResult: TPasswordChangeStatus);
end;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream;
@ -79,6 +85,8 @@ procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
procedure OnChangePasswordPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
procedure WriteAccountRestrictions(AStream: TEnhancedMemoryStream;
AAccount: TAccount);
@ -130,6 +138,44 @@ begin
TSetClientPosPacket.Create(account.LastPos));
end;
procedure OnChangePasswordPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
oldPwd, newPwd: String;
begin
oldPwd := ABuffer.ReadStringNull;
newPwd := ABuffer.ReadStringNull;
if ANetState.Account.CheckPassword(oldPwd) then
begin
//Check if the passwords actually differ. Changing them isn't allowed
//otherwise. Might be open for configuration, though.
if oldPwd <> newPwd then
begin
//Just a simple restriction to disallow too easy passwords.
//TODO: Configurable restrictions
if Length(newPwd) >= 4 then
begin
//Everything fine, update the password and report success.
ANetState.Account.UpdatePassword(newPwd);
CEDServerInstance.SendPacket(ANetState,
TPasswordChangeStatusPacket.Create(pcSuccess));
end else
begin
CEDServerInstance.SendPacket(ANetState,
TPasswordChangeStatusPacket.Create(pcNewPwInvalid));
end;
end else
begin
CEDServerInstance.SendPacket(ANetState,
TPasswordChangeStatusPacket.Create(pcIdentical));
end;
end else
begin
CEDServerInstance.SendPacket(ANetState,
TPasswordChangeStatusPacket.Create(pcOldPwInvalid));
end;
end;
procedure WriteAccountRestrictions(AStream: TEnhancedMemoryStream;
AAccount: TAccount);
var
@ -236,6 +282,15 @@ begin
WriteAccountRestrictions(FStream, AAccount);
end;
{ TPasswordChangeStatusPacket }
constructor TPasswordChangeStatusPacket.Create(AResult: TPasswordChangeStatus);
begin
inherited Create($0C, 0);
FStream.WriteByte($08);
FStream.WriteByte(Byte(AResult));
end;
{$WARNINGS OFF}
var
i: Integer;
@ -246,6 +301,7 @@ initialization
ClientPacketHandlers[$04] := TPacketHandler.Create(0, @OnUpdateClientPosPacket);
ClientPacketHandlers[$05] := TPacketHandler.Create(0, @OnChatMessagePacket);
ClientPacketHandlers[$06] := TPacketHandler.Create(0, @OnGotoClientPosPacket);
ClientPacketHandlers[$08] := TPacketHandler.Create(0, @OnChangePasswordPacket);
finalization
for i := 0 to $FF do
if ClientPacketHandlers[i] <> nil then

10
Server/UConfig.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2008 Andreas Schneider
* Portions Copyright 2013 Andreas Schneider
*)
unit UConfig;
@ -30,8 +30,8 @@ unit UConfig;
interface
uses
Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
UXmlHelper, UInterfaces, UEnums, URegions;
Classes, SysUtils, DOM, XMLRead, XMLWrite, Keyboard, UAccount, UXmlHelper,
UInterfaces, UEnums, URegions;
type
@ -292,8 +292,8 @@ begin
until stringValue <> '';
Write ('Password [hidden]: ');
password := QueryPassword;
FAccounts.Add(TAccount.Create(FAccounts, stringValue,
MD5Print(MD5String(password)), alAdministrator, nil));
FAccounts.Add(TAccount.Create(FAccounts, stringValue, password,
alAdministrator, nil));
FChanged := True;
end;

10
Server/UConnectionHandling.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2008 Andreas Schneider
* Portions Copyright 2013 Andreas Schneider
*)
unit UConnectionHandling;
@ -63,7 +63,7 @@ var
implementation
uses
md5, UCEDServer, UClientHandling, UPackets;
UCEDServer, UClientHandling, UPackets;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
@ -77,19 +77,19 @@ end;
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
username, passwordHash: string;
username, password: string;
account: TAccount;
netState: TNetState;
invalid: Boolean;
begin
username := ABuffer.ReadStringNull;
passwordHash := MD5Print(MD5String(ABuffer.ReadStringNull));
password := ABuffer.ReadStringNull;
account := Config.Accounts.Find(username);
if account <> nil then
begin
if account.AccessLevel > alNone then
begin
if account.PasswordHash = passwordHash then
if account.CheckPassword(password) then
begin
invalid := False;
CEDServerInstance.TCPServer.IterReset;

2
Server/UPackets.pas
View File

@ -139,7 +139,7 @@ begin
begin
subscriptions := CEDServerInstance.Landscape.BlockSubscriptions[ACoords[i].X, ACoords[i].Y];
subscriptions.Delete(ANetState);
subscriptions.Add(Integer(ANetState), ANetState);
subscriptions.Add(PtrInt(ANetState), ANetState);
if ANetState.Subscriptions.IndexOf(subscriptions) = -1 then
ANetState.Subscriptions.Add(subscriptions);
end;

13
Server/cedserver.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
@ -13,9 +13,9 @@
<VersionInfo>
<UseVersionInfo Value="True"/>
<MinorVersionNr Value="6"/>
<RevisionNr Value="3"/>
<RevisionNr Value="4"/>
<BuildNr Value="240"/>
<StringTable CompanyName="AKS DataBasis" ProductName="CentrED" InternalName="CentrED Server" LegalCopyright="(c) 2012 Andreas Schneider" ProductVersion="0.6.3" FileDescription="CentrED Server" OriginalFilename="cedserver.exe"/>
<StringTable CompanyName="AKS DataBasis" FileDescription="CentrED Server" InternalName="CentrED Server" LegalCopyright="(c) 2013 Andreas Schneider" OriginalFilename="cedserver.exe" ProductName="CentrED" ProductVersion="0.6.4"/>
</VersionInfo>
<BuildModes Count="3">
<Item1 Name="default" Default="True"/>
@ -69,7 +69,7 @@
</Item2>
<Item3 Name="Release Win32">
<MacroValues Count="1">
<Macro1 Name="LCLWidgetType" Value="win32"/>
<Macro2 Name="LCLWidgetType" Value="win32"/>
</MacroValues>
<CompilerOptions>
<Version Value="11"/>
@ -115,6 +115,10 @@
</Other>
</CompilerOptions>
</Item3>
<SharedMatrixOptions Count="2">
<Item1 ID="285940101796" Modes="Release Linux i686" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk2"/>
<Item2 ID="285439860087" Modes="Release Win32" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/>
</SharedMatrixOptions>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
@ -231,7 +235,6 @@
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>

6
UEnhancedMemoryStream.pas
View File

@ -118,7 +118,7 @@ var
length: Integer;
begin
Result := '';
buffer := Pointer(LongInt(Memory) + Position);
buffer := Pointer(PtrInt(Memory) + Position);
length := 0;
while (buffer[length] <> #0) and (length < (Size - Position)) do
begin
@ -138,7 +138,7 @@ var
length: Integer;
begin
Result := '';
buffer := Pointer(LongInt(FMemory) + FPosition);
buffer := Pointer(PtrInt(FMemory) + FPosition);
length := 0;
while (length < ALength) and (length < (FSize - (FPosition - FLockOffset))) do
begin
@ -158,7 +158,7 @@ var
length: Integer;
begin
Result := '';
buffer := Pointer(LongInt(FMemory) + FPosition);
buffer := Pointer(PtrInt(FMemory) + FPosition);
length := 0;
while (buffer^[length] <> 0) and (length < (FSize - (FPosition - FLockOffset))) do
begin

5
UEnums.pas
View File

@ -56,6 +56,11 @@ type
mrModified = 1);
TDeleteRegionStatus = (drNotFound = 0,
drDeleted = 1);
TPasswordChangeStatus = (pcSuccess = 0,
pcOldPwInvalid = 1,
pcNewPwInvalid = 2,
pcIdentical = 3);
function GetAccessLevelString(AAccessLevel: TAccessLevel): string;

BIN
bin/CentrED.dat
View File

Binary file not shown.

2
version.inc
View File

@ -1,2 +1,2 @@
const
ProtocolVersion = 6;
ProtocolVersion = 7;