⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dxbutton.pas

📁 功能强大的报表生成和管理工具
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.SetShowAccelChar(Value: Boolean);
begin
  if Value <> FShowAccelChar then
  begin
    FShowAccelChar := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.SetShowFocusRect
  Author:    mh
  Date:      22-Feb-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.SetShowFocusRect(Value: Boolean);
begin
  if Value <> FShowFocusRect then
  begin
    FShowFocusRect := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.SetSpacing
  Author:    mh
  Date:      11-Apr-2002
  Arguments: Value: Integer
  Result:    None
-----------------------------------------------------------------------------}

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

{-----------------------------------------------------------------------------
  Procedure: TdxButton.SetWordWrap
  Author:    mh
  Date:      29-Apr-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.SetWordWrap(Value: Boolean);
begin
  if Value <> FWordWrap then
  begin
    FWordWrap := Value;
    Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.ImageListChange
  Author:    mh
  Date:      09-Apr-2002
  Arguments: Sender: TObject
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.ImageListChange(Sender: TObject);
begin
  if Assigned(Action) and (Sender is TCustomImageList)
    and Assigned(TAction(Action).ActionList.Images)
    and ((TAction(Action).ImageIndex < (TAction(Action).ActionList.Images.Count))) then
    FImageIndex := TAction(Action).ImageIndex
  else
    FImageIndex := -1;
  Invalidate;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.KeyDown
  Author:    mh
  Date:      22-Feb-2002
  Arguments: var Key: Word; Shift: TShiftState
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Shift = []) and (Key = VK_SPACE) then
  begin
    Include(DrawState, dsHotLight);
    HookMouseDown;
  end;
  inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.KeyUp
  Author:    mh
  Date:      22-Feb-2002
  Arguments: var Key: Word; Shift: TShiftState
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.KeyUp(var Key: Word; Shift: TShiftState);
var
  cPos: TPoint;
begin
  //
  // It's not possible to call the 'HookMouseUp' or 'HookMouseLeave' methods,
  // because we don't want to call there event handlers.
  //
  if dsSelected in DrawState then
  begin
    GetCursorPos(cPos);
    cPos := ScreenToClient(cPos);
    if not PtInRect(Bounds(0, 0, Width, Height), cPos) then
      Exclude(DrawState, dsHotLight);
    Exclude(DrawState, dsSelected);
    Invalidate;
    Click;
  end;
  inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.IsSpecialDrawState
  Author:    mh
  Date:      22-Feb-2002
  Arguments: None
  Result:    Boolean
-----------------------------------------------------------------------------}

