cxheader.pas

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

        ATextRect.Left := Result.Left + AImages.Width + ImageTextOffset;
      taRightJustify:
        begin
          Result.Left := ATextRect.Right - ATextWidth - AImages.Width - ImageTextOffset;
          if Result.Left < ATextRect.Left then
          begin
            Result.Left := ATextRect.Left;
            Inc(ATextRect.Left, AImages.Width + ImageTextOffset);
            AHeaderItemInfo.SectionAlignment := taLeftJustify
          end;
        end;
      taCenter:
        begin
          Result.Left := ATextRect.Left + ((ATextRect.Right - ATextRect.Left) -
            AImages.Width - ImageTextOffset - ATextWidth) div 2;
          if Result.Left < ATextRect.Left then
          begin
            Result.Left := ATextRect.Left;
            AHeaderItemInfo.SectionAlignment := taLeftJustify
          end;
          Inc(ATextRect.Left, AImages.Width + ImageTextOffset);
        end;
    end;
  end;

var
  ANormalContentRect, ATextRect, AImageRect: TRect;
  AClipRegion: TcxRegion;
  ASavedBrushColor: TColor;
  AItemCount: Integer;
  AHeaderRect: TRect;
  AHeaderItemInfo: THeaderItemInfo;
begin
  AItemCount := Header_GetItemCount(AHeaderHandle);
  GetWindowRect(AHeaderHandle, AHeaderRect);
  AHeaderRect := Rect(0, 0, AHeaderRect.Right - AHeaderRect.Left,
    AHeaderRect.Bottom - AHeaderRect.Top);
  if AItemCount = 0 then
  begin
    ACanvas.FillRect(AHeaderRect);
    Exit;
  end;

  SendGetStructMessage(AHeaderHandle, CM_GETHEADERITEMINFO, AIndex, AHeaderItemInfo);

  if (AIndex = AItemCount) then
    AHeaderItemInfo.Rect.Right := AHeaderRect.Right + 10
  else
    if not ALookAndFeel.NativeStyle and (ALookAndFeel.Kind = lfUltraFlat) then
      Inc(AHeaderItemInfo.Rect.Right);

  ANormalContentRect := ALookAndFeel.Painter.HeaderControlSectionContentBounds(AHeaderItemInfo.Rect, cxbsNormal);
  ATextRect := GetTextRect(ANormalContentRect, AHeaderItemInfo.SortOrder);

  if Assigned(AImages) and (AHeaderItemInfo.ImageIndex >= 0) then
    AImageRect := GetImageRect(ATextRect, AHeaderItemInfo);

  ASavedBrushColor := ACanvas.Brush.Color;
  AClipRegion := ACanvas.GetClipRegion;
  try
    ACanvas.SetClipRegion(TcxRegion.Create(AHeaderItemInfo.Rect), roIntersect);
    ALookAndFeel.Painter.DrawHeaderControlSection(ACanvas, AHeaderItemInfo.Rect, ATextRect,
      [nRight], cxBordersAll, AHeaderItemInfo.State, AHeaderItemInfo.SectionAlignment, vaCenter, False,
      True, AHeaderItemInfo.Text, ACanvas.Font, ACanvas.Font.Color, ACanvas.Brush.Color);

    ACanvas.SetClipRegion(TcxRegion.Create(ANormalContentRect), roIntersect);

    if Assigned(AImages) and (AHeaderItemInfo.ImageIndex >= 0) then
      ACanvas.DrawImage(AImages, AImageRect.Left, AImageRect.Top +
        (AImageRect.Bottom - AImageRect.Top - AImages.Height) div 2,
        AHeaderItemInfo.ImageIndex);

    DrawSortingMark(AHeaderItemInfo.Rect, AHeaderItemInfo.SortOrder);
  finally
    ACanvas.SetClipRegion(AClipRegion, roSet);
    ACanvas.Brush.Color := ASavedBrushColor;
  end;
