Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

  DCB.ByteSize:=5;

 tdbSix:

  DCB.ByteSize:=6;

 tdbSeven:

  DCB.ByteSize:=7;

 tdbEight:

  DCB.ByteSize:=8;

 end;

 SetCommState(DCB);

end;

procedure TComm.SetStopBits(Value:TStopBits);

var DCB:TDCB;

begin

 FStopBits:=Value;

 if hComm<0 then exit;

 GetCommState(hComm,DCB);

 case Value of

 tsbOne:

  DCB.StopBits:=0;

 tsbOnePointFive:

  DCB.StopBits:=1;

 tsbTwo:

  DCB.StopBits:=2;

 end;

 SetCommState(DCB);

end;

procedure TComm.SetReadBufferSize(Value:Word);

begin

 FReadBufferSize:=Value;

 SetPort(FPort);

end;

procedure TComm.SetWriteBufferSize(Value:Word);

begin

 FWriteBufferSize:=Value;

 SetPort(FPort);

end;

procedure TComm.SetRxFull(Value:Word);

begin

 FRxFull:=Value;

 if hComm<0 then exit;

 EnableCommNotification(hComm,FWindowHandle,FRxFull,FTxLow);

end;

procedure TComm.SetTxLow(Value:Word);

begin

 FTxLow:=Value;

 if hComm<0 then exit;

 EnableCommNotification(hComm,FWindowHandle,FRxFull,FTxLow);

end;

procedure TComm.SetEvents(Value:TCommEvents);

var EventMask:Word;

begin

 FEvents:=Value;

 if hComm<0 then exit;

 EventMask:=0;

 if tceBreak in FEvents then inc(EventMask,EV_BREAK);

 if tceCts in FEvents then inc(EventMask,EV_CTS);

 if tceCtss in FEvents then inc(EventMask,EV_CTSS);

 if tceDsr in FEvents then inc(EventMask,EV_DSR);

 if tceErr in FEvents then inc(EventMask,EV_ERR);

 if tcePErr in FEvents then inc(EventMask,EV_PERR);

 if tceRing in FEvents then inc(EventMask,EV_RING);

 if tceRlsd in FEvents then inc(EventMask,EV_RLSD);

 if tceRlsds in FEvents then inc(EventMask,EV_RLSDS);

 if tceRxChar in FEvents then inc(EventMask,EV_RXCHAR);

 if tceRxFlag in FEvents then inc(EventMask,EV_RXFLAG);

 if tceTxEmpty in FEvents then inc(EventMask,EV_TXEMPTY);

 SetCommEventMask(hComm,EventMask);

end;

procedure TComm.WndProc(var Msg:TMessage);

begin

 with Msg do begin

  if Msg=WM_COMMNOTIFY then begin

   case lParamLo of

   CN_EVENT:

    DoEvent;

   CN_RECEIVE:

    DoReceive;

   CN_TRANSMIT:

    DoTransmit;

   end;

  end else Result:=DefWindowProc(FWindowHandle, Msg, wParam, lParam);

 end;

end;

procedure TComm.DoEvent;

var

 CommEvent:TCommEvents;

 EventMask:Word;

begin

 if (hComm<0) or not Assigned(FOnEvent) then exit;

 EventMask:=GetCommEventMask(hComm,Integer($FFFF));

 CommEvent:=[];

 if (tceBreak in Events) and (EventMask and EV_BREAK<>0) then CommEvent:=CommEvent+[tceBreak];

 if (tceCts in Events) and (EventMask and EV_CTS<>0) then CommEvent:=CommEvent+[tceCts];

 if (tceCtss in Events) and (EventMask and EV_CTSS<>0) then CommEvent:=CommEvent+[tceCtss];

 if (tceDsr in Events) and (EventMask and EV_DSR<>0) then CommEvent:=CommEvent+[tceDsr];

 if (tceErr in Events) and (EventMask and EV_ERR<>0) then CommEvent:=CommEvent+[tceErr];

 if (tcePErr in Events) and (EventMask and EV_PERR<>0) then CommEvent:=CommEvent+[tcePErr];

 if (tceRing in Events) and (EventMask and EV_RING<>0) then CommEvent:=CommEvent+[tceRing];

 if (tceRlsd in Events) and (EventMask and EV_RLSD<>0) then CommEvent:=CommEvent+[tceRlsd];

 if (tceRlsds in Events) and (EventMask and EV_Rlsds<>0) then CommEvent:=CommEvent+[tceRlsds];

 if (tceRxChar in Events) and (EventMask and EV_RXCHAR<>0) then CommEvent:=CommEvent+[tceRxChar];

 if (tceRxFlag in Events) and (EventMask and EV_RXFLAG<>0) then CommEvent:=CommEvent+[tceRxFlag];

 if (tceTxEmpty in Events) and (EventMask and EV_TXEMPTY<>0) then CommEvent:= CommEvent+[tceTxEmpty];

 FOnEvent(Self,CommEvent);

