Composant : Affectation d'un évènement à un autre [Résolu]

Utilisateur anonyme - 28 mai 2008 à 13:13 - Dernière réponse :  Utilisateur anonyme
- 30 mai 2008 à 11:12
Salut à tous,

J'ai un ptit soucis (surement très bète) mais que je n'arrive pas à résoudre :

Je vous poste qu'un tout ptit bout du code (ca évitera des mals de cranes ):

type

  TBrowserTracks = class;
  TTracksCnt = class;

  {>>TITLE}
  TBrowserTitle = class(TGraphicControl)
  private
    fColorTitle:TColor;
    fColorSubTitle:TColor;
    fColorRectTitle:TColor;
    fTitle:String;
    fSubTitle:String;
    Procedure setColorTitle(Value:TColor);
    Procedure setColorSubTitle(Value:TColor);
    Procedure setColorRectTitle(Value:TColor);
    Procedure SetTitle(Value:String);
    Procedure SetSubTitle(Value:String);
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property ColorTitle:TColor Read fColorTitle Write SetColorTitle;
    Property ColorSubTitle:TColor Read fColorSubTitle Write SetColorSubTitle;
    Property ColorRectTitle:TColor Read fColorRectTitle Write SetColorRectTitle;
    Property Title:String Read fTitle Write SetTitle;
    Property SubTitle:String Read fSubTitle Write SetSubTitle;
  end;

  {>>BROWSERBUTTON}
  TBrowserButton = class(TGraphicControl)
  private
    fColorLine:TColor;
    fColorTop:TColor;
    fColorBottom:TColor;
    fClicked:Boolean;
    fCaption:String;
    Procedure SetColorLine(Value:TColor);
    Procedure SetColorTop(Value:TColor);
    Procedure SetColorBottom(Value:TColor);
    Procedure SetCaption(Value:String);
    Procedure DrawBorder;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;    
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;   
  published
    Property ColorLine:TColor Read fColorLine Write SetColorLine;
    Property ColorTop:TColor Read fColorTop Write SetColorTop;
    Property ColorBottom:TColor Read fColorBottom Write SetColorBottom;   
    Property Tag;
    Property Enabled;
    Property OnMouseDown;
    Property OnMouseMove;
    Property OnMouseUp;
    Property OnClick;   
    Property OnDblClick;
    Property Caption : String Read fCaption Write SetCaption;
    Property Font;
  end;

  {>>BROWSERTRACK}
  TTrackType=(TtMidi,TtWav);
  TBrowserTrack = class(TCustomControl)
  private
    fTypeTrack:TTrackType;
    fTracks:TStringList;
    fIndex:Integer;
    fActive:Boolean;
    fListBox:TListBox;
    fPlayBt:TBrowserButton;
    fStopBt:TBrowserButton;
    fMuteBt:TBrowserButton;
    fWriteBt:TBrowserButton;
    fReadBt:TBrowserButton;
    fParamBt:TBrowserButton;
    Procedure SetTypeTrack(Value:TTrackType);
    Procedure SetTracks(Value:TStringList);
    Procedure SetIndex(Value:Integer);
    Procedure SetActive(Value:Boolean);
    Procedure DrawTypeArea;
    Procedure DrawTypeLogo;
    Procedure DrawCircle(X,Y,Width,Height:Integer);
    Procedure CreateButton(Button:TBrowserButton;BtLeft,BtTop:Integer; BtCaption:String);
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property TypeTrack:TTrackType Read fTypeTrack Write SetTypeTrack;
    Property Tracks:TStringList Read fTracks Write SetTracks;
    Property Index:Integer Read fIndex Write SetIndex;
    Property Active:Boolean Read fActive Write SetActive;
  end;

  {>>TRACKS} 
  TTracks=class(TCollectionItem)
  protected
    fParent:TBrowserTracks;
    fBrowserTrack:TBrowserTrack;
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
    Property Parent:TBrowserTracks Read fParent Write fParent;     
  Published
    Property BrowserTrack:TBrowserTrack Read fBrowserTrack Write fBrowserTrack;
  end;

  {>>TRACKSCNT}
  TTracksCnt = class(TOwnedCollection)
  protected
    fParent:TBrowserTracks;
    function GetItem(Index: integer): TTracks;
    procedure SetItem(Index: integer; Value: TTracks);
  public
    ItemIndex:Integer;
    constructor Create(AOwner: TBrowserTracks);
    function Add: TTracks;
    property Items[Index: integer]: TTracks Read GetItem Write SetItem;
  end;

  {EVENEMENTS}
    TPlay_Event = procedure(Sender: TObject) of object;
    TStop_Event = procedure(Sender: TObject) of object;
    TMute_Event     = procedure(Sender: TObject) of object;
    TWrite_Event = procedure(Sender: TObject) of object;
    TRead_Event = procedure(Sender: TObject) of object;
    TParam_Event = procedure(Sender: TObject) of object;
    TListBox_Event = procedure(Sender: TObject) of object;

  {>>BROWSERTRACKS} 
  TBrowserTracks = class(TCustomControl)
  private
    fBrowserTitle:TBrowserTitle;
    fTracksCnt:TTracksCnt;
    fOnPlay_Event: TPlay_Event;
    fOnStop_Event: TStop_Event;
    fOnMute_Event: TMute_Event;
    fOnWrite_Event: TWrite_Event;
    fOnRead_Event:  TRead_Event;
    fOnParam_Event:  TParam_Event;
    fOnListBox_Event: TListBox_Event;
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property BrowserTitle:TBrowserTitle Read fBrowserTitle Write fBrowserTitle;
    Property TracksCnt:TTracksCnt Read fTracksCnt Write fTracksCnt;
    property Play_Event: TPlay_Event Read fOnPlay_Event Write fOnPlay_Event;
    property Stop_Event: TStop_Event Read fOnStop_Event Write fOnStop_Event;
    property Mute_Event: TMute_Event Read fOnMute_Event Write fOnMute_Event;
    property Write_Event: TWrite_Event Read fOnWrite_Event Write fOnWrite_Event;
    property Read_Event: TRead_Event Read fOnRead_Event Write fOnRead_Event;
    property Param_Event: TParam_Event Read fOnParam_Event Write fOnParam_Event;
    property ListBox_Event: TListBox_Event Read fOnListBox_Event Write fOnListBox_Event;
    Property OnMouseDown;
    Property OnMouseMove;
    Property OnMouseUp;
    Property OnClick;
    Property OnDblClick;   
  end;

