cxcheckbox.pas

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

    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

  { TcxFilterCheckBoxHelper }

  TcxFilterCheckBoxHelper = class(TcxFilterComboBoxHelper)
  public
    class procedure GetFilterValue(AEdit: TcxCustomEdit;
      AEditProperties: TcxCustomEditProperties; var V: Variant; var S: TCaption); override;
    class function GetSupportedFilterOperators(
      AProperties: TcxCustomEditProperties;
      AValueTypeClass: TcxValueTypeClass;
      AExtendedSet: Boolean = False): TcxFilterControlOperators; override;
    class procedure InitializeProperties(AProperties,
      AEditProperties: TcxCustomEditProperties; AHasButtons: Boolean); override;
    class procedure SetFilterValue(AEdit: TcxCustomEdit; AEditProperties: TcxCustomEditProperties;
      AValue: Variant); override;
    class function UseDisplayValue: Boolean; override;
  end;

  { TcxCheckBoxActionLink }

  TcxCheckBoxActionLink = class(TWinControlActionLink)
  protected
    FClient: TcxCustomCheckBox;
    procedure AssignClient(AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    procedure SetChecked(Value: Boolean); override;
    procedure InternalSetChecked(Value: Boolean);
  end;

var
  CheckStates: TcxCheckStates = nil;

function CalculateCheckStatesValue(const ACheckStates: TcxCheckStates;
  AItems: IcxCheckItems; AValueFormat: TcxCheckStatesValueFormat): TcxEditValue;
function CalculateCheckStates(const AValue: TcxEditValue;
  AItems: IcxCheckItems; AValueFormat: TcxCheckStatesValueFormat;
  var ACheckStates: TcxCheckStates): Boolean;
procedure DrawEditCheck(ACanvas: TcxCanvas; const ACheckRect: TRect;
  AState: TcxCheckBoxState; ACheckState: TcxEditCheckState; AGlyph: TBitmap;
  AGlyphCount: Integer; ABorderStyle: TcxEditCheckBoxBorderStyle;
  ANativeStyle: Boolean; ABorderColor: TColor; ABackgroundColor: TColor;
  ADrawBackground, AIsDesigning, AFocused, ASupportGrayed: Boolean;
  APainter: TcxCustomLookAndFeelPainterClass;
  AGrayedShowingStyle: TcxCheckBoxNullValueShowingStyle = nssGrayedChecked);
function GetEditCheckBorderOffset(ACheckBorderStyle: TcxContainerBorderStyle;
  ANativeStyle, AHasGlyph: Boolean; APainter: TcxCustomLookAndFeelPainterClass): Integer; overload;
function GetEditCheckBorderOffset(ACheckBorderStyle: TcxEditBorderStyle;
  ANativeStyle, AHasGlyph: Boolean; APainter: TcxCustomLookAndFeelPainterClass): Integer; overload;
function GetEditCheckBorderOffset(ALookAndFeelKind: TcxLookAndFeelKind;
  ANativeStyle, AHasGlyph: Boolean; APainter: TcxCustomLookAndFeelPainterClass): Integer; overload;
function GetEditCheckGlyphIndex(AState: TcxCheckBoxState;
  ACheckState: TcxEditCheckState; ASupportGrayed: Boolean;
  AGlyphCount: Integer): Integer;
function GetEditCheckSize(ACanvas: TcxCanvas; ANativeStyle: Boolean;
  AGlyph: TBitmap; AGlyphCount: Integer; APainter: TcxCustomLookAndFeelPainterClass): TSize;

procedure DrawCheckBoxText(ACanvas: TcxCanvas; AText: string; AFont: TFont;
  ATextColor: TColor; ATextRect: TRect; ADrawTextFlags: Integer; AEnabled: Boolean);

implementation

uses
  ActnList, dxThemeConsts, dxThemeManager, dxUxTheme, cxEditConsts,
  cxEditPaintUtils, cxDrawTextUtils, cxEditUtils;

var
  FCheckMask: TBitmap;

procedure PrepareCheckMask;

  procedure InternalPrepareCheckMask(AButtonsBitmap: HBITMAP);
  var
    AMemDC: HDC;
    APrevBitmap: HBITMAP;
    I, J: Integer;
  begin
    FCheckMask := TBitmap.Create;
    with TcxCustomLookAndFeelPainter do
    begin
      FCheckMask.Width := CheckButtonSize.cx;
      FCheckMask.Height := CheckButtonSize.cy;
    end;

    AMemDC := CreateCompatibleDC(0);
    APrevBitmap := 0;
    try
      APrevBitmap := SelectObject(AMemDC, AButtonsBitmap);
      with FCheckMask.Canvas do
        for I := 0 to FCheckMask.Height - 1 do
          for J := 0 to FCheckMask.Width - 1 do
            if Windows.GetPixel(AMemDC, J, I) = Windows.GetPixel(AMemDC, J + FCheckMask.Width, I) then
              Pixels[J, I] := clWhite
            else
              Pixels[J, I] := 0;
    finally
      if APrevBitmap <> 0 then
        SelectObject(AMemDC, APrevBitmap);
      DeleteDC(AMemDC);
    end;
  end;

var
  AButtonsBitmap: HBITMAP;
begin
  AButtonsBitmap := LoadBitmap(0, PChar(OBM_CHECKBOXES));
  try
    InternalPrepareCheckMask(AButtonsBitmap);
  finally
    DeleteObject(AButtonsBitmap);
  end;
end;

procedure CalculateCheckBoxViewInfo(AViewData: TcxCustomCheckBoxViewData; AViewInfo:
  TcxCustomCheckBoxViewInfo; AIsMouseEvent: Boolean);
begin
  with AViewInfo do
  begin
    AViewData.CalculateViewInfo(AViewInfo, AIsMouseEvent);
    TextRect := ClientRect;
    ExtendRect(TextRect, GetTextEditDrawTextOffset(AViewData));
  end;
end;

function CalculateCheckStatesValue(const ACheckStates: TcxCheckStates;
  AItems: IcxCheckItems; AValueFormat: TcxCheckStatesValueFormat): TcxEditValue;

  function CalculateCaptionsValue: TcxEditValue;
  var
    ACheckedCaptions, AGrayedCaptions: string;
    I: Integer;
  begin
    ACheckedCaptions := '';
    AGrayedCaptions := '';
    for I := 0 to Length(ACheckStates) - 1 do
    begin
      if ACheckStates[I] <> cbsUnchecked then
        if ACheckStates[I] = cbsGrayed then
          AGrayedCaptions := AGrayedCaptions +
            IntToStr(Length(AItems.Captions[I])) + ':' + AItems.Captions[I]
        else
          ACheckedCaptions := ACheckedCaptions +
            IntToStr(Length(AItems.Captions[I])) + ':' + AItems.Captions[I];
    end;
    Result := AGrayedCaptions;
    if Length(ACheckedCaptions) > 0 then
      Result := Result + ';' + ACheckedCaptions;
  end;

  function CalculateIndicesValue: TcxEditValue;
  var
    ACheckedCaptions, AGrayedCaptions: string;
    I: Integer;
  begin
    ACheckedCaptions := '';
    AGrayedCaptions := '';
    for I := 0 to Length(ACheckStates) - 1 do
      if ACheckStates[I] <> cbsUnchecked then
        if ACheckStates[I] = cbsGrayed then
        begin
          if AGrayedCaptions <> '' then
            AGrayedCaptions := AGrayedCaptions + ',';
          AGrayedCaptions := AGrayedCaptions + IntToStr(I);
        end
        else
        begin
          if ACheckedCaptions <> '' then
            ACheckedCaptions := ACheckedCaptions + ',';
          ACheckedCaptions := ACheckedCaptions + IntToStr(I);
        end;
    Result := AGrayedCaptions;
    if Length(ACheckedCaptions) > 0 then
      Result := Result + ';' + ACheckedCaptions;
  end;

  function CalculateStatesIntegerValue: TcxEditValue;
  var
    V: {$IFDEF DELPHI6}Int64{$ELSE}Integer{$ENDIF};
    I, L: Integer;
  begin
    V := 0;
    L := Length(ACheckStates);
    if L > SizeOf({$IFDEF DELPHI6}Int64{$ELSE}Integer{$ENDIF}) * 8 then
      L := SizeOf({$IFDEF DELPHI6}Int64{$ELSE}Integer{$ENDIF}) * 8;
    for I := L - 1 downto 0 do
    begin
      V := V shl 1;
      V := V + {$IFDEF DELPHI6}Int64{$ELSE}Integer{$ENDIF}(ACheckStates[I] = cbsChecked);
    end;
    Result := V;
    VarCast(Result, Result, {$IFDEF DELPHI6}varInt64{$ELSE}varInteger{$ENDIF});
  end;

  function CalculateStatesStringValue: TcxEditValue;
  var
    I: Integer;
    S: string;
  begin
    SetLength(S, Length(ACheckStates));
    for I := 0 to High(ACheckStates) do
      S[I + 1] := Char(Integer(ACheckStates[I]) + Ord('0'));
    Result := S;
  end;

begin
  Result := Null;
  case AValueFormat of
    cvfCaptions:
      Result := CalculateCaptionsValue;
    cvfIndices:
      Result := CalculateIndicesValue;
    cvfInteger:
      Result := CalculateStatesIntegerValue;
    cvfStatesString:
      Result := CalculateStatesStringValue;
  end;
end;

function CalculateCheckStates(const AValue: TcxEditValue;
  AItems: IcxCheckItems; AValueFormat: TcxCheckStatesValueFormat;
  var ACheckStates: TcxCheckStates): Boolean;

  function GetNumber(var ANumber, AIndex: Integer;
    const S: string): Boolean;

    function IsDigit(C: Char): Boolean;
    begin
      Result := (C >= '0') and (C <= '9');
    end;

  const
    AMaxLength = MaxInt div 10;
    AMaxIntLastDigit = MaxInt mod 10;
  var
    L: Integer;
    D: Integer;
  begin
    Result := False;
    L := Length(S);
    if (AIndex > L) or not IsDigit(S[AIndex]) then
      Exit;
      
    ANumber := 0;
    repeat
      D := StrToInt(S[AIndex]);
      if (ANumber > AMaxLength) or
        ((ANumber = AMaxLength) and (D > AMaxIntLastDigit)) then
          Exit;
      ANumber := ANumber * 10 + D;
      Inc(AIndex);
    until (AIndex > L) or not IsDigit(S[AIndex]);
    Result := True;
  end;

  function CalculateItemsByCaptionsValue: Boolean;

    function GetCaptions(ACaptions: TStringList): Boolean;
    var
      S: string;
      ACaptionLength, AIndex, AValueLength: Integer;
      AChecked: Boolean;
    begin
      S := VarToStr(AValue);
      Result := S = '';
      if Result then
        Exit;

      Result := False;
      AChecked := False;
      AValueLength := Length(S);
      AIndex := 1;
      repeat
        if (S[AIndex] = ';') and not AChecked then
        begin
          AChecked := True;
          Inc(AIndex);
        end;
        if not GetNumber(ACaptionLength, AIndex, S) then
          Exit;
        if (AIndex > AValueLength) or (S[AIndex] <> ':') then
          Exit;
        Inc(AIndex);
        if AIndex + ACaptionLength - 1 > AValueLength then
          Exit;
        ACaptions.AddObject(Copy(S, AIndex, ACaptionLength),
          Pointer(AChecked));
        Inc(AIndex, ACaptionLength);
        if AIndex > AValueLength then
          Break;
      until (AIndex > AValueLength);
      Result := True;
    end;

    function CalculateStates(ACaptions: TStringList): Boolean;
    var
      AIndex, I: Integer;
    begin
      for I := 0 to AItems.Count - 1 do
      begin
        AIndex := ACaptions.IndexOf(AItems.Captions[I]);
        if AIndex = -1 then
          ACheckStates[I] := cbsUnchecked
        else
        begin
          if Boolean(ACaptions.Objects[AIndex]) then
            ACheckStates[I] := cbsChecked
          else
            ACheckStates[I] := cbsGrayed;
          ACaptions.Delete(AIndex);
        end;
      end;
      Result := ACaptions.Count = 0;
    end;

  var
    ACaptions: TStringList;
  begin
    if not(VarIsNull(AValue) or VarIsStr(AValue)) then
    begin
      Result := False;
      Exit;
    end;
    ACaptions := TStringList.Create;
    try
      Result := GetCaptions(ACaptions);
      if not Result then
        Exit;
      ACaptions.Sort;
      Result := CalculateStates(ACaptions);
    finally
      FreeAndNil(ACaptions);
    end;
  end;

  procedure SetStatesToUnchecked;
  var
    I: Integer;
  begin
    for I := 0 to AItems.Count - 1 do
      ACheckStates[I] := cbsUnchecked;
  end;

  function CalculateItemsByIndicesValue: Boolean;
  var
    AChecked: Boolean;
    AIndex, AItemIndex, L: Integer;
    S: string;
  begin
    Result := VarIsNull(AValue) or VarIsStr(AValue);
    if not Result then
      Exit;

    S := VarToStr(AValue);
    SetStatesToUnchecked;
    if S = '' then