AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

  • CodeS-SourceS
  • RSS CodeS-SourceS
  • CodyxBot, le Bot GTalk & MSN qu'il vous faut !
  • Générez des revenus avec vos codes, scripts et tutoriaux
  • Aide à la navigation du site
begin process at 2009 07 06 05:40:14
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

598 commentaire(s) de f0xi sur des sources sur tout CodeS-SourceS

Le : 19/06/2009 03:30:06
Source : DECOMPTEUR AVEC ENREGISTREMENT DES OPTIONS


1) pense a indenter ton code, regarde les notres, francky, cari, cirec, jlen pour voir comment organiser un code.

2) familliarise toi avec les conventions et regles d'ecriture, il y a des tutos qui en parle dans la rubrique tutoriaux.

3) if condition = true then, est une chose inutile, une condition IF est toujours booléene, donc if condition then (condition = true) ou if not condition then (condition = false).

4) creation et liberation d'instance dans une même procedure ? on encadre avec un bloc Try..Finally, de plus pour tout ce qui est IniFile ou Regitry on peut utiliser ceci :

with TIniFile.Create('fichier') do
try

  WriteString('[test]', 'Test', 'Hello World');

finally
  Free;
end;

5) relit toujours ton code au fur et a mesure, supprime l'inutile.
condition imbriquée non necessaire par exemple :
if condtion then
  if contition then
    if condition then
      FaireUnTruc
    else
      FaireUnAutreTruc;

sera remplacé par :
if (condition and condition) and condition then
  FaireUnTruc
else
  FaireUnAutreTruc;

voila et d'autre truc parci parla qui t'aideront a mieux coder.

Le : 08/06/2009 22:29:46
Source : SCAN THREAD : BASS
mettre une methode en Dynamic ou Virtual permet de la surcharger en derivant le composant de base (override).

Dynamic et Virtual on une incidence different sur les performances de la methode, c'est un peu kif kif mais different :)
lit l'aide a ce sujet (Dynamic, Virtual).

Pour l'auteur, non, le change pas :D, par contre si tu me cite dans le changelog utilise ma signature -> Deefaze (f0xi - www.delphifr.com)

voila, bonne prog.

Le : 08/06/2009 18:43:33
Source : SCAN THREAD : BASS

Petites corrections :

uMain.pas
- correction des references interne a Form1 -> Self
- Liberation des ressources en quittant l'application
- ajout du support des themes de couleurs

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,bass,uScanThread, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    btLoadSong1: TButton;
    Label2: TLabel;
    btLoadSong2: TButton;
    ColorDialog1: TColorDialog;
    panColBack: TPanel;
    panColPeak: TPanel;
    panColBorder: TPanel;
    panColLoopS: TPanel;
    panColLoopE: TPanel;
    panColPos: TPanel;
    panColText: TPanel;
    OpenDialog1: TOpenDialog;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure btLoadSong2Click(Sender: TObject);
    procedure btLoadSong1Click(Sender: TObject);
    procedure PanColorClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
  private
    fBassInit : boolean;
    chan1, chan2, chan1Decode, chan2Decode : HSTREAM;
    ScanThreadChan1, ScanThreadChan2 : TScanThread;
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
  PATH : String;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  PATH := ExtractFilePath(Application.ExeName);

  fBassInit := BASS_Init(-1,44100,0,Handle,nil);
  assert(fBassInit, 'Bass initialization failure.');

  // on charge le son 2
  panColBack.Tag   := 0;
  panColPeak.Tag   := 1;
  panColBorder.Tag := 2;
  panColLoopS.Tag  := 3;
  panColLoopE.Tag  := 4;
  panColPos.Tag    := 5;
  panColText.Tag   := 6;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if chan2 <> 0 then
  begin
    BASS_StreamFree(chan2);
    BASS_StreamFree(chan2Decode);
    ScanThreadChan2.Free;
  end;

  if chan1 <> 0 then begin
    BASS_StreamFree(chan1);
    BASS_StreamFree(chan1Decode);
    ScanThreadChan1.Free;
  end;

  if fBassInit then
    BASS_Free;
end;

procedure TForm1.btLoadSong2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    // libère les ressources
    if chan2 <> 0 then
    begin
      BASS_StreamFree(chan2);
      BASS_StreamFree(chan2Decode);
      ScanThreadChan2.Free;
    end;

    chan2 := BASS_StreamCreateFile(false,PChar(OpenDialog1.FileName),0,0,BASS_SAMPLE_LOOP);
    BASS_ChannelPlay(chan2,TRUE);

    chan2Decode := BASS_StreamCreateFile(false,PChar(OpenDialog1.FileName),0,0,BASS_STREAM_DECODE);
    ScanThreadChan2 := TScanThread.Create(Self, chan2Decode, chan2, 16, 328, 593, 241);
  end;
end;

procedure TForm1.btLoadSong1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    // libère les ressources
    if chan1 <> 0 then begin
      BASS_StreamFree(chan1);
      BASS_StreamFree(chan1Decode);
      ScanThreadChan1.Free;
    end;

    chan1 := BASS_StreamCreateFile(false,PChar(OpenDialog1.FileName),0,0,BASS_SAMPLE_LOOP);
    BASS_ChannelPlay(chan1,TRUE);
    // on créé une channel "décodé"
    chan1Decode := BASS_StreamCreateFile(false,PChar(OpenDialog1.FileName),0,0,BASS_STREAM_DECODE);
    ScanThreadChan1 := TScanThread.Create(Self, chan1Decode, chan1, 16, 72, 400, 185);
  end;
end;

procedure TForm1.PanColorClick(Sender: TObject);
var Col : integer;
begin
  if ColorDialog1.Execute then
  begin
    (Sender as TPanel).Color := ColorDialog1.Color;
    Col := (Sender as TPanel).Color;
    with ScanThreadChan1.SpectrumColor do
    begin
      case (Sender as TPanel).Tag of
        0: scBack      := Col;
        1: scPeak      := Col;
        2: scBorder    := Col;
        3: scLoopStart := Col;
        4: scLoopEnd   := Col;
        5: scPosition  := Col;
        6: scText      := Col;
      end;
    end;
  end;
end;


procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  if ComboBox1.ItemIndex <> -1 then
  begin
    case ComboBox1.ItemIndex of
      0 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeDefault);
      1 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeSilver);
      2 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeGirly);
      3 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeArmy);
      4 : ScanThreadChan1.SpectrumColor.LoadSpectrumTheme(SpectrumThemeLCD);
    end;
  end;
end;

end.

__________________________________________________

uScanThread.pas
- Transformation du type TSpectrumColor Record -> TPersistent
- ajout du type TSpectrumTheme
- ajout du support de TSpectrumTheme pour TSpectrumColor
- creation de 4 themes supplementaire
- correction des déclaration dans TScanThread
- correction d'indentation du code
- ajout de commentaires
- renomé Draw_Spectrum -> DrawSpectrum
- ajout du support TSpectrumColor dans TScanThread
- correction de la declaration du constructeur de TScanThread
- reordonnage des creations et definitions dans le constructeur de TScanThread
- reordonnage des destructions dans le destructeur de TScanThread
- correction de performances dans la methode Paint de fPaintBox
- correction de performances dans la methode DrawSpectrum


unit uScanThread ;

interface


uses
  Windows, SysUtils,
  Dialogs, Forms, Controls, StdCtrls, Classes, ExtCtrls,Graphics, bass;

type
  TSpectrumTheme = packed array[0..6] of integer;

const                               // LoopStart, LoopEnd, Position, Background, Border, Peak, Text
  SpectrumThemeDefault : TSpectrumTheme = (clBlue, clRed, clWhite, clBlack, clGray, clLime, clWhite);
  SpectrumThemeSilver  : TSpectrumTheme = (clBlue, clRed, clBlack, clGray, clBlack, clWhite, clBlack);
  SpectrumThemeGirly   : TSpectrumTheme = (clBlue, clRed, clBlack, $c080ff, clGray, $8000ff, clWhite);
  SpectrumThemeArmy    : TSpectrumTheme = (clBlue, clRed, clBlack, $7a9a90, clBlack, $2a4a40, clBlack);
  SpectrumThemeLCD     : TSpectrumTheme = ($804c46, $4c4680, $212e2c, $6a9583, $314440, $314440, $314440);