end;

procedure TComm.DoReceive;

var Stat:TComStat;

begin

 if (hComm<0) or not Assigned(FOnReceive) then exit;

 GetCommError(hComm,Stat);

 FOnReceive(Self,Stat.cbInQue);

 GetCommError(hComm,Stat);

end;

procedure TComm.DoTransmit;

var Stat:TComStat;

begin

 if (hComm<0) or not Assigned(FOnTransmit) then exit;

 GetCommError(hComm,Stat);

 FOnTransmit(Self,Stat.cbOutQue);

end;

procedure TComm.Loaded;

begin

 inherited Loaded;

 HasBeenLoaded:=True;

 SetPort(FPort);

end;

constructor TComm.Create(AOwner:TComponent);

begin

 inherited Create(AOwner);

 FWindowHandle:=AllocateHWnd(WndProc);

 HasBeenLoaded:=False;

 Error:=False;

 FPort:=PortDefault;

 FBaudRate:=BaudRateDefault;

 FParity:=ParityDefault;

 FDataBits:=DataBitsDefault;

 FStopBits:=StopBitsDefault;

 FWriteBufferSize:=WriteBufferSizeDefault;

 FReadBufferSize:=ReadBufferSizeDefault;

 FRxFull:=RxFullDefault;

 FTxLow:=TxLowDefault;

 FEvents:=EventsDefault;

 hComm:=-1;

end;

destructor TComm.Destroy;

begin

 DeallocatehWnd(FWindowHandle);

 if hComm>=0 then CloseComm(hComm);

 inherited Destroy;

end;

procedure TComm.Write(Data:PChar;Len:Word);

begin

 if hComm<0 then exit;

 if WriteComm(hComm,Data,Len)<0 then Error:=True;

 GetCommEventMask(hComm,Integer($FFFF));

end;

procedure TComm.Read(Data:PChar;Len:Word);

begin

 if hComm<0 then exit;

 if ReadComm(hComm,Data,Len)<0 then Error:=True;

 GetCommEventMask(hComm,Integer($FFFF));

end;

function TComm.IsError:Boolean

begin

 IsError:=Error;

 Error:=False;

end;

procedure Register;

begin

 RegisterComponents('Additional',[TComm]);

end;

end.

Принтер

Печать табуляторов с помощью TextOut

Delphi 2 

Я пытаюсь напечатать некий текст с помощью Printer.Canvas.TextOut. Моя строка содержит табуляторы, но они почему-то печатаются на бумаге в виде черных прямоугольников. Как мне правильно напечатать строку, содержащую табуляторы?

Обратите внимание на функцию API «TabbedTextOut». Ваш холст (canvas) воспользоваться ей не сможет, но вы можете просто вызвать эту API функцию и передать ей дескриптор холста.

– Bob Fisher

Печать через спулер на матричный принтер

Оргиш Александр (FIDO: 2:454/3.24) пишет:

Печатаю через спулер на матричный принтер текст таким образом :

Var

 pcbNeeded: DWORD;

 FDevice: PChar;

 FPort: PChar;

 FDriver: PChar;

 FPrinterHandle: THandle;

 FDeviceMode: THandle;

 FJob: PADDJOBINFO1;

 Stream: TFileStream;

begin

 GetMem(FDevice, 128);

 GetMem(FDriver, 128);

 GetMem(FPort, 128);

 Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);

 if FDeviceMode = 0 then Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);

 if OpenPrinter(FDevice, FPrinterHandle, nil) then  begin

  GetMem(FJob,1024);

  //Добавляем задание, получаем имя файла в директории windows\spoool\

  AddJob(FPrinterHandle,1,FJob,1024,pcbNeeded);

  Stream:=TFileStream.Create(FJob.Path,fmCreate);

  // Дальше пишем текст (+ESC команды!!!!) прямо в Stream