cxbuttons.pas

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

  function GetStandardButtonState(AState: TcxButtonState): TButtonState;
  const
    States: array[TcxButtonState] of TButtonState =
    //cxbsDefault, cxbsNormal, cxbsHot, cxbsPressed, cxbsDisabled;
      (bsUp, bsUp, bsUp, bsDown, bsDisabled);
  begin
    Result := States[AState];
    if (Result = bsDown) and (NumGlyphs < 3) then
      Result := bsUp;
  end;

  function GetGlyphList(AWidth, AHeight: Integer): TcxGlyphList;
  begin
    if FGlyphList = nil then
    begin
      if GlyphCache = nil then
        GlyphCache := TcxGlyphCache.Create;
      FGlyphList := GlyphCache.GetList(AWidth, AHeight);
    end;
    Result := FGlyphList;
  end;

  procedure InternalMakeImagesFromGlyph(AStandardButtonState: TButtonState; AImage, AMask: TBitmap; const AImageBounds: TRect);
  var
    ASrcPoint: TPoint;
    AOffset: Integer;
  begin
    AOffset := Ord(AStandardButtonState);
    if AOffset >= NumGlyphs then
      AOffset := 0;

    if (AStandardButtonState = bsDisabled) and (NumGlyphs = 1) then
      cxDrawImage(AImage.Canvas.Handle, AImageBounds, AImageBounds, Glyph, nil, -1, idmDisabled, False, 0, TransparentColor, False)
    else
    begin
      ASrcPoint := cxRectOffset(AImageBounds, AOffset * cxRectWidth(AImageBounds), 0).TopLeft;
      cxDrawBitmap(AImage.Canvas.Handle, Glyph, AImageBounds, ASrcPoint);
    end;
    if (NumGlyphs <> 1) or (AStandardButtonState <> bsDisabled) then
      AImage.TransparentColor := Glyph.TransparentColor;
    cxMakeMaskBitmap(AImage, AMask);
    Glyph.Dormant;
  end;

  procedure InternalMakeImagesFromImageList(AStandardButtonState: TButtonState; AImage, AMask: TBitmap; const AImageBounds: TRect);
  begin
    if AStandardButtonState = bsDisabled then
    begin
      cxDrawImage(AImage.Canvas.Handle, AImageBounds, AImageBounds, nil, ImageList, ImageIndex, idmDisabled);
      cxMakeMaskBitmap(AImage, AMask);
    end
    else
      TcxImageList.GetImageInfo(ImageList.Handle, ImageIndex, AImage, AMask);
  end;

  function InternalCreateButtonGlyph(AStandardButtonState: TButtonState; const AImageSize: TSize): Integer;
  var
    AImage, AMask: TBitmap;
    AImageBounds: TRect;
  begin
    AImage := TcxBitmap.CreateSize(AImageSize.cx, AImageSize.cy);
    AMask := cxCreateBitmap(AImageSize, pf1bit);
    try
      AImageBounds := cxRect(0, 0, AImageSize.cx, AImageSize.cy);
      if IsGlyphAssigned(Glyph) then
        InternalMakeImagesFromGlyph(AStandardButtonState, AImage, AMask, AImageBounds)
      else
        InternalMakeImagesFromImageList(AStandardButtonState, AImage, AMask, AImageBounds);
      FIndexs[AStandardButtonState] := GetGlyphList(AImageSize.cx, AImageSize.cy).Add(AImage, AMask);
      Result := FIndexs[AStandardButtonState];
    finally
      AMask.Free;
      AImage.Free;
    end;
  end;

  function GetGlyphIndex(AStandardButtonState: TButtonState): Integer;
  begin
    Result := FIndexs[AStandardButtonState];
    if (Result = -1) and ImageInfo.IsImageAssigned then
      Result := InternalCreateButtonGlyph(AStandardButtonState, GetImageSize)
  end;

begin
  Result := GetGlyphIndex(GetStandardButtonState(AState));
end;

procedure TcxButtonGlyph.DrawButtonGlyph(ACanvas: TCanvas; const AGlyphPos: TPoint;
  AState: TcxButtonState);
