cxclasses.pas

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

{ TcxEventHandlerCollection }

procedure TcxEventHandlerCollection.Add(AEvent: TcxEventHandler);
var
  ALength: Integer;
begin
  if IndexOf(AEvent) <> -1 then Exit;
  ALength := Length(FEvents);
  SetLength(FEvents, ALength + 1);
  FEvents[ALength] := AEvent;
end;

procedure TcxEventHandlerCollection.CallEvents(Sender: TObject; const AEventArgs);
var
  I: Integer;
begin
  for I := Low(FEvents) to High(FEvents) do
    FEvents[I](Sender, AEventArgs);
end;

procedure TcxEventHandlerCollection.Delete(AIndex: Integer);
var
  ALength, I: Integer;
begin
  ALength := Length(FEvents);
  if (AIndex < 0) or (AIndex >= ALength) then Exit;
  for I := AIndex to ALength - 2 do
    FEvents[I] := FEvents[I + 1];
  SetLength(FEvents, ALength - 1);
end;

function TcxEventHandlerCollection.IndexOf(AEvent: TcxEventHandler): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := Low(FEvents) to High(FEvents) do
    if EqualMethods(TMethod(AEvent), TMethod(FEvents[I])) then
    begin
      Result := I;
      Break;
    end;
end;

procedure TcxEventHandlerCollection.Remove(AEvent: TcxEventHandler);
begin
  Delete(IndexOf(AEvent));
end;

{ TcxRegisteredClassList }

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

destructor TcxRegisteredClassList.Destroy;
begin
  Clear;
  FreeAndNil(FItems);
  inherited Destroy;
end;

procedure TcxRegisteredClassList.Clear;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    TcxRegisteredClassListItemData(FItems[I]).Free;
  FItems.Clear;
end;

function TcxRegisteredClassList.FindClass(AItemClass: TClass): TClass;
var
  AIndex: Integer;
begin
  if Find(AItemClass, AIndex) then
    Result := Items[AIndex].RegisteredClass
  else
    Result := nil;
end;

procedure TcxRegisteredClassList.Register(AItemClass, ARegisteredClass: TClass);
var
  AIndex: Integer;
  AData: TcxRegisteredClassListItemData;
begin
  AIndex := -1;
  AData := TcxRegisteredClassListItemData.Create;
  AData.ItemClass := AItemClass;
  AData.RegisteredClass := ARegisteredClass;
  if Find(AItemClass, AIndex) then
    FItems.Insert(AIndex + 1, AData)
  else
    if AIndex <> -1 then
      FItems.Insert(AIndex, AData)
    else
      FItems.Add(AData);
end;

procedure TcxRegisteredClassList.Unregister(AItemClass, ARegisteredClass: TClass);
var
  I: Integer;
  AData: TcxRegisteredClassListItemData;
begin
  for I := FItems.Count - 1 downto 0 do
  begin
    AData := Items[I];
    if (AData.ItemClass = AItemClass) and (AData.RegisteredClass = ARegisteredClass) then
    begin
      AData.Free;
      FItems.Delete(I);
    end;
  end;
end;

function TcxRegisteredClassList.Find(AItemClass: TClass; var AIndex: Integer): Boolean;
var
  I: Integer;
  AData: TcxRegisteredClassListItemData;
begin
  Result := False;
  for I := FItems.Count - 1 downto 0 do
  begin
    AData := Items[I];
    if AItemClass.InheritsFrom(AData.ItemClass) then
    begin
      AIndex := I;
      Result := True;
      Break;
    end
    else
      if AData.ItemClass.InheritsFrom(AItemClass) then
        AIndex := I;
  end;
end;

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

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

{ TcxRegisteredClasses }

type
  TcxRegisteredClassesStringList = class(TStringList)
  public
    Owner: TcxRegisteredClasses;
  end;

constructor TcxRegisteredClasses.Create(ARegisterClasses: Boolean = False);
begin
  inherited Create;
  FRegisterClasses := ARegisterClasses;
  FItems := TcxRegisteredClassesStringList.Create;
  TcxRegisteredClassesStringList(FItems).Owner := Self;
