Форма входа
Читем онлайн Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров
Шрифт:
-
+
Интервал:
-
+
Закладка:
Сделать
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);
//Добавляем задание, получаем имя файла в директории windowsspoool
AddJob(FPrinterHandle,1,FJob,1024,pcbNeeded);
Stream:=TFileStream.Create(FJob.Path,fmCreate);
// Дальше пишем текст (+ESC команды!!!!) прямо в Stream
На этой странице вы можете бесплатно читать книгу Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров бесплатно.
Похожие на Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров книги
- Python для детей. Анимация с черепашьей графикой - Виктор Рабинович - Прочая детская литература / Программирование
- Программист-фанатик - Чед Фаулер - Программирование
- Эффективное использование STL - Скотт Мейерс - Программирование
- Как функции, не являющиеся методами, улучшают инкапсуляцию - Скотт Мейерс - Программирование
- Как я делаю мультфильмы - Андрей Шумин - Прочая научная литература / Прочее / Программирование
- Программирование - Ирина Козлова - Программирование
- Программирование на языке Пролог для искусственного интеллекта - Иван Братко - Программирование
- Новое в зарплатном учете в 2023 году: лайфхаки бухгалтера в 1С - Компания СервисКлауд - Программирование / Финансы
- ВСТУП ДО ІНЖЕНЕРІЇ ПРОГРАМНОГО ЗАБЕЗПЕЧЕННЯ - М. Сидоров - Программирование
