newchecklistbox.pas

源代码

  Level, I: Integer;
begin
  Level := ItemStates[Item].Level;
  if Level > 0 then
    for I := Item-1 downto 0 do begin
      if ItemStates[I].Level < Level then begin
        Result := I;
        Exit;
      end;
    end;
  Result := -1;
end;

function TNewCheckListBox.GetState(Index: Integer): TCheckBoxState;
begin
  Result := ItemStates[Index].State;
end;

function TNewCheckListBox.GetSubItem(Index: Integer): String;
begin
  Result := ItemStates[Index].SubItem;
end;

procedure TNewCheckListBox.InvalidateCheck(Index: Integer);
var
  IRect: TRect;
begin
  IRect := ItemRect(Index);
  Inc(IRect.Left, (FCheckWidth + 2 * Offset) * (ItemLevel[Index]));
  IRect.Right := IRect.Left + (FCheckWidth + 2 * Offset) * (ItemLevel[Index] + 1);
  InvalidateRect(Handle, @IRect, FThemeData <> 0);
end;

procedure TNewCheckListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_SPACE) and not (ssAlt in Shift) and (ItemIndex >= 0) and
    (FCaptureIndex < 0) and CanFocusItem(ItemIndex) then
    if FWantTabs then begin
      if not FSpaceDown then begin
        FCaptureIndex := ItemIndex;
        FSpaceDown := True;
        InvalidateCheck(ItemIndex);
        if (FHotIndex <> ItemIndex) and (FHotIndex <> -1) and (FThemeData <> 0) then
          InvalidateCheck(FHotIndex);
      end;
    end
    else
      Toggle(ItemIndex);
  inherited;
end;

procedure TNewCheckListBox.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_SPACE) and FWantTabs and FSpaceDown and (FCaptureIndex >= 0) then begin
    EndCapture(False);
    if (FHotIndex <> -1) and (FThemeData <> 0) then
      InvalidateCheck(FHotIndex);
  end;
  inherited;
end;

procedure TNewCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Index: Integer;
begin
  if Button = mbLeft then begin
    Index := ItemAtPos(Point(X, Y), True);
    if (Index <> -1) and CanFocusItem(Index) then
    begin
      if FWantTabs then begin
        if not FSpaceDown then begin
          if not MouseCapture then
            MouseCapture := True;
          FCaptureIndex := Index;
          FLastMouseMoveIndex := Index;
          InvalidateCheck(Index);
        end;
      end
      else
        Toggle(Index);
    end;
  end;
  inherited;
end;

procedure TNewCheckListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Index: Integer;
begin
  if (Button = mbLeft) and FWantTabs and not FSpaceDown and (FCaptureIndex >= 0) then
  begin
    Index := ItemAtPos(Point(X, Y), True);
    EndCapture(Index <> FCaptureIndex);
    if (FHotIndex <> -1) and (FThemeData <> 0) then
      InvalidateCheck(FHotIndex);
  end;
end;

procedure TNewCheckListBox.UpdateHotIndex(NewHotIndex: Integer);
var
  OldHotIndex: Integer;
begin
  OldHotIndex := FHotIndex;
  if NewHotIndex <> OldHotIndex then
  begin
    FHotIndex := NewHotIndex;
    if FCaptureIndex = -1 then begin
      if (OldHotIndex <> -1) and (FThemeData <> 0) then
        InvalidateCheck(OldHotIndex);
      if (NewHotIndex <> -1) and (FThemeData <> 0) then
        InvalidateCheck(NewHotIndex);
    end;
  end;
end;

procedure TNewCheckListBox.CMMouseLeave(var Message: TMessage);
begin
  UpdateHotIndex(-1);
  {$IFDEF HINTSHOWPAUSE}
  FHintsShowing := False;
  {$ENDIF}
  inherited;
end;

procedure TNewCheckListBox.SetChecked(Index: Integer; const AChecked: Boolean);
begin
  CheckItem(Index, AChecked);
end;

