Статьи Королевства Дельфи

         

Часть III


, часть I
, часть II
Вернуться к разделу
авное не знание ,
а умение его правильно применить» В обход своей статьи по желанию трудящихся масс представляю вашему вниманию еще пример для работы с портами теперь уже с портом LPT реализующий чистый вывод потока на принтер (данный пример взят мной из FAQ собранный Акжаном Абдулиным,за что ему огромное спасибо)

Итак…

Ниже пример открытия принтера и записи чистого потока данных в принтер.
Учтите, что Вы должны передать корректное имя принтера, такое, как "HP LaserJet 5MP",чтобы функция сработала успешно. Конечно, Вы можете включать в поток данных любые необходимые управляющие коды, которые могут потребоваться. === Cut === uses WinSpool; procedure WriteRawStringToPrinter(PrinterName:String; S:String); var Handle: THandle; N: DWORD; DocInfo1: TDocInfo1; begin if not OpenPrinter(PChar(PrinterName), Handle, nil) then begin ShowMessage('error ' + IntToStr(GetLastError)); Exit; end; with DocInfo1 do begin pDocName := PChar('test doc'); pOutputFile := nil; pDataType := 'RAW'; end; StartDocPrinter(Handle, 1, @DocInfo1); StartPagePrinter(Handle); WritePrinter(Handle, PChar(S), Length(S), N); EndPagePrinter(Handle); EndDocPrinter(Handle); ClosePrinter(Handle); end; procedure TForm1.Button1Click(Sender: TObject); begin WriteRawStringToPrinter('HP', 'Test This'); end; === Cut === unit TextPrinter; interface uses Windows, Controls, Forms, Dialogs; type TTextPrinter = class(TObject) FNumberOfBytesWritten: Integer; FHandle: THandle; FPrinterOpen: Boolean; FErrorString: PChar; procedure SetErrorString; public constructor Create; procedure Write(const Str: string); procedure WriteLn(const Str: string); destructor Destroy; override; published property NumberOfBytesWritten: Integer read FNumberOfBytesWritten; end; implementation {TTextPrinter} constructor TTextPrinter.Create; begin FHandle := CreateFile('LPT1', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); if FHandle = INVALID_HANDLE_VALUE then begin SetErrorString; raise Exception.Create(FErrorString); end else FPrinterOpen := True; end; procedure TTextPrinter.SetErrorString; begin if FErrorString <> nil then LocalFree(Integer(FErrorString)); FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(), LANG_USER_DEFAULT, @FErrorString, 0, nil); end; procedure TTextPrinter.Write(const Str: string); var OEMStr: PChar; NumberOfBytesToWrite: Integer; begin if not FPrinterOpen then Exit; NumberOfBytesToWrite := Length(Str); OEMStr := PChar(LocalAlloc(LMEM_FIXED, NumberOfBytesToWrite + 1)); try CharToOem(PChar(Str), OEMStr); if not WriteFile(FHandle, OEMStr^, NumberOfBytesToWrite, FNumberOfBytesWritten, nil) then begin SetErrorString; raise Exception.Create(FErrorString); end; finally LocalFree(Integer(OEMStr)); end; end; procedure TTextPrinter.WriteLn(const Str: string); begin Self.Write(Str); Self.Write(#10); end; destructor TTextPrinter.Destroy; begin CloseHandle(FHandle); if FErrorString <> nil then LocalFree(Integer(FErrorString)); end; end. === Cut === P.S. В принципе, вместо LPT1 может стоять что угодно, даже сетевой сервер печати (\\server\prn) - все равно печатает. Можно и параметр в конструктор вставить и т.д.

Ну на примерах остановились идем далее по теме статьи и продолжаем разбирать работу программы «ПетрВес» в которой я хотел бы остановится на следующем : В своей программе по работе с весами ПетрВес (далее во всех продолжениях цикла -«ПетрВес») ее аммы остановится на таком коде // Первоначальное считывание,приминяется для того что-бы установить // все параметры структур по умолчанию if not Windows.GetCommState(hComm, Mode) or not Windows.GetCommTimeouts(hComm,TimeOuts) then exit Else // у нас все хорошо все считалось нормально ,идем далее.. begin with Mode do Begin BaudRate := 9600; ByteSize := 8; Parity := NOPARITY; StopBits := ONESTOPBIT; Flags := EV_RXCHAR + EV_EVENT2; End; // Устанавливаем таймауты with TimeOuts do Begin ReadIntervalTimeout := MAXDWORD; ReadTotalTimeoutMultiplier := 0; ReadTotalTimeoutConstant := 0; End; IF Not SetCommState ( hComm, Mode ) OR Not SetCommTimeOuts(hComm,TimeOuts); Then ShowMessage("Ошибка"); // тут предпринимаем всякие действия // по обработке ошибки End; Итак посмотрим что делает данный код:



Содержание  Назад  Вперед