Отправлено: 14.03.13 18:00. Заголовок: PAGESCRIPT 32 FOR (X)HARBOUR
Пытаюсь прикрутить PageScript 32 к проге на Harbour и облом. К проге на Xharbour прикрутил нормально (работает) Есть в TPSCRIPT.PRG (поставляется вместе с библой)
Harbour естественно не находит Xbp.ch , Dll.ch , не пойму что делать.
=============================================== PAGESCRIPT 32 FOR (X)HARBOUR ===============================================
This file contains important supplementary and late-breaking information that may not appear in the main product documentation. We recommend that you read this file in its entirety.
In order to use PageScript 32 with (x)Harbour, you'll need to distribute PSCRIPT.DLL with your programs. We recommand that PSCRIPT.DLL be copied in the application's folder in order to avoid DLL versions conflicts.
Three files needs to be included in your (x)Harbour projects :
1 - DLLCALL.C 2 - TPSCRIPT.PRG 3 - PSCRIPT.CH
DLLCALL.C gives PageScript a way to call DLL functions in the same way as Xbase++ does. This interface is contributed by Paul Tucker, Ontario, Canada. Many thanks to him for this great contribution.
TPSCRIPT.PRG contains all the PageScript 32 functions and one class, named TPageScript. You may either choose to call PS functions or instantiate TPageScript and use its methods. When you use functions, calling PSInit() automaticaly instanciates a Static TPageScript object.
PSCRIPT.CH contains constants used by PageScript 32.
VAR cDocType INIT "PS32" // признак, с чем работаем VAR hFont VAR nFontSize INIT 5 // in mm VAR nPenSize INIT 1 // in points = 1/72 inch VAR cFileName VAR nPageWidth VAR nPageHeight VAR lPortrait INIT TRUE VAR lWasPrinted INIT FALSE // признак: документ БЫЛ распечатан VAR nPageCounter INIT 1 VAR DPI VAR lTextMode INIT FALSE VAR bMessenger // блок кода, который будет выводиться в случае ошибки // METHOD New( cMode, cDocName, nNumCopies, lLandscape, lDuplex ) CONSTRUCTOR METHOD AddPage() METHOD Finish() // INLINE EVAL( { || PSEndDoc(), lDocInProgress := FALSE, TRUE } ) METHOD ShowError( cMessage ) // METHOD BeginText() INLINE (::lTextMode := TRUE) METHOD EndText() INLINE (::lTextMode := FALSE) // METHOD FontSet( cFontList ) // ==> hNewFont ready to use METHOD FontSize( nNewSize ) // get old / set new font size (mm) METHOD SetFontAndSize( hFont, nSize ) // set new font and its size METHOD TextOut( x, y, cText, nOrigin, lKeepCP ) METHOD TextOutDyn( x, y, cText, nWide, nOrigin ) METHOD TextRect( cText, x, y, nWide, nHigh, cHAlign, cVAlign ) METHOD TextRectDyn( cText, x, y, nWide, nHigh, cHAlign, cVAlign ) METHOD TextStream( x, y, cText, nLineHeight, bAddPage ) METHOD TextWidth( cText ) INLINE ::TextWide( Str2Ansi( cText ) ) // ширина текста в мм // METHOD DrawBox( x, y, nWide, nHigh, nPenSize, aFillRGB) METHOD DrawBox2( x, y, nWide, nHigh) METHOD DrawImage(x, y, nWide, nHigh, cImageFile) INLINE PSBitmap(::dy+y, ::dx+x, ::dy+y+nHigh, ::dx+x+nWide, cImageFile, 0xFFFFFF, TRUE) METHOD PageRulers() METHOD DrawBarCode(x, y, nLineWidePx, nCodeHeight, cType, cCode, nFlags, nOrigin, nShowTextMode, lVert, aEWA ) METHOD DrawEAN13( x, y, nLineWidePx, nCodeHeight, cCode, nOrigin ) METHOD Draw2DCode( x, y, nLineWidePx, cType, cCode, nFlags, nOrigin, lShowText ) // METHOD SetPenSize( nNewSize ) // in 1/72 inch = points! METHOD LineH( x, y, nWidth ) // mm METHOD MoveTo( x, y ) METHOD LineTo( x, y ) METHOD SetRGBFill( r, g, b ) METHOD SetRGBStroke( r, g, b ) METHOD Stroke() INLINE ( NIL ) METHOD Fill() INLINE ( NIL ) METHOD FillStroke() INLINE ( NIL ) // // PROTECTED: // VAR cDocMode // режим печати VAR dx // левое поле VAR dy // верхнее поле VAR nCurrentX // тек.позиция после MoveTo VAR nCurrentY // тек.позиция после MoveTo VAR nFontVShift INIT 0 // 0.1667 // font shift for vert.align in ::TextRectDyn() VAR nPageSize INIT DMPAPER_A4 VAR cEncoder INIT NIL // не используется VAR oPage INIT NIL // не используется // METHOD TextWide( cText ) INLINE ( PSGetTextWidth( cText ) ) // text wide in mm METHOD mm2px( mm ) INLINE ( mm * 0.03937 * ::DPI ) METHOD px2mm( px ) INLINE ( px / (::DPI * 0.03937) ) METHOD px2Font( px ) INLINE ( px * (::DPI / 72) ) METHOD ZebraDraw( hZebra, lVert, a, b, nLineWide, nCodeHeight ) // ENDCLASS
В зависимости от того, что нужно юзеру в данный момент (просмотр/печать или pdf файл), я вызываю либо oETF := PS32():New(...) либо oETF := EPDF():New(...) И дальше формирую документ только через методы oETF (extended text format - мое название переменной ).
Названия методов идентичные, но внутренности реализованы по своему. Вспомнил, что начал написание своего класса EPDF (extended pdf ) из-за дурацкого решения в HPDF, при котором координаты 0,0 - в левом нижнем углу страницы.
Я пока не понял как используя HPDF заюзать аналогичные параметры как в PS32 Про эти пишу: cFontName, nFontSize, nFontStyle, nFontFColor, nFontBColor, nThick Есть идеи ?
Отправлено: 02.04.26 13:44. Заголовок: Dima пишет: Есть ид..
Dima пишет:
цитата:
Есть идеи ?
Сейчас не могу вспомнить почему, но я вообще не использовал эти функции в своем коде. Возможно потому, что я начинал с HPDF и его разметка с началом координат в левом нижнем углу меня не устраивала. А возможно потому, что мне нужно было динамическое уменьшение размера шрифта, чтобы точно его вписать в прямоугольник.
* ------------------------------------------------------------------------ * METHOD TextRectDyn( cText, x, y, nWide, nHigh, cHAlign, cVAlign ) CLASS EPDF
STATIC cDividers := e" \t\r\n",; // stadard text dividers nSTEP := 0.975,; // font scale step nFILL_FACTOR := 0.75 // tex-in-rect fill factor, 1.0 == "full fill"
LOCAL nFontSize, nAreaBox, nAreaTxt, cTxt, nSaveFontSize, nCnt,; i, j, aText, nWordCnt, cWord, nWordWide, nLineWide, nSpaceWide,; nTextWide, cLine, nOrigin, nShift, nX, nY // hb_Default( @cHAlign, "<" ) // horizontal align = left hb_Default( @cVAlign, "-" ) // vertical align = center // cTxt := Str2Ansi( cText ) // 1st of all - change copdepage nFontSize := ::nFontSize // use local - may be changed! nSaveFontSize := ::nFontSize // save for further restore nAreaBox := nWide * nHigh * nFILL_FACTOR // площадь печати в кв.мм nAreaTxt := ::TextWide(cTxt)*nFontSize // площадь текста в кв.мм // IF (nAreaTxt > nAreaBox) nCnt := 0 DO WHILE TRUE nCnt++ // для отладки nFontSize := nFontSize * nSTEP // уменьшаем ::FontSize(nFontSize) // устанавливаем nAreaTxt := ::TextWide(cTxt) * nFontSize // новая площадь текста IF (nAreaTxt < nAreaBox) // fit ? EXIT // ok ENDIF ENDDO // ENDIF // // 1st check - to do not exceed "wide" parameter // nTextWide := ::TextWide(cTxt) IF (nTextWide > nWide) // exceed ? IF nFontSize > (nHigh / (1+INT(nTextWide / nWide))) nFontSize := nHigh / (1+INT(nTextWide / nWide)) nCnt := "1st" // just for info ::FontSize(nFontSize) ENDIF // // 2nd check - text may fit to one string // DO WHILE (::TextWide(cTxt) < nWide*0.99) // nFontSize := nFontSize / nSTEP // increase size nCnt := "2nd" // just for info ::FontSize(nFontSize) ENDDO // ENDIF // // text by words: // i := 1 aText := {} nWordCnt := NUMTOKEN(@cTxt,cDividers) nSpaceWide:= ::TextWide(" ") // wide of "space" - it known now nLineWide := 0 cLine := "" // buffer // DO WHILE (i <= nWordCnt) // all words cWord := " "+TOKEN(@cTxt,cDividers,i) // space+new word nWordWide := ::TextWide(cWord) // width in mm // IF (nWide + nSpaceWide) < (nLineWide + nWordWide) // exceed ? IF (nLineWide > 0) // not empty ? AADD(aText,LTRIM(cLine)) // добавляем набранную строку без пробела слева cLine := "" // новая строка начинается с этого слова nLineWide := 0 // сразу известна его длина i-- // еще раз разберем тек.слово в след. итерации ELSE // строка пустая, слово большое - впихнем по 1 символу пол-слова... j := 0 cWord := LTRIM(cWord) // убираем пробел слева DO WHILE TRUE j++ cLine += SUBSTR(cWord,j,1) // добавляем по одному символу IF ::TextWide(cLine) >= nWide cLine := LEFT(cLine,LEN(cLine)-1) // убираем лишний символ справа j-- // учитываем его EXIT ENDIF ENDDO // AADD(aText,cLine) // добавляем первую часть слова в массив cLine := SUBSTR(cWord,++j)+" " // начинаем от символа j и до конца строки+пробел nLineWide := ::TextWide(cLine) // ширина тек. строки - ненулевая! ENDIF ELSE cLine += cWord // добавляем слово к строке-накопителю nLineWide += nWordWide // наращиваем ширину в мм ENDIF // i++ ENDDO // IF LEN(cLine) > 0 // что-то накопилось ? AADD(aText,LTRIM(cLine)) // добавляем к хвосту текста ENDIF // // Третья проверка: если строк больше, чем влезет - еще раз уменьшаем: // IF LEN(aText) > (nHigh / nFontSize) nFontSize := nHigh / LEN(aText) ::FontSize(nFontSize) nCnt := "3rd " // признак ENDIF // // текст разбит на строки, начинаем вывод // IF LEN(aText) > 0 // есть текст ? // SWITCH cHalign CASE ">" // вправо ? nX := x+nWide // смещаемся вправо на ширину nOrigin := 7 // контр. точка = правый верхний угол текста EXIT CASE "|" // по центру ? nX := x+nWide/2 // смещаемся вправо на пол ширины nOrigin := 4 // контр. точка = верхний центр текста EXIT OTHERWISE nX := x // по умолчанию выравниваем влево nOrigin := 1 // контр. точка - top left END SWITCH // SWITCH cVAlign CASE "^" // вверх ? nY := y // просто верхний угол области EXIT CASE "v" // вниз ? nY := y + nHigh - LEN(aText)*nFontSize // top + высота - высота текста EXIT OTHERWISE nY := y + 0.5 * (nHigh - LEN(aText) * nFontSize) END SWITCH // nShift := ::nFontSize * ::nFontVShift // actually 0.1667 FOR i:=1 TO LEN(aText) ::TextOut(nX,nY-nShift,aText,nOrigin,TRUE) // TRUE = keep CP (codepage) nY += nFontSize // смещаемся на 1 строку вниз NEXT i // выводим диагностику #ifdef DEBUG IF !EMPTY(nCnt) HPDF_Page_SetRGBFill( ::oPage, 0, 0, 1) // blue color = diagnostic ::FontSize(2) ::TextOut(x+nWide-1,y+nHigh-1," ("+hb_ValToExp(nCnt)+" cnt > "+ALLTRIM(STR(nFontSize,15,2))+"mm)",9) HPDF_Page_SetRGBFill( ::oPage, 0, 0, 0) // black again ENDIF #endif // ENDIF // IF nCnt != NIL // изменялся размер текста ? ::FontSize(nSaveFontSize) // восстанавливаем ENDIF // RETURN (nCnt == NIL) // TRUE = всё влезло, FALSE = пришлось масштабировать.
* ------------------------------------------------------------------------ * METHOD TextRectDyn( cText, x, y, nWide, nHigh, cHAlign, cVAlign ) CLASS PS32 // дин. масштабирование
STATIC cDividers := e" \t\r\n",; // stadard text dividers nSTEP := 0.975,; // font scale step nFILL_FACTOR := 0.75 // tex-in-rect fill factor, 1.0 == "full fill"
LOCAL nFontSize, nAreaBox, nAreaTxt, cTxt, nSaveFontSize, nCnt,; i, j, aText, nWordCnt, cWord, nWordWide, nLineWide, nSpaceWide,; nTextWide, cLine, nOrigin, nX, nY, nShift // hb_Default( @cHAlign, "<" ) // horizontal align = left hb_Default( @cVAlign, "-" ) // vertical align = center // cTxt := Str2Ansi( cText ) // 1st of all - change copdepage nFontSize := ::nFontSize // use local - may be changed! nSaveFontSize := ::nFontSize // save for further restore nAreaBox := nWide * nHigh * nFILL_FACTOR // площадь печати в кв.мм nAreaTxt := ::TextWide( cTxt )*nFontSize // площадь текста в кв.мм // IF nAreaTxt > nAreaBox nCnt := 0 DO WHILE TRUE nCnt++ // для отладки nFontSize := nFontSize * nSTEP // уменьшаем ::FontSize( nFontSize ) // устанавливаем nAreaTxt := ::TextWide(cTxt) * nFontSize // новая площадь текста IF nAreaTxt < nAreaBox // fit ? EXIT // ok ENDIF ENDDO // // RawDebug2File( hb_ValToExp( cTxt )+" was exceed print area ("+hb_NTOS( nAreaBox )+"mm), changed size to "+hb_NTOS( ::FontSize ) ) // ENDIF // // 1st check - to do not exceed "wide" parameter // nTextWide := ::TextWide( cTxt ) IF nTextWide > nWide // exceed ? IF nFontSize > ( nHigh / ( 1+INT(nTextWide / nWide)) ) nFontSize := nHigh / ( 1+INT(nTextWide / nWide) ) nCnt := "1st" // just for info ::FontSize( nFontSize ) ENDIF // // 2nd check - text may fit to one string // DO WHILE (::TextWide( cTxt ) < nWide*0.99 ) // nFontSize := nFontSize / nSTEP // increase size nCnt := "2nd" // just for info ::FontSize( nFontSize ) ENDDO // // RawDebug2File( hb_ValToExp(cTxt)+" was exceed line wide ("+hb_NTOS(nWide)+"mm), changed size to "+hb_NTOS( ::FontSize ) ) // ENDIF // // text by words: // i := 1 aText := {} nWordCnt := NUMTOKEN( @cTxt, cDividers ) nSpaceWide := ::TextWide( " " ) // wide of "space" - it's known now nLineWide := 0 cLine := "" // buffer // DO WHILE (i <= nWordCnt) // all words // cWord := " "+TOKEN( @cTxt, cDividers, i ) // space+new word nWordWide := ::TextWide( cWord ) // width in mm // IF (nWide + nSpaceWide) < (nLineWide + nWordWide) // exceed ? IF nLineWide > 0 // not empty ? AADD( aText, LTRIM(cLine) ) // добавляем набранную строку без пробела слева cLine := "" // новая строка начинается с этого слова nLineWide := 0 // сразу известна его длина i-- // еще раз разберем тек.слово в след. итерации ELSE // строка пустая, слово большое - впихнем по 1 символу пол-слова... j := 0 cWord := LTRIM( cWord ) // убираем пробел слева DO WHILE TRUE j++ cLine += SUBSTR( cWord, j, 1 ) // добавляем по одному символу IF ::TextWide( cLine ) >= nWide cLine := LEFT( cLine, LEN( cLine )-1 ) // убираем лишний символ справа j-- // учитываем его EXIT ENDIF ENDDO // AADD( aText, cLine ) // добавляем первую часть слова в массив cLine := SUBSTR( cWord, ++j )+" " // начинаем от символа j и до конца строки+пробел nLineWide := ::TextWide( cLine ) // ширина тек. строки - ненулевая! ENDIF ELSE cLine += cWord // добавляем слово к строке-накопителю nLineWide += nWordWide // наращиваем ширину в мм ENDIF // i++ ENDDO // IF LEN(cLine) > 0 // что-то накопилось ? AADD( aText, LTRIM( cLine ) ) // добавляем к хвосту текста ENDIF // // Третья проверка: если строк больше, чем влезет - еще раз уменьшаем: // IF LEN(aText) > (nHigh / nFontSize) nFontSize := nHigh / LEN(aText) ::FontSize( nFontSize ) nCnt := "3rd " // признак ENDIF // // текст разбит на строки, начинаем вывод // IF LEN(aText) > 0 // есть текст ? // SWITCH cHalign CASE ">" // вправо ? nX := x+nWide // смещаемся вправо на ширину nOrigin := 7 // контр. точка = правый верхний угол текста EXIT CASE "|" // по центру ? nX := x+nWide/2 // смещаемся вправо на пол ширины nOrigin := 4 // контр. точка = верхний центр текста EXIT OTHERWISE nX := x // по умолчанию выравниваем влево nOrigin := 1 // контр. точка - top left END SWITCH // SWITCH cVAlign CASE "^" // вверх ? nY := y // просто верхний угол области EXIT CASE "v" // вниз ? nY := y + nHigh - LEN(aText)*nFontSize // top + высота - высота текста EXIT OTHERWISE nY := y + 0.5 * (nHigh - LEN(aText) * nFontSize) END SWITCH // nShift := ::nFontSize * ::nFontVShift // FOR i:=1 TO LEN( aText ) ::TextOut( nX, nY-nShift, aText, nOrigin, TRUE ) // TRUE == keep codepage nY += nFontSize // смещаемся на 1 строку вниз NEXT i // выводим диагностику #ifdef DEBUG IF !EMPTY( nCnt ) i := PSSetFontFColor( APS_BLUE ) // blue color = diagnostic ::FontSize( 2 ) ::TextOut( x+nWide-1, y+nHigh-1, " ("+hb_ValToExp(nCnt)+" cnt > "+ALLTRIM( STR( nFontSize, 15, 2 ) )+"mm)", 9 ) PSSetFontFColor( i ) // back again ENDIF #endif // ENDIF // IF nCnt # NIL // изменялся размер текста ? ::FontSize( nSaveFontSize ) // восстанавливаем ENDIF // RETURN (nCnt == NIL) // TRUE = всё влезло, FALSE = пришлось масштабировать.
В принципе, если тебе нужно, я скину тебе эти два модуля - они к любому проекту должны прикрутиться без проблем.
Отправлено: 02.04.26 13:54. Заголовок: Если конкретно по шр..
Если конкретно по шрифтам, то я использую эти методы:
METHOD FontSet( cFontList ) // ==> hNewFont ready to use METHOD FontSize( nNewSize ) // get old / set new font size (mm) METHOD SetFontAndSize( hFont, nSize ) // set new font and its size
То есть - сначала передаю все шрифты в виде списка, а потом переключаю их по мере формирования документа. В методы вывода текста
METHOD TextOut( x, y, cText, nOrigin, lKeepCP ) METHOD TextOutDyn( x, y, cText, nWide, nOrigin ) METHOD TextRect( cText, x, y, nWide, nHigh, cHAlign, cVAlign ) METHOD TextRectDyn( cText, x, y, nWide, nHigh, cHAlign, cVAlign ) METHOD TextStream( x, y, cText, nLineHeight, bAddPage )
Не передаю шрифт, они берут текущий по умолчанию. Например, если мне нужен заголовок таблицы, я один раз делаю SetFontAndSize( hFont, nSize ) После чего идет куча TextRect для заголовка Потом снова один SetFontAndSize( hFont, nSize ) и куча уже TextRectDyn для ячеек таблицы - на случай, если что-то не влезет, размер будет автоматически уменьшен.
LOCAL aFillSave,x,y,w,h // #ifdef DEBUG IF ::lTextMode ? "::DrawBox() - invalid call between ::BeginText() / ::EndText()" INKEY(0) RETURN -1 ENDIF #endif // x := ::x2pdf( xMM ) // х без изменений y := ::y2pdf( yMM+nHigh ) // y переводим координату из TL в BL w := ::mm2px( nWide ) // ширина - из мм в точки h := ::mm2px( nHigh ) // высота - из мм в точки // HPDF_Page_SetLineWidth( ::oPage, nPenSize ) // IF hb_IsARRAY( aFillRGB ) aFillSave := HPDF_Page_GetRGBFill( ::oPage ) HPDF_Page_SetRGBFill( ::oPage, aFillRGB[1], aFillRGB[2], aFillRGB[3] ) HPDF_Page_Rectangle( ::oPage, x, y, w, h ) // IF nPenSize > 0 HPDF_Page_FillStroke( ::oPage ) ::nPenSize := nPenSize // если задана толщина = сохраняем её в объекте ELSE HPDF_Page_Fill( ::oPage ) ENDIF HPDF_Page_SetRGBFill( ::oPage, aFillSave[1], aFillSave[2], aFillSave[3] ) ELSE HPDF_Page_Rectangle( ::oPage, x, y, w, h ) HPDF_Page_Stroke( ::oPage ) ENDIF // #ifdef DEBUG // отрисовка центральных линий по горизонтали и вертикали, если есть рамка IF hb_IsNumeric( nPenSize ) .AND. ( nPenSize > 0 ) IF (nHigh < ::nPageHeight/2) HPDF_Page_SetLineWidth( ::oPage, nPenSize / 2) HPDF_Page_Rectangle( ::oPage,x,y,w/2,h/2) HPDF_Page_Rectangle( ::oPage,x+w/2,y+h/2,w/2,h/2) HPDF_Page_Stroke( ::oPage ) ENDIF HPDF_Page_SetLineWidth( ::oPage, ::nPenSize ) // восст.толщину линии ENDIF #endif // RETURN ::ShowError( "DrawBox()" )
Все даты в формате GMT
3 час. Хитов сегодня: 62
Права: смайлы да, картинки да, шрифты да, голосования нет
аватары да, автозамена ссылок вкл, премодерация откл, правка нет
). 
) из-за дурацкого решения в HPDF, при котором координаты 0,0 - в левом нижнем углу страницы. 
- участник сейчас на форуме
- участник вне форума