function TNewCheckListBox.CheckItem(const Index: Integer;
  const AChecked: Boolean): Boolean;
{ Tries to update the checked state of Index. Returns True if any changes were
  made to the state of Index or any of its children. }

  procedure SetItemState(const AIndex: Integer; const AState: TCheckBoxState);
  begin
    if ItemStates[AIndex].State <> AState then begin
      ItemStates[AIndex].State := AState;
      InvalidateCheck(AIndex);
      { Notify MSAA of the state change }
      if Assigned(NotifyWinEventFunc) then
        NotifyWinEventFunc(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT,
          1 + AIndex);
    end;
  end;

  function FindCheckedSibling(const AIndex: Integer): Integer;
  { Finds a checked sibling of AIndex (which is assumed to be a radio button).
    Returns -1 if no checked sibling was found. }
  var
    ThisLevel, I: Integer;
  begin
    ThisLevel := ItemStates[AIndex].Level;
    for I := AIndex-1 downto 0 do begin
      if ItemStates[I].Level < ThisLevel then
        Break;
      if ItemStates[I].Level = ThisLevel then begin
        if ItemStates[I].ItemType <> itRadio then
          Break;
        if GetState(I) <> cbUnchecked then begin
          Result := I;
          Exit;
        end;
      end;
    end;
    for I := AIndex+1 to Items.Count-1 do begin
      if ItemStates[I].Level < ThisLevel then
        Break;
      if ItemStates[I].Level = ThisLevel then begin
        if ItemStates[I].ItemType <> itRadio then
          Break;
        if GetState(I) <> cbUnchecked then begin
          Result := I;
          Exit;
        end;
      end;
    end;
    Result := -1;
  end;

  function CalcState(const AIndex: Integer; ACheck: Boolean): TCheckBoxState;
  { Determines new state for AIndex based on desired checked state (ACheck) and
    current state of the item's immediate children. }
  var
    RootLevel, I: Integer;
    HasChecked, HasUnchecked: Boolean;
  begin
    HasChecked := False;
    HasUnchecked := False;
    RootLevel := ItemStates[AIndex].Level;
    for I := AIndex+1 to Items.Count-1 do begin
      if ItemStates[I].Level <= RootLevel then
        Break;
      if (ItemStates[I].Level = RootLevel+1) and
         (ItemStates[I].ItemType in [itCheck, itRadio]) then begin
        case GetState(I) of
          cbUnchecked: begin
              if (ItemStates[I].ItemType <> itRadio) or
                 (FindCheckedSibling(I) = -1) then
                HasUnchecked := True;
            end;
          cbChecked: begin
              HasChecked := True;
            end;
          cbGrayed: begin
              HasChecked := True;
              HasUnchecked := True;
            end;
        end;
      end;
    end;

    { If the parent is a check box with children, don't allow it to be checked
      if none of its children are checked, unless it "has internal children" }
    if HasUnchecked and not HasChecked and
       (ItemStates[AIndex].ItemType = itCheck) and
       not ItemStates[AIndex].HasInternalChildren then
      ACheck := False;

    if ACheck or HasChecked then begin
      if HasUnchecked and (ItemStates[AIndex].ItemType = itCheck) then
        Result := cbGrayed
      else
        Result := cbChecked;
    end
    else
      Result := cbUnchecked;
  end;

  function RecursiveCheck(const AIndex: Integer; const AChecked: Boolean): Boolean;
  { Checks or unchecks AIndex and all enabled child items of AIndex at any
    level. In radio button groups, when AChecked is True only one item per
    group is checked; the rest are unchecked.
    Returns True if any of the items' states were changed. }
  var
    RootLevel, I: Integer;
    NewState: TCheckBoxState;
  begin
    Result := False;
    RootLevel := ItemStates[AIndex].Level;
    for I := AIndex+1 to Items.Count-1 do begin
      if ItemStates[I].Level <= RootLevel then
        Break;
      if (ItemStates[I].Level = RootLevel+1) and ItemStates[I].Enabled and
         (not AChecked or ItemStates[I].CheckWhenParentChecked or
          (ItemStates[I].ItemType = itRadio)) then
        { If checking and I is a radio button, don't recurse if a sibling
          already got checked in a previous iteration of this loop. This is
          needed in the following case to prevent all three radio buttons from
          being checked when "Parent check" is checked. In addition, it
          prevents "Child check" from being checked.
          [ ] Parent check
              ( ) Radio 1
              ( ) Radio 2
              ( ) Radio 3
                  [ ] Child check
        }
        if not AChecked or (ItemStates[I].ItemType <> itRadio) or
           (FindCheckedSibling(I) = -1) then
          if RecursiveCheck(I, AChecked) then
            Result := True;
    end;
    NewState := CalcState(AIndex, AChecked);
    if GetState(AIndex) <> NewState then begin
      SetItemState(AIndex, NewState);
      Result := True;
    end;
  end;

  procedure UncheckSiblings(const AIndex: Integer);
  { Unchecks all siblings (and their children) of AIndex, which is assumed to
    be a radio button. }
  var
    I: Integer;
  begin
    while True do begin
      I := FindCheckedSibling(AIndex);
      if I = -1 then
        Break;
      RecursiveCheck(I, False);
    end;
  end;

  procedure EnsureChildRadioItemsHaveSelection(const AIndex: Integer);
  { Ensures all radio button groups that are immediate children of AIndex have
    a selected item. }
  var
    RootLevel, I: Integer;
  begin
    RootLevel := ItemStates[AIndex].Level;
    for I := AIndex+1 to Items.Count-1 do begin
      if ItemStates[I].Level <= RootLevel then
        Break;
      if (ItemStates[I].Level = RootLevel+1) and
         (ItemStates[I].ItemType = itRadio) and
         ItemStates[I].Enabled and
         (GetState(I) <> cbChecked) and
         (FindCheckedSibling(I) = -1) then
        RecursiveCheck(I, True);
    end;
  end;

  procedure UpdateParentStates(const AIndex: Integer);
  var
    I: Integer;
    ChildChecked: Boolean;
    NewState: TCheckBoxState;
  begin
    I := AIndex;
    while True do begin
      ChildChecked := (GetState(I) <> cbUnchecked);

      I := GetParentOf(I);
      if I = -1 then
        Break;

      { When a child item is checked, must ensure that all sibling radio button
        groups have selections }
      if ChildChecked then
        EnsureChildRadioItemsHaveSelection(I);

      NewState := CalcState(I, GetState(I) <> cbUnchecked);

      { If a parent radio button is becoming checked, uncheck any previously
        selected sibling of that radio button }
      if (NewState <> cbUnchecked) and (ItemStates[I].ItemType = itRadio) then
        UncheckSiblings(I);

      SetItemState(I, NewState);
    end;
  end;

begin
  if ItemStates[Index].ItemType = itRadio then begin
    { Setting Checked to False on a radio button is a no-op. (A radio button
      may only be unchecked by checking another radio button in the group, or
      by unchecking a parent check box.) }
    if not AChecked then begin
      Result := False;
      Exit;
    end;
    { Before checking a new item in a radio group, uncheck any siblings and
      their children }
    UncheckSiblings(Index);
  end;

  { Check or uncheck this item and all its children }
  Result := RecursiveCheck(Index, AChecked);

  { Update state of parents. For example, if a child check box is being
    checked, its parent must also become checked if it isn't already. }
  UpdateParentStates(Index);
end;

procedure TNewCheckListBox.SetFlat(Value: Boolean);
begin
  if Value <> FFlat then 
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TNewCheckListBox.SetItemEnabled(Index: Integer; const AEnabled: Boolean);
begin
  if ItemStates[Index].Enabled <> AEnabled then 
  begin
    ItemStates[Index].Enabled := AEnabled;
    InvalidateCheck(Index);
  end;
end;

procedure TNewCheckListBox.SetObject(Index: Integer; const AObject: TObject);
begin
  ItemStates[Index].Obj := AObject;
end;

procedure TNewCheckListBox.SetOffset(AnOffset: Integer);
begin
  if FOffset <> AnOffset then
  begin
    FOffset := AnOffset;
    Invalidate;
  end;
end;

procedure TNewCheckListBox.SetShowLines(Value: Boolean);
begin
  if FShowLines <> Value then 
  begin
    FShowLines := Value;
    Invalidate;
  end;
end;

procedure TNewCheckListBox.SetSubItem(Index: Integer; const ASubItem: String);