Bonjour à toutes et à tous,

Avec une ancienne procédure pour créer un cadre sur un TBitmap, serait t'il possible d'ajouter un effet dès que le cadre est tracé.

Soit comme dans le PrintScreen de Windows 10 (assombrir la photo et éclairer l'intérieur du cadre !).

J'avais déjà ajouté le code pour définir un trait de 2pixels et modifier la couleur.

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
 
{procedure DrawSelFrame = dessin du cadre de sélection
   forme rectangle : emploi de DrawFocusRect pour dimensions > 12 pixels
                     emploi de Rectangle en ligne continue si >=2 et <= 12 pixels
                     emploi de Lineto si épaisseur = 1 pixel
   forme ellipse : emploi de Ellipse en mode psDot pour dimensions > 12 pixels
                   emploi de Ellipse en mode psSolid si >=2 et <= 12 pixels
                   emploi de LineTo si 1 pixel}
procedure TSImage.DrawSelFrame(SelVisible: boolean);
var
  R: TRect;
begin
  if SelectionExist and (SelVisible <> SelectionVisible) then
  begin
     R:= InverseRect(FSelRect);
     if (FSelectionForm = sfRectangle) and (R.Right - R.Left <=12) and (R.Bottom - R.Top <= 12) then
     begin
         Canvas.Brush.Color:= clGray;
         Canvas.Pen.Width := 2;
         Canvas.DrawFocusRect(Rect(R.Left, R.Top, R.Right + 1, R.Bottom + 1));
     end
     else
     begin
         Canvas.Pen.Color:= clGray;
         Canvas.Pen.Mode:= pmXor;
         if R.Bottom = R.Top then  // ligne horizontale
         begin
             Canvas.Pen.Style:= psSolid;
 
             Canvas.MoveTo(R.Left, R.Top);
             Canvas.LineTo(R.Right + 1, R.Bottom);
         end
         else
         if R.Right = R.Left then  // ligne verticale
         begin
             Canvas.Pen.Style:= psSolid;
 
             Canvas.MoveTo(R.Left, R.Top);
             Canvas.LineTo(R.Right, R.Bottom + 1);
         end
         else
         begin
              if (R.Right - R.Left < 12) or (R.Bottom - R.Top < 12) then
                  Canvas.Pen.Style:= psSolid
              else
                  Canvas.Pen.Style:= psDot;
              Canvas.Brush.Style:= bsClear;
 
 if FSelectionForm = sfRectangle then
                  Canvas.Rectangle(R.Left, R.Top, R.Right+1, R.Bottom+1)
              else
                  Canvas.Ellipse(R.Left, R.Top, R.Right+1, R.Bottom+1);
         end;
         // on remet les modes habituels
         Canvas.Pen.Mode:= pmCopy;
         Canvas.Pen.Style:= psSolid;
         Canvas.Brush.Style:= bsSolid;
     end;
     SelectionVisible:= not(SelectionVisible);
  end;
end;
Merci d'avance,

@+,

cincap