vgstndrt.pas

大家是不是为不知道如何在VB学到绝地程序

{*******************************************************}
{                                                       }
{         Vladimir Gaitanoff Delphi VCL Library         }
{         General non-visual components                 }
{                                                       }
{         Copyright (c) 1997, 2000                      }
{                                                       }
{         TStoredValue, TStoredValues                   }
{         TPropStorage (portion of TFormStorage)        }
{         Copyright (c) 1995, 1997 RX Library           }
{                                                       }
{*******************************************************}

{$I VG.INC }
{$D-,L-}

Unit vgStndrt;

Interface
Uses
  Classes{$IFDEF _D4_},
  IniFiles,
  vgTools{$ENDIF},
  Forms;

Type
  { TLocaleStorage }
  TLocaleStorage = Class(TComponent)
  Private
    FSysDefault: Boolean;
    FText: String;
    Procedure SetSysDefault(Value: Boolean);
  Protected
    Function IsStored: Boolean;
    Procedure Loaded; Override;
    Procedure DefaultChanged;
    Procedure SetText(Value: String);
    Procedure UpdateText; Virtual;
  Public
    Constructor Create(AOwner: TComponent); Override;
    Procedure Read; Virtual;
    Procedure Write; Virtual;
  Published
    Property SysDefault: Boolean Read FSysDefault Write SetSysDefault Default True;
    Property Text: String Read FText Write SetText Stored False;
  End;

  { TDateTimeStorage }
  TDateTimeStorage = Class(TLocaleStorage)
  Private
    FDate: String;
    FTime: String;
    FShortDateFormat: String;
    FLongDateFormat: String;
    FDateSeparator: Char;
    FTimeSeparator: Char;
    FTimeAMString: String;
    FTimePMString: String;
    FShortTimeFormat: String;
    FLongTimeFormat: String;
    FShortMonthNames: TStrings;
    FLongMonthNames: TStrings;
    FShortDayNames: TStrings;
    FLongDayNames: TStrings;
    FDateTime: Single;
    Procedure SetDateTime(Value: Single);
    Procedure SetDate(Value: String);
    Procedure SetTime(Value: String);
    Procedure SetShortDateFormat(Value: String);
    Procedure SetLongDateFormat(Value: String);
    Procedure SetDateSeparator(Value: Char);
    Procedure SetTimeSeparator(Value: Char);
    Procedure SetTimeAMString(Value: String);
    Procedure SetTimePMString(Value: String);
    Procedure SetShortTimeFormat(Value: String);
    Procedure SetLongTimeFormat(Value: String);
    Procedure SetShortMonthNames(Value: TStrings);
    Procedure SetLongMonthNames(Value: TStrings);
    Procedure SetShortDayNames(Value: TStrings);
    Procedure SetLongDayNames(Value: TStrings);
    Procedure StringsChanged(Sender: TObject);
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure Read; Override;
    Procedure Write; Override;
    Procedure UpdateText; Override;
  Published
    Property ShortDateFormat: String Read FShortDateFormat Write SetShortDateFormat Stored IsStored;
    Property LongDateFormat: String Read FLongDateFormat Write SetLongDateFormat Stored IsStored;
    Property DateSeparator: Char Read FDateSeparator Write SetDateSeparator Stored IsStored;
    Property TimeSeparator: Char Read FTimeSeparator Write SetTimeSeparator Stored IsStored;
    Property TimeAMString: String Read FTimeAMString Write SetTimeAMString Stored IsStored;
    Property TimePMString: String Read FTimePMString Write SetTimePMString Stored IsStored;
    Property ShortTimeFormat: String Read FShortTimeFormat Write SetShortTimeFormat Stored IsStored;
    Property LongTimeFormat: String Read FLongTimeFormat Write SetLongTimeFormat Stored IsStored;

    Property ShortMonthNames: TStrings Read FShortMonthNames Write SetShortMonthNames Stored IsStored;
    Property LongMonthNames: TStrings Read FLongMonthNames Write SetLongMonthNames Stored IsStored;
    Property ShortDayNames: TStrings Read FShortDayNames Write SetShortDayNames Stored IsStored;
    Property LongDayNames: TStrings Read FLongDayNames Write SetLongDayNames Stored IsStored;

    Property Value: Single Read FDateTime Write SetDateTime Stored False;
    Property TextDate: String Read FDate Write SetDate Stored False;
    Property TextTime: String Read FTime Write SetTime Stored False;
  End;

  { TCurrencyStorage }
  TCurrencyStorage = Class(TLocaleStorage)
  Private
    { Private declarations }
    FCurrencyString: String;
    FCurrencyFormat: Byte;
    FNegCurrFormat: Byte;
    FThousandSeparator: Char;
    FDecimalSeparator: Char;
    FCurrencyDecimals: Byte;
    FValue: Single;
    Procedure SetCurrencyString(Value: String);
    Procedure SetCurrencyFormat(Value: Byte);
    Procedure SetNegCurrFormat(Value: Byte);
    Procedure SetThousandSeparator(Value: Char);
    Procedure SetDecimalSeparator(Value: Char);
    Procedure SetCurrencyDecimals(Value: Byte);
    Procedure SetValue(Value: Single);
  Protected
    { Protected declarations }
    Procedure Loaded; Override;
    Procedure IncorrectValue;
    Procedure UpdateText; Override;
  Public
    { Public declarations }
    Constructor Create(AOwner: TComponent); Override;
    Function GetText(
      ACurrencyString: String;
      ACurrencyFormat: Byte;
      ANegCurrFormat: Byte;
      AThousandSeparator: Char;
      ADecimalSeparator: Char;
      ACurrencyDecimals: Byte;
      AValue: Single): String;
    Function ValueToStr(Value: Single): String;
    Procedure Read; Override;
    Procedure Write; Override;
  Published
    { Published declarations }
    Property CurrencyString: String Read FCurrencyString Write SetCurrencyString Stored IsStored;
    Property CurrencyFormat: Byte Read FCurrencyFormat Write SetCurrencyFormat Stored IsStored;
    Property NegCurrFormat: Byte Read FNegCurrFormat Write SetNegCurrFormat Stored IsStored;
    Property ThousandSeparator: Char Read FThousandSeparator Write SetThousandSeparator Stored IsStored;
    Property DecimalSeparator: Char Read FDecimalSeparator Write SetDecimalSeparator Stored IsStored;
    Property CurrencyDecimals: Byte Read FCurrencyDecimals Write SetCurrencyDecimals Stored IsStored;
    Property Value: Single Read FValue Write SetValue Stored False;
  End;

  { TMoneyString }
  TStringResource = (srCurrency, srCurrencySub, srMaleOne, srFemaleOne,
    srTen, srFirstTen, srHundred, srThousand, srMillion, srBillion);

  TMoneyFormat = (mfVerbal, mfDigit);

  TMoneyInteger = {$IFDEF _D4_}Int64{$ELSE}Integer{$ENDIF};

  TMoneyString = Class(TComponent)
  Private
    FCurrencyGender: Array[0..1] Of Boolean;
    FDefault: Boolean;
    FDelimeter: String;
    FLists: Array[TStringResource] Of TStrings;
    FFormats: Array[0..1] Of TMoneyFormat;
    FUpperStart: Boolean;
    FValueNumber: Currency;
    FValueString: String;
    FZero: String;
    FZeroEmpty: Array[0..1] Of Boolean;
    Function GetString(Strings: TStrings; Index: Integer): String;
    Procedure ListChanged(Sender: TObject);
    Function ListStored(Index: Integer): Boolean;
    Procedure SetCurrencyGender(Index: Integer; Value: Boolean);
    Procedure SetDefault(Value: Boolean);
    Procedure SetDelimeter(Value: String);
    Procedure SetFormat(Index: Integer; Value: TMoneyFormat);
    Procedure SetList(Index: Integer; Value: TStrings);
    Procedure SetUpperStart(Value: Boolean);
    Procedure SetValueNumber(Value: Currency);
    Procedure SetValueString(Value: String);
    Procedure SetZero(Value: String);
    Procedure SetZeroEmpty(Index: Integer; Value: Boolean);
    Function ZeroStored: Boolean;
  Public
    Constructor Create(AOnwer: TComponent); Override;
    Destructor Destroy; Override;
    Function IntegerCurrencyStr(Value: TMoneyInteger; Currency: TStrings): String;
    Function IntegerGenderedToString(Value: TMoneyInteger; MaleGender: Boolean): String;
    Function IntegerToString(Value: TMoneyInteger): String;
    Function MoneyToString(Value: Currency): String;
    Function Triada(Value: Integer; MaleGender: Boolean): String;
  Published
    Property Billion: TStrings Index Integer(srBillion) Read FLists[srBillion] Write SetList Stored ListStored;
    Property CurrencySub: TStrings Index Integer(srCurrencySub) Read FLists[srCurrencySub] Write SetList Stored ListStored;
    Property Currency: TStrings Index Integer(srCurrency) Read FLists[srCurrency] Write SetList Stored ListStored;
    Property Default: Boolean Read FDefault Write SetDefault Stored False Default True;
    Property Delimeter: String Read FDelimeter Write SetDelimeter;
    Property FemaleOne: TStrings Index Integer(srFemaleOne) Read FLists[srFemaleOne] Write SetList Stored ListStored;
    Property FirstTen: TStrings Index Integer(srFirstTen) Read FLists[srFirstTen] Write SetList Stored ListStored;
    Property FormatCurrency: TMoneyFormat Index 0 Read FFormats[0] Write SetFormat Default mfVerbal;
    Property FormatCurrencySub: TMoneyFormat Index 1 Read FFormats[1] Write SetFormat Default mfVerbal;
    Property Hundred: TStrings Index Integer(srHundred) Read FLists[srHundred] Write SetList Stored ListStored;
    Property MaleCurrency: Boolean Index 0 Read FCurrencyGender[0] Write SetCurrencyGender Default True;
    Property MaleCurrencySub: Boolean Index 1 Read FCurrencyGender[1] Write SetCurrencyGender;
    Property MaleOne: TStrings Index Integer(srMaleOne) Read FLists[srMaleOne] Write SetList Stored ListStored;
    Property Thousand: TStrings Index Integer(srThousand) Read FLists[srThousand] Write SetList Stored ListStored;
    Property Million: TStrings Index Integer(srMillion) Read FLists[srMillion] Write SetList Stored ListStored;
    Property Ten: TStrings Index Integer(srTen) Read FLists[srTen] Write SetList Stored ListStored;
    Property UpperStart: Boolean Read FUpperStart Write SetUpperStart Default True;
    Property ValueNumber: Currency Read FValueNumber Write SetValueNumber Stored False;
    Property ValueString: String Read FValueString Write SetValueString Stored False;
    Property Zero: String Read FZero Write SetZero Stored ZeroStored;
    Property ZeroEmptyCurrency: Boolean Index 0 Read FZeroEmpty[0] Write SetZeroEmpty Default True;
    Property ZeroEmptyCurrencySub: Boolean Index 1 Read FZeroEmpty[1] Write SetZeroEmpty Default True;
  End;

  TIniFileType = (ftIniFile, ftMemIniFile, ftRegIniFile, ftUserDefined);

  TRegistryRoot = (rtCurrentUser, rtLocalMachine, rtCurrentConfig,
    rtClassesRoot, rtUsers, rtDynData);

  {$IFDEF _D4_}
  TCreateIniFileEvent = Procedure(Sender: TObject;
    Var IniFile: TCustomIniFile) Of Object;

  TIniFileLink = Class;

  { TAppIniFile }
  TAppIniFile = Class(TComponent)
  Private
    FIniFile: TCustomIniFile;
    FIniFileName: String;
    FIniFileType: TIniFileType;
    FLinks: TList;
    FReadCount, FWriteCount: Integer;
    FRegistryRoot: TRegistryRoot;
    FOnCreateIniFile: TCreateIniFileEvent;
    Procedure CheckIniFile;
    Procedure SetIniFileType(Value: TIniFileType);
    Procedure SetIniFileName(Value: String);
    Procedure SetRegistryRoot(Value: TRegistryRoot);
  Protected
    Procedure DoIniCreate;
    Procedure DoIniDestroy;
    Procedure DoLoadLinks;
    Procedure DoSaveLinks;
    Function CreateIniFile: TCustomIniFile; Virtual;
    Function GetIniFileName: String; Virtual;
    Procedure DestroyIniFile;
    Procedure InternalLoad; Virtual;
    Procedure InternalSave; Virtual;
    Procedure InsertIniFileLink(ALink: TIniFileLink);
    Procedure RemoveIniFileLink(ALink: TIniFileLink);
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Function BeginRead: Boolean;
    Procedure EndRead;
    Function BeginWrite: Boolean;
    Procedure EndWrite;
    Procedure Load;
    Procedure Save;
    Property IniFile: TCustomIniFile Read FIniFile;
  Published
    Property IniFileName: String Read GetIniFileName Write SetIniFileName;
    Property IniFileType: TIniFileType Read FIniFileType Write SetIniFileType Default ftRegIniFile;
    Property RegistryRoot: TRegistryRoot Read FRegistryRoot Write SetRegistryRoot Default rtCurrentUser;
    Property OnCreateIniFile: TCreateIniFileEvent Read FOnCreateIniFile Write FOnCreateIniFile;
  End;

  { TIniFileLink }
  TIniFileLink = Class
  Private
    FActive: Boolean;
    FAppSection: String;
    FAppIniFile: TAppIniFile;
    FOnIniCreate, FOnIniDestroy, FOnLoad, FOnSave: TNotifyEvent;
    Procedure SetAppIniFile(Value: TAppIniFile);
    Function GetIniFile: TCustomIniFile;
  Protected
    Procedure InternalIniCreate; Virtual;
    Procedure InternalIniDestroy; Virtual;
    Procedure InternalLoad; Virtual;
    Procedure InternalSave; Virtual;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure IniCreate;
    Procedure IniDestroy;
    Procedure Load;
    Procedure Save;
    Property IniFile: TCustomIniFile Read GetIniFile;
    Property Active: Boolean Read FActive Write FActive;
    Property AppIniFile: TAppIniFile Read FAppIniFile Write SetAppIniFile;
    Property AppSection: String Read FAppSection Write FAppSection;
    Property OnIniCreate: TNotifyEvent Read FOnIniCreate Write FOnIniCreate;
    Property OnIniDestroy: TNotifyEvent Read FOnIniDestroy Write FOnIniDestroy;
    Property OnLoad: TNotifyEvent Read FOnLoad Write FOnLoad;
    Property OnSave: TNotifyEvent Read FOnSave Write FOnSave;
  End;

  TStoredValue = Class;
  TStoredValues = Class;

  TStoredValueEvent = Procedure(Sender: TStoredValue; Var Value: Variant) Of Object;

  { TStoredValue }
  TStoredValue = Class(TNamedCollectionItem)
  Private
    FValue: Variant;
    FOnLoad, FOnSave: TStoredValueEvent;
    Function IsValueStored: Boolean;
    Function GetStoredValues: TStoredValues;
  Protected
    Procedure InternalLoad; Virtual;
    Procedure InternalSave; Virtual;
  Public
    Constructor Create(Collection: TCollection); Override;
    Procedure Assign(Source: TPersistent); Override;
    Procedure Clear;
    Procedure Save;
    Procedure Load;
    Property StoredValues: TStoredValues Read GetStoredValues;
  Published
    Property Value: Variant Read FValue Write FValue Stored IsValueStored;
    Property OnLoad: TStoredValueEvent Read FOnLoad Write FOnLoad;
    Property OnSave: TStoredValueEvent Read FOnSave Write FOnSave;
  End;

  TPropStorage = Class;

  { TStoredValues }
  TStoredValues = Class(TNamedItemsCollection)
  Private
    Function GetValue(Const Name: String): TStoredValue;
    Procedure SetValue(Const Name: String; StoredValue: TStoredValue);
    Function GetItem(Index: Integer): TStoredValue;
    Procedure SetItem(Index: Integer; StoredValue: TStoredValue);
    Function GetPropStorage: TPropStorage;
  Public
    Constructor Create(AOwner: TPersistent);
    Procedure SaveValues; Virtual;
    Procedure LoadValues; Virtual;
    Property Items[Index: Integer]: TStoredValue Read GetItem Write SetItem; Default;
    Property Values[Const Name: String]: TStoredValue Read GetValue Write SetValue;
    Property PropStorage: TPropStorage Read GetPropStorage;
  End;

  { TPropStorage }
  TPropStorage = Class(TComponent)
  Private
    FIniFileLink: TIniFileLink;
    {$IFDEF _D5_}
    FMasterStorage: TPropStorage;
    FStorages: TList;
    {$ENDIF}
    FStoredProps: TStrings;
    FVersion: Integer;
    FSaved: Boolean;
    FDestroying: Boolean;
    FSaveOnShow: TNotifyEvent;
    FSaveOnDestroy: TNotifyEvent;
    FSaveOnCloseQuery: TCloseQueryEvent;
    FOnLoad, FOnSave: TNotifyEvent;
    FStoredValues: TStoredValues;
    Procedure DoLoadProps;
    Procedure DoSaveProps;
    Function GetActive: Boolean;
    Function GetAppIniFile: TAppIniFile;
    Function GetAppSection: String;
    Function GetStoredProps: TStrings;
    Procedure IniLoad(Sender: TObject);
    Procedure IniSave(Sender: TObject);
    Procedure SetActive(Value: Boolean);
    Procedure SetAppIniFile(Value: TAppIniFile);
    Procedure SetAppSection(Value: String);
    Procedure SetStoredProps(Value: TStrings);
    Procedure SetStoredValues(Value: TStoredValues);
    Procedure StoredPropsChanged(Sender: TObject);
    Procedure HookEvents;
    Procedure UnhookEvents;
    Procedure DoOnShow(Sender: TObject);
    Procedure DoOnCloseQuery(Sender: TObject; Var CanClose: Boolean);
    Procedure DoOnDestroy(Sender: TObject);
    {$IFDEF _D5_}
    Procedure DoLoadLinkedStorages;
    Procedure DoSaveLinkedStorages;
    Function IsLinkedTo(Storage: TPropStorage): Boolean;
    Procedure InsertStorage(Value: TPropStorage);
    Procedure RemoveStorage(Value: TPropStorage);
    Procedure SetMasterStorage(Value: TPropStorage);
    {$ENDIF}
  Protected
    Procedure Loaded; Override;
    Procedure Notification(AComponent: TComponent; Operation: Toperation); Override;
    Procedure InternalLoad; Virtual;
    Procedure InternalSave; Virtual;
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure Load;
    Procedure Save;
  Published
    Property Active: Boolean Read GetActive Write SetActive Default True;
    Property AppIniFile: TAppIniFile Read GetAppIniFile Write SetAppIniFile;
    Property AppSection: String Read GetAppSection Write SetAppSection;
    {$IFDEF _D5_}
    Property MasterStorage: TPropStorage Read FMasterStorage Write SetMasterStorage;
    {$ENDIF}
    Property StoredProps: TStrings Read GetStoredProps Write SetStoredProps;
    Property StoredValues: TStoredValues Read FStoredValues Write SetStoredValues;
    Property Version: Integer Read FVersion Write FVersion Default 0;
    Property OnLoad: TNotifyEvent Read FOnLoad Write FOnLoad;
    Property OnSave: TNotifyEvent Read FOnSave Write FOnSave;
  End;
  {$ENDIF}

Implementation
Uses
  Windows,
  SysUtils,
  vgVCLRes,
  vgUtils,
  Controls{$IFDEF _D4_},
  Registry,
  vgSystem{$ENDIF};

Var
  StringResourcesDefault: Array[TStringResource] Of TStrings;

  { TLocaleStorage }

Constructor TLocaleStorage.Create(AOwner: TComponent);
Begin
  Inherited;
  FSysDefault := True;
End;

Procedure TLocaleStorage.DefaultChanged;
Begin
  FSysDefault := False;
  UpdateText;
End;

Function TLocaleStorage.IsStored: Boolean;
Begin
  Result := Not FSysDefault;
End;

Procedure TLocaleStorage.Loaded;
Begin
  Inherited;
  If Not FSysDefault And Not (CsDesigning In ComponentState) Then Begin
    Write;
    Application.UpdateFormatSettings := False;
  End;
End;

Procedure TLocaleStorage.SetSysDefault(Value: Boolean);
Begin
  If Value Then Read;
  FSysDefault := Value;
End;

Procedure TLocaleStorage.Read;
Begin
  UpdateText;
End;

Procedure TLocaleStorage.Write;
Begin
End;

Procedure TLocaleStorage.SetText(Value: String);
Begin
End;

Procedure TLocaleStorage.UpdateText;
Begin
End;

{ TDateTimeStorage }

Constructor TDateTimeStorage.Create(AOwner: TComponent);
Begin
  Inherited;
  FShortMonthNames := TStringList.Create;
  FLongMonthNames := TStringList.Create;
  FShortDayNames := TStringList.Create;
  FLongDayNames := TStringList.Create;
  Read;
  TStringList(FShortMonthNames).OnChange := StringsChanged;
  TStringList(FLongMonthNames).OnChange := StringsChanged;
  TStringList(FShortDayNames).OnChange := StringsChanged;
  TStringList(FLongDayNames).OnChange := StringsChanged;
  FDateTime := Now;
End;

Destructor TDateTimeStorage.Destroy;
Begin
  FShortMonthNames.Free;
  FLongMonthNames.Free;
  FShortDayNames.Free;
  FLongDayNames.Free;
  Inherited;
End;