vgstndrt.pas

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

          Result := Result + GetString(FLists[srTen], 0);
        End;
      11..19: Begin
          Result := Result + GetString(FLists[srFirstTen], Tmp - 11);
        End;
    End;
  End;
End;

Function TMoneyString.IntegerCurrencyStr(Value: TMoneyInteger; Currency: TStrings): String;
Begin
  If Value Mod 100 In [11..19] Then
    Result := GetString(Currency, 2)
  Else Case (Value Mod 10) Of
      0, 5..9:
        Result := GetString(Currency, 2);
      1:
        Result := GetString(Currency, 0);
      2..4:
        Result := GetString(Currency, 1);
    End;
End;

Function TMoneyString.IntegerGenderedToString(Value: TMoneyInteger; MaleGender: Boolean): String;
Var
  Tmp: TMoneyInteger;
Begin
  If Value = 0 Then Begin
    Result := FZero;
    Exit;
  End;

  Result := '';

  {$IFDEF _D4_}
  Tmp := Value Div 1000000000;
  Value := Value Mod 1000000000;
  If Tmp > 0 Then Begin
    Result := IntegerGenderedToString(Tmp, True) + ' ' +
      IntegerCurrencyStr(Tmp, FLists[srBillion]);
    If Value > 0 Then Result := Result + ' ';
  End;
  {$ENDIF}

  Tmp := Value Div 1000000;
  Value := Value Mod 1000000;
  If Tmp > 0 Then Begin
    Result := Result +
      IntegerGenderedToString(Tmp, True) + ' ' +
      IntegerCurrencyStr(Tmp, FLists[srMillion]);
    If Value > 0 Then Result := Result + ' ';
  End;

  Tmp := Value Div 1000;
  Value := Value Mod 1000;
  If Tmp > 0 Then Begin
    Result := Result +
      IntegerGenderedToString(Tmp, False) + ' ' +
      IntegerCurrencyStr(Tmp, FLists[srThousand]);
    If Value > 0 Then Result := Result + ' ';
  End;

  Tmp := Value;
  If (Tmp > 0) Then
    Result := Result + Triada(Tmp, MaleGender);
End;

Function TMoneyString.IntegerToString(Value: TMoneyInteger): String;
Begin
  Result := IntegerGenderedToString(Value, True);
End;

Function TMoneyString.MoneyToString(Value: Currency): String;
Var
  Curr, CurrSub: TMoneyInteger;
  Tmp, ResultSub: String;
Begin
  Curr := Trunc(Value);
  CurrSub := Round(Frac(Value) * 100);

  If CurrSub = 100 Then Begin
    CurrSub := 0;
    Inc(Curr);
  End;

  { Currency string }
  If FFormats[0] = mfVerbal Then Begin
    If Not ((Curr = 0) And FZeroEmpty[0]) Then
      Result := IntegerGenderedToString(Curr, FCurrencyGender[0]) Else
      Result := '';
  End Else Begin
    If Not ((Curr = 0) And FZeroEmpty[0]) Then
      Result := Format('%.2d', [Curr]) Else
      Result := '';
  End;

  If (Result <> '') Then Begin
    Tmp := IntegerCurrencyStr(Curr, FLists[srCurrency]);
    If Tmp <> '' Then Result := Result + ' ' + Tmp;
  End;

  { CurrencySub string }
  If FFormats[1] = mfVerbal Then Begin
    If Not ((CurrSub = 0) And FZeroEmpty[1]) Then
      ResultSub := IntegerGenderedToString(CurrSub, FCurrencyGender[1]) Else
      ResultSub := '';
  End Else Begin
    If Not ((CurrSub = 0) And FZeroEmpty[1]) Then
      ResultSub := Format('%.2d', [CurrSub]) Else
      ResultSub := '';
  End;

  If (ResultSub <> '') Then Begin
    Tmp := IntegerCurrencyStr(CurrSub, FLists[srCurrencySub]);
    If Tmp <> '' Then ResultSub := ResultSub + ' ' + Tmp;
  End;

  { Concate Currency and CurrencySub strings }
  If Result <> '' Then Begin
    If ResultSub <> '' Then Begin
      If FDelimeter = '' Then
        Result := Result + ' ' + ResultSub Else
        Result := Result + ' ' + Delimeter + ' ' + ResultSub;
    End;
  End Else
    Result := Result + ResultSub;

  If FUpperStart And (Length(Result) > 0) Then Result[1] := AnsiUpperCase(Result[1])[1];
End;

Procedure TMoneyString.SetCurrencyGender(Index: Integer; Value: Boolean);
Begin
  If FCurrencyGender[Index] <> Value Then Begin
    FCurrencyGender[Index] := Value;
    SetValueString('');
  End;
End;

Procedure TMoneyString.SetDefault(Value: Boolean);
Var
  I: TStringResource;
