cxchecklistbox.pas

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

  if Result <> -1 then
    if not PtInRect(GetCheckRect(ItemRect(Result), False), P) then
      Result := -1;
end;

procedure TcxCustomInnerCheckListBox.GetCheckMetrics(out ACheckSize: TSize;
  out ACheckBorderOffset: Integer);
begin
  with Container do
  begin
    ACheckSize := GetEditCheckSize(Self.Canvas, Style.LookAndFeel.NativeStyle,
      Glyph, GlyphCount, Style.LookAndFeel.SkinPainter);
    ACheckBorderOffset := GetEditCheckBorderOffset(Style.LookAndFeel.Kind,
      FNativeStyle, VerifyBitmap(Glyph) and (GlyphCount > 0),
      LookAndFeel.SkinPainter);
  end;
end;

function TcxCustomInnerCheckListBox.GetCheckRect(const R: TRect;
  AReturnFullRect: Boolean): TRect;
var
  ACheckBorderOffset, ACheckOffset: Integer;
  ACheckSize: TSize;
begin
  if not Container.ShowChecks then
  begin
    Result := cxEmptyRect;
    Exit;
  end;

  GetCheckMetrics(ACheckSize, ACheckBorderOffset);
  ACheckSize.cx := ACheckSize.cx - ACheckBorderOffset * 2;
  ACheckSize.cy := ACheckSize.cy - ACheckBorderOffset * 2;

  ACheckOffset := Metrics.ContentOffset + Metrics.CheckFrameWidth;
  if (Container.ImageLayout = ilBeforeChecks) and VerifyImages(Container.Images) then
    Inc(ACheckOffset, Container.Images.Width + Metrics.ImageFrameWidth * 2);

  with R do
  begin
    Result.Top := Top + (Bottom - Top - ACheckSize.cy) div 2;
    Result.Bottom := Result.Top + ACheckSize.cy;
    if UseRightToLeftAlignment then
    begin
      Result.Right := Right - ACheckOffset;
      Result.Left := Result.Right - ACheckSize.cx;
    end
    else
    begin
      Result.Left := Left + ACheckOffset;
      Result.Right := Result.Left + ACheckSize.cx;
    end;
  end;
  if AReturnFullRect then
    InflateRect(Result, ACheckBorderOffset, ACheckBorderOffset);
end;

function TcxCustomInnerCheckListBox.GetCheckRegionWidth: Integer;
var
  ACheckBorderOffset: Integer;
  ACheckSize: TSize;
begin
  with Container do
  begin
    Result := Metrics.ContentOffset;
    if ShowChecks or VerifyImages(Images) then
      Inc(Result, Metrics.TextAreaOffset);
    if ShowChecks then
    begin
      GetCheckMetrics(ACheckSize, ACheckBorderOffset);
      ACheckSize.cx := ACheckSize.cx - ACheckBorderOffset * 2;
      Inc(Result, ACheckSize.cx + Metrics.CheckFrameWidth * 2);
    end;
    if VerifyImages(Images) then
      Inc(Result, Images.Width + Metrics.ImageFrameWidth * 2);
  end;
end;

function TcxCustomInnerCheckListBox.GetMetrics: TcxCheckListBoxMetrics;
begin
  Result.CheckFrameWidth := cxCheckListBoxCheckFrameWidth;
  Result.ContentOffset := cxCheckListBoxContentOffset;
  Result.ImageFrameWidth := cxCheckListBoxImageFrameWidth;
  Result.TextAreaOffset := cxCheckListBoxTextAreaOffset;
  Result.TextOffset := cxCheckListBoxTextOffset;
  Result.TextWidthCorrection := cxCheckListBoxTextWidthCorrection;
end;

function TcxCustomInnerCheckListBox.GetStandardItemHeight: Integer;
var
  ACheckBorderOffset: Integer;
  ACheckSize: TSize;
begin
  Canvas.Font := Font;
  Result := Canvas.TextHeight('Zg');
  with Container do
  begin
    if ShowChecks then
    begin
      GetCheckMetrics(ACheckSize, ACheckBorderOffset);
      ACheckSize.cy := ACheckSize.cy - ACheckBorderOffset * 2;
      if Result < ACheckSize.cy + Metrics.CheckFrameWidth * 2 then
        Result := ACheckSize.cy + Metrics.CheckFrameWidth * 2;
    end;
    if VerifyImages(Images) and (Result < Images.Height + Metrics.ImageFrameWidth * 2) then
      Result := Images.Height + Metrics.ImageFrameWidth * 2;
  end;