end;

destructor TcxRegisteredClasses.Destroy;
begin
  Clear;
  FItems.Free;
  inherited Destroy;
end;

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

function TcxRegisteredClasses.GetDescription(Index: Integer): string;
begin
  Result := GetShortHint(FItems[Index]);
end;

function TcxRegisteredClasses.GetHint(Index: Integer): string;
begin
  Result := GetLongHint(FItems[Index]);
end;

function TcxRegisteredClasses.GetItem(Index: Integer): TClass;
begin
  Result := TClass(FItems.Objects[Index]);
end;

procedure TcxRegisteredClasses.SetSorted(Value: Boolean);
begin
  if FSorted <> Value then
  begin
    FSorted := Value;
    if FSorted then Sort;
  end;
end;

function TcxRegisteredClasses.CompareItems(AIndex1, AIndex2: Integer): Integer;
begin
  Result := AnsiCompareText(Descriptions[AIndex1], Descriptions[AIndex2]);
end;

function SortClasses(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := TcxRegisteredClassesStringList(List).Owner.CompareItems(Index1, Index2);
end;

procedure TcxRegisteredClasses.Sort;
begin
  FItems.CustomSort(SortClasses);
end;

procedure TcxRegisteredClasses.Clear;
begin
  FItems.Clear;
end;

function TcxRegisteredClasses.FindByClassName(const AClassName: string): TClass;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    if Items[I].ClassName = AClassName then
    begin
      Result := Items[I];
      Break;
    end;
  end;
end;

function TcxRegisteredClasses.FindByDescription(const ADescription: string): TClass;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    if Descriptions[I] = ADescription then
    begin
      Result := Items[I];
      Break;
    end;
  end;
end;

function TcxRegisteredClasses.GetDescriptionByClass(AClass: TClass): string;
var
  AIndex: Integer;
begin
  AIndex := GetIndexByClass(AClass);
  if AIndex = -1 then
    Result := ''
  else
    Result := Descriptions[AIndex];
end;

function TcxRegisteredClasses.GetHintByClass(AClass: TClass): string;
var
  AIndex: Integer;
begin
  AIndex := GetIndexByClass(AClass);
  if AIndex = -1 then
    Result := ''
  else
    Result := Hints[AIndex];
end;

function TcxRegisteredClasses.GetIndexByClass(AClass: TClass): Integer;
begin
  Result := FItems.IndexOfObject(TObject(AClass));
end;

procedure TcxRegisteredClasses.Register(AClass: TClass; const ADescription: string);
begin
  if GetIndexByClass(AClass) = -1 then
  begin
    FItems.AddObject(ADescription, TObject(AClass));
    if FSorted then Sort;
    if FRegisterClasses then RegisterClass(TPersistentClass(AClass));
  end;
end;

procedure TcxRegisteredClasses.Unregister(AClass: TClass);
var
  I: Integer;
begin
  I := GetIndexByClass(AClass);
  if I <> -1 then
    FItems.Delete(I);
end;

{ TcxAutoWidthItem }

constructor TcxAutoWidthItem.Create;
begin
  inherited;
  AutoWidth := -1;
end;

{ TcxAutoWidthObject }

constructor TcxAutoWidthObject.Create(ACount: Integer);
begin
  inherited Create;
  FItems := TList.Create;
  FItems.Capacity := ACount;
end;

destructor TcxAutoWidthObject.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

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

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

function TcxAutoWidthObject.GetWidth: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
    Inc(Result, Items[I].Width);
end;

procedure TcxAutoWidthObject.Clear;
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do Items[I].Free;
end;

function TcxAutoWidthObject.AddItem: TcxAutoWidthItem;
begin
  Result := TcxAutoWidthItem.Create;
  FItems.Add(Result);
end;

procedure TcxAutoWidthObject.Calculate;
var
  AAvailableWidth, AWidth, ANewAvailableWidth, ANewWidth, AOffset, I,
    AItemAutoWidth: Integer;
  AAssignAllWidths, AItemWithMinWidthFound: Boolean;

  procedure RemoveItemFromCalculation(AItem: TcxAutoWidthItem);
  begin
    with AItem do
    begin
      Dec(ANewAvailableWidth, AutoWidth);
      Dec(ANewWidth, Width);
    end;
  end;

  procedure ProcessFixedItems;
  var
    I: Integer;

    procedure ProcessItem(AItem: TcxAutoWidthItem);
    begin
      with AItem do
        if Fixed then
        begin
          AutoWidth := Width;
          RemoveItemFromCalculation(AItem);
        end;
    end;

  begin
    for I := 0 to Count - 1 do ProcessItem(Items[I]);
  end;

  {procedure ProcessFixedColumns;
  var
    AFixedIndex, I: Integer;
  begin
    if not (gcsColumnSizing in GridDefinition.Controller.State) then Exit;
    AFixedIndex :=
      (GridDefinition.Controller.DragAndDropObject as TcxGridColumnHeaderSizingObject).Column.VisibleIndex;
    if AFixedIndex = Count - 1 then Exit;
    for I := 0 to Count - 1 do
      if I <= AFixedIndex then
      begin
        AColumnWidth := Items[I].CalculateWidth;
        Items[I].Width := AColumnWidth;
        Dec(AAvailableWidth, AColumnWidth);
        Dec(AWidth, AColumnWidth);
      end;
  end;}

  procedure ProcessItem(AItem: TcxAutoWidthItem);

    function CalculateItemAutoWidth: Integer;
    begin
      Result :=
        MulDiv(AOffset + AItem.Width, AAvailableWidth, AWidth) -
        MulDiv(AOffset, AAvailableWidth, AWidth);
    end;

  begin
    AItemAutoWidth := CalculateItemAutoWidth;
    if AAssignAllWidths then
      AItem.AutoWidth := AItemAutoWidth
    else
      if AItemAutoWidth <= AItem.MinWidth then
      begin
        AItem.AutoWidth := AItem.MinWidth;
        RemoveItemFromCalculation(AItem);
        AItemWithMinWidthFound := True;
      end;
    Inc(AOffset, AItem.Width);
  end;

begin
  AAvailableWidth := FAvailableWidth;
  AWidth := Width;

  ANewAvailableWidth := AAvailableWidth;
  ANewWidth := AWidth;
  ProcessFixedItems;
  AAssignAllWidths := False;
  repeat
    AAvailableWidth := ANewAvailableWidth;
    AWidth := ANewWidth;
    AOffset := 0;
    AItemWithMinWidthFound := False;

    for I := 0 to Count - 1 do
      if Items[I].AutoWidth = -1 then ProcessItem(Items[I]);

    if not AItemWithMinWidthFound then
      AAssignAllWidths := not AAssignAllWidths;
  until (ANewWidth = 0) or not AItemWithMinWidthFound and not AAssignAllWidths;
end;

{ TcxAlignment }

constructor TcxAlignment.Create(AOwner: TPersistent; AUseAssignedValues: Boolean = False;
  ADefaultHorz: TAlignment = taLeftJustify; ADefaultVert: TcxAlignmentVert = vaTop);
begin
  inherited Create;
  FOwner := AOwner;
  FUseAssignedValues := AUseAssignedValues;
  FDefaultHorz := ADefaultHorz;
  FDefaultVert := ADefaultVert;
  FHorz := FDefaultHorz;
  FVert := FDefaultVert;
end;

procedure TcxAlignment.Assign(Source: TPersistent);
var
  AChanged: Boolean;
begin
  if Source is TcxAlignment then
    with Source as TcxAlignment do
    begin
      AChanged := Self.FHorz <> FHorz;
      Self.FHorz := FHorz;
      AChanged := AChanged or (Self.FVert <> FVert);
      Self.FVert := FVert;
      Self.FIsHorzAssigned := FIsHorzAssigned;
      Self.FIsVertAssigned := FIsVertAssigned;
      if AChanged then
        Self.DoChanged;
    end
  else
    inherited Assign(Source);