begin
  if not ImageInfo.IsImageAssigned then
    Exit;
  FGlyphList.Draw(ACanvas, AGlyphPos.X, AGlyphPos.Y, CreateButtonGlyph(AState));
end;

procedure TcxButtonGlyph.DrawButtonText(ACanvas: TCanvas; const ACaption: TCaption;
  ATextBounds: TRect; AState: TcxButtonState ; ABiDiFlags: LongInt;
  ANativeStyle: Boolean{$IFDEF DELPHI7}; AWordWrap: Boolean{$ENDIF});

  procedure InternalDrawButtonText;
  var
    ADrawTextFlags: Integer;
  begin
    ADrawTextFlags := DT_CENTER or DT_VCENTER or ABiDiFlags;
    if CanWordWrapText{$IFDEF DELPHI7}(AWordWrap){$ENDIF} then
      ADrawTextFlags := ADrawTextFlags or DT_WORDBREAK;
    cxDrawText(ACanvas.Handle, ACaption, ATextBounds, ADrawTextFlags);
  end;

var
  ABrushStyle: TBrushStyle;
  AFontColor: TColor;
begin
  if Length(ACaption) = 0 then Exit;
  ABrushStyle := ACanvas.Brush.Style;
  try
    ACanvas.Brush.Style := bsClear;
    if AState = cxbsDisabled then
    begin
      OffsetRect(ATextBounds, 1, 1);
      AFontColor := ACanvas.Font.Color;
      ACanvas.Font.Color := clBtnHighlight;
      InternalDrawButtonText;
      OffsetRect(ATextBounds, -1, -1);
      ACanvas.Font.Color := AFontColor;
    end;
    InternalDrawButtonText;
  finally
    ACanvas.Brush.Style := ABrushStyle;
  end;
end;

procedure TcxButtonGlyph.CalcButtonLayout(ACanvas: TCanvas; const AClient: TRect;
  const AOffset: TPoint; const ACaption: TCaption; ALayout: TButtonLayout;
  AMargin, ASpacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
  ABiDiFlags: LongInt{$IFDEF DELPHI7}; AWordWrap: Boolean{$ENDIF});

  procedure CheckLayout;
  begin
    if ABiDiFlags and DT_RIGHT = DT_RIGHT then
    begin
      if ALayout = blGlyphLeft then
        ALayout := blGlyphRight
      else
        if ALayout = blGlyphRight then
          ALayout := blGlyphLeft;
    end;
  end;

  function GetCaptionSize: TPoint;
  var
    ADrawTextFlags: Integer;
    ATextOffsets: TRect;
  begin
    if Length(ACaption) = 0 then
    begin
      TextBounds := cxNullRect;
      Result := cxNullPoint;
    end
    else
    begin
      TextBounds := Rect(0, 0, AClient.Right - AClient.Left, 0);
      ATextOffsets := GetTextOffsets(ALayout);
      ExtendRect(TextBounds, ATextOffsets);
      ADrawTextFlags := DT_CALCRECT or ABiDiFlags;
      if CanWordWrapText{$IFDEF DELPHI7}(AWordWrap){$ENDIF} then
        ADrawTextFlags := ADrawTextFlags or DT_WORDBREAK;
      cxDrawText(ACanvas.Handle, ACaption, TextBounds, ADrawTextFlags);
      with TextBounds do
        Result := Point(Right - Left, Bottom - Top);
      Inc(Result.X, ATextOffsets.Left + ATextOffsets.Right);
      Inc(Result.Y, ATextOffsets.Top + ATextOffsets.Bottom);
    end;
  end;

var
  ATextPos: TPoint;
  AGlyphSize: TSize;
  AClientSize, ATextSize: TPoint;
  ATotalSize: TPoint;
begin
  CheckLayout;
  ATextSize := GetCaptionSize;
  with AClient do
    AClientSize := Point(Right - Left, Bottom - Top);

