Пример быстрой работы с графикой

Пример быстрой работы с графикой в среде Windows без использования средств DirectX Совместимость: Windows 95, 98, NT, 2000, Me, TrE, XP, Whistler, Tristler :))

// © Koster < mtaurus@rambler.ru >
// Greetz to: Vano aka RIS, Uras aka Assargadon
// Special thanx to: Leon the Trillennium
 
unit
 VisualForm;

interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, ComCtrls;

type

  TfmMain = class
(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    pbDraw: TPaintBox;
    Timer1: TTimer;
    Label1: TLabel;
    procedure
 FormCreate(Sender: TObject);
    procedure
 FormDestroy(Sender: TObject);
    procedure
 FormResize(Sender: TObject);
    procedure
 Timer1Timer(Sender: TObject);
  private

    { Private declarations }
    procedure
 CreateBitmap(aSX, aSY: Integer);
    procedure
 RecreateBitmap(aSX, aSY: Integer);
    procedure
 DeleteBitmap;

    procedure
 RestrictSize(var
 msg: TMessage); message
 WM_GETMINMAXINFO;
    procedure
 pbDrawPaint(Sender: TObject);
  private

    ScrBitmap: TBitmap;
    Scr: Pointer;
    SX, SY: Integer;
  public

    { Public declarations }
  end
;

var

  fmMain: TfmMain;

implementation


{$R *.DFM}

type

  TBig = array
[0..0] of
 Integer;

procedure
 TfmMain.CreateBitmap(aSX, aSY: Integer);
var

  BInfo: tagBITMAPINFO;
begin

  // Создание DIB
  SX := aSX; SY := aSY;
  BInfo.bmiHeader.biSize := sizeof(tagBITMAPINFOHEADER);
  BInfo.bmiHeader.biWidth := SX;
  BInfo.bmiHeader.biHeight := -SY;
  BInfo.bmiHeader.biPlanes := 1;
  BInfo.bmiHeader.biBitCount := 32;
  BInfo.bmiHeader.biCompression := BI_RGB;
  ScrBitmap := TBitmap.Create();
  ScrBitmap.Handle := CreateDIBSection(Canvas.Handle, BInfo, DIB_RGB_COLORS, Scr, 0, 0);
  ZeroMemory(Scr, SX * SY * 4);
end
;

procedure
 TfmMain.DeleteBitmap;
begin

  // Удаление DIB
  ScrBitmap.FreeImage();
  ScrBitmap.Destroy;
end
;

procedure
 TfmMain.RecreateBitmap(aSX, aSY: Integer);
var

  BInfo: tagBITMAPINFO;
begin

  // Пересоздание DIB при изменении размеров "экрана"
  ScrBitmap.FreeImage();
  SX := aSX; SY := aSY;
  BInfo.bmiHeader.biSize := sizeof(tagBITMAPINFOHEADER);
  BInfo.bmiHeader.biWidth := SX;
  BInfo.bmiHeader.biHeight := -SY;
  BInfo.bmiHeader.biPlanes := 1;
  BInfo.bmiHeader.biBitCount := 32;
  BInfo.bmiHeader.biCompression := BI_RGB;
  ScrBitmap.Handle := CreateDIBSection(Canvas.Handle, BInfo, DIB_RGB_COLORS, Scr, 0, 0);
  ZeroMemory(Scr, SX * SY * 4);
end
;

procedure
 TfmMain.FormCreate(Sender: TObject);
begin

  CreateBitmap(pbDraw.ClientWidth, pbDraw.ClientHeight);
  pbDraw.Canvas.Draw(0, 0, ScrBitmap);
  Caption := 'Визуализатор'; Application.Title := Caption;
end
;

procedure
 TfmMain.FormDestroy(Sender: TObject);
begin

  DeleteBitmap();
end
;

procedure
 TfmMain.FormResize(Sender: TObject);
begin

  ReCreateBitmap(pbDraw.ClientWidth, pbDraw.ClientHeight);
  pbDraw.Canvas.Draw(0, 0, ScrBitmap);
end
;

procedure
 TfmMain.RestrictSize(var
 msg: TMessage);
var

  p: PMinMaxInfo;
begin

  // Ограничитель размеров окна (обработка сообщений Windows).
  // Удобная вещь кстати (важно: см. объявление процедуры в классе TFmMain)
  // The lParam contains a pointer on a structure of type TMinMaxInfo
  p := PMinMaxInfo(Msg.lParam);
  // This represents the size of the Window when Maximized
//  p.ptMaxSize.x := 320;
//  p.ptMaxSize.y := 240;
  // This represents the position of the Window when Maximized
//  p.ptMaxPosition.x := 10;
//  p.ptMaxPosition.y := 10;
  // This represents the minimum size of the Window
  p.ptMinTrackSize.x := 520;
  p.ptMinTrackSize.y := 240;
  // This represents the maximum size of the Window
//  p.ptMaxTrackSize.x := 400;
//  p.ptMaxTrackSize.y := 320;
end
;

procedure
 TfmMain.pbDrawPaint(Sender: TObject);
begin

  pbDraw.Canvas.Draw(0, 0, ScrBitmap);
end
;

Пример работы с данной конструкцией: SX - текущий размер нашего "экрана" по горизонтали SY - по вертикали
TBig(Scr^). Scr - это указатель на массив пикселей битмапа, который в нашем случае имеет разрядность 32 (32 бита, или 4 байта на пиксел, что эквивалентно типу Integer. См. объявление типа TBig). Конструкция TBig(Scr^) позволяет адресовать эту память как массив пиксел. Чтобы получить доступ к пикселу нужно использовать индекс массива [x + y * SX].

Функция RGB. Это стандартная делфяцкая функция, не приспособленная для того что мы тут творим, а только для своего "родного" класс TCanvas и его цветовых кодов. В Windows при использовании 32-разрядных битмапов формат пиксела такой (начиная с первого байта):

            BBBBBBBB GGGGGGGG RRRRRRRR ********

В Delphi (то что ВСЕГДА возвращает функция RGB, при любой разрядности картинки):

            RRRRRRRR GGGGGGGG BBBBBBBB ********

Усматривается аналогия :) Все что нужно это просто перечислить аргументы функции в обратном порядке :))

            TBig(Scr^)[x + y * SX] := RGB(B, G, R);

