Hi all,
I have implemented a little example that shows the use of the .net DataGridView control in virtual mode using RDNZL and Lispworks.
The DataGridView control is particularly difficult to get working properly. I can't count the number of times I crashed my environment getting this working but foreign function calls are always hairy.
The only thing you should have to do to get it working is change the location of the RDNZL path.
Enjoy,
Matthew O'Connor
;; ========================================================================
;; DataGridView Experiment.
;;
;; Matthew O'Connor
;;
;; This is basically a lisp implementation of the Microsoft "Walkthrough:
;; Implementing Virtual Mode in the Windows Forms DataGridView Control".
;;
;; The DataGridView is running in Virtual mode continually coming back
;; to Lisp through the callbacks to get and set data.
;;
;; The example is made a little more complex by the use of an object to
;; store the row that is currently being edited. This allows a cell edit
;; to be undone with a simple press of the Escape key. A second press
;; of the same key will undo the changes made to the entire row.
;;
;; 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:enable-rdnzl-syntax)
(rdnzl:import-types "System.Windows.Forms"
"Application" "Form" "DockStyle" "DataGridView"
"DataGridViewTextBoxColumn" "DataGridViewCellValueEventHandler"
"DataGridViewRowEventHandler" "QuestionEventHandler"
"DataGridViewCellEventHandler" "DataGridViewRowCancelEventHandler")
(rdnzl:use-namespace "System.Windows.Forms")
;; ------------------------------------------------------------------------
;; Utilities
(defun filter (lst fn)
(let ((acc nil))
(dolist (x lst)
(let ((val (funcall fn x)))
(if val (push x acc))))
(nreverse acc)))
;; ------------------------------------------------------------------------
;; 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 "None")
(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 description)
(make-instance 'unit :code code :name name)))
;; Clone a unit this is needed by the datagridview which makes an copy whilst
;; editing a row.
(defun clone-unit (unit)
(make-unit (code unit) (name unit) (description unit)))
;; ------------------------------------------------------------------------
;; units database
;; A simple database of units.
(defparameter *database-units* nil)
(defun database-add-unit (unit)
(setf *database-units* (append *database-units* (list unit))))
(defun database-remove-unit (unit)
(setf *database-units* (remove unit *database-units*)))
(defun database-remove-unit-at (index)
(setf *database-units* (remove (nth index *database-units*) *database-units*)))
(defun database-get-unit (code)
(first (filter *database-units* #'(lambda (unit) (equal code (code unit))))))
(defun database-get-unit-at (index)
(nth index *database-units*))
(defun database-update-unit-at (index unit)
(setf (nth index *database-units*) unit))
(defun database-units-count ()
(length *database-units*))
;; The data grid view that is used to represent the units.
(defparameter *units-data-grid-view* nil)
;; Keeps track of the row index that we are currently editing. A value
;; of -1 indicates that we are not editing anything at the moment.
(defparameter *row-in-edit* -1)
;; This is the unit that will be created to hold edits until they have
;; been validated. At this point they will be written back to the database.
(defparameter *unit-in-edit* nil)
;; I'm not sure about this variable. It never seems to be altered anywhere
;; in the example code.
(defparameter *row-scope-commit* t)
;; A little utility to get the count of rows.
(defun data-grid-view-row-count ()
[%Count [%Rows *units-data-grid-view*]])
;; Are we editing this row already.
(defun is-row-in-edit (index)
(= *row-in-edit* index))
(defun is-new-row (index)
(= index (- (data-grid-view-row-count) 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 ()
(setf *unit-in-edit* nil
*row-in-edit* -1))
;; ------------------------------------------------------------------------
;; Implement the DataGridView callbacks.
;;
;; These are reasonably complex little calls. I refer you to the "Walkthrough"
;; mentioned at the start of the file for further information on how they
;; 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 ((row-index [%RowIndex event])
(column-index [%ColumnIndex event])
(unit nil))
(unless (is-new-row row-index)
(if (is-row-in-edit row-index)
;; then
(setf unit *unit-in-edit*)
;; 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 DataGridView.
;; It gives the underlying storage mechanism a chance to update the value.
;;
;; 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 ((row-index [%RowIndex event])
(column-index [%ColumnIndex event])
(unit-tmp nil))
(if (< row-index (length *database-units*))
(progn
(when (equal *unit-in-edit* nil)
(setf *unit-in-edit* (clone-unit (database-get-unit-at row-index))))
(setf unit-tmp *unit-in-edit*
*row-in-edit* row-index))
;; else
(setf unit-tmp *unit-in-edit*))
(unless (equal unit-tmp nil)
(let ((value [%Value event]))
(case column-index
((0) (setf (code unit-tmp) (rdnzl:unbox (rdnzl:cast value "System.String"))))
((1) (setf (name unit-tmp) (rdnzl:unbox (rdnzl:cast value "System.String"))))
((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 simply
;; 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)
(setf *unit-in-edit* (make-unit "" "" "")
*row-in-edit* (- (data-grid-view-row-count) 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 ((row-index [%RowIndex event]))
(if (and (>= row-index (database-units-count))
(not (= row-index (- (data-grid-view-row-count) 1) )))
(progn
(database-add-unit *unit-in-edit*)
(reset-unit-in-edit))
(if (and (not (equal *unit-in-edit* nil))
(< row-index (database-units-count)))
(progn
(database-update-unit-at row-index *unit-in-edit*)
(reset-unit-in-edit))
(if [%ContainsFocus *units-data-grid-view*]
(reset-unit-in-edit))))))
;; Used by the DataGridView to determine if current row has uncommitted changes.
;;
;; Note - I'm not quite sure how this works.
;;
;; QuestionEventArgs
;; Boolean Response - True or False.
(defun row-dirty-state-needed (object event)
(unless *row-scope-commit*
(setf [%Response event] [%IsCurrentCellDirty *units-data-grid-view*])))
;; 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 edit.
;;
;; QuestionEventArgs
;; Boolean Response - True to cancel the row-edit, False (I assume) to let it
;; continue.
(defun cancel-row-edit (object event)
(if (and (= *row-in-edit* (- (data-grid-view-row-count) 2))
(= *row-in-edit* (database-units-count)))
(setf *unit-in-edit* (make-unit "" "" ""))
(reset-unit-in-edit)))
;; 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* ((data-grid-row [%Row event])
(row-index [%Index data-grid-row]))
(when (< row-index (database-units-count))
(database-remove-unit-at row-index))
(when (= row-index *row-in-edit*)
(reset-unit-in-edit))))
;; ------------------------------------------------------------------------
;; 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)
col))
;; 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 ()
(setf *units-data-grid-view* (rdnzl:new "DataGridView")
*row-in-edit* -1
*unit-in-edit* nil
*row-scope-commit* t
[%VirtualMode *units-data-grid-view*] t
[%Dock *units-data-grid-view*] [$DockStyle.Fill]
[%Text *units-data-grid-view*] "DataGridView Experiment"
[%RowHeadersVisible *units-data-grid-view*] t)
[Add [%Columns *units-data-grid-view*] (create-column 0 "code" "Code")]
[Add [%Columns *units-data-grid-view*] (create-column 1 "name" "Name")]
[Add [%Columns *units-data-grid-view*] (create-column 2 "description" "Description")]
[+CellValueNeeded *units-data-grid-view* (rdnzl:new "DataGridViewCellValueEventHandler" #'cell-value-needed)]
[+CellValuePushed *units-data-grid-view* (rdnzl:new "DataGridViewCellValueEventHandler" #'cell-value-pushed)]
[+NewRowNeeded *units-data-grid-view* (rdnzl:new "DataGridViewRowEventHandler" #'new-row-needed)]
[+UserDeletingRow *units-data-grid-view* (rdnzl:new "DataGridViewRowCancelEventHandler" #'user-deleting-row)]
[+CancelRowEdit *units-data-grid-view* (rdnzl:new "QuestionEventHandler" #'cancel-row-edit)]
[+RowDirtyStateNeeded *units-data-grid-view* (rdnzl:new "QuestionEventHandler" #'row-dirty-state-needed)]
[+RowValidated *units-data-grid-view* (rdnzl:new "DataGridViewCellEventHandler" #'row-validated)])
;; Call this function to run the application.
(defun run-datagridview-experiment ()
(let ((form (rdnzl:new "Form")))
(create-units-editor)
(setf [%Text form] "DataGridView Experiment")
[Add [%Controls form] *units-data-grid-view*]
[BringToFront *units-data-grid-view*]
[Application.Run form]))
(run-datagridview-experiment)