Переписывание визуализации с увеличением ее производительности(?)
Честно ърен его знает куда эту тему надо было совать но сюда вроде как подходит... В общем задача следующая переписать аудио визуализацию с медленного метода обработки (тбитмап->канва имэйджа-> канва формы+обработка окна самой формы) в быстрый ,вроде как, метод где окно создается динамически.
Да бы не пустословить вот о чем речь для наглядного примера:
Код:
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" который идет с библиотекой Басс. А важную часть кода к "мылу" я вроде указал
|