[rdnzl-devel] Multiple DataGridViews in virtual mode example.

Matthew O'Connor matthew.oconnor at calyptech.com
Tue Mar 18 23:17:22 UTC 2008

Hi all once again,

I have another example of the DataGridView. This time it is a simple MVC
example. It is two DataGridViews showing/editing the same dataset. So
you can change the data in one and see the updates reflected in the

Feel free to to with it as you wish, but use it at your own peril. I am
still just a Lisp newbie.



;; Multiple DataGridView Experiment.
;; Matthew O'Connor
;; This experiment is an extension of the last one in that there are now
;; two DataGridViews watching over the same database. 
;; The example is a simple implemenation of the Model View Controller 
;; pattern. Each DataGridView is independent of the other but when the 
;; underlying model (database) changes all views (DataGridView) are 
;; notified and update their representation accordingly.
;; You should be able add, remove or edit rows in one DataGridView and
;; have the updates appear in the other one.
;; As with the previous experiment the DataGridView is running in
;; mode. The update mechanisms are a bit more complex now because 
;; DataGridView that should be updated has to be determined.
;; As usual there is no warranty. Use at your own peril. I am relatively
;; new to Lisp so you are warned.

;; NOTE: You need to modify this to point to the location of RDNZL on
your system.
(load "../RDNZL/rdnzl-0.12.0/load.lisp")

;; RDNZL setup.


(rdnzl:import-types "System.Windows.Forms"
                    "Application" "Form" "Splitter" "DockStyle"
(rdnzl:use-namespace "System.Windows.Forms")

(rdnzl:import-types "System.Drawing" "Size")
(rdnzl:use-namespace "System.Drawing")

;; Utilities

(defun filter (lst fn)
  (let ((acc nil))
    (dolist (x lst)
      (let ((val (funcall fn x)))
	(if val (push x acc))))
    (nreverse acc)))

(defun append1 (lst obj)
  (append lst (list obj)))

;; Units

;; The items that will be stored in the database. At the moment they are
;; simply all strings.
(defclass unit () 
  ((code :accessor code :initarg :code :initform "None")
   (description :accessor description :initarg :description :initform
   (name :accessor name :initarg :name :initform "Unknown")))

;; Create a unit with an optional description.
(defun make-unit (code name &optional description)
  (if description
      (make-instance 'unit :code code :name name :description
    (make-instance 'unit :code code :name name)))

;; Clone a unit this is needed by the datagridview which makes an copy
;; editing a row.
(defun clone-unit (unit)
  (make-unit (code unit) (name unit) (description unit)))

;; units database
;; The database has been slightly upgraded to support observers. Client
;; registers with the database through the database-add-observer call 
;; supplying their own callback 

;; A simple database of units.
(defparameter *database-units* nil)

(defparameter *database-observers* nil)

(defun database-add-observer (callback dgv)
  (setf *database-observers* (append1 *database-observers* (list
callback dgv))))

(defun database-signal-observers (sender)
  (mapcar #'(lambda (x) (funcall (first x) (second x) sender))

(defun database-add-unit (modifier unit)
  (setf *database-units* (append *database-units* (list unit)))
  (database-signal-observers modifier))

(defun database-remove-unit (modifier unit)
  (setf *database-units* (remove unit *database-units*))
  (database-signal-observers modifier))

(defun database-remove-unit-at (modifier index)
  (setf *database-units* (remove (nth index *database-units*)
  (database-signal-observers modifier))

(defun database-get-unit (code)
  (first (filter *database-units* #'(lambda (unit) (equal code (code

(defun database-get-unit-at (index)
  (nth index *database-units*))

(defun database-update-unit-at (modifier index unit)
  (setf (nth index *database-units*) unit)
  (database-signal-observers modifier))

(defun database-units-count ()
  (length *database-units*))

;; DataGridView control variables.

(defclass unit-data-grid-view () 
  ((data-grid-view :accessor
data-grid-view :initarg :data-grid-view :initform nil)
   (row-in-edit :accessor row-in-edit :initarg :row-in-edit :initform
   (unit-in-edit :accessor unit-in-edit :initarg :unit-in-edit :initform
   (row-scope-commit :accessor
row-scope-commit :initarg :row-scope-commit :initform t)))

(defparameter *unit-views* nil)

(defun new-unit-data-grid-view (dgv) 
  (let ((new-dgv (make-instance 'unit-data-grid-view :data-grid-view
    (setf *unit-views* (append1 *unit-views* new-dgv))))

(defun get-unit-data-grid-view (dgv)
  (let ((name [%Name (rdnzl:cast dgv "DataGridView")]))
    (first (filter *unit-views* (lambda (x) (equal name [%Name
(data-grid-view x)]))))))

;; A little utility to get the count of rows.
(defun data-grid-view-row-count (udgv)
  [%Count [%Rows (data-grid-view udgv)]])

;; Are we editing this row already.
(defun is-row-in-edit (udgv index)
  (= (row-in-edit udgv) index))

(defun is-new-row (udgv index)
  (= index (- (data-grid-view-row-count udgv) 1)))

;; Is the supplied index the new row.
;; (defun is-new-row-from-row (row)
;;  [%IsNewRow row])

;; We are no longer editing any row so set the variables back to their
;; defaults.
(defun reset-unit-in-edit (udgv)
  (setf (unit-in-edit udgv) nil
        (row-in-edit udgv) -1))

;; Implement the DataGridView callbacks.
;; These are reasonably complex little calls. I refer you to the
;; mentioned at the start of the file for further information on how
;; work.

;; The event occurs whenever the DataGridView requires the value to a
cell for
;; display. It retrieves the value from either the database of units or
from the
;; unit currently being edited.
;; DataGridViewCellValueEventArgs
;;   int ColumnIndex - The index of the column.
;;   int RowIndex - The index of the row.
;;   object Value - The value of the row.
(defun cell-value-needed (object event)
  (let ((udgv (get-unit-data-grid-view object))
        (row-index [%RowIndex event])
        (column-index [%ColumnIndex event])
        (unit nil))
    (unless (is-new-row udgv row-index)
      (if (is-row-in-edit udgv row-index)
          ;; then
          (setf unit (unit-in-edit udgv))
        ;; else
        (setf unit (database-get-unit-at row-index)))
      (unless (equal unit nil)
        (case column-index
          ((0) (setf [%Value event] (code unit)))
          ((1) (setf [%Value event] (name unit)))
          ((2) (setf [%Value event] (description unit))))))))

;; This event occurs whenever a cell value has been updated on the
;; It gives the underlying storage mechanism a chance to update the
;; If there is no unit currently in edit one is created. The updates do
not go
;; directly to the database. They go via the unit currently in edit
first. Once 
;; the changes have been validated they are updated in the database.
;; DataGridViewCellValueEventArgs
;;   int ColumnIndex - The index of the column.
;;   int RowIndex - The index of the row.
;;   object Value - The value of the row.
(defun cell-value-pushed (object event)
  (let ((udgv (get-unit-data-grid-view object))
        (row-index [%RowIndex event])
        (column-index [%ColumnIndex event])
        (unit-tmp nil))
    (if (< row-index (length *database-units*))
          (when (equal (unit-in-edit udgv) nil) 
            (setf (unit-in-edit udgv) (clone-unit (database-get-unit-at
          (setf unit-tmp (unit-in-edit udgv)
                (row-in-edit udgv) row-index))
      ;; else
      (setf unit-tmp (unit-in-edit udgv)))
    (unless (equal unit-tmp nil)
      (let ((value [%Value event]))
        (case column-index
          ((0) (setf (code unit-tmp) (rdnzl:unbox (rdnzl:cast value
          ((1) (setf (name unit-tmp) (rdnzl:unbox (rdnzl:cast value
          ((2) (setf (description unit-tmp) (rdnzl:unbox (rdnzl:cast
value "System.String")))))))))

;; Occurs whenever a new row is needed at the end of a DataGridView. It
;; creates a new empty unit that becomes the current unit in edit.
;; DataGridViewRowEventArgs:
;;   DataGridViewRow Row - I'm not sure what the contents of the row are
;;     as I currently don't use them.
(defun new-row-needed (object event) 
  (let ((udgv (get-unit-data-grid-view object)))
    (setf (unit-in-edit udgv) (make-unit "" "" "")
          (row-in-edit udgv) (- (data-grid-view-row-count udgv) 1))))

;; This event occurs after a row has finished validating. At this point
the data 
;; can be pushed to the database.
;; DataGridViewViewCellEventArgs
;;   int ColumnIndex - The index of the column.
;;   int RowIndex - The index of the row.
(defun row-validated (object event) 
  (let ((udgv (get-unit-data-grid-view object))
        (row-index [%RowIndex event]))
    (when [%Focused object]
      (if (and (>= row-index (database-units-count))
               (not (= row-index (- (data-grid-view-row-count udgv)
1) )))
            (database-add-unit object (unit-in-edit udgv))
            (reset-unit-in-edit udgv))
        (if (and (not (equal (unit-in-edit udgv) nil))
                 (< row-index (database-units-count)))
              (database-update-unit-at object row-index (unit-in-edit
              (reset-unit-in-edit udgv))
          (if [%ContainsFocus (data-grid-view udgv)]
            (reset-unit-in-edit udgv)))))))

;; Used by the DataGridView to determine if current row has uncommitted
;; Note - I'm not quite sure how this works.
;; QuestionEventArgs
;;   Boolean Response - True or False.
(defun row-dirty-state-needed (object event) 
  (let ((udgv (get-unit-data-grid-view object)))
    (unless (row-scope-commit udgv)
    (setf [%Response event] [%IsCurrentCellDirty udgv]))))

;; Give the application the opportunity to cancel the edits in a row. 
;; A single escape key cancels the cell edit. A double cancels the row
;; QuestionEventArgs
;;   Boolean Response - True to cancel the row-edit, False (I assume) to
let it
;;    continue.
(defun cancel-row-edit (object event) 
  (let ((udgv (get-unit-data-grid-view object)))
        (if (and (= (row-in-edit udgv) (-  (data-grid-view-row-count
udgv) 2))
                 (= (row-in-edit udgv) (database-units-count)))
            (setf (unit-in-edit udgv) (make-unit "" "" ""))
          (reset-unit-in-edit udgv))))

;; Remove the row if it is in the database otherwise simply reset the
unit in edit.
;; DataGridViewRowCancelEventArgs:
;;   DataGridViewRow Row - The row the user is deleting.
;;   Boolean Cancel - Cancel the addition of the row.
(defun user-deleting-row (object event)
  (let* ((udgv (get-unit-data-grid-view object))
         (data-grid-row [%Row event])
         (row-index [%Index data-grid-row]))
    (when (< row-index (database-units-count))
      (database-remove-unit-at object row-index))
    (when (= row-index (row-in-edit udgv))
      (reset-unit-in-edit udgv))))

;; The callback that is registered with the database.
;; The function will only update the DataGridView if it is not
;; the one that originated the modification in the first place.
(let ((locked nil))
  (defun data-grid-view-updated (dgv modifier) 
    (let ((dgv-name [%Name dgv])
          (modifier-name [%Name modifier]))
      (unless locked
        (setf locked t)
        (when (not (equal dgv-name modifier-name))
          (let ((rows [%Rows dgv]))
            (setf [%RowCount dgv] 1)
            (setf [%RowCount dgv] (+ (database-units-count) 1))))
            [Invalidate dgv]
        (setf locked nil)))))

;; Main

;; Create a new text box column.
(defun create-column (index name heading)
  (let ((col (rdnzl:new "DataGridViewTextBoxColumn")))
      (setf [%DisplayIndex col]  index
            [%Name col] name
            [%HeaderText col] heading)

;; Create a DataGridView with three columns; Code, Name and Description.
;; It is placed in Virtual mode and all of the callbacks are hooked up.
(defun create-units-editor (name)
  (let ((dgv (rdnzl:new "DataGridView")))
    (setf [%VirtualMode dgv] t    
          [%Dock dgv] [$DockStyle.Left]
          [%Text dgv] "DataGridView Experiment"
          [%Name dgv] name
          [%RowHeadersVisible dgv] t)
    [Add [%Columns dgv] (create-column 0 "code" "Code")]
    [Add [%Columns dgv] (create-column 1 "name" "Name")]
    [Add [%Columns dgv] (create-column 2 "description" "Description")]
    (when (> (database-units-count) 0)
      [Add [%Rows dgv] (database-units-count)])
    [+CellValueNeeded dgv (rdnzl:new "DataGridViewCellValueEventHandler"
    [+CellValuePushed dgv (rdnzl:new "DataGridViewCellValueEventHandler"
    [+NewRowNeeded dgv (rdnzl:new "DataGridViewRowEventHandler"
    [+UserDeletingRow dgv (rdnzl:new "DataGridViewRowCancelEventHandler"
    [+CancelRowEdit dgv (rdnzl:new "QuestionEventHandler"
    [+RowDirtyStateNeeded dgv (rdnzl:new "QuestionEventHandler"
    [+RowValidated dgv (rdnzl:new "DataGridViewCellEventHandler"

;; Call this function to run the application.
(defun run-multiple-datagridview-experiment ()
  (let ((form (rdnzl:new "Form"))
        (splitter (rdnzl:new "Splitter"))
        (dgv1 (create-units-editor "V1"))
        (dgv2 (create-units-editor "V2")))
    (setf [%Text form] "DataGridView Experiment"
          [%Dock splitter] [$DockStyle.Left])
    (new-unit-data-grid-view dgv1)
    (database-add-observer #'data-grid-view-updated dgv1)
    (new-unit-data-grid-view dgv2)
    (database-add-observer #'data-grid-view-updated dgv2)
    (setf [%Dock dgv1] [$DockStyle.Fill]
          [%Size form] (rdnzl::new "Size" 750 250)
          [%Size dgv1] (rdnzl::new "Size" 350 200)
          [%Size dgv2] (rdnzl::new "Size" 350 200))
    [Add [%Controls form] dgv1]
    [Add [%Controls form] splitter]
    [Add [%Controls form] dgv2]
    [Application.Run form]))

(defun reset ()
  (setf *database-units* nil
        *database-observers* nil
        *unit-views* nil))


More information about the rdnzl-devel mailing list