B, G, R - соответственно значения интенсивности синего, зеленого, и красного цветов размером байт, т.е. [0..255].

Палитра 32-разрядным режимом не поддерживается, за нас думает Windows (вернее, понятия палитры в таком режиме вообще нет). Ну а нам остается это все юзать как надо +)))

Чтобы почистить виртуальный экран, нужно сделать так: ZeroMemory(Scr, SX * SY * 4);

procedure
 TfmMain.Timer1Timer(Sender: TObject);
var

  x, y: Integer;

begin

  // В цикле рисуется полная левота. Рисуйте тут свою левоту :)
  for
 x := 0 to
 SX - 1 do
 for
 y := 0 to
 SY - 1 do

    TBig(Scr^)[x + y * SX] := RGB(Random(256),Random(256),Random(256));

  // При желании, используем средства Delphi на объекте ScrBitmap типа TBitmap
  // в т.ч. можно нарисовать на нем другой Bitmap с помощью функции
  // ScrBitmap.Canvas.Draw(x,y,AnotherBitmap);
  // Чтобы текст выглядел красивее (без фона), раскомментируйте строки
  // SetBkMode(ScrBitmap.Canvas.Handle, TRANSPARENT);
  ScrBitmap.Canvas.Font.Size := 24;
  ScrBitmap.Canvas.TextOut(10, 10, 'Demo');
  // SetBkMode(ScrBitmap.Canvas.Handle, OPAQUE);

  // Нарисуемся
  pbDrawPaint(Self);
end
;

end
.

Другое по теме:

• Delphi и графика
• Вывод надписи поверх всех окон
• Изменить режим копирования изображения