constructor TTracks.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  Self.fParent:=ACollection.Owner As (TBrowserTracks);
  Self.fBrowserTrack:=TBrowserTrack.Create(Self.fParent);
  Self.fBrowserTrack.Parent:=Self.fParent;
  If Assigned(Self.fBrowserTrack.fPlayBt) Then Self.fBrowserTrack.fPlayBt.OnClick:=Self.fParent.fOnPlay_Event;
end;

J'ai posté en rouge ce qui ne fonctionne pas : Dans la pratique l'évènement OnPlay_Event n'est jamais appelé quand on clique sur un "PlayBt".

J'ai beau chercher, je ne vois pas ce qui cloche.

Je vous remercie par avance pour votre aide
Afficher la suite 

Votre réponse

16 réponses

Meilleure réponse
cs_Kenavo 759 Messages postés vendredi 21 mars 2003Date d'inscription 1 octobre 2009 Dernière intervention - 30 mai 2008 à 10:24
3
Merci
Comment ça, ça ne marche pas

!










Mais si ça marche !.....






Ah aussi, je crois que la procedure CreateButton pose un problème :

  Procedure CreateButton(var Button:TBrowserButton;BtLeft,BtTop:Integer; BtCaption:String);

Sinon, quand on l'appelle :

  CreateButton(Self.fPlayBt,66,35,'P');

fPlayBt reste à nil et il devient un peu cavalier d'essayer de lui coller un évènement OnClick






Ken@vo




<hr size="2" width="100%" />



Code, Code, Codec !

Merci cs_Kenavo 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 74 internautes ce mois-ci

Commenter la réponse de cs_Kenavo
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscription 3 août 2018 Dernière intervention - 28 mai 2008 à 14:00
0
Merci
Salut,

1° tout tes évènnements :
<<
    TPlay_Event = procedure(Sender: TObject) of object;
    TStop_Event = procedure(Sender: TObject) of object;
    TMute_Event = procedure(Sender: TObject) of object;
    TWrite_Event = procedure(Sender: TObject) of object;
    TRead_Event = procedure(Sender: TObject) of object;
    TParam_Event = procedure(Sender: TObject) of object;
    TListBox_Event = procedure(Sender: TObject) of object;
>>
sont des TNotifyEvent

<<
{ Standard events }
  TNotifyEvent = procedure(Sender: TObject) of object;
>>

Et l'erreur c'est la quelle ?

parce que la tu veux affecter un TPlay_Event à un TNotifyEvent

ce qui pourrait déjà ne pas plaire à Delphi
essaye déjà de changer tout tes évents en "TNotifyEvent"

et pour finir arrête de mettre des "Self" à tout va
begin
  inherited Create(ACollection);
  fParent := ACollection.Owner As (TBrowserTracks);
  fBrowserTrack := TBrowserTrack.Create(fParent);
  fBrowserTrack.Parent := fParent;
  If Assigned(fBrowserTrack.fPlayBt) Then fBrowserTrack.fPlayBt.OnClick := fParent.fOnPlay_Event;
end;

 
@+
Cirec

<hr siz="" />
Commenter la réponse de Cirec
Utilisateur anonyme - 28 mai 2008 à 14:10
0
Merci
Merci Cirec, mais ca ne fonctionne pas .

Bon je poste le source

unit BrowserTracks;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics, StdCtrls, Dialogs;

type

  TBrowserTracks = class;
  TTracksCnt = class;

  {>>TITLE}
  TBrowserTitle = class(TGraphicControl)
  private
    fColorTitle:TColor;
    fColorSubTitle:TColor;
    fColorRectTitle:TColor;
    fTitle:String;
    fSubTitle:String;
    Procedure setColorTitle(Value:TColor);
    Procedure setColorSubTitle(Value:TColor);
    Procedure setColorRectTitle(Value:TColor);
    Procedure SetTitle(Value:String);
    Procedure SetSubTitle(Value:String);
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property ColorTitle:TColor Read fColorTitle Write SetColorTitle;
    Property ColorSubTitle:TColor Read fColorSubTitle Write SetColorSubTitle;
    Property ColorRectTitle:TColor Read fColorRectTitle Write SetColorRectTitle;
    Property Title:String Read fTitle Write SetTitle;
    Property SubTitle:String Read fSubTitle Write SetSubTitle;
  end;

  {>>BROWSERBUTTON}
  TBrowserButton = class(TGraphicControl)
  private
    fColorLine:TColor;
    fColorTop:TColor;
    fColorBottom:TColor;
    fClicked:Boolean;
    fCaption:String;
    Procedure SetColorLine(Value:TColor);
    Procedure SetColorTop(Value:TColor);
    Procedure SetColorBottom(Value:TColor);
    Procedure SetCaption(Value:String);
    Procedure DrawBorder;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;    
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;   
  published
    Property ColorLine:TColor Read fColorLine Write SetColorLine;
    Property ColorTop:TColor Read fColorTop Write SetColorTop;
    Property ColorBottom:TColor Read fColorBottom Write SetColorBottom;   
    Property Tag;
    Property Enabled;
    Property OnMouseDown;
    Property OnMouseMove;
    Property OnMouseUp;
    Property OnClick;   
    Property OnDblClick;
    Property Caption : String Read fCaption Write SetCaption;
    Property Font;
  end;

  {>>BROWSERTRACK}
  TTrackType=(TtMidi,TtWav);
  TBrowserTrack = class(TCustomControl)
  private
    fTypeTrack:TTrackType;
    fTracks:TStringList;
    fIndex:Integer;
    fActive:Boolean;
    fListBox:TListBox;
    fPlayBt:TBrowserButton;
    fStopBt:TBrowserButton;
    fMuteBt:TBrowserButton;
    fWriteBt:TBrowserButton;
    fReadBt:TBrowserButton;
    fParamBt:TBrowserButton;
    Procedure SetTypeTrack(Value:TTrackType);
    Procedure SetTracks(Value:TStringList);
    Procedure SetIndex(Value:Integer);
    Procedure SetActive(Value:Boolean);
    Procedure DrawTypeArea;
    Procedure DrawTypeLogo;
    Procedure DrawCircle(X,Y,Width,Height:Integer);
    Procedure CreateButton(Button:TBrowserButton;BtLeft,BtTop:Integer; BtCaption:String);
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property TypeTrack:TTrackType Read fTypeTrack Write SetTypeTrack;
    Property Tracks:TStringList Read fTracks Write SetTracks;
    Property Index:Integer Read fIndex Write SetIndex;
    Property Active:Boolean Read fActive Write SetActive;
  end;

  {>>TRACKS} 
  TTracks=class(TCollectionItem)
  protected
    fParent:TBrowserTracks;
    fBrowserTrack:TBrowserTrack;
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
    Property Parent:TBrowserTracks Read fParent Write fParent;     
  Published
    Property BrowserTrack:TBrowserTrack Read fBrowserTrack Write fBrowserTrack;
  end;

  {>>TRACKSCNT}
  TTracksCnt = class(TOwnedCollection)
  protected
    fParent:TBrowserTracks;
    function GetItem(Index: integer): TTracks;
    procedure SetItem(Index: integer; Value: TTracks);
  public
    ItemIndex:Integer;
    constructor Create(AOwner: TBrowserTracks);
    function Add: TTracks;
    property Items[Index: integer]: TTracks Read GetItem Write SetItem;
  end;

  {EVENEMENTS}
    TPlay_Event = procedure(Sender: TObject) of object;
    TStop_Event = procedure(Sender: TObject) of object;
    TMute_Event     = procedure(Sender: TObject) of object;
    TWrite_Event = procedure(Sender: TObject) of object;
    TRead_Event = procedure(Sender: TObject) of object;
    TParam_Event = procedure(Sender: TObject) of object;
    TListBox_Event = procedure(Sender: TObject) of object;

  {>>BROWSERTRACKS} 
  TBrowserTracks = class(TCustomControl)
  private
    fBrowserTitle:TBrowserTitle;
    fTracksCnt:TTracksCnt;
    fOnPlay_Event: TNotifyEvent;
    fOnStop_Event: TNotifyEvent;
    fOnMute_Event: TNotifyEvent;
    fOnWrite_Event: TNotifyEvent;
    fOnRead_Event:  TNotifyEvent;
    fOnParam_Event:  TNotifyEvent;
    fOnListBox_Event: TNotifyEvent;
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property BrowserTitle:TBrowserTitle Read fBrowserTitle Write fBrowserTitle;
    Property TracksCnt:TTracksCnt Read fTracksCnt Write fTracksCnt;
    property Play_Event: TNotifyEvent Read fOnPlay_Event Write fOnPlay_Event;
    property Stop_Event: TNotifyEvent Read fOnStop_Event Write fOnStop_Event;
    property Mute_Event: TNotifyEvent Read fOnMute_Event Write fOnMute_Event;
    property Write_Event: TNotifyEvent Read fOnWrite_Event Write fOnWrite_Event;
    property Read_Event: TNotifyEvent Read fOnRead_Event Write fOnRead_Event;
    property Param_Event: TNotifyEvent Read fOnParam_Event Write fOnParam_Event;
    property ListBox_Event: TNotifyEvent Read fOnListBox_Event Write fOnListBox_Event;
    Property OnMouseDown;
    Property OnMouseMove;
    Property OnMouseUp;
    Property OnClick;
    Property OnDblClick;   
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TBrowserTracks]);
end;