(*  if FOriginal.Empty then
  begin
    GlyphPos := EmptyPoint;
    ATextPos.X := (AClientSize.X - ATextSize.X) div 2;
    ATextPos.Y := (AClientSize.Y - ATextSize.Y - 1) div 2;
    OffsetRect(TextBounds, ATextPos.X + AOffset.X, ATextPos.Y + AOffset.Y);
    Exit;
  end;*)

  AGlyphSize := GetImageSize;
  if ALayout in [blGlyphLeft, blGlyphRight] then
  begin
    GlyphPos.Y := (AClientSize.Y - AGlyphSize.cy) div 2;
    ATextPos.Y := (AClientSize.Y - ATextSize.Y +
      cxBtnStdVertTextOffsetCorrection) div 2;
  end
  else
  begin
    GlyphPos.X := (AClientSize.X - AGlyphSize.cx) div 2;
    ATextPos.X := (AClientSize.X - ATextSize.X) div 2;
  end;

  if (ATextSize.X = 0) or (AGlyphSize.cx = 0) then ASpacing := 0;

  if AMargin = -1 then
  begin
    if ASpacing = -1 then
    begin
      ATotalSize := Point(AGlyphSize.cx + ATextSize.X, AGlyphSize.cy + ATextSize.Y);
      if ALayout in [blGlyphLeft, blGlyphRight] then
        AMargin := (AClientSize.X - ATotalSize.X) div 3
      else
        AMargin := (AClientSize.Y - ATotalSize.Y) div 3;
      ASpacing := AMargin;
    end
    else
    begin
      ATotalSize := Point(AGlyphSize.cx + ASpacing + ATextSize.X, AGlyphSize.cy +
        ASpacing + ATextSize.Y);
      if ALayout in [blGlyphLeft, blGlyphRight] then
        AMargin := (AClientSize.X - ATotalSize.X) div 2
      else
        AMargin := (AClientSize.Y - ATotalSize.Y) div 2;
    end;
  end
  else
  begin
    if ASpacing = -1 then
    begin
      ATotalSize := Point(AClientSize.X - (AMargin + AGlyphSize.cx),
        AClientSize.Y - (AMargin + AGlyphSize.cy));
      if ALayout in [blGlyphLeft, blGlyphRight] then
        ASpacing := (ATotalSize.X - ATextSize.X) div 2
      else
        ASpacing := (ATotalSize.Y - ATextSize.Y) div 2;
    end;
  end;
  case ALayout of
    blGlyphLeft:
      begin
        GlyphPos.X := AMargin;
        ATextPos.X := GlyphPos.X + AGlyphSize.cx + ASpacing;
      end;
    blGlyphRight:
      begin
        GlyphPos.X := AClientSize.X - AMargin - AGlyphSize.cx;
        ATextPos.X := GlyphPos.X - ASpacing - ATextSize.X;
      end;
    blGlyphTop:
      begin
        GlyphPos.Y := AMargin;
        ATextPos.Y := GlyphPos.Y + AGlyphSize.cy + ASpacing;
      end;
    blGlyphBottom:
      begin
        GlyphPos.Y := AClientSize.Y - AMargin - AGlyphSize.cy;
        ATextPos.Y := GlyphPos.Y - ASpacing - ATextSize.Y;
      end;
  end;
  with GlyphPos do
  begin
    Inc(X, AClient.Left + AOffset.X);
    Inc(Y, AClient.Top + AOffset.Y);
  end;
  OffsetRect(TextBounds, AClient.Left + ATextPos.X + AOffset.X, AClient.Top + ATextPos.Y + AOffset.X);
end;

procedure TcxButtonGlyph.Draw(ACanvas: TCanvas; const AClient: TRect;
  const AOffset: TPoint; const ACaption: TCaption; ALayout: TButtonLayout;
  AMargin, ASpacing: Integer; AState: TcxButtonState;
  ABiDiFlags: LongInt; ANativeStyle: Boolean{$IFDEF DELPHI7}; AWordWrap: Boolean{$ENDIF});
var
  AGlyphPos: TPoint;
  ATextRect: TRect;
