Advertisement
filhotecmail

Edit do Gleidson

Jul 21st, 2018
379
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 2.84 KB | None | 0 0
  1. unit EditGlaidson;
  2.  
  3. interface
  4.  
  5. uses
  6.   System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, Vcl.Graphics,
  7.   System.Types, Winapi.Windows, Winapi.Messages;
  8.  
  9. type
  10.   TEditGlaidson = class(TEdit)
  11.   private
  12.     { Private declarations }
  13.     FIndent : integer;
  14.     FCanvas : TCanvas;
  15.     FRadiusValue: Smallint;
  16.     procedure SetIndent(const Value:integer);
  17.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  18.   protected
  19.     { Protected declarations }
  20.     procedure Paint; virtual;
  21.     procedure WndProc(var Message: TMessage); override;
  22.     procedure PaintWindow(DC: HDC); override;
  23.     property Canvas: TCanvas read FCanvas;
  24.     procedure RoundSquare;
  25.   public
  26.     { Public declarations }
  27.     constructor Create(AOwner: TComponent); override;
  28.     destructor Destroy; override;
  29.   published
  30.     { Published declarations }
  31.     property RadiusValue: Smallint read FRadiusValue write FRadiusValue;
  32.     property Indent: Integer read FIndent write SetIndent default 3;
  33.   end;
  34.  
  35. procedure Register;
  36.  
  37. implementation
  38.  
  39. procedure Register;
  40. begin
  41.   RegisterComponents('EditdoGlaidson', [TEditGlaidson]);
  42. end;
  43.  
  44. constructor TEditGlaidson.Create(AOwner: TComponent);
  45. begin
  46.   inherited Create(AOwner);
  47.   FCanvas := TControlCanvas.Create;
  48.   TControlCanvas(FCanvas).Control := Self;
  49.   FIndent:=3;
  50. end;
  51.  
  52. destructor TEditGlaidson.Destroy;
  53. begin
  54.   FCanvas.Free;
  55.   inherited Destroy;
  56. end;
  57.  
  58. procedure TEditGlaidson.Paint;
  59. var
  60.   IRec: TRect;
  61.  
  62. begin
  63.   inherited;
  64.   RoundSquare;
  65.   IRec := ClientRect;
  66.   IRec.Left := IRec.Left + FIndent;
  67.   IRec.Top  := IRec.Top + 2;
  68.  
  69.   FCanvas.FillRect(ClientRect);
  70.   FCanvas.Brush.Assign(Self.Brush);
  71.   FCanvas.Font.Assign(Self.Font);
  72.  
  73.   DrawText(FCanvas.Handle, Self.Text, Length(Self.Text), IRec, DT_LEFT);
  74.  
  75. end;
  76.  
  77. procedure TEditGlaidson.SetIndent(const Value: Integer);
  78. begin
  79.   if FIndent <> Value then
  80.    begin
  81.      FIndent := Value;
  82.      Invalidate;
  83.    end;
  84. end;
  85.  
  86. procedure TEditGlaidson.PaintWindow(DC: HDC);
  87. begin
  88.   inherited;
  89.   FCanvas.Lock;
  90.   try
  91.    FCanvas.Handle := DC;
  92.    try
  93.      TControlCanvas(FCanvas).UpdateTextFlags;
  94.      Paint;
  95.    finally
  96.      FCanvas.Handle := 0;
  97.    end;
  98.   finally
  99.    FCanvas.Unlock;
  100.   end;
  101. end;
  102.  
  103. procedure TEditGlaidson.RoundSquare;
  104. var
  105.   R : TRect;
  106.   Rgn : HRGN;
  107. begin
  108.  
  109.     R := ClientRect;
  110.     Rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, FRadiusValue, FRadiusValue);
  111.     Perform(EM_GETRECT, 0, lParam(@R));
  112.     InflateRect(R, -5, -5);
  113.     Perform(EM_SETRECTNP, 0, lParam(@R));
  114.     SetWindowRgn(Handle, Rgn, True);
  115.     Invalidate;
  116.  
  117. end;
  118.  
  119. procedure TEditGlaidson.WMPaint(var Message: TWMPaint);
  120. begin
  121.   ControlState := ControlState+[csCustomPaint];
  122.   inherited;
  123.   ControlState := ControlState-[csCustomPaint];
  124.  end;
  125. procedure TEditGlaidson.WndProc(var Message: TMessage);
  126. begin
  127.   inherited;
  128.  
  129. end;
  130.  
  131. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement