DESSINER UNE COURBE SONORE

Commentaire de f0xi le 08/06/2006 12:19:42 administrateur CS

hey! amazing!


pas mal du tout, amusant meme, on dirait un vieux generateur de son bien pourris de l'epoque et donc vachement cool! (vraiment)

toute fois coté code, quelques petite amelioration :

on oublis pas d'indenté un peu, de passer des lignes et aussi ajouter des commentaires pour savoir de quoi il en retourne.

procedure TForm1.FormCreate(Sender: TObject);
begin
  markers := tdragpos.Create(self);
  with Markers do begin
     ParentWindow   := form1.Handle;
     Width          := 792;
     Height         := 380;
     startpos       := maxword div 2;
     EndPos         := maxword div 2;
     ArrayLength    := 820;
     DoubleBuffered := true;
  end;

  sound := soundgen.create;
  sound.start;
  //sound.vo:=true;

  form1.Caption := inttostr(maxword div 2);

  markers.ArrayLength := trackbar1.Position;
  sound.vfreq         := trackbar2.Position/100;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  sound.stop;
  sound.free;
  markers.free;
end;

function getgoodstr(const bar : byte; const val : integer) : string;
begin
    { format permet de supprimer pas mal de code inutile et donc d'eviter des cycles d'horloge
      tout aussi inutile }
    case bar of
       0: result := format('%.4d',[val]);
       1: result := format('%.6d',[val]);
       else
          result := format('%d',[val]);
    end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  markers.ArrayLength := trackbar1.Position;
  maskedit1.Text      := getgoodstr(0,trackbar1.position);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  markers.clear;
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
  sound.vfreq    := trackbar2.Position/100;
  maskedit2.Text := getgoodstr(1,trackbar2.Position);
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  sound.vo := checkbox1.Checked;
end;

procedure TForm1.MaskEdit1Change(Sender: TObject);
begin
  { StrToIntDef permet d'eviter les erreurs de saisie }
  trackbar1.Position := StrToIntDef(maskedit1.Text,TrackBar1.Position);
end;

procedure TForm1.MaskEdit2Change(Sender: TObject);
begin
  trackbar2.Position := StrToIntDef(maskedit2.Text,TrackBar2.Position);
end;



petite amelioration aussi dans la classe TDragPos :

  TDragPos = class(tpanel)
  private
    //++
    fGridBitmap : TBitmap;
    procedure DoGridPaint;
    //++
  protected
  public
  published
  end;

// dessine une grille
procedure TDragPos.DoGridPaint;
var IcrH,IcrW,N : integer;
begin
  fGridBitmap.Width := Self.Width;
  fGridBitmap.Height:= Self.Height;
  with fGridBitmap.Canvas do begin
       Brush.Color := $706060;
       FillRect(Rect(0,0,width,height));

       IcrH := Self.Height div 4;
       IcrW := Self.Width  div 8;

       Pen.Color := $c0c0c0;
       for N := 1 to 4 do begin
           MoveTo(0,N*IcrH);
           LineTo(Self.Width,N*IcrH);
       end;
       for N := 1 to 8 do begin
           MoveTo(N*IcrW,0);
           LineTo(N*IcrW,Self.Height);
       end;
  end;
end;

// dessin de la vue de l'enveloppe
procedure TDragPos.Paint;
var i,x,y : integer;
    Buffer: Tbitmap; // buffer de dessin
begin
  // creation du buffer
  Buffer := TBitmap.Create;
  Buffer.Width := width;
  Buffer.Height:= Height;
  Buffer.PixelFormat:= pf24bit;

  with Buffer.canvas do begin
       // on dessine la grille
       Draw(0,0,fGridBitmap);

       if list.Count <> 0 then begin
          for i := 0 to list.count-1 do begin
              Pen.Color:=$0a0aff;
              amarker := list.Items[i];
              x       := amarker^.cxpos;
              y       := amarker^.cypos;
              // ellipse, plus rapide que Arc.
              Ellipse(x-4,y-4,x+4,y+4);

              Pen.Color:=$00FF00;
              if i = 0 then
                 MoveTo(x,y)
              else
                 LineTo(x,y);
          end;
       end;
  end;
  // on dessine dans le canvas de TDragPos
  Canvas.Draw(0,0,Buffer);
  // on libere le buffer
  Buffer.Free;
end;

constructor TDragPos.Create(aOwner:TComponent);
begin
   // ++
    // creation de la grille
    fGridBitmap := TBitmap.Create;
    with fGridBitmap do begin
         width := self.Width;
         height:= self.Height;
         PixelFormat := pf24bit;
    end;
    // dessin de la grille (on ne redessineras pas a chaque fois)
    DoGridPaint;
   // ++
end;

destructor tdragpos.destroy;
begin
   // ++
    // liberation de la grille
    fGridBitmap.Free;
   // ++
end;

Commentaire de ralebol le 08/06/2006 21:13:56

1000 * Merci,
Je suis super content de conaitre la fonction 'format()' c'est une revolution pour moi, je me disait bien qu'il devait y avoir un moyen plus simple et moins sougrenu.
Je pence que pas mal de mes applis subiront des modification;
Cella faisais assez longtemp que je gardais cette appli au fond de mon disque,(depuis je manque d'inspiration).
D'appré mes souvenirs, le composant s'installe mais lorsque je la depose sur la fiche ya plein de messages d'ereurs et il ne s'affiche pas bien.

Commentaire de ralebol le 10/06/2006 13:48:36

Merci, c'est cool.

mais un petit detail me gene :

procedure TDragPos.Paint;
var i,x,y : integer;
    Buffer: Tbitmap; // buffer de dessin
begin
  // creation du buffer
  Buffer := TBitmap.Create;
  Buffer.Width := width;
  Buffer.Height:= Height;
  Buffer.PixelFormat:= pf24bit;

  with Buffer.canvas do begin
       // on dessine la grille
       Draw(0,0,fGridBitmap);

       if list.Count <> 0 then begin
          for i := 0 to list.count-1 do begin
              Pen.Color:=$0a0aff;
              amarker := list.Items[i];
              x       := amarker^.cxpos;
              y       := amarker^.cypos;
              // ellipse, plus rapide que Arc.
              Ellipse(x-4,y-4,x+4,y+4);

              Pen.Color:=$00FF00;
              if i = 0 then
                 MoveTo(x,y)
              else
                 LineTo(x,y);
          end;
       end;
  end;

J'ai remarqué que le fait de déssiné sur un bitmap puit de l'appliqué sur le panel provoquait un ralentisement de l'apli. L'orsque je deplacais un trackbar je constate que le maskedit corespondant prenait plus de temp pour affiché la nouvelle valeur.

Sinon la grille est vraiment une bonne ideé (c'est presque nécesaire).