{ ------------------------------------------------------------- }
{ Purpose : Next Standard 6                                     }
{ By      : Bojan Nikolic                                       }
{ For     : BergSoft                                            }
{ ------------------------------------------------------------- }
{ Copyright (C) BergSoft.net 2011. All Rights Reserved.         }
{ ------------------------------------------------------------- }
{$I NxSuite6.inc}
{$I NxSettings6.inc}

unit NxClasses6;

interface

uses
  { Standard }
  Classes, Types, Windows, SysUtils, Graphics, Controls,
  { Next Standard 6 }
  NxConsts6, NxIntf6, NxTypes6;

type
  { Edit Types }
  TNxEditOptions = set of (edPaste, edTyping);
  TNxNumericEditOptions = set of (ednDecimals, ednSigns);
  TNxMultiLineEditOptions = set of (meWordWrap);

  TNxDisplayMode = (dmImageOnly, dmTextAndImage, dmTextOnly, dmNone);

{$IFNDEF STYLE_SERVICES}
  // Delphi Styles added in XE2
  TStyleElements = set of (seFont, seClient, seBorder);
{$ENDIF}

{$IFNDEF VERTICAL_ALIGNMENT}
  // Added in Delphi 2005
  TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter);
{$ENDIF}

{$IFDEF TNTUNICODE}
  TChar = WideChar;
  TString = WideString;
  TNxStrings = TTntStrings;
  TWideStringList = TTntStringList;
{$ELSE}
  TChar = Char;
  TString = string;
  TNxStrings = TStrings;
  TWideStringList = TStringList;
{$ENDIF}

  TNxCompareFunc = function (Cell1, Cell2: INxBase): Boolean of object;

  { TNxFormatSettings }

  TNxFormatSettings = class
  private
    function GetDateSeparator: Char;
    function GetDecimalSeparator: Char;
    function GetListSeparator: Char;
    function GetLongDayNames(Index: Integer): string;
    function GetLongMonthNames(Index: Integer): string;
    function GetLongTimeFormat: string;
    function GetShortDayNames(Index: Integer): string;
    function GetTimeSeparator: Char;
  public
    property DateSeparator: Char read GetDateSeparator;
    property DecimalSeparator: Char read GetDecimalSeparator;
    property ListSeparator: Char read GetListSeparator;
    property LongDayNames[Index: Integer]: string read GetLongDayNames;
    property LongMonthNames[Index: Integer]: string read GetLongMonthNames;
    property LongTimeFormat: string read GetLongTimeFormat;
    property ShortDayNames[Index: Integer]: string read GetShortDayNames;
    property TimeSeparator: Char read GetTimeSeparator;
  end;

{$IFNDEF PADDING}
  TMarginSize = 0..MaxInt;

  TMargins = class(TPersistent)
  private
    FLeft, FTop, FRight, FBottom: TMarginSize;
    FOnChange: TNotifyEvent;
    procedure SetMargin(Index: Integer; Value: TMarginSize);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure Change; virtual;
    class procedure InitDefaults(Margins: TMargins); virtual;
  public
    constructor Create(Control: TControl); virtual;
    procedure SetBounds(ALeft, ATop, ARight, ABottom: Integer);
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Left: TMarginSize index 0 read FLeft write SetMargin default 3;
    property Top: TMarginSize index 1 read FTop write SetMargin default 3;
    property Right: TMarginSize index 2 read FRight write SetMargin default 3;
    property Bottom: TMarginSize index 3 read FBottom write SetMargin default 3;
  end;

  TPadding = class(TMargins)
  protected
    class procedure InitDefaults(Margins: TMargins); override;
  published
    property Left default 0;
    property Top default 0;
    property Right default 0;
    property Bottom default 0;
  end;
{$ENDIF}

  { TNxStringList }

  TNxStringList = class(TWideStringList);

  TNxHorzPadding = class(TPersistent)
  private
    FLeft: Integer;
    FOnChanged: TNotifyEvent;
    FRight: Integer;
    procedure SetLeft(const Value: Integer);
    procedure SetRight(const Value: Integer);
  protected
    procedure DoChanged; dynamic;
  public
    constructor Create; virtual;
  published
    property Left: Integer read FLeft write SetLeft default pdHorz;
    property Right: Integer read FRight write SetRight default pdHorz;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  end;

  { TNxPadding }

  TNxPadding = class(TNxHorzPadding)
  private
    FBottom: Integer;
    FTop: Integer;
    procedure SetBottom(const Value: Integer);
    procedure SetTop(const Value: Integer);
    function GetSize: TSize;
  public
    constructor Create; override;
    { Virtual Methods }
    function PaddingToRect(Source: TRect): TRect;
    procedure SetBounds(ALeft, ATop, ARight, ABottom: Integer); overload;
    procedure SetBounds(Horz, Vert: Integer); overload;
    procedure SetBounds(Value: Integer); overload;
  published
    property Bottom: Integer read FBottom write SetBottom default pdVert;
    property Top: Integer read FTop write SetTop default pdVert;
    property Size: TSize read GetSize;
  end;

  { TNxNotifyPersistent6 }

  TNxNotifyPersistent6 = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
  protected
    procedure DoChange; dynamic;
  public
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TNxLocation }

  TNxLocation = class(TPersistent)
  private
    FX: Integer;
    FY: Integer;
    FOnChange: TNotifyEvent;
    { Property Accessors }
    procedure SetX(const Value: Integer);
    procedure SetY(const Value: Integer);
  protected
    procedure DoChange; dynamic;
  public
    constructor Create(AOwner: TComponent); virtual;
    procedure Assign(Source: TPersistent); override;
  published
    property X: Integer read FX write SetX;
    property Y: Integer read FY write SetY;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TNxSize }

  TNxSize = class(TPersistent)
  private
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
    function GetAsSize: TSize;
  protected
    FHeight: Integer;
    FOnChange: TNotifyEvent;
    FWidth: Integer;
    procedure DoChange; dynamic;
  public
    constructor Create(AWidth, AHeight: Integer); virtual;
    procedure Assign(Source: TPersistent); override;
    property AsSize: TSize read GetAsSize;
  published
    property Height: Integer read FHeight write SetHeight default 0;
    property Width: Integer read FWidth write SetWidth default 0;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  procedure Arrange(var LowValue: Integer; var HighValue: Integer);

  { Public Functions }
  function DeleteLeadingZeros(const Value: string): string;

  function CenterInRect(Container: TRect; const Width, Height: Integer): TPoint; overload;
  function CenterInRect(Container: TRect; const Height: Integer): TPoint; overload;
  function GetComponent(Intf: IInterface): TComponent;
  procedure Down(const NewValue: Integer; var Value: Integer);
  function EmptyPoint: TPoint;
  procedure InvalidateControl(Handle: THandle; InvalidationRect: TRect);
  function NumberKey(Key: Word): Integer;
  procedure OffsetPoint(var Point: TPoint; Delta: TPoint); overload;
  procedure OffsetPoint(var Point: TPoint; DeltaX, DeltaY: Integer); overload;
  procedure PaddingPoint(var Point: TPoint; const Padding: TNxPadding);
  procedure PaddingRect(var Rect: TRect; const Padding: TNxPadding); overload;
  procedure PaddingRect(var Rect: TRect; const Padding: TPadding); overload;
  function RectIntersect(Rect1, Rect2: TRect): Boolean;
  procedure SetPadding(var Rect: TRect; Padding: TPadding);
  function Size(cx, cy: Integer): TSize;
  procedure Up(const NewValue: Integer; var Value: Integer);

  { Debug }
  procedure WritelnDebug(S: string);

  { Types }
  function IsEqual(Point1, Point2: TPoint): Boolean; overload;
  function IsSet(Point: TPoint): Boolean; overload;
  function IsSet(Size: TSize): Boolean; overload;
  procedure Unset(var Point: TPoint); overload;
  procedure Unset(var Rect: TRect); overload;
  procedure Unset(var Size: TSize); overload;

{$IFNDEF CHARINSET}
  function CharInSet(C: Char; const CharSet: TSysCharSet): Boolean;
{$ENDIF}

var
  LocalSettings: TNxFormatSettings;
  UnicodeSupported: Boolean;

implementation

uses
  { Standard }
  Math, TypInfo,
  { Next Standard }
  NxGraphics6;

procedure Arrange(var LowValue: Integer; var HighValue: Integer);
var
  t: Integer;
begin
  if LowValue > HighValue then
  begin
    t := LowValue;
    LowValue := HighValue;
    HighValue := t;
  end;
end;

function DeleteLeadingZeros(const Value: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(Value) do
  begin
    if Value[i] <> '0' then
    begin
      Result := Copy(Value, i, MaxInt);
      Exit;
    end;
  end;
end;

function CenterInRect(Container: TRect; const Height: Integer): TPoint;
begin
  Result.Y := CenterPoint(Container).Y - Height div 2;
end;

function CenterInRect(Container: TRect; const Width, Height: Integer): TPoint;
begin
  Result.X := CenterPoint(Container).X - Width div 2;
  Result.Y := CenterPoint(Container).Y - Height div 2;
end;

function GetComponent(Intf: IInterface): TComponent;
{$IFNDEF INTERFACES}
var
  Ref: IInterfaceComponentReference;
{$ENDIF}
begin
{$IFNDEF INTERFACES}
  if Supports(Intf, IInterfaceComponentReference, Ref)
    then Result := Ref.GetComponent
  else
    raise EAccessViolation.CreateFmt('Interface not supported', []);
{$ELSE}
  Result := TComponent(Intf);
{$ENDIF}
end;

procedure Down(const NewValue: Integer; var Value: Integer);
begin
  if NewValue < Value then Value := NewValue;
end;

function EmptyPoint: TPoint;
begin
  Result := Point(-1, -1);
end;

function IsEqual(Point1, Point2: TPoint): Boolean;
begin
  Result := (Point1.X = Point2.X) and (Point1.Y = Point2.Y);
end;

procedure InvalidateControl(Handle: THandle; InvalidationRect: TRect);
begin
{$IFDEF UNSAFE}
  Windows.InvalidateRect(Handle, @InvalidationRect, False);
{$ELSE}
  Windows.InvalidateRect(Handle, InvalidationRect, False);
{$ENDIF}
end;

function IsSet(Point: TPoint): Boolean;
begin
  Result := (Point.X <> -1) or (Point.Y <> -1);
end;

function IsSet(Size: TSize): Boolean;
begin
  Result := (Size.cx <> 0) or (Size.cy <> 0);
end;

function NumberKey(Key: Word): Integer;
begin
  if Key in [48..57] then
  begin
    Result := Key - 48;
  end else Result := -1
end;

procedure OffsetPoint(var Point: TPoint; Delta: TPoint); overload;
begin
  Inc(Point.X, Delta.X);
  Inc(Point.Y, Delta.Y);
end;

procedure OffsetPoint(var Point: TPoint; DeltaX, DeltaY: Integer);
begin
  Inc(Point.X, DeltaX);
  Inc(Point.Y, DeltaY);
end;

procedure PaddingPoint(var Point: TPoint; const Padding: TNxPadding);
begin
  with Point do
  begin
    Inc(X, Padding.Left);
    Inc(Y, Padding.Top);
  end;
end;

procedure PaddingRect(var Rect: TRect; const Padding: TNxPadding);
begin
  with Rect do
  begin
    Inc(Left, Padding.Left);
    Inc(Top, Padding.Top);
    Dec(Right, Padding.Right);
    Dec(Bottom, Padding.Bottom);
  end;
end;

procedure PaddingRect(var Rect: TRect; const Padding: TPadding); overload;
begin
  with Rect do
  begin
    Inc(Left, Padding.Left);
    Inc(Top, Padding.Top);
    Dec(Right, Padding.Right);
    Dec(Bottom, Padding.Bottom);
  end;
end;

function RectIntersect(Rect1, Rect2: TRect): Boolean;
begin
  Result := not((Rect1.Right < Rect2.Left) or (Rect1.Left > Rect2.Right) or
    (Rect1.Bottom < Rect2.Top) or (Rect1.Top > Rect2.Bottom));
end;

procedure SetPadding(var Rect: TRect; Padding: TPadding);
begin
  Inc(Rect.Left, Padding.Left);
  Inc(Rect.Top, Padding.Top);
  Dec(Rect.Right, Padding.Right);
  Dec(Rect.Bottom, Padding.Bottom);
end;

function Size(cx, cy: Integer): TSize;
begin
  Result.cx := cx;
  Result.cy := cy;
end;

procedure Unset(var Point: TPoint); overload;
begin
  Point := Types.Point(-1, -1);
end;

procedure Unset(var Rect: TRect); overload;
begin
  Rect := Types.Rect(0, 0, 0, 0);
end;

procedure Unset(var Size: TSize); overload;
begin
  Size.cx := 0;
  Size.cy := 0;
end;

procedure Up(const NewValue: Integer; var Value: Integer);
begin
  if NewValue > Value then Value := NewValue;
end;

{$IFNDEF CHARINSET}
function CharInSet(C: Char; const CharSet: TSysCharSet): Boolean;
begin
  Result := C in CharSet;
end;
{$ENDIF}

procedure WritelnDebug(S: string);
begin
{$IFDEF DEBUG_WRITE}
  OutputDebugString(PChar(S));
{$ENDIF}
end;

{ TNxFormatSettings }

function TNxFormatSettings.GetDateSeparator: Char;
begin
{$IFDEF FORMAT_SETTINGS}
  Result := FormatSettings.DateSeparator;
{$ELSE}
  Result := SysUtils.DateSeparator;
{$ENDIF}
end;

function TNxFormatSettings.GetDecimalSeparator: Char;
begin
{$IFDEF FORMAT_SETTINGS}
  Result := FormatSettings.DecimalSeparator;
{$ELSE}
  Result := SysUtils.DecimalSeparator;
{$ENDIF}
end;

function TNxFormatSettings.GetListSeparator: Char;
begin
{$IFDEF FORMAT_SETTINGS}
  Result := FormatSettings.ListSeparator;
{$ELSE}
  Result := SysUtils.ListSeparator;
{$ENDIF}
end;

function TNxFormatSettings.GetLongDayNames(Index: Integer): string;
begin
{$IFDEF FORMAT_SETTINGS}
  Result := FormatSettings.LongDayNames[Index];
{$ELSE}
  Result := SysUtils.LongDayNames[Index];
{$ENDIF}
end;

function TNxFormatSettings.GetLongMonthNames(Index: Integer): string;
begin
{$IFDEF FORMAT_SETTINGS}
  Result := FormatSettings.LongMonthNames[Index];
{$ELSE}
  Result := SysUtils.LongMonthNames[Index];
{$ENDIF}
end;

function TNxFormatSettings.GetLongTimeFormat: string;
begin
{$IFDEF FORMAT_SETTINGS}
  Result := FormatSettings.LongTimeFormat;
{$ELSE}
  Result := SysUtils.LongTimeFormat;
{$ENDIF}
end;

function TNxFormatSettings.GetShortDayNames(Index: Integer): string;
begin

end;

function TNxFormatSettings.GetTimeSeparator: Char;
begin
{$IFDEF FORMAT_SETTINGS}
  Result := FormatSettings.TimeSeparator;
{$ELSE}
  Result := SysUtils.TimeSeparator;
{$ENDIF}
end;

{ TNxHorzPadding }

constructor TNxHorzPadding.Create;
begin
  FLeft := pdHorz;
  FRight := pdHorz;
end;

procedure TNxHorzPadding.DoChanged;
begin
  if Assigned(FOnChanged) then FOnChanged(Self);
end;

procedure TNxHorzPadding.SetLeft(const Value: Integer);
begin
  FLeft := Value;
  DoChanged;
end;

procedure TNxHorzPadding.SetRight(const Value: Integer);
begin
  FRight := Value;
  DoChanged;
end;

{ TNxPadding }

constructor TNxPadding.Create;
begin
  inherited;
  FBottom := pdVert;
  FTop := pdVert;
end;

function TNxPadding.GetSize: TSize;
begin
  with Result do
  begin
    cx := FLeft + FRight;
    cy := FTop + FBottom;
  end;
end;

function TNxPadding.PaddingToRect(Source: TRect): TRect;
begin
  Result := Source;

  { Adjust }
  Inc(Result.Left, Left);
  Inc(Result.Top, Top);
  Dec(Result.Right, Right);
  Dec(Result.Bottom, Bottom);
end;

procedure TNxPadding.SetBottom(const Value: Integer);
begin
  FBottom := Value;
  DoChanged;
end;

procedure TNxPadding.SetBounds(Value: Integer);
begin
  SetBounds(Value, Value, Value, Value);
end;

procedure TNxPadding.SetBounds(Horz, Vert: Integer);
begin
  SetBounds(Horz, Vert, Horz, Vert);
end;

procedure TNxPadding.SetBounds(ALeft, ATop, ARight, ABottom: Integer);
begin
  FLeft := ALeft;
  FTop := ATop;
  FRight := ARight;
  FBottom := ABottom;
end;

procedure TNxPadding.SetTop(const Value: Integer);
begin
  FTop := Value;
  DoChanged;
end;

{$IFNDEF PADDING}
{ TMargins }

procedure TMargins.AssignTo(Dest: TPersistent);
begin
  if Dest is TMargins then
    with TMargins(Dest) do
    begin
      FLeft := Self.FLeft;
      FTop := Self.FTop;
      FRight := Self.FRight;
      FBottom := Self.FBottom;
      Change;
    end
  else
    inherited;
end;

procedure TMargins.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

constructor TMargins.Create(Control: TControl);
begin
  inherited Create;
  InitDefaults(Self);
end;

class procedure TMargins.InitDefaults(Margins: TMargins);
begin
  with Margins do
  begin
    FLeft := 3;
    FRight := 3;
    FTop := 3;
    FBottom := 3;
  end;
end;

procedure TMargins.SetBounds(ALeft, ATop, ARight, ABottom: Integer);
begin
  if (FLeft <> ALeft) or (FTop <> ATop) or (FRight <> ARight) or (FBottom <> ABottom) then
  begin
    FLeft := ALeft;
    FTop := ATop;
    FRight := ARight;
    FBottom := ABottom;
    Change;
  end;
end;

procedure TMargins.SetMargin(Index: Integer; Value: TMarginSize);
begin
  case Index of
    0:
      if Value <> FLeft then
      begin
        FLeft := Value;
        Change;
      end;
    1:
      if Value <> FTop then
      begin
        FTop := Value;
        Change;
      end;
    2:
      if Value <> FRight then
      begin
        FRight := Value;
        Change;
      end;
    3:
      if Value <> FBottom then
      begin
        FBottom := Value;
        Change;
      end;
  end;
end;

{ TPadding }

class procedure TPadding.InitDefaults(Margins: TMargins);
begin
  { Zero initialization is sufficient here }
end;
{$ENDIF}

{ TNxNotifyPersistent6 }

procedure TNxNotifyPersistent6.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

{ TNxLocation }

procedure TNxLocation.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TNxLocation then
  begin
    X := TNxLocation(Source).X;
    Y := TNxLocation(Source).Y;
  end;
end;

constructor TNxLocation.Create(AOwner: TComponent);
begin
  FX := 0;
  FY := 0;
end;

procedure TNxLocation.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TNxLocation.SetX(const Value: Integer);
begin
  if Value <> FX then
  begin
    FX := Value;
    DoChange;
  end;
end;

procedure TNxLocation.SetY(const Value: Integer);
begin
  if Value <> FY then
  begin
    FY := Value;
    DoChange;
  end;
end;

{ TNxSize }

procedure TNxSize.Assign(Source: TPersistent);
begin
  inherited;
  if Assigned(Source) then
  begin
    FHeight := TNxSize(Source).Height;
    FOnChange := TNxSize(Source).OnChange;
    FWidth := TNxSize(Source).Height;
  end;
end;

constructor TNxSize.Create(AWidth, AHeight: Integer);
begin
  FHeight := AHeight;
  FWidth := AWidth;
end;

procedure TNxSize.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TNxSize.GetAsSize: TSize;
begin
  Result := Size(FWidth, FHeight);
end;

procedure TNxSize.SetHeight(const Value: Integer);
begin
  if Value <> FHeight then
  begin
    FHeight := Value;
    DoChange;
  end;
end;

procedure TNxSize.SetWidth(const Value: Integer);
begin
  if Value <> FWidth then
  begin
    FWidth := Value;
    DoChange;
  end;
end;

initialization
  UnicodeSupported := (Win32Platform = VER_PLATFORM_WIN32_NT);

  LocalSettings := TNxFormatSettings.Create;

finalization
  LocalSettings.Free;

end.

