dcinternal.pas

DiskControls.v3.8.Full.Source 控制磁盘的控件 包括源代码

      raise Exception.Create(ERROR_NO_INI);

    Ini := TIniFile.Create(FIniFileName);
    try
      try
        DoLoadFromIniFile(Ini);
      except
      end;
    finally
      Ini.Free;
    end;
   end;
{$ENDIF}   
end;

function  TdcRegistrySaver.IsStoreRegKey: Boolean;
begin
  Result := DEF_REGKEY <> FRegKey;
end;

procedure TdcRegistrySaver.SetRegKey(const Value: String);
begin
  FRegKey := ExcludeTrailingBackslash(Value);
end;


{ TdcUniqueList (the TList descendant which can contain only unique pointers (Items) }
function TdcUniqueList.Add(Item: Pointer): Integer;
begin
  if (Item <> nil) and (IndexOf(Item) = -1) then
    Result := inherited Add(Item)
  else
    Result := -1;
end;

procedure TdcUniqueList.Insert(Index: Integer; Item: Pointer);
begin
  if (Item <> nil) and (IndexOf(Item) = -1) then
    inherited Insert(Index, Item)
end;


{ TdcObjectList }
constructor TdcObjectList.Create;
begin
  inherited Create;
  FOwnsObjects := True;
end;

{$IFDEF D4}
constructor TdcObjectList.Create(AOwnsObjects: Boolean; AOwner: TObject = nil);
begin
  inherited Create;
  FOwnsObjects := AOwnsObjects;
  FOwner := AOwner;
end;

constructor TdcObjectList.Create(AStream: TStream; AOwnsObjects: Boolean = True; AOwner: TObject = nil);
begin
  inherited Create;
  if AStream <> nil then
    LoadFromStream(AStream);
  FOwnsObjects := AOwnsObjects;
  FOwner := AOwner;
end;

procedure TdcObjectList.Initialize;
begin
  // abstract
end;
{$ENDIF}

{$IFNDEF D5}
destructor TdcObjectList.Destroy;
begin
  if FOwnsObjects then
    Clear;
end;

procedure TdcObjectList.Clear;
var
  I: Integer;
begin
  if FOwnsObjects and (Count <> 0) then
   for I := Count - 1 downto 0 do
    if Items[I] <> nil then
     TObject(Items[I]).Free;

{$IFDEF D4}
  inherited;
{$ELSE}
  SetCount(0);
  SetCapacity(0);
{$ENDIF}
end;
{$ENDIF}

function TdcObjectList.Add(Item: TObject): Integer;
begin
  if IsCanAddItem(Item) then
    Result := inherited Add(Item)
  else
   begin
    Result := -1;
    if (Item <> nil) and FOwnsObjects then
      Item.Free;
   end; 
end;

function TdcObjectList.Remove(Item: TObject {$IFDEF D4}; ReleaseInstance: Boolean = True {$ENDIF}): Integer;
begin
  Result := IndexOf(Item);
  if Result >= 0 then
    Delete(Result {$IFDEF D4}, ReleaseInstance {$ENDIF});
end;

procedure TdcObjectList.Delete(Index: Integer {$IFDEF D4}; ReleaseInstance: Boolean = True {$ENDIF});
var
{$IFDEF D5}
  OldOwnsObjects: Boolean;
{$ELSE}
  Temp: Pointer;
{$ENDIF}
begin
{$IFDEF D5}
  OldOwnsObjects := FOwnsObjects;
  FOwnsObjects := ReleaseInstance;
{$ELSE}
  Temp := Items[Index];
{$ENDIF}

  inherited Delete(Index);

{$IFDEF D5}
  FOwnsObjects := OldOwnsObjects;
{$ELSE}
  if {$IFDEF D4}ReleaseInstance and {$ENDIF}(Temp <> nil) then
    TObject(Temp).Free;
{$ENDIF}
end;

function TdcObjectList.IndexOf(Item: TObject): Integer;
begin
  Result := inherited IndexOf(Item);
end;

procedure TdcObjectList.Insert(Index: Integer; Item: TObject);
begin
  if IsCanAddItem(Item) then
    inherited Insert(Index, Item)
  else
    if (Item <> nil) and FOwnsObjects then
      Item.Free;
end;

function TdcObjectList.FindInstanceOf(AClass: TClass; AExact: Boolean {$IFDEF D4} = True {$ENDIF}; AStartAt: Integer {$IFDEF D4} = 0 {$ENDIF}): Integer;
begin
  for Result := AStartAt to Count - 1 do
   if (AExact and (TObject(Items[Result]).ClassType = AClass)) or
      (not AExact and TObject(Items[Result]).InheritsFrom(AClass)) then
     Exit;
  Result := -1;
end;

{$IFDEF D4}
procedure TdcObjectList.LoadItemFromStream(Stream: TStream);
begin
  // abstract
end;

procedure TdcObjectList.SaveItemToStream(Index: Integer; Stream: TStream);
begin
  if TObject(Items[Index]) is TdcListObject then
    TdcListObject(Items[Index]).SaveToStream(Stream);
end;

procedure TdcObjectList.LoadFromStream(Stream: TStream; Reset: Boolean {$IFDEF D4} = True {$ENDIF});
var
  I: Integer;
begin
  if Reset then Clear; // clear before load new values

  Stream.Read(I, SizeOf(I));
  if I <> 0 then
   for I := 0 to I - 1 do
     LoadItemFromStream(Stream);
end;

procedure TdcObjectList.SaveToStream(Stream: TStream);
var
  I: Integer;
begin
  Stream.Write(Count, SizeOf(Count));
  if Count <> 0 then
   for I := 0 to Count - 1 do
     SaveItemToStream(I, Stream);
end;
{$ENDIF}

{$IFDEF D5}
procedure TdcObjectList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  case Action of
    lnAdded: DoAdded(Ptr);
    lnExtracted: DoDeleted(Ptr);
    lnDeleted: begin
                DoDeleted(Ptr);
                if FOwnsObjects then
                  TObject(Ptr).Free;
               end;
   end;

  inherited Notify(Ptr, Action);
  DoChanged;
end;

procedure TdcObjectList.DoAdded(Item: TObject);
begin
  if not (csDestroying in Application.ComponentState) and Assigned(FOnAdded) then
    FOnAdded(Self, Item);
end;

procedure TdcObjectList.DoDeleted(Item: TObject);
begin
  if not (csDestroying in Application.ComponentState) and Assigned(FOnDeleted) then
    FOnDeleted(Self, Item);
end;

procedure TdcObjectList.DoChanged;
begin
  if not (csDestroying in Application.ComponentState) and Assigned(FOnChanged) then
    FOnChanged(Self);
end;
{$ENDIF}

function TdcObjectList.IsCanAddItem(Item: TObject): Boolean;
begin
  Result := True;
end;


{$IFDEF D4}
{ TdcListObject }
constructor TdcListObject.Create(aOwner: TdcObjectList; Stream: TStream = nil; AObject: TObject = nil);
begin
  inherited Create;
  FOwner := aOwner;

  Initialize(AObject);

  if Stream <> nil then
    LoadFromStream(Stream, AObject);
end;

procedure TdcListObject.Initialize(AObject: TObject);
begin
  // abstract
end;

procedure TdcListObject.LoadFromStream(Stream: TStream; AObject: TObject = nil);
begin
  // abstract
end;

procedure TdcListObject.SaveToStream(Stream: TStream);
begin
  // abstract
end;
{$ENDIF}



{$IFDEF TRIAL}
constructor TumdcComponent.Create(aOwner: TComponent);
begin
  inherited;

  if not NotifyDone and not (csDesigning in ComponentState) then
   begin
    NotifyDone := True;
    Application.MessageBox('This program built with DiskControls'#13#10 +
                           '(c) by UtilMind Solutions 1999-2002'#13#10#10 +
                           'To register DiskControls pack -'#13#10 +
                           'follow instructions in "readme.txt" file.', 'UNREGISTERED', mb_Ok or mb_IconInformation or mb_SystemModal);
   end;
end;
{$ENDIF}

end.