{>>TITLE}
constructor TBrowserTitle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Self.fColorRectTitle:=$00935F42;
  Self.Title:='MUSIC PRO';
  Self.fColorTitle:=$00C5C5C5;
  Self.SubTitle:='Browser';
  Self.fColorSubTitle:=$0000BB00;
end;

destructor TBrowserTitle.Destroy;
begin
  inherited;
end;

Procedure TBrowserTitle.setColorTitle(Value:TColor);
Begin
  self.fColorTitle:=Value;
  self.Invalidate;
End;

Procedure TBrowserTitle.setColorSubTitle(Value:TColor);
Begin
  self.fColorSubTitle:=Value;
  self.Invalidate;
End;

Procedure TBrowserTitle.setColorRectTitle(Value:TColor);
Begin
  self.fColorRectTitle:=Value;
  self.Invalidate;
End;

Procedure TBrowserTitle.SetTitle(Value:String);
Begin
  self.fTitle:=Value;
  self.Invalidate;
End;

Procedure TBrowserTitle.SetSubTitle(Value:String);
Begin
  self.fSubTitle:=Value;
  self.Invalidate;
End;

procedure TBrowserTitle.Resize;
Begin
  self.Width:=209;
  If Self.Height<49 Then
  Self.Height:=49;
  self.Invalidate;
End;

procedure TBrowserTitle.Paint;
Var
  RectTitle:TRect;
  WidthString,HeightString,LeftString,TopString:Integer;
Begin
  InHerited;
  With Self.Canvas Do
    Begin
      Brush.Style:=BsClear;
      With RectTitle Do
        Begin
          Left:=0;
          Right:=Self.Width;
          Top:=0;
          Bottom:=49;
          Brush.Color:=Self.fColorRectTitle;
          Pen.Color:=ClBlack;
          Pen.Width:=4;
          Rectangle(RectTitle);

          Font.Name:='ARIAL';
          Font.Size:=16;
          Font.Color:=Self.fColorTitle;
          LeftString:=Round(0.05*Self.Width);
          TopString:=Pen.Width;
          TextOut(LeftString,TopString,Self.fTitle);

          Font.Name:='Comic Sans MS';
          Font.Size:=13;
          Font.Color:=Self.fColorSubTitle;
          WidthString:=TextWidth(Self.fSubTitle);
          HeightString:=TextHeight(Self.fSubTitle);
          LeftString:=Self.Width-WidthString-10;
          TopString:=Bottom-Pen.Width-HeightString;
          TextOut(LeftString,TopString,Self.fSubTitle);
        End;
    End 
End;

{>>BROWSERBUTTON}
constructor TBrowserButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fClicked:=False;
end;

destructor TBrowserButton.Destroy;
begin
  inherited;
end;

Procedure TBrowserButton.SetColorLine(Value:TColor);
begin
  Self.fColorLine:=Value;
  Self.Invalidate;
end;

Procedure TBrowserButton.SetColorTop(Value:TColor);
begin
  Self.fColorTop:=Value;
  Self.Invalidate;
end;

Procedure TBrowserButton.SetColorBottom(Value:TColor);
begin
  Self.fColorBottom:=Value;
  Self.Invalidate;
end;

Procedure TBrowserButton.SetCaption(Value:String);
begin
  Self.fCaption:=Value;
  Self.Invalidate;
end;

