Исходники
Статьи
Языки программирования
.NET Delphi Visual C++ Borland C++ Builder C/С++ и C# Базы Данных MySQL MSSQL Oracle PostgreSQL Interbase VisualFoxPro Веб-Мастеру PHP HTML Perl Java JavaScript Протоколы AJAX Технология Ajax Освоение Ajax Сети Беспроводные сети Локальные сети Сети хранения данных TCP/IP xDSL ATM Операционные системы Windows Linux Wap Книги и учебники
Скрипты
Магазин программиста
|
Быстрая работы с графикой в среде WindowsПример быстрой работы с графикой в среде Windows без использования средств DirectX Совместимость: Windows 95, 98, NT, 2000, Me, TrE, XP, Whistler, Tristler :)) 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; Пример работы с данной конструкцией
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. |
Форум Программиста
Новости Обзоры Магазин Программиста Каталог ссылок Поиск Добавить файл Обратная связь Рейтинги
|