vgstndrt.pas

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

Begin
  InternalIniDestroy;
End;

Procedure TIniFileLink.Load;
Begin
  If Assigned(FAppIniFile) And FAppIniFile.BeginRead Then Try
    InternalLoad;
  Finally
    FAppIniFile.EndRead;
  End;
End;

Procedure TIniFileLink.Save;
Begin
  If Assigned(FAppIniFile) And FAppIniFile.BeginWrite Then Try
    InternalSave;
  Finally
    FAppIniFile.EndWrite;
  End;
End;

Procedure TIniFileLink.SetAppIniFile(Value: TAppIniFile);
Begin
  If FAppIniFile <> Value Then Begin
    If Assigned(FAppIniFile) Then FAppIniFile.RemoveIniFileLink(Self);
    If Assigned(Value) Then Value.InsertIniFileLink(Self);
  End;
End;

{ TStoredValue }

Constructor TStoredValue.Create(Collection: TCollection);
Begin
  Inherited Create(Collection);
  FValue := Unassigned;
End;

Procedure TStoredValue.Assign(Source: TPersistent);
Begin
  If (Source Is TStoredValue) Then
    With TStoredValue(Source) Do Begin
      Self.FValue := FValue;
    End
  Else
    Inherited;
End;

Function TStoredValue.GetStoredValues: TStoredValues;
Begin
  Result := TStoredValues(Collection);
End;

Procedure TStoredValue.Clear;
Begin
  FValue := Unassigned;
End;

Function TStoredValue.IsValueStored: Boolean;
Begin
  Result := Not VarIsEmpty(FValue);
End;

Procedure TStoredValue.Save;
Var
  AppIniFile: TAppIniFile;
Begin
  AppIniFile := StoredValues.PropStorage.AppIniFile;
  If Assigned(AppIniFile) And AppIniFile.BeginWrite Then Try
    InternalSave;
  Finally
    AppIniFile.EndWrite;
  End;
End;

Procedure TStoredValue.Load;
Var
  AppIniFile: TAppIniFile;
Begin
  AppIniFile := StoredValues.PropStorage.AppIniFile;
  If Assigned(AppIniFile) And AppIniFile.BeginRead Then Try
    InternalLoad;
  Finally
    AppIniFile.EndRead;
  End;
End;

Procedure TStoredValue.InternalLoad;
Var
  LoadValue: Variant;
  LoadStrValue, DefaultStrValue: String;
Begin
  DefaultStrValue := VarToStr(Value);
  With StoredValues.PropStorage, AppIniFile Do
    LoadStrValue := IniFile.ReadString(AppSection, Self.Name, DefaultStrValue);
  LoadValue := LoadStrValue;
  If Assigned(FOnLoad) Then
    FOnLoad(Self, LoadValue);
  Value := LoadValue;
End;

Procedure TStoredValue.InternalSave;
Var
  SaveValue: Variant;
  SaveStrValue: String;
Begin
  SaveValue := Value;
  If Assigned(FOnSave) Then
    FOnSave(Self, SaveValue);
  SaveStrValue := VarToStr(SaveValue);
  With StoredValues.PropStorage, AppIniFile Do
    IniFile.WriteString(AppSection, Self.Name, SaveStrValue);
End;

{ TStoredValues }

Constructor TStoredValues.Create(AOwner: TPersistent);
Begin
  Inherited Create(AOwner, TStoredValue);
End;

Function TStoredValues.GetItem(Index: Integer): TStoredValue;
Begin
  Result := TStoredValue(Inherited Items[Index]);
End;

Procedure TStoredValues.SetItem(Index: Integer; StoredValue: TStoredValue);
Begin
  Inherited SetItem(Index, TCollectionItem(StoredValue));
End;

Function TStoredValues.GetValue(Const Name: String): TStoredValue;
Var
  I: Integer;
Begin
  I := IndexOf(Name);
  If I >= 0 Then
    Result := Items[I] Else
    Result := Nil;
End;

Procedure TStoredValues.SetValue(Const Name: String; StoredValue: TStoredValue);
Var
  I: Integer;
Begin
  I := IndexOf(Name);
  If I >= 0 Then
    Items[I].Assign(StoredValue);
End;

Procedure TStoredValues.SaveValues;
Var
  I: Integer;
  AppIniFile: TAppIniFile;
Begin
  AppIniFile := PropStorage.AppIniFile;
  If Assigned(AppIniFile) And AppIniFile.BeginWrite Then Try
    For I := 0 To Count - 1 Do
      Items[I].Save;
  Finally
    AppIniFile.EndWrite;
  End;
End;

Procedure TStoredValues.LoadValues;
Var
  I: Integer;
  AppIniFile: TAppIniFile;
Begin
  AppIniFile := PropStorage.AppIniFile;
  If Assigned(AppIniFile) And AppIniFile.BeginRead Then Try
    For I := 0 To Count - 1 Do
      Items[I].Load;
  Finally
    AppIniFile.EndRead;
  End;
