Недавно добавленные исходники

•  3D Designer  105

•  Sik Screen Capture  87

•  Patch Maker  76

•  Айболит (remote control)  95

•  ListBox Drag & Drop  73

•  Доска для игры Реверси  1 272

•  Графические эффекты  84

•  Рисование по маске  62

•  Перетаскивание изображений  66

•  Canvas Drawing  68

•  Рисование Луны  143

•  Поворот изображения  50

•  Рисование стержней  44

•  Paint on Shape  41

•  Генератор кроссвордов  53

•  Головоломка Paletto  63

•  Теорема Монжа об окружностях  105

•  Пазл Numbrix  49

•  Заборы и коммивояжеры  74

•  Игра HIP  56

•  Игра Go (Го)  47

•  Симулятор лифта  49

•  Программа укладки плитки  52

•  Генератор лабиринта  92

•  Проверка числового ввода  43

•  HEX View  97

•  Физический маятник  99

•  Задача коммивояжера  126

•  Автомобильная пробка  49

•  Квадратные сетки из слов  43

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Пример быстрой работы с графикой в среде Windows без использования средств DirectX



Автор: Koster
Прислал: Andrey

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

type
  TfmMain = class(TForm)
    pbDraw: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    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;

  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)
  p := PMinMaxInfo(Msg.lParam);
  p.ptMinTrackSize.x := 520;
  p.ptMinTrackSize.y := 240;
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-разрядных битмапов формат пиксела такой (начиная с первого байта):

BBBBBBB GGGGGGGG RRRRRRRR ********

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

RRRRRRRR GGGGGGGG BBBBBBBB ******** 

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

Big(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;

В примере я (Мироводин Дмитрий) добавил вывод значения FPS, и несколько заменил процедуру заполнения массива пикселями. Дело в том, что функция Random является достаточно долгой по времени выполнения (причем всегда с разным) и по этому я заменил ее на более простую - TBig(Scr^)[x + y * SX] := RGB(254,200,23); Т.е. простая "заливка". При таком подходе Вы можете оценить реальную скорость работы цепочки заполнение памяти - отрисовка.

Итак значения примерно следующие:

полный экран 800x600 - 70-80 ms
с использованием Random - 100-120 ms

Greetz to: Vano aka RIS, Uras aka Assargadon
Special thanx to: Leon the Trillennium





Похожие по теме исходники

Примеры работы с БД

Примеры оформления DBGrid

Пример использования DBGrid

График работы

 

Non Rectangular Windows

Windows Transparency

Windows Alpha-channel

Progress Windows

 

Popup Info Windows

Windows Sorting

RawWrite for Windows

Windows Desktops

 

Сообщения между процессами Windows

База данных без BDE

БД без BDE

Кривая Безье

 

Bezier Curves (кривые Безье)

Splay Line (Безье)

Сплайн на 8 точек (Безье)

Text Bezier Curve (Безье)

 

Кривые Безье на OpenGL

DirectX Backdate




Copyright © 2004-2021 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter