vgstndrt.pas

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

Procedure TDateTimeStorage.Read;
Begin
  FShortDateFormat := SysUtils.ShortDateFormat;
  FLongDateFormat := SysUtils.LongDateFormat;
  FDateSeparator := SysUtils.DateSeparator;
  FTimeSeparator := SysUtils.TimeSeparator;
  FTimeAMString := SysUtils.TimeAMString;
  FTimePMString := SysUtils.TimePMString;
  FShortTimeFormat := SysUtils.ShortTimeFormat;
  FLongTimeFormat := SysUtils.LongTimeFormat;
  //
  StringsAssignTo(FShortMonthNames, SysUtils.ShortMonthNames);
  StringsAssignTo(FLongMonthNames, SysUtils.LongMonthNames);
  StringsAssignTo(FShortDayNames, SysUtils.ShortDayNames);
  StringsAssignTo(FLongDayNames, SysUtils.LongDayNames);
  Inherited;
End;

Procedure TDateTimeStorage.Write;
Begin
  SysUtils.ShortDateFormat := FShortDateFormat;
  SysUtils.LongDateFormat := FLongDateFormat;
  SysUtils.DateSeparator := FDateSeparator;
  SysUtils.TimeSeparator := FTimeSeparator;
  SysUtils.TimeAMString := FTimeAMString;
  SysUtils.TimePMString := FTimePMString;
  SysUtils.ShortTimeFormat := FShortTimeFormat;
  SysUtils.LongTimeFormat := FLongTimeFormat;
  //
  ArrayAssignTo(FShortMonthNames, SysUtils.ShortMonthNames);
  ArrayAssignTo(FLongMonthNames, SysUtils.LongMonthNames);
  ArrayAssignTo(FShortDayNames, SysUtils.ShortDayNames);
  ArrayAssignTo(FLongDayNames, SysUtils.LongDayNames);
End;

Procedure TDateTimeStorage.SetDateTime(Value: Single);
Begin
  FDateTime := Value;
  UpdateText;
End;

Procedure TDateTimeStorage.SetDate(Value: String);
Begin
End;

Procedure TDateTimeStorage.SetTime(Value: String);
Begin
End;

Procedure TDateTimeStorage.SetShortMonthNames(Value: TStrings);
Begin
  FShortMonthNames.Assign(Value);
End;

Procedure TDateTimeStorage.SetLongMonthNames(Value: TStrings);
Begin
  FLongMonthNames.Assign(Value);
End;

Procedure TDateTimeStorage.SetShortDayNames(Value: TStrings);
Begin
  FShortDayNames.Assign(Value);
End;

Procedure TDateTimeStorage.SetLongDayNames(Value: TStrings);
Begin
  FLongDayNames.Assign(Value);
End;

Procedure TDateTimeStorage.SetShortDateFormat(Value: String);
Begin
  If FShortDateFormat <> Value Then Begin
    FShortDateFormat := Value;
    DefaultChanged;
  End;
End;

Procedure TDateTimeStorage.SetLongDateFormat(Value: String);
Begin
  If FLongDateFormat <> Value Then Begin
    FLongDateFormat := Value;
    DefaultChanged;
  End;
End;

Procedure TDateTimeStorage.SetDateSeparator(Value: Char);
Begin
  If FDateSeparator <> Value Then Begin
    FDateSeparator := Value;
    DefaultChanged;
  End;
End;

Procedure TDateTimeStorage.SetTimeSeparator(Value: Char);
Begin
  If FTimeSeparator <> Value Then Begin
    FTimeSeparator := Value;
    DefaultChanged;
  End;
End;

Procedure TDateTimeStorage.SetTimeAMString(Value: String);
Begin
  If FTimeAMString <> Value Then Begin
    FTimeAMString := Value;
    DefaultChanged;
  End;
End;

Procedure TDateTimeStorage.SetTimePMString(Value: String);
Begin
  If FTimePMString <> Value Then Begin
    FTimePMString := Value;
    DefaultChanged;
  End;
End;

Procedure TDateTimeStorage.SetShortTimeFormat(Value: String);
Begin
  If FShortTimeFormat <> Value Then Begin
    FShortTimeFormat := Value;
    DefaultChanged;
  End;
End;