End;

Function TStoredValues.GetPropStorage: TPropStorage;
Begin
  Result := GetOwner As TPropStorage;
End;

{ TPropStorage }

Constructor TPropStorage.Create(AOwner: TComponent);
Begin
  Inherited;
  FIniFileLink := TIniFileLink.Create;
  FIniFileLink.OnLoad := IniLoad;
  FIniFileLink.OnSave := IniSave;
  FStoredProps := TStringList.Create;
  With TStringList(FStoredProps) Do Begin
    Duplicates := DupIgnore;
    OnChange := StoredPropsChanged;
  End;
  FStoredValues := TStoredValues.Create(Self);
End;

Destructor TPropStorage.Destroy;
Begin
  If Not (CsDesigning In ComponentState){$IFDEF _D5_} And Not Assigned(FMasterStorage){$ENDIF} Then
    UnhookEvents;
  FreeObject(FStoredProps);
  FStoredValues.Free;
  FIniFileLink.Free;
  Inherited;
End;

Function TPropStorage.GetActive: Boolean;
Begin
  Result := FIniFileLink.Active;
End;

Procedure TPropStorage.SetActive(Value: Boolean);
Begin
  FIniFileLink.Active := Value;
End;

Function TPropStorage.GetAppIniFile: TAppIniFile;
Begin
  Result := FIniFileLink.AppIniFile;
End;

Procedure TPropStorage.SetAppIniFile(Value: TAppIniFile);
Begin
  FIniFileLink.AppIniFile := Value;
End;

Function TPropStorage.GetAppSection: String;
Var
  Tmp: String;
Begin
  Tmp := FIniFileLink.AppSection;
  If (Tmp = '') And Not (CsDesigning In ComponentState) Then
    Result := GetDefaultSection(Owner) Else
    Result := Tmp;
End;

Procedure TPropStorage.SetAppSection(Value: String);
Begin
  FIniFileLink.AppSection := Value;
End;

{$IFDEF _D5_}

Procedure TPropStorage.DoLoadLinkedStorages;
Var
  I: Integer;
Begin
  For I := 0 To ListCount(FStorages) - 1 Do
    TPropStorage(FStorages[I]).Load;
End;

Procedure TPropStorage.DoSaveLinkedStorages;
Var
  I: Integer;
Begin
  For I := 0 To ListCount(FStorages) - 1 Do
    TPropStorage(FStorages[I]).Save;
End;

Function TPropStorage.IsLinkedTo(Storage: TPropStorage): Boolean;
Var
  MasterStorage: TPropStorage;
Begin
  MasterStorage := Self.FMasterStorage;
  While MasterStorage <> Nil Do Begin
    If MasterStorage = Storage Then Begin
      Result := True;
      Exit;
    End;
    MasterStorage := MasterStorage.MasterStorage;
  End;
  Result := False;
End;

Procedure TPropStorage.InsertStorage(Value: TPropStorage);
Begin
  ListAdd(FStorages, Value);
  Value.FMasterStorage := Self;
End;

Procedure TPropStorage.RemoveStorage(Value: TPropStorage);
Begin
  ListRemove(FStorages, Value);
  Value.FMasterStorage := Nil;
End;

Procedure TPropStorage.SetMasterStorage(Value: TPropStorage);
Begin
  If (FMasterStorage <> Value) Then Begin
    If (Value = Self) Or Assigned(Value) And Value.IsLinkedTo(Self) Then
      Raise EInValidOp.Create(LoadStr(SCircularLink));
    If Assigned(FMasterStorage) Then FMasterStorage.RemoveStorage(Self);
    If Assigned(Value) Then Value.InsertStorage(Self);
  End;
End;
{$ENDIF}

Procedure TPropStorage.DoLoadProps;
Begin
  With TPropsFiler.Create(AppIniFile.IniFile, AppSection) Do Try
    Try
      LoadObjectsProps(Owner, FStoredProps);
    Except
    End;
  Finally
    Free;
  End;
End;

Procedure TPropStorage.DoSaveProps;
Begin
  With TPropsFiler.Create(AppIniFile.IniFile, AppSection) Do Try
    StoreObjectsProps(Owner, FStoredProps);
  Finally
    Free;
  End;
End;

Procedure TPropStorage.InternalLoad;
Begin
  DoLoadProps;
  FStoredValues.LoadValues;
  If Assigned(FOnLoad) Then FOnLoad(Self);
  {$IFDEF _D5_}
  DoLoadLinkedStorages;
  {$ENDIF}
End;

Procedure TPropStorage.InternalSave;
Begin
  DoSaveProps;
  FStoredValues.SaveValues;
  If Assigned(FOnSave) Then FOnSave(Self);
  {$IFDEF _D5_}
  DoSaveLinkedStorages;
  {$ENDIF}
