| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Помогите переделать проседуру рисования под WinApi(Delphi).

Страницы:   < 1 2 >

M.A. ©   (2014-10-26 17:22:00) 

Здравствуйте. Вопрос выше.

вот код VCL:

unit ChervUnit;

interface

uses
 Windows, Classes, Graphics, Controls, Forms, SysUtils,
 ExtCtrls, BASS;

type
 TChervForm = class(TForm)
   TimerCherv: TTimer;
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormCreate(Sender: TObject);
   procedure TimerChervTimer(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure ChervVis(HWND: THandle; ind : Integer);
 private          
   { Private declarations }
 public
   { Public declarations }
 end;

var
 ChervForm: TChervForm;
 VisBuffCherv{, NonePic} : TBitmap;

implementation

uses mp3, SpectrUnit, LevelUnit, PeremUnit{, MemUnit}, SetFom,
 CircleForm;

{$R *.dfm}

procedure TChervForm.TimerChervTimer(Sender: TObject);
begin
 ChervVis(ChervForm.Canvas.Handle, ChervForm.Tag);
end;

procedure TChervForm.ChervVis(HWND: THandle; ind : Integer);
var
i,  YPos : Integer;
vCherv, ColChan : Integer;
BufCherv :array of Single;
 ciCherv : BASS_CHANNELINFO;
begin
 VisBuffCherv.Width := ClientWidth;
 VisBuffCherv.Height := ClientHeight;

 VisBuffCherv.Canvas.Pen.Color := clBlack;
 VisBuffCherv.Canvas.Brush.Color := clBlack;
 VisBuffCherv.Canvas.Rectangle(0, 0, VisBuffCherv.Width, VisBuffCherv.Height) ;// only if no background

 if BASS_ChannelIsActive(Channel) <> BASS_ACTIVE_STOPPED then
   begin
           BASS_ChannelGetInfo(Channel, ciCherv); // get number of channels
           if VisBuffCherv.Width <= 1920 then
             vCherv := VisBuffCherv.Width
           else
             vCherv := 1920;
           SetLength(BufCherv, Integer(ciCherv.chans) * (vCherv + 1));
           BASS_ChannelGetData(Channel, BufCherv, (Integer(ciCherv.chans) * vCherv * SizeOf(Single)) or BASS_DATA_FLOAT);
           VisBuffCherv.Canvas.Font.Color := clYellow;
     case ind of
       0:   //ChervLineDraw
         begin
           for ColChan := 0 to ciCherv.chans - 1 do
             begin
               VisBuffCherv.Canvas.Pen.Color := Sqr((ColChan + 2) * 94); //$00009B00;
               VisBuffCherv.Canvas.MoveTo(0, VisBuffCherv.Height div 2);      //146
               for i := 0 to vCherv do
                 begin
                   YPos := Trunc((1-BufCherv[i * Integer(ciCherv.chans) + ColChan]) * VisBuffCherv.Height / 2);
                   VisBuffCherv.Canvas.lineto(i, YPos);
                 end;
             end;
         end;
       1:  // ChervTSDraw
         begin
          for ColChan := 0 to ciCherv.chans - 1 do
             begin
               VisBuffCherv.Canvas.Pen.Color := Sqr((ColChan + 2) * 94); //$00009B00;
             for i := 0 to vCherv do
               begin
                 YPos := Trunc((1-BufCherv[i * integer(ciCherv.chans) + ColChan]) * VisBuffCherv.Height / 2);
                 VisBuffCherv.Canvas.MoveTo(i, VisBuffCherv.Height div 2);
                 VisBuffCherv.Canvas.lineto(i, YPos);
               end;
             end;
         end;
       2:  //ChervPixelDraw
         begin
         
           for ColChan := 0 to ciCherv.chans - 1 do
             for i := 0 to vCherv do
               begin
                 YPos := Trunc((1-BufCherv[i * integer(ciCherv.chans) + ColChan])  * VisBuffCherv.Height / 2);
                 VisBuffCherv.Canvas.Pixels[i, YPos] := Sqr((ColChan + 2) * 94);
               end;
         end;
     end;
   end;
 BitBlt(HWND, 0, 0, VisBuffCherv.Width, VisBuffCherv.Height, VisBuffCherv.Canvas.Handle, 0, 0, srccopy);
end;

procedure TChervForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 TimerCherv.Enabled := False;
 Form_player.CBCherv.Checked := False;
end;

procedure TChervForm.FormCreate(Sender: TObject);
begin
 VisBuffCherv := TBitmap.Create;
 Color := clBlack;
 if ChervForm.Tag > 2 then
   ChervForm.Tag := 0;
 if ChervForm.Tag < 0 then
   ChervForm.Tag := 0;
end;

procedure TChervForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Button = mbRight then
   if ChervForm.Tag < 2 then
     ChervForm.Tag := ChervForm.Tag + 1
   else
     ChervForm.Tag := 0;
 if Button = mbMiddle then
   if ChervForm.Tag > 0 then
      ChervForm.Tag :=  ChervForm.Tag - 1
   else
     ChervForm.Tag := 2;
end;

procedure TChervForm.FormShow(Sender: TObject);
begin
 TimerCherv.Enabled := True;
end;

end.

Меня интересует - procedure TChervForm.ChervVis(HWND: THandle; ind : Integer);
пПомогите пожалуйста переделать на Api, без испольльзования модуля Graphics.
Спасибо.

ИЛИ ХОТЯ БЫ ПРИВЕДИТЬ РАБОЧИЙ ПРИМЕР РИСОВАНИЯ ПО ТАЙМРУ примитивов (SetTimer).

---

M.A.   (2014-10-26 17:58:00) [21]

Kilkennycat ©

ИЛИ ХОТЯ БЫ ПРИВЕДИТЬ РАБОЧИЙ ПРИМЕР Перерисовка окна ПО ТАЙМРУ примитивов (SetTimer).

---

Kilkennycat   (2014-10-26 17:53:00) [22]

Таймер ничего не рисует, он лишь генерирует событие.
Сформулируйте вопрос правильно.

---

Страницы:   < 1 2 >

Наверх