forum.clarionlife.net

Код: Выделить всё

               PROGRAM
               MAP
               END

ImagesQueue    QUEUE,TYPE
id               LONG
feq              LONG
               END

MoveImages     CLASS,TYPE
List             &ImagesQueue
Construct        PROCEDURE
Destruct         PROCEDURE
Add              PROCEDURE(LONG id, LONG feq)
MoveUp           PROCEDURE(LONG id)
MoveDown         PROCEDURE(LONG id)
SwapProperty     PROCEDURE(LONG feq1, LONG feq2)
               END

Window WINDOW('Move images'),AT(,,344,238),FONT('Tahoma',,,),CENTER,GRAY,RESIZE
       GROUP('Image 1'),AT(252,6,83,49),USE(?Group1),BOXED
         BUTTON('Move Up'),AT(279,18,45,14),USE(?ButtonUp)
         BUTTON('Move Down'),AT(279,33,45,14),USE(?ButtonDown)
       END
       PROMPT('1'),AT(117,21),USE(?Prompt1:1)
       PROMPT('2'),AT(144,54),USE(?Prompt1:2)
       GROUP('Image 3'),AT(252,60,83,49),USE(?Group1:1),BOXED
         BUTTON('Move Up'),AT(279,72,45,14),USE(?ButtonUp1)
         BUTTON('Move Down'),AT(279,87,45,14),USE(?ButtonDown1)
       END
       PROMPT('3'),AT(174,84),USE(?Prompt1:3)
       PROMPT('4'),AT(201,114),USE(?Prompt1:4)
     END

c    LONG

mi   MoveImages


  CODE
  OPEN(Window)
  Window{PROP:Buffer} = 1
  ACCEPT
    CASE ACCEPTED()
    OF ?ButtonUp
      mi.MoveUp(1)
    OF ?ButtonDown
      mi.MoveDown(1)
    OF ?ButtonUp1
      mi.MoveUp(3)
    OF ?ButtonDown1
      mi.MoveDown(3)
    END
    CASE EVENT()
    OF EVENT:OpenWindow
      c = CREATE(0, CREATE:Image)
      (c){PROP:Hide} = FALSE
      (c){PROP:Text} = 'VF_ac13.jpg'
      (c){PROP:XPos} = 10
      (c){PROP:YPos} = 10
      (c){PROP:Width} = 100
      (c){PROP:Height} = 100
      (c){PROP:Tiled} = 1
      mi.Add(1, c)
      c = CREATE(0, CREATE:Image)
      (c){PROP:Hide} = FALSE
      (c){PROP:Text} = 'VF_pois01a.jpg'
      (c){PROP:XPos} = 40
      (c){PROP:YPos} = 40
      (c){PROP:Width} = 100
      (c){PROP:Height} = 100
      (c){PROP:Tiled} = 1
      mi.Add(2, c)
      c = CREATE(0, CREATE:Image)
      (c){PROP:Hide} = FALSE
      (c){PROP:Text} = 'VF_pois01b.jpg'
      (c){PROP:XPos} = 70
      (c){PROP:YPos} = 70
      (c){PROP:Width} = 100
      (c){PROP:Height} = 100
      (c){PROP:Tiled} = 1
      mi.Add(3, c)
      c = CREATE(0, CREATE:Image)
      (c){PROP:Hide} = FALSE
      (c){PROP:Text} = 'VF_pattern33.jpg'
      (c){PROP:XPos} = 100
      (c){PROP:YPos} = 100
      (c){PROP:Width} = 100
      (c){PROP:Height} = 100
      (c){PROP:Tiled} = 1
      mi.Add(999, c)
    END
  END
  CLOSE(Window)



MoveImages.Construct        PROCEDURE
  CODE
  SELF.List &= NEW ImagesQueue

MoveImages.Destruct         PROCEDURE
  CODE
  FREE(SELF.List)
  DISPOSE(SELF.List)

MoveImages.Add              PROCEDURE(LONG id, LONG feq)
  CODE
  SELF.List.id = id
  SELF.List.feq = feq
  ADD(SELF.List)

MoveImages.MoveUp           PROCEDURE(LONG id)
pos                         LONG
feq1                        LONG
feq2                        LONG
id1                         LONG
id2                         LONG
  CODE
  SELF.List.id = id
  GET(SELF.List, SELF.List.id)
  IF NOT ERRORCODE()
    feq1 = SELF.List.feq
    id1 = SELF.List.id
    pos = POINTER(SELF.List)
    GET(SELF.List, pos+1)
    IF NOT ERRORCODE()
      feq2 = SELF.List.feq
      id2 = SELF.List.id
      SELF.SwapProperty(feq1,feq2)
      SELF.List.id = id1
      PUT(SELF.List)
      GET(SELF.List, pos)
      SELF.List.id = id2
      PUT(SELF.List)
    END
  END

MoveImages.MoveDown         PROCEDURE(LONG id)
pos                         LONG
feq1                        LONG
feq2                        LONG
id1                         LONG
id2                         LONG
  CODE
  SELF.List.id = id
  GET(SELF.List, SELF.List.id)
  IF NOT ERRORCODE()
    feq1 = SELF.List.feq
    id1 = SELF.List.id
    pos = POINTER(SELF.List)
    GET(SELF.List, pos-1)
    IF NOT ERRORCODE()
      feq2 = SELF.List.feq
      id2 = SELF.List.id
      SELF.SwapProperty(feq1,feq2)
      SELF.List.id = id1
      PUT(SELF.List)
      GET(SELF.List, pos)
      SELF.List.id = id2
      PUT(SELF.List)
    END
  END

MoveImages.SwapProperty     PROCEDURE(LONG feq1, LONG feq2)
ip                          GROUP
XPos                          LONG
YPos                          LONG
Width                         LONG
Height                        LONG
Text                          STRING(255)
                            END
  CODE
  ip.XPos = feq1{PROP:XPos}
  ip.YPos = feq1{PROP:YPos}
  ip.Width = feq1{PROP:Width}
  ip.Height = feq1{PROP:Height}
  ip.Text = feq1{PROP:Text}

  feq1{PROP:XPos} = feq2{PROP:XPos}
  feq1{PROP:YPos} = feq2{PROP:YPos}
  feq1{PROP:Width} = feq2{PROP:Width}
  feq1{PROP:Height} = feq2{PROP:Height}
  feq1{PROP:Text} = feq2{PROP:Text}

  feq2{PROP:XPos} = ip.XPos
  feq2{PROP:YPos} = ip.YPos
  feq2{PROP:Width} = ip.Width
  feq2{PROP:Height} = ip.Height
  feq2{PROP:Text} = ip.Text