cxchecklistbox.pas

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

    ANewPressedCheckIndex := FNewPressedCheckIndex;
    if (ANewPressedCheckIndex <> -1) and
      ((Container.DragMode = dmAutomatic) or not FNewPressedCheckItemFullyVisible) and
      CheckItems[ANewPressedCheckIndex].Enabled then
    begin
      ToggleClickCheck(ANewPressedCheckIndex);
      ANewPressedCheckIndex := -1;
    end;
  end
  else
    ANewPressedCheckIndex := -1;
  FCapturedCheckIndex := ANewPressedCheckIndex;
  ANewHotCheckIndex := -1;
  SynchronizeCheckStates(ANewHotCheckIndex, ANewPressedCheckIndex);
end;

procedure TcxCustomInnerCheckListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if (Container.DragMode = dmAutomatic) and (GetCaptureControl <> Self) then
  begin
    FCapturedCheckIndex := -1;
    SynchronizeCheckStates(FHotCheckIndex, -1);
  end;
  InternalMouseMove(Shift, X, Y);
  BeginMouseTracking(Self, GetControlRect(Self), Self);
end;

procedure TcxCustomInnerCheckListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  ACheckIndex: Integer;
  ANewHotCheckIndex, ANewPressedCheckIndex: Integer;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) and (Container.DragMode <> dmAutomatic) then
  begin
    ACheckIndex := GetCheckAt(X, Y);
    if (ACheckIndex = FPressedCheckIndex) and (ACheckIndex <> -1) and
      CheckItems[ACheckIndex].Enabled then
        ToggleClickCheck(ACheckIndex);
  end;
  FCapturedCheckIndex := -1;
  ANewPressedCheckIndex := -1;
  if Shift = [] then
    ANewHotCheckIndex := GetCheckAt(X, Y)
  else
    ANewHotCheckIndex := -1;
  SynchronizeCheckStates(ANewHotCheckIndex, ANewPressedCheckIndex);
end;

