cxdatautils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 387 行

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressDataController                                        }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSDATACONTROLLER AND ALL         }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxDataUtils;

{$I cxVer.inc}

interface

uses
  Windows,
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Classes, SysUtils;

type
  TcxDataEditValueSource = (evsValue, evsText, evsKey);

  { TcxCustomDataBinding }

  TcxDataBindingNotifyEvent = procedure of object;

  TcxCustomDataBinding = class(TPersistent)
  private
    FDataComponent: TComponent;
    FOwner: TComponent;
    FReadOnly: Boolean;
    FVisualControl: TComponent;
    FOnDataChange: TcxDataBindingNotifyEvent;
    FOnDataSetChange: TcxDataBindingNotifyEvent;
    FOnUpdateData: TcxDataBindingNotifyEvent;
    procedure SetVisualControl(Value: TComponent);
  protected
    function GetOwner: TPersistent; override;
    procedure DataChange; virtual;
    procedure DataSetChange; virtual;
    function GetModified: Boolean; virtual;
    function GetReadOnly: Boolean; virtual;
    procedure SetReadOnly(Value: Boolean); virtual;
    procedure UpdateData; virtual;
    procedure VisualControlChanged; virtual;
    property DataComponent: TComponent read FDataComponent;
  public
    constructor Create(AOwner, ADataComponent: TComponent); virtual;
    function CanModify: Boolean; virtual;
    function ExecuteAction(Action: TBasicAction): Boolean; virtual;
    function GetStoredValue(AValueSource: TcxDataEditValueSource; AFocused: Boolean): Variant; virtual;
    function IsControlReadOnly: Boolean; virtual;
    function IsDataSourceLive: Boolean; virtual;
    function IsDataStorage: Boolean; virtual;
    procedure Reset; virtual;
    function SetEditMode: Boolean; virtual;
    procedure SetStoredValue(AValueSource: TcxDataEditValueSource; const Value: Variant); virtual;
    function UpdateAction(Action: TBasicAction): Boolean; virtual;
    procedure UpdateDataSource; virtual;
    property Modified: Boolean read GetModified;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property VisualControl: TComponent read FVisualControl write SetVisualControl;
    property OnDataChange: TcxDataBindingNotifyEvent read FOnDataChange write FOnDataChange;
    property OnDataSetChange: TcxDataBindingNotifyEvent read FOnDataSetChange write FOnDataSetChange;
    property OnUpdateData: TcxDataBindingNotifyEvent read FOnUpdateData write FOnUpdateData;
  end;

  TcxCustomDataBindingClass = class of TcxCustomDataBinding;

  { TcxCollection }

  TcxCollection = class(TCollection)  // copy from cxClasses
  public
    procedure Assign(Source: TPersistent); override;
  {$IFNDEF DELPHI6}
    function Owner: TPersistent;
  {$ENDIF}
  end;

function DefaultCurrencyDisplayFormat: string;

function DateOf(const AValue: TDateTime): TDateTime;
function TimeOf(const AValue: TDateTime): TDateTime;
function GetStartDateOfWeek(const AValue: TDateTime): TDateTime;

// StartOfWeek: 0..6 - 0 = Sunday, 6 = Saturday

const
  cxDataUnassignedStartOfWeek = 10;

function GetStartOfWeek: Word;
procedure SetStartOfWeek(Value: Word);

function DataCompareText(const S1, S2: string; APartialCompare: Boolean): Boolean;

implementation

function DefaultCurrencyDisplayFormat: string;
var
  ACurrStr: string;
  I: Integer;
  C: Char;
begin
  if CurrencyDecimals > 0 then
  begin
    SetLength(Result, CurrencyDecimals);
    FillChar(Result[1], Length(Result), '0');
  end
  else
    Result := '';
  Result := ',0.' + Result;
  ACurrStr := '';
  for I := 1 to Length(CurrencyString) do
  begin
    C := CurrencyString[I];
    if C in [',', '.'] then
      ACurrStr := ACurrStr + '''' + C + ''''
    else
      ACurrStr := ACurrStr + C;
  end;
  if Length(ACurrStr) > 0 then
    case CurrencyFormat of
      0: Result := ACurrStr + Result; { '$1' }
      1: Result := Result + ACurrStr; { '1$' }
      2: Result := ACurrStr + ' ' + Result; { '$ 1' }
      3: Result := Result + ' ' + ACurrStr; { '1 $' }
    end;
end;

function DateOf(const AValue: TDateTime): TDateTime;
begin
  Result := Trunc(AValue);
end;

function TimeOf(const AValue: TDateTime): TDateTime;
begin
  Result := Frac(AValue);
end;

function GetStartDateOfWeek(const AValue: TDateTime): TDateTime;
var
  AStartOfWeek, ADayOfWeek: Integer;
begin
  AStartOfWeek := GetStartOfWeek;
  ADayOfWeek := DayOfWeek(AValue) - 1;
  if ADayOfWeek < AStartOfWeek then
    Result := DateOf(AValue) - 7 + (AStartOfWeek - ADayOfWeek)
  else
    Result := DateOf(AValue) - (ADayOfWeek - AStartOfWeek);
