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

Советы » Графика » Пример быстрой работы с графикой

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

.

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

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com