cxclasses.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,401 行 · 第 1/5 页

end;

procedure TcxAlignment.Reset;
var
  AChanged: Boolean;
begin
  FIsHorzAssigned := False;
  FIsVertAssigned := False;
  AChanged := FHorz <> FDefaultHorz;
  FHorz := FDefaultHorz;
  AChanged := AChanged or (FVert <> FDefaultVert);
  FVert := FDefaultVert;
  if AChanged then
    DoChanged;
end;

procedure TcxAlignment.DoChanged;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

function TcxAlignment.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TcxAlignment.IsHorzStored: Boolean;
begin
  if FUseAssignedValues then
    Result := FIsHorzAssigned
  else
    Result := FHorz <> FDefaultHorz;
end;

function TcxAlignment.IsVertStored: Boolean;
begin
  if FUseAssignedValues then
    Result := FIsVertAssigned
  else
    Result := FVert <> FDefaultVert;
end;

procedure TcxAlignment.SetHorz(const Value: TAlignment);
begin
  FIsHorzAssigned := True;
  if Value <> FHorz then
  begin
    FHorz := Value;
    DoChanged;
  end;
end;

procedure TcxAlignment.SetVert(const Value: TcxAlignmentVert);
begin
  FIsVertAssigned := True;
  if Value <> FVert then
  begin
    FVert := Value;
    DoChanged;
  end;
end;

{ TcxObjectLinkController }

constructor TcxObjectLinkController.Create;
begin
  inherited Create;
  FLinks := TList.Create;
end;

destructor TcxObjectLinkController.Destroy;
begin
  FreeAndNil(FLinks);
  inherited Destroy;
end;

function TcxObjectLinkController.AddLink(AObject: TObject): TcxObjectLink;
begin
  Result := TcxObjectLink.Create;
  Result.Ref := AObject;
  FLinks.Add(Result);
end;

procedure TcxObjectLinkController.RemoveLink(ALink: TcxObjectLink);
begin
  if ALink.Ref <> nil then
    FLinks.Remove(ALink);
  ALink.Free;
end;

procedure TcxObjectLinkController.ClearLinks(AObject: TObject);
var
  I: Integer;
  ALink: TcxObjectLink;
begin
  for I := FLinks.Count - 1 downto 0 do
  begin
    ALink := TcxObjectLink(FLinks[I]);
    if ALink.Ref = AObject then
    begin
      ALink.Ref := nil;
      FLinks.Delete(I);
    end;
  end;
end;

{ TcxFreeNotificator }

procedure TcxFreeNotificator.AddSender(ASender: TComponent);
begin
  if ASender <> nil then
    ASender.FreeNotification(Self);
end;

procedure TcxFreeNotificator.RemoveSender(ASender: TComponent);
begin
{$IFDEF DELPHI5}
  if ASender <> nil then
    ASender.RemoveFreeNotification(Self);
{$ENDIF}
end;

procedure TcxFreeNotificator.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and Assigned(FOnFreeNotification) then
    FOnFreeNotification(AComponent);
end;

procedure AddObjectLinkControllerRefCount;
begin
  Inc(FObjectLinkControllerRefCount);
  if FObjectLinkController = nil then
    FObjectLinkController := TcxObjectLinkController.Create;
end;

procedure ReleaseObjectLinkControllerRefCount;
begin
  Dec(FObjectLinkControllerRefCount);
  if FObjectLinkControllerRefCount = 0 then
    FreeAndNil(FObjectLinkController);
end;

function cxAddObjectLink(AObject: TObject): TcxObjectLink;
begin
  if AObject <> nil then
  begin
    AddObjectLinkControllerRefCount;
    Result := FObjectLinkController.AddLink(AObject);
  end
  else
    Result := nil;
end;

procedure cxRemoveObjectLink(ALink: TcxObjectLink);
begin
  if ALink <> nil then
  begin
    FObjectLinkController.RemoveLink(ALink);
    ReleaseObjectLinkControllerRefCount;
  end;
