Форум по Delphi программированию



Вернуться   Форум по Delphi программированию > Все о Delphi > Графика и игры
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 11.05.2021, 22:55
DedZahar DedZahar вне форума
Прохожий
 
Регистрация: 03.05.2021
Сообщения: 1
Версия Delphi: Delphi 7
Репутация: 10
Радость Переписывание визуализации с увеличением ее производительности(?)

Честно ърен его знает куда эту тему надо было совать но сюда вроде как подходит... В общем задача следующая переписать аудио визуализацию с медленного метода обработки (тбитмап->канва имэйджа-> канва формы+обработка окна самой формы) в быстрый ,вроде как, метод где окно создается динамически.
Да бы не пустословить вот о чем речь для наглядного примера:

Код:
for i:=1 to 500 do
  for j:=1 to 1120 do
  begin
  if ((i>0) or (i<500)) and ((j>0) or (j<1120)) then
  begin
    ArrBit[i,j].R:=round(((ArrBit[i-1,j-1].R+ArrBit[i-1,j].R+ArrBit[i-1,j+1].R+ArrBit[i,j-1].R+ArrBit[i,j].R+ArrBit[i,j+1].R+ArrBit[i+1,j-1].R+ArrBit[i+1,j].R+ArrBit[i+1,j+1].R) * cons));
   ArrBit[i,j].g:=round(((ArrBit[i-1,j-1].g+ArrBit[i-1,j].g+ArrBit[i-1,j+1].g+ArrBit[i,j-1].g+ArrBit[i,j].g+ArrBit[i,j+1].g+ArrBit[i+1,j-1].g+ArrBit[i+1,j].g+ArrBit[i+1,j+1].g) * cons));
   ArrBit[i,j].b:=round(((ArrBit[i-1,j-1].b+ArrBit[i-1,j].b+ArrBit[i-1,j+1].b+ArrBit[i,j-1].b+ArrBit[i,j].b+ArrBit[i,j+1].b+ArrBit[i+1,j-1].b+ArrBit[i+1,j].b+ArrBit[i+1,j+1].b) * cons));
   if ArrBit[i,j].R>2 then  ArrBit[i,j].R:=ArrBit[i,j].R-2 else ArrBit[i,j].R:=0;
   if ArrBit[i,j].g>2 then  ArrBit[i,j].g:=ArrBit[i,j].g-2 else ArrBit[i,j].g:=0;
   if ArrBit[i,j].b>2 then  ArrBit[i,j].b:=ArrBit[i,j].b-2 else ArrBit[i,j].b:=0;

  end;
  end;


 for i:=0 to 501 do
    for j:=0 to 1121 do
    begin
      rr:= round((ArrBit[i,j].R  +  ArrBit2[i,j].R)*3);
      gg:= round((ArrBit[i,j].g  +  ArrBit2[i,j].g)*3);
      bb:= round((ArrBit[i,j].b  +  ArrBit2[i,j].b)*3);
      if rr>255 then rr:=255;
      if gg>255 then gg:=255;
      if bb>255 then bb:=255;
      ArrBit2[i,j].R:=rr;
      ArrBit2[i,j].g:=gg;
      ArrBit2[i,j].b:=bb;

  end;
  buffBit.Canvas.Brush.Style:=bsclear;
   buffBit.Canvas.Pen.Color:=0;
 buffBit.Canvas.Rectangle(0,0,1120,500);
 image1.Canvas.Draw(0,0,buffBit);
 for i:=0 to 501 do
    for j:=0 to 1121 do
    begin

     ArrBit2[i,j].R:=0;
     ArrBit2[i,j].g:=0;
     ArrBit2[i,j].b:=0;
  end;
end;
рисовка на первом битмапе если что.
и перед этим
при создании формы идет сканлайн где присваивается PRGB поочердно первый второй битмап
Ну так вот, собственно код через который создается и удерживается в живых окно:
Код:
....
const
  AppName = 'visualization';
  cons = 0.106;


type BRGB = record
 B:Byte;
 G:Byte;
 R:Byte;
 end;
 TRgb=array of BRGB;
 PRGB=array of ^TRgb;
 type TWaveData = array[0..2047] of DWORD;

var
  Window:HWND =0;
  Stream:DWORD;
  Timer:DWORD =0;
  Msg:TMsg;
  WndClass:TWndClassEX;
  WndPosX, WndPosY:Integer;
  WndSizeX, WndSizeY:Integer;
  BMP1_info:TBITMAPINFO;
  BMP1_DC:HDC =0;
  BMP1:HBITMAP =0;
  BMP1_buffer:Pointer;
  BMP1_Pixel,BMP2_Pixel:PRGB;
  WaveData:TWaveData;
......
procedure UpdateWindow(uTimerID, uMsg, dwUser, dw1, dw2 : Integer); stdcall;
var
 DC:HDC;
...
begin
 BASS_ChannelGetData(Stream,@WaveData,2048);
....

  DC:=GetDC(Window);
 try
  BitBlt(DC, 0, 0, 848, 480, BMP1_DC, 0, 0, SRCCOPY);
 finally
  ReleaseDC(Window,DC);
 end;
end;



function MainWndMessage(Wnd:HWND; Msg:Integer; wParam, lParam:Longint):Integer; stdcall;
var
 DC:HDC;
 PS:TPAINTSTRUCT;
begin
 Result:=0;
 Case Msg of

  WM_CREATE:
   begin
    GetOSInfo;
    If not BASS_Init(-1,48000,0,Wnd,NIL) Then
     begin
	    Result := -1;
      Exit;
     end;
    If not OpenFile(Wnd) Then // start a file playing
     begin
	    BASS_Free;
     	Result:=-1;
    	Exit;
     end;
    FillChar(BMP1_info,SizeOf(BMP1_info),0);
    With BMP1_info.bmiHeader do
     begin
      biSize:=SizeOf(BMP1_info.bmiHeader);
      biWidth:= 848;
      biHeight:= 480;
      biPlanes:=1;
      biBitCount:=24;
     end;
    BMP1:=CreateDIBSection(0,BMP1_info,DIB_RGB_COLORS,BMP1_buffer,0,0);
    BMP1_DC:=CreateCompatibleDC(0);
    SelectObject(BMP1_DC,BMP1);
    Timer:=timeSetEvent(25,25,@UpdateWindow,0,TIME_PERIODIC);
   end;


  WM_PAINT:
   If GetUpdateRect(Wnd,PRect(NIL)^,False) Then
    begin
     DC:=BeginPaint(Wnd,PS);
     If DC=0 Then
      begin
       Result:=0;
       Exit;
      end;
     BitBlt(DC,0,0,848,480,BMP1_DC,0,0,SRCCOPY);
     EndPaint(Wnd,PS);
     Result:=0;
     Exit;
    end;



  WM_CLOSE:
   begin
    DestroyWindow(Wnd);
   end;


  WM_DESTROY:
   begin
    If Timer <> 0 Then timeKillEvent(Timer);
    BASS_Free;
    If BMP1_DC <> 0 Then DeleteDC(BMP1_DC);
    If BMP1 <> 0 Then DeleteObject(BMP1);
    PostQuitMessage(0);
    Exit;
   end;

  end;
  Result:=DefWindowProc(Wnd,Msg,wParam,lParam);
end;



procedure CreateMainWindow;
begin
 Window:=FindWindow(AppName,NIL);
 If Window <> 0 Then
  begin
    If IsIconic(Window) Then ShowWindow(Window,SW_RESTORE);
    SetForegroundWindow(Window);
    Halt(254);
  end;
 FillChar(WndClass,SizeOf(TWndClassEx),0);
 with WndClass do
  begin
   cbSize:=SizeOf(TWndClassEx);
   style:=CS_HREDRAW or CS_VREDRAW;
   lpfnWndProc:=@MainWndMessage;
   cbClsExtra:= 0;
   cbWndExtra:= 0;
   hInstance:=hInstance;
   hCursor:=LoadCursor(0,IDC_ARROW);
   hbrBackGround:=GetSysColorBrush(COLOR_BTNFACE);
   lpszClassName:=AppName;
  end;
 If RegisterClassEx(WndClass)=0 Then Halt(255);
 WndSizeX:=848 + 2 * GetSystemMetrics(SM_CXDLGFRAME);
 WndSizeY:=480 + 2 * GetSystemMetrics(SM_CYDLGFRAME) + GetSystemMetrics(SM_CYCAPTION);
 WndPosX:=(GetSystemMetrics(SM_CXSCREEN) - WndSizeX) div 2;
 WndPosY:=(GetSystemMetrics(SM_CYSCREEN) - WndSizeY) div 2;
 Window:=CreateWindowEx(0,AppName,'',WS_POPUPWINDOW or WS_CAPTION,WndPosX,WndPosY,WndSizeX,WndSizeY,0,0,hInstance,NIL);
 ShowWindow(Window, SW_SHOWNORMAL);
 While (GetMessage(Msg,0,0,0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
 Halt(Msg.wParam);
end;


begin
 CreateMainWindow;
end.
Вопрос +- таков: как подружить Тбитмап с АШБитмапом без потери производительности? код для рендера эффекта мыла и так тяжел; Если на прямую нельзя, то как можно?(функции)\костыли из типов\массивов?.
Я до этого 3 года не кодил; пока лопатил пасы переучил 1000+ функций и констант и соответственно пропустил похоже нужное здесь Поэтому буду благодарен если подскажете хорошую литературу по делфи 7(кстати у меня вин10 так что справка не работает), в особенности интресует битшифтинг ну или же ассамблеровская составляющая делфи.

Также если что пример создания формы взял из исходника "spectrum" который идет с библиотекой Басс. А важную часть кода к "мылу" я вроде указал
Ответить с цитированием
  #2  
Старый 14.05.2021, 21:02
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,800
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Код:
var
  bmp : TBitmap;
  hbmp : HBitmap
begin
  ...
  bmp.Handle := hbmp;
  ...
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 13:41.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2021

ВКонтакте   Facebook   Twitter   Ссылка на Telegram