Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
Как из программы переключить раскладку клавиатуры?
Одной строкой
Nomadic отвечает:
A: ActivateKeyboardLayout(). Учтите, что использование этой функции – плохой тон.
Модем
Как получить список установленных модемов в Win95/98?
Nomadic советует:
unit PortInfo;
interface
uses Windows, SysUtils, Classes, Registry;
function EnumModems: TStrings;
implementation
function EnumModems: TStrings;
var
R: TRegistry;
s: ShortString;
N: TStringList;
i: integer;
j: integer;
begin
Result:= TStringList.Create;
R:= TRegistry.Create;
try
with R do begin
RootKey:= HKEY_LOCAL_MACHINE;
if OpenKey('SystemCurrentControlSetServicesClassModem', False) then
if HasSubKeys then begin
N:= TStringList.Create;
try
GetKeyNames(N);
for i:=0 to N.Count – 1 do begin
closekey; { + }
openkey('SystemCurrentControlSetServicesClassModem',false); { + }
OpenKey(N[i], False);
s:= ReadString('AttachedTo');
for j:=1 to 4 do if pos(chr(j+ord('0')), s) > 0 then Break;
Result.AddObject(ReadString('DriverDesc'),TObject(j));
CloseKey;
end;
finally
N.Free;
end;
end;
end;
finally
R.Free;
end;
end;
end.
Порты
Асинхронная связь
Delphi 1
unit Comm;
interface
uses Messages,WinTypes,WinProcs,Classes,Forms;
type
TPort=(tptNone,tptOne,tptTwo,tptThree,tptFour,tptFive,tptSix,tptSeven,tptEight);
TBaudRate= (tbr110, tbr300, tbr600, tbr1200, tbr2400, tbr4800, tbr9600, tbr14400, tbr19200, tbr38400, tbr56000, tbr128000, tbr256000);
TParity=(tpNone,tpOdd,tpEven,tpMark,tpSpace);
TDataBits=(tdbFour,tdbFive,tdbSix,tdbSeven,tdbEight);
TStopBits=(tsbOne,tsbOnePointFive,tsbTwo);
TCommEvent=(tceBreak, tceCts, tceCtss, tceDsr, tceErr, tcePErr, tceRing, tceRlsd, tceRlsds, tceRxChar, tceRxFlag, tceTxEmpty);
TCommEvents=set of TCommEvent;
const
PortDefault=tptNone;
BaudRateDefault=tbr9600;
ParityDefault=tpNone;
DataBitsDefault=tdbEight;
StopBitsDefault=tsbOne;
ReadBufferSizeDefault=2048;
WriteBufferSizeDefault=2048;
RxFullDefault=1024;
TxLowDefault=1024;
EventsDefault=[];
type
TNotifyEventEvent=procedure(Sender:TObject; CommEvent:TCommEvents) of object;
TNotifyReceiveEvent=procedure(Sender:TObject; Count:Word) of object;
TNotifyTransmitEvent=procedure(Sender:TObject; Count:Word) of object;
TComm=class(TComponent)
private
FPort:TPort;
FBaudRate:TBaudRate;
FParity:TParity;
FDataBits:TDataBits;
FStopBits:TStopBits;
FReadBufferSize:Word;
FWriteBufferSize:Word;
FRxFull:Word;
FTxLow:Word;
FEvents:TCommEvents;
FOnEvent:TNotifyEventEvent;
FOnReceive:TNotifyReceiveEvent;
FOnTransmit:TNotifyTransmitEvent;
FWindowHandle:hWnd;
hComm:Integer;
HasBeenLoaded:Boolean;
Error:Boolean;
procedure SetPort(Value:TPort);
procedure SetBaudRate(Value:TBaudRate);
procedure SetParity(Value:TParity);
procedure SetDataBits(Value:TDataBits);
procedure SetStopBits(Value:TStopBits);
procedure SetReadBufferSize(Value:Word);
procedure SetWriteBufferSize(Value:Word);
procedure SetRxFull(Value:Word);
procedure SetTxLow(Value:Word);
procedure SetEvents(Value:TCommEvents);
procedure WndProc(var Msg:TMessage);
procedure DoEvent;
procedure DoReceive;
procedure DoTransmit;
protected
procedure Loaded; override;
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure Write(Data:PChar; Len:Word);
procedure Read(Data:PChar; Len:Word);
function IsError:Boolean;
published
property Port:TPort read FPort write SetPort default PortDefault;
property BaudRate:TBaudRate read FBaudRate write SetBaudRate default BaudRateDefault;
property Parity:TParity read FParity write SetParity default ParityDefault;
property DataBits:TDataBits read FDataBits write SetDataBits default DataBitsDefault;
property StopBits:TStopBits read FStopBits write SetStopBits default StopBitsDefault;
property WriteBufferSize:Word read FWriteBufferSize write SetWriteBufferSize default WriteBufferSizeDefault;
property ReadBufferSize:Word read FReadBufferSize write SetReadBufferSize default ReadBufferSizeDefault;
property RxFullCount:Word read FRxFull write SetRxFull default RxFullDefault;
property TxLowCount:Word read FTxLow write SetTxLow default TxLowDefault;
property Events:TCommEvents read FEvents write SetEvents default EventsDefault;
property OnEvent:TNotifyEventEvent read FOnEvent write FOnEvent;
property OnReceive:TNotifyReceiveEvent read FOnReceive write FOnReceive;
property OnTransmit:TNotifyTransmitEvent read FOnTransmit write FOnTransmit;
end;
procedure Register;
implementation
procedure TComm.SetPort(Value:TPort);
const CommStr:PChar='COM1:';
begin
FPort:=Value;
if (csDesigning in ComponentState) or (Value=tptNone) or (not HasBeenLoaded) then exit;
if hComm>=0 then CloseComm(hComm);
CommStr[3]:=chr(48+ord(Value));
hComm:=OpenComm(CommStr,ReadBufferSize,WriteBufferSize);
if hComm<0 then begin
Error:=True;
exit;
end;
SetBaudRate(FBaudRate);
SetParity(FParity);
SetDataBits(FDataBits);
SetStopBits(FStopBits);
SetEvents(FEvents);
EnableCommNotification(hComm,FWindowHandle,FRxFull,FTxLow);
end;
procedure TComm.SetBaudRate(Value:TBaudRate);
var DCB:TDCB;
begin
FBaudRate:=Value;
if hComm>=0 then begin
GetCommState(hComm,DCB);
case Value of
tbr110:
DCB.BaudRate:=CBR_110;
tbr300:
DCB.BaudRate:=CBR_300;
tbr600:
DCB.BaudRate:=CBR_600;
tbr1200:
DCB.BaudRate:=CBR_1200;
tbr2400:
DCB.BaudRate:=CBR_2400;
tbr4800:
DCB.BaudRate:=CBR_4800;
tbr9600:
DCB.BaudRate:=CBR_9600;
tbr14400:
DCB.BaudRate:=CBR_14400;
tbr19200:
DCB.BaudRate:=CBR_19200;
tbr38400:
DCB.BaudRate:=CBR_38400;
tbr56000:
DCB.BaudRate:=CBR_56000;
tbr128000:
DCB.BaudRate:=CBR_128000;
tbr256000:
DCB.BaudRate:=CBR_256000;
end;
SetCommState(DCB);
end;
end;
procedure TComm.SetParity(Value:TParity);
var DCB:TDCB;
begin
FParity:=Value;
if hComm<0 then exit;
GetCommState(hComm,DCB);
case Value of
tpNone:
DCB.Parity:=0;
tpOdd:
DCB.Parity:=1;
tpEven:
DCB.Parity:=2;
tpMark:
DCB.Parity:=3;
tpSpace:
DCB.Parity:=4;
end;
SetCommState(DCB);
end;
procedure TComm.SetDataBits(Value:TDataBits);
var DCB:TDCB;
begin
FDataBits:=Value;
if hComm<0 then exit;
GetCommState(hComm,DCB);
case Value of
tdbFour:
DCB.ByteSize:=4;
tdbFive:
DCB.ByteSize:=5;
tdbSix:
DCB.ByteSize:=6;
tdbSeven:
DCB.ByteSize:=7;
tdbEight:
DCB.ByteSize:=8;
