Beranda>Terkait pemrograman>Kode sumber Delphi
Unduh

Bitmappixels

[Eng]

Bitmappixels.pas - Modul Lazarus dan Delphi untuk akses langsung ke piksel di tbitmap

Bekerja di Windows (Winapi), Linux (GTK2, QT5), OSX (Cocoa)

Pertanyaan yang cukup populer adalah bagaimana mendapatkan akses cepat ke piksel tbitmap ?
Mudah dilakukan di Delphi , dengan properti Scanline [] , karena terbatasnya jumlah format piksel, tetapi agak sulit di Lazarus .
Misalnya: https://wiki.freepascal.org/fast_direct_pixel_access

Saya mengusulkan file kecil, tunggal, modul "bitmappixels.pas" yang menyederhanakan pekerjaan dengan hanya memanggil tbitmapdata.map () dan tbitmapdata.unmap () .
Anda mendapatkan array $ aarrggbb piksel di properti data , dan ABILTY SET dan mendapatkan warna piksel menggunakan setPixel ()/getPixel () . 

 var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec; // for easy access to the channels 
begin
  // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode.
  // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 
  Data.Map(Bitmap, TAccessMode.ReadWrite, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        // Read color at (X, Y) to Pixel record
        Pixel := Data.GetPixel(X, Y);
        // some changes of Pixel
        Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3 ;
        Pixel.G := Pixel.R;
        Pixel.B := Pixel.R;
        // ...
        // Write Pixel record to (X, Y) in map
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    // Writing the map to the image.
    // Since we have abandoned Alpha, the pixel format will be set to pf24bit.
    Data.Unmap();
  end ;
end ;

Fitur Utama:

  • Cross-Platform
  • Mendukung semua format piksel tbitmap untuk dibaca
  • Pemrosesan cepat format populer di Windows/GTK/QT/OSX
  • dapat memetakan gambar apa pun sebagai memiliki saluran alfa atau tidak (24bit/32bit)

Contoh 1 - Balikkan warna (baca dan tulis)

Contoh1.png

 procedure InvertColors ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, False); // RGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.R := 255 - Pixel.R;
        Pixel.G := 255 - Pixel.G;
        Pixel.B := 255 - Pixel.B;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

Contoh 2 - Transparansi setengah bitmap (baca dan tulis, alpha)

Contoh2.png

 procedure HalfAlpha ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, True); // ARGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.A := Pixel.A div 2 ;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

Contoh 3 - Buat Efek Plasma pada Bitmap (Tulis Hanya)

Contoh3.png

 function MakePlasm (): TBitmap;
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize( 300 , 300 );

  Data.Map(Result, TAccessMode.Write, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel.R := Byte(Trunc(
          100 + 100 * (Sin(X * Cos(Y * 0.049 ) * 0.01 ) + Cos(X * 0.0123 - Y * 0.09 ))));
        Pixel.G := 0 ;
        Pixel.B := Byte(Trunc(
          Pixel.R + 100 * (Sin(X * Cos(X * 0.039 ) * 0.022 ) + Sin(X * 0.01 - Y * 0.029 ))));
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

Contoh 4 - Campurkan dua bitmap menjadi satu bitmap (hanya baca, hanya tulis)

Contoh4.png

 function Mix ( const A, B: TBitmap): TBitmap;
  function Min (A, B: Integer): Integer;
  begin
    if A < B then Exit(A) else Exit(B);
  end ;
var
  DataA, DataB, DataResult: TBitmapData;
  X, Y: Integer;
  PixelA, PixelB, PixelResult: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height));
  // this needed for correct Unmap() on exception
  DataA.Init();
  DataB.Init();
  DataResult.Init();
  try
    DataA.Map(A, TAccessMode.Read, False);
    DataB.Map(B, TAccessMode.Read, False);
    DataResult.Map(Result, TAccessMode.Write, False);
    for Y := 0 to DataResult.Height - 1 do
    begin
      for X := 0 to DataResult.Width - 1 do
      begin
        PixelA := DataA.Pixels[X, Y];
        PixelB := DataB.Pixels[X, Y];
        PixelResult.R := (PixelA.R + PixelB.R) div 2 ;
        PixelResult.G := (PixelA.G + PixelB.G) div 2 ;
        PixelResult.B := (PixelA.B + PixelB.B) div 2 ;
        DataResult[X, Y] := PixelResult;
      end ;
    end ;
  finally
    DataA.Unmap();
    DataB.Unmap();
    DataResult.Unmap();
  end ;
end ;

[Rus]

