Советы по 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;