* ccontrol.prg 

* 26-Oct-98 major rev

define class hdrSeeker as Header

Name = "hdrSeeker"
mcArrowName = ""    && name of the arrow used for all headers of the grid
mlAscending = .f.   && flag for sort order
mlColumnMoved = .f. && flag indicating column was moved
mnColumnOrder = 0   && original column order
mlColumnSized = .f. && flag indicating column was resized
mnColumnWidth = 0   && original size of column
mcTag = ""          && name of the index tag

procedure Init( pcTag )
local lcName

this.mcTag = iif( ! empty( pcTag ), pcTag, "" )
this.FontBold = ! empty( this.mcTag )

lcName = this.parent.parent.Name + "lblHeaderArrow"
this.mcArrowName = "this.parent.parent.parent." + lcName

if ( type( (this.mcArrowName) ) == "U" )
   * arrow doesn't exist yet so create it
   lcGrid = FullName( this.parent.parent )
   lcGrid = "thisform" + substr( lcGrid, at( '.', lcGrid ) )
   this.parent.parent.parent.AddObject( (lcName), "lblHeaderArrow", lcGrid )
endif

if ( ! empty( this.mcTag ) )
   this.parent.Width = this.parent.Width + 5
endif

endproc

procedure Click()
local loArrow

loArrow = evaluate( this.mcArrowName )

if ( ! empty( this.mcTag ) and ! this.mlColumnMoved and ! this.mlColumnSized )
   * sortable column that was clicked
   this.mlAscending = ! this.mlAscending
   this.parent.parent.Reorder( this.mcTag, this.mlAscending )
   loArrow.mcColumnName = this.parent.Name
endif

loArrow.SetPosition() && update position
endproc

procedure MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord

with this
   * initialize items that will be tested in MouseUp
   .mnColumnOrder = this.parent.ColumnOrder
   .mnColumnWidth = this.parent.Width
endwith
endproc

procedure MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord

with this
   * check to see if this was a resize or move
   .mlColumnMoved = ( this.parent.ColumnOrder != .mnColumnOrder )
   .mlColumnSized = ( this.parent.Width != .mnColumnWidth )
endwith
endproc

procedure Error
LPARAMETERS nError, cMethod, nLine
ObjError( this, nError, cMethod, nLine )
endproc

enddefine

**************************************************
*-- Class:        grdfind (c:\vfp6app\ccontrol.vcx)
*-- ParentClass:  resizeablegrid (c:\vfp6app\ccontrol.vcx)
*-- BaseClass:    grid
*-- Time Stamp:   11/18/98 12:39:12 PM
*
DEFINE CLASS grdfind AS resizeablegrid


DeleteMark = .F.
Name = "grdfind"


*-- Reorder the grid
PROCEDURE reorder
lparameter pcOrder, plAscending

local i, j, llLockScreen, lnRecno, lnRelativeRow, lnDirection, lcDescending

llLockScreen = thisform.LockScreen  && prevent user from seeing all of the jumping
thisform.LockScreen = .t.

lnRecno = recno()
lnRelativeRow = this.RelativeRow
lcDescending = iif( ! plAscending, "descending", "ascending" )
set order to pcOrder &lcDescending
this.Refresh()

goto lnRecno                        && move record pointer back
this.Refresh()

if ( lnRelativeRow != this.RelativeRow )
   * the record didn't wind up at the same grid row, so we scroll the grid

   lnDirection = iif( lnRelativeRow > this.RelativeRow, 0, 1 )
   j = abs( lnRelativeRow - this.RelativeRow )
   for i = 1 to j
      this.DoScroll( lnDirection )
   endfor

   this.Refresh() && YAR
endif

thisform.LockScreen = llLockScreen
ENDPROC


*-- GetMinWidth  - this method finds the min width to display all columns
PROCEDURE getminwidth
local i, j

j = 10 + sysmetric( 5 ) + 2 * this.GridLineWidth && record marker & vertical scroll bar
for i = 1 to this.ColumnCount
   with this.Columns[i]
      j = j + .Width + this.GridLineWidth
   endwith
endfor

return j
ENDPROC


PROCEDURE Scrolled
LPARAMETERS nDirection

if ( nDirection >= 4 )
   local lcName, loArrow
   lcName = "this.parent." + this.Name + "lblHeaderArrow"
   loArrow = evaluate( lcName )
   loArrow.SetPosition()
endif
ENDPROC


PROCEDURE Init
lparameter pcFieldList

ResizeableGrid::Init()

if ( pcount() = 0 )
   pcFieldList = ""
endif

if ( ! empty( pcFieldList ) )
   pcFieldList = chrtran( lower( pcFieldList ) + ",", " ", "" )
endif

local i, j, k, lcTag, lcControlSource, laControlSource[this.ColumnCount]

for i = 1 to this.ColumnCount
   with this.Columns[i]
      lcControlSource = lower( .ControlSource )
      k = at( '.', lcControlSource )
      if ( k > 0 )
         lcControlSource = substr( lcControlSource, k+1 )
      endif
      if ( ! empty( pcFieldList ) )
         if ( ! lcControlSource + "," $ pcFieldList )
            .ControlSource = ""
         endif
      endif
      laControlSource[i] = lcControlSource
   endwith
endfor

for i = this.ColumnCount to 1 step -1
   if ( empty( this.Columns[i].ControlSource ) )
      this.DeleteColumn( i )
      adel( laControlSource, i )
   endif
endfor

if ( ! ( "CCONTROL.VCX" $ set( "classlib" ) ) )
   set classlib to ccontrol additive
endif

if ( ! ( this.ClassLibrary $ set( "classlib" ) ) )
   set classlib to (this.ClassLibrary) additive
endif

if ( ! ( "CCONTROL.FXP" $ set( "procedure" ) ) )
   * header class is in ccontrol.prg
   set procedure to ccontrol additive
endif

local loHeader, lnX, lcX

*loHeader = createobject( "hdrSeeker" )

for i = 1 to tagcount()
   lcTag = lower( tag(i) )
   j = ascan( laControlSource, lcTag )
   if ( j > 0 )
      with this.Columns[j]
         * copy object properties because they're not default values or come from dbc
         lcX = .Header1.Caption
         .RemoveObject( "Header1" )
         .AddObject( "Header1", "hdrSeeker", lcTag )
         .Header1.Caption = lcX

         if ( type( .ControlSource ) == "C" )
            .RemoveObject( "Text1" )
            .AddObject( "Text1", "txtSeeker" )
            with .Text1
               .Visible = .t.
               .mcTag = lcTag
               .mlUpper = "UPPER" $ upper( sys( 14, i ) )
            endwith
         else
            .ReadOnly = .t.
         endif
      endwith
   endif
endfor

* make all col headers left aligned and switch the rest of the headers

for each loCol in this.Columns
   with loCol
      .Header1.Alignment = 0
      if ( .Header1.Class == "Header" )
         lcX = .Header1.Caption
         .RemoveObject( "Header1" )
         .AddObject( "Header1", "hdrSeeker", "" )
         .Header1.Caption = lcX
         .Header1.FontBold = .f.
      endif
   endwith
endfor
ENDPROC


PROCEDURE Resize
dodefault()

this.ScrollBars = iif( this.Width > this.GetMinWidth(), 2, 3 )
ENDPROC


ENDDEFINE
*
*-- EndDefine: grdfind
**************************************************