Begin
  If FDefault <> Value Then Begin
    If Value Then Begin
      For I := Low(TStringResource) To High(TStringResource) Do
        SetList(Integer(I), StringResourcesDefault[I]);

      FZero := LoadStr(SsrZero);
    End;
    FDefault := Value;
  End;
End;

Procedure TMoneyString.SetDelimeter(Value: String);
Begin
  If (FDelimeter <> Value) Then Begin
    FDelimeter := Value;
    SetValueString('');
  End;
End;

Procedure TMoneyString.SetFormat(Index: Integer; Value: TMoneyFormat);
Begin
  If (FFormats[Index] <> Value) Then Begin
    FFormats[Index] := Value;
    SetValueString('');
  End;
End;

Procedure TMoneyString.SetList(Index: Integer; Value: TStrings);
Begin
  FLists[TStringResource(Index)].Assign(Value);
End;

Procedure TMoneyString.SetUpperStart(Value: Boolean);
Begin
  If (FUpperStart <> Value) Then Begin
    FUpperStart := Value;
    SetValueString('');
  End;
End;

Procedure TMoneyString.SetValueNumber(Value: Currency);
Begin
  If FValueNumber <> Value Then Begin
    FValueString := MoneyToString(Value);
    FValueNumber := Value;
  End;
End;

Procedure TMoneyString.SetValueString(Value: String);
Begin
  FValueString := MoneyToString(FValueNumber);
End;

Procedure TMoneyString.SetZero(Value: String);
Begin
  If (FZero <> Value) Then Begin
    FZero := Value;
    FDefault := FDefault And Not ZeroStored;
    SetValueString('');
  End;
End;

Procedure TMoneyString.SetZeroEmpty(Index: Integer; Value: Boolean);
Begin
  If (FZeroEmpty[Index] <> Value) Then Begin
    FZeroEmpty[Index] := Value;
    SetValueString('');
  End;
End;

Function TMoneyString.ZeroStored: Boolean;
Begin
  Result := FZero <> LoadStr(SsrZero);
End;

{$IFDEF _D4_}

Function GetDefaultIniFileName: String;
Begin
  Result := ExtractFileName(ChangeFileExt(Application.ExeName, '.ini'));
End;

Function GetDefaultIniRegKey: String;
Begin
  Result := ExtractFileName(ChangeFileExt(Application.ExeName, ''));
  Result := 'Software\' + Result;
End;

Function GetDefaultSection(Component: TComponent): String;
Var
  F: TCustomForm;
  Owner: TComponent;
Begin
  If Assigned(Component) Then Begin
    If (Component Is TCustomForm) Or (Component Is TDataModule) Then
      Result := Component.ClassName
    Else Begin
      Result := Component.Name;
      If Component Is TControl Then Begin
        F := GetParentForm(TControl(Component));
        If F <> Nil Then
          Result := F.ClassName + Result
        Else Begin
          If TControl(Component).Parent <> Nil Then
            Result := TControl(Component).Parent.Name + Result;
        End;
      End Else Begin
        Owner := Component.Owner;
        If (Owner Is TCustomForm) Or (Component Is TDataModule) Then
          Result := Format('%s.%s', [Owner.ClassName, Result]);
      End;
    End;
  End Else
    Result := '';
End;

{ TAppIniFile }

Constructor TAppIniFile.Create(AOwner: TComponent);
Begin
  Inherited;
  FIniFileType := ftRegIniFile;
End;

Destructor TAppIniFile.Destroy;
Begin
  While Assigned(FLinks) Do
    RemoveIniFileLink(FLinks.Last);
  DestroyIniFile;
  Inherited;
End;

Function TAppIniFile.CreateIniFile: TCustomIniFile;
Const
  RegRoots: Array[TRegistryRoot] Of DWORD = (
    HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_CLASSES_ROOT,
    HKEY_CURRENT_CONFIG, HKEY_USERS, HKEY_DYN_DATA);
Begin
  Result := Nil;
  Case FIniFileType Of
    ftIniFile:
      Result := TIniFile.Create(IniFileName);
    ftMemIniFile:
      Result := TMemIniFile.Create(IniFileName);
    ftRegIniFile: Begin
        Result := TRegistryIniFile.Create(IniFileName);
        TRegistryIniFile(Result).RegIniFile.RootKey := RegRoots[FRegistryRoot];
      End;
    ftUserDefined: Begin
        If Assigned(FOnCreateIniFile) Then
          FOnCreateIniFile(Self, Result);
      End;
  End;
End;

Procedure TAppIniFile.CheckIniFile;
Begin
  If Not Assigned(FIniFile) Then
    FIniFile := CreateIniFile;
  DoIniCreate;
End;

Procedure TAppIniFile.DestroyIniFile;
Begin
  If Assigned(FIniFile) Then Begin
    DoIniDestroy;
    FReadCount := 0;
    FWriteCount := 0;
    FreeObject(FIniFile);
  End;
End;

Procedure TAppIniFile.DoIniCreate;
Var
  I: Integer;
Begin
  For I := 0 To ListCount(FLinks) - 1 Do
    TIniFileLink(FLinks.List^[I]).IniCreate;
End;

Procedure TAppIniFile.DoIniDestroy;
Var
  I: Integer;
Begin
  For I := 0 To ListCount(FLinks) - 1 Do
    TIniFileLink(FLinks.List^[I]).IniDestroy;
End;

Procedure TAppIniFile.DoLoadLinks;
Var
  I: Integer;
Begin
  For I := 0 To ListCount(FLinks) - 1 Do
    With TIniFileLink(FLinks.List^[I]) Do
      If Active Then Load;
End;

Procedure TAppIniFile.DoSaveLinks;
Var
  I: Integer;
Begin
  For I := 0 To ListCount(FLinks) - 1 Do
    With TIniFileLink(FLinks.List^[I]) Do
      If Active Then Save;
End;

Function TAppIniFile.GetIniFileName: String;
Begin
  If (FIniFileName = '') And Not (CsDesigning In ComponentState) Then Begin
    If FIniFileType <> ftRegIniFile Then
      Result := GetDefaultIniFileName Else
      Result := GetDefaultIniRegKey;
  End Else
    Result := FIniFileName;
End;

Procedure TAppIniFile.SetIniFileName(Value: String);
Begin
  If (FIniFileName <> Value) Then Begin
    DestroyIniFile;
    FIniFileName := Value;
  End;
End;

Procedure TAppIniFile.SetIniFileType(Value: TIniFileType);
Begin
  If (FIniFileType <> Value) Then Begin
    DestroyIniFile;
    FIniFileType := Value;
  End;
End;

Procedure TAppIniFile.SetRegistryRoot(Value: TRegistryRoot);
Begin
  If (FRegistryRoot <> Value) Then Begin
    DestroyIniFile;
    FRegistryRoot := Value;
  End;
End;

Procedure TAppIniFile.InsertIniFileLink(ALink: TIniFileLink);
Begin
  ListAdd(FLinks, ALink);
  ALink.FAppIniFile := Self;
End;

Procedure TAppIniFile.RemoveIniFileLink(ALink: TIniFileLink);
Begin
  ListRemove(FLinks, ALink);
  ALink.FAppIniFile := Nil;
End;

Function TAppIniFile.BeginRead: Boolean;
Begin
  If FReadCount = 0 Then Begin
    CheckIniFile;
    Result := Assigned(FIniFile);
  End Else
    Result := True;
  If Result Then Inc(FReadCount);
End;

Function TAppIniFile.BeginWrite: Boolean;
Begin
  If FWriteCount = 0 Then Begin
    CheckIniFile;
    Result := Assigned(FIniFile);
  End Else
    Result := True;
  If Result Then Inc(FWriteCount);
End;

Procedure TAppIniFile.EndRead;
Begin
  If FReadCount > 0 Then Begin
    Dec(FReadCount);
    If (FReadCount = 0) And (FWriteCount = 0) Then
      DestroyIniFile;
  End;
End;

Procedure TAppIniFile.EndWrite;
Begin
  If FWriteCount > 0 Then Begin
    Dec(FWriteCount);
    Try
      If (FWriteCount = 0) Then FIniFile.UpdateFile;
    Except
      Application.HandleException(Self);
    End;
    If (FReadCount = 0) And (FWriteCount = 0) Then
      DestroyIniFile;
  End;
End;

Procedure TAppIniFile.InternalLoad;
Begin
  DoLoadLinks;
End;

Procedure TAppIniFile.InternalSave;
Begin
  DoSaveLinks;
End;

Procedure TAppIniFile.Load;
Begin
  If BeginRead Then Try
    InternalLoad;
  Finally
    EndRead;
  End;
End;

Procedure TAppIniFile.Save;
Begin
  If BeginWrite Then Try
    InternalSave;
  Finally
    EndWrite;
  End;
End;

{ TIniFileLink }

Constructor TIniFileLink.Create;
Begin
  Inherited;
  FActive := True;
End;

Destructor TIniFileLink.Destroy;
Begin
  SetAppIniFile(Nil);
  Inherited;
End;

Function TIniFileLink.GetIniFile: TCustomIniFile;
Begin
  If Assigned(FAppIniFile) Then
    Result := FAppIniFile.IniFile Else
    Result := Nil;
End;

Procedure TIniFileLink.InternalLoad;
Begin
  If Assigned(FOnLoad) Then FOnLoad(Self);
End;

Procedure TIniFileLink.InternalSave;
Begin
  If Assigned(FOnSave) Then FOnSave(Self);
End;

Procedure TIniFileLink.InternalIniCreate;
Begin
  If Assigned(FOnIniCreate) Then FOnIniCreate(Self);
End;

Procedure TIniFileLink.InternalIniDestroy;
Begin
  If Assigned(FOnIniDestroy) Then FOnIniDestroy(Self);
End;

Procedure TIniFileLink.IniCreate;
Begin
  InternalIniCreate;
End;

Procedure TIniFileLink.IniDestroy;