delphi3开发使用手册得一个例子(100分)

F

fjpan

Unregistered / Unconfirmed
GUEST, unregistred user!
unit padlock;
interface
uses
windows;
type tsepadlock = class
private
fcritsect: trtlcriticalsection;
protected
procedure setlocked(l: boolean);
public
constructor create;
destructor destroy ;
override;
property locked :boolean write setlocked;
end;

implementation
constructor tsepadlock.create;
begin
initializecriticalsection(fcritsect);
end;

destructor tsepadlock.destroy;
begin
deletecriticalsection(fcritsect);
end;

procedure tsepadlock.setlocked(l:boolean);
begin
if l then
entercriticalsection(fcritsect)
else
leavecriticalsection(fcritsect);
end;
end.




program testpadlock;
{$apptype console }
{$define usepadlock}
uses
sysutils,
windows,
padlock;
var consolepadlock :tsepadlock;
procedure safewriteln(const s:string);
begin
{$ifdef usepadlock}
consolepadlock.locked:=true;
try
writeln(s);
finally
consolepadlock.locked:=false;
end;
{$else
}
writeln(s);
{$endif}
end;
function englishthreadroutine(P:pointer):integer;
var
threadid: integer ;
i: integer;
begin
result:=0;
threadid:=getcurrentthreadid;
for i:=1 to 20do
safewriteln(format('[%x] current line: %d' , [threadid,i]));
end;

function frenchthreadroutine(p:pointer):integer;
var
threadid:integer;
i : integer;
begin
result:=0;
threadid:= getcurrentthreadid;
for i:=1 to 20do
safewriteln(format('[%x] ligne courant : %d',[threadid, i]));
end;

var
handles: array[0..1] of integer ;
threadid: integer ;
begin
fillchar(handles,sizeof(handles),0);
consolepadlock:=tsepadlock.create;
engthr:= englishthreadroutine;
frenthr:= frenchthreadroutine;
try
handles[0]:=begin
thread(nil,0,englishthreadroutine,nil,0,threadid);
handles[1]:=begin
thread(nil,0,frenchthreadroutine,nil,0,threadid);
waitformultipleobjects(2,@handles,true,infinite);
finally
if (handles[0]<>0) then
closehandle(handles[0]);
if (handles[1]<>0) then
closehandle(handles[1]);
consolepadlock.free;
end;
writeln('press<enter> to close...');
readln;
end.


程序运行到了
handles[0]:=begin
thread(nil,0,englishthreadroutine,nil,0,threadid);
handles[1]:=begin
thread(nil,0,frenchthreadroutine,nil,0,threadid);
就有For a variable parameter, the actual argument must be of the exact type of the formal parameter.
why?
plz help me
 
begin
thread的定义:
function begin
Thread(SecurityAttributes: Pointer;
StackSize: LongWord;
ThreadFunc: TThreadFunc;
Parameter: Pointer;
CreationFlags: LongWord;
var ThreadId: LongWord): Integer;
^^^^^^^^^^^^^^^^^^
在您的程序中:
function frenchthreadroutine(p:pointer):integer;
var
threadid:integer;
^^^^^^^^^^^^^^^^^
看到了吗? 类型不同. 呵呵 (var参数类型必须完全一样)
请改成
var
threadid: LongWord;
 
呵呵,你用的一定是DELPHI4/5, begin
THREAD的定义不同, D3可以通过, D4/5就
不行了, 照EYES说的改吧.
 
主程序应改为:
program testpadlock;
{$apptype console }
{$define usepadlock}
uses
sysutils,
windows,
padlock;
var consolepadlock :tsepadlock;
procedure safewriteln(const s:string);
begin
{$ifdef usepadlock}
consolepadlock.locked:=true;
try
writeln(s);
finally
consolepadlock.locked:=false;
end;
{$else
}
writeln(s);
{$endif}
end;
function englishthreadroutine(P:pointer):integer;
var
threadid: integer ;
i: integer;
begin
result:=0;
threadid:=getcurrentthreadid;
for i:=1 to 20do
safewriteln(format('[%x] current line: %d' , [threadid,i]));
end;
function frenchthreadroutine(p:pointer):integer;
var
threadid:integer;
i : integer;
begin
result:=0;
threadid:= getcurrentthreadid;
for i:=1 to 20do
safewriteln(format('[%x] ligne courant : %d',[threadid, i]));
end;

var
handles: array[0..1] of integer ;
threadid: integer ;
begin
fillchar(handles,sizeof(handles),0);
consolepadlock:=tsepadlock.create;
//engthr:= englishthreadroutine;
//frenthr:= frenchthreadroutine;
try
handles[0]:=begin
thread(nil,0,@englishthreadroutine,nil,0,LongWord(threadid));
handles[1]:=begin
thread(nil,0,@frenchthreadroutine,nil,0,LongWord(threadid));
waitformultipleobjects(2,@handles,true,infinite);
finally
if (handles[0]<>0) then
closehandle(handles[0]);
if (handles[1]<>0) then
closehandle(handles[1]);
consolepadlock.free;
end;
writeln('press to close...');
readln;
end.
 
研究研究。
 
什么版本的开发手册,我也想要一分,那里有买,
你觉的好吗?
 
多人接受答案了。
 

Similar threads

I
回复
0
查看
442
import
I
I
回复
0
查看
449
import
I
I
回复
0
查看
660
import
I
I
回复
0
查看
686
import
I
顶部