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

📄 jvbuttons.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    FLayout := Value;
    Changed;
  end;
end;

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

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

procedure TJvaCaptionButton.SetWidth(const Value: Integer);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    Changed;
  end;
end;

procedure TJvaCaptionButton.Update;
begin
  Draw;
end;

procedure TJvaCaptionButton.SetDown(const Value: Boolean);
begin
  if FPress <> Value then
  begin
    FPress := Value;
    Changed;
  end;
end;

procedure TJvaCaptionButton.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed;
  end;
end;

procedure TJvaCaptionButton.DoAfterMsg(Sender: TObject; var Msg: TMessage;
  var Handled: Boolean);
begin
  if Owner = nil then
    Exit;
  case Msg.Msg of
    WM_NCACTIVATE:
      begin
        FActive := Boolean(Msg.wParam);
        Draw;
      end;
    WM_SETTEXT, WM_NCPAINT:
      Draw;
    WM_SIZE:
      Resize;
    WM_SETTINGCHANGE:
      Changed;
  end;
end;

procedure TJvaCaptionButton.DoBeforeMsg(Sender: TObject; var Msg: TMessage;
  var Handled: Boolean);
var
  P: TPoint;
  OldPress: Boolean;
begin
  if Owner = nil then
    Exit;
  case Msg.Msg of
    WM_NCLBUTTONDOWN:
      if FVisible and
        MouseOnButton(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor) then
      begin
        SetCapture((Owner as TForm).Handle);
        FMouseLButtonDown := True;
        FPress := True;
        Handled := True;
        Draw;
      end;
    WM_NCLBUTTONDBLCLK:
      if FVisible and
        MouseOnButton(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor) then
      begin
        { FPress := True;
          Draw;
          FPress := False;
          Draw;}
        Handled := True;
      end;
    WM_LBUTTONUP:
      if FVisible and FMouseLButtonDown then
      begin
        ReleaseCapture;
        FMouseLButtonDown := False;
        FPress := False;
        Draw;
        P := (Owner as TForm).ClientToScreen(Point(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor));
        if MouseOnButton(P.X, P.Y) then
          Click;
        Handled := True;
      end;
    WM_MOUSEMOVE:
      if FMouseLButtonDown then
      begin
        P := (Owner as TForm).ClientToScreen(Point(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor));
        OldPress := FPress;
        FPress := MouseOnButton(P.X, P.Y);
        if OldPress <> FPress then
          Draw;
        Handled := True;
      end;
    WM_NCHITTEST:
      if FVisible and
        MouseOnButton(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor) then
      begin
        Msg.Result := HTBORDER;
        Handled := True;
      end;
    WM_NCRBUTTONDOWN:
      { if FVisible and
          MouseOnButton(TWMNCHitMessage(Msg).XCursor, TWMNCHitMessage(Msg).YCursor) then
         WHook.CallOldProc(Msg)
       else}
      ;
  end;
end;

{$ENDIF VCL}

//=== { TJvaColorButton } ====================================================

constructor TJvaColorButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGlyphDrawer := TJvButtonGlyph.Create;
  {$IFDEF VCL}
  FCanvas := TControlCanvas.Create;
  // (rom) destroy Canvas AFTER inherited Destroy
  FCanvas.Control := Self;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  FCanvas := Canvas;
  {$ENDIF VisualCLX}
end;

destructor TJvaColorButton.Destroy;
begin
  FreeAndNil(FGlyphDrawer);
  inherited Destroy;
  {$IFDEF VCL}
  FreeAndNil(FCanvas);
  {$ENDIF VCL}
end;

{$IFDEF VCL}

function TJvaColorButton.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

procedure TJvaColorButton.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> IsFocused then
    IsFocused := ADefault;
  inherited SetButtonStyle(ADefault);
end;

procedure TJvaColorButton.CNDrawItem(var Msg: TWMDrawItem);
var
  DrawItemStruct: TDrawItemStruct;
  IsDown, IsDefault: Boolean;
  State: TButtonState;
begin
  if csDestroying in ComponentState then
    Exit;
  DrawItemStruct := Msg.DrawItemStruct^;
  FCanvas.Handle := DrawItemStruct.hDC;
  with DrawItemStruct do
  begin
    IsDown := itemState and ODS_SELECTED <> 0;
    IsDefault := itemState and ODS_FOCUS <> 0;

    if not Enabled then
      State := bsDisabled
    else
    if IsDown then
      State := bsDown
    else
      State := bsUp;
  end;

  if Assigned(FOnPaint) then
    FOnPaint(Self, IsDown, IsDefault, State)
  else
    DefaultDrawing(IsDown, IsDefault, State);

  FCanvas.Handle := 0;
end;

{$ENDIF VCL}

{$IFDEF VisualCLX}
procedure TJvaColorButton.Paint;
var
  IsDown, IsDefault: Boolean;
  State: TButtonState;
begin
  if csDestroying in ComponentState then
    Exit;
  IsDown := Down;
  IsDefault := Focused;
  if not Enabled then
    State := bsDisabled
  else
  if IsDown then
    State := bsDown
  else
    State := bsUp;
  if Assigned(FOnPaint) then
    FOnPaint(Self, IsDown, IsDefault, State)
  else
    DefaultDrawing(IsDown, IsDefault, State);
end;
{$ENDIF VisualCLX}

procedure TJvaColorButton.DefaultDrawing(const IsDown, IsDefault: Boolean; const State: TButtonState);
var
  R: TRect;
  Flags: Longint;
