cxheader.pas

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

  else
    RestoreScreenCursor;
end;

procedure TcxCustomHeader.UpdatePressedSection;
begin
  if UnderMouseSectionIndex <> FSelectedSectionIndex then
    SetSectionState(FSelectedSectionIndex, cxbsNormal)
  else
    SetSectionState(FSelectedSectionIndex, cxbsPressed);
end;

procedure TcxCustomHeader.UpdateSizedSection;
var
  ASectionRect: TRect;
  APoint: TPoint;
  ASizedSectionIndex, AUnderMouseSectionIndex: Integer;
begin
  GetCursorPos(APoint);
  APoint := ScreenToClient(APoint);
  ASizedSectionIndex := -1;
  AUnderMouseSectionIndex := GetSectionIndexAtPos(APoint.X, APoint.Y, True);
  if AUnderMouseSectionIndex >= 0 then
  begin
    ASectionRect := GetSectionRect(AUnderMouseSectionIndex);
    if (AUnderMouseSectionIndex < FSections.Count) and
      (APoint.X >= ASectionRect.Right - 7) and (APoint.X <= ASectionRect.Right) then
      ASizedSectionIndex := AUnderMouseSectionIndex
    else
      if (AUnderMouseSectionIndex > 0) and
        (APoint.X >= ASectionRect.Left) and (APoint.X <= ASectionRect.Left + 7) then
        ASizedSectionIndex := AUnderMouseSectionIndex - 1;
    if (ASizedSectionIndex > -1) and not Sections[ASizedSectionIndex].AllowResize then
      ASizedSectionIndex := -1;
  end;
  SizedSectionIndex := ASizedSectionIndex;
end;

procedure TcxCustomHeader.UpdateUnderMouseSection;
var
  APoint: TPoint;
begin
  GetCursorPos(APoint);
  APoint := ScreenToClient(APoint);
  UnderMouseSectionIndex := GetSectionIndexAtPos(APoint.X, APoint.Y);
end;

procedure TcxCustomHeader.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  BeginMouseTracking(Self, ClientRect, Self);
end;

procedure TcxCustomHeader.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  EndMouseTracking(Self);
  case FState of
    hsNone:
      begin
        UnderMouseSectionIndex := -1;
        SizedSectionIndex := -1;
        HotSectionIndex := -1;
      end;
  end;
end;

procedure TcxCustomHeader.SetAllowSort(Value: Boolean);
begin
  if FAllowSort <> Value then
  begin
    FAllowSort := Value;
    if not FAllowSort then DisableSort;
  end;
end;

procedure TcxCustomHeader.DisableSort;
var
  I: Integer;
begin
  Sections.BeginUpdate;
  try
    for I := 0 to Sections.Count - 1 do
      Sections[I].SortOrder := soNone;
  finally
    Sections.EndUpdate;
  end;
end;

procedure TcxCustomHeader.FitToClientWidth;
var
  ASectionWidths: TcxHeaderSectionWidths;
  ASectionWidthsChanged: Boolean;
  I: Integer;
begin
  if not HandleAllocated or (csReading in ComponentState) then
    Exit;
  CalcSectionWidths(Width, ASectionWidths);
  ASectionWidthsChanged := False;
  for I := 0 to Sections.Count - 1 do
    if Sections[I].Width <> ASectionWidths[I] then
    begin
      ASectionWidthsChanged := True;
      Break;
    end;
  if ASectionWidthsChanged then
  begin
    FSectionsFitCalculating := True;
    try
      Sections.BeginUpdate;
      try
        for I := 0 to Sections.Count - 1 do
          Sections[I].Width := ASectionWidths[I];
      finally
        Sections.EndUpdate;
      end;
    finally
      FSectionsFitCalculating := False;
    end;
  end;
end;

function TcxCustomHeader.GetSectionContentBounds(ASectionBounds: TRect;
      AState: TcxButtonState): TRect;
