creation composant

Question

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+

Guillemouze · Answer

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).

gebu34 · Answer

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+

Guillemouze · Answer

"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.

gebu34 · Answer

Hé non tout est dessiné dans paint avec du Rectangle, MoveTo et LineTo........
A+

gebu34 · Answer

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

Creation composant

5 réponses

Votre réponse

Discussions similaires