begin
  {$IFDEF VCL}
  if (csDestroying in ComponentState) or (FCanvas.Handle = 0) then
    Exit;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  if (csDestroying in ComponentState) or (FCanvas.Handle = nil) then
    Exit;
  {$ENDIF VisualCLX}
  R := ClientRect;
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  if IsDown then
    Flags := Flags or DFCS_PUSHED;
  if State = bsDisabled then
    Flags := Flags or DFCS_INACTIVE;

  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
  begin
    if IsFocused or IsDefault then
      Flags := Flags or DFCS_MONO; // mis-used
    if MouseOver then
      Flags := Flags or DFCS_HOT;
    DrawThemedFrameControl(Self, FCanvas.Handle, R, DFC_BUTTON, Flags);
  end
  else
  {$ENDIF JVCLThemesEnabled}
  begin
    { DrawFrameControl doesn't allow for drawing a button as the
        default button, so it must be done here. }
    if IsFocused or IsDefault then
    begin
      FCanvas.Pen.Color := clWindowFrame;
      FCanvas.Pen.Width := 1;
      FCanvas.Brush.Style := bsClear;
      FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

      { DrawFrameControl must draw within this border }
      InflateRect(R, -1, -1);
    end;

    { DrawFrameControl does not draw a pressed button correctly }
    if IsDown then
    begin
      FCanvas.Pen.Color := clBtnShadow;
      FCanvas.Pen.Width := 1;
      FCanvas.Brush.Color := Color {clBtnFace};
      FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
      InflateRect(R, -1, -1);
    end
    else
    begin
      DrawFrameControl(FCanvas.Handle, R, DFC_BUTTON, Flags);
      FCanvas.Pen.Style := psSolid;
      FCanvas.Pen.Color := Color {clBtnShadow};
      FCanvas.Pen.Width := 1;
      FCanvas.Brush.Color := Color;
      FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
    end;
  end;

  if IsFocused then
  begin
    R := ClientRect;
    InflateRect(R, -1, -1);
  end;

  FCanvas.Font := Self.Font;
  if IsDown then
    OffsetRect(R, 1, 1);

  FGlyphDrawer.DrawExternal(Glyph, NumGlyphs, Color, True, FCanvas, R, Point(0, 0), Caption, Layout, Margin,
    Spacing, State, False {True});

  {$IFDEF JVCLThemesEnabled}
  if not ThemeServices.ThemesEnabled then
  {$ENDIF JVCLThemesEnabled}
    if IsFocused and IsDefault then
    begin
      R := ClientRect;
      InflateRect(R, -4, -4);
      FCanvas.Pen.Color := clWindowFrame;
      FCanvas.Brush.Color := Color;  {clBtnFace}
      DrawFocusRect(FCanvas.Handle, R);
    end;
end;

//=== { TJvNoFrameButton } ===================================================

constructor TJvNoFrameButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGlyphDrawer := TJvButtonGlyph.Create;
  FNoBorder := True;
end;

destructor TJvNoFrameButton.Destroy;
begin
  FGlyphDrawer.Free;
  FGlyphDrawer := nil;
  inherited Destroy;
end;

procedure TJvNoFrameButton.Paint;
begin
  if not Enabled then
  begin
    FState := bsDisabled;
    // FDragging := False;
  end
  else
  if FState = bsDisabled then
    if Down and (GroupIndex <> 0) then
      FState := bsExclusive
    else
      FState := bsUp;
  if Assigned(FOnPaint) then
    FOnPaint(Self, Down, False, FState)
  else
    DefaultDrawing(Down, FState);
end;

procedure TJvNoFrameButton.DefaultDrawing(const IsDown: Boolean; const State: TButtonState);
const
  DownStyles: array [Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  FillStyles: array [Boolean] of Integer = (BF_MIDDLE, 0);
var
  PaintRect: TRect;
  Offset: TPoint;
begin
  if Flat and not NoBorder then
    inherited Paint
  else
  begin
    Canvas.Font := Self.Font;
    PaintRect := Rect(0, 0, Width, Height);
    if not NoBorder then
    begin
      DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
        FillStyles[Transparent] or BF_RECT);
      InflateRect(PaintRect, -1, -1);
    end;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := Color;
    Canvas.FillRect(PaintRect);
    if NoBorder and (csDesigning in ComponentState) then
      DrawDesignFrame(Canvas, PaintRect);
    InflateRect(PaintRect, -1, -1);

    if FState in [bsDown, bsExclusive] then
    begin
      if (FState = bsExclusive) then
      begin
        if Pattern = nil then
          CreateBrushPattern(clBtnFace, clBtnHighlight);
        Canvas.Brush.Bitmap := Pattern;
        Canvas.FillRect(PaintRect);
      end;
      Offset.X := 1;
      Offset.Y := 1;
    end
    else
    begin
      Offset.X := 0;
      Offset.Y := 0;
    end;
    {O}
    {$IFDEF VCL}
    FGlyphDrawer.BiDiMode := BiDiMode;
    {$ENDIF VCL}
    FGlyphDrawer.DrawExternal(Glyph, NumGlyphs, Color, True, Canvas, PaintRect, Offset, Caption, Layout, Margin,
      Spacing, FState, False {True});
  end;
end;

procedure TJvNoFrameButton.SetNoBorder(Value: Boolean);
begin
  if FNoBorder <> Value then
  begin
    FNoBorder := Value;
    Refresh;
  end;
end;

//=== { TJvHTButton } ========================================================

constructor TJvHTButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGlyphDrawer.Free;
  FGlyphDrawer := TJvHTButtonGlyph.Create;
end;

destructor TJvHTButton.Destroy;
begin
  TJvHTButtonGlyph(FGlyphDrawer).Free;
  FGlyphDrawer := nil;
  inherited Destroy;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

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