Автор: Maks150988
Дата сообщения: 27.06.2008 16:07
Эх, ну ладно. Не велика проблема.
Теперь вот следующее. Неоходимо перевести код юнита Спектрума для плейера с VCL на API.
[more]unit uSpectrum;
interface
uses
Windows, Graphics, SysUtils, Classes;
type
TWaveData = array [0..2048] of DWORD;
TFFTData = array [0..512] of Single;
type
TSpectrum = class(TObject)
private
VisBuff: TBitmap;
BackBmp: TBitmap;
BkColor: TColor;
SpecHeight: Integer;
PenColor: TColor;
PenMask: TColor;
PeakColor: TColor;
FPenSolid: Boolean;
DrawType: Integer;
DrawRes: Integer;
FrmClear: Boolean;
UseBkg: Boolean;
PeakFall: Integer;
LineFall: Integer;
ColWidth: Integer;
ShowPeak: Boolean;
FFTPeacks: array [0..128] of Integer;
FFTFallOff: array [0..128] of Integer;
public
constructor Create(Width, Height: Integer);
procedure Draw(HWND: THandle; FFTData: TFFTData; X, Y: Integer);
property BackColor: TColor read BkColor write BkColor;
property Height: Integer read SpecHeight write SpecHeight;
property Width: Integer read ColWidth write ColWidth;
property Pen: TColor read PenColor write PenColor;
property Mask: TColor read PenMask write PenMask;
property Peak: TColor read PeakColor write PeakColor;
property PenSolid: Boolean read FPenSolid write FPenSolid;
property Mode: Integer read DrawType write DrawType;
property Res: Integer read DrawRes write DrawRes;
property FrameClear: Boolean read FrmClear write FrmClear;
property PeakFallOff: Integer read PeakFall write PeakFall;
property LineFallOff: Integer read LineFall write LineFall;
property DrawPeak: Boolean read ShowPeak write ShowPeak;
end;
var
Spectrum: TSpectrum;
implementation
function GetLightColor(const Color: TColor; const Light: Byte): TColor;
var
R, G, B: Byte;
begin
R:= GetRValue(Color);
G:= GetGValue(Color);
B:= GetBValue(Color);
Result:= RGB(
Round(R + (255 - R) * (Light / 100)),
Round(G + (255 - G) * (Light / 100)),
Round(B + (255 - B) * (Light / 100)));
end;
constructor TSpectrum.Create(Width, Height: Integer);
begin
VisBuff:= TBitmap.Create;
BackBmp:= TBitmap.Create;
VisBuff.Width:= Width;
VisBuff.Height:= Height;
BackBmp.Width:= Width;
BackBmp.Height:= Height;
BkColor:= clBlack;
SpecHeight:= 100;
PenColor:= clBlack;
PenMask:= clBlack;
PeakColor:= clWhite;
FPenSolid:= False;
DrawType:= 1;
DrawRes:= 1;
FrmClear:= True;
UseBkg:= False;
PeakFall:= 1;
LineFall:= 3;
ColWidth:= 3;
ShowPeak:= True;
end;
procedure TSpectrum.Draw(HWND: THandle; FFTData: TFFTData; X, Y: Integer);
var
I, J, YPos: LongInt;
YVal: Single;
R, G, B: Integer;
begin
if FrmClear then
begin
VisBuff.Canvas.Pen.Color:= BkColor;
VisBuff.Canvas.Brush.Color:= BkColor;
VisBuff.Canvas.Rectangle(0, 0, VisBuff.Width, VisBuff.Height);
if UseBkg then
VisBuff.Canvas.CopyRect(Rect(0, 0, BackBmp.Width, BackBmp.Height),
BackBmp.Canvas, Rect(0, 0, BackBmp.Width, BackBmp.Height));
end;
VisBuff.Canvas.Pen.Color:= PenColor;
for I:= 0 to 128 do
begin
YVal:= Abs(FFTData[(I * DrawRes) + 5]);
YPos:= Trunc((YVal) * 500);
if YPos > Height then YPos:= SpecHeight;
if YPos >= FFTPeacks[I] then
FFTPeacks[I]:= YPos
else
FFTPeacks[I]:= FFTPeacks[I] - PeakFall;
if YPos >= FFTFallOff[I] then
FFTFallOff[I]:= YPos
else
FFTFallOff[I]:= FFTFallOff[I] - LineFall;
if (VisBuff.Height - FFTPeacks[I]) > VisBuff.Height then FFTPeacks[I]:= 0;
if (VisBuff.Height - FFTFallOff[I]) > VisBuff.Height then FFTFallOff[I]:= 0;
case DrawType of
0:
begin
VisBuff.Canvas.MoveTo(X + I, Y + VisBuff.Height);
VisBuff.Canvas.LineTo(X + I, Y + VisBuff.Height - FFTFallOff[I]);
if ShowPeak then
VisBuff.Canvas.Pixels[X + I, Y + VisBuff.Height - FFTPeacks[I]]:= Pen;
end;
1:
begin
if ShowPeak then
begin
VisBuff.Canvas.Pen.Color:= PeakColor;
VisBuff.Canvas.MoveTo(X + I * (ColWidth + 1), Y + VisBuff.Height - FFTPeacks[I]);
VisBuff.Canvas.LineTo(X + I * (ColWidth + 1) + ColWidth, Y + VisBuff.Height - FFTPeacks[I]);
end;
if not FPenSolid then
begin
R:= GetRValue(GetLightColor(PenColor, GetRValue(PenMask)));
G:= GetGValue(GetLightColor(PenColor, GetGValue(PenMask)));
B:= GetBValue(GetLightColor(PenColor, GetBValue(PenMask)));
for J:= Y + VisBuff.Height - FFTFallOff[I] to Y + VisBuff.Height do
begin
if J > Height / 2 then
Dec(R, Trunc(256 / Height));
if J > Height / 2 then
Dec(G, Trunc(256 / Height));
if J > Height / 2 then
Dec(B, Trunc(256 / Height));
if R < 0 then R:= 0;
if G < 0 then G:= 0;
if B < 0 then B:= 0;
VisBuff.Canvas.Pen.Color:= TColor(RGB(R, G, B));
VisBuff.Canvas.Brush.Color:= TColor(RGB(R, G, B));
VisBuff.Canvas.Rectangle(X + I * (ColWidth + 1), J,
X + I * (ColWidth + 1) + ColWidth, J + 1);
end;
end else begin
VisBuff.Canvas.Pen.Color:= PenColor;
VisBuff.Canvas.Brush.Color:= PenColor;
VisBuff.Canvas.Rectangle(X + I * (ColWidth + 1), Y + VisBuff.Height -
FFTFallOff[I], X + I * (ColWidth + 1) + ColWidth, Y + VisBuff.Height);
end;
end;
end;
end;
BitBlt(HWND, 0, 0, VisBuff.Width, VisBuff.Height, VisBuff.Canvas.Handle, 0, 0, SRCCOPY);
end;
end.
[/more]
Ну надо избавиться от TBitmap.Create и Canvas. Получилось вот что:
[more]unit uSpectrum;
interface
uses
Windows;
type
TWaveData = array [0..2048] of DWORD;
TFFTData = array [0..512] of Single;
TColor = -$7FFFFFFF-1..$7FFFFFFF;
TSpectrum = class(TObject)
private
VisBuff: hBitmap;
BackBmp: TBitmap;
BkColor: TColor;
SpecHeight: Integer;
PenColor: TColor;
PenMask: TColor;
PeakColor: TColor;
FPenSolid: Boolean;
DrawType: Integer;
DrawRes: Integer;
FrmClear: Boolean;
UseBkg: Boolean;
PeakFall: Integer;
LineFall: Integer;
ColWidth: Integer;
ShowPeak: Boolean;
FFTPeacks: array [0..128] of Integer;
FFTFallOff: array [0..128] of Integer;
public
constructor Create(Width, Height: Integer);
procedure Draw(HWND: THandle; FFTData: TFFTData; X, Y: Integer);
property BackColor: TColor read BkColor write BkColor;
property Height: Integer read SpecHeight write SpecHeight;
property Width: Integer read ColWidth write ColWidth;
property Pen: TColor read PenColor write PenColor;
property Mask: TColor read PenMask write PenMask;
property Peak: TColor read PeakColor write PeakColor;
property PenSolid: Boolean read FPenSolid write FPenSolid;
property Mode: Integer read DrawType write DrawType;
property Res: Integer read DrawRes write DrawRes;
property FrameClear: Boolean read FrmClear write FrmClear;
property PeakFallOff: Integer read PeakFall write PeakFall;
property LineFallOff: Integer read LineFall write LineFall;
property DrawPeak: Boolean read ShowPeak write ShowPeak;
end;
var
Spectrum : TSpectrum;
VisBuffDC : HDC;
BmpInfo : tagBITMAP;
BmpDC : HDC;
hBMP : HBITMAP;
bits : Pointer;
implementation
function GetLightColor(const Color: TColor; const Light: Byte): TColor;
var
R, G, B: Byte;
begin
R:= GetRValue(Color);
G:= GetGValue(Color);
B:= GetBValue(Color);
Result:= RGB(
Round(R + (255 - R) * (Light / 100)),
Round(G + (255 - G) * (Light / 100)),
Round(B + (255 - B) * (Light / 100)));
end;
procedure CreateBitmap32(width, height: Word);
var
bmi: BITMAPINFO;
begin
BmpDC := CreateCompatibleDC(0);
with bmi do
begin
bmiHeader.biSize := SizeOF(bmi.bmiHeader);
bmiHeader.biWidth := width;
bmiHeader.biHeight := -height;
bmiHeader.biPlanes := 1;
bmiHeader.biBitCount := 32;
bmiHeader.biCompression := BI_RGB;
bmiHeader.biSizeImage := 0;
bmiHeader.biXPelsPerMeter := 0;
bmiHeader.biYPelsPerMeter := 0;
bmiHeader.biClrUsed := 0;
bmiHeader.biClrImportant := 0;
end;
hBMP := CreateDIBSection(BmpDC, bmi, DIB_RGB_COLORS, bits, 0, 0);
SelectObject(BmpDC, hBMP);
end;
constructor TSpectrum.Create(Width, Height: Integer);
begin
{ TBitmap.Create для VisBuff }
VisBuff := LoadImage(hInstance, 'название картинки', IMAGE_BITMAP, 0, 0, 0);
VisBuffDC := CreateCompatibleDC(0);
SelectObject(VisBuffDC, VisBuff);
GetObject(VisBuff, sizeof(BITMAP), @BmpInfo);
CreateBitmap32(BmpInfo.bmWidth, BmpInfo.bmHeight);
BitBlt(BmpDC, 0, 0, BmpInfo.bmWidth, BmpInfo.bmHeight, VisBuffDC, 0, 0, SRCCOPY);
DeleteObject(VisBuff);
DeleteDC(VisBuffDC);
BackBmp:= TBitmap.Create;
VisBuff.Width:= Width;
VisBuff.Height:= Height;
BackBmp.Width:= Width;
BackBmp.Height:= Height;
BkColor:= clBlack;
SpecHeight:= 100;
PenColor:= clBlack;
PenMask:= clBlack;
PeakColor:= clWhite;
FPenSolid:= False;
DrawType:= 1;
DrawRes:= 1;
FrmClear:= True;
UseBkg:= False;
PeakFall:= 1;
LineFall:= 3;
ColWidth:= 3;
ShowPeak:= True;
end;
function _Rect(aLeft, aTop, aRight, aBottom: Integer): TRect;
begin
with Result do
begin
Left := aLeft;
Top := aTop;
Right := aRight;
Bottom := aBottom;
end;
end;
procedure TSpectrum.Draw(HWND: THandle; FFTData: TFFTData; X, Y: Integer);
var
I, J, YPos: LongInt;
YVal: Single;
R, G, B: Integer;
begin
if FrmClear then
begin
VisBuff.Canvas.Pen.Color:= BkColor;
VisBuff.Canvas.Brush.Color:= BkColor;
VisBuff.Canvas.Rectangle(0, 0, VisBuff.Width, VisBuff.Height);
if UseBkg then
VisBuff.Canvas.CopyRect(_Rect(0, 0, BackBmp.Width, BackBmp.Height),
BackBmp.Canvas, _Rect(0, 0, BackBmp.Width, BackBmp.Height));
end;
VisBuff.Canvas.Pen.Color:= PenColor;
for I:= 0 to 128 do
begin
YVal:= Abs(FFTData[(I * DrawRes) + 5]);
YPos:= Trunc((YVal) * 500);
if YPos > Height then YPos:= SpecHeight;
if YPos >= FFTPeacks[I] then
FFTPeacks[I]:= YPos
else
FFTPeacks[I]:= FFTPeacks[I] - PeakFall;
if YPos >= FFTFallOff[I] then
FFTFallOff[I]:= YPos
else
FFTFallOff[I]:= FFTFallOff[I] - LineFall;
if (VisBuff.Height - FFTPeacks[I]) > VisBuff.Height then FFTPeacks[I]:= 0;
if (VisBuff.Height - FFTFallOff[I]) > VisBuff.Height then FFTFallOff[I]:= 0;
case DrawType of
0:
begin
VisBuff.Canvas.MoveTo(X + I, Y + VisBuff.Height);
VisBuff.Canvas.LineTo(X + I, Y + VisBuff.Height - FFTFallOff[I]);
if ShowPeak then
VisBuff.Canvas.Pixels[X + I, Y + VisBuff.Height - FFTPeacks[I]]:= Pen;
end;
1:
begin
if ShowPeak then
begin
VisBuff.Canvas.Pen.Color:= PeakColor;
VisBuff.Canvas.MoveTo(X + I * (ColWidth + 1), Y + VisBuff.Height - FFTPeacks[I]);
VisBuff.Canvas.LineTo(X + I * (ColWidth + 1) + ColWidth, Y + VisBuff.Height - FFTPeacks[I]);
end;
if not FPenSolid then
begin
R:= GetRValue(GetLightColor(PenColor, GetRValue(PenMask)));
G:= GetGValue(GetLightColor(PenColor, GetGValue(PenMask)));
B:= GetBValue(GetLightColor(PenColor, GetBValue(PenMask)));
for J:= Y + VisBuff.Height - FFTFallOff[I] to Y + VisBuff.Height do
begin
if J > Height / 2 then
Dec(R, Trunc(256 / Height));
if J > Height / 2 then
Dec(G, Trunc(256 / Height));
if J > Height / 2 then
Dec(B, Trunc(256 / Height));
if R < 0 then R:= 0;
if G < 0 then G:= 0;
if B < 0 then B:= 0;
VisBuff.Canvas.Pen.Color:= TColor(RGB(R, G, B));
VisBuff.Canvas.Brush.Color:= TColor(RGB(R, G, B));
VisBuff.Canvas.Rectangle(X + I * (ColWidth + 1), J,
X + I * (ColWidth + 1) + ColWidth, J + 1);
end;
end else begin
VisBuff.Canvas.Pen.Color:= PenColor;
VisBuff.Canvas.Brush.Color:= PenColor;
VisBuff.Canvas.Rectangle(X + I * (ColWidth + 1), Y + VisBuff.Height -
FFTFallOff[I], X + I * (ColWidth + 1) + ColWidth, Y + VisBuff.Height);
end;
end;
end;
end;
BitBlt(HWND, 0, 0, VisBuff.Width, VisBuff.Height, VisBuff.Canvas.Handle, 0, 0, SRCCOPY);
end;
end.
[/more]
То есть например есть
VisBuff := TBitmap.Create;
И стал:
Код:
VisBuff := LoadImage(hInstance, 'название картинки', IMAGE_BITMAP, 0, 0, 0);
VisBuffDC := CreateCompatibleDC(0);
SelectObject(VisBuffDC, VisBuff);
GetObject(VisBuff, sizeof(BITMAP), @BmpInfo);
CreateBitmap32(BmpInfo.bmWidth, BmpInfo.bmHeight);
BitBlt(BmpDC, 0, 0, BmpInfo.bmWidth, BmpInfo.bmHeight, VisBuffDC, 0, 0, SRCCOPY);
DeleteObject(VisBuff);
DeleteDC(VisBuffDC);
