Canvas sur des panels créés dynamiquement

Question

Bonjour,


J'essai d'affecter une couleur dégrader sur un Panel, jusque là tout va bien si je place cela dans un evenement onmousedoxn du panel.
Mais lorsque je créer Un panel en dynamique je n'arrive pas à imposer cette couleur dégrader
voici le code complet sous delphi 7 qui fonctionne au clique sur un panel mais pas en dynamique




unit Unit1;





interface





uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, math, ExtCtrls, StdCtrls;





type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure PanelMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PanelMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  Procedure Degrader(Canevas : TCanvas;Rect : TRect;FStartColor:Tcolor;FEndColor:Tcolor);
  public
    { Public declarations }
  end;





var
  Form1: TForm1;





implementation





{$R *.dfm}





Procedure TForm1.Degrader(Canevas : TCanvas;Rect : TRect;FStartColor:Tcolor;FEndColor:Tcolor);
Var
  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;
Begin
  { Calcul des valeurs RGB pour la couleur courante }
  FStartRGB[0] := GetRValue( ColorToRGB( FStartColor ) );
  FStartRGB[1] := GetGValue( ColorToRGB( FStartColor ) );
  FStartRGB[2] := GetBValue( ColorToRGB( FStartColor ) );
  { Calcul des valeurs à ajouter pour atteindre la couleur de fin }
  FDeltaRGB[0] := GetRValue( ColorToRGB( FEndColor )) - FStartRGB[0] ;
  FDeltaRGB[1] := GetgValue( ColorToRGB( FEndColor )) - FStartRGB[1] ;
  FDeltaRGB[2] := GetbValue( ColorToRGB( FEndColor )) - 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;
  End;
End;





procedure TForm1.FormCreate(Sender: TObject);
Var
  PanelCanvas: TControlCanvas;
  PanelRect : TRect;
  i: Integer;
  Panel: Tpanel;
begin
  for i := 1 To 10 do
  Begin
    Panel := TPanel.Create(Form1);
    Panel.Font.Size := 8;
    Panel.Font.Name := 'Tahoma';
    Panel.Name := 'PANEL' + inTtoStr(i);
    Panel.Caption := Panel.Name;
    Panel.Height := 20;
    Panel.Top := 30 * i;
    Panel.Parent := Form1;
    Panel.OnMouseDown := PanelMouseDown;
    Panel.OnMouseUp := PanelMouseUp;





    PanelCanvas:= TControlCanvas.Create;
    PanelCanvas.Control:= Panel;





    PanelRect.Left := 0;
    PanelRect.Top := 0;
    PanelRect.Right := Panel.width;
    PanelRect.Bottom := Panel.Height;





    Degrader(PanelCanvas,PanelRect,clblue,clwhite);
  end;
end;





procedure TForm1.PanelMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
  PanelCanvas: TControlCanvas;
  PanelRect : TRect;
begin





  // On remet la structure graphic du Panel comme initial
    PanelCanvas:= TControlCanvas.Create;
    PanelCanvas.Control:= Tpanel(sender);
    PanelRect.Left := 0;
    PanelRect.Top := 0;
    PanelRect.Right := Tpanel(sender).Width;
    PanelRect.Bottom := Tpanel(sender).Height;





    Degrader(PanelCanvas,PanelRect,clwhite,clblue);
end;





procedure TForm1.PanelMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
  PanelCanvas: TControlCanvas;
  PanelRect : TRect;
begin
  // On remet la structure graphic du Panel comme initial
    PanelCanvas:= TControlCanvas.Create;
    PanelCanvas.Control:= Tpanel(sender);
    PanelCanvas.Brush.Style := bsClear;
    PanelCanvas.Font.Name := 'Tahoma';
    PanelCanvas.Font.Size := 8;
    PanelRect.Left := 0;
    PanelRect.Top := 0;
    PanelRect.Right := Tpanel(sender).Width;
    PanelRect.Bottom := Tpanel(sender).Height;





    DrawText(PanelCanvas.Handle, PChar(Tpanel(Sender).Caption) , -1, PanelRect, DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE);





end;





end.



Je pense que le problème se situe dans la procedure oncreate de la form à :



Panelcanvas.Control = Panel;


Mais je vois pas quoi mettre d'autre, auriez vous une idée ?

Bacterius · Answer

Il y a des composants sur le site, des panels avec des dégradés dessus. Et aussi des sources, des trucs et des astuces. Tape dans le moteur de recherche du site, "Panel Degradé" tu vas comprendre.

Cordialement, Bacterius !

RURUInc · Answer