Bitmappixels.pas - модуль для lazarus и delphi дающий пffemberмой досту к пикселам tbitmap.

Windows работает на (WinAPI), Linux (GTK2, QT5), OSX (Cocoa)

Е довольно популancingый, в собществе lazarus рззоиков, в д к к к к00?
Это л ко сделать В delphi б scline Scanline с з-дз дз довов kata, оопнннзutu оззззззззззззззззззззззззззззззззза взза взззззззза вара вззззззза вара взззззза вара взза вара вара вара вза вара вара вара вара вла вара вара вла вла вза вззза варз. довольно сложно В lazarus .
Примеры сложностей, которые мог возникнуть: https://wiki.freepascal.org/fast_direct_pixel_access.

Я предл secara Tbitmapdata.unmap () .
Вы полчаете масив пикселй в ф ф ф ф ф ф ф ф в в kata , алжжжжжжжжжжжжжжжж ужжжж уilan ужжжж уilan ужж уilan ужжжжж уilan ужжж уilan у. помощщ setpixel ()/getpixel () . 

 var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec; // for easy access to the channels 
begin
  // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode.
  // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 
  Data.Map(Bitmap, TAccessMode.ReadWrite, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        // Read color at (X, Y) to Pixel record
        Pixel := Data.GetPixel(X, Y);
        // some changes of Pixel
        Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3 ;
        Pixel.G := Pixel.R;
        Pixel.B := Pixel.R;
        // ...
        // Write Pixel record to (X, Y) in map
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    // Writing the map to the image.
    // Since we have abandoned Alpha, the pixel format will be set to pf24bit.
    Data.Unmap();
  end ;
end ;

Оновныental фичи:

  • кросспany secara
  • подерживает Все форматы пикселей tbitmap дл чтения я
  • ускоренная обработка попуmati "форматов В windows/gtk/qt/osx
  • можно обработать юбое зображение, как иеющее аа-канал, так и нет (24б: 32бит))

Contoh 1 - инве Agustus

Contoh1.png

 procedure InvertColors ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, False); // RGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.R := 255 - Pixel.R;
        Pixel.G := 255 - Pixel.G;
        Pixel.B := 255 - Pixel.B;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

CONTOH 2 - создание полу 201

Contoh2.png

 procedure HalfAlpha ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, True); // ARGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.A := Pixel.A div 2 ;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

Contoh 3 - создание ээекта плаз (Tulis saja)

Contoh3.png

 function MakePlasm (): TBitmap;
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize( 300 , 300 );

  Data.Map(Result, TAccessMode.Write, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel.R := Byte(Trunc(
          100 + 100 * (Sin(X * Cos(Y * 0.049 ) * 0.01 ) + Cos(X * 0.0123 - Y * 0.09 ))));
        Pixel.G := 0 ;
        Pixel.B := Byte(Trunc(
          Pixel.R + 100 * (Sin(X * Cos(X * 0.039 ) * 0.022 ) + Sin(X * 0.01 - Y * 0.029 ))));
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

Contoh 4 - смешивание двх зображений (hanya baca, hanya tulis)

Contoh4.png

 function Mix ( const A, B: TBitmap): TBitmap;
  function Min (A, B: Integer): Integer;
  begin
    if A < B then Exit(A) else Exit(B);
  end ;
var
  DataA, DataB, DataResult: TBitmapData;
  X, Y: Integer;
  PixelA, PixelB, PixelResult: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height));
  // this needed for correct Unmap() on exception
  DataA.Init();
  DataB.Init();
  DataResult.Init();
  try
    DataA.Map(A, TAccessMode.Read, False);
    DataB.Map(B, TAccessMode.Read, False);
    DataResult.Map(Result, TAccessMode.Write, False);
    for Y := 0 to DataResult.Height - 1 do
    begin
      for X := 0 to DataResult.Width - 1 do
      begin
        PixelA := DataA.Pixels[X, Y];
        PixelB := DataB.Pixels[X, Y];
        PixelResult.R := (PixelA.R + PixelB.R) div 2 ;
        PixelResult.G := (PixelA.G + PixelB.G) div 2 ;
        PixelResult.B := (PixelA.B + PixelB.B) div 2 ;
        DataResult[X, Y] := PixelResult;
      end ;
    end ;
  finally
    DataA.Unmap();
    DataB.Unmap();
    DataResult.Unmap();
  end ;
end ;

[Ua]

Bitmappixels.pas - модуль для lazarus і delphi, що дає пffemberмий досту до піксе_і В tbitmap.

Працює на Windows (WinAPI), Linux (GTK2, QT5), OSX (Cocoa)

