Problème de control dans un composant hérité de TScrollBoxRésolu

Question

Salut à tous,

Je suis entrain de réaliser un composant. J'ai fais des tests préalable et au moment de son élaboration voila que je suis confronté à un ' Control " has not Parent Window'. Je sens que c'est tout bête mais ca fait 3 heures que je bute sur ce machin .

Voici le code 

interface

uses
  SysUtils, Classes, Controls, Forms, Graphics;

type
  TTimeLine = class(TScrollBox)
  private
  fCanvas: TControlCanvas; //Canvas associé au composant
  fMin:Cardinal; //Valeur minimale
  fMax:Cardinal;  //Valeur maximale
  fPenColor:TColor; //Couleur du pinceau
  fColorFont:TColor; //Couleur de la font
  fFontText:TFontName; // Font du texte
  fFontSize:Cardinal; // Taille de la police
  Procedure TimeProgress; //Procédure pour dessiner la TimeLine
  Procedure SetMin(Value:Cardinal);
  Procedure SetMax(Value:Cardinal);
  Procedure SetPenColor(Value:TColor);
  Procedure SetColorFont(Value:TColor);
  Procedure SetFontText(Value:TFontName);
  Procedure SetFontSize(Value:Cardinal);
    { Private declarations }
  protected
    { Protected declarations }
  public
   constructor Create(AOwner:TComponent); override;
    { Public declarations }
  published
    Property Min: Cardinal Read fMin Write SetMin;
    Property Max: Cardinal Read fMax Write SetMax;
    Property PenColor: TColor Read fPenColor Write SetPenColor;
    Property ColorFont: TColor Read fColorFont Write SetColorFont;
    Property FontText: TFontName Read fFontText Write SetFontText ;
    Property FontSize: Cardinal Read fFontSize Write SetFontSize ;
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Music_Pro', [TTimeLine]);
end;

Procedure TTimeLine.TimeProgress;
Var
  Index,MinValue,Value:Integer;
Begin
  fcanvas:=TControlCanvas.Create; //On crée le canvas du control
  With fCanvas Do
    Begin
      Control:=Self;  //On associe le control du canvas au ScrollBox
      Pen.Color:=fPenColor; //On attribue la couleur blanche
      Pen.Width:=3; //Epaisseur du trait
      MoveTo(0,Self.Height-5); // On place le stylo à la position (0,Height-5)
      LineTo(Self.Width,Self.Height-5); // On tire un trait horizontal jusqu'au point (Width,Height-5)
      minValue:= Self.Width Div ((Self.Max-Self.Min)*20); // On détermine le pas
      For Index:=0 to Self.Width Do //Pour toutes les valeurs allant de fMin*20 jusqu'à fMax*20
        Begin
          Pen.Color:=fPenColor; //On impose la couleur du stylo
          MoveTo(MinValue*Index,Self.Height-5); //On se place au point (MinValue*Index,Self.Height-5)
          LineTo(MinValue*Index,Self.Height-30); // On trace un trait jusqu'au point (MinValue*Index,Self.Height-30)
          Value:=20*(Self.Max-Self.Min)*Index Div Width;
          If (Value Mod 20 = 0) then
            Begin
              Pen.Color:=ColorFont; // On choisit la couleur de la font
              Brush.Style:=bsClear; // On choisit le mode
              Font.Name:=FontText; // On choisit la police
              Font.Size:=FontSize; // On choisit la taille de la fonte
              TextOut(MinValue*Index,Self.Height-35,IntToStr(Value)); // On écrit la valeur de Value
            End;
        End;
    End;
End;

constructor TTimeLine.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  AutoScroll:=True; //Les ScrollBars apparaissent automatiquement quand cela est utile
  With Self Do
    Begin
      Color:=$00AE8051;//La couleur par défaut sera Gris
      Width:=750; //Longueur par défaut
      Height:=60;  //Largueur par défaut
      Min:=0; // Valeur de Min par défaut
      Max:=25; // Valeur de Max par défaut
      PenColor:=ClWhite; // Couleur par défaut du stylo
      ColorFont:=ClWhite; // Couleur du texte par défaut
      fFontText:='Arial';
    End;  
  TimeProgress;