end;

function SendGetStructMessage(Handle: HWND; Msg: UINT; WParam: WPARAM;
  var LParam): LRESULT;
begin
  Result := SendMessage(Handle, Msg, WParam, Integer(@LParam));
end;

function GetNextSortOrder(ASortOrder: TcxHeaderSortOrder;
  ADeleteSorting: Boolean): TcxHeaderSortOrder;
begin
  if ADeleteSorting then
    Result := soNone
  else
    if ASortOrder = soAscending then
      Result := soDescending
    else
      Result := soAscending;
end;

{ TcxCustomHeader }

procedure TcxCustomHeader.CMBiDiModeChanged(var Message: TMessage);
var
  I: Integer;
begin
  inherited;
  if HandleAllocated then
    for I := 0 to Sections.Count - 1 do
      if Sections[I].ParentBiDiMode then
        Sections[I].ParentBiDiModeChanged;
end;

procedure TcxCustomHeader.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

constructor TcxCustomHeader.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [];
  DoubleBuffered := True;
  Height := 17;
  Width := 117;

  FAllowSort := True;
  FResizeUpdate := True;
  FSectionStream := nil;
  FSelectedSectionIndex := -1;
  FSizedSectionIndex := -1;
  FUnderMouseSectionIndex := -1;
  FHotSectionIndex := -1;

  FSections := TcxHeaderSections.Create(Self);
  FImagesChangeLink := TChangeLink.Create;
  FImagesChangeLink.OnChange := ImageListChange;
end;

destructor TcxCustomHeader.Destroy;
begin
  EndMouseTracking(Self);
  FreeAndNil(FSections);
  FreeAndNil(FImagesChangeLink);
  FreeAndNil(FSectionStream);
  FreeAndNil(FBrush);
  inherited Destroy;
end;

procedure TcxCustomHeader.CalcSectionWidths(AHeaderWidth: Integer;
  out AWidths: TcxHeaderSectionWidths);
var
  ANewSectionWidth, APrevNonFixedWidthSectionCount, ARemainedWidth: Integer;
  ASectionWidth, ATempWidth, AWorkWidth, I: Integer;
  ANonFixedWidthSections: TList;
  ASection: TcxHeaderSection;
begin
  ANonFixedWidthSections := TList.Create;
  try
    SetLength(AWidths, Sections.Count);
    AWorkWidth := AHeaderWidth;
    for I := 0 to Sections.Count - 1 do
    begin
      ASection := Sections[I];
      if ASection.AutoSize then
        ANonFixedWidthSections.Add(ASection)
      else
      begin
        Dec(AWorkWidth, ASection.Width);
        AWidths[I] := ASection.Width;
      end;
    end;
    if ANonFixedWidthSections.Count > 0 then
      repeat
        APrevNonFixedWidthSectionCount := ANonFixedWidthSections.Count;
        ATempWidth := AWorkWidth div APrevNonFixedWidthSectionCount;
        ARemainedWidth := AWorkWidth mod APrevNonFixedWidthSectionCount;
        for I := APrevNonFixedWidthSectionCount - 1 downto 0 do
        begin
          ASection := TcxHeaderSection(ANonFixedWidthSections[I]);
          ASectionWidth := ATempWidth;
          if I = APrevNonFixedWidthSectionCount - 1 then
            Inc(ASectionWidth, ARemainedWidth);
          ANewSectionWidth := Max(ASectionWidth, ASection.MinWidth);
          ANewSectionWidth := Min(ANewSectionWidth, ASection.MaxWidth);
          AWidths[ASection.Index] := ANewSectionWidth;
          if ASectionWidth <> ANewSectionWidth then
          begin
            ANonFixedWidthSections.Remove(ASection);
            Dec(AWorkWidth, ANewSectionWidth);
          end;
        end;
      until (ANonFixedWidthSections.Count = 0) or
        (ANonFixedWidthSections.Count = APrevNonFixedWidthSectionCount);
  finally
    ANonFixedWidthSections.Free;
  end;
end;

procedure TcxCustomHeader.FlipChildren(AllLevels: Boolean);
var
  I, AFirstSectionWidth, ALastSectionWidth: Integer;
  ASectionList: TcxHeaderSections;
begin
  if HandleAllocated and (Sections.Count > 0) then
  begin
    ALastSectionWidth := ClientWidth;
    AFirstSectionWidth := Sections[0].Width;
    for I := 0 to Sections.Count - 2 do
      Dec(ALastSectionWidth, Sections[I].Width);

    ASectionList := TcxHeaderSections.Create(Self);
    try
      for I := 0 to Sections.Count - 1 do
        with ASectionList.Add do
          Assign(Sections[I]);
      for I := 0 to Sections.Count - 1 do
        Sections[I].Assign(ASectionList[Sections.Count - I - 1]);
    finally
      ASectionList.Free;
    end;

    if Sections.Count > 1 then
    begin
      Sections[Sections.Count - 1].Width := AFirstSectionWidth;
      Sections[0].Width := ALastSectionWidth;
    end;
    UpdateSections;
  end;
end;

function TcxCustomHeader.GetAutoHeight: Integer;
var
  AContentHeight: Integer;
begin
  Canvas.Font.Assign(Font);
  Canvas.Font.Style := [fsBold, fsUnderline];

  AContentHeight := Canvas.TextHeight('Wq');
  if (Images <> nil) and (AContentHeight < Images.Height) then
    AContentHeight := Images.Height;

  Result := AContentHeight +
    2 * (LookAndFeel.Painter.HeaderControlSectionBorderSize(cxbsNormal) +
      cxHeaderSectionTextTopBottomIndent);
end;

procedure TcxCustomHeader.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style and not(CS_HREDRAW or CS_VREDRAW);
end;

function TcxCustomHeader.CreateSection: TcxHeaderSection;
begin
  Result := TcxHeaderSection.Create(Sections);
end;

procedure TcxCustomHeader.CreateWnd;

  procedure ReadSections;
  var
    AReader: TReader;
  begin
    Sections.Clear;
    AReader := TReader.Create(FSectionStream, 1024);
    try
      AReader.ReadValue;
      AReader.ReadCollection(Sections);
    finally
      AReader.Free;
    end;
    FreeAndNil(FSectionStream);
  end;

begin
  inherited CreateWnd;
  if FSectionStream <> nil then
    ReadSections
  else
    UpdateSections;
end;

procedure TcxCustomHeader.DestroyWnd;
var
  AWriter: TWriter;
begin
  if FSectionStream = nil then
    FSectionStream := TMemoryStream.Create;
  AWriter := TWriter.Create(FSectionStream, 1024);
  try
    AWriter.WriteCollection(FSections);
  finally
    AWriter.Free;
    FSectionStream.Position := 0;
  end;
  inherited DestroyWnd;
end;

procedure TcxCustomHeader.LookAndFeelChanged(Sender: TcxLookAndFeel;
  AChangedValues: TcxLookAndFeelValues);
begin
  inherited LookAndFeelChanged(Sender, AChangedValues);
  Invalidate;
end;

procedure TcxCustomHeader.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = Images) then
    Images := nil;
end;

procedure TcxCustomHeader.SetSections(Value: TcxHeaderSections);
begin
  FSections.Assign(Value);
end;

procedure TcxCustomHeader.UpdateSection(Index: Integer);
begin
  InvalidateRect(GetSectionRect(Index), False);
end;

procedure TcxCustomHeader.UpdateSections;
begin
  InvalidateRect(ClientRect, False);
end;

