[MS] '''Note''': 
This is similar to Jeff's non-compressing encoding at [Binary image compression challenge]. It does not compress, the size of the encoded file for an image having ''X'' pixels is (12+X/8) bytes.

My compressing entry is at [Binary image compression challenge - MS's Entry]
----

The differences are:
   * faster encoding - access the [[$img data]] in one go, instead of repeating [[$img get]] calls. Note that it does this twice (once hidden in the '''photo'colors''' call).
   * it encodes ''changes'' in color, instead of encoding the color. 

The second difference is expected to produce more zeros, and hence (maybe?) a file that compresses better even though it has the same length as Jeff's.
----
'''Results'''
   * courier12.dif: 2163b (courier12.dif.gz: 660b) courier12.gif: 1923b
   * times12i.dif:  1611b (times12i.dif.gz:  683b) times12i.gif:   1947b
   * castle.dif:   15763b (castle.dif.gz:  10234b) castle.gif:    11598b

''castle.dif'' has 80% nonzero bits, versus 69% in ''castle.jeff''.
----
 #
 # Given an image, it returns an encoded binary string.
 #

 proc analyse img {
     set h [image height $img]
     set w [image width  $img]
     set raw [$img data]
     set clr0 [lindex [lindex $raw 0] 0]
     set clr $clr0
     set str {}
 
     catch {
 	foreach line $raw {
 	    foreach pix $line {
 		if {$pix ne $clr} {
 		    set clr1 $pix
 		    return; #double break
 		}
 	    }
 	}
 	set clr1 $clr0
     }
 
     foreach line $raw {
 	foreach pix $line {
 	    append str [expr {$pix ne $clr}]
 	    set clr $pix
 	}
     }
     set clr0 [expr {[string replace $clr0 0 0 0x]}]
     set clr1 [expr {[string replace $clr1 0 0 0x]}]
     return [binary format ssiib* $w $h $clr0 $clr1 $str]
 }

 #
 # Given an encoded binary string, it returns an image.
 #
 
 proc synth {data} {
     binary scan $data ssiib* w h clr0 clr1 str
     set img [image create photo -width $w -height $h]
 
     set clr0 \#[format %06x $clr0]
     set clr1 \#[format %06x $clr1]
 
     set empty [list]
     set data $empty
     set line $empty
 
     set clrs [list $clr0 $clr1]
     set clr $clr0
     set nclr 0
     set i 0
     foreach bit [split $str {}] {
 	if {$bit} {
 	    set nclr [expr {!$nclr}]
 	    set clr [lindex $clrs $nclr]
 	}
 	lappend line $clr
 	if {[incr i] == $w} {
 	    lappend data $line
 	    set line $empty
 	    set i 0
 	}
     }
 
     $img put $data -to 0 0
     return $img
 }

----
[PS] I've tried your version in my compression code (my second attempt). The results are interesting indeed, both castle and courier12 compress less than with the [JH] variant. Howerver, times12i compresses somewhat better - Here are the numbers:

   * courier12: Was 671, grows to 721, gaining 50 bytes
   * times12i: Was 718, shrinks to 684, 34 bytes less
   * castle: Was 11442, grows to 12417, gaining 975 bytes.