00502.txt

Delphi编程五大妙招源程序

1：判断系统是否安装了声卡
   欲判断系统是否安装了声卡，调用Winmm.dll中的waveOutGetNumDevs和midiOutGetNumDevs就可以判断是否安装了声卡。这两个函数在Var部分的说明如下：
  function waveOutGetNumDevs: longint; stdcall; external 'winmm.dll' name 'waveOutGetNumDevs';
  function midiOutGetNumDevs: longint; stdcall; external 'winmm.dll' name 'midiOutGetNumDevs';

//判断声卡是否存在
Function IsSoundcardInstalled : Boolean ;
Var
  WaveOutPutDeviceCount: Integer ;
  MidiOutPutDeviceCount : Integer ;
Begin
  Result := False ;
  WaveOutPutDeviceCount := waveOutGetNumDevs ;
  MidiOutPutDeviceCount := midiOutGetNumDevs ;
  if (WaveOutPutDeviceCount>0) and (MidiOutPutDeviceCount>0) Then Result := True
                                                            Else Result := False ;

End ;


procedure TForm1.Button1Click(Sender: TObject);
Begin
  if IsSoundcardInstalled Then ShowMessage('系统已经安装了声卡')
                          Else ShowMessage('系统没有安装声卡') ;

end;


2：如何把程序关闭的控制权，掌握在自己手里
   在一般的应用程序中，按Alt+F4就可以关闭或者在系统菜单里面，选择了关闭这个菜单项，就可以关闭当前的应用程序，如何屏蔽掉系统的菜单的关闭功能（Alt+F4）失效呢，实现的方法和简单，就是当当前的应用程序收到关闭消息时，把CanClose:=FALSE; 
在本程序中，设置一个全局变量bClose，用他来控制能否关闭当前应用程序，只有单击Button3时才可以关闭当前的应用程序。

procedure TForm1.FormCreate(Sender: TObject);
begin
  bClose := False ;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := bClose ;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  bClose := True ;
  Close ;
end;


3：写一个简单的多线程的程序
使用线程时有两个主要任务：第一，创建线程，第二，创建线程入口函数。Windows API调用CreateThread函数来创建一个线程。  
hthread := CreateThread(nil,         //是安全属性，如果此参数设为Nil，使用的是缺省安全属性，在Windows95/98下，标准的就设为Nil，只有想此线程有子线程时才可能脱离这种模式。
                        0,           //如果这个参数为0，就是线程的堆栈长度和此应用程序的的堆栈长度相同，可以总把此参数设置为0
                        @ThreadFunc, //线程开始初的线程名称，
                        nil,         // argument of thread
                        0,           // Create flags
                        ThreadID);   // thread ID


function ThreadFunc(P: Pointer): LongInt; stdcall;
var
  i: Integer;
  DC: HDC;
  S: string;
begin
  DC := GetDC(Form1.Handle);
  SetBkColor(DC, GetSysColor(color_btnface));
  for i := 0 to 100000 do begin
    S := IntToStr(i);
    TextOut(DC, 10, 10, PChar(S), Length(S));

  end;
  ReleaseDC(Form1.Handle, DC);
end;

//采用一个多线程
procedure TForm1.Button4Click(Sender: TObject);
var
  hThread: THandle;
  ThreadID: DWord;
begin
  hthread := CreateThread(nil,         //Security attribute
                          0,           //Initial Stack
                          @ThreadFunc, //Starting address of thread
                          nil,         // argument of thread
                          0,           // Create flags
                          ThreadID);   // thread ID

  if hthread = 0 then
    MessageBox(Handle, 'No Thread', nil, MB_OK);
end;

//采用单线程
procedure TForm1.Button5Click(Sender: TObject);
begin
  ThreadFunc(nil);
end;