cxchecklistbox.pas

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

    property Enabled;
    property Glyph;
    property GlyphCount;
    property Images;
    property ImageLayout;
    property ImeMode;
    property ImeName;
    property IntegralHeight;
    property Items;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ScrollWidth;
    property ShowChecks;
    property ShowHint;
    property Sorted;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnCheckStatesToEditValue;
    property OnClick;
    property OnClickCheck;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnEditValueChanged;
    property OnEditValueToCheckStates;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem; // deprecated
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses
{$IFDEF DELPHI6}
  RTLConsts,
{$ENDIF}
  Consts, cxEditPaintUtils, cxEditUtils, dxThemeManager;

const
  cxCheckListBoxCheckFrameWidth = 1;
  cxCheckListBoxContentOffset = 0;
  cxCheckListBoxImageFrameWidth = 1;
  cxCheckListBoxTextAreaOffset = 1;
  cxCheckListBoxTextOffset = 2;
  cxCheckListBoxTextWidthCorrection = 3;

{ TcxCheckListBoxItem }

constructor TcxCheckListBoxItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FEnabled := True;
  FImageIndex := -1;
  FState := cbsUnchecked;
  FText := '';
end;

procedure TcxCheckListBoxItem.Assign(Source: TPersistent);
begin
  if Source is TcxCheckListBoxItem then
  begin
    Text := TcxCheckListBoxItem(Source).Text;
    Enabled := TcxCheckListBoxItem(Source).Enabled;
    ImageIndex := TcxCheckListBoxItem(Source).ImageIndex;
    ItemObject := TcxCheckListBoxItem(Source).ItemObject;
    State := TcxCheckListBoxItem(Source).State;
    Tag := TcxCheckListBoxItem(Source).Tag;
  end
  else
  inherited Assign(Source);
end;

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

function TcxCheckListBoxItem.GetChecked: Boolean;
begin
  Result := (State = cbsChecked);
end;

function TcxCheckListBoxItem.IsTagStored: Boolean;
begin
  Result := FTag <> 0;
end;

procedure TcxCheckListBoxItem.SetText(const Value: TCaption);
begin
  if InternalCompareString(Value, FText, True) then
    Exit;
  FText := Value;
  if Assigned(Collection) and (TcxCheckListBoxItems(Collection).UpdateCount = 0) and
    (TcxCheckListBoxItems(Collection).CheckListBox <> nil) then
  begin
    TcxCheckListBoxItems(Collection).CheckListBox.Items[Index] := Value;
    Changed(False);
  end;
end;

procedure TcxCheckListBoxItem.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    Changed(False);
  end;
end;

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

procedure TcxCheckListBoxItem.SetState(Value: TcxCheckBoxState);
var
  ACheckListBox: TcxCustomInnerCheckListBox;
begin
  if Assigned(Collection) and Assigned(TcxCheckListBoxItems(Collection).CheckListBox) then
    ACheckListBox := TcxCheckListBoxItems(Collection).CheckListBox
  else
    ACheckListBox := nil;

  if (Value = cbsGrayed) and (ACheckListBox <> nil) then
    if ACheckListBox.Container.EditValueFormat = cvfInteger then
      Value := cbsUnchecked;

  if FState = Value then
    Exit;
  FState := Value;
  if ACheckListBox <> nil then
  begin
    ACheckListBox.InvalidateCheck(Self.Index);
    if not TcxCheckListBoxItems(Collection).IsChangedLocked then
      ACheckListBox.UpdateEditValue;
  end;
end;

procedure TcxCheckListBoxItem.SetChecked(Value: Boolean);
begin
  if Value then
    State := cbsChecked
  else
    State := cbsUnchecked;
end;

{ TcxCheckListBoxItems }

constructor TcxCheckListBoxItems.Create(AOwner: TcxCustomInnerCheckListBox;
  ItemClass: TCollectionItemClass);
begin
  inherited Create(AOwner, ItemClass);
  FCheckListBox := AOwner;
end;

destructor TcxCheckListBoxItems.Destroy;
begin
  FCheckListBox := nil;
  inherited;
end;

function TcxCheckListBoxItems.GetItems(Index: Integer): TcxCheckListBoxItem;
begin
  Result := TcxCheckListBoxItem(inherited Items[Index]);
end;

function TcxCheckListBoxItems.GetObjects(Index: Integer): TObject;
begin
  Result := Items[Index].ItemObject;
end;

procedure TcxCheckListBoxItems.SetItems(Index: Integer;const Value: TcxCheckListBoxItem);
begin
  inherited Items[Index] := Value;
  if Assigned(CheckListBox) then
    CheckListBox.Items[Index] := Value.Text;
end;

procedure TcxCheckListBoxItems.SetObjects(Index: Integer; Value: TObject);
begin
  Items[Index].ItemObject := Value;
end;

//  IUnknown
function TcxCheckListBoxItems.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

function TcxCheckListBoxItems._AddRef: Integer;
begin
  Result := -1;
end;

function TcxCheckListBoxItems._Release: Integer;
begin
  Result := -1;