function TcxCustomInnerCheckListBox.DoMouseWheel(Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  CheckHotTrack;
end;

procedure TcxCustomInnerCheckListBox.ToggleClickCheck(Index: Integer);
var
  ANewState, APrevState: TcxCheckBoxState;
begin
  if (Index < 0) or (Index >= CheckItems.Count) or
      not CheckItems[Index].Enabled then
    Exit;
  if Container.Focused and not Container.DataBinding.SetEditMode then
    Exit;

  APrevState := CheckItems[Index].State;
  case APrevState of
    cbsUnchecked:
      if AllowGrayed and (Container.EditValueFormat <> cvfInteger) then
        ANewState := cbsGrayed
      else
        ANewState := cbsChecked;
    cbsGrayed: ANewState := cbsChecked;
    else
      ANewState := cbsUnchecked;
  end;
  CheckItems[Index].State := ANewState;
  DoClickCheck(Index, APrevState, ANewState);
end;

procedure TcxCustomInnerCheckListBox.DoClickCheck(const AIndex: Integer;
  const OldState, NewState: TcxCheckBoxState);
begin
  if Assigned(FOnClickCheck) then
    FOnClickCheck(Container, AIndex, OldState, NewState);
end;

{ TcxCustomCheckListBox }

constructor TcxCustomCheckListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEditValue := VarAsType(0, {$IFDEF DELPHI6}varInt64{$ELSE}varInteger{$ENDIF});
  FEditValueFormat := cvfInteger;

  FDataBinding := GetDataBindingClass.Create(Self, Self);
  FDataBinding.OnDataChange := Self.DataChange;
  FDataBinding.OnDataSetChange := Self.DataSetChange;
  FDataBinding.OnUpdateData := Self.UpdateData;

  FInnerCheckListBox := GetInnerCheckListBoxClass.Create(Self);
  FInnerCheckListBox.AutoSize := False;
  FInnerCheckListBox.BorderStyle := bsNone;
  FInnerCheckListBox.OnDrawItem := DrawItem;
  FInnerCheckListBox.Parent := Self;
  FInnerCheckListBox.LookAndFeel.MasterLookAndFeel := Style.LookAndFeel;

  InnerControl := FInnerCheckListBox;
  DataBinding.VisualControl := FInnerCheckListBox;
  Width := 121;
  Height := 97;

  FImageLayout := ilBeforeChecks;
  FIntegralHeight := False;
  FListStyle := lbStandard;
  FInnerCheckListBox.Style := lbOwnerDrawFixed;
  FShowChecks := True;
  CalculateDrawCheckParams;

  FImagesChangeLink := TChangeLink.Create;
  FImagesChangeLink.OnChange := ImagesChanged;
  FItemTextList := TStringList.Create;
end;

destructor TcxCustomCheckListBox.Destroy;
begin
  FreeAndNil(FItemTextList);
  FreeAndNil(FImagesChangeLink);
  FreeAndNil(FInnerCheckListBox);
  FreeAndNil(FDataBinding);
  inherited Destroy;
end;

function TcxCustomCheckListBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or
    FDataBinding.ExecuteAction(Action);
end;

function TcxCustomCheckListBox.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or FDataBinding.UpdateAction(Action);
end;

function TcxCustomCheckListBox.CheckAtPos(const APos: TPoint): Integer;
begin
  Result := FInnerCheckListBox.GetCheckAt(APos.X - FInnerCheckListBox.Left,
    APos.Y - FInnerCheckListBox.Top);
end;

procedure TcxCustomCheckListBox.Clear;
begin
  Items.Clear;
end;

function TcxCustomCheckListBox.GetBestFitWidth: Integer;
var
  AItemTextWidth, AMaxItemTextWidth: Integer;
  I: Integer;
begin
  with GetBorderExtent do
    Result := Left + Right;
  Inc(Result, FInnerCheckListBox.GetCheckRegionWidth +
    FInnerCheckListBox.Metrics.TextWidthCorrection);
  AMaxItemTextWidth := 0;
  for I := 0 to Items.Count - 1 do
  begin
    AItemTextWidth := FInnerCheckListBox.Canvas.TextWidth(Items[I].Text);
    if AItemTextWidth > AMaxItemTextWidth then
      AMaxItemTextWidth := AItemTextWidth;
  end;
  Inc(Result, AMaxItemTextWidth);
end;

function TcxCustomCheckListBox.GetHeight(ARowCount: Integer): Integer;
begin
  with GetBorderExtent do
    Result := FInnerCheckListBox.GetStandardItemHeight * ARowCount + Top + Bottom;
end;

function TcxCustomCheckListBox.GetItemWidth(AIndex: Integer): Integer;
begin
  with GetBorderExtent do
    Result := Left + Right;
  Inc(Result, FInnerCheckListBox.GetCheckRegionWidth +
    Canvas.TextWidth(Items[AIndex].Text) + FInnerCheckListBox.Metrics.TextWidthCorrection);
end;

function TcxCustomCheckListBox.ItemAtPos(const APos: TPoint; AExisting: Boolean): Integer;
begin
  Result := FInnerCheckListBox.ItemAtPos(
    Point(APos.X - FInnerCheckListBox.Left, APos.Y - FInnerCheckListBox.Top),
    AExisting);
end;

function TcxCustomCheckListBox.ItemRect(Index: Integer): TRect;
begin
  Result := FInnerCheckListBox.ItemRect(Index);
  OffsetRect(Result, FInnerCheckListBox.Left, FInnerCheckListBox.Top);
end;

procedure TcxCustomCheckListBox.Sort;

  procedure FillItemTextList;
  var
    ACount, I: Integer;
  begin
    ACount := FItemTextList.Count;
    if ACount > Items.Count then
      ACount := Items.Count;

    for I := 0 to ACount - 1 do
    begin
      FItemTextList[I] := Items[I].Text;
      FItemTextList.Objects[I] := Items[I];
    end;

    if ACount < Items.Count then
      for I := ACount to Items.Count - 1 do
        FItemTextList.AddObject(Items[I].Text, Items[I])
    else
      if ACount < FItemTextList.Count then
        for I := 1 to FItemTextList.Count - ACount do
          FItemTextList.Delete(FItemTextList.Count - 1);
  end;

var
  APrevSorted: Boolean;
  I: Integer;
begin
  APrevSorted := Sorted;
  FSorted := False;
  try
    FillItemTextList;
    FItemTextList.Sort;

    Items.BeginUpdate;
    try
      for I := 0 to FItemTextList.Count - 1 do
        TcxCheckListBoxItem(FItemTextList.Objects[I]).Index := I;
    finally
      Items.EndUpdate;
    end;
  finally
    FSorted := APrevSorted;
  end;
  InnerCheckListBox.FullRepaint;
end;

{$IFDEF DELPHI6}
procedure TcxCustomCheckListBox.AddItem(AItem: string);
var
  Item: TcxCheckListBoxItem;
begin
  Item := Items.Add;
  Item.Text := AItem;
end;

procedure TcxCustomCheckListBox.CopySelection(ADestination: TcxCustomCheckListBox);
begin
  if ItemIndex <> -1 then
    ADestination.AddItem(Items[ItemIndex].Text);
end;

procedure TcxCustomCheckListBox.DeleteSelected;
begin
  if ItemIndex <> -1 then
    Items.Delete(ItemIndex);
end;

procedure TcxCustomCheckListBox.MoveSelection(ADestination: TcxCustomCheckListBox);
begin
  CopySelection(ADestination);
  DeleteSelected;
end;

{$ENDIF}

procedure TcxCustomCheckListBox.CalculateDrawCheckParams;
const
  ABorderStyleMap: array[TcxLookAndFeelKind] of TcxEditCheckBoxBorderStyle =
    (ebsFlat, ebs3D, ebsUltraFlat, ebsOffice11);
begin
  with Style.LookAndFeel do
  begin
    FNativeStyle := NativeStyle and AreVisualStylesAvailable([totButton, totComboBox]);
    if not FNativeStyle then
      FCheckBorderStyle := ABorderStyleMap[Kind];
  end;
end;

procedure TcxCustomCheckListBox.DoExit;
begin
  if IsDestroying or FIsExitProcessing then
    Exit;
  FIsExitProcessing := True;
  try
    try
      DataBinding.UpdateDataSource;
    except
      SetFocus;
      raise;
    end;
    inherited DoExit;
  finally
    FIsExitProcessing := False;
  end;
end;

function TcxCustomCheckListBox.IsReadOnly: Boolean;
begin
  Result := DataBinding.IsControlReadOnly;
end;

procedure TcxCustomCheckListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if not ShowChecks then
    case Key of
      VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN:
        if not DataBinding.SetEditMode then
          Key := 0;
    end;
end;

procedure TcxCustomCheckListBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #27:
      DataBinding.Reset;
    #32..#255:
      if not ShowChecks and not DataBinding.SetEditMode then
        Key := #0;
  end;
end;

procedure TcxCustomCheckListBox.Loaded;
begin
  inherited Loaded;
  DataBinding.Reset;
  _TWinControlAccess._RecreateWnd(InnerCheckListBox);
end;

procedure TcxCustomCheckListBox.LookAndFeelChanged(Sender: TcxLookAndFeel;
  AChangedValues: TcxLookAndFeelValues);
begin
  CalculateDrawCheckParams;
  inherited LookAndFeelChanged(Sender, AChangedValues);
  if FInnerCheckListBox <> nil then
    FInnerCheckListBox.AdjustItemHeight;
end;

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

function TcxCustomCheckListBox.GetReadOnly: Boolean;
begin
  Result := DataBinding.ReadOnly;
end;

procedure TcxCustomCheckListBox.SetReadOnly(Value: Boolean);
begin
  DataBinding.ReadOnly := Value;
end;

function TcxCustomCheckListBox.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := inherited CanResize(NewWidth, NewHeight);
  if not Result or not IntegralHeight or IsLoading then
    Exit;
  if Align in [alLeft, alRight, alClient] then
    Exit;
  GetOptimalHeight(NewHeight);
  if NewHeight<20 then Exit;
end;

procedure TcxCustomCheckListBox.FontChanged;
begin
  inherited FontChanged;
  SetSize;
end;

procedure TcxCustomCheckListBox.DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);

  procedure PrepareColors(AIsItemEnabled: Boolean);
  begin
    if (odSelected in State) and not IsDesigning then
    begin
      FInnerCheckListBox.Canvas.Font.Color := clHighlightText;
      FInnerCheckListBox.Canvas.Brush.Color := clHighlight;
    end
    else
    begin
      FInnerCheckListBox.Canvas.Brush.Color := ViewInfo.BackgroundColor;
      FInnerCheckListBox.Canvas.Font.Color := ActiveStyle.GetVisibleFont.Color;
    end;
    if (not AIsItemEnabled) and not(odSelected in State) then
      FInnerCheckListBox.Canvas.Font.Color := StyleDisabled.TextColor;
  end;

  function GetCheckState(AIsItemEnabled: Boolean): TcxEditCheckState;
  begin
    if not AIsItemEnabled then
      Result := ecsDisabled
    else
      if FInnerCheckListBox.FHotCheckIndex = Index then
        Result := ecsHot
      else
        if FInnerCheckListBox.FPressedCheckIndex = Index then