mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
*** empty log message ***
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2131 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
parent
05e59ff031
commit
18ef8bb39d
@ -71,7 +71,8 @@ GNOME_SRCS := top-level.c window-main.c window-register.c window-adjust.c \
|
||||
extensions.c query-user.c reconcile-list.c \
|
||||
window-report.c global-options.c \
|
||||
dialog-qif-import.c glade-gnc-dialogs.c \
|
||||
dialog-account-picker.c print-session.c
|
||||
dialog-account-picker.c print-session.c \
|
||||
dialog-print-check.c
|
||||
######################################################################
|
||||
|
||||
all: gnome
|
||||
|
||||
@ -8,52 +8,135 @@
|
||||
|
||||
(gnc:support "print-check.scm")
|
||||
(gnc:depend "number-to-words.scm")
|
||||
(gnc:depend "simple-obj.scm")
|
||||
|
||||
;; format notes (I found a GIF of the check form and am measuring from
|
||||
;; that, so this is definitely not perfect) positions are lower-left
|
||||
;; text origin, (0,0) at lower left of page, in inches, for
|
||||
;; US-Letter format paper.
|
||||
(define quicken-check-3up-at-top-us-letter
|
||||
'((payee . (1.25 9.5625))
|
||||
(amount-words . (1.25 9.1875))
|
||||
(amount-number . (7.0 9.625))
|
||||
(date . (7.0 10.0625))
|
||||
(memo . (0.75 8.0625))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; <print-check-format> class
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define <print-check-format>
|
||||
(make-simple-class
|
||||
'print-check-format
|
||||
'(format
|
||||
position
|
||||
date-format
|
||||
custom-info)))
|
||||
|
||||
(define (print-check-format? self)
|
||||
(eq? (simple-obj-type self) 'print-check-format))
|
||||
|
||||
(define (print-check-format:format self)
|
||||
(simple-obj-getter self <print-check-format> 'format))
|
||||
|
||||
(define (print-check-format:set-format! self value)
|
||||
(simple-obj-setter self <print-check-format> 'format value))
|
||||
|
||||
(define (print-check-format:position self)
|
||||
(simple-obj-getter self <print-check-format> 'position))
|
||||
|
||||
(define (print-check-format:set-position! self value)
|
||||
(simple-obj-setter self <print-check-format> 'position value))
|
||||
|
||||
(define (print-check-format:date-format self)
|
||||
(simple-obj-getter self <print-check-format> 'date-format))
|
||||
|
||||
(define (print-check-format:set-date-format! self value)
|
||||
(simple-obj-setter self <print-check-format> 'date-format value))
|
||||
|
||||
(define (print-check-format:custom-info self)
|
||||
(simple-obj-getter self <print-check-format> 'custom-info))
|
||||
|
||||
(define (print-check-format:set-custom-info! self value)
|
||||
(simple-obj-setter self <print-check-format> 'custom-info value))
|
||||
|
||||
(define (make-print-check-format fmt pos dateformat cust)
|
||||
(let ((retval (make-simple-obj <print-check-format>)))
|
||||
(print-check-format:set-format! retval fmt)
|
||||
(print-check-format:set-position! retval pos)
|
||||
(print-check-format:set-date-format! retval dateformat)
|
||||
(print-check-format:set-custom-info! retval cust)
|
||||
retval))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; stock formats
|
||||
;; units for stock formats and positions are points (72/inch)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define gnc:*stock-check-formats*
|
||||
'((quicken . ((payee . (90.0 150.0))
|
||||
(amount-words . (90.0 120.0))
|
||||
(amount-number . (500.0 150.0))
|
||||
(date . (500.0 185.0))
|
||||
(memo . (50.0 40.0))))))
|
||||
|
||||
(define gnc:*stock-check-positions*
|
||||
'((top . 540.0)
|
||||
(middle . 288.0)
|
||||
(bottom . 0.0)))
|
||||
|
||||
(define (gnc:print-check payee amount date memo)
|
||||
(let* ((int-part (inexact->exact (truncate amount)))
|
||||
(frac-part (inexact->exact
|
||||
(define (print-check-callback format-info)
|
||||
(let* ((int-part (inexact->exact (truncate amount)))
|
||||
(frac-part (inexact->exact
|
||||
(truncate
|
||||
(+ (/ .5 100) (* 100 (- amount int-part))))))
|
||||
(ps (gnc:print-session-create))
|
||||
(format quicken-check-3up-at-top-us-letter)
|
||||
(inches-to-points
|
||||
(lambda (inches)
|
||||
(* inches 72))))
|
||||
(ps (gnc:print-session-create))
|
||||
(format #f)
|
||||
(offset #f)
|
||||
(date-string ""))
|
||||
(if (not (eq? (print-check-format:format format-info) 'custom))
|
||||
(begin
|
||||
(set! format (assq (print-check-format:format format-info)
|
||||
gnc:*stock-check-formats*))
|
||||
(if (pair? format)
|
||||
(set! format (cdr format))))
|
||||
(set! format (print-check-format:custom-info format-info)))
|
||||
|
||||
(if (not (eq? (print-check-format:position format-info) 'custom))
|
||||
(begin
|
||||
(set! offset
|
||||
(cdr (assq (print-check-format:position format-info)
|
||||
gnc:*stock-check-positions*)))
|
||||
(if (pair? offset)
|
||||
(set! offset (cdr offset))))
|
||||
(set! offset
|
||||
(cdr (assq 'position
|
||||
(print-check-format:custom-info format-info)))))
|
||||
|
||||
(let ((fmt (print-check-format:date-format format-info)))
|
||||
(if (string=? fmt "custom")
|
||||
(let* ((custom-info (print-check-format:custom-info format-info))
|
||||
(date-fmt (assq 'date-format custom-info)))
|
||||
(if date-fmt
|
||||
(set! date-fmt (cdr date-fmt)))
|
||||
(set! date-string
|
||||
(strftime date-fmt (localtime date))))
|
||||
(begin
|
||||
(set! date-string (strftime fmt (localtime date))))))
|
||||
|
||||
(let ((date-pos (assq 'date format)))
|
||||
(gnc:print-session-moveto ps (cadr date-pos)
|
||||
(+ offset (caddr date-pos)))
|
||||
(gnc:print-session-text ps date-string))
|
||||
|
||||
(let ((payee-pos (assq 'payee format)))
|
||||
(gnc:print-session-moveto ps (cadr payee-pos)
|
||||
(+ offset (caddr payee-pos)))
|
||||
(gnc:print-session-text ps payee))
|
||||
|
||||
(let ((number-pos (assq 'amount-number format)))
|
||||
(gnc:print-session-moveto ps (cadr number-pos)
|
||||
(+ offset (caddr number-pos)))
|
||||
(gnc:print-session-text ps (printable-value amount 100)))
|
||||
|
||||
(let ((words-pos (assq 'amount-words format)))
|
||||
(gnc:print-session-moveto ps (cadr words-pos)
|
||||
(+ offset (caddr words-pos)))
|
||||
(gnc:print-session-text ps (number-to-words amount 100)))
|
||||
|
||||
(gnc:print-session-done ps)
|
||||
(gnc:print-dialog-create ps)))
|
||||
|
||||
(let ((date-pos (assq 'date format)))
|
||||
(gnc:print-session-moveto ps
|
||||
(inches-to-points (cadr date-pos))
|
||||
(inches-to-points (caddr date-pos)))
|
||||
(gnc:print-session-text ps date))
|
||||
(gnc:print-check-dialog-create print-check-callback))
|
||||
|
||||
(let ((payee-pos (assq 'payee format)))
|
||||
(gnc:print-session-moveto ps
|
||||
(inches-to-points (cadr payee-pos))
|
||||
(inches-to-points (caddr payee-pos)))
|
||||
(gnc:print-session-text ps payee))
|
||||
|
||||
(let ((number-pos (assq 'amount-number format)))
|
||||
(gnc:print-session-moveto ps
|
||||
(inches-to-points (cadr number-pos))
|
||||
(inches-to-points (caddr number-pos)))
|
||||
(gnc:print-session-text ps (printable-value amount 100)))
|
||||
|
||||
(let ((words-pos (assq 'amount-words format)))
|
||||
(gnc:print-session-moveto ps
|
||||
(inches-to-points (cadr words-pos))
|
||||
(inches-to-points (caddr words-pos)))
|
||||
(gnc:print-session-text ps (number-to-words amount 100)))
|
||||
|
||||
(gnc:print-session-done ps)
|
||||
(gnc:print-dialog-create ps)))
|
||||
|
||||
@ -426,7 +426,6 @@
|
||||
(set! reparse-ok
|
||||
(qif-acct:reparse acct self))))
|
||||
(qif-file:accounts self))
|
||||
(display "reparse-ok == ") (write reparse-ok) (newline)
|
||||
reparse-ok))
|
||||
(begin
|
||||
(display "There was a heinous error. Failed to read file.")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user