begin
  Result := LookAndFeel.Painter.HeaderControlSectionContentBounds(
    ASectionBounds, AState);
end;

function TcxCustomHeader.IsInnerControl: Boolean;
begin
  Result := False;
end;

{ TcxHeaderSection }
constructor TcxHeaderSection.Create(Collection: TCollection);
begin
  FWidth := 50;
  FMaxWidth := 1000;
  FMinWidth := 30;
  FAllowClick := False;
  FImageIndex := -1;
  FParentBiDiMode := True;
  inherited Create(Collection);
  ParentBiDiModeChanged;
  FDataIndex := Index;
  FAllowResize := True;
end;

procedure TcxHeaderSection.Assign(Source: TPersistent);
var
  ASection: TcxHeaderSection;
begin
  if Source is TcxHeaderSection then
  begin
    ASection := TcxHeaderSection(Source);
    Alignment := ASection.Alignment;
    AllowClick := ASection.AllowClick;
    AllowResize := ASection.AllowResize;
    AutoSize := ASection.AutoSize;
    BiDiMode := ASection.BiDiMode;
    DataIndex := ASection.DataIndex;
    ImageIndex := ASection.ImageIndex;
    MinWidth := ASection.MinWidth;
    MaxWidth := ASection.MaxWidth;
    ParentBiDiMode := ASection.ParentBiDiMode;
    SortOrder := ASection.SortOrder;
    Text := ASection.Text;
    Width := ASection.Width;
  end
  else
    inherited Assign(Source);
end;

procedure TcxHeaderSection.SetBiDiMode(Value: TBiDiMode);
begin
  if Value <> FBiDiMode then
  begin
    FBiDiMode := Value;
    FParentBiDiMode := False;
    Changed(False);
  end;
end;

procedure TcxHeaderSection.SetDataIndex(Value: Integer);
begin
  if Value < -1 then
    Value := -1;
  if Value <> FDataIndex then
  begin
    FDataIndex := Value;
    Changed(False);
  end;
end;

function TcxHeaderSection.IsBiDiModeStored: Boolean;
begin
  Result := not FParentBiDiMode;
end;

function TcxHeaderSection.IsDataIndexStored: Boolean;
begin
  Result := FDataIndex <> Index;
end;

function TcxHeaderSection.GetHeaderControl: TcxCustomHeader;
begin
  Result := TcxHeaderSections(Collection).FHeaderControl;
end;

procedure TcxHeaderSection.SetParentBiDiMode(Value: Boolean);
begin
  if FParentBiDiMode <> Value then
  begin
    FParentBiDiMode := Value;
    ParentBiDiModeChanged;
  end;
end;

procedure TcxHeaderSection.SetState(Value: TcxButtonState);
begin
  if FState <> Value then
  begin
    FState := Value;
    Changed(False);
  end;
end;

procedure TcxHeaderSection.ParentBiDiModeChanged;
begin
  if FParentBiDiMode then
  begin
    if GetOwner <> nil then
    begin
      BiDiMode := TcxHeaderSections(GetOwner).FHeaderControl.BiDiMode;
      FParentBiDiMode := True;
    end;
  end;
end;

function TcxHeaderSection.UseRightToLeftReading: Boolean;
begin
  Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight);
end;

function TcxHeaderSection.UseRightToLeftAlignment: Boolean;
begin
  Result := SysLocale.MiddleEast and (BiDiMode = bdRightToLeft);
end;

function TcxHeaderSection.GetDisplayName: string;
begin
  Result := Text;
  if Result = '' then
    Result := inherited GetDisplayName;
end;

function TcxHeaderSection.GetLeft: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Index - 1 do
    Inc(Result, TcxHeaderSections(Collection)[I].Width);
end;

function TcxHeaderSection.GetRight: Integer;
begin
  Result := Left + Width;
end;

procedure TcxHeaderSection.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Changed(False);
  end;
end;