procedure TcxCustomHeader.AllocateSplitLineDC;
begin
  FLineDC := GetDCEx(Parent.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_LOCKWINDOWUPDATE);
  if not ResizeUpdate then
  begin
    if not Assigned(FBrush) then
    begin
      FBrush := TBrush.Create;
      {$IFDEF DELPHI4}
      FBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite);
      {$ENDIF}
    end;
    FPrevBrush := SelectObject(FLineDC, FBrush.Handle);
  end;
end;

procedure TcxCustomHeader.DrawSplitLine(XPos: Integer);
begin
  FLineVisible := not FLineVisible;
  FLastDrawPosOnMove := XPos;
  PatBlt(FLineDC, Self.Left + XPos, 1, 1, Parent.Height - 1, DSTINVERT);
end;

procedure TcxCustomHeader.ReleaseSplitLine;
begin
  if FLineVisible then DrawSplitLine(FLastDrawPosOnMove);
  if FPrevBrush <> 0 then SelectObject(FLineDC, FPrevBrush);
  ReleaseDC(Parent.Handle, FLineDC);
  if FBrush <> nil then FreeAndNil(FBrush);
end;

procedure TcxCustomHeader.InitResize(XPos: Integer);
begin
  FLineVisible := False;
  AllocateSplitLineDC;
  if not ResizeUpdate then DrawSplitLine(XPos);
end;

procedure TcxCustomHeader.ChangeSectionSortOrder(ASection: TcxHeaderSection;
  ANewSortOrder: TcxHeaderSortOrder; ADeleteOtherSorting: Boolean);

  procedure DeleteOtherSorting;
  var
    I: Integer;
  begin
    for I := 0 to Sections.Count - 1 do
      if Sections[I] <> ASection then
        ChangeSectionSortOrder(Sections[I], soNone, False);
  end;

begin
  if not AllowSort or (ANewSortOrder = ASection.SortOrder) then
    Exit;

  if ADeleteOtherSorting then
    DeleteOtherSorting;

  if DoSectionChangingSortOrder(ASection, ANewSortOrder) then
  begin
    ASection.SortOrder := ANewSortOrder;
    DoSectionChangedSortOrder(ASection);
  end;
end;

function TcxCustomHeader.DoSectionChangingSortOrder(ASection: TcxHeaderSection;
  ANewSortOrder: TcxHeaderSortOrder): Boolean;
begin
  Result := True;
  if Assigned(FOnSectionChangingSortOrder) then
    FOnSectionChangingSortOrder(Self, ASection, ASection.SortOrder,
      ANewSortOrder, Result);
end;

procedure TcxCustomHeader.DoSectionChangedSortOrder(ASection: TcxHeaderSection);
begin
  if Assigned(FOnSectionChangedSortOrder) then
    FOnSectionChangedSortOrder(Self, ASection, ASection.SortOrder);
end;

function TcxCustomHeader.DoSectionDrag(FromSection,
  ToSection: TcxHeaderSection): Boolean;
begin
  Result := True;
  DoSectionDragEvent(FromSection, ToSection, Result);
end;

procedure TcxCustomHeader.DoSectionEndDrag;
var
  AIndexFrom: Integer;
begin
  if UnderMouseSectionIndex <> -1 then
  begin
    AIndexFrom := SelectedSectionIndex;
    SelectedSectionIndex := -1;
    HotSectionIndex := -1;
    Sections[AIndexFrom].Index := UnderMouseSectionIndex;
    HotSectionIndex := UnderMouseSectionIndex;
  end;
  DoSectionEndDragEvent;
end;

procedure TcxCustomHeader.DrawSection(SectionIndex: Integer);
begin
  if IsSectionIndex(SectionIndex) and Assigned(FOnDrawSection) then
    FOnDrawSection(Self, FSections[SectionIndex], GetSectionRect(SectionIndex),
      FSections[SectionIndex].State = cxbsPressed)
  else
    DrawHeaderSection(Handle, SectionIndex, Canvas, LookAndFeel, Images);
end;

procedure TcxCustomHeader.ImageListChange(Sender: TObject);