Composant : Affectation d'un évènement à un autre
Résolu16 réponses
cs_Kenavo
Messages postés
702
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
1 octobre 2009
5
30 mai 2008 à 10:24
30 mai 2008 à 10:24
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 !
!
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 !
Cirec
Messages postés
3833
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2022
50
28 mai 2008 à 14:00
28 mai 2008 à 14:00
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="" />
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="" />
Utilisateur anonyme
28 mai 2008 à 14:10
28 mai 2008 à 14:10
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.
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.
florenth
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
3
28 mai 2008 à 15:51
28 mai 2008 à 15:51
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 ?
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 ?
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Utilisateur anonyme
28 mai 2008 à 16:00
28 mai 2008 à 16:00
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.
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.
Caribensila
Messages postés
2527
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
16 octobre 2019
18
28 mai 2008 à 16:24
28 mai 2008 à 16:24
Salut,
Les "self"... C'est p'têt parce que Francky est un self-made-man, non?
Bon, je sors...
Les "self"... C'est p'têt parce que Francky est un self-made-man, non?
Bon, je sors...
florenth
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
3
28 mai 2008 à 18:44
28 mai 2008 à 18:44
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 !!!!
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 !!!!
f0xi
Messages postés
4205
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
12 mars 2022
35
29 mai 2008 à 02:00
29 mai 2008 à 02:00
Et dire que je vais devoir optimiser tout ça aprés ...
<hr size="2" width="100%" />
<hr size="2" width="100%" />
cs_Kenavo
Messages postés
702
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
1 octobre 2009
5
29 mai 2008 à 12:05
29 mai 2008 à 12:05
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 !
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 !
Cirec
Messages postés
3833
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2022
50
29 mai 2008 à 12:16
29 mai 2008 à 12:16
"Et dire que je vais devoir optimiser tout ça aprés ..."
Mouahahahaha ...
en même temps tu fais ça tellement bien
@+
Cirec
<hr siz="" />
Mouahahahaha ...
en même temps tu fais ça tellement bien
@+
Cirec
<hr siz="" />
Utilisateur anonyme
29 mai 2008 à 16:08
29 mai 2008 à 16:08
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
Kénavo : j'ai essayé mais ca ne règle pas mon probleme. Merci quand meme
florenth
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
3
29 mai 2008 à 18:47
29 mai 2008 à 18:47
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.
"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.
Utilisateur anonyme
29 mai 2008 à 19:31
29 mai 2008 à 19:31
C'est une option que j'avais mis de coté : Mais ca fait pas tres propre.
Bon je vais encore regarder la chose
Merci
Bon je vais encore regarder la chose
Merci
florenth
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
3
29 mai 2008 à 20:24
29 mai 2008 à 20:24
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.
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.
Utilisateur anonyme
30 mai 2008 à 11:12
30 mai 2008 à 11:12
Ta raison c'est le var qui faisait toute la différence : Quel boulet que je fais .
Merci à tous , Merci Kenavo
Merci à tous , Merci Kenavo