Procedure TDateTimeStorage.SetLongTimeFormat(Value: String);
Begin
  If FLongTimeFormat <> Value Then Begin
    FLongTimeFormat := Value;
    DefaultChanged;
  End;
End;

Procedure TDateTimeStorage.StringsChanged(Sender: TObject);
Begin
  DefaultChanged;
End;

Procedure TDateTimeStorage.UpdateText;
Var
  TmpShortDateFormat: String;
  TmpLongDateFormat: String;
  TmpDateSeparator: Char;
  TmpTimeSeparator: Char;
  TmpTimeAMString: String;
  TmpTimePMString: String;
  TmpShortTimeFormat: String;
  TmpLongTimeFormat: String;
  TmpShortMonthNames, TmpLongMonthNames,
    TmpShortDayNames, TmpLongDayNames: TStrings;
Begin
  TmpShortMonthNames := Nil;
  TmpLongMonthNames := Nil;
  TmpShortDayNames := Nil;
  TmpLongDayNames := Nil;
  Try
    TmpShortMonthNames := TStringList.Create;
    TmpLongMonthNames := TStringList.Create;
    TmpShortDayNames := TStringList.Create;
    TmpLongDayNames := TStringList.Create;
    // saving
    TmpShortDateFormat := SysUtils.ShortDateFormat;
    TmpLongDateFormat := SysUtils.LongDateFormat;
    TmpDateSeparator := SysUtils.DateSeparator;
    TmpTimeSeparator := SysUtils.TimeSeparator;
    TmpTimeAMString := SysUtils.TimeAMString;
    TmpTimePMString := SysUtils.TimePMString;
    TmpShortTimeFormat := SysUtils.ShortTimeFormat;
    TmpLongTimeFormat := SysUtils.LongTimeFormat;

    StringsAssignTo(TmpShortMonthNames, SysUtils.ShortMonthNames);
    StringsAssignTo(TmpLongMonthNames, SysUtils.LongMonthNames);
    StringsAssignTo(TmpShortDayNames, SysUtils.ShortDayNames);
    StringsAssignTo(TmpLongDayNames, SysUtils.LongDayNames);

    Write;

    FText := DateTimeToStr(FDateTime);
    FDate := DateToStr(FDateTime);
    FTime := TimeToStr(FDateTime);
    // restoring
    SysUtils.ShortDateFormat := TmpShortDateFormat;
    SysUtils.LongDateFormat := TmpLongDateFormat;
    SysUtils.DateSeparator := TmpDateSeparator;
    SysUtils.TimeSeparator := TmpTimeSeparator;
    SysUtils.TimeAMString := TmpTimeAMString;
    SysUtils.TimePMString := TmpTimePMString;
    SysUtils.ShortTimeFormat := TmpShortTimeFormat;
    SysUtils.LongTimeFormat := TmpLongTimeFormat;

    ArrayAssignTo(TmpShortMonthNames, SysUtils.ShortMonthNames);
    ArrayAssignTo(TmpLongMonthNames, SysUtils.LongMonthNames);
    ArrayAssignTo(TmpShortDayNames, SysUtils.ShortDayNames);
    ArrayAssignTo(TmpLongDayNames, SysUtils.LongDayNames);
  Finally
    TmpShortMonthNames.Free;
    TmpLongMonthNames.Free;
    TmpShortDayNames.Free;
    TmpLongDayNames.Free;
  End;
End;

{ TCurrencyStorage }

Constructor TCurrencyStorage.Create(AOwner: TComponent);
Begin
  Inherited;
  Read;
  FText := '';
End;

Procedure TCurrencyStorage.Loaded;
Begin
  Inherited;
  If (CsDesigning In ComponentState) Then SetValue(FValue);
End;

Procedure TCurrencyStorage.Read;
Begin
  FCurrencyString := SysUtils.CurrencyString;
  FCurrencyFormat := SysUtils.CurrencyFormat;
  FNegCurrFormat := SysUtils.NegCurrFormat;
  FThousandSeparator := SysUtils.ThousandSeparator;
  FDecimalSeparator := SysUtils.DecimalSeparator;
  FCurrencyDecimals := SysUtils.CurrencyDecimals;
  Inherited;
End;