procedure TBrowserButton.Paint;
Var
  RectTop,RectBottom : TRect;
  HeightCaption, WidthCaption:Integer;
Begin
  InHerited;
  DrawBorder;
  With Self.Canvas Do
    Begin
          Font:=Self.Font;
      With RectTop Do
        Begin
          Top:=6;
          Bottom:=Self.Height Div 2 ;
          Left:=6;
          Right:=Self.Width-6;
              Brush.Color:=Self.fColorTop;
                  Pen.Color:=Self.fColorTop;
          Rectangle(RectTop);
        End;
      With RectBottom Do
        Begin
          Top:=Self.Height Div 2;
          Bottom:=Self.Height-6;
          Left:=6;
          Right:=Self.Width-6;
              Brush.Color:=Self.fColorBottom;
                  Pen.Color:=Self.fColorBottom;
          Rectangle(RectBottom );
        End;
      Brush.Color:=Self.fColorLine;
      Pen.Color:=Self.fColorLine;
          Pen.Width:=2;
      MoveTo(5,Self.Height Div 2);
      LineTo(Self.Width-7,Self.Height Div 2);
          HeightCaption:=Self.Canvas.TextHeight(Self.Caption);
          WidthCaption:=Self.Canvas.TextWidth(Self.Caption);
          Brush.Style:=BsClear;
          TextOut((Self.Width - WidthCaption) Div 2,(Self.Height - HeightCaption) Div 2, Self.Caption);
    End;
End;

Procedure TBrowserButton.DrawBorder;
Var
  LeftColor, RightColor:TColor;
  UpperCorner,LowerCorner:Array [0..2] Of TPoint;
Begin
  If Not fClicked Then
    Begin
      LeftColor:=ClWhite;
      RightColor:=$00657271;
    End
  Else
    Begin
      LeftColor:=$00657271;
      RightColor:=ClWhite;
    End;
  With Self.Canvas Do
    Begin
      Pen.Width:=2;
      UpperCorner[0]:=Point(Pen.Width,Self.Height-Pen.Width);
      UpperCorner[1]:=Point(Pen.Width,Pen.Width);
      UpperCorner[2]:=Point(Self.Width-Pen.Width,Pen.Width);
      LowerCorner[0]:=Point(Pen.Width,Self.Height-Pen.Width);
      LowerCorner[1]:=Point(Self.Width-Pen.Width,Self.Height-Pen.Width);
      LowerCorner[2]:=Point(Self.Width-Pen.Width,Pen.Width);
      Brush.Color:=LeftColor;
      Pen.Color:=LeftColor;
      Polyline(UpperCorner);
      Brush.Color:=RightColor;
      Pen.Color:=RightColor;
      Polyline(LowerCorner);
    End;  
End;

procedure TBrowserButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
Begin
  InHerited;
  If Shift=[SSLeft] Then
    Begin
      Self.fClicked:= True;
      Self.Invalidate;
    End; 
End;

procedure TBrowserButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
Begin
  InHerited;
   Self.fClicked:= False;
   Self.Invalidate;
End;

{>>BROWSERTRACK}
constructor TBrowserTrack.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fTracks:=TStringList.Create;
  fListBox:=TListBox.Create(Self);
  With fListBox Do
    Begin
      Parent:=Self;
      Width:=112;
      Height:=26;
      Left:=94;
      Top:=2;
      Color:=ClBlack;
      Font.Color:=ClWhite;
      Font.Size:=13;
    End;
  Self.Index:=0;
  Self.fTypeTrack:=TtMidi;
  CreateButton(Self.fPlayBt,66,35,'P');
  CreateButton(Self.fStopBt,94,35,'S');
  CreateButton(Self.fMuteBt,122,35,'M');
  CreateButton(Self.fReadBt,150,35,'R');
  CreateButton(Self.fWriteBt,178,35,'W');
  CreateButton(Self.fParamBt,66,0,'B');
end;

Procedure TBrowserTrack.CreateButton(Button:TBrowserButton;BtLeft,BtTop:Integer; BtCaption:String);
Begin
  Button:=TBrowserButton.Create(Self);
  With Button Do
    Begin
      Parent:=Self;
      Width:=28;
      Height:=28;
      Left:=BtLeft;
      Top:=BtTop;
      Caption:=BtCaption;
      Font.Size:=14;
      Font.Style:=[FsBold];
      Button.ColorTop:=$00FFE6E1;
      Button.ColorBottom:=$00E8E8E8;
      Button.ColorLine:=$0041C9D3;
    End; 
End;

destructor TBrowserTrack.Destroy;
begin
  fTracks.Free;
  fListBox.Free;
  fPlayBt.Free;
  fStopBt.Free;
  fMuteBt.Free;
  fWriteBt.Free;
  fReadBt.Free;
  fParamBt.Free;
  inherited;
end;

