schecklistbox.pas

AlphaControls是一个Delphi标准控件的集合

      Exit;
    end;
    TempBmp := Graphics.TBitmap.Create;
    TempBmp.PixelFormat := pf24Bit;
    TempBmp.Width := WidthOf(Rect);
    TempBmp.Height := HeightOf(Rect);
    try
      R := Classes.Rect(ACheckWidth, 0, TempBmp.Width, TempBmp.Height);
      if SavedIndex - TopIndex = Index then begin // If selected
        State := [odSelected]; if Focused then State := State + [odFocused];
        TempBmp.Canvas.Brush.Color := clHighlight;
        TempBmp.Canvas.Brush.Style := bsSolid;
        TempBmp.Canvas.FillRect(R);
        TempBmp.Canvas.Font.Color := clHighlightText;
      end
      else begin
        BitBlt(TempBmp.Canvas.Handle, 0, 0, TempBmp.Width, TempBmp.Height, CommonData.FCacheBmp.Canvas.Handle, Rect.Left + 3, Rect.Top + 3, SRCCOPY);
        State := [];
        TempBmp.Canvas.Brush.Color := clWhite;
        TempBmp.Canvas.Brush.Style := bsClear;
        TempBmp.Canvas.Font.Color := Font.Color;
      end;
      if Assigned(OnDrawItem) then OnDrawItem(Self, Index, Rect, State) else begin

        if (Index < Items.Count) and (Index + TopIndex > -1) then begin
          R := Rect;
          if not UseRightToLeftAlignment
            then R.Right := ACheckWidth
            else R.Left := Rect.Right; R.Right := R.Left + ACheckWidth;
          if Index + TopIndex < Items.Count then begin
            Enable := Self.Enabled and GetItemEnabled(Index + TopIndex);
            DrawCheck(R, GetState(Index + TopIndex), Enable, TempBmp.Canvas);
          end;
        end;

        R := Classes.Rect(ACheckWidth, 0, TempBmp.Width, TempBmp.Height);
        R.Left := ACheckWidth + 2;
        if (Index + TopIndex < Items.Count) and (Index + TopIndex > -1) then begin
          if State = [] then begin
            WriteTextEx(TempBmp.Canvas, PChar(Items[Index + TopIndex]), True{Enable}, R, DT_VCENTER, CommonData.SkinIndex, ControlIsActive(CommonData));
          end
          else begin
            WriteText(TempBmp.Canvas, PChar(Items[Index + TopIndex]), True{Enable}, R, DT_VCENTER);
          end;
        end;
        R := Classes.Rect(ACheckWidth, 0, TempBmp.Width, TempBmp.Height);
        if odFocused in State then DrawFocusRect(TempBmp.Canvas.Handle, R);
      end;
      if not Enabled then begin
        CI.Bmp := CommonData.FCacheBmp;
        CI.X := 0;
        CI.Y := 0;
        CI.Ready := True;
        BmpDisabledKind(TempBmp, DisabledKind, Parent, CI, Point(Rect.Left + 3, Rect.Top + 3));
      end;
      BitBlt(Canvas.Handle, Rect.Left, Rect.Top, TempBmp.Width, TempBmp.Height, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      FreeAndNil(TempBmp);
    end;
  end
  else if Assigned(OnDrawItem) then OnDrawItem(Self, Index, Rect, State) else begin
    if Index < Items.Count then begin
      R := Rect;
      if not UseRightToLeftAlignment then begin
        R.Right := Rect.Left; R.Left := R.Right - ACheckWidth;
      end
      else begin
        R.Left := Rect.Right; R.Right := R.Left + ACheckWidth;
      end;
      Enable := Self.Enabled and GetItemEnabled(Index);
      DrawCheck(R, GetState(Index), Enable, Canvas);
      if not Enable then Canvas.Font.Color := clGrayText;
    end;

    if (Style = lbStandard) and Assigned(OnDrawItem) then begin
      { Force lbStandard list to ignore OnDrawItem event. }
      SaveEvent := OnDrawItem;
      OnDrawItem := nil;
      try
        inherited;
      finally
        OnDrawItem := SaveEvent;
      end;
    end
    else begin
      R := Rect;
      R.Left := ACheckWidth;
      inherited DrawItem(Index, R, State);
    end;
  end;
end;

function TsCheckListBox.ExtractWrapper(Index: Integer): TObject;
begin
  Result := TsCheckListBoxDataWrapper(inherited GetItemData(Index));
  if LB_ERR = Integer(Result) then
    raise EListError.CreateResFmt(@SListIndexError, [Index]);
  if (Result <> nil) and (not (Result is TsCheckListBoxDataWrapper)) then
    Result := nil;
end;

function TsCheckListBox.GetChecked(Index: Integer): Boolean;
begin
  if HaveWrapper(Index)
    then Result := TsCheckListBoxDataWrapper(GetWrapper(Index)).GetChecked
    else Result := False;
end;

function TsCheckListBox.GetCheckWidth: Integer;
begin
  Result := FCheckWidth + 2;
end;

function TsCheckListBox.GetItemData(Index: Integer): LongInt;
begin
  Result := 0;
  if HaveWrapper(Index) then
    Result := TsCheckListBoxDataWrapper(GetWrapper(Index)).FData;
end;

function TsCheckListBox.GetItemEnabled(Index: Integer): Boolean;
begin
  Result := False;
  if (Index = -1) or (Index > Items.Count - 1) then Exit;
  if HaveWrapper(Index)
    then Result := not TsCheckListBoxDataWrapper(GetWrapper(Index)).Disabled
    else Result := True;
end;

function TsCheckListBox.GetState(Index: Integer): TCheckBoxState;
begin
  if HaveWrapper(Index)
    then Result := TsCheckListBoxDataWrapper(GetWrapper(Index)).State
    else Result := TsCheckListBoxDataWrapper.GetDefaultState;
end;

function TsCheckListBox.GetWrapper(Index: Integer): TObject;
begin
  Result := ExtractWrapper(Index);
  if Result = nil then
    Result := CreateWrapper(Index);
end;

function TsCheckListBox.HaveWrapper(Index: Integer): Boolean;
begin
  Result := ExtractWrapper(Index) <> nil;
end;

function TsCheckListBox.InternalGetItemData(Index: Integer): Longint;
begin
  Result := inherited GetItemData(Index);
end;

procedure TsCheckListBox.InternalSetItemData(Index, AData: Integer);
begin
  inherited SetItemData(Index, AData);
end;

procedure TsCheckListBox.InvalidateCheck(Index: Integer);
var
  R: TRect;
begin
  if CommonData.Skinned then begin
    R := ItemRect(Index - TopIndex);
  end
  else begin
    R := ItemRect(Index);
  end;
  if not UseRightToLeftAlignment
    then R.Right := R.Left + GetCheckWidth
    else R.Left := R.Right - GetCheckWidth;
  InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
  UpdateWindow(Handle);
end;

procedure TsCheckListBox.KeyPress(var Key: Char);
begin
  inherited;
  if (Key = ' ') then ToggleClickCheck(ItemIndex);
end;

{
procedure TsCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Index: Integer;
begin
  inherited;
  if Button = mbLeft then begin
    Index := ItemAtPos(Point(X,Y),True);
    if (Index <> -1) and GetItemEnabled(Index) then
      if not UseRightToLeftAlignment then begin
        if X - ItemRect(Index).Left < GetCheckWidth then ToggleClickCheck(Index)
      end
      else begin
        Dec(X, ItemRect(Index).Right - GetCheckWidth);
        if (X > 0) and (X < GetCheckWidth) then ToggleClickCheck(Index)
      end;
  end;
end;
}
procedure TsCheckListBox.ResetContent;
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do
    if HaveWrapper(I) then
      GetWrapper(I).Free;
  inherited;
end;

procedure TsCheckListBox.ResetItemHeight;
begin
  if HandleAllocated and (Style = lbStandard) then
  begin
    Canvas.Font := Font;
    FStandardItemHeight := Canvas.TextHeight('Wg');
    Perform(LB_SETITEMHEIGHT, 0, FStandardItemHeight);
  end;
end;

procedure TsCheckListBox.SetChecked(Index: Integer; Checked: Boolean);
begin
  if Checked <> GetChecked(Index) then begin
    TsCheckListBoxDataWrapper(GetWrapper(Index)).SetChecked(Checked);
    InvalidateCheck(Index);
  end;
end;

procedure TsCheckListBox.SetItemData(Index, AData: Integer);
var
  Wrapper: TsCheckListBoxDataWrapper;
  SaveState: TObject;
begin
  Wrapper := TsCheckListBoxDataWrapper(GetWrapper(Index));
  Wrapper.FData := AData;
  if FSaveStates <> nil then
    if FSaveStates.Count > 0 then begin
      SaveState := FSaveStates[0];
      Wrapper.FState := GetSaveState(SaveState);
      Wrapper.FDisabled := GetSaveDisabled(SaveState);
      FSaveStates.Delete(0);
    end;
end;

procedure TsCheckListBox.SetItemEnabled(Index: Integer; const Value: Boolean);
begin
  if Value <> GetItemEnabled(Index) then begin
    TsCheckListBoxDataWrapper(GetWrapper(Index)).Disabled := not Value;
    if Commondata.Skinned
      then ChangeSelected (Index, Index)
      else InvalidateCheck(Index);
  end;
end;

procedure TsCheckListBox.SetState(Index: Integer; AState: TCheckBoxState);
begin
  if AState <> GetState(Index) then begin
    TsCheckListBoxDataWrapper(GetWrapper(Index)).State := AState;
    InvalidateCheck(Index);
  end;
end;

procedure TsCheckListBox.ToggleClickCheck(Index: Integer);
var
  State: TCheckBoxState;
begin
  if (Index >= 0) and (Index < Items.Count) and GetItemEnabled(Index) then begin
    State := Self.State[Index];
    case State of
      cbUnchecked: if AllowGrayed then State := cbGrayed else State := cbChecked;
      cbChecked: State := cbUnchecked;
      cbGrayed: State := cbChecked;
    end;
    Self.State[Index] := State;
    ClickCheck;
  end;
end;

procedure TsCheckListBox.WMDestroy(var Msg: TWMDestroy);
var
  i: Integer;
begin
  for i := 0 to Items.Count -1 do ExtractWrapper(i).Free;
  inherited;
end;

procedure TsCheckListBox.WMLButtonDown(var Message: TWMLButtonDown);
var
  Index: Integer;
begin
  inherited;
//  if Button = mbLeft then begin
    Index := ItemAtPos(Point(Message.XPos,Message.YPos), True);
    if (Index <> -1) and GetItemEnabled(Index) then
      if not UseRightToLeftAlignment then begin
        if Message.XPos - ItemRect(Index).Left < GetCheckWidth then
          ToggleClickCheck(Index)
      end
      else begin
        Dec(Message.XPos, ItemRect(Index).Right - GetCheckWidth);
        if (Message.XPos > 0) and (Message.XPos < GetCheckWidth) then ToggleClickCheck(Index)
      end;
//  end;
end;

initialization

  GetCheckSize;

end.