forum.clarionlife.net

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

MAP
  MODULE('Clarion RTL')
    RTL::NewMem(UNSIGNED _Size),ULONG,NAME('Cla$NewMemZ')
    RTL::NewStr(UNSIGNED _Size),ULONG,NAME('Cla$NewMemB')
    RTL::FreeMem(ULONG _Addr),NAME('_free')
    RTL::Mem2UfoAddr(ULONG _VarAddr,BYTE _VarType,ULONG _DecFloat=0, |
    UNSIGNED _VarSize,BYTE=0),ULONG,RAW,NAME('Cla$Mem2Ufo')
    RTL::FreeUfo(ULONG _UFOAddr),RAW,NAME('Cla$FreeUfo')
    RTL::Bind(ULONG _UFOAddr,STRING _Name),NAME('Cla$BindV')
    RTL::UnBind(STRING _Name),NAME('Cla$UnbindV')
    RTL::GetBindVar(STRING _cVarName),*?,RAW,NAME('Cla$EvaluateVariable')
  END
END

Var1  ANY
sVar1 STRING(40)
Var2  ANY
sVar2 STRING(40)

VarNamesQue QUEUE,PRE(VAR)
Name     STRING(40) ! Имя переменной
Type     LONG ! Тип
Size     LONG ! Размер
DecFloat BYTE ! Для DECIMAL/PDECIMAL
Addr     LONG ! Здесь будет адрес блока памяти
UFOAddr  LONG ! Здесь будет адрес UFO-оболочки для переменной
           END
!
! Последние два поля при создании очереди инициализируются нулями.
!