type
  TSpectrumColor = class(TPersistent)
  private
    fColors   : TSpectrumTheme;
    fOnChange : TNotifyEvent;
    procedure SetColor(const index: integer; const value: integer);
    function GetColor(const index: integer): integer;
  protected
    procedure Change; virtual;
    procedure AssignTo(Dest: TPersistent); override;
    property OnChange : TNotifyEvent read fOnChange write fOnChange;
  published
    property scLoopStart : Integer index 0 read GetColor write SetColor default clBlue;
    property scLoopEnd   : Integer index 1 read GetColor write SetColor default clRed;
    property scPosition  : Integer index 2 read GetColor write SetColor default clWhite;
    property scBack      : Integer index 3 read GetColor write SetColor default clBlack;
    property scBorder    : Integer index 4 read GetColor write SetColor default clGray;
    property scPeak      : Integer index 5 read GetColor write SetColor default clLime;
    property scText      : Integer index 6 read GetColor write SetColor default clWhite;
  public
    constructor Create;
    procedure LoadSpectrumTheme(const ColorTheme: TSpectrumTheme);
    procedure LoadFromResource(Instance: THandle; const ResName: string);
    procedure LoadFromResourceID(Instance: THandle; ResID: integer);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
  end;


type
  TScanThread = class(TThread)
  private
    fPaintBox      : TPaintBox;
    fdecoder       : DWORD;               // le canal "decode" -> GetLevel
    fChannel       : DWORD;               // le canal en cours -> Position
    fKillScan      : boolean;             // Switch de démarrage et arret du scan
    fBPP           : DWORD;               // Relation Temps/Longueur
    fWaveBufL      : array of smallint;   // Level sonore Gauche
    fWaveBufR      : array of smallint;   // Level sonore Droit
    fWidth         : integer;             // Taille en X
    fHeight        : integer;             // Taille en Y
    fBufferBitmap  : TBitmap;             // le bitmap ou on va dessiner desus
    fNbLoopSync    : DWORD;               // indice pr la procedure LoopSyncProc
    fSpectrumColor : TSpectrumColor;      // Couleur de la visualisation du spectre
    fLoopStart     : DWORD;               // Debut de la boucle
    fLoopEnd       : DWORD;               // Fin de la boucle
    fPosition      : DWORD;               // Position en cours
    fNeedRedraw    : boolean;             // Switch pour redessiner le Spectre

    procedure SetSpectrumColor(Value: TSpectrumColor);

  protected
    procedure ScanPeaks; dynamic;     // Récuperation des Levels
    procedure DrawSpectrum; dynamic;  // Dessin du spectre
    procedure ThreadProcedure;        // Procedure principale du Thread
    procedure Execute; override;      // Execution du Thread

    procedure DoSpectrumColorChange(Sender: TObject);

    // Les <> méthodes relatives au TPaintBox : Paint , onMouseDown , onMouseMove
    procedure PaintBoxPaint(Sender: TObject);
    procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

  published
    property BPP           : DWORD read fBPP;
    property LoopStart     : DWORD read fLoopStart write fLoopStart default 0;
    property LoopEnd       : DWORD read fLoopEnd   write fLoopEnd   default 0;
    property Position      : DWORD read fPosition  write fPosition  default 0;
    property SpectrumColor : TSpectrumColor  read fSpectrumColor write SetSpectrumColor;

  public
    procedure ReDraw;
    procedure ReScan;

    constructor Create(AOwner: TWinControl; const ADecoder, AChannel,
                       ALeft, ATop, AWidth, AHeight : DWORD);
    destructor Destroy;override;
  end;