procedure TBrowserTrack.Resize;
Begin
  self.Width:=209;
  Self.Height:=65;
  self.Invalidate;
End;

Procedure TBrowserTrack.SetTypeTrack(Value:TTrackType);
Begin
  fTypeTrack:=Value;
  self.Invalidate;
End;

Procedure TBrowserTrack.SetTracks(Value:TStringList);
Begin
  self.fTracks:=Value;
  Self.fListBox.Items.Assign(Value);
  self.Invalidate;
End;

Procedure TBrowserTrack.SetIndex(Value:Integer);
Begin
  self.fIndex:=Value;
  self.Invalidate;
End;

Procedure TBrowserTrack.SetActive(Value:Boolean);
Begin
  self.fActive:=Value;
  self.Invalidate;
End;

Procedure TBrowserTrack.DrawTypeArea;
Var
  RectType:TRect;
Begin
  With Self.Canvas Do
  With RectType Do
    Begin
      Left:=0;
      Right:=65;
      Top:=0;
      Bottom:=Self.Height;
      Pen.Color:=ClBlack;
      Pen.Width:=1;
      If Self.fTypeTrack=TtMidi Then
      Brush.Color:=$0096E1FA Else
      Brush.Color:=$00ADAE93;
      Rectangle(RectType);
    End;         
End;

Procedure TBrowserTrack.DrawCircle(X,Y,Width,Height:Integer);
Var
  EllipseRect:TRect;
Begin
  With self.Canvas Do
  With EllipseRect Do
    Begin
      Pen.Width:=1;
      Pen.Color:=ClBlack;
      Pen.Width:=1;
      Left:=X-Width Div 2;
      Right:=X+Width Div 2;
      Top:=Y-Height Div 2;
      Bottom:=Y+Height Div 2;
      Ellipse(EllipseRect);
    End;
End;

Procedure TBrowserTrack.DrawTypeLogo;
Const
  WavLogo='WAV';
Var
  Index,LeftLetter,TopLetter:Cardinal;
Begin
  With Self.Canvas Do
    Begin
      If Self.fTypeTrack=TtMidi Then
        Begin
          DrawCircle(23,23,35,35);
          Brush.Color:=ClBlack;
          DrawCircle(23,13,4,4);
          DrawCircle(13,23,4,4);
          DrawCircle(33,23,4,4);
          DrawCircle(15,16,4,4);
          DrawCircle(31,16,4,4);
        End
      Else
        Begin
          Brush.Style:=BsClear;
          Font.Size:=14;
          LeftLetter:=8;
          TopLetter:=20;
          For Index:=1 To 3 Do
            Begin
              LeftLetter:=LeftLetter+20*(Index-1);
              If Index=3 Then LeftLetter:=LeftLetter-25;
              TopLetter:=TopLetter-5*(Index-1);
              If Index=3 Then TopLetter:=TopLetter+5;
              TextOut(LeftLetter,TopLetter,WavLogo[index]);
            End;
        End;
      If Self.fActive Then
     Brush.Color:=ClLime
     Else Brush.Color:=ClRed;
     DrawCircle(23,55,10,10);
     Brush.Style:=BsClear;
     TextOut(60-TextWidth(IntToStr(Self.Index)),40-TextHeight(IntToStr(Self.Index)) Div 2,IntToStr(Self.Index));
    End;
End;

procedure TBrowserTrack.Paint;
Var
  Index:Cardinal;
Begin
  With Self.Canvas Do
    Begin
      Pen.Color:=ClBlack;
      Brush.Color:=$00C9CAB7;
      Rectangle(Self.ClientRect);
      DrawTypeArea;
      Pen.Color:=ClWhite;
      For Index:=1 To Self.Height Do
      If Index Mod 5 = 0  Then
        Begin
          MoveTo(Pen.Width,Index);
          LineTo(65-Pen.Width,Index);
          MoveTo(65,Index);
          LineTo(Self.Width-Pen.Width,Index);
        End;
      DrawTypeLogo;
    End;
End;

{>>TRACKS}
constructor TTracks.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  Self.fParent:=ACollection.Owner As (TBrowserTracks);
  Self.fBrowserTrack:=TBrowserTrack.Create(Self.fParent);
  Self.fBrowserTrack.Parent:=Self.fParent;
  If Assigned(fBrowserTrack.fPlayBt) Then fBrowserTrack.fPlayBt.OnClick:=fParent.fOnPlay_Event;
end;

destructor TTracks.Destroy;
begin
  Self.fBrowserTrack.Free;
  inherited Destroy;
end;

{>>TRACKSCNT}
constructor TTracksCnt.Create(AOwner: TBrowserTracks);
begin
  inherited Create(AOwner,TTracks);
  Self.fParent:=AOwner;
end;

function TTracksCnt.Add:TTracks;
begin
  Result := TTracks(inherited Add);
end;