end;

procedure cxClearObjectLinks(AObject: TObject);
begin
  if FObjectLinkController <> nil then
    FObjectLinkController.ClearLinks(AObject);
end;

{ TcxMRUItems }

constructor TcxMRUItems.Create;
begin
  inherited Create;
  FItems := TList.Create;
end;

destructor TcxMRUItems.Destroy;
begin
  ClearItems;
  FItems.Free;
  inherited;
end;

function TcxMRUItems.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TcxMRUItems.GetItem(Index: Integer): TcxMRUItem;
begin
  Result := TcxMRUItem(FItems[Index]);
end;

procedure TcxMRUItems.SetCount(Value: Integer);
var
  I: Integer;
begin
  if Value < Count then
    for I := Count - 1 downto Value do
      Delete(I);
end;

procedure TcxMRUItems.SetMaxCount(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if FMaxCount <> Value then
  begin
    FMaxCount := Value;
    UpdateCount;
  end;
end;

procedure TcxMRUItems.Delete(AIndex: Integer);
begin
  Items[AIndex].Free;
  FItems.Delete(AIndex);
end;

procedure TcxMRUItems.UpdateCount;
begin
  if MaxCount <> 0 then Count := MaxCount;
end;

procedure TcxMRUItems.Add(AItem: TcxMRUItem);
var
  AIndex: Integer;
begin
  AIndex := IndexOf(AItem);
  if AIndex = -1 then
  begin
    FItems.Insert(0, AItem);
    UpdateCount;
  end
  else
  begin
    FItems.Move(AIndex, 0);
    AItem.Free;
  end;
end;

procedure TcxMRUItems.ClearItems;
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    Delete(I);
end;

function TcxMRUItems.IndexOf(AItem: TcxMRUItem): Integer;
begin
  for Result := 0 to Count - 1 do
    if Items[Result].Equals(AItem) then Exit;
  Result := -1;
end;

{ TcxOpenList }

function TcxOpenList.GetItem(Index: Integer): TObject;
begin
  Result := TObject(inherited Items[Index]);
end;

procedure TcxOpenList.SetItem(Index: Integer; Value: TObject);
begin
  Count := Max(Count, 1 + Index);
  inherited Items[Index] := Value;
end;

{ TcxComponentCollectionItem }

destructor TcxComponentCollectionItem.Destroy;
begin
  SetCollection(nil);
  inherited Destroy;
end;

procedure TcxComponentCollectionItem.Changed(AAllItems: Boolean);
begin
  if not (csDestroying in ComponentState) and (Collection <> nil) then
    if AAllItems then
      Collection.Changed
    else
      Collection.Changed(Self);
end;

function TcxComponentCollectionItem.GetDisplayName: string;
begin
  Result := Name;
end;

function TcxComponentCollectionItem.GetParentComponent: TComponent;
begin
  if Collection <> nil then
    Result := Collection.ParentComponent
  else
    Result := inherited GetParentComponent;
end;

function TcxComponentCollectionItem.HasParent: Boolean;
begin
  Result := GetParentComponent <> nil;
end;

procedure TcxComponentCollectionItem.SetParentComponent(Value: TComponent);
begin
  Collection := GetCollectionFromParent(Value);
end;

procedure TcxComponentCollectionItem.SetCollection(AValue: TcxComponentCollection);
begin
  if Collection <> AValue then
  begin
    RemoveFromCollection(Collection);
    AddToCollection(AValue);
  end;
end;

procedure TcxComponentCollectionItem.SetIndex(AValue: Integer);
var
  ACurIndex: Integer;
begin
  ACurIndex := GetIndex;
  if (ACurIndex >= 0) and (ACurIndex <> AValue) then
  begin
    Collection.FItems.Move(ACurIndex, AValue);
    Changed(True);
  end;
end;

procedure TcxComponentCollectionItem.AddToCollection(ACollection: TcxComponentCollection);
begin
  if ACollection <> nil then
    ACollection.InsertItem(Self);
end;

function TcxComponentCollectionItem.GetIndex: Integer;
begin
  if Collection <> nil then
    Result := Collection.FItems.IndexOf(Self)
  else
    Result := -1;
end;

procedure TcxComponentCollectionItem.RemoveFromCollection(ACollection: TcxComponentCollection);
begin
  if ACollection <> nil then
    ACollection.RemoveItem(Self);
end;

{ TcxComponentCollection }

constructor TcxComponentCollection.Create(AParentComponent: TComponent; AItemClass: TcxComponentCollectionItemClass);
begin
  inherited Create;
  FParentComponent := AParentComponent;
  FItemClass := AItemClass;
  FItems := TList.Create;
end;

destructor TcxComponentCollection.Destroy;
begin
  FUpdateCount := 1;
  if FItems <> nil then
    Clear;
  FItems.Free;
  inherited Destroy;
end;

procedure TcxComponentCollection.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TcxComponentCollection then
  begin
    BeginUpdate;
    try
      Clear;
      for I := 0 to TcxComponentCollection(Source).Count - 1 do
        Add.Assign(TcxComponentCollection(Source).Items[I]);
    finally
      EndUpdate;
    end;
  end
  else
    inherited Assign(Source);
end;

function TcxComponentCollection.Add: TcxComponentCollectionItem;
begin
  Result := FItemClass.Create(ParentComponent.Owner);
  Result.SetParentComponent(ParentComponent);
  SetItemName(Result);
end;

procedure TcxComponentCollection.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TcxComponentCollection.Clear;
begin
  if FItems.Count = 0 then Exit;
  BeginUpdate;
  try
    while FItems.Count > 0 do
      TObject(FItems.Last).Free;
  finally
    EndUpdate;
  end;
end;

procedure TcxComponentCollection.Delete(AIndex: Integer);
begin
  Notify(Items[AIndex], ccnDeleting);
  Items[AIndex].Free;
end;

procedure TcxComponentCollection.EndUpdate(AForceUpdate: Boolean = True);
begin
  Dec(FUpdateCount);
  if AForceUpdate then
    Changed;
end;

function TcxComponentCollection.FindItemByID(ID: Integer): TcxComponentCollectionItem;
var
  I: Integer;
begin
  for I := 0 to FItems.Count-1 do
  begin
    Result := Items[I];
    if Result.ID = ID then
      Exit;
  end;
  Result := nil;
end;

function TcxComponentCollection.Insert(AIndex: Integer): TcxComponentCollectionItem;
begin
  Result := Add;
  Result.Index := AIndex;
end;

procedure TcxComponentCollection.Remove(AItem: TcxComponentCollectionItem);
var
  AIndex: Integer;
begin
  AIndex := FItems.IndexOf(AItem);
  if AIndex > -1 then
    Delete(AIndex);
end;

procedure TcxComponentCollection.InsertItem(AItem: TcxComponentCollectionItem);
begin
  if not (AItem is FItemClass) then
    Exit;
  FItems.Add(AItem);
  AItem.FCollection := Self;
  AItem.FID := FNextID;
  Inc(FNextID);
  Notify(AItem, ccnAdded);
  Changed(AItem, ccnAdded);
end;

procedure TcxComponentCollection.RemoveItem(AItem: TcxComponentCollectionItem);
begin
  Notify(AItem, ccnExtracting);
  FItems.Remove(AItem);
  AItem.FCollection := nil;
  Notify(AItem, ccnExtracted);
  Changed(AItem, ccnExtracted);
end;

procedure TcxComponentCollection.Changed(AItem: TcxComponentCollectionItem = nil;
  AAction: TcxComponentCollectionNotification = ccnChanged);
begin
  if FUpdateCount = 0 then
    Update(AItem, AAction);
end;