Clarion Community Help

The following example shows a sequence of statements to declare, instantiate, initialize, use, and terminate an EditMultiSelectClass object and a related BrowseClass object. The example page-loads a LIST of fieldnames and associated control attributes (such as color, font, when-to-apply, etc.), then edits the “when-to-apply” items with an EditMultiSelectClass object. Note that the BrowseClass object calls the “registered” EditMultiSelectClass object's methods as needed.

  PROGRAM

_ABCDllMode_  EQUATE(0)

_ABCLinkMode_ EQUATE(1)

  INCLUDE('ABWINDOW.INC')

  INCLUDE('ABBROWSE.INC')

  INCLUDE('ABEIP.INC')

  MAP

  END

Property   FILE,DRIVER('TOPSPEED'),PRE(PR),CREATE,BINDABLE,THREAD

NameKey     KEY(PR:FieldName),NOCASE,OPT

Record      RECORD,PRE()

FieldName    STRING(30)

Color        STRING(20)

Hidden       STRING(1)

IconFile     STRING(30)

Font         STRING(40)

ControlType  STRING(12)

ApplyTo      CSTRING(500)

           END

          END

   

PropView   VIEW(Property)

          END

PropQ         QUEUE

PR:FieldName   LIKE(PR:FieldName)

PR:Color       LIKE(PR:Color)

PR:Font        LIKE(PR:Font)

PR:ControlType LIKE(PR:ControlType)

PR:Hidden      LIKE(PR:Hidden)

PR:IconFile    LIKE(PR:IconFile)

PR:ApplyTo     LIKE(PR:ApplyTo)

ViewPosition   STRING(1024)                  

             END

BRW1 CLASS(BrowseClass)

Q     &PropQ

    END

Edit:PR:ApplyTo CLASS(EditMultiSelectClass)!declare Edit:PR:ApplyTo-EIP multi dialog

Init             PROCEDURE(UNSIGNED FieldNumber,UNSIGNED ListBox,*? UseVar),VIRTUAL

TakeAction       PROCEDURE(BYTE Action,<;STRING Item>,LONG Pos1=0,LONG Pos2=0),VIRTUAL

               END

PropWindow WINDOW('Browse Properties'),AT(,,318,137),IMM,SYSTEM,GRAY

           LIST,AT(8,4,303,113),USE(?PropList),IMM,HVSCROLL,FROM(PropQ),|

           FORMAT( '50L(2)|_M~Field Name~@s30@[70L(2)|_M~Color~@s20@' &amp;|

                   '60L(2)|_M~Font~@s40@60L(2)|_M~Control Type~@s12@' &amp;|

                   '20L(2)|_M~Hide~L(0)@s1@/130L(2)|_M~Icon File~@s30@' &amp;|

                   '120L(2)|_M~Apply To~L(0)@s25@]|M')

           BUTTON('&amp;Insert'),AT(169,121),USE(?Insert)

           BUTTON('&amp;Change'),AT(218,121),USE(?Change),DEFAULT

           BUTTON('&amp;Delete'),AT(267,121),USE(?Delete)

          END

GlobalErrors   ErrorClass

Access:Property CLASS(FileManager)

Init             PROCEDURE

               END

Relate:Property  CLASS(RelationManager)

Init              PROCEDURE

Kill              PROCEDURE,VIRTUAL

                END

GlobalRequest   BYTE(0),THREAD

GlobalResponse  BYTE(0),THREAD

VCRRequest      LONG(0),THREAD

ThisWindow CLASS(WindowManager)

Init        PROCEDURE(),BYTE,PROC,VIRTUAL

Kill        PROCEDURE(),BYTE,PROC,VIRTUAL

          END

CODE

GlobalErrors.Init

Relate:Property.Init

GlobalResponse = ThisWindow.Run()

Relate:Property.Kill

GlobalErrors.Kill

ThisWindow.Init  PROCEDURE()

ReturnValue    BYTE,AUTO

CODE

SELF.Request = GlobalRequest

ReturnValue = PARENT.Init()

SELF.FirstField = ?PropList

SELF.VCRRequest &amp;= VCRRequest

SELF.Errors &amp;= GlobalErrors

Relate:Property.Open

BRW1.Init(?PropList,PropQ.ViewPosition,PropView,PropQ,Relate:Property,SELF)

OPEN(PropWindow)

SELF.Opened=True

?PropList{PROP:LineHeight}=12          !enlarge rows to accomodate EIP icons

 BRW1.Q &amp;= PropQ

 BRW1.AddSortOrder(,PR:NameKey)

 BRW1.AddField(PR:FieldName,BRW1.Q.PR:FieldName)

 BRW1.AddField(PR:Color,BRW1.Q.PR:Color)

 BRW1.AddField(PR:Font,BRW1.Q.PR:Font)

 BRW1.AddField(PR:ControlType,BRW1.Q.PR:ControlType)

 BRW1.AddField(PR:Hidden,BRW1.Q.PR:Hidden)

 BRW1.AddField(PR:IconFile,BRW1.Q.PR:IconFile)

 BRW1.AddField(PR:ApplyTo,BRW1.Q.PR:ApplyTo)

 BRW1.AddEditControl(Edit:PR:ApplyTo,7)!use Edit:PR:ApplyTo to edit BRW1 col 7

 BRW1.ArrowAction = EIPAction:Default+EIPAction:Remain+EIPAction:RetainColumn

 BRW1.InsertControl=?Insert

 BRW1.ChangeControl=?Change

 BRW1.DeleteControl=?Delete

 SELF.SetAlerts()

 RETURN ReturnValue