procedure TcxHeaderSection.SetAutoSize(Value: Boolean);
begin
  if Value <> FAutoSize then
  begin
    FAutoSize := Value;
    if TcxHeaderSections(Collection).FHeaderControl <> nil then
      TcxHeaderSections(Collection).FHeaderControl.AdjustSize;
    Changed(True);
  end;
end;

procedure TcxHeaderSection.SetMaxWidth(Value: TcxNaturalNumber);
begin
  if Value < FMinWidth then
    Value := FMinWidth;
  if Value > 10000 then
    Value := 10000;
  FMaxWidth := Value;
  SetWidth(FWidth);
end;

procedure TcxHeaderSection.SetMinWidth(Value: TcxNaturalNumber);
begin
  if Value > FMaxWidth then
    Value := FMaxWidth;
  FMinWidth := Value;
  SetWidth(FWidth);
end;

procedure TcxHeaderSection.SetText(const Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    Changed(False);
  end;
end;

procedure TcxHeaderSection.SetSortOrder(Value: TcxHeaderSortOrder);
begin
  if FSortOrder <> Value then
  begin
    FSortOrder := Value;
    Changed(False);
  end;
end;

procedure TcxHeaderSection.SetWidth(Value: Integer);
begin
  if Value < FMinWidth then
    Value := FMinWidth;
  if Value > FMaxWidth then
    Value := FMaxWidth;
  if FWidth <> Value then
  begin
    FWidth := Value;
    Changed(True);

    if Collection <> nil then
    begin
      TcxHeaderSections(Collection).FHeaderControl.DoSectionResizeEvent(Self);
      TcxHeaderSections(Collection).FHeaderControl.DoSectionEndResizeEvent(Self);
    end;
  end;
end;

procedure TcxHeaderSection.SetImageIndex(const Value: TImageIndex);
begin
  if Value <> FImageIndex then
  begin
    FImageIndex := Value;
    Changed(False);
  end;
end;

{ TcxHeaderSections }

constructor TcxHeaderSections.Create(HeaderControl: TcxCustomHeader);
begin
  inherited Create(TcxHeaderSection);
  FHeaderControl := HeaderControl;
end;

procedure TcxHeaderSections.Assign(Source: TPersistent);
var
  FHeaderSection: TcxHeaderSection;
  I: Integer;
begin
  if (Source is TcxHeaderSections) then
  begin
    Clear;
    for I := 0 to (Source as TcxHeaderSections).Count - 1 do
    begin
      FHeaderSection := Add;
      FHeaderSection.Assign((Source as TcxHeaderSections).Items[I]);
    end;
  end
  else
    inherited Assign(Source);
end;

function TcxHeaderSections.Add: TcxHeaderSection;
begin
  Result := TcxHeaderSection.Create(Self);
end;

function TcxHeaderSections.GetItem(Index: Integer): TcxHeaderSection;
begin
  Result := TcxHeaderSection(inherited GetItem(Index));
end;

function TcxHeaderSections.GetOwner: TPersistent;
begin
  Result := FHeaderControl;
end;

procedure TcxHeaderSections.SetItem(Index: Integer; Value: TcxHeaderSection);
begin
  inherited SetItem(Index, Value);
end;

procedure TcxHeaderSections.Update(Item: TCollectionItem);
begin
  if FHeaderControl <> nil then
  begin
    if Item <> nil then
    begin
      FHeaderControl.UpdateSection(Item.Index);
      FHeaderControl.DoSectionChange;
    end
    else
    begin
      if not FHeaderControl.FSectionsFitCalculating then
        FHeaderControl.FitToClientWidth;
      FHeaderControl.UpdateSections;
      FHeaderControl.DoSectionsChange;
    end;
  end;
end;
 
function TcxHeaderSections.Insert(Index: Integer): TcxHeaderSection;
begin
  BeginUpdate;
  try
    if Index < 0 then Index := 0;
    if Index > Count then Index := Count - 1;

    Result := Add;
    Result.Index := Index;
  finally
    EndUpdate;
  end;
end;
{ TcxHeaderSections }

end.