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+