Procedure TCurrencyStorage.Write;
Begin
  SysUtils.CurrencyString := Self.CurrencyString;
  SysUtils.CurrencyFormat := Self.CurrencyFormat;
  SysUtils.NegCurrFormat := Self.NegCurrFormat;
  SysUtils.ThousandSeparator := Self.ThousandSeparator;
  SysUtils.DecimalSeparator := Self.DecimalSeparator;
  SysUtils.CurrencyDecimals := Self.CurrencyDecimals;
End;

Function TCurrencyStorage.GetText(
  ACurrencyString: String;
  ACurrencyFormat: Byte;
  ANegCurrFormat: Byte;
  AThousandSeparator: Char;
  ADecimalSeparator: Char;
  ACurrencyDecimals: Byte;
  AValue: Single): String;
Var
  SaveCurrencyString: String;
  SaveCurrencyFormat: Byte;
  SaveNegCurrFormat: Byte;
  SaveThousandSeparator: Char;
  SaveDecimalSeparator: Char;
  SaveCurrencyDecimals: Byte;

Begin
  Result := '';
  If (CsLoading In ComponentState) Then Exit;
  SaveCurrencyString := SysUtils.CurrencyString;
  SaveCurrencyFormat := SysUtils.CurrencyFormat;
  SaveNegCurrFormat := SysUtils.NegCurrFormat;
  SaveThousandSeparator := SysUtils.ThousandSeparator;
  SaveDecimalSeparator := SysUtils.DecimalSeparator;
  SaveCurrencyDecimals := SysUtils.CurrencyDecimals;

  Try
    SysUtils.CurrencyString := ACurrencyString;
    SysUtils.CurrencyFormat := ACurrencyFormat;
    SysUtils.NegCurrFormat := ANegCurrFormat;
    SysUtils.ThousandSeparator := AThousandSeparator;
    SysUtils.DecimalSeparator := ADecimalSeparator;
    SysUtils.CurrencyDecimals := ACurrencyDecimals;

    Result := FloatToStrF(AValue, FfCurrency, 19, ACurrencyDecimals);

  Finally
    SysUtils.CurrencyString := SaveCurrencyString;
    SysUtils.CurrencyFormat := SaveCurrencyFormat;
    SysUtils.NegCurrFormat := SaveNegCurrFormat;
    SysUtils.ThousandSeparator := SaveThousandSeparator;
    SysUtils.DecimalSeparator := SaveDecimalSeparator;
    SysUtils.CurrencyDecimals := SaveCurrencyDecimals;
  End;
End;

Function TCurrencyStorage.ValueToStr(Value: Single): String;
Begin
  Result := GetText(
    FCurrencyString,
    FCurrencyFormat,
    FNegCurrFormat,
    FThousandSeparator,
    FDecimalSeparator,
    FCurrencyDecimals,
    FValue);
End;

Procedure TCurrencyStorage.SetCurrencyString(Value: String);
Const
  MaxCurrencyString = 10;
Begin
  Value := Copy(Value, 1, MaxCurrencyString);
  FText := GetText(
    Value,
    FCurrencyFormat,
    FNegCurrFormat,
    FThousandSeparator,
    FDecimalSeparator,
    FCurrencyDecimals,
    FValue);
  FCurrencyString := Value;
  DefaultChanged;
End;

Procedure TCurrencyStorage.SetCurrencyFormat(Value: Byte);
Begin
  FText := GetText(
    FCurrencyString,
    Value,
    FNegCurrFormat,
    FThousandSeparator,
    FDecimalSeparator,
    FCurrencyDecimals,
    FValue);
  FCurrencyFormat := Value;
  DefaultChanged;
End;

Procedure TCurrencyStorage.SetNegCurrFormat(Value: Byte);
Begin
  FText := GetText(
    FCurrencyString,
    FCurrencyFormat,
    Value,
    FThousandSeparator,
    FDecimalSeparator,
    FCurrencyDecimals,
    FValue);
  FNegCurrFormat := Value;
  DefaultChanged;
End;

Procedure TCurrencyStorage.SetThousandSeparator(Value: Char);
Begin
  FText := GetText(
    FCurrencyString,
    FCurrencyFormat,
    FNegCurrFormat,
    Value,
    FDecimalSeparator,
    FCurrencyDecimals,
    FValue);
  FThousandSeparator := Value;
  DefaultChanged;
End;

Procedure TCurrencyStorage.SetDecimalSeparator(Value: Char);
Begin
  FText := GetText(
    FCurrencyString,
    FCurrencyFormat,
    FNegCurrFormat,
    FThousandSeparator,
    Value,
    FCurrencyDecimals,
    FValue);
  FDecimalSeparator := Value;
  DefaultChanged;
