cxcheckbox.pas

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

      Exit;

    Result := False;
    AIndex := 1;
    L := Length(S);
    AChecked := False;
    repeat
      if (S[AIndex] = ';') and not AChecked then
      begin
        AChecked := True;
        Inc(AIndex);
      end;
      if not GetNumber(AItemIndex, AIndex, S) or (AItemIndex >= AItems.Count) then
        Exit;
      if AChecked then
        ACheckStates[AItemIndex] := cbsChecked
      else
        ACheckStates[AItemIndex] := cbsGrayed;
      if AIndex > L then
        Break;
      if S[AIndex] = ',' then
        Inc(AIndex);
    until AIndex > L;
    Result := True;
  end;

  function CalculateItemsByStatesIntegerValue: Boolean;
  var
    V: {$IFDEF DELPHI6}Int64{$ELSE}Integer{$ENDIF};
    I, ACode: Integer;
  begin
    Result := VarIsNumericEx(AValue) or VarIsStr(AValue) or VarIsDate(AValue) or
      VarIsNull(AValue);
    if Result then
    begin
      if VarIsNull(AValue) then
        V := 0
      else
        if VarIsStr(AValue) then
        begin
          Val(AValue, V, ACode);
          Result := ACode = 0;
          if not Result then
            Exit;
        end
        else
          V := VarAsType(AValue, {$IFDEF DELPHI6}varInt64{$ELSE}varInteger{$ENDIF});
      for I := 0 to AItems.Count - 1 do
      begin
        if V and 1 = 0 then
          ACheckStates[I] := cbsUnchecked
        else
          ACheckStates[I] := cbsChecked;
        V := V shr 1;
      end;
    end
  end;

  function CalculateItemsByStatesStringValue: Boolean;
  var
    AItemCount, I: Integer;
    S: string;
  begin
    Result := VarIsNull(AValue) or VarIsStr(AValue);
    if not Result then
      Exit;

    Result := False;
    S := VarToStr(AValue);
    AItemCount := Length(S);
    if AItemCount > AItems.Count then
      AItemCount := AItems.Count;
    for I := 1 to AItemCount do
      if (S[I] < '0') or (S[I] > '2') then
        Exit
      else
        ACheckStates[I - 1] := TcxCheckBoxState(Ord(S[I]) - Ord('0'));
    if AItemCount < AItems.Count then
      for I := AItemCount to AItems.Count - 1 do
        ACheckStates[I] := cbsUnchecked;
    Result := True;
  end;

var
  I: Integer;
begin
  SetLength(ACheckStates, AItems.Count);

  case AValueFormat of
    cvfCaptions:
      Result := CalculateItemsByCaptionsValue;
    cvfIndices:
      Result := CalculateItemsByIndicesValue;
    cvfInteger:
      Result := CalculateItemsByStatesIntegerValue;
    cvfStatesString:
      Result := CalculateItemsByStatesStringValue;
    else
      Result := False;
  end;

  if not Result then
    for I := 0 to AItems.Count - 1 do
      ACheckStates[I] := cbsUnchecked;
end;

procedure CalculateCustomCheckBoxViewInfo(ACanvas: TcxCanvas; AViewData: TcxCustomCheckBoxViewData;
  AViewInfo: TcxCustomCheckBoxViewInfo);

  procedure CheckFocusRectBounds;
  var
    AMaxRect: TRect;
  begin
    with AViewInfo do
    begin
      if Alignment = taCenter then
        AMaxRect := Rect(FocusRect.Left, ClientRect.Top, FocusRect.Right, ClientRect.Bottom)
      else
      begin
        AMaxRect := Rect(TextRect.Left - 1, TextRect.Top - 1 + 2 * Integer(IsInplace),
          TextRect.Right + 1, TextRect.Bottom + 1 - 2 * Integer(IsInplace));
        if AMaxRect.Right > BorderRect.Right - 1 then
          AMaxRect.Right := BorderRect.Right - 1;
      end;

      if FocusRect.Left < AMaxRect.Left then
        FocusRect.Left := AMaxRect.Left;
      if FocusRect.Top < AMaxRect.Top then
        FocusRect.Top := AMaxRect.Top;
      if FocusRect.Right > AMaxRect.Right then
        FocusRect.Right := AMaxRect.Right;
      if FocusRect.Bottom > AMaxRect.Bottom then
        FocusRect.Bottom := AMaxRect.Bottom;
    end;
  end;