begin
  CalcButtonLayout(ACanvas, AClient, AOffset, ACaption, ALayout, AMargin,
    ASpacing, AGlyphPos, ATextRect, ABiDiFlags{$IFDEF DELPHI7}, AWordWrap{$ENDIF});
  DrawButtonGlyph(ACanvas, AGlyphPos, AState);
  DrawButtonText(ACanvas, ACaption, ATextRect, AState, ABiDiFlags,
    ANativeStyle{$IFDEF DELPHI7}, AWordWrap{$ENDIF});
end;

function TcxButtonGlyph.CanWordWrapText{$IFDEF DELPHI7}(AWordWrap: Boolean){$ENDIF}: Boolean;
begin
{$IFDEF DELPHI7}
  Result := AWordWrap and not ImageInfo.IsImageAssigned;
{$ELSE}
  Result := False;
{$ENDIF}
end;

function TcxButtonGlyph.GetTextOffsets(ALayout: TButtonLayout): TRect;
begin
  if ImageInfo.IsImageAssigned then
    Result := cxNullRect
  else
    Result := TextRectCorrection;
end;

{ TcxButtonActionLink }

destructor TcxButtonActionLink.Destroy;
begin
  if not (csDestroying in Client.ComponentState) then
  begin
    Client.FGlyph.ImageList := nil;
    Client.FGlyph.ImageIndex := -1;
  end;
  inherited;
end;

procedure TcxButtonActionLink.SetImageIndex(Value: Integer);
begin
  inherited;
  Client.FGlyph.ImageIndex := Value;
end;

function TcxButtonActionLink.GetClient: TcxCustomButton;
begin
  Result := TcxButton(FClient);
end;

{ TcxCustomButton }

constructor TcxCustomButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGlyph := GetGlyphClass.Create;
  FGlyph.OnChange := GlyphChanged;
  FColors := TcxButtonColors.Create(Self);
  FControlCanvas := TControlCanvas.Create;
  FControlCanvas.Control := Self;
  FCanvas := TcxCanvas.Create(TCanvas(FControlCanvas));
  FLookAndFeel := TcxLookAndFeel.Create(Self);
  FLookAndFeel.OnChanged := LookAndFeelChanged;
  FDoPopup := True;
  FKind := cxbkStandard;
  FLayout := blGlyphLeft;
  FPopupAlignment := paLeft;
  FSpacing := 4;
  FMargin := -1;
  DoubleBuffered := True;
  ControlStyle := ControlStyle + [csReflector, csOpaque];
  CanBeFocused := True;
  GroupIndex := 0;
  AllowAllUp := False;
  Down := False;
end;

destructor TcxCustomButton.Destroy;
begin
  EndMouseTracking(Self);
  FreeAndNil(FLookAndFeel);
  FreeAndNil(FColors);
  FreeAndNil(FGlyph);
  FreeAndNil(FCanvas);
  FreeAndNil(FControlCanvas);
  inherited Destroy;
end;

procedure TcxCustomButton.InitializeCanvasColors(out AState: TcxButtonState; out AColor: TColor);
begin
  AState := GetButtonState;
  FCanvas.Font.Assign(Font);
  AColor := FColors.GetColorByState(AState);

  if FColors.GetTextColorByState(AState) = clDefault then
    FCanvas.Font.Color := GetPainterClass.ButtonSymbolColor(AState, FCanvas.Font.Color)
  else
    FCanvas.Font.Color := FColors.GetTextColorByState(AState);
end;

procedure TcxCustomButton.SetGlyph(Value: TBitmap);
begin
  FGlyph.Glyph := Value;
end;

function TcxCustomButton.GetGlyph: TBitmap;
begin
  Result := FGlyph.Glyph;
end;

procedure TcxCustomButton.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TcxCustomButton.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

function TcxCustomButton.GetNumGlyphs: TNumGlyphs;
begin
  Result := FGlyph.NumGlyphs;
end;

procedure TcxCustomButton.SetNumGlyphs(Value: TNumGlyphs);
begin
  FGlyph.NumGlyphs := Value;
end;

procedure TcxCustomButton.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TcxCustomButton.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= - 1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;