end;

Procedure TTimeLine.SetMin(Value:Cardinal);
Begin
  If Assigned(Self) then
  fMin:=Value;
End;

Procedure TTimeLine.SetMax(Value:Cardinal);
Begin
  If Assigned(Self) then
  fMax:=Value;
End;

Procedure TTimeLine.SetPenColor(Value:TColor);
Begin
  If Assigned(Self) then
  fPenColor:=Value;
End;

Procedure TTimeLine.SetColorFont(Value:TColor);
Begin
  If Assigned(Self) then
  fColorFont:=Value;
End;

Procedure TTimeLine.SetFontText(Value:TFontName);
Begin
  If Assigned(Self) then
  fFontText:=Value;
End;

Procedure TTimeLine.SetFontSize(Value:Cardinal);
Begin
  If Assigned(Self) then
  fFontSize:=Value;
End;

Merci du coup de main 

Grrr : manque des sections dans la partie "Type de question" . On pourrait en rajouter M'Sieurs Dames  ?

f0xi · Accepted Answer

type TTimeLine = class(TScrollBox) private fAPWC : boolean; fCanvas : TControlCanvas; fMin : Cardinal; fMax : Cardinal; Procedure SetMinMax(index: integer; Value:Cardinal); function GetPen: TPen; procedure SetPen(value: TPen); function GetBrush: TBrush; procedure SetBrush(value: TBrush); procedure WMPaint(var Message: TWMPaint); message WM_PAINT; protected procedure DoFontChange(Sender: TObject); public constructor Create(AOwner:TComponent); override; destructor Destroy; override; published property Color default $AE8051; property Width default 750; property Height default 60; property Min : Cardinal index 0 Read fMin Write SetMinMax default 0; property Max : Cardinal index 1 Read fMax Write SetMinMax default 25; property Pen : TPen read GetPen write SetPen; property Brush : TBrush read GetBrush write SetBrush; end; constructor TTimeLine.Create(AOwner:TComponent); begin inherited Create(AOwner); fAPWC := assigned(AOwner) and (AOwner is TWinControl); if fAPWC then Parent := TWinControl(AOwner); DoubleBuffered := true; AutoScroll := True; VertScrollBar.Tracking := true; VertScrollBar.Smooth := true; HorzScrollBar.Visible := false; Color := $AE8051; Width := 750; Height := 60; fMin := 0; fMax := 25; fCanvas := TControlCanvas.Create; fCanvas.Control := Self; fCanvas.Pen.Color := clWhite; Font.OnChange := DoFontChange; Font.Color := clWhite; Font.Name := 'Arial'; Font.Size := 9; Font.Style := []; end; destructor TTimeLine.Destroy; begin FreeAndNil(fCanvas); inherited; end; procedure TTimeLine.WMPaint(var Message: TWMPaint); var PS: TPaintStruct; begin if not assigned(Parent) then exit; BeginPaint(Handle, PS); with fCanvas Do begin Brush.Color := self.Color; Brush.Style := bsSolid; FillRect(Self.ClientRect); { draw here } end; EndPaint(Handle, PS); end; procedure TTimeLine.SetMinMax(Index: integer; Value:Cardinal); var ptr : ^cardinal; begin case index of 0: ptr := @fMin; 1: ptr := @fMax; end; if ptr^ <> Value then begin ptr^ := Value; if fMin > fMax then fMax := fMin+25; end; end; procedure TTimeLine.DoFontChange(Sender: TObject); begin fCanvas.Font.Assign(Font); end; function TTimeLine.GetBrush: TBrush; begin result := fCanvas.Brush; end; function TTimeLine.GetPen: TPen; begin result := fCanvas.Pen; end; procedure TTimeLine.SetBrush(value: TBrush); begin fCanvas.Brush.Assign(value); end; procedure TTimeLine.SetPen(value: TPen); begin fcanvas.Pen.Assign(value); end;

http://deefaze.gnomz.com

Francky23012301 · Answer

Merci f0xi

Problème de control dans un composant hérité de TScrollBox

2 réponses

Votre réponse

Discussions similaires