end;

procedure TcxCustomInnerCheckListBox.InternalMouseMove(Shift: TShiftState;
  X, Y: Integer);
var
  ANewHotCheckIndex, ANewPressedCheckIndex: Integer;
begin
  if FCapturedCheckIndex = -1 then
  begin
    if Shift = [] then
      ANewHotCheckIndex := GetCheckAt(X, Y)
    else
      ANewHotCheckIndex := FHotCheckIndex;
    ANewPressedCheckIndex := FPressedCheckIndex;
  end
  else
  begin
    ANewHotCheckIndex := -1;
    if GetCheckAt(X, Y) = FCapturedCheckIndex then
      ANewPressedCheckIndex := FCapturedCheckIndex
    else
      ANewPressedCheckIndex := -1;
  end;
  SynchronizeCheckStates(ANewHotCheckIndex, ANewPressedCheckIndex);
end;

procedure TcxCustomInnerCheckListBox.DblClick;
var
  P: TPoint;
begin
  inherited DblClick;
  if (ItemIndex <> -1) and CheckItems[ItemIndex].Enabled then
  begin
    P := ScreenToClient(InternalGetCursorPos);
    if (GetCheckAt(P.X, P.Y) <> -1) or AllowDblClickToggle then
      ToggleClickCheck(ItemIndex);
  end;
end;

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

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

procedure TcxCustomInnerCheckListBox.CMFontChanged(var Message: TMessage);
begin
  inherited;
  AdjustItemHeight;
end;

procedure TcxCustomInnerCheckListBox.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  BeginMouseTracking(Self, GetControlRect(Self), Self);
end;

procedure TcxCustomInnerCheckListBox.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  InternalMouseMove([], -1, -1);
  EndMouseTracking(Self);
end;

function TcxCustomInnerCheckListBox.GetContainer: TcxCustomCheckListBox;
begin
  Result := TcxCustomCheckListBox(Owner);
end;

procedure TcxCustomInnerCheckListBox.FullRepaint;
var
  R: TRect;
begin
  if HandleAllocated then
  begin
    R := GetControlRect(Self);
    InvalidateRect(Handle, @R, True);
  end;
end;

procedure TcxCustomInnerCheckListBox.WMLButtonDown(var Message: TWMLButtonDown);
var
  R: TRect;
begin
  if Container.ShowChecks or Container.DataBinding.SetEditMode then
  begin
    FNewPressedCheckIndex := GetCheckAt(Message.XPos, Message.YPos);
    try
      if FNewPressedCheckIndex <> -1 then
      begin
        R := ItemRect(FNewPressedCheckIndex);
        FNewPressedCheckItemFullyVisible := R.Bottom <= ClientHeight;
        DragMode := dmManual;
      end;
      inherited;
    finally
      FNewPressedCheckIndex := -1;
      DragMode := Container.DragMode;
    end;
  end
  else
  begin
    SetFocus;
    with Message do
      MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
  end;
end;

procedure TcxCustomInnerCheckListBox.CNDrawItem(var Message: TWMDrawItem);
var
  ADrawItemStruct: PDrawItemStruct;
begin
  if Items.Count = 0 then
    Exit;
  ADrawItemStruct := Message.DrawItemStruct;
  with ADrawItemStruct^ do
    if not UseRightToLeftAlignment then
      rcItem.Left := rcItem.Left + GetCheckRegionWidth
    else
      rcItem.Right := rcItem.Right - GetCheckRegionWidth;
  inherited;
end;

procedure TcxCustomInnerCheckListBox.CNMeasureItem(var Message: TWMMeasureItem);
begin
  if Container.FListStyle = lbStandard then
    Message.MeasureItemStruct.itemHeight := GetStandardItemHeight
  else
    inherited;
end;

procedure TcxCustomInnerCheckListBox.CMColorChanged(var Message: TMessage);
begin
  inherited;
  FullRepaint;
end;

procedure TcxCustomInnerCheckListBox.DrawCheck(R: TRect;
  AState: TcxCheckBoxState; ACheckState: TcxEditCheckState);

  function GetCheckBorderStyle: TcxEditCheckBoxBorderStyle;
  begin
    with Container do
      if not FNativeStyle and (FCheckBorderStyle = ebsFlat) and
          (ACheckState in [ecsHot, ecsPressed]) then
        Result := ebs3D
      else
        Result := FCheckBorderStyle;
  end;

