COMPOSANT TSWITCHLED (UNE LED)

Commentaire de Bacterius le 27/09/2008 22:22:28

Ah oui je n'ai pas mis à jour l'exemple suite à la modification du composant.
Je ferai ça demain.

Cordialement, Bacterius !

Commentaire de cirec le 28/09/2008 01:01:27 administrateur CS

tu as la folie des composants en ce moment ....

avant que tu fasses une mise à jour je tiens à te dire que la voie utilisée n'est pas la bonne ...
tu recharges continuellement toutes les images pour libérer de suite après (dans la procedure Paint) et il y a pas mal de code inutile.

Je te propose donc une autre version plus efficace dans la gestion des bitmaps et leurs index :

**********************************************************************************
unit SwitchLed;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics, Menus;

type
  TLedColor=(lcAqua, lcPink, lcPurple, lcRed, lcYellow, lcGreen,
    lcBlue, lcOrange, lcBlack); // Type couleur de la LED
  TLedState=(lsOn, lsOff, lsDisabled); // Type état de la LED

  TLedBmp = array[TLedState] of TBitmap;
const
  StrLedColor : array[TLedColor] of String = ('Aqua', 'Pink', 'Purple', 'Red',
    'Yellow', 'Green', 'Blue', 'Orange', 'Black');//
type
  TSwitchLed = class(TGraphicControl)
  private
    { Déclarations privées }
    FOnColor: TLedColor; // Champ objet OnColor
    FOffColor: TLedColor; // Champ objet OffColor
    FDisabledColor: TLedColor; // Champ objet DisabledColor
    FLedState: TLedState; // Champ objet LedState
    FAllowChanges: Boolean; // Champ objet AllowChanges
    FLedBmp: TLedBmp;
    FVersion, FAuthor: String; // Champs objet de la version et de l'auteur
    procedure SetOnLedColor(Value: TLedColor); // Procédure définition OnColor
    procedure SetOffLedColor(Value: TLedColor); // Procédure définition OffColor
    procedure SetDisabledLedColor(Value: TLedColor); // Procédure définition DisabledColor
    procedure SetLedState(Value: TLedState); // Procédure définition LedState
    procedure SetLedBmp(const Idx: TLedState; Value: TLedColor);
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override; // Constucteur hérité
    destructor Destroy; override;
    procedure Paint; override;  // Dessin du composant hérité

    property Version: String read FVersion; // Propriétés cachées version et auteur
    property Author: String read FAuthor;
  published
    { Déclarations publiées }
    property OnColor: TLedColor read FOnColor write SetOnLedColor; // Propriété OnColor
    property OffColor: TLedColor read FOffColor write SetOffLedColor; // Propriété OffColor
    property DisabledColor: TLedColor read FDisabledColor write SetDisabledLedColor; // Propriété DisabledColor
    property LedState: TLedState read FLedState write SetLedState;  // Propriété LedState
    property AllowChanges: Boolean read FAllowChanges write FAllowChanges; // Propriété AllowChanges

    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnStartDrag;
    property OnDragOver;
    property OnEndDrag; // On remet tous les évenements hérités
    property OnDragDrop;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock; // Je ne suis pas sûr pour les docks ...
    property OnEndDock;
    property PopupMenu; // On remet le popupmenu
    property ShowHint; // On remet ShowHint
    property Visible; // On remet Visible
  end;

procedure Register;

implementation

{$R Leds.res}

procedure Register;
begin
  RegisterComponents('Bacterius', [TSwitchLed]); // Recensement du composant
end;

constructor TSwitchLed.Create(AOwner: TComponent);
begin
  inherited Create(AOwner); // Constructeur hérité
//  Parent := TWinControl(AOwner); // Le parent sera un transtypage de AOwner
  FOnColor := lcGreen; // Couleur ON par défaut
  FOffColor := lcRed; // Couleur OFF par défaut
  FDisabledColor := lcBlack; // Couleur DISABLED par défaut
  FLedState := lsOff; // Etat de la LED par défaut
  FAllowChanges := True; // On autorise la modification des valeurs
  FVersion := '1.3';  // On fixe la version
  FAuthor := 'Bacterius'; // On fixe l'auteur
  Width := 13;
  Height := 13; // C'est la taille des bitmaps LEDs

  SetLedBmp(lsOn, FOnColor);
  SetLedBmp(lsOff, FOffColor);
  SetLedBmp(lsDisabled, FDisabledColor);
end;

procedure TSwitchLed.SetOnLedColor(Value: TLedColor);
begin
if not AllowChanges then Exit;  // Si on peut modifier
if Value <> FOnColor then
begin
   FOnColor := Value; // On définit
   SetLedBmp(lsOn, FOnColor);
   Invalidate; // On redessine le tout
end;
end;

procedure TSwitchLed.SetOffLedColor(Value: TLedColor);
begin
if not AllowChanges then Exit;  // Si on peut modifier
if Value <> FOffColor then
begin
   FOffColor := Value; // On définit
   SetLedBmp(lsOff, FOffColor);
   Invalidate; // On redessine le tout