procedure LoopSyncProc(handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;

var
  NbLoopSync      : DWORD = 0;
  GlobalLoopStart : array[0..1000] of DWORD;
  fLoopSync       : array[0..1000] of HSYNC;

implementation


procedure LoopSyncProc(handle: HSYNC; channel, data: DWORD; user: Pointer); stdcall;
var
  i : integer;
begin
  for i:= 0 to NbLoopSync do
    if handle = fLoopSync[i] then
      if not BASS_ChannelSetPosition(channel,GlobalLoopStart[i],BASS_POS_BYTE) then
        BASS_ChannelSetPosition(channel,0,BASS_POS_BYTE);
end;

//------------------------------------------------------------------------------

{ TScanThread }

constructor TScanThread.Create(AOwner: TWinControl; const ADecoder, AChannel,
                               ALeft, ATop, AWidth, AHeight : DWORD);
begin
  inherited Create(false);

  if NbLoopSync >= 1000 then
    NbLoopSync := 0;

  fNeedRedraw   := True;
  fNbLoopSync   := NbLoopSync;
  fLoopEnd      := 0;
  fLoopStart    := 0;
  fPosition     := 0;
  fKillScan     := false;
  GlobalLoopStart[fNbLoopSync] := fLoopStart;

  // Create internal objects
  fSpectrumColor := TSpectrumColor.Create;
  fSpectrumColor.OnChange := DoSpectrumColorChange;

  fBufferBitmap  := TBitmap.Create;
  fBufferBitmap.PixelFormat := pf32bit;

  Assert(AOwner <> nil, 'Error TScanThread.Create : AParent must not be null.');
  fPaintBox      := TPaintBox.Create(AOwner);
  // fPaintBox settings
  fPaintBox.Parent := AOwner;
  fPaintBox.Parent.DoubleBuffered := True;
  fPaintBox.SetBounds(ALeft, ATop, AWidth, AHeight);
  fPaintBox.OnPaint     := PaintBoxPaint;
  fPaintBox.OnMouseDown := PaintBoxMouseDown;
  fPaintBox.OnMouseMove := PaintBoxMouseMove;


  fWidth  := fPaintBox.Canvas.ClipRect.Right;
  fHeight := fPaintBox.Canvas.ClipRect.Bottom;

  fDecoder := ADecoder;

  fBPP := BASS_ChannelGetLength(ADecoder,BASS_POS_BYTE) div fWidth;
  if (fBPP < BASS_ChannelSeconds2Bytes(ADecoder,0.02)) then // minimum 20ms per pixel (BASS_ChannelGetLevel scans 20ms)
      fBPP := BASS_ChannelSeconds2Bytes(ADecoder,0.02);

  SetLength(fWaveBufL, fWidth);
  SetLength(fWaveBufR, fWidth);

  Priority := tpNormal;
  FreeOnTerminate := false;

  fChannel := AChannel;
  fLoopSync[fNbLoopSync]:= BASS_ChannelSetSync(fChannel,BASS_SYNC_POS or BASS_SYNC_MIXTIME,fLoopEnd,LoopSyncProc,nil);
  NbLoopSync := NbLoopSync+1;
end;

destructor TScanThread.Destroy;
begin
  fPaintBox.Free;
  fBufferBitmap.Free;
  fSpectrumColor.Free;
  inherited Destroy;
end;

procedure TScanThread.SetSpectrumColor(Value: TSpectrumColor);
begin
  Value.AssignTo(fSpectrumColor);
end;

procedure TScanThread.DoSpectrumColorChange(Sender: TObject);
begin
  fNeedRedraw := true;
  DrawSpectrum;
end;

procedure TScanThread.ReDraw;
begin
  fNeedRedraw := true;
end;

procedure TScanThread.ReScan;
begin
  fKillScan := false;
end;

procedure TScanThread.PaintBoxPaint(Sender: TObject);
var LSD, LED, PSD : integer;
begin
  LSD := fLoopStart div fBPP;
  LED := fLoopEnd div fBPP;
  PSD := fPosition div fBPP;

  with fPaintBox.Canvas do
  begin
    Draw(0, 0, fBufferBitmap);

    Pen.Color := fSpectrumColor.scLoopStart;
    MoveTo(LSD, 0);
    LineTo(LSD, fHeight);

    Pen.Color := fSpectrumColor.scLoopEnd;
    MoveTo(LED, 0);
    LineTo(LED, fHeight);

    Pen.Color := fSpectrumColor.scPosition;
    MoveTo(PSD, 0);
    LineTo(PSD, fHeight);

    Font.Color := fSpectrumColor.scText;
    Brush.Color:= fSpectrumColor.scBack;
    TextOut(LSD+7, 12, IntToStr(Round(BASS_ChannelBytes2Seconds(fDecoder, fLoopStart))));
    TextOut(LED+7, 12, IntToStr(Round(BASS_ChannelBytes2Seconds(fDecoder, fLoopEnd))));
    TextOut(PSD+7, 12, IntToStr(Round(BASS_ChannelBytes2Seconds(fDecoder, fPosition))));
  end;
end;

procedure TScanThread.PaintBoxMouseDown(Sender: TObject;Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in shift then
  begin
    fLoopStart := DWORD(X)*fBPP;
    GlobalLoopStart[fNbLoopSync] := fLoopStart;
  end
  else if ssRight in shift then begin
    fLoopEnd :=DWORD(X)*fBPP;
    BASS_ChannelRemoveSync(fChannel,fLoopSync[fNbLoopSync]); // remove old sync
    fLoopSync[fNbLoopSync]:= BASS_ChannelSetSync(fChannel,BASS_SYNC_POS or BASS_SYNC_MIXTIME,fLoopEnd,LoopSyncProc,nil);
   // set new sync
  end else if ssMiddle in shift then
    BASS_ChannelSetPosition(fChannel,DWORD(X)*fBPP,BASS_POS_BYTE);
end;

procedure TScanThread.PaintBoxMouseMove(Sender: TObject;
    Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in shift then begin
    fLoopStart := DWORD(X)*fBPP;
    GlobalLoopStart[fNbLoopSync]:=fLoopStart;
  end
  else
  if ssRight in shift then
  begin
    fLoopEnd := DWORD(X)*fBPP;
    BASS_ChannelRemoveSync(fChannel,fLoopSync[fNbLoopSync]); // remove old sync
    fLoopSync[fNbLoopSync] := BASS_ChannelSetSync(fChannel,BASS_SYNC_POS or BASS_SYNC_MIXTIME,fLoopEnd,LoopSyncProc,nil);
   // set new sync
  end
  else
  if ssMiddle in shift then
    BASS_ChannelSetPosition(fChannel, DWORD(X)*fBPP,BASS_POS_BYTE);
end;

procedure TScanThread.Execute;
begin
  ScanPeaks;
  repeat
    synchronize(ThreadProcedure);
    sleep(20);
  until Terminated;
end;

procedure TScanThread.ThreadProcedure;
begin
  //ScanPeaks ; //-> normalement inutile , car déjà scanné
  if fNeedRedraw then
    DrawSpectrum;
  fPosition := BASS_ChannelGetPosition(fChannel,BASS_POS_BYTE);
  fPaintBox.Invalidate;
end;

procedure TScanThread.DrawSpectrum;
var
  i, ht : integer;
  rt : single;
begin
  rt := (1/32768);

  fBufferBitmap.Width  := fPaintBox.Width;
  fBufferBitmap.Height := fPaintBox.Height;

  with fBufferBitmap.Canvas do
  begin
    // clear background
    Brush.Color := fSpectrumColor.scBack;
    FillRect(ClipRect);

    Pen.Color := fSpectrumColor.scBorder;
    Rectangle(1, 0, fWidth, ClipRect.Bottom);

    //draw peaks
    ht := fHeight shr 1;
    Pen.Color := fSpectrumColor.scPeak;
    for i := 0 to length(fWaveBufL)-1 do
    begin
      MoveTo(i, ht-trunc((fWaveBufL[i]*rt)*ht));
      LineTo(i, ht+trunc((fWaveBufR[i]*rt)*ht)+1);
    end;
    Pen.Color := fSpectrumColor.scBack;
    MoveTo(0, ht);
    LineTo(fWidth, ht);
  end;
  fNeedRedraw := false;
end;

procedure TScanThread.ScanPeaks;
var
  cpos, level : DWord;
  peak : array[0..1] of DWORD;
  position : DWORD;
  counter : integer;
begin
  cpos    := 0;
  peak[0] := 0;
  peak[1] := 0;
  counter := 0;

  while not fKillscan do
  begin
    level := BASS_ChannelGetLevel(fDecoder); // scan peaks

    if peak[0] < LOWORD(level) then
      peak[0] := LOWORD(level); // set left peak

if peak[1] < HIWORD(level) then
      peak[1] := HIWORD(level); // set right peak

    if BASS_ChannelIsActive(fDecoder) <> BASS_ACTIVE_PLAYING then
    begin
      position := cardinal(-1); // reached the end
end
    else
      position := BASS_ChannelGetPosition(fDecoder,BASS_POS_BYTE) div fBPP;

    if position > cpos then
    begin
      inc(counter);
      if counter <= length(fWaveBufL)-1 then
      begin
        fWaveBufL[counter] := peak[0];
        fWaveBufR[counter] := peak[1];
      end;

      if position >= DWORD(fWidth) then
        fKillscan := true;

        cpos := position;
     end;
    peak[0] := 0;
    peak[1] := 0;
  end;
end;

//------------------------------------------------------------------------------

{ TSpectrumColor }

constructor TSpectrumColor.Create;
begin
  inherited Create;
  fColors := SpectrumThemeDefault;
end;

function TSpectrumColor.GetColor(const index: integer): integer;
begin
  result := fColors[index];
end;

procedure TSpectrumColor.LoadFromFile(const FileName: string);
var Stream : TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TSpectrumColor.LoadFromResource(Instance: THandle; const ResName: string);
var Stream : TResourceStream;
begin
  Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TSpectrumColor.LoadFromResourceID(Instance: THandle; ResID: integer);
var Stream : TResourceStream;
begin
  Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TSpectrumColor.LoadFromStream(Stream: TStream);
begin
  assert(Stream <> nil, 'Error TSpectrumColor.LoadFromStream : '+#13#10+
                        'Stream must not be null.');
  Stream.Read(fColors, SizeOf(fColors));
  Change;
end;

procedure TSpectrumColor.SaveToFile(const FileName: string);
var Stream : TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TSpectrumColor.SaveToStream(Stream: TStream);
begin
  assert(Stream <> nil, 'Error TSpectrumColor.SaveToStream : '+#13#10+
                        'Stream must not be null.');
  Stream.Write(fColors, SizeOf(fColors));
end;

procedure TSpectrumColor.SetColor(const index, value: integer);
begin
  if fColors[index] <> Value then
  begin
    fColors[index] := Value;
    Change;
  end;
end;

procedure TSpectrumColor.AssignTo(Dest: TPersistent);
begin
  if Dest is TSpectrumColor then
    TSpectrumColor(Dest).LoadSpectrumTheme(Self.fColors)
  else
    inherited AssignTo(Dest);
end;

procedure TSpectrumColor.Change;
begin
  if Assigned(fOnChange) then
    fOnChange(Self);
end;

procedure TSpectrumColor.LoadSpectrumTheme(
  const ColorTheme: TSpectrumTheme);
begin
  if not CompareMem(@fColors, @ColorTheme, SizeOf(TSpectrumTheme)) then
  begin
    fColors := ColorTheme;
    Change;
  end;
end;

end.

Le : 03/06/2009 21:48:50
Source : BOZOON - ANIMATION GDI+
Houla, GDI+ a du apparaitre en 2002 2003 quelque chose comme ça, mais ça a tarder a venir sur Delphi grace a l'equipe ProgDigy.

GDI+ est un bon compromis entre la vieille GDI et les grosses API Graphique comme OpenGL ou DirectX.
l'API G32 est aussi pas mal comme alternative a GDI et GDI+.

Le : 02/06/2009 00:22:52
Source : BOZOON - ANIMATION GDI+
Coucou, pour faire cela il suffit de modifier l'etendue de MoveXMin, MoveXMax, MovYMin et MoveYMax

réglé pour l'instant a -20..ClientWidth+20 et -20..ClientHeight+20

donc change le 20 en 100 ou 200 par exemple ;)

lecopyleft ne concerne que mon code, pas celui de la GDI+ :)

Le : 01/06/2009 15:26:08
Source : NUANCIER POUR CODER EN RGB
Tiens voila une amelioration...
Tu pourrais y ajouter plus tard le formatage en CMJ, HLS etc.




unit Nuance;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Clipbrd,
  Dialogs, Controls, Forms, StdCtrls, ComCtrls, ExtCtrls, Graphics;

type
  TMagicColor = packed record
    case integer of
      0 : (RGBA  : array[1..4] of Byte);
      1 : (Color : Integer);
  end;

  TForm1 = class(TForm)
    Panel1  : TPanel;
    Panel2  : TPanel;
    Panel3  : TPanel;
    Button1 : TButton;
    Button2 : TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    fMagicColor : TMagicColor;
    fPanels     : array[1..3] of TPanel;
    fTrackBars  : array[1..3] of TTrackBar;
    fComboBox   : TComboBox;
    fColFmt     : integer;
  protected
    function GetColorFmt: string; virtual;
    procedure Initialize; virtual;
    procedure DoComboChange(Sender: TObject);
    procedure DoTrackbarChange(Sender: TObject);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  ColMask : array[1..3] of integer = ($000000FF, $0000FF00, $00FF0000);

function TForm1.GetColorFmt: string;
var
  ODS : char;
const
  GLR = 1/255;
begin
  // Retourne une chaine qui represente la couleur dans le format désiré
  with fMagicColor do
    case fColFmt of
      // Delphi BGR : $00000000 a $00FFFFFF
      1 : result := format('$%.8x',[Color]);

      // HTML RGB : #000000 a #FFFFFF
      2 : result := format('#%.2x%.2x%.2x',[RGBA[1], RGBA[2], RGBA[3]]);

      // Hexa RGB : 000000 a FFFFFF
      3 : result := format('%.2x%.2x%.2x',[RGBA[1], RGBA[2], RGBA[3]]);

      // OpenGL RGB : 0.0, 0.0, 0.0 a 1.0, 1.0, 1.0
      4 :
        begin
          ODS := DecimalSeparator;
          DecimalSeparator := '.';
          result := format('%.4g, %.4g, %.4g',[GLR*RGBA[1], GLR*RGBA[2], GLR*RGBA[3]]);
          DecimalSeparator := ODS;
        end
      else
        // Decimal RGB : 0 0 0 a 255 255 255
        result := format('%d, %d, %d',[RGBA[1], RGBA[2], RGBA[3]]);
    end;
end;

procedure TForm1.Initialize;
var
   I : Byte;
begin
  for I := 1 to 3 do
  with fPanels[I] do
  begin
    // On definie le texte du Panel qui correspond a l'octet de couleur associé
    Caption := IntToStr(fMagicColor.RGBA[I]);

    // Sa hauteur depend egalement de l'octet de couleur associé
    Height  := fMagicColor.RGBA[I];

    // On change sa position pour qu'elle suive le curseur de la Trackbar
    Top     := 190 + fTrackBars[I].Position;

    // Finalement on definie sa couleur par l'octet de couleur associé
    Color   := fMagicColor.Color and ColMask[I];
  end;

  // On definie la couleur de panel1 et panel2 selon la couleur réglée
  Panel1.Color   := fMagicColor.Color;
  Panel2.Color   := Panel1.Color;

  // On affiche la couleur formatée en texte
  Panel3.Caption := GetColorFmt;
end;

procedure TForm1.FormCreate(Sender: TObject);
var I : Byte;
begin
  // Par defaut tout est blanc
  fMagicColor.Color := clWhite;

  // Par defaut on affiche en decimal RGB
  fColFmt           := 0;

  // Combobox pour le formatage texte de la couleur
  fComboBox := TComboBox.Create(Panel2);
  with fComboBox do
  begin
    // Le parent est Panel2!
    Parent     := Panel2;

    // L'objet n'herite pas de la fonte de Panel2
    ParentFont := false;

    // Ont redefinie la police
    Font.Size  := 8;
    Font.Style := [];

    // On vide le texte par defaut
    Text       := '';

    // On definie la position et dimension de l'objet
    SetBounds(1,72,220,22);

    // On definie les lignes de textes dans l'objet
    Items.BeginUpdate;
    try
      Items.Clear;
      Items.Add('Format Decimal RGB (R, G, B)');
      Items.Add('Format Delphi ($00BBGGRR)');
      Items.Add('Format HTML (#RRGGBB)');
      Items.Add('Format Hexa RGB (RRGGBB)');
      Items.Add('Format OpenGL RGB (R.R, G.G, B.B)');
    finally
      Items.EndUpdate;
    end;

    // Par defaut on est en format Decimal RGB
    ItemIndex := 0;

    // On assigne finalement le gestionnaire d'evenement
    OnChange  := DoComboChange;
  end;

  for I := 1 to 3 do
  begin
    // Trackbar pour augmenter ou diminuer la couleur R,G ou B
    fTrackBars[I] := TTrackBar.Create(Self);
    with fTrackBars[I] do
    begin
      // Le parent est la classe TForm1, pas la variable Form1!
      Parent        := Self;

      // On definie l'intervalle, la position et l'orientation de la Trackbar
      Max           := 255;
      Min           := 0;
      Position      := 0;
      Orientation   := trVertical;

      // On definie l'apparence de la Trackbar
      SliderVisible := True;
      ThumbLength   := 10;
      TickMarks     := tmBoth;

      // On definie un Tag different pour differencier les Trackbar
      Tag           := I;

      // On definie la position et dimension de la Trackbar
      SetBounds(12 + (126 * (I - 1)), 184, 25, 265);

      // On assigne finalement le gestionnaire d'evenement
      OnChange      := DoTrackbarChange;
    end;

    // Panels qui servent de gauge quantitative de couleur R,G ou B
    fPanels[I] := TPanel.Create(Self);
    with fPanels[I] do
    begin
      // Le parent est la classe TForm1 et non la variable Form1
      Parent     := Self;

      // On definie la police, identique a celle de Panel3
      Font       := Panel3.Font;

      // Le blanc ressort bien sur du rouge, du vert ou du bleu pur.
      Font.Color := clWhite;

      // On definie la position et dimension du Panel
      SetBounds(32 + (126 * (I - 1)), 184, 100, 260);
    end;
  end;

  // Initialise les couleurs, texte, position et aspect
  Initialize;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var N : integer;
begin
  // Liberation des objets créés dynamiquement
  for N := 3 downto 1 do
  begin
    // Liberation des Panels
    fPanels[N].Free;
    // Liberation des TrackBars
    fTrackBars[N].Free;
  end;
  // Liberation de la ComboBox
  fComboBox.Free;
end;

procedure TForm1.DoTrackbarChange(Sender: TObject);
var I : integer;
begin
  // Changement de la couleur R, G ou B
  I := (Sender as TTrackBar).Tag;
  if I in [1..3] then
  begin
    { un simple Not suffit pour inverser la valeur de position
      de la Trackbar en couleur valide.
      Not byte(N) = 255-N
    }
    fMagicColor.RGBA[I] := not byte(fTrackBars[I].Position);
    Initialize;
  end;
end;

procedure TForm1.DoComboChange(Sender: TObject);
var I : integer;
begin
  // Changement du formatage texte de la couleur
  I := (Sender as TComboBox).ItemIndex;
  if I <> -1 then
  begin
    fColFmt := I;
    Initialize;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Memorisation de la couleur dans le presse-papier
  Clipboard.Clear;
  Clipboard.AsText := GetColorFmt;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  // Fermeture du programme
  Close;
end;

end.

Le : 06/05/2009 20:52:10
Source : PRÉ-COMPOSANT D'AFFICHAGE DE TEXTE PROGRESSIF...
j'aime toujours bien tes codes, très obscure au premier abord, mais facilement compréhensible. ton originalité est rafraichissante.

ton seul defaut : tu ne respecte pas encore tout a fait les convention d'ecriture du code :

les variable private/protected sont a nommées "f" et non "_" nous ne faisons pas du C/C++!

un petit espace aprés les ":" entre l'identifiant et le type

les published avant les public override
les public avant les public override
les override aprés les nouvelles methodes etc

voila un exemple de ce que ça donne :

type
  TThreadOfTextFader = class(TThread)
  private
    fActuals   : TStringList;
    fLastDo    : TDateTime;
    fTextFader : TTextFader;
    function GetActuals: TStringList;
    function GetLastDo: TDateTime;
    function GetTextFader: TTextFader;

  protected
    procedure Execute; override;

  protected
    function GetDelay: Cardinal; virtual;
    procedure PleaseDo; virtual;
    property Actuals: TStringList read GetActuals;

  published
    property LastDo   : TDateTime  read GetLastDo;
    property TextFader: TTextFader read GetTextFader;

  public
    constructor Create(AObject: TTextFader); { reintroduce; }
    destructor Destroy; override;

  end;


si tu te resoud a faire ça, ce sera encore mieux!

tu peux faire un tours ici : http://www.delphifr.com/tutoriaux/CONVENTIONS-ECRITURE-IDENTIFIANTS-VARIABLES-METHODES-DELPHI_413.aspx

sinon, le reste est trés bien, un peu trop aéré mais ça reste parfaitement lisible.
l'Ascii art est toujours sympa, je regarderais plus en details demain.

Le : 06/05/2009 10:25:16
Source : IMAGE DANS UN TDBGRID
Et c'est tout ?!

un peu leger tout de même ...

Le : 30/04/2009 00:00:33
Source : DES DÉS ...
Yo les mecs ! :)

