Форум: "Начинающим";
Текущий архив: 2007.01.14;
Скачать: [xml.tar.bz2];
Вниз
Мультимедийный таймер Найти похожие ветки
← →
addi (2006-12-19 22:56) [0]Для обеспечения задержки в 1мс реализовал мультимедийный таймер по примеру из книги В.В. Фаронов.
При обращении к внешним функциям происходит ошибка доступа(к параметрам).
Код вроде тот же, тока видимо где ошибка.
Может кто сталкивался с похожей проблемой?.
unit two;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ValEdit, ComCtrls, StdCtrls, ExtCtrls,
WinTypes, WinProcs,
Buttons, Spin, Mask ;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Constants: TGroupBox;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
WriteByte: TButton;
ReadByte: TButton;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
Connect: TButton;
UpDown1: TUpDown;
Edit5: TEdit;
UpDown2: TUpDown;
CheckBox7: TCheckBox;
Edit6: TEdit;
Memo1: TMemo;
Label1: TLabel;
Timer1: TTimer;
Handshake: TButton;
Edit7: TEdit;
Edit8: TEdit;
Timer2: TTimer;
ProgressBar1: TProgressBar;
procedure ConnectClick(Sender: TObject) ;
Procedure ApplyComSettings ;
procedure FormCreate(Sender: TObject) ;
procedure ReadByteClick(Sender: TObject) ;
procedure HandshakeClick(Sender: TObject) ;
procedure Timer1Timer(Sender: TObject) ;
procedure WriteByteClick(Sender: TObject) ;
procedure tr16to8(edt:word) ;
procedure tr8to16(num:byte) ;
procedure Timer2Timer(Sender: TObject) ;
procedure ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD); stdcall;
//Protected
private
{ Private declarations }
FComNumber: Integer;
function Read:Boolean;
function Write:Boolean;
function caseof(b:byte):byte;
public
{ Public declarations }
// FHandle: THandle;
// Procedure ApplyComSettings;
end;
type
PInteger = ^Integer;
Const
dcb_Binary = $00000001;
b_size = $00000008;
no_par = $00000000;
stop_ = 2;//$01; {sb1BITS}
MaxCount = 800 ;
var
Form1: TForm1;
FHandle: THandle;
i,l:cardinal;
j:byte;
varbl:word;
temp:word;
addvar:word;
ind:integer;
flag:boolean;
PData:PInteger;
flag2: boolean;
uEventID: UINT ;
Counter: integer;
Delay: Word;
mas: Array[1..20] of byte;
mas2:Array[1..2] of byte;
masword: Array[1..9] of word; // 0..6 com + 1 flag/2 bytes value of loop
nToWrite:Cardinal;
g:Cardinal;
implementation
{$R *.dfm}
function timeSetEvent(uDelay, uResolution:UINT; lpTimeProc:Pointer;
dwUser: DWORD; fuEvent:UINT):integer; stdcall; external
"winmm.dll";
function timeKillEvent(uID:UINT):integer; stdcall; external
"winmm.dll";
procedure TForm1.HandshakeClick(Sender: TObject);
var j,k:byte;
begin
Delay:=1; // setting the delay of 1ms
counter:=0;
uEventID:=timeSetEvent(Delay,0,@TForm1.ProcTime,0,1);
if uEventID=0 then
begin
ShowMessage("Error of starting of timer")
end ;
end;
end;
procedure TForm1.ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD);
stdcall;
begin
timeKillEvent(uEventID);
inc(counter);
if counter=MaxCount then begin
timeKillEvent(uEventID);
Memo1.Lines.Strings[2]:="Communication is failed";
end else begin
if read then
begin
if mas[1]=$A5 then
begin
Memo1.Lines.Strings[1]:="HandShake!";
Handshake.Caption:="Disconnect" ;
end;
end else begin
mas[1]:=$A5;
nToWrite:=1;
if not write then
begin
Memo1.Lines.Strings[1]:="Bad Write!" ;
Memo1.Lines.Strings[2]:=SysErrorMessage(GetLastError);
end else
begin
Memo1.Lines.Strings[1]:="Write is OK!";
// waiting another cycle
uEventID:=timeSetEvent(Delay,0,@TForm1.ProcTime,0,1);
end;
end;
end;
← →
Anatoly Podgoretsky © (2006-12-19 22:59) [1]> addi (19.12.2006 22:56:00) [0]
CallBack функция не может быть методом класса.
← →
addi (2006-12-20 23:09) [2]В примере заголовок call back процедуры ProcTime не описан.
Я его попробовал описать в Public, но компилятор в точках ее вызова начал ругаться.
???
unit two;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ValEdit, ComCtrls, StdCtrls, ExtCtrls,
WinTypes, WinProcs,
Buttons, Spin, Mask ;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Constants: TGroupBox;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
WriteByte: TButton;
ReadByte: TButton;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
Connect: TButton;
UpDown1: TUpDown;
Edit5: TEdit;
UpDown2: TUpDown;
CheckBox7: TCheckBox;
Edit6: TEdit;
Memo1: TMemo;
Label1: TLabel;
Timer1: TTimer;
Handshake: TButton;
Edit7: TEdit;
Edit8: TEdit;
Timer2: TTimer;
ProgressBar1: TProgressBar;
procedure ConnectClick(Sender: TObject) ;
Procedure ApplyComSettings ;
procedure FormCreate(Sender: TObject) ;
procedure ReadByteClick(Sender: TObject) ;
procedure HandshakeClick(Sender: TObject) ;
procedure Timer1Timer(Sender: TObject) ;
procedure WriteByteClick(Sender: TObject) ;
procedure tr16to8(edt:word) ;
procedure tr8to16(num:byte) ;
procedure Timer2Timer(Sender: TObject) ;
//procedure ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD); stdcall;
//Protected
private
{ Private declarations }
FComNumber: Integer;
function Read:Boolean;
function Write:Boolean;
function caseof(b:byte):byte;
public
{ Public declarations }
procedure ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD); stdcall;
// FHandle: THandle;
// Procedure ApplyComSettings;
end;
type
PInteger = ^Integer;
Const
dcb_Binary = $00000001;
b_size = $00000008;
no_par = $00000000;
stop_ = 2;//$01; {sb1BITS}
MaxCount = 800 ;
var
Form1: TForm1;
FHandle: THandle;
i,l:cardinal;
j:byte;
varbl:word;
temp:word;
addvar:word;
ind:integer;
flag:boolean;
PData:PInteger;
flag2: boolean;
uEventID: UINT ;
Counter: integer;
Delay: Word;
//PData:Pointer;
mas: Array[1..20] of byte;
mas2:Array[1..2] of byte;
masword: Array[1..9] of word; // 0..6 com + 1 flag/2 bytes value of loop
nToWrite:Cardinal;
g:Cardinal;
// nWrite:byte;
//Connected:byte;
implementation
{$R *.dfm}
function timeSetEvent(uDelay, uResolution:UINT; lpTimeProc:Pointer;
dwUser: DWORD; fuEvent:UINT):integer; stdcall; external
"winmm.dll";
function timeKillEvent(uID:UINT):integer; stdcall; external
"winmm.dll";
procedure TForm1.HandshakeClick(Sender: TObject);
var j,k:byte;
begin
Delay:=1; // setting the delay of 1ms
counter:=0;
uEventID:=timeSetEvent(Delay,0,@TForm1.ProcTime,0,1);
if uEventID=0 then
begin
ShowMessage("Error of starting of timer")
end ;
end;
end;
procedure ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD); stdcall;
begin
timeKillEvent(uEventID);
counter:=counter+1;
if counter=MaxCount then begin
//timeKillEvent(uEventID);
Form1.Memo1.Lines.Strings[2]:="Communication is failed";
//exit;
end else begin
if Form1.read=true then
begin
if mas[1]=$A5 then
begin
Form1.Memo1.Lines.Strings[1]:="HandShake!";
flag2:=true ;
Form1.Handshake.Caption:="Disconnect" ;
//timeKillEvent(uEventID);
//break;
//progressbar1.Position:=75000-l;
// progressbar1.Free;
// progressbar1.Enabled:=false;
// mas[1]:=$A5;
end;
end else
begin
mas[1]:=$A5;
nToWrite:=1;
if Form1.write=false then
begin
Form1.Memo1.Lines.Strings[1]:="Bad Write!" ;
Form1.Memo1.Lines.Strings[2]:=SysErrorMessage(GetLastError);
end else
begin
//Memo1.Lines.Strings[1]:="Write is OK!";
// waiting another cycle
uEventID:=timeSetEvent(Delay,0,@TForm1.ProcTime,0,1);
end;
end;
//if counter=MaxCount then
//timeKillEvent(uEventID);
//Memo1.Lines.Strings[2]:="Communication is failed";
//end;
//end;
//uEventID:=timeSetEvent(Delay,0,@TForm1.ProcTime,0,0);
end;
end;
← →
Anatoly Podgoretsky © (2006-12-20 23:26) [3]> addi (20.12.2006 23:09:02) [2]
call back процедура не должна быть методом класса, а рядовой процедурой. Вынеси ее из класса.
← →
Anatoly Podgoretsky © (2006-12-20 23:29) [4]> addi (20.12.2006 23:09:02) [2]
И еще это не надо
function timeSetEvent(uDelay, uResolution:UINT; lpTimeProc:Pointer;
dwUser: DWORD; fuEvent:UINT):integer; stdcall; external
"winmm.dll";
function timeKillEvent(uID:UINT):integer; stdcall; external
"winmm.dll";
В модуле mmsystem все уже объявлено, там же и определение заголовка call back процедуры.
← →
Vovan #2 (2006-12-20 23:34) [5]>Я его попробовал описать в Public, но компилятор в точках ее вызова начал ругаться.
Попробуй вообще вынести ProcTime из класса. Объяви её, например, над
var
Form1: TForm1;
Соответсвенно, вызов будет без TForm:
uEventID := timeSetEvent(Delay, 0, @ProcTime, 0, 1);
Дело в том, что методы, оказывается, несут в себе скрытый параметр Self (я когда узнал впервые - офигел), который, видимо, мешает.
← →
addi (2006-12-21 22:48) [6]Спасибо. Буду пробовать.
← →
Германн © (2006-12-22 01:54) [7]
> Vovan #2 (20.12.06 23:34) [5]
...
> Дело в том, что методы, оказывается, несут в себе скрытый
> параметр Self (я когда узнал впервые - офигел), который,
> видимо, мешает.
>
...
Если "офигел", значит не учил матчасть, а сразу приступил к манёврам! :-)
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2007.01.14;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.014 c
