API tools faq
paste
Advertisement
jpfassis

TPanelBorderColor - Delphi

jpfassis
Nov 13th, 2022 (edited)
1,799
2
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 13.09 KB | None | 2 0
raw download clone embed print report
  1. //Atualizado em 25/01/2023
  2. unit UPanelBorderColor;
  3.  
  4. interface
  5.  
  6. uses
  7.  
  8.   Windows,
  9.   Messages,
  10.   SysUtils,
  11.   Classes,
  12.   VCL.Graphics,
  13.   VCL.ExtCtrls,
  14.   VCL.Controls,
  15.   Vcl.Forms,
  16.   Vcl.Dialogs,
  17.   Vcl.Direct2D,
  18.   D2D1;
  19.  
  20. type
  21.  
  22.   TDestAlign = (alNone, alTop, alBottom, alLeft, alRight, alLeftRight, alTopBottom);
  23.  
  24.   TPanelBorderColor = class(VCL.ExtCtrls.TPanel)
  25.     private
  26.       FD2DCanvas: TDirect2DCanvas;
  27.       FRadiusX : Integer;
  28.       FRadiusY : Integer;
  29.       FColor : TColor;
  30.       FBorderColor : TColor;
  31.       FBorderVisible : Boolean;
  32.       FColorBackGround  : TColor;
  33.       FDestWidth : Integer;
  34.       FDestVisible : Boolean;
  35.       FPenWidth : Integer;
  36.       FExStyle : DWORD;
  37.       FDestAlign : TDestAlign;
  38.       procedure PaintBorder;
  39.       procedure SetBorderColor(const Value: TColor);
  40.       procedure SetPenWidth(const Value: Integer);
  41.       procedure SetRadiusX(const Value: Integer);
  42.       procedure SetRadiusY(const Value: Integer);
  43.       procedure SetColorBackGround(const Value: TColor);
  44.       procedure SetColor(const Value: TColor);
  45.       procedure SetDestWidth(const Value: Integer);
  46.       procedure SetDestVisible(const Value: Boolean);
  47.       procedure SetBorderVisible(const Value: Boolean);
  48.       procedure SetDestAlign(const Value: TDestAlign);
  49.     protected
  50.       procedure CreateParams(var Params : TCreateParams); override;
  51.       procedure CreateWnd; override;
  52.       procedure WMSize(var Message: TWMSize); message WM_SIZE;
  53.       procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  54.       procedure CMMouseEnter(var Msg: TMessage); message CM_MouseEnter;
  55.       procedure CMMouseLeave(var Msg: TMessage); message CM_MouseLeave;
  56.       procedure WM_NCPaint(var Message : TWMNCPaint); message WM_NCPaint;
  57.       procedure Paint; override;
  58.     public
  59.       constructor Create(AOwner: TComponent); override;
  60.       destructor Destroy; override;
  61.     published
  62.       property BorderRadiusX : Integer read FRadiusX write SetRadiusX;
  63.       property BorderRadiusY : Integer read FRadiusY write SetRadiusY;
  64.       property BorderColor : TColor read FBorderColor write SetBorderColor;
  65.       property BorderVisible : Boolean read FBorderVisible write SetBorderVisible;
  66.       property Color : TColor read FColor write SetColor;
  67.       property ColorBackGround : TColor read FColorBackGround write SetColorBackGround;
  68.       property BorderPenWidth : Integer read FPenWidth write SetPenWidth;
  69.       property DestWidth : Integer read FDestWidth write SetDestWidth;
  70.       property DestVisible : Boolean read FDestVisible write SetDestVisible;
  71.       property DestAlign : TDestAlign read FDestAlign write SetDestAlign;
  72.   end;
  73.  
  74. procedure Register;
  75.  
  76. implementation
  77.  
  78. { TPanelBorderColor }
  79.  
  80. procedure TPanelBorderColor.CMMouseEnter(var Msg: TMessage);
  81. begin
  82. //  PaintStruct;
  83. end;
  84.  
  85. procedure TPanelBorderColor.CMMouseLeave(var Msg: TMessage);
  86. begin
  87. // PaintStruct;
  88. end;
  89.  
  90. constructor TPanelBorderColor.Create(AOwner: TComponent);
  91. begin
  92.   inherited Create(AOwner);
  93.   Width := 200;
  94.   Height := 50;
  95.   BevelOuter:=bvNone;
  96.   BorderStyle := bsNone;
  97.   Caption:='';
  98.  
  99.   FColor := clbtnFace;
  100.   FColorBackGround := clSilver;
  101.   FBorderColor := clGray;
  102.   FRadiusX := 10;
  103.   FRadiusY := 10;
  104.   FPenWidth := 2;
  105.   FDestWidth:=70;
  106.   FBorderVisible := True;
  107.   FDestVisible:=True;
  108.   FDestAlign:=alRight;
  109.  
  110.   DoubleBuffered:=False;
  111.   ParentDoubleBuffered:=False;
  112.   FullRepaint:=False;
  113.  
  114.   ControlStyle := ControlStyle - [csOpaque, csSetCaption] + [csAcceptsControls, csPannable];
  115. end;
  116.  
  117. procedure TPanelBorderColor.CreateParams(var Params: TCreateParams);
  118. begin
  119.  
  120.   inherited CreateParams(Params);
  121.  
  122.   with Params do
  123.   begin
  124.     FExStyle := ExStyle or WS_EX_TRANSPARENT;
  125.     ExStyle := FExStyle;
  126.   end;
  127.  
  128. end;
  129.  
  130. procedure TPanelBorderColor.CreateWnd;
  131. begin
  132.   inherited;
  133. end;
  134.  
  135. destructor TPanelBorderColor.Destroy;
  136. begin
  137.   if Assigned(FD2DCanvas) then
  138.     FreeAndNil(FD2DCanvas);
  139.   inherited;
  140. end;
  141.  
  142.  
  143. procedure TPanelBorderColor.Paint;
  144. begin
  145.   inherited;
  146.   PaintBorder;
  147. end;
  148.  
  149. procedure TPanelBorderColor.PaintBorder;
  150. var
  151.   RRect, RRect2: TD2D1RoundedRect;
  152.   Rect : D2D1_Rect_F;
  153. begin
  154.   FD2DCanvas := TDirect2DCanvas.Create(Canvas, ClientRect);
  155. try
  156.  
  157.   D2D1RenderTargetProperties(D2D1_RENDER_TARGET_TYPE_DEFAULT);
  158.   FD2DCanvas.RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_PER_PRIMITIVE);
  159.   FD2DCanvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);
  160.   FD2DCanvas.RenderTarget.BeginDraw;
  161.  
  162.   FD2DCanvas.Brush.Style:=bsSolid;
  163.   FD2DCanvas.Brush.Color:=FColorBackGround;
  164.  
  165.   RRect.Rect.Left:=ClientRect.Left+2;
  166.   RRect.Rect.Top:=ClientRect.Top+2;
  167.   RRect.Rect.Right:=ClientRect.Right-2;
  168.   RRect.Rect.Bottom:=ClientRect.Bottom-2;
  169.   RRect.RadiusX:=FRadiusX;
  170.   RRect.RadiusY:=FRadiusY;
  171.  
  172.   FD2DCanvas.FillRoundedRectangle(RRect);
  173.  
  174.   if (FDestVisible=True) then
  175.   begin
  176.  
  177.     if FDestAlign=alRight then
  178.     begin
  179.  
  180.       FD2DCanvas.Brush.Style:=bsSolid;
  181.       FD2DCanvas.Brush.Color:=FBorderColor;
  182.  
  183.       RRect2.Rect.Left:=ClientRect.Right-FDestWidth;
  184.       RRect2.Rect.Top:=ClientRect.Top+2;
  185.       RRect2.Rect.Right:=ClientRect.Right-2;
  186.       RRect2.Rect.Bottom:=ClientRect.Bottom-2;
  187.       RRect2.RadiusX:=FRadiusX;
  188.       RRect2.RadiusY:=FRadiusY;
  189.  
  190.       FD2DCanvas.FillRoundedRectangle(RRect2);
  191.  
  192.       FD2DCanvas.Brush.Style:=bsSolid;
  193.       FD2DCanvas.Brush.Color:=FColorBackGround;
  194.  
  195.       Rect.Left:=(ClientRect.Right-(FDestWidth+2));
  196.       Rect.Top:=ClientRect.Top+2;
  197.       Rect.Right:=ClientRect.Right-(FDestWidth-8);
  198.       Rect.Bottom:=ClientRect.Bottom-2;
  199.  
  200.       FD2DCanvas.FillRectangle(Rect);
  201.     end;
  202.  
  203.  
  204.     if FDestAlign=alLeft then
  205.     begin
  206.       FD2DCanvas.Brush.Style:=bsSolid;
  207.       FD2DCanvas.Brush.Color:=FBorderColor;
  208.  
  209.       RRect2.Rect.Left:=ClientRect.Left;
  210.       RRect2.Rect.Top:=ClientRect.Top+2;
  211.       RRect2.Rect.Right:=ClientRect.Left+(FDestWidth+2);
  212.       RRect2.Rect.Bottom:=ClientRect.Bottom-2;
  213.       RRect2.RadiusX:=FRadiusX;
  214.       RRect2.RadiusY:=FRadiusY;
  215.  
  216.       FD2DCanvas.FillRoundedRectangle(RRect2);
  217.  
  218.       FD2DCanvas.Brush.Style:=bsSolid;
  219.       FD2DCanvas.Brush.Color:=FColorBackGround;
  220.  
  221.       Rect.Left:=(ClientRect.Left+(FDestWidth+2));
  222.       Rect.Top:=ClientRect.Top+2;
  223.       Rect.Right:=ClientRect.Left+(FDestWidth-8);
  224.       Rect.Bottom:=ClientRect.Bottom-2;
  225.  
  226.       FD2DCanvas.FillRectangle(Rect);
  227.     end;
  228.  
  229.  
  230.     if FDestAlign=alLeftRight then
  231.     begin
  232.       FD2DCanvas.Brush.Style:=bsSolid;
  233.       FD2DCanvas.Brush.Color:=FBorderColor;
  234.  
  235.       RRect2.Rect.Left:=ClientRect.Right-FDestWidth;
  236.       RRect2.Rect.Top:=ClientRect.Top+2;
  237.       RRect2.Rect.Right:=ClientRect.Right-2;
  238.       RRect2.Rect.Bottom:=ClientRect.Bottom-2;
  239.       RRect2.RadiusX:=FRadiusX;
  240.       RRect2.RadiusY:=FRadiusY;
  241.  
  242.       FD2DCanvas.FillRoundedRectangle(RRect2);
  243.  
  244.       FD2DCanvas.Brush.Style:=bsSolid;
  245.       FD2DCanvas.Brush.Color:=FColorBackGround;
  246.  
  247.       Rect.Left:=(ClientRect.Right-(FDestWidth+2));
  248.       Rect.Top:=ClientRect.Top+2;
  249.       Rect.Right:=ClientRect.Right-(FDestWidth-8);
  250.       Rect.Bottom:=ClientRect.Bottom-2;
  251.  
  252.       FD2DCanvas.FillRectangle(Rect);
  253.  
  254.       //
  255.       FD2DCanvas.Brush.Style:=bsSolid;
  256.       FD2DCanvas.Brush.Color:=FBorderColor;
  257.  
  258.       RRect2.Rect.Left:=ClientRect.Left;
  259.       RRect2.Rect.Top:=ClientRect.Top+2;
  260.       RRect2.Rect.Right:=ClientRect.Left+(FDestWidth+2);
  261.       RRect2.Rect.Bottom:=ClientRect.Bottom-2;
  262.       RRect2.RadiusX:=FRadiusX;
  263.       RRect2.RadiusY:=FRadiusY;
  264.  
  265.       FD2DCanvas.FillRoundedRectangle(RRect2);
  266.  
  267.       FD2DCanvas.Brush.Style:=bsSolid;
  268.       FD2DCanvas.Brush.Color:=FColorBackGround;
  269.  
  270.       Rect.Left:=(ClientRect.Left+(FDestWidth+2));
  271.       Rect.Top:=ClientRect.Top+2;
  272.       Rect.Right:=ClientRect.Left+(FDestWidth-8);
  273.       Rect.Bottom:=ClientRect.Bottom-2;
  274.  
  275.       FD2DCanvas.FillRectangle(Rect);
  276.  
  277.  
  278.     end;
  279.  
  280.  
  281.     if FDestAlign=alTop then
  282.     begin
  283.       FD2DCanvas.Brush.Style:=bsSolid;
  284.       FD2DCanvas.Brush.Color:=FBorderColor;
  285.  
  286.       RRect2.Rect.Left:=ClientRect.Left+2;
  287.       RRect2.Rect.Top:=ClientRect.Top+2;
  288.       RRect2.Rect.Right:=ClientRect.Right-2;
  289.       RRect2.Rect.Bottom:=ClientRect.Top+2+(FDestWidth+2);
  290.       RRect2.RadiusX:=FRadiusX;
  291.       RRect2.RadiusY:=FRadiusY;
  292.  
  293.       FD2DCanvas.FillRoundedRectangle(RRect2);
  294.  
  295.       FD2DCanvas.Brush.Style:=bsSolid;
  296.       FD2DCanvas.Brush.Color:=FColorBackGround;
  297.  
  298.       Rect.Left:=ClientRect.Left+2;
  299.       Rect.Top:=ClientRect.Top+(FDestWidth-2);
  300.       Rect.Right:=ClientRect.Right-2;
  301.       Rect.Bottom:=ClientRect.Top+(FDestWidth+8);
  302.  
  303.       FD2DCanvas.FillRectangle(Rect);
  304.     end;
  305.  
  306.  
  307.     if FDestAlign=alBottom then
  308.     begin
  309.       FD2DCanvas.Brush.Style:=bsSolid;
  310.       FD2DCanvas.Brush.Color:=FBorderColor;
  311.  
  312.       RRect2.Rect.Left:=ClientRect.Left+2;
  313.       RRect2.Rect.Top:=ClientRect.Bottom-2;
  314.       RRect2.Rect.Right:=ClientRect.Right-2;
  315.       RRect2.Rect.Bottom:=ClientRect.Bottom-2-(FDestWidth+2);
  316.       RRect2.RadiusX:=FRadiusX;
  317.       RRect2.RadiusY:=FRadiusY;
  318.  
  319.       FD2DCanvas.FillRoundedRectangle(RRect2);
  320.  
  321.       FD2DCanvas.Brush.Style:=bsSolid;
  322.       FD2DCanvas.Brush.Color:=FColorBackGround;
  323.  
  324.       Rect.Left:=ClientRect.Left+2;
  325.       Rect.Top:=ClientRect.Bottom-(FDestWidth-2);
  326.       Rect.Right:=ClientRect.Right-2;
  327.       Rect.Bottom:=ClientRect.Bottom-(FDestWidth+8);
  328.  
  329.       FD2DCanvas.FillRectangle(Rect);
  330.     end;
  331.  
  332.     if FDestAlign=alTopBottom then
  333.     begin
  334.       FD2DCanvas.Brush.Style:=bsSolid;
  335.       FD2DCanvas.Brush.Color:=FBorderColor;
  336.  
  337.       RRect2.Rect.Left:=ClientRect.Left+2;
  338.       RRect2.Rect.Top:=ClientRect.Top+2;
  339.       RRect2.Rect.Right:=ClientRect.Right-2;
  340.       RRect2.Rect.Bottom:=ClientRect.Top+2+(FDestWidth+2);
  341.       RRect2.RadiusX:=FRadiusX;
  342.       RRect2.RadiusY:=FRadiusY;
  343.  
  344.       FD2DCanvas.FillRoundedRectangle(RRect2);
  345.  
  346.       FD2DCanvas.Brush.Style:=bsSolid;
  347.       FD2DCanvas.Brush.Color:=FColorBackGround;
  348.  
  349.       Rect.Left:=ClientRect.Left+2;
  350.       Rect.Top:=ClientRect.Top+(FDestWidth-2);
  351.       Rect.Right:=ClientRect.Right-2;
  352.       Rect.Bottom:=ClientRect.Top+(FDestWidth+8);
  353.  
  354.       FD2DCanvas.FillRectangle(Rect);
  355.       //
  356.       FD2DCanvas.Brush.Style:=bsSolid;
  357.       FD2DCanvas.Brush.Color:=FBorderColor;
  358.  
  359.       RRect2.Rect.Left:=ClientRect.Left+2;
  360.       RRect2.Rect.Top:=ClientRect.Bottom-2;
  361.       RRect2.Rect.Right:=ClientRect.Right-2;
  362.       RRect2.Rect.Bottom:=ClientRect.Bottom-2-(FDestWidth+2);
  363.       RRect2.RadiusX:=FRadiusX;
  364.       RRect2.RadiusY:=FRadiusY;
  365.  
  366.       FD2DCanvas.FillRoundedRectangle(RRect2);
  367.  
  368.       FD2DCanvas.Brush.Style:=bsSolid;
  369.       FD2DCanvas.Brush.Color:=FColorBackGround;
  370.  
  371.       Rect.Left:=ClientRect.Left+2;
  372.       Rect.Top:=ClientRect.Bottom-(FDestWidth-2);
  373.       Rect.Right:=ClientRect.Right-2;
  374.       Rect.Bottom:=ClientRect.Bottom-(FDestWidth+8);
  375.  
  376.       FD2DCanvas.FillRectangle(Rect);
  377.     end;
  378.  
  379.   end;
  380.  
  381.  
  382.   if (FBorderVisible=True) then
  383.   begin
  384.  
  385.     FD2DCanvas.Brush.Style:=bsSolid;
  386.     FD2DCanvas.Pen.Width:=FPenWidth;
  387.     FD2DCanvas.Pen.Color:= FBorderColor;
  388.  
  389.     RRect.Rect.Left:=ClientRect.Left+2;
  390.     RRect.Rect.Top:=ClientRect.Top+2;
  391.     RRect.Rect.Right:=ClientRect.Right-2;
  392.     RRect.Rect.Bottom:=ClientRect.Bottom-2;
  393.     RRect.RadiusX:=FRadiusX;
  394.     RRect.RadiusY:=FRadiusY;
  395.  
  396.     FD2DCanvas.DrawRoundedRectangle(RRect);
  397.  
  398.   end;
  399.  
  400. finally
  401.   FD2DCanvas.RenderTarget.EndDraw;
  402.   FreeAndNil(FD2DCanvas);
  403. end;
  404.  
  405. end;
  406.  
  407. procedure TPanelBorderColor.SetBorderColor(const Value: TColor);
  408. begin
  409.   FBorderColor := Value;
  410.   PaintBorder;
  411. end;
  412.  
  413. procedure TPanelBorderColor.SetBorderVisible(const Value: Boolean);
  414. begin
  415.   FBorderVisible := Value;
  416.   PaintBorder;
  417. end;
  418.  
  419. procedure TPanelBorderColor.SetColor(const Value: TColor);
  420. begin
  421.   FColor := Value;
  422.   PaintBorder;
  423. end;
  424.  
  425. procedure TPanelBorderColor.SetColorBackGround(const Value: TColor);
  426. begin
  427.   FColorBackGround := Value;
  428.   PaintBorder;
  429. End;
  430.  
  431. procedure TPanelBorderColor.SetDestAlign(const Value: TDestAlign);
  432. begin
  433.   FDestAlign := Value;
  434.   PaintBorder;
  435. end;
  436.  
  437. procedure TPanelBorderColor.SetDestVisible(const Value: Boolean);
  438. begin
  439.   FDestVisible := Value;
  440.   PaintBorder;
  441. end;
  442.  
  443. procedure TPanelBorderColor.SetDestWidth(const Value: Integer);
  444. begin
  445.   FDestWidth := Value;
  446.   PaintBorder;
  447. end;
  448.  
  449. procedure TPanelBorderColor.SetPenWidth(const Value: Integer);
  450. begin
  451.   FPenWidth := Value;
  452.   PaintBorder;
  453. end;
  454.  
  455. procedure TPanelBorderColor.SetRadiusX(const Value: Integer);
  456. begin
  457.   FRadiusX := Value;
  458.   PaintBorder;
  459. end;
  460.  
  461.  
  462. procedure TPanelBorderColor.SetRadiusY(const Value: Integer);
  463. begin
  464.   FRadiusY := Value;
  465.   PaintBorder;
  466. end;
  467.  
  468. procedure TPanelBorderColor.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  469. begin
  470.   Message.Result := 1;
  471. End;
  472.  
  473. procedure TPanelBorderColor.WMSize(var Message: TWMSize);
  474. var
  475.   S: TD2DSizeU;
  476. begin
  477.   if Assigned(FD2DCanvas) then
  478.   begin
  479.     S := D2D1SizeU(ClientWidth, ClientHeight);
  480.     ID2D1HwndRenderTarget(FD2DCanvas.RenderTarget).Resize(S);
  481.   end;
  482.   Realign;
  483.   PaintBorder;
  484.   Invalidate;
  485. end;
  486.  
  487. procedure TPanelBorderColor.WM_NCPaint(var Message: TWMNCPaint);
  488. begin
  489.  PaintBorder;
  490.  Invalidate;
  491. end;
  492.  
  493. procedure Register;
  494. begin
  495.   RegisterComponents('Standard', [TPanelBorderColor]);
  496. end;
  497.  
  498. initialization
  499.   RegisterClass(TPanelBorderColor);
  500.  
  501. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!