bon par ou commencer :

@All : On peut remplacer l'unité PngImage fournie par une version plus ancienne, compatible D6/D7, l'unité fournie etant celle de Delphi 2009.
il suffirat de remplacer TPNGImage par TPNGObject, le fonctionnement reste le même.

@Bacterius :
PNG compresse et la couche alpha et les pixels, le restant est en clair dans le fichier. exactement comme si on compréssait les bytes d'un BMP aprés l'offset 56 (soit les pixels de couleurs).

@Debiars :
Oui mon vieil ami! cela peut etre fait de façon plus simple et aussi de façon plus polyvalente en incluant par exemple les D4, D8, D20, D50, D80, D100 ...
mais bon ...
Il s'agit bien sur d'un exercice de style. un cas d'ecole incluant animation, images, initialization, classe objet, evenements, composant, logique booléenne etc. un programme complet donc.


Le : 29/04/2009 13:28:11
Source : DES DÉS ...
ça rame ?!

la je suis etonné, car on tourne entre 2 a 9 image/s, si ça saccade c'est peut etre pour ça.
pour ce qui est des png, le detail qui tue : un png c'est comme un bmp + une couche alpha et compréssé en sortie avec ZLib (un zip en quelque sorte).
d'ou la qualité et la petite taille.

j'utilise souvent les png, dans la plupart de mes sources, notement mastermind ou pazu. personne, même Debiars, ne m'ont jamais rapporté que ça ramer.

Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Comparez les prix Nouvelle version


Console Sony Playstation 3 80GB
Entre 398€ et 425€


Visiter le guide achat

Photothèque Nouveau !

Photo sitges beachPhoto Cockpit Airbus A320
Photo corps parfaitPhoto femme, Plage, Bien être, été, détente,

Visiter la photothèque


Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,265 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.