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;