Стартовый пул

RXLib/.svn/pristine/01/01206f37f41f9e2bdb1922f4942a5e535c9d6004.svn-base

@@ -0,0 +1,356 @@
+{ rxtbrsetup unit
+
+  Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
+  original conception from rx library for Delphi (c)
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit rxtbrsetup;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
+  rxtoolbar, StdCtrls, ComCtrls, ExtCtrls, ButtonPanel;
+
+type
+
+  { TToolPanelSetupForm }
+
+  TToolPanelSetupForm = class(TForm)
+    BitBtn3: TBitBtn;
+    BitBtn4: TBitBtn;
+    BitBtn5: TBitBtn;
+    BitBtn6: TBitBtn;
+    ButtonPanel1: TButtonPanel;
+    cbShowHint: TCheckBox;
+    cbTransp: TCheckBox;
+    cbFlatBtn: TCheckBox;
+    cbShowCaption: TCheckBox;
+    Label1: TLabel;
+    Label2: TLabel;
+    ListBtnAvaliable: TListBox;
+    ListBtnVisible: TListBox;
+    PageControl1: TPageControl;
+    Panel1: TPanel;
+    Panel2: TPanel;
+    RadioGroup1: TRadioGroup;
+    RadioGroup2: TRadioGroup;
+    TabSheet1: TTabSheet;
+    TabSheet2: TTabSheet;
+    procedure BitBtn3Click(Sender: TObject);
+    procedure BitBtn4Click(Sender: TObject);
+    procedure BitBtn5Click(Sender: TObject);
+    procedure BitBtn6Click(Sender: TObject);
+    procedure CheckBox1Change(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormResize(Sender: TObject);
+    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
+      ARect: TRect; State: TOwnerDrawState);
+    procedure ListBtnAvaliableClick(Sender: TObject);
+    procedure cbShowCaptionChange(Sender: TObject);
+    procedure ListBtnVisibleDblClick(Sender: TObject);
+  private
+    procedure FillItems(List:TStrings; AVisible:boolean);
+    procedure UpdateStates;
+    procedure Localize;
+  public
+    FToolPanel:TToolPanel;
+    constructor CreateSetupForm(AToolPanel:TToolPanel);
+  end; 
+
+var
+  ToolPanelSetupForm: TToolPanelSetupForm;
+
+implementation
+uses rxlclutils, ActnList, rxboxprocs, rxconst, LCLProc, rxShortCutUnit;
+
+{$R *.lfm}
+
+type
+  THackToolPanel = class(TToolPanel);
+{ TToolPanelSetupForm }
+
+procedure TToolPanelSetupForm.FormDestroy(Sender: TObject);
+begin
+  if Assigned(FToolPanel) then
+  begin
+    THackToolPanel(FToolPanel).SetCustomizing(false);
+    THackToolPanel(FToolPanel).FCustomizer:=nil;
+  end;
+end;
+
+procedure TToolPanelSetupForm.FormResize(Sender: TObject);
+begin
+  ListBtnVisible.Width:=BitBtn6.Left - 4 - ListBtnVisible.Left;
+  ListBtnAvaliable.Left:=BitBtn6.Left + BitBtn6.Width + 4;
+  ListBtnAvaliable.Width:=Width - ListBtnAvaliable.Left - 4;
+  Label1.Left:=ListBtnAvaliable.Left;
+end;
+
+procedure TToolPanelSetupForm.ListBox1DrawItem(Control: TWinControl;
+  Index: Integer; ARect: TRect; State: TOwnerDrawState);
+var
+  Offset:integer;
+  P:TToolbarItem;
+  BtnRect:TRect;
+  Cnv:TCanvas;
+  C: TColor;
+  S: String;
+begin
+  Cnv:=(Control as TListBox).Canvas;
+  C:=Cnv.Brush.Color;
+  Cnv.FillRect(ARect);       { clear the rectangle }
+  P:=TToolbarItem((Control as TListBox).Items.Objects[Index]);
+  if Assigned(P) then
+  begin
+    if Assigned(FToolPanel.ImageList) and Assigned(P.Action) then
+    begin
+      if (P.Action is TCustomAction) and
+         (TCustomAction(P.Action).ImageIndex>-1) and
+         (TCustomAction(P.Action).ImageIndex < FToolPanel.ImageList.Count) then
+      begin
+        Offset := 2;
+        BtnRect.Top:=ARect.Top + 2;
+        BtnRect.Left:=ARect.Left + Offset;
+        BtnRect.Right:=BtnRect.Left + FToolPanel.BtnWidth;
+        BtnRect.Bottom:=BtnRect.Top + FToolPanel.BtnHeight;
+        Cnv.Brush.Color := clBtnFace;
+        Cnv.FillRect(BtnRect);
+        DrawButtonFrame(Cnv, BtnRect, false, false);
+        FToolPanel.ImageList.Draw(Cnv, BtnRect.Left + (FToolPanel.BtnWidth - FToolPanel.ImageList.Width) div 2,
+                                       BtnRect.Top + (FToolPanel.BtnHeight - FToolPanel.ImageList.Height) div 2,
+                                       TCustomAction(P.Action).ImageIndex, True);
+        Offset:=BtnRect.Right;
+      end;
+      Offset := Offset + 6;
+      Cnv.Brush.Color:=C;
+      Cnv.TextOut(ARect.Left + Offset, (ARect.Top + ARect.Bottom  - Cnv.TextHeight('Wg')) div 2, TCustomAction(P.Action).Caption);  { display the text }
+      if (P.Action is TAction) then
+        if TAction(P.Action).ShortCut <> 0 then
+        begin
+          S:=ShortCutToText(TAction(P.Action).ShortCut);
+          if S<> '' then
+            Cnv.TextOut(ARect.Right - Cnv.TextWidth(S) - 2, (ARect.Top + ARect.Bottom  - Cnv.TextHeight('Wg')) div 2, S);  { display the shortut caption }
+        end;
+    end;
+  end;
+end;
+
+procedure TToolPanelSetupForm.ListBtnAvaliableClick(Sender: TObject);
+begin
+  with (Sender as TListBox) do
+  begin
+    if (ItemIndex>-1) and (ItemIndex<Items.Count) then
+    begin
+      Panel1.Caption:=TCustomAction(TToolbarItem(Items.Objects[ItemIndex]).Action).Hint;
+      if Sender = ListBtnVisible then
+        cbShowCaption.Checked:=TToolbarItem(Items.Objects[ItemIndex]).ShowCaption;
+    end;
+  end;
+  UpdateStates;
+end;
+
+procedure TToolPanelSetupForm.cbShowCaptionChange(Sender: TObject);
+begin
+  if (ListBtnVisible.ItemIndex>-1) and (ListBtnVisible.ItemIndex<ListBtnVisible.Items.Count) then
+    TToolbarItem(ListBtnVisible.Items.Objects[ListBtnVisible.ItemIndex]).ShowCaption:=cbShowCaption.Checked;
+end;
+
+procedure TToolPanelSetupForm.ListBtnVisibleDblClick(Sender: TObject);
+var
+  Act: TBasicAction;
+  A: TShortCut;
+begin
+  if FToolPanel.CustomizeShortCut then
+  if (TListBox(Sender).ItemIndex>-1) and (TListBox(Sender).ItemIndex<TListBox(Sender).Items.Count) then
+  begin
+    Act:=TToolbarItem(TListBox(Sender).Items.Objects[TListBox(Sender).ItemIndex]).Action;
+    if Act is TCustomAction then
+    begin
+      A:=TCustomAction(Act).ShortCut;
+      Hide;
+      if RxSelectShortCut(A) then
+      begin
+        TCustomAction(Act).ShortCut:=A;
+        TListBox(Sender).Invalidate;
+      end;
+      Show;
+    end;
+  end;
+end;
+
+procedure TToolPanelSetupForm.FillItems(List: TStrings; AVisible: boolean);
+var
+  i, p:integer;
+begin
+  List.Clear;
+  for i:=0 to FToolPanel.Items.Count - 1 do
+  begin
+    if (FToolPanel.Items[i].Visible = AVisible) and Assigned(FToolPanel.Items[i].Action) then
+    begin
+      P:=List.Add(FToolPanel.Items[i].Action.Name);
+      List.Objects[P]:=FToolPanel.Items[i];
+    end;
+  end;
+end;
+
+procedure TToolPanelSetupForm.UpdateStates;
+var
+  i:integer;
+begin
+  for I:=0 to ListBtnVisible.Items.Count - 1 do
+    TToolbarItem(ListBtnVisible.Items.Objects[i]).Visible:=true;
+
+  for I:=0 to ListBtnAvaliable.Items.Count - 1 do
+    TToolbarItem(ListBtnAvaliable.Items.Objects[i]).Visible:=false;
+    
+  BitBtn6.Enabled:=ListBtnVisible.Items.Count>0;
+  BitBtn5.Enabled:=ListBtnVisible.Items.Count>0;
+  cbShowCaption.Enabled:=(ListBtnVisible.Items.Count>0) and (ListBtnVisible.ItemIndex>=0);
+
+  BitBtn4.Enabled:=ListBtnAvaliable.Items.Count>0;
+  BitBtn3.Enabled:=ListBtnAvaliable.Items.Count>0;
+
+  cbFlatBtn.Checked:=tpFlatBtns in FToolPanel.Options;
+end;
+
+procedure TToolPanelSetupForm.Localize;
+begin
+  Caption:=sToolPanelSetup;
+  TabSheet1.Caption:=sVisibleButtons;
+  TabSheet2.Caption:=sOptions;
+  Label2.Caption:=sVisibleButtons;
+  Label2.Caption:=sVisibleButtons;
+  Label1.Caption:=sAvaliableButtons;
+  cbShowCaption.Caption:=sShowCaption;
+  RadioGroup2.Caption:=sToolBarStyle;
+  RadioGroup2.Items.Clear;
+  RadioGroup2.Items.Add(sToolBarStyle1);
+  RadioGroup2.Items.Add(sToolBarStyle2);
+  RadioGroup2.Items.Add(sToolBarStyle3);
+  cbFlatBtn.Caption:=sFlatButtons;
+  cbTransp.Caption:=sTransparent;
+  cbShowHint.Caption:=sShowHint;
+  RadioGroup1.Caption:=sButtonAlign;
+  RadioGroup1.Items.Clear;
+  RadioGroup1.Items.Add(sButtonAlign1);
+  RadioGroup1.Items.Add(sButtonAlign2);
+  RadioGroup1.Items.Add(sButtonAlign3);
+end;
+
+procedure TToolPanelSetupForm.FormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  CloseAction:=caFree;
+end;
+
+procedure TToolPanelSetupForm.CheckBox1Change(Sender: TObject);
+var
+  tpo:TToolPanelOptions;
+begin
+  tpo:=FToolPanel.Options;
+  if cbTransp.Checked then
+    tpo:=tpo + [tpTransparentBtns]
+  else
+    tpo:=tpo - [tpTransparentBtns];
+
+  FToolPanel.ToolBarStyle:=TToolBarStyle(RadioGroup2.ItemIndex);
+
+  if cbFlatBtn.Checked then
+    tpo:=tpo + [tpFlatBtns]
+  else
+    tpo:=tpo - [tpFlatBtns];
+
+  FToolPanel.ShowHint:=cbShowHint.Checked;
+  FToolPanel.Options:=tpo;
+  
+  FToolPanel.ButtonAllign:=TToolButtonAllign(RadioGroup1.ItemIndex);
+  cbFlatBtn.Checked:=tpFlatBtns in FToolPanel.Options;
+end;
+
+procedure TToolPanelSetupForm.BitBtn4Click(Sender: TObject);
+begin
+  BoxMoveSelectedItems(ListBtnAvaliable, ListBtnVisible);
+  UpdateStates;
+end;
+
+procedure TToolPanelSetupForm.BitBtn3Click(Sender: TObject);
+begin
+  BoxMoveAllItems(ListBtnAvaliable, ListBtnVisible);
+  UpdateStates;
+end;
+
+procedure TToolPanelSetupForm.BitBtn5Click(Sender: TObject);
+begin
+  BoxMoveSelectedItems(ListBtnVisible, ListBtnAvaliable);
+  UpdateStates;
+end;
+
+procedure TToolPanelSetupForm.BitBtn6Click(Sender: TObject);
+begin
+  BoxMoveAllItems(ListBtnVisible, ListBtnAvaliable);
+  UpdateStates;
+end;
+
+constructor TToolPanelSetupForm.CreateSetupForm(AToolPanel: TToolPanel);
+begin
+  inherited Create(AToolPanel);
+  Localize;
+  PageControl1.ActivePageIndex:=0;
+  FormResize(nil);
+  FToolPanel:=AToolPanel;
+
+
+  cbFlatBtn.Checked:=tpFlatBtns in FToolPanel.Options;
+  cbTransp.Checked:=tpTransparentBtns in FToolPanel.Options;
+  cbShowHint.Checked:=FToolPanel.ShowHint;
+
+  ListBtnAvaliable.ItemHeight:=FToolPanel.BtnHeight + 4;
+  ListBtnVisible.ItemHeight:=FToolPanel.BtnHeight + 4;
+
+  FillItems(ListBtnVisible.Items, true);
+  FillItems(ListBtnAvaliable.Items, false);
+
+  RadioGroup1.ItemIndex:=Ord(FToolPanel.ButtonAllign);
+  RadioGroup2.ItemIndex:=Ord(FToolPanel.ToolBarStyle);
+
+  UpdateStates;
+
+  cbFlatBtn.OnChange:=@CheckBox1Change;
+  cbTransp.OnChange:=@CheckBox1Change;
+  cbShowHint.OnChange:=@CheckBox1Change;
+  RadioGroup1.OnClick:=@CheckBox1Change;
+  RadioGroup2.OnClick:=@CheckBox1Change;
+
+end;
+
+end.
+

RXLib/.svn/pristine/01/01359bb11d3450f9c34ea05aa6a5ab7d0697c13c.svn-base

@@ -0,0 +1,225 @@
+{ folderlister unit
+
+  Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
+  original conception from rx library for Delphi (c)
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit rxfolderlister;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus;
+
+
+type
+  { TCustomFolderLister }
+
+  TCustomFolderLister = class(TComponent)
+  private
+    FDefaultExt: string;
+    FMenuItem: TMenuItem;
+    FOnExecuteItem: TNotifyEvent;
+    FFileFolder: string;
+    FFileList:TStringList;
+    procedure DoFind(S:string; MenuItem:TMenuItem);
+    function GetCount: integer;
+    function GetFiles(Item: integer): string;
+    procedure SetMenuItem(const AValue: TMenuItem);
+    procedure SetFileFolder(const AValue: string);
+  protected
+    property FileFolder:string read FFileFolder write SetFileFolder;
+    property OnExecuteItem:TNotifyEvent read FOnExecuteItem write FOnExecuteItem;
+    property MenuItem:TMenuItem read FMenuItem write SetMenuItem;
+    property DefaultExt:string read FDefaultExt write FDefaultExt;
+    procedure InternalExecute(Sender: TObject);virtual;
+  public
+    procedure Execute;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property Files[Item:integer]:string read GetFiles;
+    property Count:integer read GetCount;
+  published
+  end;
+
+type
+  TFolderLister = class(TCustomFolderLister)
+  published
+    property DefaultExt;
+    property FileFolder;
+    property OnExecuteItem;
+    property MenuItem;
+  end;
+  
+implementation
+uses FileUtil, strutils, RxAppUtils, LazUTF8, LazFileUtils, rxconst;
+
+function MenuItemStr(S:string):string;
+var
+  i:integer;
+begin
+  Result:=Copy2Symb(ExtractFileName(S), '.');
+  if Result='' then exit;
+  for i:=1 to Length(Result) do
+  begin
+    if Result[i]='\' then Result[i]:='/' else
+    if Result[i]='_' then Result[i]:='.';
+  end;
+end;
+
+{ TCustomFolderLister }
+procedure TCustomFolderLister.DoFind(S: string; MenuItem: TMenuItem);
+var
+  Rec:TSearchRec;
+  R:integer;
+  AFileList,
+  AFolderList:TStringList;
+
+procedure CreateItems;
+var
+  i:integer;
+  M:TMenuItem;
+begin
+  for I:=0 to AFileList.Count-1 do
+  begin
+    FFileList.Add(AFileList[i]);
+    M:=TMenuItem.Create(Application.MainForm);
+    M.Caption:=MenuItemStr(AFileList[i]);
+    M.Hint:=MenuItemStr(AFileList[i]);
+    MenuItem.Add(M);
+    M.Tag:=FFileList.Count-1;
+    M.OnClick:=@InternalExecute;
+  end;
+end;
+
+procedure CreateSubItems;
+var
+  i:integer;
+  M:TMenuItem;
+  S:string;
+begin
+  for i:=0 to AFolderList.Count-1 do
+  begin
+    M:=TMenuItem.Create(MenuItem.Owner);//Application.MainForm);
+    S:=AFolderList[i];
+    M.Caption:=MenuItemStr(S);
+    MenuItem.Add(M);
+    DoFind(AFolderList[i]+DirectorySeparator,M);
+  end;
+end;
+
+var
+  SS:string;
+begin
+  AFolderList:=TStringList.Create;
+  AFolderList.Sorted:=true;
+  AFileList:=TStringList.Create;
+  AFolderList.Sorted:=true;
+  try
+    R:=FindFirstUTF8(S+AllMask,faAnyFile, Rec);
+    while R=0 do
+    begin
+      if ((Rec.Attr and faDirectory) <>0) and (Rec.Name<>'.') and (Rec.Name<>'..') then
+      begin
+        SS:=S+Rec.Name;
+        AFolderList.Add(SS)
+      end
+      else
+      begin
+        if UTF8LowerCase(ExtractFileExt(Rec.Name))=UTF8LowerCase(FDefaultExt) then
+        begin
+          SS:=S+Rec.Name;
+          AFileList.Add(SS);
+        end;
+      end;
+      R:=FindNextUTF8(Rec);
+    end;
+    FindCloseUTF8(Rec);
+    CreateSubItems;
+    CreateItems;
+  finally
+    AFolderList.Free;
+    AFileList.Free;
+  end;
+end;
+
+function TCustomFolderLister.GetCount: integer;
+begin
+  Result:=FFileList.Count;
+end;
+
+function TCustomFolderLister.GetFiles(Item: integer): string;
+begin
+  Result:=FFileList[Item];
+end;
+
+procedure TCustomFolderLister.SetMenuItem(const AValue: TMenuItem);
+begin
+  if FMenuItem=AValue then exit;
+  FMenuItem:=AValue;
+end;
+
+procedure TCustomFolderLister.SetFileFolder(const AValue: string);
+begin
+  if FFileFolder=AValue then exit;
+  FFileFolder:=AValue;
+  if FFileFolder<>'' then
+    if FFileFolder[Length(FFileFolder)]<>DirectorySeparator then
+      FFileFolder:=FFileFolder+DirectorySeparator;
+end;
+
+procedure TCustomFolderLister.InternalExecute(Sender: TObject);
+begin
+  if Assigned(FOnExecuteItem) then
+    FOnExecuteItem(Sender)
+end;
+
+procedure TCustomFolderLister.Execute;
+begin
+  if Assigned(FMenuItem) then
+    DoFind(FFileFolder, FMenuItem)
+  else
+    raise Exception.CreateFmt( sFolderListerErr, [Name]);
+end;
+
+constructor TCustomFolderLister.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFileList:=TStringList.Create;
+  FFileList.Sorted:=false;
+end;
+
+destructor TCustomFolderLister.Destroy;
+begin
+  FFileList.Free;
+  inherited Destroy;
+end;
+
+end.

RXLib/.svn/pristine/01/01a18a83b8e36aa8286630cbac55c20d8c37c0d1.svn-base

@@ -0,0 +1,650 @@
+{ DateUtil unit
+
+  Copyright (C) 2005-2017 Lagunov Aleksey alexs@yandex.ru and Lazarus team
+  original conception from rx library for Delphi (c)
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit rxdateutil;
+
+{$I rx.inc}
+
+interface
+
+function CurrentYear: Word;
+function IsLeapYear(AYear: Integer): Boolean;
+function DaysPerMonth(AYear, AMonth: Integer): Integer;
+function FirstDayOfPrevMonth: TDateTime;
+function LastDayOfPrevMonth: TDateTime;
+function FirstDayOfNextMonth: TDateTime;
+function ExtractDay(ADate: TDateTime): Word;
+function ExtractMonth(ADate: TDateTime): Word;
+function ExtractYear(ADate: TDateTime): Word;
+function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
+function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
+function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
+function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
+function ValidDate(ADate: TDateTime): Boolean;
+procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
+function MonthsBetween(Date1, Date2: TDateTime): Double;
+function DaysInPeriod(Date1, Date2: TDateTime): Longint;
+  { Count days between Date1 and Date2 + 1, so if Date1 = Date2 result = 1 }
+function DaysBetween(Date1, Date2: TDateTime): Longint;
+  { The same as previous but if Date2 < Date1 result = 0 }
+
+function IncTime(ATime: TDateTime; Hours, Minutes, Seconds, MSecs: Integer): TDateTime;
+function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
+function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
+function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
+function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
+function CutTime(ADate: TDateTime): TDateTime; { Set time to 00:00:00:00 }
+
+type
+  TDateOrder = (doMDY, doDMY, doYMD);
+  TDayOfWeekName = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
+  TDaysOfWeek = set of TDayOfWeekName;
+
+{ String to date conversions }
+function GetDateOrder(const DateFormat: string): TDateOrder;
+function MonthFromName(const S: string; MaxLen: Byte): Byte;
+function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
+function StrToDateFmt(const DateFormat, S: string): TDateTime;
+function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
+function DefDateFormat(FourDigitYear: Boolean): string;
+function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
+function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
+
+{$IFDEF WIN32}
+function FormatLongDate(Value: TDateTime): string;
+function FormatLongDateTime(Value: TDateTime): string;
+{$ENDIF}
+
+const
+  DefaultDateOrder = doDMY;
+
+{$IFDEF USE_FOUR_DIGIT_YEAR}
+var
+  FourDigitYear: Boolean;
+{$ELSE}
+function FourDigitYear: Boolean;
+{$ENDIF USE_FOUR_DIGIT_YEAR}
+
+const
+  CenturyOffset: Byte = 60;
+  NullDate: TDateTime = 0;
+
+implementation
+
+uses DateUtils, SysUtils, RXStrUtils, rxdconst{, DBConsts }{$IFDEF WIN32}, Windows{$ENDIF};
+
+
+function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
+begin
+  if DateValue = NullDate then Result := DefaultValue
+  else Result := DateValue;
+end;
+
+function IsLeapYear(AYear: Integer): Boolean;
+begin
+  Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
+end;
+
+function DaysPerMonth(AYear, AMonth: Integer): Integer;
+const
+  DaysInMonth: array[1..12] of Integer =
+    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+begin
+  Result := DaysInMonth[AMonth];
+  if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
+end;
+
+function FirstDayOfNextMonth: TDateTime;
+var
+  Year, Month, Day: Word;
+begin
+  DecodeDate(Date, Year, Month, Day);
+  Day := 1;
+  if Month < 12 then Inc(Month)
+  else begin
+    Inc(Year);
+    Month := 1;
+  end;
+  Result := EncodeDate(Year, Month, Day);
+end;
+
+function FirstDayOfPrevMonth: TDateTime;
+var
+  Year, Month, Day: Word;
+begin
+  DecodeDate(Date, Year, Month, Day);
+  Day := 1;
+  if Month > 1 then Dec(Month)
+  else begin
+    Dec(Year);
+    Month := 12;
+  end;
+  Result := EncodeDate(Year, Month, Day);
+end;
+
+function LastDayOfPrevMonth: TDateTime;
+var
+  D: TDateTime;
+  Year, Month, Day: Word;
+begin
+  D := FirstDayOfPrevMonth;
+  DecodeDate(D, Year, Month, Day);
+  Day := DaysPerMonth(Year, Month);
+  Result := EncodeDate(Year, Month, Day);
+end;
+
+function ExtractDay(ADate: TDateTime): Word;
+var
+  M, Y: Word;
+begin
+  DecodeDate(ADate, Y, M, Result);
+end;
+
+function ExtractMonth(ADate: TDateTime): Word;
+var
+  D, Y: Word;
+begin
+  DecodeDate(ADate, Y, Result, D);
+end;
+
+function ExtractYear(ADate: TDateTime): Word;
+var
+  D, M: Word;
+begin
+  DecodeDate(ADate, Result, M, D);
+end;
+
+function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
+var
+  D, M, Y: Word;
+  Day, Month, Year: Longint;
+begin
+  DecodeDate(ADate, Y, M, D);
+  Year := Y; Month := M; Day := D;
+  Inc(Year, Years);
+  Inc(Year, Months div 12);
+  Inc(Month, Months mod 12);
+  if Month < 1 then begin
+    Inc(Month, 12);
+    Dec(Year);
+  end
+  else if Month > 12 then begin
+    Dec(Month, 12);
+    Inc(Year);
+  end;
+  if Day > DaysPerMonth(Year, Month) then Day := DaysPerMonth(Year, Month);
+  Result := EncodeDate(Year, Month, Day) + Days + Frac(ADate);
+end;
+
+procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
+{ Corrected by Anatoly A. Sanko (2:450/73) }
+var
+  DtSwap: TDateTime;
+  Day1, Day2, Month1, Month2, Year1, Year2: Word;
+begin
+  if Date1 > Date2 then begin
+    DtSwap := Date1;
+    Date1 := Date2;
+    Date2 := DtSwap;
+  end;
+  DecodeDate(Date1, Year1, Month1, Day1);
+  DecodeDate(Date2, Year2, Month2, Day2);
+  Years := Year2 - Year1;
+  Months := 0;
+  Days := 0;
+  if Month2 < Month1 then begin
+    Inc(Months, 12);
+    Dec(Years);
+  end;
+  Inc(Months, Month2 - Month1);
+  if Day2 < Day1 then begin
+    Inc(Days, DaysPerMonth(Year1, Month1));
+    if Months = 0 then begin
+      Dec(Years);
+      Months := 11;
+    end
+    else Dec(Months);
+  end;
+  Inc(Days, Day2 - Day1);
+end;
+
+function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := ADate + Delta;
+end;
+
+function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncDate(ADate, 0, Delta, 0);
+end;
+
+function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncDate(ADate, 0, 0, Delta);
+end;
+
+function MonthsBetween(Date1, Date2: TDateTime): Double;
+var
+  D, M, Y: Word;
+begin
+  DateDiff(Date1, Date2, D, M, Y);
+  Result := 12 * Y + M;
+  if (D > 1) and (D < 7) then Result := Result + 0.25
+  else if (D >= 7) and (D < 15) then Result := Result + 0.5
+  else if (D >= 15) and (D < 21) then Result := Result + 0.75
+  else if (D >= 21) then Result := Result + 1;
+end;
+
+function IsValidDate(Y, M, D: Word): Boolean;
+begin
+  Result := (Y >= 1) and (Y <= 9999) and (M >= 1) and (M <= 12) and
+    (D >= 1) and (D <= DaysPerMonth(Y, M));
+end;
+
+function ValidDate(ADate: TDateTime): Boolean;
+var
+  Year, Month, Day: Word;
+begin
+  try
+    DecodeDate(ADate, Year, Month, Day);
+    Result := IsValidDate(Year, Month, Day);
+  except
+    Result := False;
+  end;
+end;
+
+function DaysInPeriod(Date1, Date2: TDateTime): Longint;
+begin
+  if ValidDate(Date1) and ValidDate(Date2) then
+    Result := Abs(Trunc(Date2) - Trunc(Date1)) + 1
+  else Result := 0;
+end;
+
+function DaysBetween(Date1, Date2: TDateTime): Longint;
+begin
+  Result := Trunc(Date2) - Trunc(Date1) + 1;
+  if Result < 0 then Result := 0;
+end;
+
+function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
+  MSecs: Integer): TDateTime;
+begin
+  Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
+    Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
+  if Result < 0 then Result := Result + 1;
+end;
+
+function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncTime(ATime, Delta, 0, 0, 0);
+end;
+
+function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncTime(ATime, 0, Delta, 0, 0);
+end;
+
+function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncTime(ATime, 0, 0, Delta, 0);
+end;
+
+function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
+begin
+  Result := IncTime(ATime, 0, 0, 0, Delta);
+end;
+
+function CutTime(ADate: TDateTime): TDateTime;
+begin
+  Result := Trunc(ADate);
+end;
+
+function CurrentYear: Word;
+var
+  SystemTime: TSystemTime;
+begin
+  GetLocalTime(SystemTime);
+  Result := SystemTime.Year;
+end;
+
+{ String to date conversions. Copied from SYSUTILS.PAS unit. }
+
+procedure ScanBlanks(const S: string; var Pos: Integer);
+var
+  I: Integer;
+begin
+  I := Pos;
+  while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
+  Pos := I;
+end;
+
+function ScanNumber(const S: string; MaxLength: Integer; var Pos: Integer;
+  var Number: Longint): Boolean;
+var
+  I: Integer;
+  N: Word;
+begin
+  Result := False;
+  ScanBlanks(S, Pos);
+  I := Pos;
+  N := 0;
+  while (I <= Length(S)) and (Longint(I - Pos) < MaxLength) and
+    (S[I] in ['0'..'9']) and (N < 1000) do
+  begin
+    N := N * 10 + (Ord(S[I]) - Ord('0'));
+    Inc(I);
+  end;
+  if I > Pos then begin
+    Pos := I;
+    Number := N;
+    Result := True;
+  end;
+end;
+
+function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
+begin
+  Result := False;
+  ScanBlanks(S, Pos);
+  if (Pos <= Length(S)) and (S[Pos] = Ch) then begin
+    Inc(Pos);
+    Result := True;
+  end;
+end;
+
+{$IFDEF RX_D3}
+procedure ScanToNumber(const S: string; var Pos: Integer);
+begin
+  while (Pos <= Length(S)) and not (S[Pos] in ['0'..'9']) do begin
+    if S[Pos] in LeadBytes then Inc(Pos);
+    Inc(Pos);
+  end;
+end;
+{$ENDIF}
+
+function GetDateOrder(const DateFormat: string): TDateOrder;
+var
+  I: Integer;
+begin
+  Result := DefaultDateOrder;
+  I := 1;
+  while I <= Length(DateFormat) do begin
+    case Chr(Ord(DateFormat[I]) and $DF) of
+{$IFDEF RX_D3}
+      'E': Result := doYMD;
+{$ENDIF}
+      'Y': Result := doYMD;
+      'M': Result := doMDY;
+      'D': Result := doDMY;
+    else
+      Inc(I);
+      Continue;
+    end;
+    Exit;
+  end;
+  Result := DefaultDateOrder; { default }
+end;
+
+function ExpandYear(Year: Integer): Integer;
+var
+  N: Longint;
+begin
+  Result := Year;
+  if Result < 100 then begin
+    N := CurrentYear - CenturyOffset;
+    Inc(Result, N div 100 * 100);
+    if (CenturyOffset > 0) and (Result < N) then
+      Inc(Result, 100);
+  end;
+end;
+
+function ScanDate(const S, DateFormat: string; var Pos: Integer;
+  var Y, M, D: Integer): Boolean;
+var
+  DateOrder: TDateOrder;
+  N1, N2, N3: Longint;
+begin
+  Result := False;
+  Y := 0; M := 0; D := 0;
+  DateOrder := GetDateOrder(DateFormat);
+  if DefaultFormatSettings.ShortDateFormat[1] = 'g' then { skip over prefix text }
+    ScanToNumber(S, Pos);
+  if not (ScanNumber(S, MaxInt, Pos, N1) and ScanChar(S, Pos, DefaultFormatSettings.DateSeparator) and
+    ScanNumber(S, MaxInt, Pos, N2)) then Exit;
+  if ScanChar(S, Pos, DateSeparator) then begin
+    if not ScanNumber(S, MaxInt, Pos, N3) then Exit;
+    case DateOrder of
+      doMDY: begin Y := N3; M := N1; D := N2; end;
+      doDMY: begin Y := N3; M := N2; D := N1; end;
+      doYMD: begin Y := N1; M := N2; D := N3; end;
+    end;
+    Y := ExpandYear(Y);
+  end
+  else begin
+    Y := CurrentYear;
+    if DateOrder = doDMY then begin
+      D := N1; M := N2;
+    end
+    else begin
+      M := N1; D := N2;
+    end;
+  end;
+  ScanChar(S, Pos, DefaultFormatSettings.DateSeparator);
+  ScanBlanks(S, Pos);
+(*
+{$IFDEF RX_D3}
+  if SysLocale.FarEast and (System.Pos('ddd', ShortDateFormat) <> 0) then
+  begin { ignore trailing text }
+    if ShortTimeFormat[1] in ['0'..'9'] then  { stop at time digit }
+      ScanToNumber(S, Pos)
+    else  { stop at time prefix }
+      repeat
+        while (Pos <= Length(S)) and (S[Pos] <> ' ') do Inc(Pos);
+        ScanBlanks(S, Pos);
+      until (Pos > Length(S)) or
+        (AnsiCompareText(TimeAMString, Copy(S, Pos, Length(TimeAMString))) = 0) or
+        (AnsiCompareText(TimePMString, Copy(S, Pos, Length(TimePMString))) = 0);
+  end;
+{$ENDIF RX_D3}
+*)
+  Result := IsValidDate(Y, M, D) and (Pos > Length(S));
+end;
+
+function MonthFromName(const S: string; MaxLen: Byte): Byte;
+begin
+  if Length(S) > 0 then
+    for Result := 1 to 12 do begin
+      if (Length(DefaultFormatSettings.LongMonthNames[Result]) > 0) and
+        (AnsiCompareText(Copy(S, 1, MaxLen),
+        Copy(DefaultFormatSettings.LongMonthNames[Result], 1, MaxLen)) = 0) then Exit;
+    end;
+  Result := 0;
+end;
+
+procedure ExtractMask(const Format, S: string; Ch: Char; Cnt: Integer;
+  var I: Integer; Blank, Default: Integer);
+var
+  Tmp: string[20];
+  J, L: Integer;
+begin
+  I := Default;
+  Ch := UpCase(Ch);
+  L := Length(Format);
+  if Length(S) < L then L := Length(S)
+  else if Length(S) > L then Exit;
+  J := Pos(MakeStr(Ch, Cnt), AnsiUpperCase(Format));
+  if J <= 0 then Exit;
+  Tmp := '';
+  while (UpCase(Format[J]) = Ch) and (J <= L) do begin
+    if S[J] <> ' ' then Tmp := Tmp + S[J];
+    Inc(J);
+  end;
+  if Tmp = '' then I := Blank
+  else if Cnt > 1 then begin
+    I := MonthFromName(Tmp, Length(Tmp));
+    if I = 0 then I := -1;
+  end
+  else I := StrToIntDef(Tmp, -1);
+end;
+
+function ScanDateStr(const Format, S: string; var D, M, Y: Integer): Boolean;
+var
+  Pos: Integer;
+begin
+  ExtractMask(Format, S, 'm', 3, M, -1, 0); { short month name? }
+  if M = 0 then ExtractMask(Format, S, 'm', 1, M, -1, 0);
+  ExtractMask(Format, S, 'd', 1, D, -1, 1);
+  ExtractMask(Format, S, 'y', 1, Y, -1, CurrentYear);
+  Y := ExpandYear(Y);
+  Result := IsValidDate(Y, M, D);
+  if not Result then begin
+    Pos := 1;
+    Result := ScanDate(S, Format, Pos, Y, M, D);
+  end;
+end;
+
+function InternalStrToDate(const DateFormat, S: string;
+  var Date: TDateTime): Boolean;
+var
+  D, M, Y: Integer;
+begin
+  if S = '' then begin
+    Date := NullDate;
+    Result := True;
+  end
+  else begin
+    Result := ScanDateStr(DateFormat, S, D, M, Y);
+    if Result then
+    try
+      Date := EncodeDate(Y, M, D);
+    except
+      Result := False;
+    end;
+  end;
+end;
+
+function StrToDateFmt(const DateFormat, S: string): TDateTime;
+begin
+  if not InternalStrToDate(DateFormat, S, Result) then
+    raise EConvertError.CreateFmt({$IFDEF RX_D3} SInvalidDate {$ELSE}
+      LoadStr(SInvalidDate) {$ENDIF}, [S]);
+end;
+
+function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
+begin
+  if not InternalStrToDate(DefaultFormatSettings.ShortDateFormat, S, Result) then
+    Result := Trunc(Default);
+end;
+
+function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
+begin
+  if not InternalStrToDate(DateFormat, S, Result) then
+    Result := Trunc(Default);
+end;
+
+function DefDateFormat(FourDigitYear: Boolean): string;
+begin
+  if FourDigitYear then begin
+    case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
+      doMDY: Result := 'MM/DD/YYYY';
+      doDMY: Result := 'DD/MM/YYYY';
+      doYMD: Result := 'YYYY/MM/DD';
+    end;
+  end
+  else begin
+    case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
+      doMDY: Result := 'MM/DD/YY';
+      doDMY: Result := 'DD/MM/YY';
+      doYMD: Result := 'YY/MM/DD';
+    end;
+  end;
+end;
+
+function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
+begin
+  if FourDigitYear then begin
+    case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
+      doMDY, doDMY: Result := '!99/99/9999;1;';
+      doYMD: Result := '!9999/99/99;1;';
+    end;
+  end
+  else begin
+    case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
+      doMDY, doDMY: Result := '!99/99/99;1;';
+      doYMD: Result := '!99/99/99;1;';
+    end;
+  end;
+  if Result <> '' then Result := Result + BlanksChar;
+end;
+
+
+{$IFDEF WIN32}
+
+function FormatLongDate(Value: TDateTime): string;
+var
+  Buffer: array[0..1023] of Char;
+  SystemTime: TSystemTime;
+begin
+{$IFDEF RX_D3}
+  DateTimeToSystemTime(Value, SystemTime);
+{$ELSE}
+  with SystemTime do
+  begin
+    DecodeDate(Value, wYear, wMonth, wDay);
+    DecodeTime(Value, wHour, wMinute, wSecond, wMilliseconds);
+  end;
+{$ENDIF}
+  SetString(Result, Buffer, GetDateFormat(GetThreadLocale, DATE_LONGDATE,
+    @SystemTime, nil, Buffer, SizeOf(Buffer) - 1));
+  Result := TrimRight(Result);
+end;
+
+function FormatLongDateTime(Value: TDateTime): string;
+begin
+  if Value <> NullDate then
+    Result := FormatLongDate(Value) + FormatDateTime(' tt', Value)
+  else Result := '';
+end;
+
+{$ENDIF WIN32}
+
+{$IFNDEF USE_FOUR_DIGIT_YEAR}
+function FourDigitYear: Boolean;
+begin
+  Result := Pos('YYYY', AnsiUpperCase(DefaultFormatSettings.ShortDateFormat)) > 0;
+end;
+{$ENDIF}
+
+
+{$IFDEF USE_FOUR_DIGIT_YEAR}
+initialization
+  FourDigitYear := Pos('YYYY', AnsiUpperCase(ShortDateFormat)) > 0;
+{$ENDIF}
+end.