end;

var
  FStartOfWeek: Word = cxDataUnassignedStartOfWeek;

function GetStartOfWeek: Word;
var
  Buffer: array[0..1] of Char;
begin
  if FStartOfWeek = cxDataUnassignedStartOfWeek then
  begin
  {$IFDEF DELPHI6}
    {$WARN SYMBOL_PLATFORM OFF}
  {$ENDIF}
    if GetLocaleInfo(GetThreadLocale, LOCALE_IFIRSTDAYOFWEEK, Buffer,
      SizeOf(Buffer)) > 0 then
      Result := StrToInt(Buffer[0])
    else
      Result := 0;
  {$IFDEF DELPHI6}
    {$WARN SYMBOL_PLATFORM ON}
  {$ENDIF}
    Inc(Result);
    if Result > 6 then Result := 0;
  end
  else
    Result := FStartOfWeek;
end;

procedure SetStartOfWeek(Value: Word);
begin
  if Value in [0..6, cxDataUnassignedStartOfWeek] then
    FStartOfWeek := Value;
end;

function DataCompareText(const S1, S2: string; APartialCompare: Boolean): Boolean;
var
  AText1, AText2: string;
  L2: Integer; 
begin
  AText1 := AnsiUpperCase(S1);
  AText2 := AnsiUpperCase(S2);
  L2 := Length(AText2);
  if L2 = 0 then
    Result := Length(AText1) = 0
  else
    if not APartialCompare then
      Result := AText1 = AText2
    else
      Result := (Length(AText1) >= L2) and (Copy(AText1, 1, L2) = AText2);
end;

{ TcxCustomDataBinding }

constructor TcxCustomDataBinding.Create(AOwner, ADataComponent: TComponent);
begin
  inherited Create;
  FDataComponent := ADataComponent;
  FOwner := AOwner;
end;

function TcxCustomDataBinding.CanModify: Boolean;
begin
  Result := not ReadOnly;
end;

function TcxCustomDataBinding.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := False;
end;

function TcxCustomDataBinding.GetStoredValue(AValueSource: TcxDataEditValueSource;
  AFocused: Boolean): Variant;
begin
  Result := Null;
end;

function TcxCustomDataBinding.IsControlReadOnly: Boolean;
begin
  Result := ReadOnly;
end;

function TcxCustomDataBinding.IsDataSourceLive: Boolean;
begin
  Result := True;
end;

function TcxCustomDataBinding.IsDataStorage: Boolean;
begin
  Result := False;
end;

procedure TcxCustomDataBinding.Reset;
begin
end;

function TcxCustomDataBinding.SetEditMode: Boolean;
begin
  Result := CanModify;
end;

procedure TcxCustomDataBinding.SetStoredValue(AValueSource: TcxDataEditValueSource;
  const Value: Variant);
begin
end;

function TcxCustomDataBinding.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := False;
end;

procedure TcxCustomDataBinding.UpdateDataSource;
begin
end;

function TcxCustomDataBinding.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TcxCustomDataBinding.DataChange;
begin
  if Assigned(FOnDataChange) then
    FOnDataChange;
end;

procedure TcxCustomDataBinding.DataSetChange;
begin
  if Assigned(FOnDataSetChange) then
    FOnDataSetChange;
end;

function TcxCustomDataBinding.GetModified: Boolean;
begin
  Result := False;
end;

function TcxCustomDataBinding.GetReadOnly: Boolean;
begin
  Result := FReadOnly;
end;

procedure TcxCustomDataBinding.SetReadOnly(Value: Boolean);
begin
  if Value <> FReadOnly then
  begin
    FReadOnly := Value;
    DataSetChange;
  end;
end;

procedure TcxCustomDataBinding.UpdateData;
begin
  if Assigned(FOnUpdateData) then
    FOnUpdateData;
end;

procedure TcxCustomDataBinding.VisualControlChanged;
begin
end;

procedure TcxCustomDataBinding.SetVisualControl(Value: TComponent);
begin
  if Value <> FVisualControl then
  begin
    FVisualControl := Value;
    VisualControlChanged;
  end;
end;

{ TcxCollection }

procedure TcxCollection.Assign(Source: TPersistent);
var
  I: Integer;
  AItem: TCollectionItem;
begin
  if Source is TCollection then
  begin
    if (Count = 0) and (TCollection(Source).Count = 0) then Exit;
    BeginUpdate;
    try
      for I := 0 to TCollection(Source).Count - 1 do
      begin
        if I > Count - 1 then
          AItem := Add
        else
          AItem := Items[I];
        AItem.Assign(TCollection(Source).Items[I]);
      end;
      for I := Count - 1 downto TCollection(Source).Count do
        Delete(I);
    finally
      EndUpdate;
    end;
  end
  else
    inherited;
end;

{$IFNDEF DELPHI6}
function TcxCollection.Owner: TPersistent;
begin
  Result := GetOwner;
end;
{$ENDIF}

end.