Discussion :

[BuzzLeclaire]

Désolé 3 ème message.

J'ai tenté de mettre tout cela dans mon programme.
ALors j'ai déjà un stringgrid de poser sur ma form et je fait cela
1/ j'ajoute ceci

Code :

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

1
2
3
4
5
6
7
8
9
10
11
type
 
  TStringGridRu = class(TStringGrid)
    Protected
      procedure WMVSCROLL(var Message :TMessage); message WM_VSCROLL;
      procedure WMMOUSEWHEEL(var Message :TMessage); message WM_MOUSEWHEEL;
    public
      procedure CheckInBounds;
  end;
 
.....

2/ Puis je modifie cela (en rouge)

Code :

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

1
2
3
4
5
  TFormPrincipal = class(TForm)
    ....
    StringGridSemaine: TStringGridRu;
    ....
;

3/ j'ai un message où je reponds non

Field FormPrincipal.StringGridSemaine should be of type TStringGrid nut is declared as tStringGridRu. Correct this declaration?

La procedure CheckBounds à l'air dêtre pris en compte, mais aucun TMessage ne fonctionne, de plus comment eviter se message, sans passer par une création dynamique de mon StringGrid existant ?

[Andnotor]

Ola Buzz.

Alors dans l'ordre:

1. MakeLong(6, 2) correspondait au ligne/colonne, pas au pixels.
Dans ton cas, tu peux ignorer le Left puisque tu n'a pas de scroll horizontal. Tu peux le fixer une fois pour toute où tu veux.

2. Même remarque qu'au dessus. Tu peux remplacer le Col par une constante (ex. 0).

3. Tu ne peux pas simplement remplacer TStringGrid par TStringGridRu dans ton unité. Dans le DFM, l'objet est toujours TStringGrid ! Le compilateur râle du fait de cette désynchronisation et te propose de le remettre comme le DFM.

Pour l'utiliser au Design, tu dois obligatoirement enregistrer ce nouveau composant dans la palette des composants.

Première partie:

Pas à pas (avec l'assistant):
- Menu Composants,
- Nouveau composant VCL,
- Le composant ancêtre sera le TStringGrid,
- Le nom du nouveau composant : TStringGridRu,
- Donne un nom personnel à la palette.
- Tu sélectionnes où tu veux sauvegarder la nouvelle unité.

L'assistant va créer la structure de base pour toi.

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
unit StringGrid1;
 
interface
 
uses
  SysUtils, Classes, Controls, Grids;
 
type
  TStringGridRu = class(TStringGrid)
  private
    { Déclarations privées }
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
  published
    { Déclarations publiées }
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Samples', [TStringGridRu]);
end;
 
end.

Deuxième partie:

Les composants sont stockés dans des paquets (BPL). Crée un nouveau projet de type Package. Ajoutes-y l'unité que tu viens de créer. Sauves-le où tu veux et compiles.

Il ne te reste plus qu'à faire un click droit sur ce paquet dans le gestionnaire de projet et de sélectionner Installer. Ou dans le menu Composants, Installer un paquet.

Je sais que ça paraît un peu compliqué la première fois

[BuzzLeclaire]

Salut AndNotor,

Avant de créer mon composant (j'étais en fait entrain d'apprendre car je me doutais de ta réponse)
Est-ce que je dois intégrer ces lignes dans mon compo, ce qui donnerais cela avant la compilation :

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
unit StringGridRu;
 
interface
 
uses
  SysUtils, Classes, Controls, Grids;
 
type

  TStringGridRu = class(TStringGrid)
  private
    { Déclarations privées }
  protected
    { Déclarations protégées }
     procedure WMVSCROLL(var Message :TMessage); message WM_VSCROLL;
     procedure WMMOUSEWHEEL(var Message :TMessage); message WM_MOUSEWHEEL;
  public
    { Déclarations publiques }
      procedure CheckInBounds;
  published
    { Déclarations publiées }
  end;
 
procedure Register;
 
implementation


procedure  TStringGridRu.WMVSCROLL(var Message :TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;

procedure TStringGridRu.WMMOUSEWHEEL(var Message: TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;

procedure TStringGridRu.CheckInBounds;
var
  i   :Integer;
  Col :integer;
  Row :integer;
  xLeft: Integer;
begin
  //Liste des Shapes
  for i := 0 to ControlCount -1 do
  begin
    Col := HiWord(Controls[i].Tag);
    Row := LoWord(Controls[i].Tag);
    xLeft := Controls[i].Left;
 
    //Cache le Shape si la ligne est masquée ou le positionne
    Controls[i].Visible := CellRect(Col,Row).Top > 0;
    Controls[i].Left    := xLeft;
    Controls[i].Top     := CellRect(Col,Row).Top;
  end;
end;
 
procedure Register;
begin
  RegisterComponents('Samples', [TStringGridRu]);
end;

merci de ta réponse.

[Andnotor]

Exact

Supprime juste tes xLeft qui ne servent à rien.

[BuzzLeclaire]

Voilà ce que j'ai fais, pour créer mon composant
1/ File
2/ New
3/ Other
Dans la fenêtre new items j'ai choisi
4/ Package
Dans la fenêtre Package j'ai cliquer sur
5/ Add
Dans cette fenêtre Add j'ai mis
Onglet Add Unit j'ai laisser vide les 2 champs
Onglet New Component
6/ Ancestor Type = j'ai mis TStringGrid [Grids]
7/ Class Name = j'ai mis TStringGridRu
8/ Palette Page = j'ai mis EssaiPerso
9/ Unit file name = j'ai mis C:\Program Files\Borland\Delphi7\Lib\TestComposant\stringGridRu.pas
10/ Search path = On trouve $(DELPHI)\Lib;$(DELPHI)\Bin;$(DELPHI)\Imports;$(DELPHI)\Projects\Bpl;$(DELPHI)\Rave5\Lib;$(DELPHI)\Lib\SpTBXLib;$(delphi)\lib\mescomposants;$(delphi)\lib\testcomposant
J'ai cliquer en suite sur OK, j'ai supprimer l'unit1 et j'ai copier coller cela dedans

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
unit StringGridRu;
 
interface
 
uses
  SysUtils, Classes, Controls, Grids, Messages, Windows;
 
type
 
  TStringGridRu = class(TStringGrid)
  private
    { Déclarations privées }
  protected
    { Déclarations protégées }
     procedure WMVSCROLL(var Message :TMessage); message WM_VSCROLL;
     procedure WMMOUSEWHEEL(var Message :TMessage); message WM_MOUSEWHEEL;
  public
    { Déclarations publiques }
      procedure CheckInBounds;
  published
    { Déclarations publiées }
  end;
 
procedure Register;
 
implementation
 
 
procedure  TStringGridRu.WMVSCROLL(var Message :TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;
 
procedure TStringGridRu.WMMOUSEWHEEL(var Message: TMessage);
begin
  inherited;
  CheckInBounds;
  Invalidate;
end;
 
procedure TStringGridRu.CheckInBounds;
var
  i   :Integer;
  Col :integer;
  Row :integer;
begin
  //Liste des Shapes
  for i := 0 to ControlCount -1 do
  begin
 
    Col := HiWord(Controls[i].Tag);
    Row := LoWord(Controls[i].Tag);
 
    //Cache le Shape si la ligne est masquée ou le positionne
    Controls[i].Visible := CellRect(Col,Row).Top > 0;
    Controls[i].Left    := Controls[i].Left;
    Controls[i].Top     := CellRect(Col,Row).Top;
  end;
end;
 
procedure Register;
begin
  RegisterComponents('Samples', [TStringGridRu]);
end;
end.

11/ j'ai cliqué sur Compile
12/ Sur install
13/ j'ai cliqué sur enregistrer
J'ai nommé le .Pas en StringGridRu
J'ai nommé le .PKG en Package (Je sais pas si c'est bien comme nom ??)
Et la j'ai pas mal de fichier qui se sont créer dans le répertoire

Ensuite dans l'onglet Sample j'ai retouvé un StrinGridru(StringGriRu)


J'ai 2 Questions :
- Pourquoi le StringGrid de base s'appel StringGrid(Grids) et pas StringGrid(StringGrid) comme moi ? J'ai fais une erreur ?
- Est-ce que c'est génant d'avoir mis 8/ Palette Page = EssaiPerso au lieu de Sample ?

Merci à toi


PS : les premiers tests sont concluant, je finanlise dans mon prog et je reviens donner mes infos.

[Andnotor]

J'ai pas compris la question...

- Pourquoi le StringGrid de base s'appel StringGrid(Grids) et pas StringGrid(StringGrid) comme moi ? J'ai fais une erreur ?

Utilise un nom plus parlant, style RUCompo. Ton Package, dans une année, tu ne sauras plus à quoi il sert.

Aucune limite sur le nom de la palette. Mais RUCompo (encore) serait pas mal pour lier le paquet, la palette et les composants inclus.

[BuzzLeclaire]

Ok pour les nom de palette et de paquet je vais les mettre en RuCompo tu as raison.

Pour cela :

- Pourquoi le StringGrid de base s'appel StringGrid(Grids) et pas StringGrid(StringGrid) comme moi ? J'ai fais une erreur ?

Quand tu passe ta souris sur le composant (au survole) le hint ecris
StringGrid(Grids) pour le StringGrid standard
et ecris
StringGridRu(StringGridRu) pour le mien ?

Est-ce normal ?

[Andnotor]

C'est le nom de l'unité. Donc normal

[BuzzLeclaire]

Encore moi...

J'ai donc mis en place un StringGridRu

J'ai ajouter à la creat de la form cela

Code :

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

1
2
3
4
5
6
procedure TFormPrincipal.FormCreate(Sender: TObject);
Begin
.......
  StringGridMois.CheckInBounds;
  StringGridMois.DoubleBuffered := True;
end;

1/ si je le retire ou mis à false le DoubleBuffered et que je scroll dans le stringgridRu je te raconte pas le scintiellement qu'il y a, mais la couleur et dégrader des Shape fonctionne bien

2/ Maintenant si je le mets à True, j'ai aucun scintiellement, mais j'ai un gros soucis mon dégradé de la fonction paint de mon TRuShape ne se redessine pas, mes shape son blanc, si je clique dans le stringgridRu alors les Shape récupere bien leur dégrader. En fait dés que je scroll ils redeviennent tous blanc.. le délire.

Comment je peux régler se phénomène ?

[Andnotor]

En surchargeant Paint du TShapeRu, cela fonctionne bien

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
type
  TShapeRu = class(TShape)
  protected
    procedure Paint; override;
  end;
 
procedure TShapeEx.Paint;
var
  i: Integer;
  Step :real;
begin
//  inherited;
 
  //dégradé simple noir/rouge
  Step := 255 /Height;
 
  for i := 0 to Height - 1 do
  begin
    Canvas.Pen.Color := Round(Step *i);
    Canvas.MoveTo(0, i);
    Canvas.LineTo(Width, i);
  end;
end;

Il faut me montrer ton code.

[BuzzLeclaire]

Voilà le code pour le degrader.

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
type
 
  TRuShape = class(TShape)
    Private
      FStartColor:Tcolor;
      FEndColor:Tcolor ;
      fCaption1:String;
      fCaption2:String;
    Protected
      Procedure Paint;override;
    Published
      property StartColor : Tcolor read fStartColor write fStartColor ;
      property EndColor : Tcolor read FEndColor write FEndColor ;
      property Caption1 : String read fCaption1 write fCaption1;
      property Caption2 : String read fCaption2 write fCaption2;
  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
procedure TRuShape.Paint;
  Procedure Degrader;
  Var
    TailleDuTexte : Integer;
    aBand : TRect;    { Bande rectangulaire de couleur courante        }
    i : Integer;  { Compteur pour parcourir la hauteur de la fiche }
    FStartRGB  : Array[0..2] of Byte;    { RGB de la couleur de départ }
    FCurrentRGB : Array[0..2] of Byte;    { RGB de la couleur courante  }
    FDeltaRGB  : Array[0..2] of Integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
    nbtranches: integer;
    Canevas:TControlCanvas;
    Rect:TRect;
 
  Begin
    Rect.Left := 2;
    Rect.Top := 2;
    Rect.Right := Self.Width-2;
    Rect.Bottom := Self.Height-2;
    self.ParentColor := false;
    Canevas:= TControlCanvas.Create;
    Canevas.Control:= self;
    { Calcul des valeurs RGB pour la couleur courante }
    FStartRGB[0] := GetRValue( ColorToRGB( StartColor ) );
    FStartRGB[1] := GetGValue( ColorToRGB( StartColor ) );
    FStartRGB[2] := GetBValue( ColorToRGB( StartColor ) );
    { Calcul des valeurs à ajouter pour atteindre la couleur de fin }
    FDeltaRGB[0] := GetRValue( ColorToRGB( EndColor )) - FStartRGB[0] ;
    FDeltaRGB[1] := GetgValue( ColorToRGB( EndColor )) - FStartRGB[1] ;
    FDeltaRGB[2] := GetbValue( ColorToRGB( EndColor )) - FStartRGB[2] ;
 
    { Initialisation des dimensions de la bande de couleur }
    aBand.Left :=Rect.Left;
    aBand.Right:=Rect.Right;
    nbtranches:=min(256, Rect.Bottom-Rect.Top);
    { Boucle pour remplir la fiche courante en dégradé }
    With Canevas Do
    Begin
        Pen.Style:=psSolid;
        Pen.Mode:=pmCopy;
        For i:= 0 To nbtranches-1 Do
        Begin
            { Dimensions verticales de la bande }
            aBand.Left :=Rect.Left;
            aBand.Right:=Rect.Right;
            aBand.Top := Rect.Top+Round((Rect.Bottom-Rect.Top)/nbtranches*i);
            aBand.Bottom := Rect.Top+Round((Rect.Bottom-Rect.Top)/nbtranches*(i+1));
 
            { Calcul de la couleur courante }
            FCurrentRGB[0] := (FStartRGB[0] + MulDiv( i , FDeltaRGB[0] , nbtranches )) mod 256;
            FCurrentRGB[1] := (FStartRGB[1] + MulDiv( i , FDeltaRGB[1] , nbtranches )) mod 256;
            FCurrentRGB[2] := (FStartRGB[2] + MulDiv( i , FDeltaRGB[2] , nbtranches )) mod 256;
            { Affichage sur la fiche }
            Brush.color:=RGB(FCurrentRGB[0],FCurrentRGB[1],FCurrentRGB[2]);
            FillRect(aBand);
        End;
      Font.Name := self.Font.Name;
      Font.Size := self.Font.Size;
      Brush.Style := bsClear;
      if Self.Caption1 = '' then DrawText(Canevas.Handle, PChar(Self.Caption) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
      else
      Begin
        DrawText(Canevas.Handle, PChar(Self.Caption1) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_WORDBREAK);
        TailleDuTexte := DrawText(Canevas.Handle, PChar(Self.Caption1) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_WORDBREAK);
        Rect.Top := Rect.Top + TailleDuTexte + 5;
 
        Pen.Color := clBlack;
        MoveTo(Rect.Left+2,Rect.Top);
        LineTo(Rect.Right-2,Rect.top);
 
        Rect.Top := Rect.Top + 2;
        DrawText(Canevas.Handle, PChar(Self.Caption2) , -1, Rect, DT_NOPREFIX or DT_WORDBREAK);
      end;
    End;
   Canevas.Free; // Libérer le canevas après usage !
  End;
 
begin
 inherited Paint;
 Degrader;
end;

Je cherche mais je trouve pas.

[Andnotor]

En effet, TControlCanvas se comporte mal en DoubleBuffered.

Mais une chose est sûr,... tu n'en as pas besoin. TShape a déjà un canvas

[BuzzLeclaire]

En effet, TControlCanvas se comporte mal en DoubleBuffered.

Mais une chose est sûr,... tu n'en as pas besoin. TShape a déjà un canvas

Tu va rire mais sa veux dire quoi concretement ?

[BuzzLeclaire]

Il faut que je face cela a la place ?

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
procedure TRuShape.Paint;
  Procedure Degrader;
  Var
    TailleDuTexte : Integer;
    aBand : TRect;    { Bande rectangulaire de couleur courante        }
    i : Integer;  { Compteur pour parcourir la hauteur de la fiche }
    FStartRGB  : Array[0..2] of Byte;    { RGB de la couleur de départ }
    FCurrentRGB : Array[0..2] of Byte;    { RGB de la couleur courante  }
    FDeltaRGB  : Array[0..2] of Integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
    nbtranches: integer;
//    Canevas:TControlCanvas;
    Rect:TRect;
 
  Begin
    Rect.Left := 2;
    Rect.Top := 2;
    Rect.Right := Self.Width-2;
    Rect.Bottom := Self.Height-2;
    self.ParentColor := false;
//    Canevas:= TControlCanvas.Create;
//    Canevas.Control:= self;
    { Calcul des valeurs RGB pour la couleur courante }
    FStartRGB[0] := GetRValue( ColorToRGB( StartColor ) );
    FStartRGB[1] := GetGValue( ColorToRGB( StartColor ) );
    FStartRGB[2] := GetBValue( ColorToRGB( StartColor ) );
    { Calcul des valeurs à ajouter pour atteindre la couleur de fin }
    FDeltaRGB[0] := GetRValue( ColorToRGB( EndColor )) - FStartRGB[0] ;
    FDeltaRGB[1] := GetgValue( ColorToRGB( EndColor )) - FStartRGB[1] ;
    FDeltaRGB[2] := GetbValue( ColorToRGB( EndColor )) - FStartRGB[2] ;
 
    { Initialisation des dimensions de la bande de couleur }
    aBand.Left :=Rect.Left;
    aBand.Right:=Rect.Right;
    nbtranches:=min(256, Rect.Bottom-Rect.Top);
    { Boucle pour remplir la fiche courante en dégradé }
    With Canvas Do // Canevas Do
    Begin
        Pen.Style:=psSolid;
        Pen.Mode:=pmCopy;
        For i:= 0 To nbtranches-1 Do
        Begin
            { Dimensions verticales de la bande }
            aBand.Left :=Rect.Left;
            aBand.Right:=Rect.Right;
            aBand.Top := Rect.Top+Round((Rect.Bottom-Rect.Top)/nbtranches*i);
            aBand.Bottom := Rect.Top+Round((Rect.Bottom-Rect.Top)/nbtranches*(i+1));
 
            { Calcul de la couleur courante }
            FCurrentRGB[0] := (FStartRGB[0] + MulDiv( i , FDeltaRGB[0] , nbtranches )) mod 256;
            FCurrentRGB[1] := (FStartRGB[1] + MulDiv( i , FDeltaRGB[1] , nbtranches )) mod 256;
            FCurrentRGB[2] := (FStartRGB[2] + MulDiv( i , FDeltaRGB[2] , nbtranches )) mod 256;
            { Affichage sur la fiche }
            Brush.color:=RGB(FCurrentRGB[0],FCurrentRGB[1],FCurrentRGB[2]);
            FillRect(aBand);
        End;
      Font.Name := self.Font.Name;
      Font.Size := self.Font.Size;
      Brush.Style := bsClear;
      if Self.Caption1 = '' then DrawText(Canvas.Handle, PChar(Self.Caption) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE)
      else
      Begin
        DrawText(Canvas.Handle, PChar(Self.Caption1) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_WORDBREAK);
        TailleDuTexte := DrawText(Canvas.Handle, PChar(Self.Caption1) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_WORDBREAK);
        Rect.Top := Rect.Top + TailleDuTexte + 5;
 
        Pen.Color := clBlack;
        MoveTo(Rect.Left+2,Rect.Top);
        LineTo(Rect.Right-2,Rect.top);
 
        Rect.Top := Rect.Top + 2;
        DrawText(Canvas.Handle, PChar(Self.Caption2) , -1, Rect, DT_NOPREFIX or DT_WORDBREAK);
      end;
    End;
//   Canvas.Free; // Libérer le canevas après usage !
  End;

[Andnotor]

Exact , C'est suffisant et plus de problème d'affichage.

[BuzzLeclaire]

Je me demande quand j'arriverais à te coincer !! lol

Encore merci, cela fonctionne trés bien. Me reste a revoir certaine chose surtout au niveau de mes évenements.

MErci

[petitcoucou31]

salut juste pour info il existe le composant gratuit qui fonctionne très bien:

MRControl

bye