Є досить популяancing, у с сбнноті lazarus рззбancing вв, питання: я о о о о о о о о о о о secara
Л л кко зробити В delphi завдя ingatan Влстивості Scanline [] через доить оаиииииamah ксииииииamah, складно В Lazarus .
Приклад masuk складнощв, я можть Виникнути: https://wiki.freepascal.org/fast_direct_pixel_access.

Я пропоню нвеликий, у в влл оiden файлу, мощ р р д д д д д д д д д д д д д д д д д д д д д д д д д д я я я я я я я я я я я я я я я я я я я я KAN я я я я я я я я я я я KAN я я я я я я я я я KAN я я я я я я я я я KAN я я я я я я я я KAN я я я я я я я я KAN я я Tbitmapdata.unmap () .
В отримте маив піксел secara у ф ф ф ф ф ф ф ф ф ф ф ф ф ф ф ф ф ф у вabat вови вilat всжж ahat , за допомою ю setpixel ()/getPixel () . 

 var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec; // for easy access to the channels 
begin
  // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode.
  // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 
  Data.Map(Bitmap, TAccessMode.ReadWrite, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        // Read color at (X, Y) to Pixel record
        Pixel := Data.GetPixel(X, Y);
        // some changes of Pixel
        Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3 ;
        Pixel.G := Pixel.R;
        Pixel.B := Pixel.R;
        // ...
        // Write Pixel record to (X, Y) in map
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    // Writing the map to the image.
    // Since we have abandoned Alpha, the pixel format will be set to pf24bit.
    Data.Unmap();
  end ;
end ;

Основlat фчччч

  • кроспany secara
  • підтрим Всі формати піксе_і В TBITMAP для читанннetakan
  • прискорена обробка популяancingх формат secara у windows/gtk/qt/osx
  • можна обробити будь-etanе зображення, я таке, що має а аа-анал, так і і і і і і і і і і і00,

Contoh 1 - інве Agustusthosan кольору (Baca dan Tulis)

Contoh1.png

 procedure InvertColors ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, False); // RGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.R := 255 - Pixel.R;
        Pixel.G := 255 - Pixel.G;
        Pixel.B := 255 - Pixel.B;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

CONTOH 2 - створення напівпрозоро зображення (baca dan tulis, alpha)

Contoh2.png

 procedure HalfAlpha ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, True); // ARGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.A := Pixel.A div 2 ;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

Contoh 3 - створення еекту плази (Tulis saja)

Contoh3.png

 function MakePlasm (): TBitmap;
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize( 300 , 300 );

  Data.Map(Result, TAccessMode.Write, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel.R := Byte(Trunc(
          100 + 100 * (Sin(X * Cos(Y * 0.049 ) * 0.01 ) + Cos(X * 0.0123 - Y * 0.09 ))));
        Pixel.G := 0 ;
        Pixel.B := Byte(Trunc(
          Pixel.R + 100 * (Sin(X * Cos(X * 0.039 ) * 0.022 ) + Sin(X * 0.01 - Y * 0.029 ))));
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

CONTOH 4 - зшшвання двох зображень (Baca saja, Tulis saja)

Contoh4.png

 function Mix ( const A, B: TBitmap): TBitmap;
  function Min (A, B: Integer): Integer;
  begin
    if A < B then Exit(A) else Exit(B);
  end ;
var
  DataA, DataB, DataResult: TBitmapData;
  X, Y: Integer;
  PixelA, PixelB, PixelResult: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height));
  // this needed for correct Unmap() on exception
  DataA.Init();
  DataB.Init();
  DataResult.Init();
  try
    DataA.Map(A, TAccessMode.Read, False);
    DataB.Map(B, TAccessMode.Read, False);
    DataResult.Map(Result, TAccessMode.Write, False);
    for Y := 0 to DataResult.Height - 1 do
    begin
      for X := 0 to DataResult.Width - 1 do
      begin
        PixelA := DataA.Pixels[X, Y];
        PixelB := DataB.Pixels[X, Y];
        PixelResult.R := (PixelA.R + PixelB.R) div 2 ;
        PixelResult.G := (PixelA.G + PixelB.G) div 2 ;
        PixelResult.B := (PixelA.B + PixelB.B) div 2 ;
        DataResult[X, Y] := PixelResult;
      end ;
    end ;
  finally
    DataA.Unmap();
    DataB.Unmap();
    DataResult.Unmap();
  end ;
end ;
Memperluas
Informasi Tambahan
Aplikasi Terkait
Direkomendasikan untuk Anda
Informasi Terkait Semua