end;
end;

procedure TSwitchLed.SetDisabledLedColor(Value: TLedColor);
begin
if not AllowChanges then Exit;  // Si on peut modifier
if Value <> FDisabledColor then
begin
   FDisabledColor := Value; // On définit
   SetLedBmp(lsDisabled, FDisabledColor);
   Invalidate; // On redessine le tout
end;
end;

procedure TSwitchLed.SetLedBmp(const Idx: TLedState; Value: TLedColor);
begin
  if not Assigned(FLedBmp[Idx]) then
  begin
    FLedBmp[Idx] := TBitmap.Create;
    FLedBmp[Idx].TransparentColor := clGreen;
    FLedBmp[Idx].Transparent := True; // On fixe la transparence :)
  end;

  FLedBmp[Idx].LoadFromResourceName(hInstance, StrLedColor[Value]);
end;

procedure TSwitchLed.SetLedState(Value: TLedState);
begin
if not AllowChanges then Exit; // Si on peut modifier
if Value <> FLedState then
begin
  FLedState := Value;  // On définit
  Invalidate; // On redessine le tout
end;
end;

procedure TSwitchLed.Paint;
begin
  if Width <> 13 then Width := 13; // On empeche de redimensionner
  if Height <> 13 then Height := 13;
  // On dessine
  Canvas.Draw(0, 0, FLedBmp[LedState]);
end;

destructor TSwitchLed.Destroy;
var I: TLedState;
begin
  for I:= Low(TLedState) to High(TLedState) do
    FLedBmp[I].Free;
  inherited Destroy;
end;
end.
**********************************************************************************

dans l'unité Main il y a aussi des changements
la procedure FormClose est inutile, l'affectation correcte du parent des Leds et la selection des couleurs:
**********************************************************************************
procedure TMainForm.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;

OnLedComp := TSwitchLed.Create(Self);
OnLedComp.Left := 6; // Création dynamique du ON
OnLedComp.Top := 14;
OnLedComp.LedState := lsOn;
OnLedComp.Parent := OnBox;

OffLedComp := TSwitchLed.Create(Self);
OffLedComp.Left := 7; // Création dynamique du OFF
OffLedComp.Top := 14;
OffLedComp.LedState := lsOff;
OffLedComp.Parent := OffBox;
end;

procedure TMainForm.ModifyColors(Sender: TObject);
Var
TmpColor: TLedColor;
begin
if Sender is TComboBox then // Si c'est bien un combobox alors ...
  begin
   if not (TComboBox(Sender).ItemIndex in [0..7]) then Exit;
   // Si l'itemindex est incorrect on s'en va

   TmpColor := TLedColor(TComboBox(Sender).ItemIndex);
   // On définit la couleur selon l'itemindex du combobox sender

   case TComboBox(Sender).Tag of
    1: OnLedComp.OnColor := TmpColor; // Selon le tag du combobox on modifie le led correspondant
    2: OffLedComp.OffColor := TmpColor;
   end;
  end;
end;
**********************************************************************************


il y a encore d'autres possibilités mais je t'en laisse un peut ^^

Commentaire de John Dogget le 28/09/2008 09:53:20

Tu mets un TBevel entre les deux, et tu lui mets une hauteur de 2 ;)

Bon sinon, c'est effectivement très bien de créer ses propres composants pour ses propres besoins.
Mais pour ceux qui comme moi n'ont pas envie de réinventer la roue à chaque fois, les packs e composants sont vraiment très utiles.

La JVCL en particulier est un outils (open-source) extraordinaire qui offre des compos qu'on ne trouve pas ailleurs.
Je comprends très bien qu'il soit preferable de se servir des compos de base Delphi pour poster ici, mais pour d'autres projets il n'y as pas de raisons de s'en priver ...

Commentaire de Bacterius le 28/09/2008 12:09:26

Bon voilà, tout ça a été arrangé, j'ai ajouté des petites optimisations perso en passant.

John Dogget j'ai pensé à toi, je n'ai pas mis le thème WindowsXP dans l'exemple (tu as toujours un écran noir après ...) ^^

"tu as la folie des composants en ce moment ...." oui c'est vrai ... mais je découvre juste, j'ai envie d'approfondir.

Sinon, pour la création des 9 bitmaps à chaque Paint, c'était car j'avais peur que les bitmaps ne soient pas libérés à la destruction du composant, si je les mettait en propriété globale (si jamais on kill une application avec une LED dedans ...), mais je crois que Destroy est appellé de toute façon non ? Même avec un Kill ?

Cordialement, Bacterius !

Commentaire de Bacterius le 28/09/2008 13:03:12

De rien, mais dans un gros projet qui contient genre 15 leds, ne te fatigue pas à les créer dynamiquement.
Place les directement sur ta fiche, car créer 15 composants dynamiquement c'est très pénible et source d'erreurs.

Cordialement, Bacterius !

Commentaire de cirec le 28/09/2008 15:30:55 administrateur CS