begin
  with AViewInfo do
  begin
    BackgroundColor := AViewData.Style.Color;

    if Focused and ((not IsInplace or AViewData.Properties.IsEmbeddedEdit) and (Alignment <> taCenter) or
      IsInplace and (Alignment = taCenter) and (epoShowFocusRectWhenInplace in PaintOptions)) then
    begin
      if Alignment = taCenter then
      begin
        FocusRect := ClientRect;
        InflateRect(FocusRect, -1, -1);
      end
      else
        if Length(Text) <> 0 then
        begin
          FocusRect := TextRect;
          if not AViewData.Properties.FullFocusRect then
          begin
            ACanvas.Font := Font;
            ACanvas.TextExtent(Text, FocusRect, DrawTextFlags);
          end;
          InflateRect(FocusRect, 1, 1);
        end
        else
          FocusRect := cxEmptyRect;
    end
    else
      FocusRect := cxEmptyRect;
    if not IsRectEmpty(FocusRect) then
      CheckFocusRectBounds;
  end;
end;

procedure DrawCheckBoxText(ACanvas: TcxCanvas; AText: string; AFont: TFont;
  ATextColor: TColor; ATextRect: TRect; ADrawTextFlags: Integer; AEnabled: Boolean);
begin
  ACanvas.Font := AFont;
  ACanvas.Font.Color := ATextColor;
  ACanvas.Brush.Style := bsClear;
  ACanvas.DrawText(AText, ATextRect, ADrawTextFlags, AEnabled);
  ACanvas.Brush.Style := bsSolid;
end;

function IsGlyphValid(AGlyph: TBitmap; AGlyphCount: Integer): Boolean;
begin
  Result := (AGlyphCount > 0) and VerifyBitmap(AGlyph);
end;

function GetCheckNativeState(AState: TcxCheckBoxState; ACheckState: TcxEditCheckState): Integer;
const
  ANativeCheckStateMap: array[TcxCheckBoxState, TcxEditCheckState] of Integer = (
    (CBS_UNCHECKEDNORMAL, CBS_UNCHECKEDHOT, CBS_UNCHECKEDPRESSED, CBS_UNCHECKEDDISABLED),
    (CBS_CHECKEDNORMAL, CBS_CHECKEDHOT, CBS_CHECKEDPRESSED, CBS_CHECKEDDISABLED),
    (CBS_MIXEDNORMAL, CBS_MIXEDHOT, CBS_MIXEDPRESSED, CBS_MIXEDDISABLED)
  );
begin
  Result := ANativeCheckStateMap[AState, ACheckState];
end;

procedure DrawCustomCheckBox(ACanvas: TcxCanvas; AViewInfo: TcxCustomCheckBoxViewInfo); overload;
var
  AIsBackgroundTransparent: Boolean;
  ACheckRect: TRect;
  ACheckTransparent: Boolean;
begin
  AIsBackgroundTransparent := AViewInfo.IsBackgroundTransparent;

//  ACanvas.Brush.Color := AViewInfo.BackgroundColor; // to fix problem with DC color after RestoreDC

  ACheckRect := AViewInfo.CheckBoxRect;
  InflateRect(ACheckRect, -AViewInfo.CheckBorderOffset, -AViewInfo.CheckBorderOffset);

  ACheckTransparent := AIsBackgroundTransparent and
    (Assigned(AViewInfo.Painter) or AViewInfo.HasGlyph or
    AViewInfo.NativeStyle and IsThemeBackgroundPartiallyTransparent(
    OpenTheme(totButton), BP_CHECKBOX, GetCheckNativeState(AViewInfo.State, AViewInfo.CheckBoxState)));

  AViewInfo.DrawEditBackground(ACanvas, AViewInfo.Bounds, ACheckRect, ACheckTransparent);

  DrawEditCheck(ACanvas, AViewInfo.CheckBoxRect, AViewInfo.State, AViewInfo.CheckBoxState,
    AViewInfo.CheckBoxGlyph, AViewInfo.CheckBoxGlyphCount,
    AViewInfo.CheckBoxBorderStyle, AViewInfo.NativeStyle,
    AViewInfo.BorderColor, AViewInfo.BackgroundColor, not AIsBackgroundTransparent,
    AViewInfo.IsDesigning, AViewInfo.Focused, True, AViewInfo.Painter,
    AViewInfo.NullValueShowingStyle);

  if AViewInfo.Alignment <> taCenter then
    DrawCheckBoxText(ACanvas, AViewInfo.Text, AViewInfo.Font, AViewInfo.TextColor,
      AViewInfo.TextRect, AViewInfo.DrawTextFlags, AViewInfo.IsTextEnabled);
  if not IsRectEmpty(AViewInfo.FocusRect) then
    ACanvas.DrawFocusRect(AViewInfo.FocusRect);
end;

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);
const
  CheckState2ButtonState: array[TcxEditCheckState] of TcxButtonState =
      (cxbsNormal, cxbsHot, cxbsPressed, cxbsDisabled);

  procedure DrawCheckBoxGlyph;
  var
    ABitmap: TBitmap;
    AGlyphIndex: Integer;
    R: TRect;
  begin
    AGlyphIndex := GetEditCheckGlyphIndex(AState, ACheckState, ASupportGrayed,
      AGlyphCount);
    ABitmap := TBitmap.Create;
    try
      ABitmap.Assign(AGlyph);
      ABitmap.Height := ACheckRect.Bottom - ACheckRect.Top;
      ABitmap.Width := ACheckRect.Right - ACheckRect.Left;

      R.Left := (AGlyph.Width div AGlyphCount) * AGlyphIndex;
      R.Right := R.Left + ABitmap.Width;
      R.Top := (AGlyph.Height - ABitmap.Height) div 2;
      R.Bottom := R.Top + ABitmap.Height;

      ABitmap.Canvas.CopyRect(Rect(0, 0, ABitmap.Width, ABitmap.Height),
        AGlyph.Canvas, R);
      DrawGlyph(ACanvas, ACheckRect.Left, ACheckRect.Top, ABitmap,
        ACheckState <> ecsDisabled, ColorToRGB(ABackgroundColor));
    finally
      ABitmap.Free;
    end;
  end;

  procedure DrawCheckBoxBorder;
  const
    ACheckBoxStateToButtonStateMap: array [TcxEditCheckState] of TcxButtonState =
      (cxbsNormal, cxbsHot, cxbsPressed, cxbsDisabled);
  var
    ACheckBorderOffset: Integer;
    R: TRect;
  begin
    if ANativeStyle then
    begin
      DrawThemeBackground(OpenTheme(totButton), ACanvas.Handle, BP_CHECKBOX,
        GetCheckNativeState(AState, ACheckState), ACheckRect);
      Exit;
    end;

    R := ACheckRect;
    ACheckBorderOffset := GetEditCheckBorderOffset(ABorderStyle, False, False, APainter);

    if ADrawBackground and (ACheckBorderOffset > 0) then
      ACanvas.FrameRect(R, ABackgroundColor, ACheckBorderOffset);
    InflateRect(R, -ACheckBorderOffset, -ACheckBorderOffset);
    with ACanvas do
    begin
      case ABorderStyle of
        ebsSingle:
          FrameRect(R, ABorderColor);
        ebsThick:
          FrameRect(R, ABorderColor, 2);
        ebsFlat:
          begin
            DrawEdge(R, True, True, cxBordersAll);
            InflateRect(R, -1, -1);
            FrameRect(R, clBtnFace);
          end;
        ebs3D:
          begin
            DrawEdge(R, True, True, cxBordersAll);
            InflateRect(R, -1, -1);
            DrawComplexFrame(R, cl3DDkShadow, cl3DLight, cxBordersAll);
          end;
        ebsUltraFlat, ebsOffice11:
          begin
            if (ABorderStyle = ebsOffice11) and (ACheckState = ecsNormal) and
              not AIsDesigning and not AFocused then
                ABorderColor := clBtnText
            else
              if (ACheckState in [ecsHot, ecsPressed]) or
                AIsDesigning and (ACheckState <> ecsDisabled) or
                (ACheckState = ecsNormal) and AFocused then
                  ABorderColor := GetEditBorderHighlightColor(
                    ABorderStyle = ebsOffice11)
              else
                ABorderColor := clBtnShadow;
            FrameRect(R, ABorderColor);
          end;
      end;
    end;
  end;

  procedure DrawCheck(R: TRect; AColor: TColor);
  const
    ROP_PSDPxax = $B8074A;
  var
    APrevClipRgn: TcxRegion;
  begin
    APrevClipRgn := ACanvas.GetClipRegion;
    try
      ACanvas.SetClipRegion(TcxRegion.Create(R), roIntersect);
      InflateRect(R, cxEditMaxCheckBoxBorderWidth, cxEditMaxCheckBoxBorderWidth);
      ACanvas.Brush.Color := AColor;
      BitBlt(ACanvas.Handle, R.Left, R.Top, FCheckMask.Width, FCheckMask.Height,
        FCheckMask.Canvas.Handle, 0, 0, ROP_PSDPxax);
    finally
      ACanvas.SetClipRegion(APrevClipRgn, roSet);
    end;
  end;

  function GetCheckBoxContentColor: TColor;
  const
    AColors: array[TcxEditCheckState] of TColor =
      (clWindow, clWindow, clBtnFace, clBtnFace);
  begin
    if ABorderStyle in [ebsUltraFlat, ebsOffice11] then
      case ACheckState of
        ecsNormal:
          if (AState = cbsGrayed) and (AGrayedShowingStyle = nssInactive) then
            Result := clBtnFace
          else
            Result := clWindow;
        ecsHot, ecsPressed:
          Result := GetEditButtonHighlightColor(
            ACheckState = ecsPressed,
            ABorderStyle = ebsOffice11);
        else
          Result := clBtnFace;
      end
    else
      if (AState = cbsGrayed) and (AGrayedShowingStyle = nssInactive) then
        Result := clBtnFace
      else
        Result := AColors[ACheckState];
  end;

  procedure InternalDrawCheckBoxContent(AContentRect: TRect);
  const
    AButtonStateMap: array [TcxEditCheckState] of TcxButtonState =