End;

Procedure TPropStorage.Loaded;
Var
  Loading: Boolean;
Begin
  Loading := CsLoading In ComponentState;
  Inherited Loaded;
  If Loading Then Begin
    If Not (CsDesigning In ComponentState){$IFDEF _D5_} And Not Assigned(FMasterStorage){$ENDIF} Then
      HookEvents;
    UpdateStoredList(Owner, FStoredProps, True);
  End;
End;

Procedure TPropStorage.Notification(AComponent: TComponent;
  Operation: Toperation);
Var
  I: Integer;
Begin
  Inherited;
  If (Operation = OpRemove) Then Begin
    If Assigned(FStoredProps) Then Begin
      FStoredProps.BeginUpdate;
      Try
        Repeat
          I := FStoredProps.IndexOfObject(AComponent);
          If I >= 0 Then FStoredProps.Delete(I);
        Until I < 0;
      Finally
        FStoredProps.EndUpdate;
      End;
    End;
    {$IFDEF _D5_}
    If (FMasterStorage = AComponent) Then
      SetMasterStorage(Nil);
    {$ENDIF}
  End;
End;

Procedure TPropStorage.Load;
Begin
  FIniFileLink.Load;
End;

Procedure TPropStorage.Save;
Begin
  FIniFileLink.Save;
End;

Procedure TPropStorage.IniLoad(Sender: TObject);
Begin
  InternalLoad;
End;

Procedure TPropStorage.IniSave(Sender: TObject);
Begin
  InternalSave;
End;

Function TPropStorage.GetStoredProps: TStrings;
Begin
  If Not (CsLoading In ComponentState) Then
    UpdateStoredList(Owner, FStoredProps, False);
  Result := FStoredProps;
End;

Procedure TPropStorage.SetStoredProps(Value: TStrings);
Begin
  FStoredProps.Assign(Value);
End;

Procedure TPropStorage.SetStoredValues(Value: TStoredValues);
Begin
  FStoredValues.Assign(Value);
End;

Procedure TPropStorage.StoredPropsChanged(Sender: TObject);
Var
  I: Integer;
  Instance: TComponent;
Begin
  If (CsLoading In ComponentState) Then Exit;
  TStringList(FStoredProps).OnChange := Nil;
  Try
    UpdateStoredList(Owner, FStoredProps, True);
    For I := 0 To FStoredProps.Count - 1 Do Begin
      Instance := TComponent(FStoredProps.Objects[I]);
      FreeNotification(Instance);
    End;
  Finally
    TStringList(FStoredProps).OnChange := StoredPropsChanged;
  End;
End;

Procedure TPropStorage.HookEvents;
Begin
  If Owner Is TCustomForm Then Begin
    With TForm(Owner) Do Begin
      FSaveOnShow := OnShow;
      OnShow := DoOnShow;
      FSaveOnCloseQuery := OnCloseQuery;
      OnCloseQuery := DoOnCloseQuery;
      FSaveOnDestroy := OnDestroy;
      OnDestroy := DoOnDestroy;
    End;
  End Else If Owner Is TDataModule Then Begin
    With TDataModule(Owner) Do Begin
      FSaveOnShow := OnCreate;
      OnCreate := DoOnShow;
      FSaveOnDestroy := OnDestroy;
      OnDestroy := DoOnDestroy;
    End;
  End;
End;

Procedure TPropStorage.UnhookEvents;
Begin
  If (Owner Is TCustomForm) Then Begin
    With TForm(Owner) Do Begin
      OnShow := FSaveOnShow;
      OnCloseQuery := FSaveOnCloseQuery;
      OnDestroy := FSaveOnDestroy;
    End;
  End Else If Owner Is TDataModule Then Begin
    With TDataModule(Owner) Do Begin
      OnCreate := FSaveOnShow;
      OnDestroy := FSaveOnDestroy;
    End;
  End;
End;

Procedure TPropStorage.DoOnShow(Sender: TObject);
Begin
  Try
    Load;
  Except
    Application.HandleException(Self);
  End;
  If Assigned(FSaveOnShow) Then FSaveOnShow(Sender);
End;

Procedure TPropStorage.DoOnCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
  If Assigned(FSaveOnCloseQuery) Then
    FSaveOnCloseQuery(Sender, CanClose);
  If CanClose And (Owner Is TCustomForm) And (TForm(Owner).Handle <> 0) Then Try
    FSaved := True;
    Save;
  Except
    Application.HandleException(Self);
  End;
End;

Procedure TPropStorage.DoOnDestroy(Sender: TObject);
Begin
  If Not FSaved Then Begin
    FDestroying := True;
    Try
      FSaved := True;
      Save;
    Except
      Application.HandleException(Self);
    End;
    FDestroying := False;
  End;
  If Assigned(FSaveOnDestroy) Then FSaveOnDestroy(Sender);
End;
{$ENDIF}

End.