Mais non !!!
qu'est ce que tu fais ^^

vires moi ces deux procedures "IntToLedColor & LedColorToInt" ... je les ai pas virés pour que tu les remettes à la première occase. Ö

regarde comment j'ai fait dans la procedure "SetLedBmp"
c'est exactement le même principe ;)

Commentaire de Bacterius le 28/09/2008 19:01:21

Bon voilà, l'exemple est mis à jour.
On peut maintenant modifier les 3 valeurs (OnColor, OffColor, DisabledColor) des LEDs depuis l'exemple.
Le feu rouge est toujours là :)

Cordialement, Bacterius !

Commentaire de Bacterius le 28/09/2008 22:37:05

Oui je mets tout le code en anglais, je trouve que c'est plus conventionnel, plus pratique, et plus professionnel ^^

Sinon, il est tard, je mettrai ça demain apres-midi :)

Merci encore Cirec je n'y aurais jamais pensé à Ord.

Cordialement, Bacterius !

Commentaire de Bacterius le 29/09/2008 18:06:19

Voilà Cirec, j'ai ajouté ta boucle ordinale, en la commentant (pour bien montrer que j'ai compris le principe) et en modifiant juste le formattage (le 1 >> Pink) ne me plaisait pas, j'ai remplacé par des listes de cette façon :

(0) Aqua
(1) Pink
(2) Purple
(3) Red
...

C'est sûr que c'est plus pratique, plus besoin d'aller modifier la liste des 3 combos lorsqu'on ajoute une couleur.

Je n'ai pas mis à jour la capture mais je pense que vous avez compris.

Cordialement, Bacterius !

Commentaire de Bacterius le 29/09/2008 21:46:53

Bon, j'ai intégré les évenements OnMouseEnter et OnMouseLeave (j'ai suivi les instructions de mon bouquin Borland avec mes evenements perso, et je me suis légèrement inspiré de la TextImage de Guillemouze pour l'idée ^^).
Ces evenements peuvent être utiles pour une LED ... (quand on pointe la souris dessus on change la LED de couleur ... enfin vous voyez le truc).

Cordialement, Bacterius !

Commentaire de JulioDelphi le 30/09/2008 09:45:46 administrateur CS

Salut !
Alors moi j'avoue je n'ai pas encore lu le code ni les commentaires mais je propose ça :

Screen : http://diabloporc.free.fr/delphi/demos/led_sans_compo.jpg
Exe : http://diabloporc.free.fr/delphi/demos/led_sans_compo.exe

La même chose que toi mais sans aucun composant externe.
Juste 3 TGroupBox, 3 TShape, 3 TImage, 3 TColorBox, 3 TLabel et une seule ligne de code dans le onchange des colorbox :
(FindComponent((Sender as TColorBox).Hint) as TShape).Brush.Color:= (Sender as TColorBox).Selected;

De plus, on peut mettre toutes les couleurs et pas seulement 9.
Reste à faire 3 procédure si on veut faire des positions on, off, disa...
Des commentaires ? ^^

Commentaire de pascal99 le 30/09/2008 13:12:18

Bonjour,
JulioDelphi, tu n'aurais pas la source de ce led_sans_compo par hasard ?

a+

Commentaire de pascal99 le 30/09/2008 14:45:22

Merci JulioDelphi,
Apres avoir ouvert ton source, tu avais effectivement tout donné dans ton message.
La simplicité a l'état pur !!!

Commentaire de JulioDelphi le 30/09/2008 18:19:57 administrateur CS

(encore une fois) Lis moi avant de répondre :)
Tu aurais vu mon adresse du screen
http://diabloporc.free.fr/delphi/demos/led_sans_compo.jpg
et moi, je vois les meme led que toi ...

Commentaire de JulioDelphi le 30/09/2008 20:15:07 administrateur CS

Nan, ton composant est très bien dans la forme, dans dans le fond je ne trouve pas car il est vite rattrapé par du simple code.
Oui j'utilise une bitmap, toi aussi non ? ^^
Je donne les couleurs a des TShape sous les bitmap transparents, l'effet est le meme et le choix de couleur est plus grand.
Oui, ma ligne de code ne ferait pas long feu ici ^^ lol

Bien vu pour ton compo néanmoins !

Commentaire de Bacterius le 30/09/2008 21:39:57

Sinon c'est toujours une connaissance de plus, savoir qu'on peut fusionner une couleur avec un TShape et les pixels derrière ^^ Ca peut aider du monde ...

Cordialement, Bacterius !

Commentaire de JulioDelphi le 30/09/2008 22:47:16 administrateur CS

Je viens de poser 100 fois ton composant sur une fiche, je regarde la place en mémoire occupée : 3400k
J'ai ensuite fait 100 shape et 100 timage avec une image transparente dedans et une procedure pour les couleurs : 3200k
Qui est lourd ? ^^

Commentaire de Bacterius le 01/10/2008 14:04:09

Bon sinon j'ai ajouté ... enfin voir description et mise à jour.

Cordialement, Bacterius !