forum.clarionlife.net

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

mRunDynArray   procedure
tgMyGroup           group,type
lID                   long
rSum                  real
szStr                 cstring(31)
                    end



tagMyGroupArray     group,type
gMyGroup              group(tgMyGroup),dim(1).
                    end

pagMyGroupArray     &tagMyGroupArray
loc:ptr             long
loc:lArraySize      long(10)

!Ниже для нагладности

qMyGroup            queue(tgMyGroup).
loc:i               long




window WINDOW('mRunDynArray'),AT(,,331,216),FONT('MS Sans Serif',10,,FONT:regular),CENTER,STATUS,SYSTEM, |
         GRAY,MAX,RESIZE,MDI
       SPIN(@n4),AT(132,5,60,12),USE(loc:lArraySize),HVSCROLL,RIGHT(2),RANGE(1,100),STEP(1)
       BUTTON('Создать'),AT(210,2,60,16),USE(?bArrayCreate),FLAT,LEFT,ALRT(EscKey),ICON(ICON:New)
       PROMPT('Размер массива'),AT(73,6),USE(?Prompt1)
       LIST,AT(1,30),USE(?qMyGroup),FULL,HVSCROLL,ALRT(EnterKey),ALRT(MouseRight),ALRT(EnterKey),ALRT(MouseLeft2), |
           ALRT(EscKey),VCR,FORMAT('40R(2)|FM~ID~@n11@60R(2)|FM~Сумма~@n18.2@140L(2)|FM~Строка~S(800)@s255@'), |
           FROM(qMyGroup)
       BUTTON('Выход'),AT(1,2,60,16),USE(?bClose),FLAT,LEFT,ALRT(EscKey),ICON('exit.ico'),STD(STD:Close)
     END
  code
  open(window)
  accept

    case field()
    of ?bArrayCreate
       case event()
       of EVENT:Accepted
           do mRun
       end
    end
  end
  do onExit
  close(window)

onExit  routine
 do mFreePtr

mFreePtr  routine
 if loc:ptr
    !WinAPI
    HeapFree(GetProcessHeap(),0,loc:ptr)
    loc:ptr = 0
 end

mRun  routine
 do mFreePtr
 update(?loc:lArraySize)
 if ~inrange(loc:lArraySize, 1, 100) !Сами ограничиваем
    Select(?loc:lArraySize)
    beep
    exit.

 !WinAPI
 loc:ptr = HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,size(tgMyGroup) * loc:lArraySize)
 if ~loc:ptr
     exit.

 pagMyGroupArray &= (loc:ptr)
 do mFill_Array
 do mFill_Queue

mFill_Array  routine
 loop loc:i = 1 to loc:lArraySize
    pagMyGroupArray.gMyGroup[loc:i].lID   = loc:i
    pagMyGroupArray.gMyGroup[loc:i].rSum  = 200 + loc:i
    pagMyGroupArray.gMyGroup[loc:i].szStr = 'Строка номер '&loc:i
 end
mFill_Queue  routine
 free(qMyGroup)
 loop loc:i = 1 to loc:lArraySize
     qMyGroup = pagMyGroupArray.gMyGroup[loc:i]
     add(qMyGroup)

 end