Creation composant

Signaler
Messages postés
118
Date d'inscription
samedi 9 décembre 2006
Statut
Membre
Dernière intervention
17 novembre 2009
-
Messages postés
118
Date d'inscription
samedi 9 décembre 2006
Statut
Membre
Dernière intervention
17 novembre 2009
-
Bonjour,
Je suis en train d'écrire un composant (un slider vertical), sans grandes complications pour la fabrication, mais j'ai un problème pour le fonctionnement, je ne trouve pas la soluce pour faire glisser le curseur... J'ai essayé de découper une image du curseur et de la faire bouger avec un MouseMove, mais celà a été un gros echec......
Je donne ci-après le code, il permet de dessinner le compo....il ne manque que le déplacement du curseur haut et bas......

Unit slidervert;
// Fevrier 2009
// gebu34
// Pour Delphi 7.0 (reste non testé)
Interface

Uses  Windows, SysUtils, Messages, Classes, Graphics, Controls, Dialogs,
      Math;
Type
  TSliderVert = Class(TGraphicControl)
  Private
    FValeurMax          : Integer;   //Valeur maximum de l'échelle
    FValeurMin          : Integer;   //Valuer Minimum de l'échelle
    FPosition           : Integer;   //Position par rapport à l'échelle
    FPisteLarg          : Integer;   //Largeur de la piste
    FCursHt             : Integer;   //Hauteur du curseur
    FCurseurCtrLgnCol   : TColor;    //couleur de la ligne centrale du curseur
    procedure SetPisteLarg(Valeur: Integer);
    procedure SetCurseurHt(Valeur: Integer);
    procedure SetCurseurCtrLgnCol(Valeur: TColor);
    procedure SetValeurMax  (Valeur : Integer);
    procedure SetValeurMin  (Valeur : Integer);
    procedure SetPosition   (Valeur : Integer);
  Protected
    procedure Paint; Override;
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  Published
    Property Enabled;
    Property ValeurMax : Integer Read FValeurMax write SetValeurMax Default 10;
    Property ValeurMin : Integer Read FValeurMin write SetValeurMin Default 0;
    Property ParentShowHint;
    Property Position : Integer Read FPosition write SetPosition Default 0;
    Property ShowHint;
    Property Visible;
    property PisteLarg: Integer read FPisteLarg write SetPisteLarg;
    property CurseurHt: Integer read FCursHt write SetCurseurHt;
    property CurseurLigneCol: TColor read FCurseurCtrLgnCol write SetCurseurCtrLgnCol;
  End;

Procedure Register;

Implementation

Procedure Register;
Begin
  RegisterComponents('GBmusik', [TSliderVert]);
End;

Constructor TSliderVert.Create(AOwner: TComponent);
Begin
  Inherited Create(AOwner);
  FPisteLarg        := 3;
  FCursHt           := 25;
  FCurseurCtrLgnCol := clRed;
  FValeurMin        := 0;
  FValeurMax        := 100;
  FPosition         := 0;
End;

Destructor TSliderVert.Destroy;
Begin
  Inherited Destroy;
End;

procedure TSliderVert.SetPisteLarg(Valeur : Integer);
begin
  if FPisteLarg <> Valeur then begin
    FPisteLarg := Valeur;
    Invalidate;
  end;
end;

procedure TSliderVert.SetCurseurHt(Valeur : Integer);
begin
  if Valeur < 9 then Valeur := 9;
  if Valeur <> FCursHt then begin
    FCursHt := Valeur;
    Invalidate;
  end;
end;

procedure TSliderVert.SetCurseurCtrLgnCol(Valeur : TColor);
begin
  if Valeur <> FCurseurCtrLgnCol then begin
    FCurseurCtrLgnCol := Valeur;
    Invalidate;
  end;
end;

Procedure TSliderVert.SetValeurMin(Valeur : Integer);
Begin
  if Valeur <> 0 then Valeur := 0;
  If Valeur <> FValeurMin Then
  Begin
     FValeurMin := Valeur;
     Invalidate;
  End;
End;

Procedure TSliderVert.SetValeurMax(Valeur : Integer);
Begin
  if Valeur <> 100 then Valeur := 100;
  If Valeur <> FValeurMax Then
  Begin
     FValeurMax := Valeur;
     Invalidate;
  End;
End;

Procedure TSliderVert.SetPosition(Valeur : Integer);
Begin
   If Valeur <> FPosition Then
   Begin
      //La valeur doit être comprise ente valeur Max et Mini
      If Valeur < ValeurMin Then Valeur := ValeurMin
      Else
      If Valeur > ValeurMax Then Valeur := ValeurMax;
      FPosition := Valeur;
   End;
   //On est en mode de paramétrage du composant
   If csDesigning In ComponentState Then Invalidate;
End;

Procedure TSliderVert.Paint;
var
  DepPstX, DepPstY, ArrPstX, ArrPstY : Integer;
  DepCrsX, DepCrsY, ArrCrsX, ArrCrsY : Integer;
Begin
  With Canvas Do begin
    // On dessine l'encadrement du composant
      Pen.Style := psClear; Brush.Style := bsClear; Pen.Color := clBlack;
      Rectangle(0, 0, Width, Height);
    // on dessine la piste centrale
      Brush.Style := bsSolid; Brush.Color := clBlack;
      Pen.Style := psSolid; Pen.Color := clBlack;
      DepPstX := Trunc((Width - FPisteLarg) / 2); DepPstY := 3;
      ArrPstX := DepPstX + FPisteLarg; ArrPstY := Height - 3;
      Rectangle(DepPstX, DepPstY, ArrPstX, ArrPstY);
      Pen.Color := clWhite;
      MoveTo (DepPstX, DepPstY); LineTo(ArrPstX, DepPstY);
      MoveTo (ArrPstX, DepPstY); LineTo(ArrPstX, ArrPstY);
    // on dessine le curseur;
      // 1 on calcul la position du rectangle curseur dans le rectangle slider
        DepCrsX := 0; DepCrsY := Trunc(((Height - FCursHt)/100)*(100-FPosition));
        if FPosition = 0 then DepCrsY := Height - FCursHt;
        ArrCrsX := Width; ArrCrsY := DepCrsY + FCursHt;
      // 2 on dessine
        Brush.Style := bsSolid; Brush.Color := clMedGray;
        Pen.Style := psSolid; Pen.Color := clMedGray;
        Rectangle(DepCrsX, DepCrsY, ArrCrsX, ArrCrsY);
        Pen.Color := clWhite;
        MoveTo (DepCrsX + 1, DepCrsY + FCursHt - 1); LineTo(DepCrsX + 1, DepCrsY + 1);
        MoveTo (DepCrsX + 1, DepCrsY + 1); LineTo(ArrCrsX - 1, DepCrsY + 1);
        Pen.Color := clBlack;
        MoveTo (DepCrsX + 1, DepCrsY + FCursHt - 1);
        LineTo(ArrCrsX - 1, DepCrsY + FCursHt - 1);
        MoveTo (ArrCrsX - 1, DepCrsY + FCursHt - 1);
        LineTo(ArrCrsX - 1, DepCrsY + 1);
        Pen.Color := clGray;
        MoveTo (DepCrsX + 1, DepCrsY + FCursHt - 2);
        LineTo(ArrCrsX - 1, DepCrsY + FCursHt - 2);
        MoveTo (DepCrsX + 2, DepCrsY + Trunc(FCursHt/2) - 1);
        LineTo(ArrCrsX - 2, DepCrsY + Trunc(FCursHt/2) - 1);
        Pen.Color := FCurseurCtrLgnCol;
        MoveTo (DepCrsX + 2, DepCrsY + Trunc(FCursHt/2));
        LineTo(ArrCrsX - 2, DepCrsY + Trunc(FCursHt/2));
        Pen.Color := clWhite;
        MoveTo (DepCrsX + 2, DepCrsY + Trunc(FCursHt/2) + 1);
        LineTo(ArrCrsX - 2, DepCrsY + Trunc(FCursHt/2) + 1);
   End;
End;

End.

Merci pour toutes idées géniales......
A+

5 réponses

Messages postés
991
Date d'inscription
samedi 25 octobre 2003
Statut
Membre
Dernière intervention
29 août 2013
7
Procedure TSliderVert.SetPosition(Valeur : Integer);
Begin
   If Valeur <> FPosition Then
   Begin
      //La valeur doit être comprise ente valeur Max et Mini
      If Valeur < ValeurMin Then Valeur := ValeurMin
      Else
      If Valeur > ValeurMax Then Valeur := ValeurMax;
      FPosition := Valeur;
   End;
   //On est en mode de paramétrage du composant
   If csDesigning In ComponentState Then Invalidate;
End;

si on est pas en designing, alors on repaint pas, donc c'est normal que le changement ne soit pas visible (dans l'hypothese ou, sur ton mousemove, tu fais un SetPosition).
Messages postés
118
Date d'inscription
samedi 9 décembre 2006
Statut
Membre
Dernière intervention
17 novembre 2009

Oui j'ai du faire une petite erreur, mais à chaque déplacement du curseur, même d'un pixel, on doit redessiner ???????
D'ailleurs, c'est ce déplacement de curseur que je ne vois pas. Je suis peut-être partis du mauvais concept.............
Je pense quand même que dériver un TGraphicControl est une bonne solution, mais comment le faire bouger......
Les quelques objets que j'ai vus, partaient d'images toutes faites......
Merci pour les idées....
A+
Messages postés
991
Date d'inscription
samedi 25 octobre 2003
Statut
Membre
Dernière intervention
29 août 2013
7
"Les quelques objets que j'ai vus, partaient d'images toutes faites......"

ca sera surement plus rapide de copier une image bufferisée que de la redessiner a chaque fois. A verifier, ca depend surement de la complexité du dessin.
Messages postés
118
Date d'inscription
samedi 9 décembre 2006
Statut
Membre
Dernière intervention
17 novembre 2009

Hé non tout est dessiné dans paint avec du Rectangle, MoveTo et LineTo........
A+
Messages postés
118
Date d'inscription
samedi 9 décembre 2006
Statut
Membre
Dernière intervention
17 novembre 2009

Si je pars d'une image je n'aurais pas ce curseur à "géométrie variable".......
A+