function TTracksCnt.GetItem(Index: integer):TTracks;
begin
  Result := TTracks(inherited Items[Index]);
end;

procedure TTracksCnt.SetItem(Index: integer; Value:TTracks);
begin
  inherited SetItem(Index, Value);
end;               

{>>BROWSERTRACKS}
constructor TBrowserTracks.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fBrowserTitle:=TBrowserTitle.Create(Self);
  With fBrowserTitle Do
    Begin
      Parent:=Self;
      Top:=0;
      Left:=0;
      Width:=209;
      Height:=49;
    End;
  fTracksCnt:=TTracksCnt.Create(Self);
  fOnPlay_Event:=nil;
  fOnStop_Event:=nil;
  fOnMute_Event:=nil;
  fOnWrite_Event:=nil;
  fOnRead_Event:=nil;
  fOnParam_Event:=nil;
  fOnListBox_Event:=nil;
end;

destructor TBrowserTracks.Destroy;
begin
  Self.fTracksCnt.Free;
  fBrowserTitle.Free;
  inherited;
end;

procedure TBrowserTracks.Resize;
begin
  inherited;
  Self.Width:=209;
  If Self.fTracksCnt.Count<=0 Then
  Self.Height:=49;
end;

procedure TBrowserTracks.Paint;
Var
  IndexTracks:Integer;
begin
  inherited;
  If Self.fTracksCnt.Count>0 Then
    Begin
      For IndexTracks:=0 To Self.fTracksCnt.Count-1 Do
      With Self.fTracksCnt.Items[IndexTracks].fBrowserTrack Do
      Top:=49+IndexTracks*65;
      Self.Height:=49+Self.fTracksCnt.Count*65;
    End; 
end;

end.
Commenter la réponse de Utilisateur anonyme
florenth 1105 Messages postés dimanche 1 août 2004Date d'inscription 17 août 2008 Dernière intervention - 28 mai 2008 à 15:51
0
Merci
Ahhh, compliqué !!
Comme le dit Cirec, arrête avec tes "self." c'est super lourd à lire.
Et on dit des maux de tête, pas de mals... !!

Bref, passons aux choses sérieuses :

-----
fTracksCnt:=TTracksCnt.Create(Self);
fOnPlay_Event:=nil;
fOnStop_Event:=nil;
fOnMute_Event:=nil;
fOnWrite_Event:=nil;
fOnRead_Event:=nil;
fOnParam_Event:=nil;
fOnListBox_Event:=nil;
-----

et puis

-----
If Assigned(fBrowserTrack.fPlayBt) Then fBrowserTrack.fPlayBt.OnClick:=fParent.fOnPlay_Event;
-----

Si tu ne donnes pas une valeur autre que "nil" à fOnPlay_Event AVANT de créer des TTracks alors ça ne marchera pas.
Le fait de changer fOnPlay_Event APRES la création des TTracks n'influence pas la valeur du OnClick de tes boutons.

Alors... ça parait logique ou pas ?
Commenter la réponse de florenth
Utilisateur anonyme - 28 mai 2008 à 16:00
0
Merci
Salut Flo,

J'ai mis les Event à Nil car c'est spécifié ainsi dans le tuto de GrandVizir .
Logique oui mais si tu supprimes les  fOnPlay_Event:=nil et compagnie ca résoud pas le blem quand meme.
Commenter la réponse de Utilisateur anonyme
Caribensila 2684 Messages postés jeudi 15 janvier 2004Date d'inscription 26 juillet 2018 Dernière intervention - 28 mai 2008 à 16:24
0
Merci
Salut,

Les "self"... C'est p'têt parce que Francky est un self-made-man, non?

Bon, je sors...
Commenter la réponse de Caribensila
florenth 1105 Messages postés dimanche 1 août 2004Date d'inscription 17 août 2008 Dernière intervention - 28 mai 2008 à 18:44
0
Merci
Ok pour les self version Cari mais pour les "nil" c'est normal que ça ne change rien.
Il faudrait mettre fOnPlay_Event := MaProc avec MaProc qui est une procéure qui existe bel et bien et ce, AVANT de créer tes TTracks.

Sinon, lorsque tu fais "fBrowserTrack.fPlayBt.OnClick:=fParent.fOnPlay_Event;"
comme fParent.fOnPlay_Event nil, alors fBrowserTrack.fPlayBt.OnClick nil donc ça ne fait rien lors du clic sur le bouton !!!!
Commenter la réponse de florenth
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 29 mai 2008 à 02:00
0
Merci
Et dire que je vais devoir optimiser tout ça aprés ...

