|
Пример быстрой работы с графикой
Автор: Koster
Пример быстрой работы с графикой в среде 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.
|
|