end;

// IcxCheckItems
function TcxCheckListBoxItems.CheckItemsGetCaption(Index: Integer): string;
begin
  Result := Items[Index].Text;
end;

function TcxCheckListBoxItems.CheckItemsGetCount: Integer;
begin
  Result := Count;
end;

procedure TcxCheckListBoxItems.Update(Item: TCollectionItem);

  procedure SynchronizeInnerListBoxItems;
  var
    I, ATopIndex, AItemIndex: Integer;
  begin
    if (CheckListBox.Items.Count = Count) and (Item <> nil) then
      Exit;

    CheckListBox.Items.BeginUpdate;
    try
      AItemIndex := CheckListBox.ItemIndex;
      ATopIndex := CheckListBox.TopIndex;

      CheckListBox.Items.Clear;

      for I := 0 to Count - 1 do
        CheckListBox.Items.Add(Items[I].Text);

      CheckListBox.TopIndex := ATopIndex;
      CheckListBox.ItemIndex := AItemIndex;
    finally
      CheckListBox.Items.EndUpdate;
    end;
  end;

begin
  if not Assigned(CheckListBox) then
    Exit;

  SynchronizeInnerListBoxItems;

  if CheckListBox.Container.Sorted then
    CheckListBox.Container.Sort;

  if CheckListBox.Container.IsModified then
    CheckListBox.UpdateEditValue
  else
    CheckListBox.UpdateCheckStates;
end;

function TcxCheckListBoxItems.IsChangedLocked: Boolean;
begin
  Result := FChangedLockCount > 0;
end;

procedure TcxCheckListBoxItems.LockChanged(ALock: Boolean;
  AInvokeChangedOnUnlock: Boolean = True);
begin
  if ALock then
    Inc(FChangedLockCount)
  else
    if FChangedLockCount > 0 then
    begin
      Dec(FChangedLockCount);
      if AInvokeChangedOnUnlock and (FChangedLockCount = 0) then
        Changed;
    end;
end;

function TcxCheckListBoxItems.Add: TcxCheckListBoxItem;
begin
  Result := TcxCheckListBoxItem(inherited Add);
end;

procedure TcxCheckListBoxItems.Delete(Index: Integer);
begin
{$IFDEF DELPHI5}
  inherited Delete(Index);
{$ELSE}
  TcxCheckListBoxItem(Items[Index]).Free;
{$ENDIF}
end;

function TcxCheckListBoxItems.IndexOf(const S: TCaption): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Count - 1 do
    if InternalCompareString(Items[I].Text, S, False) then
    begin
      Result := I;
      Break;
    end;
end;

function TcxCheckListBoxItems.IndexOfObject(AObject: TObject): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Count - 1 do
    if Objects[I] = AObject then
    begin
      Result := I;
      Break;
    end;
end;

procedure TcxCheckListBoxItems.LoadStrings(AStrings: TStrings);
var
  I: Integer;
begin
  AStrings.Clear;
  for I := 0 to Count - 1 do
    AStrings.Add(Items[I].Text);
end;

{ TcxCustomInnerCheckListBox }

constructor TcxCustomInnerCheckListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FContainer := TcxCustomCheckListBox(AOwner);
  FAllowGrayed := False;
  FAllowDblClickToggle := True;
  FCapturedCheckIndex := -1;
  FCheckItems := TcxCheckListBoxItems.Create(Self, TcxCheckListBoxItem);
  FGlyphCount := 6;
  FHotCheckIndex := -1;
  FPressedCheckIndex := -1;
  FMetrics := GetMetrics;
end;

destructor TcxCustomInnerCheckListBox.Destroy;
begin
  EndMouseTracking(Self);
  if Assigned(FGlyph) then FreeAndNil(FGlyph);
  FreeAndNil(FCheckItems);
  inherited Destroy;
end;

procedure TcxCustomInnerCheckListBox.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
    if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
      Style := Style or LBS_OWNERDRAWFIXED;
end;

procedure TcxCustomInnerCheckListBox.MouseTrackingMouseLeave;
begin
  InternalMouseMove([], -1, -1);
  EndMouseTracking(Self);
end;

procedure TcxCustomInnerCheckListBox.AdjustItemHeight;
begin
  if HandleAllocated then
  begin
    if Container.FListStyle = lbStandard then
      Perform(LB_SETITEMHEIGHT, 0, GetStandardItemHeight);
    SetExternalScrollBarsParameters;
    FullRepaint;
  end;
end;

procedure TcxCustomInnerCheckListBox.CheckHotTrack;
var
  P: TPoint;
begin
  P := ScreenToClient(InternalGetCursorPos);
  InternalMouseMove(InternalGetShiftState, P.X, P.Y);
end;

procedure TcxCustomInnerCheckListBox.Click;
begin
  if Container.ShowChecks or Container.DataBinding.SetEditMode then
    inherited Click;
end;

function TcxCustomInnerCheckListBox.GetCheckAt(X, Y: Integer): Integer;
var
  P: TPoint;
begin
  P := Point(X, Y);
  Result := ItemAtPos(P, True);