placemnt.pas

RX Library contains a large number of components, objects and routines for Borland Delphi with full

  UpdatePlacement;
end;

{ TWinMinMaxInfo }

procedure TWinMinMaxInfo.Assign(Source: TPersistent);
begin
  if Source is TWinMinMaxInfo then begin
    FMinMaxInfo := TWinMinMaxInfo(Source).FMinMaxInfo;
    if FOwner <> nil then FOwner.MinMaxInfoModified;
  end
  else inherited Assign(Source);
end;

function TWinMinMaxInfo.GetMinMaxInfo(Index: Integer): Integer;
begin
  with FMinMaxInfo do begin
    case Index of
      0: Result := ptMaxPosition.X;
      1: Result := ptMaxPosition.Y;
      2: Result := ptMaxSize.Y;
      3: Result := ptMaxSize.X;
      4: Result := ptMaxTrackSize.Y;
      5: Result := ptMaxTrackSize.X;
      6: Result := ptMinTrackSize.Y;
      7: Result := ptMinTrackSize.X;
      else Result := 0;
    end;
  end;
end;

procedure TWinMinMaxInfo.SetMinMaxInfo(Index: Integer; Value: Integer);
begin
  if GetMinMaxInfo(Index) <> Value then begin
    with FMinMaxInfo do begin
      case Index of
        0: ptMaxPosition.X := Value;
        1: ptMaxPosition.Y := Value;
        2: ptMaxSize.Y := Value;
        3: ptMaxSize.X := Value;
        4: ptMaxTrackSize.Y := Value;
        5: ptMaxTrackSize.X := Value;
        6: ptMinTrackSize.Y := Value;
        7: ptMinTrackSize.X := Value;
      end;
    end;
    if FOwner <> nil then FOwner.MinMaxInfoModified;
  end;
end;

function TWinMinMaxInfo.DefaultMinMaxInfo: Boolean;
begin
  with FMinMaxInfo do begin
    Result := not ((ptMinTrackSize.X <> 0) or (ptMinTrackSize.Y <> 0) or
      (ptMaxTrackSize.X <> 0) or (ptMaxTrackSize.Y <> 0) or
      (ptMaxSize.X <> 0) or (ptMaxSize.Y <> 0) or
      (ptMaxPosition.X <> 0) or (ptMaxPosition.Y <> 0));
  end;
end;

{ TFormStorage }

constructor TFormStorage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStoredProps := TStringList.Create;
{$IFDEF RX_D3}
  FStoredValues := TStoredValues.Create{$IFDEF RX_D4}(Self){$ENDIF RX_D4};
  FStoredValues.Storage := Self;
{$ENDIF RX_D3}
end;

destructor TFormStorage.Destroy;
begin
  FStoredProps.Free;
  FStoredProps := nil;
{$IFDEF RX_D3}
  FStoredValues.Free;
  FStoredValues := nil;
{$ENDIF RX_D3}
  inherited Destroy;
end;

{$IFDEF WIN32}
procedure TFormStorage.SetNotification;
var
  I: Integer;
  Component: TComponent;
begin
  for I := FStoredProps.Count - 1 downto 0 do begin
    Component := TComponent(FStoredProps.Objects[I]);
    if Component <> nil then Component.FreeNotification(Self);
  end;
end;
{$ENDIF WIN32}

procedure TFormStorage.SetStoredProps(Value: TStrings);
begin
  FStoredProps.Assign(Value);
{$IFDEF WIN32}
  SetNotification;
{$ENDIF}
end;

{$IFDEF RX_D3}
procedure TFormStorage.SetStoredValues(Value: TStoredValues);
begin
  FStoredValues.Assign(Value);
end;

function TFormStorage.GetStoredValue(const Name: string): Variant;
begin
  Result := StoredValues.StoredValue[Name];
end;

procedure TFormStorage.SetStoredValue(const Name: string; Value: Variant);
begin
  StoredValues.StoredValue[Name] := Value;
end;

{$ENDIF RX_D3}

procedure TFormStorage.Loaded;
begin
  inherited Loaded;
  UpdateStoredList(Owner, FStoredProps, True);
end;

procedure TFormStorage.WriteState(Writer: TWriter);
begin
  UpdateStoredList(Owner, FStoredProps, False);
  inherited WriteState(Writer);
end;

procedure TFormStorage.Notification(AComponent: TComponent; Operation: TOperation);
var
  I: Integer;
  Component: TComponent;
begin
  inherited Notification(AComponent, Operation);
  if not (csDestroying in ComponentState) and (Operation = opRemove) and
    (FStoredProps <> nil) then
    for I := FStoredProps.Count - 1 downto 0 do begin
      Component := TComponent(FStoredProps.Objects[I]);
      if Component = AComponent then FStoredProps.Delete(I);
    end;
end;

procedure TFormStorage.SaveProperties;
begin
  with TPropsStorage.Create do
  try
    Section := IniSection;
    OnWriteString := DoWriteString;
{$IFDEF WIN32}
    if UseRegistry then OnEraseSection := FRegIniFile.EraseSection
    else OnEraseSection := FIniFile.EraseSection;
{$ELSE}
    OnEraseSection := FIniFile.EraseSection;
{$ENDIF WIN32}
    StoreObjectsProps(Owner, FStoredProps);
  finally
    Free;
  end;
end;

procedure TFormStorage.RestoreProperties;
begin
  with TPropsStorage.Create do
  try
    Section := IniSection;
    OnReadString := DoReadString;
    try
      LoadObjectsProps(Owner, FStoredProps);
    except
      { ignore any exceptions }
    end;
  finally
    Free;
  end;
