cxcheckgroup.pas

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

    (ecsDisabled, ecsNormal, ecsPressed, ecsHot);
var
  ACheckBorderStyle: TcxEditBorderStyle;
  AEditProperties: TcxCustomCheckGroupProperties;
begin
  if (CheckBorderStyle = ebsFlat) and (AButtonViewInfo.Data.State = ebsSelected) then
    ACheckBorderStyle := ebs3D
  else
    ACheckBorderStyle := CheckBorderStyle;
  AEditProperties := TcxCustomCheckGroupProperties(EditProperties);

  DrawEditCheck(ACanvas, AGlyphRect, TcxCheckGroupButtonViewInfo(AButtonViewInfo).State,
    ACheckStateByButtonState[AButtonViewInfo.Data.State], AEditProperties.Glyph,
    AEditProperties.GlyphCount, ACheckBorderStyle, AButtonViewInfo.Data.NativeStyle,
    clBtnText, BackgroundColor, not IsBackgroundTransparent, IsDesigning, False, True,
    Painter);
end;

function TcxCheckGroupViewInfo.GetButtonViewInfoClass: TcxEditButtonViewInfoClass;
begin
  Result := TcxCheckGroupButtonViewInfo;
end;

function TcxCheckGroupViewInfo.IsButtonGlypthTransparent(AButtonViewInfo: TcxGroupBoxButtonViewInfo): Boolean;
begin
  Result := IsBackgroundTransparent;
end;

procedure TcxCheckGroupViewInfo.SetOnDrawBackground(AValue: TcxEditDrawBackgroundEvent);
var
  I: Integer;
begin
  inherited SetOnDrawBackground(AValue);
  if Edit <> nil then
    for I := 0 to Edit.InternalButtons.Count - 1 do
      TcxCheckGroupButton(Edit.InternalButtons[I]).ViewInfo.OnDrawBackground := AValue;
end;

function TcxCheckGroupViewInfo.GetEdit: TcxCustomCheckGroup;
begin
  Result := TcxCustomCheckGroup(FEdit);
end;

{ TcxCheckGroupViewData }

procedure TcxCheckGroupViewData.Calculate(ACanvas: TcxCanvas;
  const ABounds: TRect; const P: TPoint; Button: TcxMouseButton;
  Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo; AIsMouseEvent: Boolean);
const
  ABorderStyle: array[TcxLookAndFeelKind] of TcxEditCheckBoxBorderStyle =
    (ebsFlat, ebs3D, ebsUltraFlat, ebsOffice11);
begin
  inherited Calculate(ACanvas, ABounds, P, Button, Shift, AViewInfo,
    AIsMouseEvent);
  with TcxCustomCheckGroupProperties(Properties) do
  begin
    TcxCheckGroupViewInfo(AViewInfo).GlyphSize :=
      GetEditCheckSize(ACanvas, IsButtonNativeStyle(Style.LookAndFeel), Glyph,
      GlyphCount, AViewInfo.Painter);
    TcxCheckGroupViewInfo(AViewInfo).Alignment := ItemAlignment;
  end;
  TcxCheckGroupViewInfo(AViewInfo).CheckBorderStyle :=
    ABorderStyle[Style.LookAndFeel.Kind];
  AViewInfo.BackgroundColor := Style.Color;
end;

procedure TcxCheckGroupViewData.EditValueToDrawValue(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue; AViewInfo: TcxCustomEditViewInfo);
var
  ASender: TObject;
  I: Integer;
begin
  with TcxCustomCheckGroupProperties(Properties) do
  begin
    if IsInplace then
      ASender := nil
    else
      ASender := Edit;
    TcxCheckGroupViewInfo(AViewInfo).SetButtonCount(Items.Count);
    if PreviewMode then
      TcxCheckGroupButtonViewInfo(AViewInfo.ButtonsInfo[0]).State := cbsChecked
    else
    begin
      CalculateCheckStatesByEditValue(ASender, AEditValue);
      for I := 0 to Items.Count - 1 do
        TcxCheckGroupButtonViewInfo(AViewInfo.ButtonsInfo[I]).State := CheckStates[I];
    end;
  end;
  if epoAutoHeight in PaintOptions then
    Include(AViewInfo.PaintOptions, epoAutoHeight);
end;

procedure TcxCheckGroupViewData.CalculateButtonNativeState(AViewInfo: TcxCustomEditViewInfo;
  AButtonViewInfo: TcxGroupBoxButtonViewInfo);
begin
end;

function TcxCheckGroupViewData.GetCaptionRectExtent: TRect;
begin
  Result.Top := 0;
  Result.Bottom := 0;
  if TcxCustomCheckGroupProperties(Properties).ItemAlignment = taLeftJustify then
  begin
    Result.Left := 3;
    Result.Right := 2;
  end
  else
  begin
    Result.Right := 2;
    Result.Left := 2;
  end;
end;

procedure TcxCheckGroupViewData.GetEditMetrics(AAutoHeight: Boolean;
  ACanvas: TcxCanvas; out AMetrics: TcxEditMetrics);