begin
  if R.Top < 0 then
    Exit;    

  DrawEditCheck(Canvas, GetCheckRect(R, True), AState, ACheckState, Glyph,
    GlyphCount, GetCheckBorderStyle, Container.FNativeStyle, clBtnText, Color,
    True, Container.IsDesigning, False, True, LookAndFeel.SkinPainter);
end;

procedure TcxCustomInnerCheckListBox.InvalidateItem(Index: Integer);
var
  R: TRect;
begin
  R := ItemRect(Index);
  InvalidateRect(Handle, @R, True);
end;

procedure TcxCustomInnerCheckListBox.SynchronizeCheckStates(ANewHotCheckIndex,
  ANewPressedCheckIndex: Integer);
begin
  if ANewHotCheckIndex <> FHotCheckIndex then
  begin
    InvalidateCheck(FHotCheckIndex);
    FHotCheckIndex := ANewHotCheckIndex;
    InvalidateCheck(FHotCheckIndex);
  end;
  if ANewPressedCheckIndex <> FPressedCheckIndex then
  begin
    InvalidateCheck(FPressedCheckIndex);
    FPressedCheckIndex := ANewPressedCheckIndex;
    InvalidateCheck(FPressedCheckIndex);
  end;
end;

procedure TcxCustomInnerCheckListBox.UpdateCheckStates;
var
  I: Integer;
begin
  if Assigned(Container.FOnEditValueToCheckStates) then
  begin
    SetLength(CheckStates, Container.Items.Count);
    Container.FOnEditValueToCheckStates(Container, Container.EditValue,
      CheckStates);
  end
  else
    CalculateCheckStates(Container.EditValue, CheckItems,
      Container.EditValueFormat, CheckStates);
  CheckItems.LockChanged(True);
  try
    for I := 0 to CheckItems.Count - 1 do
      CheckItems[I].State := CheckStates[I];
  finally
    CheckItems.LockChanged(False, False);
  end;
end;

procedure TcxCustomInnerCheckListBox.UpdateEditValue;
var
  ANewEditValue: TcxEditValue;
  AEditValueChanged: Boolean;
  I: Integer;
begin
  SetLength(CheckStates, CheckItems.Count);
  for I := 0 to CheckItems.Count - 1 do
    CheckStates[I] := CheckItems[I].State;
  if Assigned(Container.FOnCheckStatesToEditValue) then
    Container.FOnCheckStatesToEditValue(Container, CheckStates, ANewEditValue)
  else
    ANewEditValue := CalculateCheckStatesValue(CheckStates, CheckItems,
      Container.EditValueFormat);

  if Assigned(Container.OnEditValueChanged) then
    AEditValueChanged := not InternalVarEqualsExact(Container.FEditValue, ANewEditValue)
  else
    AEditValueChanged := False;

  Container.FEditValue := ANewEditValue;
  Container.IsModified := True;

  if AEditValueChanged then
    Container.DoEditValueChanged;
end;

procedure TcxCustomInnerCheckListBox.WndProc(var Message: TMessage);
begin
  inherited WndProc(Message);
  case Message.Msg of
    WM_HSCROLL,
    WM_MOUSEWHEEL,
    WM_VSCROLL:
      CheckHotTrack;
  end;
end;

procedure TcxCustomInnerCheckListBox.InvalidateCheck(Index: Integer);
var
  R: TRect;
begin
  if not HandleAllocated then
    Exit;
  R := ItemRect(Index);
  R := GetCheckRect(R, False);
  InvalidateRect(Handle, @R, False);
end;

function TcxCustomInnerCheckListBox.GetGlyph: TBitmap;
begin
  if FGlyph = nil then
  begin
    FGlyph := TBitmap.Create;
    FGlyph.OnChange := GlyphChanged;
  end;
  Result := FGlyph;
end;

procedure TcxCustomInnerCheckListBox.GlyphChanged(Sender: TObject);
begin
  AdjustItemHeight;
end;

procedure TcxCustomInnerCheckListBox.SetGlyph(Value: TBitmap);
begin
  if Value = nil then
  begin
    FreeAndNil(FGlyph);
    AdjustItemHeight;
  end
  else
    Glyph.Assign(Value);
end;

procedure TcxCustomInnerCheckListBox.SetGlyphCount(Value: Integer);
begin
  if FGlyphCount <> Value then
  begin
    FGlyphCount := Value;
    if FGlyph <> nil then
      AdjustItemHeight;
  end;
end;

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

procedure TcxCustomInnerCheckListBox.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ANewHotCheckIndex, ANewPressedCheckIndex: Integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin