Composant TEdit sous Delphi 7

**mamiF** · 18/10/2017, 20h28

Bonsoir
je veux savoir comment travailler avec un edit quand il tient le focus, le contour de edit changeant de couleur.

**ShaiLeTroll** · 19/10/2017, 09h35

C'est toujours ton histoire de création de composant ?
Sinon, ta question est incompréhensible, je dirais que tu veux changer la couleur du Edit quand il a le focus

Rien de plus simple mais cela ne peut pas être ça, ta question, c'est bien trop évident pour quelqu'un qui cherche un peu

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
//------------------------------------------------------------------------------
procedure TxxxForm.edScanEnter(Sender: TObject);
begin
  edScan.Color := clWindow;
end;
 
//------------------------------------------------------------------------------
procedure TxxxForm.edScanExit(Sender: TObject);
begin
  edScan.Color := clWebLightCoral;
end;

**mamiF** · 19/10/2017, 17h10

Merci ShaiLeTroll.

Est-ce qu' il n' y a pas d'autres méthodes ? Je veux tracer ou dessiner un rectangle dans les dimensions du TEdit , dans la même idée que Edit1.Color
mais avec le contour de TEdit.

**Cirec** · 20/10/2017, 15h02

peut être comme ça ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure TForm1.Edit1Enter(Sender: TObject);
var
  aRect: TRect;
begin
  with TBrushRecall.Create(Canvas.Brush) do
  try
    Canvas.Brush.Color := clRed;
    Canvas.Brush.Style := bsSolid;
    aRect := Edit1.BoundsRect;
    InflateRect(aRect, 1, 1);
    FrameRect(Canvas.Handle, aRect, Canvas.Brush.Handle)
  finally
    Free;
  end;
end;
 
procedure TForm1.Edit1Exit(Sender: TObject);
var
  aRect: TRect;
begin
  aRect := Edit1.BoundsRect;
  InflateRect(aRect, 1, 1);
  FrameRect(Canvas.Handle, aRect, Canvas.Brush.Handle)
end;

le TEdit se trouve directement sur le canvas de la fiche

Cordialement,
@+

**ShaiLeTroll** · 20/10/2017, 16h41

TBrushRecall pas sûr que cela existe en D7
Et dès le moindre invalidate, le trait ne disparait-il pas ?

J'ai fait cela pour faire une surbrillance sur des TSpeedButton ou une TListBox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
  TActionShape = class(TShape)
  private
    FColor: TColor;
    procedure SetColor(const Value: TColor);
    function CreateSpecialPen(AColor: TColor): THandle;
  protected
    procedure InitializeColor(APenColor: TColor);
  public
    property Color: TColor read FColor write SetColor;
  end;
 
  TButtonActionShape = class(TActionShape)
  public
    constructor Create(AButton: TSpeedButton; APenColor: TColor = clYellow; AInsideButton: Boolean = True); reintroduce;
  end;
 
  TWinControlActionShape = class(TActionShape)
  private
    type
      THackWinControl = class(TWinControl);
  public
    constructor Create(AWinControl: TWinControl; APenColor: TColor = clYellow; AInsideWinControl: Boolean = False); reintroduce;
  end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 
{ TActionShape }
 
//------------------------------------------------------------------------------
procedure TActionShape.InitializeColor(APenColor: TColor);
begin
  Brush.Style := bsClear;
  FColor := APenColor;
  if Canvas.GetConstratedColor(APenColor) = clBlack then
  begin
    // Pour une couleur claire, on utilise un pointillé épais
    Pen.Handle := CreateSpecialPen(APenColor); // Pen se charge de la libération
  end
  else
  begin
    // Pour une couleur foncée, on utilise un pointillé standard
    Pen.Style := psDot;
    Pen.Color := APenColor;
  end;
end;
 
//------------------------------------------------------------------------------
function TActionShape.CreateSpecialPen(AColor: TColor): THandle;
const
  LineLengths: array[0..1] of DWORD = (2, 3);
var
  LogBrush: TLogBrush;
begin
  LogBrush.lbStyle := BS_SOLID;
  LogBrush.lbColor := ColorToRGB(AColor);
  Result := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE or PS_ENDCAP_FLAT or PS_JOIN_BEVEL, 2, LogBrush, 2, @LineLengths[0]);
end;
 
//------------------------------------------------------------------------------
procedure TActionShape.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    Pen.Handle := CreateSpecialPen(Value); // Pen se charge de la libération
    FColor := Value;
  end;
end;
 
{ TButtonActionShape }
 
//------------------------------------------------------------------------------
constructor TButtonActionShape.Create(AButton: TSpeedButton; APenColor: TColor = clYellow; AInsideButton: Boolean = True);
var
  ShapeRect: TRect;
begin
  inherited Create(AButton.Owner);
 
  ShapeRect := AButton.BoundsRect;
  if AInsideButton then
    InflateRect(ShapeRect, -2, -2)
  else
    InflateRect(ShapeRect, 3, 3);
 
  BoundsRect := ShapeRect;
  // Le Shape étant créé après, son Z-Order fait qu'il sera dessiné par dessus le Bouton
  Parent := AButton.Parent;
  OnClick := AButton.OnClick;
  OnDblClick := AButton.OnDblClick;
 
  if AInsideButton then
    Shape := stRoundRect
  else
    Shape := stRectangle;
 
  InitializeColor(APenColor);
 
  Visible := False;
end;
 
{ TWinControlActionShape }
 
//------------------------------------------------------------------------------
constructor TWinControlActionShape.Create(AWinControl: TWinControl; APenColor: TColor = clYellow; AInsideWinControl: Boolean = False);
var
  ShapeRect: TRect;
begin
  inherited Create(AWinControl.Owner);
 
  ShapeRect := AWinControl.BoundsRect;
  if AInsideWinControl then
  begin
    ShapeRect := Rect(2, 2, AWinControl.Width - 4, AWinControl.Height - 4);
    Parent := AWinControl;
  end
  else
  begin
    InflateRect(ShapeRect, 3, 3);
    Parent := AWinControl.Parent;
  end;
 
  BoundsRect := ShapeRect;
  OnClick := THackWinControl(AWinControl).OnClick;
  OnDblClick := THackWinControl(AWinControl).OnDblClick;
 
  if AInsideWinControl then
    Shape := stRoundRect
  else
    Shape := stRectangle;
 
  InitializeColor(APenColor);
 
  Visible := False;
end;

Nom : Sans titre.jpg
Affichages : 1119
Taille : 70,4 Ko

**Cirec** · 20/10/2017, 18h10

Envoyé par ShaiLeTroll

TBrushRecall pas sûr que cela existe en D7

Si Depuis D7

Envoyé par ShaiLeTroll

Et dès le moindre invalidate, le trait ne disparait-il pas ?

Oui tu as raison

j'avais zappé

Cordialement,
@+

**mamiF** · 20/10/2017, 19h00

Nom : editrouge.PNG
Affichages : 960
Taille : 927 octets

aprés quelque réglage j'écrie ce code dans l'événement OnPaint ca marche

**Charly910** · 21/10/2017, 11h27

Bonjour,
un truc qui marche très bien et qui ne "coute" pas cher : un panel sans bord sous le TEdit, avec un débord d'un ou deux pixels

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
procedure TForm2.Edit1Enter(Sender: TObject);
begin
   Panel1.Color := clRed ;
end;
 
procedure TForm2.Edit1Exit(Sender: TObject);
begin
   Panel1.color := clBtnFace ;
end;

A+
Charly

**mamiF** · 21/10/2017, 18h30

Merci A Tous Ce Petit Code a Résolu

La Solution de Cirec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
procedure TForm1.FormPaint(Sender: TObject);
begin
with TBrushRecall.Create(canvas.Brush) do
try
Canvas.Brush.Color:=clred;
Canvas.Brush.Style:=bsSolid;
aRect:=edit1.BoundsRect;
InflateRect(aRect,1,1);
FrameRect(Canvas.Handle, aRect,canvas.Brush.Handle);
finally
free;
edit1.BorderStyle:=bsnone;
 
end;
end;
 
end.

**Charly910** · 22/10/2017, 10h39

Bonjour,

tu oublies de déclarer aRect. cela ne peut pas compiler.

D'autre part, il faut affecter le code de Cirec aux OnEnter et OnExit de chacun des TEdit de ta Form :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
procedure TForm1.EditEnter(Sender: TObject);
var
  aRect: TRect;
begin
  // Edit1.BorderStyle := bsnone ;   ==>> à mettre dans le Oncreate de Form1
  with TBrushRecall.Create(Canvas.Brush) do
  try
    Canvas.Brush.Color := clRed;
    Canvas.Brush.Style := bsSolid;
    aRect := (Sender as TEdit).BoundsRect;
    InflateRect(aRect, 3, 3);
    FrameRect(Canvas.Handle, aRect, Canvas.Brush.Handle)
  finally
    Free;
  end;
end;

procedure TForm1.EditExit(Sender: TObject);
var
  aRect: TRect;
begin
  aRect := (Sender as TEdit).BoundsRect;
  InflateRect(aRect, 3, 3);
  FrameRect(Canvas.Handle, aRect, Canvas.Brush.Handle)
end;

Si tu le mets dans le OnPaint de ta Form, le cadre rouge sera toujours dessiné, même si le TEdit n'a plus le focus.

A+
Charly

**mamiF** · 22/10/2017, 15h01

j'ai déclaré comme une variable Globale merci

Composant TEdit sous Delphi 7

Composants VCL Delphi

Discussions similaires

Partager

Partager