begin
  AMetrics.ClientLeftBoundCorrection := 6 - (5 +
    Integer(TcxCustomCheckGroupProperties(Properties).ItemAlignment =
    taRightJustify)) * Integer(IsInplace);
  AMetrics.ClientWidthCorrection := 5 * Integer(IsInplace) - 6;
  AMetrics.ColumnOffset := 6;
  if ACanvas = nil then
    Exit;

  AMetrics.ButtonSize := GetEditCheckSize(ACanvas,
    IsButtonNativeStyle(Style.LookAndFeel),
    TcxCustomCheckGroupProperties(Properties).FGlyph,
    TcxCustomCheckGroupProperties(Properties).GlyphCount,
    Style.LookAndFeel.Painter);
  with GetCaptionRectExtent do
    AMetrics.AutoHeightColumnWidthCorrection := Left + Right;
  AMetrics.ColumnWidthCorrection := AMetrics.AutoHeightColumnWidthCorrection;
  AMetrics.WidthCorrection := 6 - 5 * Integer(IsInplace);
  AMetrics.AutoHeightWidthCorrection := AMetrics.ClientWidthCorrection;
end;

{ TcxCustomCheckGroupProperties }

constructor TcxCustomCheckGroupProperties.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FEditValueFormat := cvfIndices;
  FItemAlignment := taLeftJustify;
  FGlyphCount := 6;
end;

destructor TcxCustomCheckGroupProperties.Destroy;
begin
  if FGlyph <> nil then
    FreeAndNil(FGlyph);
  inherited Destroy;
end;

procedure TcxCustomCheckGroupProperties.Assign(Source: TPersistent);
begin
  if Source is TcxCustomCheckGroupProperties then
  begin
    BeginUpdate;
    try
      inherited Assign(Source);
      with TcxCustomCheckGroupProperties(Source) do
      begin
        Self.AllowGrayed := AllowGrayed;
        Self.ItemAlignment := ItemAlignment;
        Self.WordWrap := WordWrap;
        Self.Glyph := Glyph;
        Self.GlyphCount := GlyphCount;
        Self.EditValueFormat := EditValueFormat;
        Self.OnEditValueToStates := OnEditValueToStates;
        Self.OnStatesToEditValue := OnStatesToEditValue;
      end;
    finally
      EndUpdate;
    end
  end
  else
    inherited Assign(Source);
end;

function TcxCustomCheckGroupProperties.CompareDisplayValues(
  const AEditValue1, AEditValue2: TcxEditValue): Boolean;
var
  ACheckStates: TcxCheckStates;
begin
  CalculateCheckStatesByEditValue(nil, AEditValue1);
  ACheckStates := Copy(CheckStates);
  CalculateCheckStatesByEditValue(nil, AEditValue2);
  Result := CompareMem(@ACheckStates[0], @CheckStates[0],
    SizeOf(TcxCheckBoxState) * Length(CheckStates));
end;

class function TcxCustomCheckGroupProperties.GetContainerClass: TcxContainerClass;
begin
  Result := TcxCheckGroup;
end;

function TcxCustomCheckGroupProperties.GetDisplayText(const AEditValue: TcxEditValue;
  AFullText: Boolean = False; AIsInplace: Boolean = True): WideString;
var
  ACheckStateNames: array[TcxCheckBoxState] of WideString;

  procedure InitCheckStateNames;
  begin
    ACheckStateNames[cbsUnchecked] :=
      cxGetResourceString(@cxSEditCheckGroupUnchecked);
    ACheckStateNames[cbsChecked] :=
      cxGetResourceString(@cxSEditCheckGroupChecked);
    ACheckStateNames[cbsGrayed] :=
      cxGetResourceString(@cxSEditCheckGroupGrayed);
  end;

var
  I: Integer;
begin
  CalculateCheckStatesByEditValue(nil, AEditValue);
  InitCheckStateNames;

  Result := '';
  for I := 0 to Items.Count - 1 do
  begin
    Result := Result + Items[I].Caption +
      cxGetResourceString(@cxSEditCheckGroupCaptionStateDelimiter) +
      ACheckStateNames[CheckStates[I]];
    if I < Items.Count - 1 then
      Result := Result + cxGetResourceString(@cxSEditCheckGroupFilterColumnSeparator);
  end;
end;

class function TcxCustomCheckGroupProperties.GetViewInfoClass: TcxContainerViewInfoClass;
begin
  Result := TcxCheckGroupViewInfo;
end;

function TcxCustomCheckGroupProperties.CreateItems: TcxButtonGroupItems;
begin
  Result := TcxCheckGroupItems.Create(Self, TcxCheckGroupItem);
end;

class function TcxCustomCheckGroupProperties.GetViewDataClass: TcxCustomEditViewDataClass;
begin
  Result := TcxCheckGroupViewData;
end;

function TcxCustomCheckGroupProperties.HasDisplayValue: Boolean;
begin
  Result := True;
end;

procedure TcxCustomCheckGroupProperties.CalculateCheckStatesByEditValue(
  Sender: TObject; const AEditValue: TcxEditValue);
begin
  if Assigned(OnEditValueToStates) then
  begin
    SetLength(CheckStates, Items.Count);
    OnEditValueToStates(Sender, AEditValue, CheckStates);
  end
  else
    cxCheckBox.CalculateCheckStates(AEditValue, Items, EditValueFormat, CheckStates);
end;

procedure TcxCustomCheckGroupProperties.CalculateEditValueByCheckStates(
  Sender: TObject; out AEditValue: TcxEditValue);
begin
  if Assigned(OnStatesToEditValue) then
    OnStatesToEditValue(Sender, CheckStates, AEditValue)
  else
    AEditValue := cxCheckBox.CalculateCheckStatesValue(CheckStates, Items, EditValueFormat);
end;

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

function TcxCustomCheckGroupProperties.GetItems: TcxCheckGroupItems;
begin
  Result := TcxCheckGroupItems(inherited Items);
end;

procedure TcxCustomCheckGroupProperties.GlyphChanged(Sender: TObject);
begin
  Changed;
end;

procedure TcxCustomCheckGroupProperties.SetAllowGrayed(Value: Boolean);
begin
  if Value <> FAllowGrayed then
  begin
    FAllowGrayed := Value;
    Changed;
  end;
end;

procedure TcxCustomCheckGroupProperties.SetEditValueFormat(Value: TcxCheckStatesValueFormat);
begin
  if Value <> FEditValueFormat then
  begin
    FEditValueFormat := Value;
    Changed;
  end;
end;

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

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

procedure TcxCustomCheckGroupProperties.SetItemAlignment(Value: TLeftRight);
begin
  if Value <> FItemAlignment then
  begin
    FItemAlignment := Value;
    Changed;
  end;
end;

procedure TcxCustomCheckGroupProperties.SetItems(Value: TcxCheckGroupItems);
begin
  inherited Items.Assign(Value);
end;

{ TcxCheckGroupCheckButtonViewInfo }

procedure TcxCheckGroupCheckButtonViewInfo.InternalPaint(ACanvas: TcxCanvas);
var
  ARect: TRect;
  ABitmap: TBitmap;
  ABitmapCanvas: TcxCanvas;
begin
  if Painter <> nil then
  begin
    ARect := ClientRect;
    ABitmap := cxCreateBitmap(ARect, pf32bit);
    ABitmapCanvas := TcxCanvas.Create(ABitmap.Canvas);
    try
      Painter.DrawGroupBoxBackground(ABitmapCanvas, ARect,
        Rect(0, 0, ABitmap.Width, ABitmap.Height));
      inherited InternalPaint(ABitmapCanvas);
      ACanvas.Draw(0, 0, ABitmap); 
    finally
      ABitmapCanvas.Free;
      ABitmap.Free;
    end;
  end
  else
    inherited InternalPaint(ACanvas);
end;

{ TcxCheckGroupButtonProperties }

function TcxCheckGroupButtonProperties.InternalGetGlyph: TBitmap;
begin
  Result :=
   (TcxCheckGroupButton(Owner).Owner as TcxCustomCheckGroup).ActiveProperties.Glyph;
end;

function TcxCheckGroupButtonProperties.IsEmbeddedEdit: Boolean;
begin
  Result := True;
end;

class function TcxCheckGroupButtonProperties.GetViewInfoClass: TcxContainerViewInfoClass;
begin
  Result := TcxCheckGroupCheckButtonViewInfo;
end;

{ TcxCheckGroupButton }

destructor TcxCheckGroupButton.Destroy;
begin
  TcxCustomCheckGroup(GetOwner).InternalButtons.Remove(Self);
  inherited Destroy;
end;

function TcxCheckGroupButton.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or
    CheckGroup.DataBinding.ExecuteAction(Action);
end;

class function TcxCheckGroupButton.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxCheckGroupButtonProperties;
end;

function TcxCheckGroupButton.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or
    CheckGroup.DataBinding.UpdateAction(Action);
end;

function TcxCheckGroupButton.CanAutoSize: Boolean;
begin
  Result := False;
end;

procedure TcxCheckGroupButton.DoExit;
begin
  inherited DoExit;
  CheckGroup.FFocusedItemIndex := CheckGroup.InternalButtons.IndexOf(Self);
end;

procedure TcxCheckGroupButton.Initialize;
begin
  inherited Initialize;
  CheckGroup.InternalButtons.Add(Self);
  Style.LookAndFeel.MasterLookAndFeel := CheckGroup.LookAndFeel;
  Keys := Keys + [kArrows];
  CheckTransparentBorder;
end;

function TcxCheckGroupButton.IsNativeBackground: Boolean;
begin
  Result := CheckGroup.IsNativeBackground;
end;

function TcxCheckGroupButton.IsNativeStyle: Boolean;
begin