\ Распечатка картинок по несколько штук на листе \ Ю. Жиловец, 13.02.2004 \ REQUIRE DebugOn ~ac/lib/debug/trace.f REQUIRE WINDOWS... ~yz/lib/wincc.f REQUIRE { lib/ext/locals.f REQUIRE <( ~yz/lib/format.f REQUIRE single-method ~yz/lib/interfaces.f REQUIRE RESOURCES: ~yz/lib/resources.f REQUIRE traverse-files ~yz/lib/findfile.f REQUIRE <( ~yz/lib/format.f REQUIRE last-character ~yz/lib/filename.f REQUIRE (: ~yz/lib/inline.f REQUIRE CAPI: ~af/lib/c/capi.f " Tprint 1.00" ASCIIZ progname " ./tprint.ini" ASCIIZ profile REQUIRE read-profile ~yz/lib/profile.f 5 == max-hor-pieces 10 == max-vert-pieces 210 == sheet-w 297 == sheet-h 10 == sheet-margin 5 == caption-h 5 == luft 100 == max-pages \ ----------------------------------- : write-profile-int ( sect key n -- ) >R <( R> " ~N" )> write-profile ; \ ----------------------------------- CREATE printer-name 100 ALLOT 0 VALUE printer-handle 0 VALUE devmode 0 VALUE pieces 0 VALUE hor-pieces 0 VALUE vert-pieces 0 VALUE piece-w 0 VALUE piece-h 0 VALUE lvdirs 0 VALUE imglist 0 VALUE pages 0 VALUE current-page 0 VALUE total-pages 0 VALUE total-photos 0 VALUE extra-pages 0 VALUE up 0 VALUE down 0 VALUE ht 0 VALUE vt 0 VALUE pages-label 0 VALUE smallpage 0 VALUE bigpage 0 VALUE printers 0 VALUE photos-label 0 VALUE small-font VAR bp-cached? VAR bp-cache-dc VAR bp-cache-bmp \ ------------------------------------ PROC: draw-status { \ x x2 } lparam 7 CELLS@ TO x lparam 9 CELLS@ TO x2 x2 x - lparam 11 CELLS@ ( percent) 100 */ x + lparam 9 CELLS! W: color_highlight 1+ paint-rect windc FillRect DROP PROC; : progress-to ( n -- ) \ n - в процентах от ширины окна статуса W: sbt_ownerdraw SWAP W: sb_settexta winmain -status@ send DROP ; : add-total-photos ( n -- ) total-photos + TO total-photos <( total-photos " ~N" )> photos-label -text! ; : show-pages-label <( current-page total-pages " ~N/~N" )> pages-label -text! current-page 2 < IF down windisable ELSE down winenable THEN current-page total-pages = IF up windisable ELSE up winenable THEN 0 TO bp-cached? bigpage force-redraw ; \ ------------------------------------ WINAPI: EnumPrintersA WINSPOOL.DRV WINAPI: GetProfileStringA KERNEL32.DLL WINAPI: DocumentPropertiesA WINSPOOL.DRV WINAPI: OpenPrinterA WINSPOOL.DRV WINAPI: ClosePrinter WINSPOOL.DRV : del-info-about-printer printer-handle ?DUP IF ClosePrinter DROP devmode MFREEMEM THEN ; PROC: newprinter { \ h } \ запоминаем имя текущего принтера printer-name printers -selected@ printers fromcombo \ уничтожаем информацию о предыдущем del-info-about-printer \ и заносим новую: 0 ^ h printer-name OpenPrinterA DROP h TO printer-handle 0 0 0 0 h 0 DocumentPropertiesA MGETMEM TO devmode W: dm_out_buffer 0 devmode printer-name h 0 DocumentPropertiesA DROP PROC; : set-print-controls { \ no cnt } ^ no ^ cnt 1000 HERE 4 0 0x6 ( printer_enum_local printer_enum_connections) EnumPrintersA DROP no 0 ?DO HERE I 3 CELLS * + @ printers addstring LOOP printer-name C@ 0= IF 100 printer-name "" " device" " windows" GetProfileStringA DROP printer-name BEGIN DUP C@ c: , <> WHILE 1+ REPEAT 0! THEN -1 printer-name W: cb_findstringexact printers send printers -selected! newprinter EXECUTE ; PROC: setup (* dm_in_buffer dm_prompt dm_out_buffer *) devmode devmode printer-name printer-handle winmain -hwnd@ DocumentPropertiesA W: idok = IF \ принудительно выставляем A4, портрет devmode 10 CELLS@ (* dm_orientation dm_papersize *) OR devmode 10 CELLS! W: dmorient_portrait devmode 11 CELLS+ W! W: dmpaper_a4 devmode 11 CELLS+ 2+ W! THEN PROC; WINAPI: CreateDCA GDI32.DLL WINAPI: CreateBitmap GDI32.DLL WINAPI: Rectangle GDI32.DLL WINAPI: DrawTextA USER32.DLL \ =================================== 0 CELL -- :lv-list CELL -- :lv-fullname == #lvrecord 0 CELL -- :pageDir CELL -- :pageFile == #page-record VARIABLE gen-dir VARIABLE gen-file VARIABLE gen-count : dir>count ( dir -- # ) DUP -1 = IF DROP 0 ELSE lvdirs -iparam@ :lv-list @ lb-count THEN ; : dir>list ( dir -- list ) lvdirs -iparam@ :lv-list @ ; : dir>name ( dir -- name ) lvdirs -iparam@ :lv-fullname @ ; : page-dir-file ( page -- dir file ) 1- #page-record * pages + DUP :pageDir @ SWAP :pageFile @ ; : init-gen ( dir file -- ) gen-file ! DUP gen-dir ! dir>count gen-count ! ; : next-dir ( -- ?) BEGIN gen-dir 1+! gen-dir @ lvdirs item-count = IF FALSE EXIT THEN gen-dir @ dir>count DUP gen-count ! UNTIL gen-file 0! TRUE ; : next-photo ( -- ?) gen-file 1+! \ фотографии в каталоге кончились? gen-file @ gen-count @ = IF next-dir ELSE TRUE THEN ; : next-n-photos ( n -- ) 0 DO next-photo 0= IF LEAVE THEN LOOP ; : calculate-pages total-photos hor-pieces vert-pieces * /MOD SWAP IF 1+ THEN TO total-pages total-pages max-pages > IF total-pages TO extra-pages 0 TO total-pages ELSE 0 TO extra-pages THEN total-pages 0= IF 0 TO current-page ELSE -1 -1 init-gen next-photo DROP total-pages 0 DO pages I #page-record * + gen-dir @ OVER :pageDir ! gen-file @ SWAP :pageFile ! hor-pieces vert-pieces * next-n-photos LOOP current-page 1 MAX total-pages MIN TO current-page THEN show-pages-label ; : recount-pages calculate-pages smallpage force-redraw ; : set-pieces sheet-w sheet-margin 2* - hor-pieces 1- luft * - hor-pieces / TO piece-w sheet-h sheet-margin 2* - luft vert-pieces 1- * - vert-pieces / caption-h - TO piece-h <( hor-pieces vert-pieces " ~Nx~N" )> pieces -text! recount-pages ; \ ================================== PROC: next-page current-page 1+ TO current-page show-pages-label PROC; PROC: prev-page current-page 1- TO current-page show-pages-label PROC; \ ================================== WINAPI: DragAcceptFiles SHELL32.DLL WINAPI: DragFinish SHELL32.DLL WINAPI: DragQueryFile SHELL32.DLL : already-added? { dir -- ?} lvdirs item-count 0 ?DO I lvdirs -iparam@ :lv-fullname @ dir ZCOMPARE 0= IF UNLOOP TRUE EXIT THEN LOOP FALSE ; PROC: add-to-list ( fd param -- ) >R :fName R> lb-addstring 1 add-total-photos PROC; : new-list-with-files ( dir -- list) listbox >R W: lbs_sort R@ +style >R <( R> " ~Z\\*.tif" )> add-to-list R@ traverse-files R> ; : new-dir-in-listview ( dir -- ) DUP already-added? IF DROP EXIT THEN DUP >R c: \ last-character 1+ DUP C@ 0= IF DROP R@ THEN 0 R> ( dir) #lvrecord MGETMEM >R DUP new-list-with-files R@ :lv-list ! ZMGETMEM R@ :lv-fullname ! R> lvdirs add-item ; : add-one-directory ( dir -- ) new-dir-in-listview recount-pages ; WINAPI: GetFileAttributesA KERNEL32.DLL : add-dropped-directories { hdrop \ count [ MAX_PATH ] fname percent -- } 0 0 -1 hdrop DragQueryFile TO count count lvdirs prepare-listview count 0 ?DO MAX_PATH fname I hdrop DragQueryFile DROP fname GetFileAttributesA 0x10 ( file_attribute_directory) AND IF fname new-dir-in-listview THEN percent 100 count / + DUP TO percent progress-to LOOP recount-pages 0 progress-to ; : delete-one-directory ( item# -- ) DUP lvdirs -iparam@ DUP :lv-list @ DUP lb-count NEGATE add-total-photos ctl-destroy DUP :lv-fullname @ MFREEMEM MFREEMEM lvdirs delete-item recount-pages ; \ ================================== WINAPI: SHBrowseForFolder SHELL32.DLL WINAPI: SHGetPathFromIDList SHELL32.DLL WINAPI: SHGetMalloc SHELL32.DLL 5 single-method ::Free PROC: add-dir { \ shmalloc [ 8 CELLS ] binfo [ MAX_PATH ] dirname } binfo init->> winmain -hwnd@ >> \ window handle of the owner 0 >> \ PID root dirname >> \ buffer for display name " Выберите каталог:" >> \ prompt 0x9 >> \ flags ( return only file system directories) 0 >> \ callback 0 >> \ userdata 0 >> \ image number binfo SHBrowseForFolder ?DUP IF DUP dirname SWAP SHGetPathFromIDList DROP dirname add-one-directory \ теперь надо освободить возвращенный PIDL \ делается это, как и все в Майкрософте, через извращение ^ shmalloc SHGetMalloc DROP shmalloc ::Free DROP shmalloc release THEN PROC; PROC: rem-dir lvdirs -selected@ -1 <> IF lvdirs -selected@ delete-one-directory THEN PROC; \ -------------------------------------- WINAPI: wvsprintfA USER32.DLL :NONAME ( arglist fmt module -- ) TO mbox-title HERE wvsprintfA DROP HERE err 0 TO mbox-title ; WNDPROC: tifferror 2 CAPI: TIFFOpen libtiff.dll 1 CAPI: TIFFSetErrorHandler libtiff.dll 1 CAPI: TIFFSetWarningHandler libtiff.dll 3 CAPI: TIFFGetField libtiff.dll 4 CAPI: TIFFSetField libtiff.dll 1 CAPI: TIFFClose libtiff.dll 1 CAPI: _TIFFmalloc libtiff.dll 1 CAPI: _TIFFfree libtiff.dll 5 CAPI: TIFFReadRGBAImage libtiff.dll 0 VALUE bmp-x 0 VALUE bmp-y 0 VALUE bmp 0 VALUE bmpdc : load-tiff-as-mem { filename \ b tiff mem size -- mem } " r" filename TIFFOpen TO tiff tiff 0= IF 0 EXIT THEN ^ b 256 tiff TIFFGetField DROP b TO bmp-x ^ b 257 tiff TIFFGetField DROP b TO bmp-y bmp-x bmp-y * CELLS TO size size _TIFFmalloc TO mem mem 0= IF tiff TIFFClose DROP 0 EXIT THEN 0 mem bmp-y bmp-x tiff TIFFReadRGBAImage 0= IF mem _TIFFfree DROP tiff TIFFClose DROP 0 EXIT THEN tiff TIFFClose DROP mem ; WINAPI: CreateDIBSection GDI32.DLL : create-bitmap { x y dc \ bmp pic -- pic bmp} \ создаем картинку HERE init->> 10 CELLS >> x >> y >> 1 W>> 8 W>> W: bi_rgb >> 0 >> 11180 >> 11180 >> 0 >> 0 >> \ заполняем серую палитру: 0,0,0 потом 1,1,1 и т.д. 256 0 DO I C>> I C>> I C>> 0 C>> LOOP 0 0 ^ pic W: dib_rgb_colors HERE dc CreateDIBSection TO bmp bmp dc SelectObject DROP pic bmp-x bmp-y * ERASE pic bmp ; : new-bmp { olddc \ dc bmp pic -- pic bmp dc} olddc CreateCompatibleDC TO dc bmp-x bmp-y dc create-bitmap dc ; WINAPI: GdiFlush GDI32.DLL : make-grayscale-bmp-from-rgba { rgba dc \ bmpdata >rgba rest -- hbmp/0) \ создаем новую картинку, совместимую с контекстом устройства dc new-bmp TO bmpdc TO bmp TO bmpdata bmp 0= IF EXIT THEN \ записываем rgba в картинку, преобразуя ее попутно в серый цвет \ формула преобразования: gray = (222*r+707*g+71*b)/1000 GdiFlush DROP bmp-x 4 MOD DUP IF 4 SWAP - THEN TO rest bmpdata init->> rgba TO >rgba bmp-y 0 ?DO bmp-x 0 ?DO >rgba C@ 222 * >rgba 1+ C@ 707 * >rgba 2+ C@ 71 * + + 1000 / C>> 4 ^ >rgba +! LOOP \ дополняем до границы двойного слова rest 0 ?DO 0 C>> LOOP LOOP bmp ; : load-tiff { filename dc -- bmp/0} filename load-tiff-as-mem DUP 0= IF EXIT THEN DUP dc make-grayscale-bmp-from-rgba SWAP _TIFFfree DROP ; \ (x1,y1)-------------------(x2,y2) \ | | \ (x3,y3)-------------------------- WINAPI: PlgBlt GDI32.DLL WINAPI: StretchBlt GDI32.DLL : rotate-bmp { x1 y1 x2 y2 x3 y3 dc \ [ 6 CELLS ] points -- } points init->> x1 >> y1 >> x2 >> y2 >> x3 >> y3 >> 0 0 0 \ маска, которой нет bmp-y bmp-x \ размеры картинки 0 0 \ координаты левого верхнего угла источника bmpdc points dc PlgBlt DROP ; : stretch-bmp { x y w h dc -- } W: srccopy bmp-y bmp-x 0 0 bmpdc h w y x dc StretchBlt DROP ; : paint-bmp { x y dc \ w h half rotated? -- x1 y1 x2 y2 x3 y3 } bmp-x TO w bmp-y TO h FALSE TO rotated? piece-w piece-h > w h < AND piece-w piece-h < w h > AND OR IF \ разворачиваем картинку TRUE TO rotated? w h TO w TO h THEN piece-w 10000 w */ piece-h 10000 h */ < IF \ ------------------ \ | | \ ****************** \ ****************** \ ****************** \ | | \ ------------------ h piece-w w */ TO h piece-w TO w piece-h h - 2/ TO half half y + TO y ELSE \ ------------------ \ | ****** | \ | ****** | \ | ****** | \ | ****** | \ | ****** | \ ------------------ w piece-h h */ TO w piece-h TO h piece-w w - 2/ TO half x half + TO x THEN rotated? IF x y h + x y x w + y h + dc rotate-bmp ELSE x y w h dc stretch-bmp THEN ; WINAPI: SetRect USER32.DLL : print-tiff { file x y dc \ [ 4 CELLS ] rect -- } file dc load-tiff IF x y dc paint-bmp bmpdc DeleteDC DROP bmp DeleteObject DROP ELSE y piece-h + x piece-w + y x rect SetRect DROP (* dt_center dt_wordbreak *) rect -1 " Ошибка при загрузке файла" dc DrawTextA DROP THEN ; : piece>xy ( piece# -- x y) hor-pieces 2DUP MOD -ROT / ( xx yy ) piece-h luft + caption-h + * sheet-margin + SWAP piece-w luft + * sheet-margin + SWAP ; \ -------------------------------------- WINAPI: FrameRect USER32.DLL WINAPI: GetSysColorBrush USER32.DLL WINAPI: SetMapMode GDI32.DLL WINAPI: SetWindowExtEx GDI32.DLL WINAPI: SetViewportExtEx GDI32.DLL : mapA4 ( w h dc -- ) >R W: mm_isotropic R@ SetMapMode DROP 0 sheet-h sheet-w R@ SetWindowExtEx DROP SWAP 0 -ROT R> SetViewportExtEx DROP ; : unmapA4 ( dc -- ) W: mm_text SWAP SetMapMode DROP ; : photos-on-last-page ( -- n) total-photos hor-pieces vert-pieces * MOD ?DUP 0= IF vert-pieces hor-pieces * THEN ; PROC: paint-smallpage W: color_window 1+ paint-rect windc FillRect DROP W: color_windowtext GetSysColorBrush DUP >R paint-rect windc FrameRect R> DeleteObject 2DROP total-pages 0= IF EXIT THEN sheet-w 2/ sheet-h 2/ windc mapA4 photos-on-last-page 0 DO I piece>xy SWAP ( y1 x1) 2DUP piece-w + SWAP piece-h + SWAP 2SWAP windc Rectangle DROP LOOP windc unmapA4 PROC; WINAPI: MoveToEx GDI32.DLL WINAPI: LineTo GDI32.DLL WINAPI: CreatePen GDI32.DLL USER-VALUE draw-dc : line ( x1 y1 x2 y2 -- ) 2SWAP SWAP 0 -ROT draw-dc MoveToEx DROP SWAP draw-dc LineTo DROP ; : hruler ( y -- ) >R 0 R@ sheet-w R> line ; : vruler ( x -- ) 0 OVER sheet-h line ; : draw-with-color-pen { xt color dc \ oldpen -- } color >bgr 0 W: ps_solid CreatePen dc SelectObject TO oldpen dc TO draw-dc xt EXECUTE oldpen dc SelectObject DeleteObject DROP ; : make-caption { dirname filename \ dn [ MAX_PATH ] fn -- z } dirname c: \ last-character 1+ TO dn filename fn ZMOVE fn c: . -trail <( dn fn " ~Z / ~Z" )> ; : print-photo { x y dc \ dirname [ 4 CELLS ] rect [ MAX_PATH ] filename -- } gen-dir @ dir>name TO dirname filename gen-file @ gen-dir @ dir>list fromlist x DUP rect ! piece-w + rect 2 CELLS! y piece-h + DUP rect 1 CELLS! caption-h + rect 3 CELLS! (* dt_center dt_end_ellipsis dt_noprefix dt_vcenter dt_singleline *) rect -1 dirname filename make-caption dc DrawTextA DROP <( dirname filename " ~Z\\~Z" )> x y dc print-tiff ; : print-page { page dc font \ step -- } font dc SelectObject page page-dir-file init-gen page total-pages = IF photos-on-last-page ELSE hor-pieces vert-pieces * THEN DUP 100 SWAP / TO step 0 DO I step * progress-to I piece>xy dc print-photo next-photo DROP LOOP 0 progress-to dc SelectObject DROP ; : paint-bigpage-to-dc { dc -- } \ сама страница W: color_window 1+ paint-rect dc FillRect DROP \ поля sheet-w sheet-h dc mapA4 (: sheet-margin vruler sheet-w sheet-margin - vruler sheet-margin hruler sheet-h sheet-margin - hruler ;) 0xFF80FF dc draw-with-color-pen \ границы секций (: hor-pieces 1- 0 ?DO I piece-w luft + * piece-w + sheet-margin + DUP vruler luft + vruler LOOP vert-pieces 0 ?DO I piece-h luft + caption-h + * piece-h + sheet-margin + DUP hruler I vert-pieces 1- < IF caption-h + DUP hruler luft + hruler ELSE DROP THEN LOOP ;) 0x8080FF dc draw-with-color-pen total-pages IF current-page dc small-font print-page ELSE extra-pages IF (* dt_center dt_end_ellipsis dt_noprefix dt_vcenter dt_wordbreak *) paint-rect -1 <( extra-pages " Слишком много страниц: ~N" )> dc DrawTextA DROP THEN THEN W: color_windowtext GetSysColorBrush DUP >R paint-rect dc FrameRect R> DeleteObject 2DROP dc unmapA4 ; WINAPI: BitBlt GDI32.DLL PROC: paint-bigpage bp-cached? 0= IF bp-cache-dc paint-bigpage-to-dc TRUE TO bp-cached? THEN W: srccopy 0 0 bp-cache-dc sheet-h sheet-w 0 0 windc BitBlt DROP PROC; \ -------------------------------------- WINAPI: StartDocA GDI32.DLL WINAPI: EndDoc GDI32.DLL WINAPI: StartPage GDI32.DLL WINAPI: EndPage GDI32.DLL WINAPI: CreateCompatibleBitmap GDI32.DLL : print-from-to { end begin \ dc font [ 5 CELLS ] prdata -- } \ создадим контекст устройства и начнем печать devmode 0 printer-name " WINSPOOL" CreateDCA TO dc prdata init->> 5 CELLS >> begin end = IF <( progname begin " ~Z [~N]" )> ELSE <( progname begin end " ~Z [~N-~N]" )> THEN >> 3 zeroes>> prdata dc StartDocA DROP \ установим величины, зависящие от принтера W: logpixelsx dc GetDeviceCaps ( dpi) 10 254 */ ( dpmm) >R sheet-w R@ * sheet-h R> * dc mapA4 \ создадим шрифт " Arial Cyr" 12 ( pt) 254 720 */ ( mm) NEGATE italic create-font-devunits TO font \ печать по страницам end 1+ begin DO dc StartPage DROP I dc font print-page dc EndPage DROP LOOP \ уничтожим все dc EndDoc DROP dc DeleteDC DROP ; \ -------------------------------------- WINAPI: ImageList_Create COMCTL32.DLL WINAPI: ImageList_Destroy COMCTL32.DLL WINAPI: ImageList_LoadImage COMCTL32.DLL MESSAGES: mainmsg M: wm_dropfiles wparam add-dropped-directories wparam DragFinish DROP TRUE M; M: wm_close \ уничтожим все, что можно imglist ImageList_Destroy DROP pages-label -font@ delete-font small-font delete-font bp-cache-dc DeleteDC DROP bp-cache-bmp DeleteObject DROP pages FREEMEM " settings" " hor" hor-pieces write-profile-int " settings" " vert" vert-pieces write-profile-int FALSE M; MESSAGES; MESSAGES: lvdirs-notify M: lvn_keydown lparam W@ W: vk_delete = IF rem-dir EXECUTE THEN M; MESSAGES; MESSAGES: slider M: tb_endtrack ht -pos@ TO hor-pieces vt -pos@ TO vert-pieces set-pieces M; MESSAGES; \ -------------------------------------- : create-listview ( -- lv) (* lvs_sortascending lvs_autoarrange lvs_singlesel *) listview (/ -name lvdirs -size 100 40 -notify lvdirs-notify /) \ создадим список картинок (* lr_loadtransparent *) W: image_bitmap W: clr_none 1 32 " folder" IMAGE-BASE ImageList_LoadImage DUP TO imglist 0 lvdirs -imagelist! ; WINAPI: SetStretchBltMode GDI32.DLL : init-all mainmsg winmain -wndproc! TRUE winmain -hwnd@ DragAcceptFiles DROP winmain create-status draw-status winmain -status@ -painter! set-print-controls " Arial Cyr" 8 italic create-font TO small-font ['] tifferror TIFFSetErrorHandler DROP 0 TIFFSetWarningHandler DROP 0 CreateCompatibleDC TO bp-cache-dc sheet-h sheet-w winmain -hwnd@ GetDC DUP >R CreateCompatibleBitmap TO bp-cache-bmp bp-cache-bmp bp-cache-dc SelectObject DROP R> ReleaseDC DROP W: halftone bp-cache-dc SetStretchBltMode DROP max-pages #page-record * GETMEM TO pages " settings" " hor" 1 read-profile-int-default TO hor-pieces " settings" " vert" 1 read-profile-int-default TO vert-pieces hor-pieces ht -pos! vert-pieces vt -pos! set-pieces ; \ ================================== WINAPI: LoadImageA USER32.DLL : load-bmp ( z -- ) >R W: lr_loadmap3dcolors 0 0 W: image_bitmap R> IMAGE-BASE LoadImageA ; : skip filler (/ -size 1 10 /) | ; : picture ( -- ctl) control static W: ss_ownerdraw create-control ; : RUN { \ g1 g2 g3 } WINDOWS... 0 (* ws_overlapped ws_caption ws_dlgframe ws_clipsiblings ws_sysmenu ws_minimizebox *) 0 create-window-with-styles TO winmain W: color_3dface syscolor winmain -bgcolor! TRUE winmain -dialog! " Печать кадров" winmain -text! GRID " 9х9" label DUP TO pieces 15 -width | (* tbs_autoticks tbs_top *) trackbar DUP TO ht (/ -size 0 30 -notify slider -min 1 -max max-hor-pieces /) -xspan | === (* tbs_vert tbs_autoticks tbs_left *) trackbar DUP TO vt (/ -size 30 0 -notify slider -min 1 -max max-vert-pieces /) 10 -width -yspan | picture (/ -name bigpage -size sheet-w sheet-h -painter paint-bigpage /) -right | GRID; TO g1 GRID " 0 " label (/ -name photos-label -align center /) -xspan | === skip === " up" load-bmp bitmap-button (/ -name up -size 50 20 -command next-page /) -center | === " 99/99" label -xspan (/ -name pages-label -font " Arial Cyr" 20 bold create-font -align center /) | === " down" load-bmp bitmap-button (/ -name down -size 50 20 -command prev-page /) -center | === picture (/ -name smallpage -painter paint-smallpage -size sheet-w 2/ sheet-h 2/ /) | GRID; TO g2 \ ----------------------------- GRID " +" button (/ -command add-dir /) -xspan | === " -" button (/ -command rem-dir /) -xspan | GRID; TO g3 \ ----------------------------- GRID g3 10 -width | create-listview -xspan -yspan | === hline -xspan | === skip === g1 | g2 -bottom | === combo DUP TO printers (/ -size 250 200 -command newprinter /) 10 -ymargin -middle | " Настроить..." button 10 -ymargin -middle (/ -command setup /) | === hline -xspan | === " print" load-bmp bitmap-button (/ -command (: current-page current-page print-from-to ;) /) | " << Текущая" label -top | " Печатать с этой страницы >>" label -right -bottom | " print" load-bmp bitmap-button -defbutton -right (/ -command (: total-pages current-page print-from-to ;) /) | GRID; winmain -grid! init-all winmain wincenter winmain winshow ...WINDOWS BYE ; \ RUN 0 TO SPF-INIT? \ ' ANSI>OEM TO ANSI>