J'ai regarder, analyser ton lien, et je vois pas comment cela peux m'aider. D'ailleur les proposition ne sont pas adaptable à mon cas.
A moins que je sois un gros nigo... (je crois lolo)

Bref, en fait si je place dans OnActivate de ma form la procedure OnCreate (j'inverse en fait) et bien il dessine bien les panels en 1 fraction de seconde il les remts en classique.
Cela redessine mes panels en fait.

Et je reste persuadé que cela viens du control de PAnelCanvas.Control := Panel

De plus dans mon projet si dessus, je le sort du context de mon programme. En effet je créer des panel dynamiquement mais le dégradé en réalité est différent pour chaque panel.

Je pensais trouvé un specialiste des canvas et autre TcontrolGraphic ici.

Si vous pouvez m'aider ou me diriger vers une autre solution. MErci a vous

RURUInc · Answer

C'est énorme ce que tu à fait. Apparement superbe.
Alors entre temps voilà ce que l'on à pu me proposé.

Est-ce que tu pense que c'est mieux ou pas ?

.....

type




  TMyPanel =  class(TPanel)
   private
     FStartColor:Tcolor;
     FEndColor:Tcolor ;
   protected
    procedure Paint;override;
   published
    property StartColor : Tcolor read fStartColor write fStartColor ;
    property EndColor : Tcolor read FEndColor write FEndColor ;
   end;

.....(Suite)

procedure TMyPanel.Paint;





  Procedure Degrader;
  Var
    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 := 0;
    Rect.Top := 0;
    Rect.Right := Self.Width;
    Rect.Bottom := Self.Height;
    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;
      DrawText(Canevas.Handle, PChar(Self.Caption) , -1, Rect, DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE);
    End;
   Canevas.Free; // Libérer le canevas après usage !
  End;
 
begin
 inherited Paint;
 Degrader;
end;

...... (suite)
Procedure TFormPrincipal.MiseEnPlaceDesTPanelDejaExistant;
Var 
   Panel: TMyPanel;
begin
      With ModuleDeDonneeSecondaire do
      Begin
        while not ADOCalendrier.Eof do
        Begin
          Panel := TMyPanel.Create(FormPrincipal);  <== la tu est sur qu'il faut mettre SELF ?
          Panel.Font.Size := 8;
          Panel.Font.Name := 'Tahoma';
          Panel.Name := 'PANEL' + ADOCalendrier.Fields.Fields[31].AsString;
          Panel.Caption := ADOCalendrier.Fields.Fields[45].AsString;
          Panel.Top := StrToInt(ADOCalendrier.Fields.Fields[28].AsString);
          Panel.left := StrToInt(ADOCalendrier.Fields.Fields[25].AsString);
          Panel.Height := StrToInt(ADOCalendrier.Fields.Fields[22].AsString);
//          Panel.Color := ADOCalendrier.Fields.Fields[20].AsInteger;
          Panel.Width := StrToInt(ADOCalendrier.Fields.Fields[30].AsString);
          Panel.Parent := FormPrincipal.StringGridSemaine;  <== tu penses que c'est bon comme cela ? 
          Panel.PopupMenu : = FormPrincipal.PopupMenu1;
          Panel.OnDblClick := FormPrincipal.PanelDblClick;
          Panel.OnMouseDown := FormPrincipal.PanelMouseDown;
          Panel.OnMouseMove := FormPrincipal.PanelMouseMove;
          Panel.OnMouseUp := FormPrincipal.PanelMouseUp;
          Panel.ParentBackground := False;
          Panel.Hint := ADOCalendrier.Fields.Fields[23].AsString;
          Panel.ShowHint := True;
          Panel.StartColor := clCream;
          Panel.EndColor := ADOCalendrier.Fields.Fields[20].AsInteger;
          ProgressBarPrincipal.Position := ProgressBarPrincipal.Position + 1;





          ADOCalendrier.Next;
        end;
end;






J'attends vraiement ton avis de professionel.

N'hesite pas à me dire ce que tu en pense.

Bacterius · Answer

Bonjour,
je me permets de simplifier la réponse de f0xi, pour ta première remarque en rouge.

Self définit le type actif dans une unité. Dans les unités fiches, il désignera la fiche.

Pour toute création de composant dynamique, il vaut mieux utiliser Self pour Create, cela spécifie à la fiche qu'elle devra se charger de la destruction du composant lorsqu'elle se détruira.

Cordialement, Bacterius !

f0xi · Answer

utilise la procedure de dégradé que j'ai mis, elle est mieux!

ensuite, oui Self et pas autre chose.

Self pour create et Self.StringGridSemaine

<hr size="2" width="100%" />

Canvas sur des panels créés dynamiquement

5 réponses

Votre réponse

Discussions similaires