newchecklistbox.pas

源代码

begin
  with Message.DrawItemStruct^ do
  begin
    L := ItemStates[itemID].Level;
    if ItemStates[itemID].ItemType <> itGroup then Inc(L);
    rcItem.Left := rcItem.Left + (FCheckWidth + 2 * FOffset) * L;
    { Don't let TCustomListBox.CNDrawItem draw the focus }
    if FWantTabs or (CanQueryUIState and
      (SendMessage(Handle, WM_QUERYUISTATE, 0, 0) and UISF_HIDEFOCUS <> 0)) then
      itemState := itemState and not ODS_FOCUS;
    inherited;
  end;
end;

procedure TNewCheckListBox.RemeasureItem(Index: Integer);
var
  H: Integer;
begin
  H := ItemHeight;
  MeasureItem(Index, H);
  SendMessage(Handle, LB_SETITEMHEIGHT, Index, H);
  { Necessary hack: Windows doesn't update the list box's scroll range when a
    LB_SETITEMHEIGHT message is sent. If the last item is extended beyond the
    current scroll bounds, it isn't possible to scroll that item fully into
    view. To work around that, send a seemingly-ineffectual LB_SETTOPINDEX
    message. It updates the scroll bounds on Windows 95 and 2000. }
  SendMessage(Handle, LB_SETTOPINDEX, SendMessage(Handle, LB_GETTOPINDEX, 0, 0), 0);
end;

procedure TNewCheckListBox.MeasureItem(Index: Integer; var Height: Integer);
var
  DrawTextFormat: Integer;
  Rect: TRect;
  ItemState: TItemState;
  L, SubItemWidth: Integer;
begin
  with Canvas do begin
    { If Index >= FStateList.Count, it means the item has just been inserted
      and the item's TItemState hasn't been created yet; in that case, don't
      measure. }
    if Index < FStateList.Count then begin
      ItemState := ItemStates[Index];
      Rect := ItemRect(Index);

      L := ItemState.Level;
      if ItemState.ItemType <> itGroup then
        Inc(L);
      Rect.Left := Rect.Left + (FCheckWidth + 2 * FOffset) * L;

      if ItemState.SubItem <> '' then begin
        SubItemWidth := TextWidth(ItemState.SubItem) + 2 * FOffset;
        Dec(Rect.Right, SubItemWidth)
      end else
        Dec(Rect.Right, FOffset);

      if not FWantTabs then
        Inc(Rect.Left);

      DrawTextFormat := DT_NOCLIP or DT_CALCRECT or DT_WORDBREAK;
      if not FWantTabs or (ItemState.ItemType = itGroup) then
        DrawTextFormat := DrawTextFormat or DT_NOPREFIX;

      ItemState.MeasuredHeight := DrawText(Canvas.Handle, PChar(Items[Index]), Length(Items[Index]), Rect, DrawTextFormat);
      if ItemState.MeasuredHeight < FMinItemHeight then
        Height := FMinItemHeight
      else
        Height := ItemState.MeasuredHeight + 4;

      { The height must be an even number for tree lines to be painted correctly }
      if Odd(Height) then
        Inc(Height);
    end;
  end;
end;

procedure TNewCheckListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
  ButtonStates: array [TItemType] of Integer =
  (
    0,
    DFCS_BUTTONCHECK,
    DFCS_BUTTONRADIO
  );
  ButtonPartIds: array [TItemType] of Integer =
  (
    0,
    BP_CHECKBOX,
    BP_RADIOBUTTON
  );
  ButtonStateIds: array [TCheckBoxState, TCheckBoxState2] of Integer =
  (
    //Can be used for both checkboxes and radiobuttons because RBS_... constants
    //equal CBS_... constants
    (CBS_UNCHECKEDNORMAL, CBS_UNCHECKEDHOT, CBS_UNCHECKEDPRESSED, CBS_UNCHECKEDDISABLED),
    (CBS_CHECKEDNORMAL, CBS_CHECKEDHOT, CBS_CHECKEDPRESSED, CBS_CHECKEDDISABLED),
    (CBS_MIXEDNORMAL, CBS_MIXEDHOT, CBS_MIXEDPRESSED, CBS_MIXEDDISABLED)
  );

  procedure InternalDrawText(const S: string; var R: TRect; Format: Integer;
    Embossed: Boolean);
  begin
    if Embossed then
    begin
      Canvas.Brush.Style := bsClear;
      OffsetRect(R, 1, 1);
      SetTextColor(Canvas.Handle, GetSysColor(COLOR_BTNHIGHLIGHT));
      DrawText(Canvas.Handle, PChar(S), Length(S), R, Format);
      OffsetRect(R, -1, -1);
      SetTextColor(Canvas.Handle, GetSysColor(COLOR_BTNSHADOW));
      DrawText(Canvas.Handle, PChar(S), Length(S), R, Format);
    end
    else
      DrawText(Canvas.Handle, PChar(S), Length(S), R, Format);
  end;

var
  Disabled: Boolean;
  uState, I, ThreadPosX, ThreadBottom, ThreadLevel, ItemMiddle,
    DrawTextFormat: Integer;
  CheckRect, SubItemRect, FocusRect: TRect;
  OldColor: COLORREF;
  ItemState: TItemState;
  UIState: DWORD;
  SubItemWidth: Integer;
  PartId, StateId: Integer;
begin
  if FShowLines and not FThreadsUpToDate then begin
    UpdateThreads;
    FThreadsUpToDate := True;
  end;

  ItemState := ItemStates[Index];
  if CanQueryUIState then
    UIState := SendMessage(Handle, WM_QUERYUISTATE, 0, 0)
  else
    UIState := 0; //no UISF_HIDEACCEL and no UISF_HIDEFOCUS
  Disabled := not Enabled or not ItemState.Enabled;
  with Canvas do begin
    if FWantTabs and (odSelected in State) then
      Brush.Color := Self.Color;
    { Draw threads }
    if FShowLines then begin
      Pen.Color := clGrayText;
      ThreadLevel := ItemLevel[Index];
      for I := 0 to ThreadLevel - 1 do
        if I in ItemStates[Index].ThreadCache then begin
          ThreadPosX := (FCheckWidth + 2 * FOffset) * I + FCheckWidth div 2 + FOffset;
          ItemMiddle := (Rect.Bottom - Rect.Top) div 2 + Rect.Top;
          ThreadBottom := Rect.Bottom;
          if I = ThreadLevel - 1 then begin
            if ItemStates[Index].IsLastChild then
              ThreadBottom := ItemMiddle;
            LineDDA(ThreadPosX, ItemMiddle, ThreadPosX + FCheckWidth div 2 + FOffset,
              ItemMiddle, @LineDDAProc, Integer(Canvas));
          end;
          LineDDA(ThreadPosX, Rect.Top, ThreadPosX, ThreadBottom,
            @LineDDAProc, Integer(Canvas));
        end;
    end;
    { Draw checkmark}
    if ItemState.ItemType <> itGroup then begin
      Dec(Rect.Left, FCheckWidth + 2 * FOffset);
      with CheckRect do begin
        Left := Rect.Left + FOffset;
        Top := Rect.Top + (Rect.Bottom - Rect.Top - FCheckHeight) div 2;
        Bottom := Top + FCheckHeight;
        Right := Left + FCheckWidth;
      end;
      if FThemeData = 0 then begin
        case ItemState.State of
          cbChecked: uState := ButtonStates[ItemState.ItemType] or DFCS_CHECKED;
          cbUnchecked: uState := ButtonStates[ItemState.ItemType];
          else
            uState := DFCS_BUTTON3STATE or DFCS_CHECKED;
        end;
        if FFlat then
          uState := uState or DFCS_FLAT;
        if Disabled then
          uState := uState or DFCS_INACTIVE;
        if (FCaptureIndex = Index) and (FSpaceDown or (FLastMouseMoveIndex = Index)) then
          uState := uState or DFCS_PUSHED;
        DrawFrameControl(Handle, CheckRect, DFC_BUTTON, uState)
      end else begin
        PartId := ButtonPartIds[ItemState.ItemType];
        if Disabled then
          StateId := ButtonStateIds[ItemState.State][cb2Disabled]
        else if Index = FCaptureIndex then
          if FSpaceDown or (FLastMouseMoveIndex = Index) then
            StateId := ButtonStateIds[ItemState.State][cb2Pressed]
          else
            StateId := ButtonStateIds[ItemState.State][cb2Hot]
        else if (FCaptureIndex < 0) and (Index = FHotIndex) then
          StateId := ButtonStateIds[ItemState.State][cb2Hot]
        else
          StateId := ButtonStateIds[ItemState.State][cb2Normal];
        //if IsThemeBackgroundPartiallyTransparent(FThemeData, PartId, StateId) then
        //  DrawThemeParentBackground(Self.Handle, Handle, @CheckRect);
        DrawThemeBackGround(FThemeData, Handle, PartId, StateId, CheckRect, @CheckRect);
      end;
      Rect.Left := CheckRect.Right + FOffset;
    end;
    { Draw SubItem }
    FillRect(Rect);
    Inc(Rect.Left);
    OldColor := GetTextColor(Handle);
    if Disabled then begin
      if not FWantTabs and not (odSelected in State) then
        SetTextColor(Handle, GetSysColor(COLOR_GRAYTEXT))
    end
    else
      if FWantTabs then
        SetTextColor(Handle, ColorToRGB(Self.Font.Color));
    if ItemState.SubItem <> '' then
    begin
      SubItemWidth := TextWidth(ItemState.SubItem) + 2 * FOffset;
      SubItemRect := Rect;
      SubItemRect.Left := SubItemRect.Right - SubItemWidth + FOffset;
      InternalDrawText(ItemState.SubItem, SubItemRect, DT_NOCLIP or
        DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER, FWantTabs and Disabled);
      Dec(Rect.Right, SubItemWidth);
    end
    else
      Dec(Rect.Right, FOffset);
    { Draw item text }
    if not FWantTabs then
      Inc(Rect.Left);
    OffsetRect(Rect, 0, (Rect.Bottom - Rect.Top - ItemState.MeasuredHeight) div 2);
    DrawTextFormat := DT_NOCLIP or DT_WORDBREAK;
    if not FWantTabs or (ItemState.ItemType = itGroup) then
      DrawTextFormat := DrawTextFormat or DT_NOPREFIX;
    if (UIState and UISF_HIDEACCEL) <> 0 then
      DrawTextFormat := DrawTextFormat or DT_HIDEPREFIX;
    InternalDrawText(Items[Index], Rect, DrawTextFormat, FWantTabs and Disabled);
    { Draw focus rectangle }
    if FWantTabs and not Disabled and (odSelected in State) and Focused and
      (UIState and UISF_HIDEFOCUS = 0) then
    begin
      FocusRect := Rect;
      InternalDrawText(Items[Index], FocusRect, DrawTextFormat or DT_CALCRECT,
        False);
      InflateRect(FocusRect, 1, 1);
      DrawFocusRect(FocusRect);
    end;
    SetTextColor(Handle, OldColor);
  end;
end;

procedure TNewCheckListBox.EndCapture(Cancel: Boolean);
var
  InvalidateItem: Boolean;
  Item: Integer;
begin
  Item := FCaptureIndex;
  if Item >= 0 then
  begin
    InvalidateItem := FSpaceDown or (FCaptureIndex = FLastMouseMoveIndex) or (FThemeData <> 0);
    FSpaceDown := False;
    FCaptureIndex := -1;
    FLastMouseMoveIndex := -1;
    if not Cancel then
      Toggle(Item);
    if InvalidateItem then
      InvalidateCheck(Item);
  end;
  if MouseCapture then
    MouseCapture := False;
end;

procedure TNewCheckListBox.EnumChildrenOf(Item: Integer; Proc: TEnumChildrenProc;
  Ext: Longint);
var
  L: Integer;
begin
  if (Item < -1) or (Item >= Items.Count) then 
    Exit;
  if Item = -1 then 
  begin
    L := 0;
    Item := 0;
  end
  else
  begin
    L := ItemLevel[Item] + 1;
    Inc(Item);
  end;
  while (Item < Items.Count) and (ItemLevel[Item] >= L) do
  begin
    if ItemLevel[Item] = L then
      Proc(Item, (Item < Items.Count - 1) and (ItemLevel[Item + 1] > L), Ext);
    Inc(Item);
  end;
end;

function TNewCheckListBox.AddItem(AType: TItemType;
  const ACaption, ASubItem: string; ALevel: Byte;
  AChecked, AEnabled, AHasInternalChildren, ACheckWhenParentChecked: Boolean;
  AObject: TObject): Integer;
var
  ItemState: TItemState; 
begin
  if Items.Count > 0 then
  begin
    if ItemLevel[Items.Count - 1] + 1 < ALevel then
      ALevel := ItemLevel[Items.Count - 1] + 1;
  end
  else
    ALevel := 0;
  FThreadsUpToDate := False;
  { Use our own grow code to minimize heap fragmentation }
  if FStateList.Count = FStateList.Capacity then begin
    if FStateList.Capacity < 64 then
      FStateList.Capacity := 64
    else
      FStateList.Capacity := FStateList.Capacity * 2;
  end;
  Result := Items.Add(ACaption);
  try
    ItemState := TItemState.Create;
    ItemState.ItemType := AType;
    ItemState.Enabled := AEnabled;
    ItemState.Obj := AObject;
    ItemState.Level := ALevel;
    ItemState.SubItem := ASubItem;
    ItemState.HasInternalChildren := AHasInternalChildren;
    ItemState.CheckWhenParentChecked := ACheckWhenParentChecked;
    FStateList.Add(ItemState);
  except
    Items.Delete(Result);
    raise;
  end;
  SetChecked(Result, AChecked);
  RemeasureItem(Result);
end;

function TNewCheckListBox.FindAccel(VK: Word): Integer;
begin
  for Result := 0 to Items.Count - 1 do
    if CanFocusItem(Result) and IsAccel(VK, Items[Result]) then
      Exit;
  Result := -1;
end;

function TNewCheckListBox.FindNextItem(StartFrom: Integer; GoForward,
  SkipUncheckedRadios: Boolean): Integer;

  function ShouldSkip(Index: Integer): Boolean;
  begin
    with ItemStates[Index] do
      Result := (ItemType = itRadio) and (State <> cbChecked)
  end;
  
var
  Delta: Integer;
begin
  if StartFrom < -1 then
    StartFrom := ItemIndex;
  if Items.Count > 0 then
  begin
    Delta := Ord(GoForward) * 2 - 1;
    Result := StartFrom + Delta;
    while (Result >= 0) and (Result < Items.Count) and
      (not CanFocusItem(Result) or SkipUncheckedRadios and ShouldSkip(Result)) do
      Result := Result + Delta;
    if (Result < 0) or (Result >= Items.Count) then
      Result := -1;
  end
  else
    Result := -1;
end;

function TNewCheckListBox.GetChecked(Index: Integer): Boolean;
begin
  Result := GetState(Index) <> cbUnchecked;
end;

function TNewCheckListBox.GetItemEnabled(Index: Integer): Boolean;
begin
  Result := ItemStates[Index].Enabled;
end;

function TNewCheckListBox.GetItemState(Index: Integer): TItemState;
begin
  Result := FStateList[Index];
end;

function TNewCheckListBox.GetLevel(Index: Integer): Byte;
begin
  Result := ItemStates[Index].Level;
end;

function TNewCheckListBox.GetObject(Index: Integer): TObject;
begin
  Result := ItemStates[Index].Obj;
end;

function TNewCheckListBox.GetParentOf(Item: Integer): Integer;
{ Gets index of Item's parent, or -1 if there is none. }
var