CODE
...
Loop Var# = 1 to Records(VarNameQue)
  Get(VarNameQue,Var#)
  if ~VAR:Name OR ~VAR:Type OR ~VAR:Size Then Cycle.
  if VAR:Type = TYPE:STRING
    VAR:Addr = RTL::NewStr(VAR:Size)
  else
    VAR:Addr = RTL::NewMem(VAR:Size)
  .
  if ~VAR:Addr then Cycle. ! Память не выделена
  VAR:UFOAddr = RTL::Mem2UfoAddr(VAR:Addr,VAR:Type,VAR:DecFloat,VAR:Size)
  if ~VAR:UFOAddr ! UFO-оболочка не создана
    RTL::FreeMem(VAR:Addr)
    Cycle
  .
  RTL::Bind(VAR:UFOAddr,VAR:Name)
  Put(VarNameQue)   ! Обновить запись
.

Get(VarNameQue,1); Var1 &= RTL::GetBindVar(Clip(VAR:Name)&'<0>')
Get(VarNameQue,2); Var2 &= RTL::GetBindVar(Clip(VAR:Name)&'<0>')
! ВНИМАНИЕ!!! Если какая-либо переменная не найдена и ANY &= Null,
! без проверки на Message() получим GPF.
if ~(Var1 &= Null) AND ~(Var2 &= Null)
  Message(Var1 + Var2) ! Var1 + Var2
.

! В конце надо освобождать за собой занятую память:

  Loop Var# = 1 to Records(VarNameQue)
    Get(VarNameQue,Var#)
    if ~VAR:Addr then Cycle.
    RTL::FreeMem(VAR:Addr); Clear(VAR:Addr)
    if ~VAR:UFOAddr then Cycle.
    RTL::FreeUfo(VAR:UFOAddr); Clear(VAR:UFOAddr)
    RTL::UnBind(Clip(VAR:Name))
  .

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

Var[numb_of_var#] &= RTL::GetBindVar(Clip(VAR:Name)&'<0>')

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

Var[numb_of_var#] &= (VAR:Addr)

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

WINDOW('text-text-text'),AT(,,318,231),FONT('MS Sans Serif',8,,FONT:regular),ALRT(MouseLeft2),IMM,ICON('icon.ico'),TIMER(0),SYSTEM,GRAY,MASK,AUTO

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

ENTRY(@S20),AT(4,31,48,10),USE(loc:fl_Date),IMM,FLAT,RIGHT(2),FONT(,,COLOR:Blue,,CHARSET:ANSI), OVR

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

MAP
  RTL::Mem2Ufo(LONG _VarAddr,BYTE _VarType,LONG _DecFloat=0,UNSIGNED _VarSize,BYTE=0),*?,NAME('Cla$Mem2Ufo'),DLL(dll_mode)
END

  Var[numb_of_var#] &= RTL::Mem2Ufo(VAR:Addr,VAR:Type,VAR:DecFloat,VAR:Size)

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

window  WINDOW('Тест'),AT(,,300,150),CENTER,IMM,SYSTEM,GRAY,DOUBLE,AUTO,MDI
  END

?Entry1  EQUATE(100)
?Entry2  EQUATE(101)
?Ok  EQUATE(102)
?Cancel  EQUATE(103)

  OPEN(Window)

  CREATE(?Entry1,CREATE:entry)
  SETPOSITION(?Entry1,x1,y1,w1,h1)
  ?Entry1{PROP:Text} = '@n15`2'
  UNHIDE(?Entry1)

  CREATE(?Entry2,CREATE:entry)
  SETPOSITION(?Entry2,x2,y2,w2,h2)
  ?Entry2{PROP:Text} = '@s255'
  UNHIDE(?Entry2)

  CREATE(?Ok,CREATE:button)
  SETPOSITION(?Ok,x3,y3,w3,h3)
  ?Ok{PROP:Text} = 'Сохранить'
  UNHIDE(?Ok)

  CREATE(?Cancel,CREATE:button)
  SETPOSITION(?Cancel,x4,y4,w4,h4)
  ?Cancel{PROP:Text} = 'Отменить'
  ?Cancel{PROP:Std} = STD:Close
  UNHIDE(?Cancel)

  ACCEPT
    CASE FIELD()
    OF ?Entry1
         CASE EVENT()
         OF EVENT:Selected
              Message('EVENT:Selected','?Entry1')
         OF EVENT:Accepted
              Message('EVENT:Accepted','?Entry1')
         END
    OF ?Entry2
         CASE EVENT()
         OF EVENT:Selected
              Message('EVENT:Selected','?Entry2')
         OF EVENT:Accepted
              Message('EVENT:Accepted','?Entry2')
         END
    OF ?Ok
         IF EVENT() = EVENT:Accepted
             Message(Contens(?Entry1) &'|'& Contens(?Entry2))
             Break
         END
    END
  END

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

window  WINDOW('Тест'),AT(,,300,150),CENTER,IMM,SYSTEM,GRAY,DOUBLE,AUTO,MDI
  END

  OPEN(Window)

  тут CREATEы всякие и установки PROPов

  loop
    ACCEPT
      loc:field= FIELD()
      loc:event= EVENT()
      BREAK
    END

   CASE loc:event
   OF EVENT:Selected
              Message('EVENT:Selected',loc:field)
   OF EVENT:Accepted
              Message('EVENT:Accepted',loc:field)
   OF EVENT:NewSelection
              Message('EVENT:NewSelection',loc:field)
   END
  end

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

       case upper(clip(keyw2))
       of 'WINDOW'

         open(QWindow)

         destroy(1,5000)
         loop pcounter#=1 to records(WinQ)
           get(WinQ,pcounter#)

           if clip(WQ:Name)='' !новый контрол
             do CreateCTL
           else
             do SetCTLProp
           end
         end
  ..............

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

CreateCTL routine
    case clip(WQ:CTRL)
    of 'WINDOW'
    of 'BUTTON'
      a#=create(WQ:id,create:button,WQ:parent)
    of 'PANEL'
      a#=create(WQ:id,create:panel,WQ:parent)
    of 'IMAGE'
      a#=create(WQ:id,create:image,WQ:parent)
    of 'PROMPT'
      a#=create(WQ:id,create:prompt,WQ:parent)
    of 'GROUP'
      a#=create(WQ:id,create:group,WQ:parent)
    of 'SHEET'
      a#=create(WQ:id,create:sheet,WQ:parent)
    of 'TAB'
      a#=create(WQ:id,create:tab,WQ:parent)
    of 'STRING'
      a#=create(WQ:id,create:sstring,WQ:parent)
    of 'ENTRY'
      a#=create(WQ:id,create:entry,WQ:parent)
    of 'CHECK'
      a#=create(WQ:id,create:check,WQ:parent)
    of 'OPTION'
      a#=create(WQ:id,create:option,WQ:parent)
    of 'RADIO'
      a#=create(WQ:id,create:radio,WQ:parent)
    end
    if clip(WQ:CTRL)<>'STRING'
      WQ:id{Prop:Text}=clip(WQ:prop)
    end
    unhide(WQ:id)

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

SetCTLProp routine
 data
prop STRING(255)
 code

    case upper(left(WQ:Name))
    of 'ACTIVE'
      if clip(WQ:Prop)='' then WQ:Prop='1'.
      WQ:id{PROP:ACTIVE}=clip(WQ:Prop)
    of 'ACCEPTALL'
      if clip(WQ:Prop)='' then WQ:Prop='1'.
      WQ:id{PROP:ACCEPTALL}=clip(WQ:Prop)
    of 'TOUCHED'
      if clip(WQ:Prop)='' then WQ:Prop='1'.
      WQ:id{PROP:TOUCHED}=clip(WQ:Prop)
    of 'TEXT'
      WQ:id{PROP:TEXT}=clip(WQ:Prop)
    of 'FORMAT'
      WQ:id{PROP:FORMAT}=clip(WQ:Prop)
    of 'USE'
      UQ:id=WQ:id
      UQ:Use=clip(WQ:Prop)
      UQ:CTRL=clip(WQ:CTRL)
      add(UseQ,+UQ:Use)
      case upper(clip(WQ:CTRL))
      of 'ENTRY' OROF 'STRING' OROF 'CHECK'
        VAR:id=WQ:id
        get(VarNamesQue,+VAR:id)
        if ~errorcode() then
          WQ:id{PROP:USE}=VarData[VAR:num].VarStr
          WQ:id{PROP:USE,2}=WQ:id
        end
      end

    of 'VALUE'
      case upper(clip(WQ:CTRL))
      of 'RADIO'
        WQ:id{PROP:VALUE}=clip(WQ:Prop)
      OF 'CHECK'
        free(ParamsQ)
        a#=Parse(ParamsQ,clip(WQ:Prop))
        loop pq#=1 to 2
          if ~errorcode() and clip(ParamsQ.VName)<>'' then
            WQ:id{PROP:VALUE,pq#}=clip(ParamsQ.VName)
          end
        end
      end
    of 'AT'
      free(ParamsQ)
      a#=Parse(ParamsQ,clip(WQ:Prop))
      loop pq#=1 to 4
        get(ParamsQ,pq#)
        if ~errorcode() and clip(ParamsQ.VName)<>'' then
          WQ:id{PROP:at,pq#}=clip(ParamsQ.VName)
        end
      end

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

где-то далеко и высоко начинается глобальный цикл...
.......
потом case по выполняемым командам... :
.......
     of 'ACCEPT'
         accept
           loc:keycode=keycode()
           loc:keycode_name=GetNameKeycode(loc:keycode)
           loc:event_num=event()
           loc:field_num=field()
           loc:event_name=GetNameEquate(loc:event_num,'EVENT')
           sort(UseQ,+UQ:id)
           UQ:id=loc:field_num
           get(UseQ,+UQ:id)
           if ~errorcode() then
             loc:field_name=UQ:Use
           else
             loc:field_name=''
           end
           sort(UseQ,+UQ:Use)
           if loc:field_num then ! это тоже след экспериментов -- этот if не нужен
             update(loc:field_num)
           end
           break
         end
..... и так далее ....

где-то там, внизу, case и loop заканчиваются

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

window WINDOW('Test'),AT(,,260,100),FONT('Arial',8,,,CHARSET:CYRILLIC),CENTER,IMM,SYSTEM,GRAY,DOUBLE, |
         AUTO
     END

ctrlque  queue,pre(ctrl)
id         long
type       long
text       string(20)
x          long
y          long
w          long
h          long
         .

  Code

  ctrl:id   = 100
  ctrl:type = create:entry
  ctrl:text = '@n15`2'
  ctrl:x    = 10; ctrl:y = 10; ctrl:w = 50; ctrl:h = 10
  add(ctrlque)

  ctrl:id   = 101
  ctrl:type = create:entry
  ctrl:text = '@n_4'
  ctrl:x    = 70; ctrl:y = 10; ctrl:w = 30; ctrl:h = 10
  add(ctrlque)

  ctrl:id   = 102
  ctrl:type = create:button
  ctrl:text = 'button1'
  ctrl:x    = 10; ctrl:y = 50; ctrl:w = 60; ctrl:h = 14
  add(ctrlque)

  ctrl:id   = 103
  ctrl:type = create:button
  ctrl:text = 'button2'
  ctrl:x    = 100; ctrl:y = 50; ctrl:w = 60; ctrl:h = 14
  add(ctrlque)

  open(window)
  sort(ctrlque,+ctrl:id)
  loop ndx# = 1 to records(ctrlque)
    get(ctrlque,ndx#)
    create(ctrl:id,ctrl:type)
    ctrl:id{prop:text} = ctrl:text
    setposition(ctrl:id,ctrl:x,ctrl:y,ctrl:w,ctrl:h)
    unhide(ctrl:id)
  .

  loop
    event# = 0; field# = 0
    accept
      event# = event()
      field# = field()
      break
    .
    if (event# = event:closewindow) or (event# = event:closedown) then break.
    if event# and field#
       ctrl:id = field#; get(ctrlque,+ctrl:id)
       case event#
       of event:selected
       of event:accepted
          if field# = 103 then break.
  . .  .