end;

procedure TFormStorage.SavePlacement;
begin
  inherited SavePlacement;
  SaveProperties;
{$IFDEF RX_D3}
  StoredValues.SaveValues;
{$ENDIF}
end;

procedure TFormStorage.RestorePlacement;
begin
  inherited RestorePlacement;
  FRestored := True;
  RestoreProperties;
{$IFDEF RX_D3}
  StoredValues.RestoreValues;
{$ENDIF}
end;

{ TIniLink }

destructor TIniLink.Destroy;
begin
  FOnSave := nil;
  FOnLoad := nil;
  SetStorage(nil);
  inherited Destroy;
end;

function TIniLink.GetIniObject: TObject;
begin
  if Assigned(FStorage) then Result := FStorage.IniFileObject
  else Result := nil;
end;

function TIniLink.GetRootSection: string;
begin
  if Assigned(FStorage) then Result := FStorage.FIniSection else Result := '';
  if Result <> '' then Result := Result + '\';
end;

procedure TIniLink.SetStorage(Value: TFormPlacement);
begin
  if FStorage <> Value then begin
    if FStorage <> nil then FStorage.RemoveLink(Self);
    if Value <> nil then Value.AddLink(Self);
  end;
end;

procedure TIniLink.SaveToIni;
begin
  if Assigned(FOnSave) then FOnSave(Self);
end;

procedure TIniLink.LoadFromIni;
begin
  if Assigned(FOnLoad) then FOnLoad(Self);
end;

{$IFDEF RX_D3}

{ TStoredValue }

constructor TStoredValue.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FValue := Unassigned;
end;

procedure TStoredValue.Assign(Source: TPersistent);
begin
  if (Source is TStoredValue) and (Source <> nil) then begin
    if VarIsEmpty(TStoredValue(Source).FValue) then
      Clear
    else
      Value := TStoredValue(Source).FValue;
    Name := TStoredValue(Source).Name;
    KeyString := TStoredValue(Source).KeyString;
  end;
end;

function TStoredValue.GetDisplayName: string;
begin
  if FName = '' then
    Result := inherited GetDisplayName
  else
    Result := FName;
end;

procedure TStoredValue.SetDisplayName(const Value: string);
begin
  if (Value <> '') and (AnsiCompareText(Value, FName) <> 0) and
    (Collection is TStoredValues) and (TStoredValues(Collection).IndexOf(Value) >= 0) then
    raise Exception.Create(SDuplicateString);
  FName := Value;
  inherited;
end;

function TStoredValue.GetStoredValues: TStoredValues;
begin
  if Collection is TStoredValues then
    Result := TStoredValues(Collection)
  else
    Result := nil;
end;

procedure TStoredValue.Clear;
begin
  FValue := Unassigned;
end;

function TStoredValue.IsValueStored: Boolean;
begin
  Result := not VarIsEmpty(FValue);
end;

procedure TStoredValue.Save;
var
  SaveValue: Variant;
  SaveStrValue: string;
begin
  SaveValue := Value;
  if Assigned(FOnSave) then
    FOnSave(Self, SaveValue);
  SaveStrValue := VarToStr(SaveValue);
  if KeyString <> '' then
    SaveStrValue := XorEncode(KeyString, SaveStrValue);
  StoredValues.Storage.WriteString(Name, SaveStrValue);
end;

procedure TStoredValue.Restore;
var
  RestoreValue: Variant;
  RestoreStrValue, DefaultStrValue: string;
begin
  DefaultStrValue := VarToStr(Value);
  if KeyString <> '' then
    DefaultStrValue := XorEncode(KeyString, DefaultStrValue);
  RestoreStrValue := StoredValues.Storage.ReadString(Name, DefaultStrValue);
  if KeyString <> '' then
    RestoreStrValue := XorDecode(KeyString, RestoreStrValue);
  RestoreValue := RestoreStrValue;
  if Assigned(FOnRestore) then
    FOnRestore(Self, RestoreValue);
  Value := RestoreValue;  
end;

{ TStoredValues }

{$IFDEF RX_D4}
constructor TStoredValues.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TStoredValue);
end;
{$ELSE}
constructor TStoredValues.Create;
begin
  inherited Create(TStoredValue);
end;
{$ENDIF}

function TStoredValues.IndexOf(const Name: string): Integer;
begin
  for Result := 0 to Count - 1 do
    if AnsiCompareText(Items[Result].Name, Name) = 0 then Exit;
  Result := -1;
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.GetStoredValue(const Name: string): Variant;
var
  StoredValue: TStoredValue;
begin
  StoredValue := GetValue(Name);
  if StoredValue = nil then Result := Null
  else Result := StoredValue.Value;
end;

procedure TStoredValues.SetStoredValue(const Name: string; Value: Variant);
var
  StoredValue: TStoredValue;
begin
  StoredValue := GetValue(Name);
  if StoredValue = nil then begin
    StoredValue := TStoredValue(Add);
    StoredValue.Name := Name; 
    StoredValue.Value := Value;
  end
  else StoredValue.Value := Value;
end;

function TStoredValues.GetValue(const Name: string): TStoredValue;
var
  I: Integer;
begin
  I := IndexOf(Name);
  if I < 0 then
    Result := nil
  else
    Result := Items[I];
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;
begin
  for I := 0 to Count - 1 do
    Items[I].Save;
end;

procedure TStoredValues.RestoreValues;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].Restore;
end;

{$ENDIF RX_D3}

end.