Utilisation de la scanline pour optimiser la lecture et l'écriture des fonctions get/set-pixels.

Description

Utilisation de la scanline pour optimiser la lecture et l'écriture des fonctions Get/Set-Pixels.

Utilisation : Créer l'object avec sa méthode create
et assigner lui un bitmap de chez Borland
Faire des opérations sur les pixels Get et Set Pixels
Puis assigner en retour le bitmap à obtenir à partir de celui dessinné.
Normalement Pixel:=adresse_base_du_bitmap + largeur de l'image * Y + X;

Source / Exemple :


unit U_fast_bitmap;

  {Une unité écrite par denis bertin pour accéler
  l'accès à la lecture ou l'écriture de pixel dans une image. (c) db 15-07-2009}

interface

uses Windows, Graphics, Classes, SysUtils;

var globale_stop : boolean;

const max_size_vertical = 32000;

//Utilisation : Créer l'object avec sa méthode create
//et assigner lui un bitmap de chez Borland
//Faire des opérations sur les pixels Get et Set Pixels
//Puis assigner en retour le bitmap à obtenir à partir de celui dessinné.
//Normalement Pixel:=adresse_base_du_bitmap + largeur de l'image * Y + X;

type

  Parray_maxi = ^Tarray_maxi;
  Tarray_maxi = array[00..max_size_vertical] of pointer;

type

  TFastBitmap = class {gagne 2000% en lecture le dbn:15-07-2009}
    abitmap:TBitmap;
    awindow:hwnd;
    constructor Create(window:hwnd);
    destructor  Destroy; override;
    procedure   Assign(Source: TPersistent);
    function    Lecture_de_la_scanline:boolean;
    procedure   Liberation_de_la_scanline;
    function    Height:integer;
    function    Width:integer;
    function    Get_pixel(x,y:integer):TColor;
    procedure   Set_pixel(x,y:integer; color:TColor);
    procedure   For_a_rectangle_filling(sa_couleur:TColor);
    //procedure   Resize(byx,byy:integer);
    private
      size : integer;
      scan : Parray_maxi;
    end; {TFastBitmap}

implementation

uses k_erreur,g_base;

constructor TFastBitmap.Create(window:hwnd);
  begin
  inherited Create;
  self.abitmap:=tbitmap.create;
  self.scan:=nil;
  self.size:=0;
  self.awindow:=window;
  end;

destructor TFastBitmap.Destroy;
  begin
  self.Liberation_de_la_scanline;
  self.abitmap.free;
  inherited Destroy;
  end;

procedure TFastBitmap.Assign(Source: TPersistent);
  begin
  self.abitmap.Assign(Source);
  self.Liberation_de_la_scanline;
  end;

function TFastBitmap.lecture_de_la_scanline:boolean;
  var i:integer;
  begin
  try
    self.abitmap.PixelFormat:=pf24bit;
  except
    on EOutOfResources do
      begin
      //spécifique à l'application
      k_erreur.MessageBox(self.awindow,
        k_erreur.Err_Fichier_trop_volumineux,mb_iconstop+id_ok);
      lecture_de_la_scanline:=false;
      exit;
      end;
    end;
  size:=self.abitmap.Height*sizeof(pointer);
  getmem(self.scan,size);
  for i:=0 to pred(self.abitmap.Height) do self.scan[i]:=Self.abitmap.scanline[i];
  lecture_de_la_scanline:=true;
  end; {TFastBitmap.lecture_de_la_scanline}

procedure TFastBitmap.Liberation_de_la_scanline;
  begin
  if self.scan<>nil then
    freemem(self.scan,self.size);
  self.scan:=nil;
  self.size:=0;
  end;

function TFastBitmap.get_pixel(x,y:integer):TColor;
  var p:^byte;
      color:tcolorref;
  begin
  if self.scan=nil then
    lecture_de_la_scanline;
  if (y>=self.abitmap.height) or (x>=self.abitmap.width) or (x<0) or (y<0) then
    begin
    get_pixel:=g_base.rgb_noir;
    end
  else
    begin
    p:=self.scan^[y];
    inc(p,x*3);
    color:=P^ shl 16;
    inc(p);
    inc(color,p^ shl 8);
    inc(p);
    inc(color,p^);
    get_pixel:=color;
    end;
  end; {TFastBitmap.get_pixel}

function TFastBitmap.width:integer;
  begin
  result:=self.abitmap.Width;
  end;

function TFastBitmap.Height:integer;
  begin
  result:=self.abitmap.Height;
  end;

procedure TFastBitmap.set_pixel(x,y:integer; color:TColor);
  var p:pchar; {PByteArray;}
      q:pbytearray;
      d:integer;
  begin
  if self.scan=nil then
    lecture_de_la_scanline;
  if not ((y>=self.abitmap.height) or (x>=self.abitmap.width) or (y<0) or (x<0)) then
    begin
    q:=Self.scan[y];
    d:=x*3;
    q[d]:=(color shr 16) and 255;
    q[d+1]:=(color shr 8) and 255;
    q[d+2]:=color and 255;
    end;
  end; {TFastBitmap.set_pixel}

procedure TFastBitmap.For_a_rectangle_filling(sa_couleur:TColor);
  var i,j,ii,jj:integer;
  begin
  ii:=self.width;
  jj:=self.Height;
  for i:=1 to ii do for j:=1 to jj do self.Set_pixel(i,j,sa_couleur);
  end;

end.

Conclusion :


J'espère avoir été explicite.

Codes Sources

A voir également

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.