<hr size="2" width="100%" />
Commenter la réponse de f0xi
Utilisateur anonyme - 29 mai 2008 à 10:05
0
Merci
@f0xi : Et encore ce n'est que la partie composant lol
Commenter la réponse de Utilisateur anonyme
cs_Kenavo 759 Messages postés vendredi 21 mars 2003Date d'inscription 1 octobre 2009 Dernière intervention - 29 mai 2008 à 12:05
0
Merci
A mon avis il te faut un méchanisme du genre :

  TBrowserTracks = class(TCustomControl)
  private
    fBrowserTitle:TBrowserTitle;
    fOnPlay_Event: TNotifyEvent;
    fOnStop_Event: TNotifyEvent;
    fOnMute_Event: TNotifyEvent;
    fOnWrite_Event: TNotifyEvent;
    fOnRead_Event:  TNotifyEvent;
    fOnParam_Event:  TNotifyEvent;
    fOnListBox_Event: TNotifyEvent;
    fTracksCnt:TTracksCnt;
    procedure SetOnPlay_Event(Event : TNotifyEvent);
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property BrowserTitle:TBrowserTitle Read fBrowserTitle Write fBrowserTitle;
    Property TracksCnt:TTracksCnt Read fTracksCnt Write fTracksCnt;
    property Play_Event: TNotifyEvent Read fOnPlay_Event Write SetOnPlay_Event ;
    property Stop_Event: TNotifyEvent Read fOnStop_Event Write fOnStop_Event;
    property Mute_Event: TNotifyEvent Read fOnMute_Event Write fOnMute_Event;
    property Write_Event: TNotifyEvent Read fOnWrite_Event Write fOnWrite_Event;
    property Read_Event: TNotifyEvent Read fOnRead_Event Write fOnRead_Event;
    property Param_Event: TNotifyEvent Read fOnParam_Event Write fOnParam_Event;
    property ListBox_Event: TNotifyEvent Read fOnListBox_Event Write fOnListBox_Event;
    Property OnMouseDown;
    Property OnMouseMove;
    Property OnMouseUp;
    Property OnClick;
    Property OnDblClick;  
  end;

....

procedure TBrowserTracks.SetOnPlay_Event(Event : TNotifyEvent);
begin
    fOnPlay_Event : = Event;

    ....fPlayBt.OnClick:= fOnPlay_Event;
    // J'ai pas suivi le chemin entre







TBrowserTracks et







fPlayBt










end;




Ken@vo



<hr size ="2" width="100%" />



Code, Code, Codec !
Commenter la réponse de cs_Kenavo
Cirec 4231 Messages postés vendredi 23 juillet 2004Date d'inscription 3 août 2018 Dernière intervention - 29 mai 2008 à 12:16
0
Merci
"Et dire que je vais devoir optimiser tout ça aprés ..."
Mouahahahaha ...
en même temps tu fais ça tellement bien
 
@+
Cirec

<hr siz="" />
Commenter la réponse de Cirec
Utilisateur anonyme - 29 mai 2008 à 16:08
0
Merci
Ne t'inquète pas f0xi, je laisse les parties dll pour Cirec : Mouahahahaha .

Kénavo : j'ai essayé mais ca ne règle pas mon probleme. Merci quand meme
Commenter la réponse de Utilisateur anonyme
florenth 1105 Messages postés dimanche 1 août 2004Date d'inscription 17 août 2008 Dernière intervention - 29 mai 2008 à 18:47
0
Merci
Je réponds ici à ton MP:
"Tu dis que je dois utiliser fOnPlay_Event := MaProc
Mais MaProc est une fonction que je ne peux pas définir à l'avance ;) et je me vois mal mettre une fonction qui sert à rien.

Concrètement je dois faire quoi ?"

Ah, c'est bien ce que je pensais !

Dans ce cas, il faudra, lorsque tu connaitras MaProc, dire à tous les boutons que c'est vers elle qu'il faut pointer leur OnClick.

Pour cela, tu peux faire une procédure qui parcours les boutons et qui renseigne leur évènement Onclick avec MaProc.
Une boucle quoi.
Commenter la réponse de florenth
Utilisateur anonyme - 29 mai 2008 à 19:31
0
Merci
C'est une option que j'avais mis de coté : Mais ca fait pas tres propre.

Bon je vais encore regarder la chose

Merci
Commenter la réponse de Utilisateur anonyme
florenth 1105 Messages postés dimanche 1 août 2004Date d'inscription 17 août 2008 Dernière intervention - 29 mai 2008 à 20:24
0
Merci
Bah, pas grave si c'est pas super propre, y'a f0xi qui nettoie derrière !!!

Sérieusement, tu peux aussi faire pointer OnClick vers une procédure qui se chargera de rediriger vers la "vraie" procédure une fois qu'elle sera connue.
Mais suivant les cas, ça risque d'être chaud à implementer.
Commenter la réponse de florenth
Utilisateur anonyme - 30 mai 2008 à 11:12
0
Merci
Ta raison c'est le var qui faisait toute la différence : Quel boulet que je fais .

Merci à tous , Merci Kenavo
Commenter la réponse de Utilisateur anonyme

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.