ThisWindow.Kill  PROCEDURE()

ReturnValue    BYTE,AUTO

 CODE

 ReturnValue = PARENT.Kill()

 Relate:Property.Close

 RETURN ReturnValue

Edit:PR:ApplyTo.Init PROCEDURE(UNSIGNED FieldNumber,UNSIGNED ListBox,*? UseVar)

 CODE

 PARENT.Init(FieldNumber,ListBox,UseVar)

 SELF.Reset

 SELF.AddValue('Browse',INSTRING('Browse',SELF.UseVar,1,1))  !set multi-select choice

 SELF.AddValue('Form',INSTRING('Form',SELF.UseVar,1,1))      !set multi-select choice

 SELF.AddValue('Report',INSTRING('Report',SELF.UseVar,1,1))  !set multi-select choice

 SELF.AddValue('Window',INSTRING('Window',SELF.UseVar,1,1))  !set multi-select choice

Edit:PR:ApplyTo.TakeAction PROCEDURE(BYTE Action,<;STRING Item>,LONG Pos1=0,LONG Pos2=0)

HoldIt  CSTRING(1024)        !indexable string of end user choices

Pos     USHORT               !index to parse end user selections

Comma   USHORT               !index to parse end user selections

ItemQ   QUEUE                !Q to reorder end user selections

Item    CSTRING(100)

Ord     BYTE

                          END

CODE

PARENT.TakeAction(Action,Item,Pos1,Pos2)

HoldIt=SELF.UseVar

CASE Action

OF MSAction:Add                !end user selected an Item

   IF HoldIt

     HoldIt=HoldIt&amp;','&amp;Item

   ELSE

     HoldIt=Item

   END

OF MSAction:Delete               !end user deselected an Item

   Pos=INSTRING(Item,HoldIt,1,1)

   CASE Pos

   OF 0

     MESSAGE(Item&amp;' not found!')

   OF 1                     !first item

     HoldIt=HoldIt[Pos+LEN(Item)+1 : LEN(HoldIt)] !deselect first item

   ELSE

     IF Pos+LEN(Item) > LEN(HoldIt)     !last item

       HoldIt=HoldIt[1 : Pos-2]         !deselect last item

     ELSE                               !deselect any other item

       HoldIt=HoldIt[1 : Pos-1] &amp; HoldIt[Pos+LEN(Item)+1 : LEN(HoldIt)]

     END

   END

 OF MSAction:Move                       !Selected Item moved up or down

   FREE(ItemQ)                          ! Pos1=Item's “old” position

   CLEAR(ItemQ)                         ! Pos2=Item's “new” position

   Comma=1

   LOOP WHILE Comma                     !build Q of Selected Items

     Comma = INSTRING(',',HoldIt,1,1)   ! to use for repositioning

     ItemQ.Ord+=1

     IF Comma

       ItemQ.Item  = HoldIt[1 : Comma-1]

       ADD(ItemQ,ItemQ.Ord)

   HoldIt=HoldIt[Comma+1 : LEN(HoldIt)] !comma separated list of user choices

     ELSE

       ItemQ.Item = HoldIt

       ADD(ItemQ,ItemQ.Ord)

     END

   END

   ItemQ.Ord=Pos2

   GET(ItemQ, ItemQ.Ord)                !get the “bumped” item

   ItemQ.Ord=Pos1

   PUT(ItemQ)                           !reposition the “bumped” item

   ItemQ.Item=Item

   GET(ItemQ, ItemQ.Item)               !get the selected item

   ItemQ.Ord=Pos2

   PUT(ItemQ)                           !reposition the selected item

   SORT(ItemQ,ItemQ.Ord)                !reorder Q of selected items  

   HoldIt=''

   LOOP Pos = 1 TO RECORDS(ItemQ)       !refill comma separated list

     GET(ItemQ,Pos)

     IF HoldIt

       HoldIt=HoldIt&amp;','&amp;ItemQ.Item

     ELSE

       HoldIt=ItemQ.Item

     END

   END

OF MSAction:StartProcess                !begin AddAll (») or DeleteAll (<;<;)

 SETCURSOR(CURSOR:Wait)

OF MSAction:EndProcess                  !end AddAll (») or DeleteAll (<;<;)

 SETCURSOR()

END

SELF.UseVar=HoldIt

Access:Property.Init PROCEDURE

CODE

PARENT.Init(Property,GlobalErrors)

SELF.FileNameValue = 'Property'

SELF.Buffer &amp;= PR:Record

SELF.Create = 1

SELF.AddKey(PR:NameKey,'PR:NameKey',0)

Relate:Property.Init PROCEDURE

CODE

Access:Property.Init

PARENT.Init(Access:Property,1)

Relate:Property.Kill PROCEDURE

CODE

Access:Property.Kill

PARENT.Kill