End;

Procedure TCurrencyStorage.SetCurrencyDecimals(Value: Byte);
Begin
  FText := GetText(
    FCurrencyString,
    FCurrencyFormat,
    FNegCurrFormat,
    FThousandSeparator,
    FDecimalSeparator,
    Value,
    FValue);
  FCurrencyDecimals := Value;
  DefaultChanged;
End;

Procedure TCurrencyStorage.UpdateText;
Begin
  FText := GetText(
    FCurrencyString,
    FCurrencyFormat,
    FNegCurrFormat,
    FThousandSeparator,
    FDecimalSeparator,
    FCurrencyDecimals,
    FValue);
End;

Procedure TCurrencyStorage.SetValue(Value: Single);
Begin
  FText := GetText(
    FCurrencyString,
    FCurrencyFormat,
    FNegCurrFormat,
    FThousandSeparator,
    FDecimalSeparator,
    FCurrencyDecimals,
    Value);
  FValue := Value;
End;

Procedure TCurrencyStorage.IncorrectValue;
Begin
  Raise EInValidOp.Create('Incorrect value');
End;

{ TMoneyString }
Var
  StringResourcesLoaded: Boolean = False;

Constructor TMoneyString.Create(AOnwer: TComponent);
Var
  I: TStringResource;
Begin
  Inherited;
  If Not StringResourcesLoaded Then Begin
    For I := Low(StringResourcesDefault) To High(StringResourcesDefault) Do Begin
      StringResourcesDefault[I] := TStringList.Create;
      StringResourcesDefault[I].Text := LoadStr(SsrCurrency - Integer(I));
    End;
    StringResourcesLoaded := True;
  End;

  FCurrencyGender[0] := True;
  FUpperStart := True;
  FZeroEmpty[0] := True;
  FZeroEmpty[1] := True;

  For I := Low(TStringResource) To High(TStringResource) Do Begin
    FLists[I] := TStringList.Create;
    TStringList(FLists[I]).OnChange := ListChanged;
  End;

  SetDefault(True);
End;

Destructor TMoneyString.Destroy;
Var
  I: TStringResource;
Begin
  For I := Low(TStringResource) To High(TStringResource) Do
    FLists[I].Free;
  Inherited;
End;

Function TMoneyString.GetString(Strings: TStrings; Index: Integer): String;
Begin
  If Index < Strings.Count Then
    Result := Strings[Index] Else
    Result := '';
End;

Procedure TMoneyString.ListChanged(Sender: TObject);
Var
  I: TStringResource;
Begin
  For I := Low(TStringResource) To High(TStringResource) Do Begin
    If FLists[I] = Sender Then Begin
      FDefault := Not ListStored(Integer(I));
      Break;
    End;
  End;
  SetValueString('');
End;

Function TMoneyString.ListStored(Index: Integer): Boolean;
Begin
  Result := (FLists[TStringResource(Index)].Text <> StringResourcesDefault[TStringResource(Index)].Text);
End;

Function TMoneyString.Triada(Value: Integer; MaleGender: Boolean): String;
Var
  Tmp: Integer;
Begin
  Tmp := Value Div 100;
  Value := Value Mod 100;

  If (Tmp > 0) Then Begin
    Result := GetString(FLists[srHundred], Tmp - 1);
    If Value > 0 Then Result := Result + ' ';
  End Else
    Result := '';

  Tmp := Value Div 10;
  Value := Value Mod 10;

  If (Tmp > 1) Then Begin
    Result := Result + GetString(FLists[srTen], Tmp - 1);
    Tmp := Value;
    If (Tmp > 0) Then Begin
      Result := Result + ' ';
      If MaleGender Then
        Result := Result + GetString(FLists[srMaleOne], Tmp - 1) Else
        Result := Result + GetString(FLists[srFemaleOne], Tmp - 1);
    End;
  End Else Begin
    Tmp := Tmp * 10 + Value;
    Case Tmp Of
      1..9: Begin
          If MaleGender Then
            Result := Result + GetString(FLists[srMaleOne], Tmp - 1) Else
            Result := Result + GetString(FLists[srFemaleOne], Tmp - 1);
        End;
      10: Begin