function TdxButton.IsSpecialDrawState(IgnoreDefault: Boolean = False): Boolean;
begin
  if dsSelected in DrawState then
    Result := not (dsHotLight in DrawState)
  else
    Result := (dsHotLight in DrawState) or (dsFocused in DrawState);
  if not IgnoreDefault then
    Result := Result or FDefault and not IsSibling;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.ActionChange
  Author:    mh
  Date:      09-Apr-2002
  Arguments: Sender: TObject; CheckDefaults: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if Assigned(TCustomAction(Sender).ActionList.Images) and
        (FImageChangeLink.Sender <> TCustomAction(Sender).ActionList.Images) then
        TCustomAction(Sender).ActionList.Images.RegisterChanges(FImageChangeLink);
      if (ActionList <> nil) and (ActionList.Images <> nil) and
        (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
        FImageIndex := ImageIndex;
      Invalidate;
    end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.HookResized
  Author:    mh
  Date:      22-Feb-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.HookResized;
var
  Offset, ColSteps: Integer;
  Dithering: Boolean;
begin
  inherited;

  // calculate quality.
  Dithering := FQuality = bqHigh;
  ColSteps := 16;
  if FQuality = bqLow then
    ColSteps := 8;
  if FQuality = bqHigh then
    ColSteps := 64;

  // calculate offset.
  Offset := 4 * (Integer(IsSpecialDrawState(True)));

  //
  // create gradient rectangles for...
  //

  // background.
  dxCreateGradientRect(Width - (2 + Offset), Height - (2 + Offset),
    FColors.BackgroundFrom,  FColors.BackgroundTo, ColSteps, gsTop, Dithering,
    FBgGradient);

  // clicked.
  dxCreateGradientRect(Width - 2, Height - 2, FColors.ClickedFrom,
    FColors.ClickedTo, ColSteps, gsTop, Dithering, FCkGradient);

  // focused.
  dxCreateGradientRect(Width - 2, Height - 2, FColors.FocusedFrom,
    FColors.FocusedTo, ColSteps, gsTop, Dithering, FFcGradient);

  // highlight.
  dxCreateGradientRect(Width - 2, Height - 2, FColors.HighlightFrom,
    FColors.HighlightTo, ColSteps, gsTop, Dithering, FHlGradient);

  // redraw.
  Invalidate;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxButton.Paint
  Author:    mh
  Date:      21-Feb-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxButton.Paint;
var
  R: TRect;
  c, x, y: Integer;
  PxlColor: TColor;
  Offset, Flags: Integer;
  DrawPressed: Boolean;
  Image: TBitmap;
  Bitmap: TBitmap;
begin
  with Canvas do
  begin
    // clear background.
    R := GetClientRect;
    Brush.Color := Self.Color;
    FillRect(R);

    // draw gradient borders.
    if IsSpecialDrawState then
    begin
      Bitmap := TBitmap.Create;
      try
        if dsHotLight in DrawState then
          Bitmap.Assign(FHlGradient)
        else
          Bitmap.Assign(FFcGradient);
        BitBlt(Handle, 1, 1, Width, Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
      finally
        Bitmap.Free;
      end;
    end;

    // draw background gradient...
    if not ((dsHotLight in DrawState) and (dsSelected in DrawState)) then
    begin
      Offset := 2 * Integer(IsSpecialDrawState);
      BitBlt(Handle, 1 + Offset, 1 + Offset, Width - 3 * Offset, Height - 3 * Offset,
        FBgGradient.Canvas.Handle, 0, 0, SRCCOPY);
    end
    // ...or click gradient.
    else
      BitBlt(Handle, 1, 1, Width, Height, FCkGradient.Canvas.Handle, 0, 0, SRCCOPY);

    // draw border lines.
    Pen.Color := FColors.BorderLine;
    Brush.Style := bsClear;
    RoundRect(0, 0, Width, Height, 5, 5);

    // draw border edges.
    Pen.Color := cColorBorderEdges;
    dxDrawLine(Canvas, 0, 1, 2, 0);
    dxDrawLine(Canvas, Width - 2, 0, Width, 2);
    dxDrawLine(Canvas, 0, Height - 2, 2, Height);
    dxDrawLine(Canvas, Width - 3, Height, Width, Height - 3);

    // set drawing flags.
    Flags := {DT_VCENTER or }DT_END_ELLIPSIS;
    if FWordWrap then
      Flags := Flags or DT_WORDBREAK;

    // draw image & caption.
    Image := TBitmap.Create;
    try
      // get image from action or glyph property.
      if Assigned(Action) and Assigned(TAction(Action).ActionList.Images) and
        (FImageIndex > -1) and (FImageIndex < TAction(Action).ActionList.Images.Count) then
        TAction(Action).ActionList.Images.GetBitmap(FImageIndex, Image)
      else
        Image.Assign(FGlyph);

      // autogray image (if allowed).
      if FAutoGray and not Enabled then
      for x := 0 to Image.Width - 1 do
        for y := 0 to Image.Height - 1 do
        begin
          PxlColor := ColorToRGB(Image.Canvas.Pixels[x, y]);
          c := Round((((PxlColor shr 16) + ((PxlColor shr 8) and $00FF) + (PxlColor and $0000FF)) div 3)) div 2 + 96;
          Image.Canvas.Pixels[x, y] := RGB(c, c, c);
        end;

      // assign canvas font (change HotTrack-Color, if necessary).
      Font.Assign(Self.Font);
      if (FHotTrack) and (dsHotLight in DrawState) then
        Font.Color := FColors.HotTrack;

      // calculate textrect.
      if not Image.Empty then
        case FLayout of
          blGlyphLeft:
            Inc(R.Left, Image.Width + FSpacing);
          blGlyphRight:
            begin
              Dec(R.Left, Image.Width + FSpacing);
              Dec(R.Right, (Image.Width + FSpacing) * 2);
              Flags := Flags or DT_RIGHT;
            end;
          blGlyphTop:
            Inc(R.Top, Image.Height + FSpacing);
          blGlyphBottom:
            Dec(R.Top, Image.Height + FSpacing);
        end;
      dxRenderText(Self, Canvas, Caption, Font, Enabled, FShowAccelChar, R, Flags or DT_CALCRECT);
      OffsetRect(R, (Width - R.Right) div 2, (Height - R.Bottom) div 2);

      // should we draw the pressed state?
      DrawPressed := (dsHotLight in DrawState) and (dsSelected in DrawState);
      if DrawPressed then
        OffsetRect(R, 1, 1);

      // draw image - if available.
      if not Image.Empty then
      begin
        Image.Transparent := True;
        case FLayout of
          blGlyphLeft:
            Draw(R.Left - (Image.Width + FSpacing), (Height - Image.Height) div 2 +
              Integer(DrawPressed), Image);
          blGlyphRight:
            Draw(R.Right + FSpacing, (Height - Image.Height) div 2 +
              Integer(DrawPressed), Image);
          blGlyphTop:
            Draw((Width - Image.Width) div 2 + Integer(DrawPressed),
              R.Top - (Image.Height + FSpacing), Image);
          blGlyphBottom:
            Draw((Width - Image.Width) div 2 + Integer(DrawPressed),
              R.Bottom + FSpacing, Image);
        end;
      end;

      // draw caption.
      dxRenderText(Self, Canvas, Caption, Font, Enabled, FShowAccelChar, R, Flags);

      // draw focusrect (if enabled).
      if (dsFocused in DrawState) and (FShowFocusRect) then
        DrawFocusRect(Bounds(3, 3, Width - 6, Height - 6));
    finally
      Image.Free;
    end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -