|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Переписывание визуализации с увеличением ее производительности(?)
Честно ърен его знает куда эту тему надо было совать но сюда вроде как подходит... В общем задача следующая переписать аудио визуализацию с медленного метода обработки (тбитмап->канва имэйджа-> канва формы+обработка окна самой формы) в быстрый ,вроде как, метод где окно создается динамически.
Да бы не пустословить вот о чем речь для наглядного примера: Код:
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
|
|||
|
|||
Код:
var bmp : TBitmap; hbmp : HBitmap begin ... bmp.Handle := hbmp; ... |