Приложение C. Динамические свойства Clarion

PROGRAM

MAP

AssertMy1 PROCEDURE(STRING filename,UNSIGNED LineNumber)

AssertMy2 PROCEDURE(UNSIGNED LineNumber, STRING filename, STRING message)

END

PRAGMA('define(zero_divide => on'))

CODE

SYSTEM{prop:asserthook} = ADDRESS(AssertMy1)

SYSTEM{prop:asserthook2} = ADDRESS(AssertMy2)

assert(0)

assert(0,'i am a message')

AssertMy1 PROCEDURE(STRING filename,UNSIGNED LineNumber)

CODE

AssertMy2(LineNumber, FileName,'')

AssertMy2 PROCEDURE(UNSIGNED LineNumber, STRING filename, STRING message)

l long

CODE

SYSTEM{prop:asserthook2} = 0 !остановить рекурсивные вызовы в обработчик assert

IF MESSAGE('Assert 1|filename=' & CLIP(filename) & '|line=' & LineNumber & |

'|Message=' & CLIP(message) & '|Do you want me to GPF?',|

'ASSERT', ICON:Exclamation, BUTTON:Yes + BUTTON:No)

l = l / l ! деление на 0 - причина GPF

END

PROGRAM

CODE

OPEN(AppFrame)

ACCEPT

END

Report REPORT,AT(1000,2000,6000,7000),PRE(RPT),FONT('Arial',10,,FONT:regular),THOUS

Break1 BREAK(ORD:CustNumber),USE(?Break1)

Break2 BREAK(DTL:OrderNumber),USE(?Break2)

HEADER,AT(,,,2167)

END

detail DETAIL,AT(,,,385)

END

FOOTER,PAGEAFTER(-1)

END

END

FOOTER,PAGEAFTER(-1),AT(,,,1385)

END

END

FOOTER,AT(1000,9000,6000,1000)

END

END

CODE

OPEN(Report)

WinView WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

END

CODE

OPEN(WinView)

WinView{PROP:Buffer} = 1 !Постоянное обновление буфера для окна

WinView WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

CHECK('Check Me'),AT(20,0,20,20),USE(CheckVar)

END

CODE

OPEN(WinView)

IF ?CheckVar{PROP:Checked} = TRUE !Выставлен ли флажок?

END

ACCEPT

END

WinView WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

OPTION('Option 1'),USE(OptVar1),KEY(F10Key),HLP('Option1Help')

RADIO('Radio 1'),AT(0,0,20,20),USE(?R1)

RADIO('Radio 2'),AT(20,0,20,20),USE(?R2)

END

END

CODE

OPEN(WinView)

LOOP X# = 1 TO 99

Y# = ?OptVar1{PROP:Child,X#} !Получить номерам полей в OPTION

IF NOT Y# THEN BREAK.

Z# = ?OptVar1{PROP:ChildIndex,Y#} !Получить порядковую позиции полей в OPTION

MESSAGE('Radio ' & Z# & ' is field number ' & Y#)

END

ACCEPT

END

!Пример использования с обектом SHEET

SHEET,AT(5,177,133,123),USE(?Sheet1)

TAB('Tab Alpha'),USE(?TabAlpha)

END

TAB('Tab Bravo'),USE(?TabBravo)

END

TAB('Tab Charlie'),USE(?TabCharlie)

END

END

?Sheet1{PROP:Child,Nth}

!возвращает соответствие поля в N-м листе структуры SHEET.

TabFeq = ?Sheet1{PROP:Child,2}

!эквивалентно

TabFeq=?TabBravo

SELECT(?TabBravo)

!эквивалентно

SELECT(?Sheet1{PROP:Child,2})

?Sheet1{PROP:Child,CHOICE(?Sheet1)}

!эквивалентно

?Sheet1{PROP:ChoiceFEQ}

!получить метку соответствия последнего листа:

LastFEQ = ?Sheet1{PROP:Child,(?Sheet1{Prop:NumTabs})}

!получить метку соответствия первого листа

?Sheet1{Prop:Child, 1 }

!Существует ли не скрыт ли следующий лист в структуре sheet?

IF CHOICE(?Sheet1) < ?Sheet1{Prop:NumTabs} AND

(?Sheet1{PROP:Child,CHOICE(?Sheet1)+1}){PROP:Hide} <> TRUE

WinView WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

OPTION('Option 1'),USE(OptVar1),KEY(F10Key),HLP('Option1Help')

RADIO('Radio 1'),AT(0,0,20,20),USE(?R1)

RADIO('Radio 2'),AT(20,0,20,20),USE(?R2)

END

END

CODE

OPEN(WinView)

?OptVar1{PROP:ChoiceFeq} = ?R1 !Выбрать первую кнопку

ACCEPT

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

END

MessageText CSTRING('You cannot exit the program from this window ')

MessageCaption CSTRING('No EVENT:CloseDown Allowed ')

TextAddr LONG

CaptionAddr LONG

RetVal SHORT

CODE

OPEN(WinView)

ACCEPT

CASE EVENT()

OF EVENT:CloseDown

TextAddr = ADDRESS(MessageText)

CaptionAddr = ADDRESS(MessageCaption)

RetVal = MessageBox(WinView{PROP:ClientHandle},TextAddr,CaptionAddr,MB_OK)

END

END

PROGRAM

MAP

Main

SubClassFunc(UNSIGNED hWnd,SIGNED wMsg,UNSIGNED wParam,LONG lParam),LONG,PASCAL

CallWindowProc(LONG,UNSIGNED,SIGNED,UNSIGNED,LONG),LONG,PASCAL,NAME('CallWindowProcA')

END

END

SavedProc LONG

PT GROUP,PRE(PT)

X SHORT

Y SHORT

END

CODE

Main

Main PROCEDURE

WinView WINDOW('View'),AT(0,0,320,200),HVSCROLL,MAX,TIMER(1)

STRING('X Pos'),AT(1,1,,),USE(?String1)

STRING(@n3),AT(24,1,,),USE(PT:X)

STRING('Y Pos'),AT(44,1,,),USE(?String2)

STRING(@n3),AT(68,1,,),USE(PT:Y)

BUTTON('Close'),AT(240,180,60,20),USE(?Close)

END

CODE

OPEN(WinView)

ACCEPT

CASE ACCEPTED()

OF ?Close

BREAK

END

END

CASE wMsg

OF WM_MOUSEMOVE

PT:X = MOUSEX()

PT:Y = MOUSEY()

END

RETURN(CallWindowProc(SavedProc,hWnd,wMsg,wParam,lParam))

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

IMAGE(),AT(0,0,,),USE(?Image)

BUTTON('Save Picture'),AT(80,180,60,20),USE(?SavePic)

BUTTON('New Picture'),AT(160,180,60,20),USE(?NewPic)

END

CODE

OPEN(WinView)

DISABLE(?LastPic)

IF NOT FILEDIALOG('Choose File to View',FileName,'BitMap|*.BMP|PCX|*.PCX',0)

END

?Image{PROP:Text} = FileName

ACCEPT

CASE ACCEPTED()

OF ?NewPic

IF NOT FILEDIALOG('Choose File to View',FileName,'BitMap|*.BMP|PCX|*.PCX',0)

END

?Image{PROP:Text} = FileName

OF ?SavePic

END

END

Синтаксис:

color = SYSTEM {PROP:CustomColor, n}

SYSTEM {PROP:CustomColor, n} = color

DDERetVal STRING(20)

WinOne WINDOW,AT(0,0,160,400)

ENTRY(@s20),USE(DDERetVal)

END

MyServer LONG

CODE

OPEN(WinOne)

ACCEPT

END

DDERetVal STRING(20)

WinOne WINDOW,AT(0,0,160,400)

ENTRY(@s20),USE(DDERetVal)

END

MyServer LONG

CODE

OPEN(WinOne)

ACCEPT

CASE EVENT()

DDEWRITE(MyServer,DDE:manual,'DataEntered',DDERetVal)

END

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

IMAGE(),AT(0,0,,),USE(?Image)

BUTTON('New Picture'),AT(160,180,60,20),USE(?NewPic)

BUTTON('Close'),AT(80,180,60,20),USE(?Close)

END

ImageWidth SHORT

ImageHeight SHORT

CODE

OPEN(WinView)

DISABLE(?LastPic)

IF NOT FILEDIALOG('Choose File to View',FileName,'BitMap|*.BMP|PCX|*.PCX',0)

END

?Image{PROP:Text} = FileName

ACCEPT

CASE ACCEPTED()

OF ?NewPic

IF NOT FILEDIALOG('Choose File to View',FileName,'BitMap|*.BMP|PCX|*.PCX',0)

END

?Image{PROP:Text} = FileName

ImageHeight = ?Image{PROP:Height} !2 перемещения

IF ImageWidth > 320

?Image{PROP:Width} = 320

?Image{PROP:XPos} = 0

ELSE

?Image{PROP:XPos} = (320 - ImageWidth) / 2 !Центрировать по горизонтали

END

IF ImageHeight > 180

?Image{PROP:Height} = 180

?Image{PROP:YPos} = 0

ELSE

END

OF ?Close

BREAK

END

Q QUEUE

f1 STRING(15)

f2 STRING(15)

END

Win1 WINDOW('List Edit In Place'),AT(0,1,308,172),SYSTEM

LIST,AT(6,6,120,90),USE(?List),COLUMN,FORMAT('60L@s15@60L@s15@'), |

FROM(Q),ALRT(EnterKey)

END

?EditEntry EQUATE(100)

CODE

OPEN(Win1)

CREATE(?EditEntry,CREATE:Entry)

SELECT(?List,1)

ACCEPT

CASE FIELD()

OF ?List

CASE EVENT()

OF EVENT:AlertKey

IF KEYCODE() = EnterKey

SETKEYCODE(MouseLeft2)

POST(EVENT:Accepted,?List)

END

OF EVENT:NewSelection

IF ?List{PROP:edit,?List{PROP:column}}

GET(Q,CHOICE())

END

OF EVENT:Accepted

IF KEYCODE() = MouseLeft2

GET(Q,CHOICE())

?EditEntry{PROP:text} = ?List{PROPLIST:picture,?List{PROP:column}}

CASE ?List{PROP:column}

OF 1

?EditEntry{PROP:use} = Q.F1

OF 2

?EditEntry{PROP:use} = Q.F2

END

?List{PROP:edit,?List{PROP:column}} = ?EditEntry

. .

OF ?EditEntry

CASE EVENT()

OF EVENT:Selected

?EditEntry{PROP:Touched} = 1

OF EVENT:Accepted

PUT(Q)

?List{PROP:edit,?List{PROP:column}} = 0

. . .

MDIChild WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

SHEET,AT(0,0,320,175),USE(SelectedTab)

TAB('Tab One'),USE(?TabOne)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P1)

ENTRY(@S8),AT(100,140,32,20),USE(E1)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P2)

ENTRY(@S8),AT(100,240,32,20),USE(E2)

END

TAB('Tab Two'),USE(?TabTwo)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P3)

ENTRY(@S8),AT(100,140,32,20),USE(E3)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P4)

ENTRY(@S8),AT(100,240,32,20),USE(E4)

END

END

BUTTON('Ok'),AT(100,180,20,20),USE(?Ok)

BUTTON('Cancel'),AT(200,180,20,20),USE(?Cancel)

END

CODE

OPEN(MDIChild)

ACCEPT

CASE EVENT()

OF EVENT:Completed

BREAK

END

CASE FIELD()

OF ?Ok

CASE EVENT()

OF EVENT:Accepted

SELECT

END

OF ?E3

CASE EVENT()

OF EVENT:Accepted

IF ?E3{PROP:Enabled} AND MDIChild{PROP:AcceptAll}

END

END

OF ?Cancel

CASE EVENT()

OF EVENT:Accepted

BREAK

END

END

END

END

MESSAGE('Compiled in CW release ' & SYSTEM{PROP:ExeVersion})

MAP

PageNum (LONG), LONG

END

CODE

OPEN (Report)

!Report processing code here

Report{PROP:FlushPageNumFunc} = ADDRESS(PageNum)

Report{PROP:FlushPreview} = TRUE

Report{PROP:FlushPageNumFunc} = 0

PageNum PROCEDURE (LONG LastPage)

CODE

IF LastPage = 0

RETURN 1

ELSE

RETURN LastPage + 2 ! Печать только нечетных страниц

END

SomeReport PROCEDURE

STRING(64)

END

DetailOne DETAIL

!Report controls

END

END

ViewReport WINDOW('View Report'),AT(0,0,320,200),MDI,MAX,HVSCROLL

IMAGE(),AT(0,0,320,180),USE(?ImageField)

BUTTON('View Next Page'),AT(0,180,60,20),USE(?NextPage),DEFAULT

BUTTON('Print Report'),AT(80,180,60,20),USE(?PrintReport)

BUTTON('Exit Without Printing'),AT(160,180,60,20),USE(?ExitReport)

END

CODE

OPEN(Report)

LOOP

NEXT(SomeFile)

IF ERRORCODE() THEN BREAK.

PRINT(DetailOne)

END

ENDPAGE(Report)

GET(WMFQue,NextEntry) !Получить первый элемент очереди

ACCEPT

CASE ACCEPTED()

OF ?NextPage

CYCLE

END

OF ?PrintReport

OF ?ExitReport

END

END

CLOSE(Report)

CLOSE(Window)

! удалив временные метафайлы

WinView WINDOW('View Report'),AT(0,0,320,200),MDI,MAX,HVSCROLL

BUTTON('View Next Page'),AT(0,180,60,20),USE(?NextPage),DEFAULT

BUTTON('Print Report'),AT(80,180,60,20),USE(?PrintReport)

BUTTON('Exit Without Printing'),AT(160,180,60,20),USE(?ExitReport)

END

CODE

OPEN(WinView)

?PrintReport{PROP:Follows} = ?ExitReport

ACCEPT

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

END

MessageText CSTRING('You cannot exit the program from this window ')

MessageCaption CSTRING('No EVENT:CloseDown Allowed ')

TextAddress LONG

CaptionAddress LONG

RetVal SHORT

CODE

OPEN(WinView)

ACCEPT

CASE EVENT()

OF EVENT:CloseDown

TextAddress = ADDRESS(MessageText)

CaptionAddress = ADDRESS(MessageCaption)

RetVal = MessageBox(WinView{PROP:Handle},TextAddress,CaptionAddress,MB_OK)

END

END

MDIChild WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

LIST,AT(0,0,220,220),USE(?L1),FROM(Que),IMM,FORMAT('60L~Header Text~')

END

CODE

OPEN(MDIChild)

Que QUEUE

F1 STRING(50)

F2 STRING(50)

F3 STRING(50)

END

WinView WINDOW('View'),AT(,,340,200),SYSTEM,CENTER

LIST,AT(20,0,300,200),USE(?List),FROM(Que),IMM,HVSCROLL |

FORMAT('80L#1#80L#2#80L#3#')

END

CODE

OPEN(WinView)

DO BuildListQue

ACCEPT

CASE FIELD()

OF ?List

CASE EVENT()

OF EVENT:ScrollDrag

CASE (?List{PROP:HscrollPos} % 200) + 1

OF 1

?List{PROP:Format} = '80L#1#80L#2#80L#3#'

OF 2

?List{PROP:Format} = '80L#2#80L#3#80L#1#'

OF 3

?List{PROP:Format} = '80L#3#80L#1#80L#2#'

END

DISPLAY

. . .

FREE(Que)

BuildListQue ROUTINE

LOOP 15 TIMES

Que.F1 = 'F1F1F1F1'

Que.F2 = 'F2F2F2F2'

Que.F3 = 'F3F3F3F3'

ADD(Que)

END

PROGRAM

MAP

RandomAlphaData PROCEDURE(*STRING Field)

END

FName STRING(20)

LName STRING(20)

Init STRING(4)

END

Win WINDOW('List Box'),AT(0,0,374,314),FONT('Tahoma',8,,FONT:regular,CHARSET:ANSI),|

SYSTEM,GRAY,DOUBLE

LIST,AT(3,4,369,306),USE(?Show),HVSCROLL,COLOR(,COLOR:Black,0E7E7E7H),|

FORMAT('121L(2)|M*IT~First Name~149L(2)|M~Last Name~16C(2)|M~Initials~'), |

FROM(TreeDemo),GRID(0E7E7E7H)

END

x long

CODE

LOOP x = 1 to 20

RandomAlphaData(FName)

ColorNBG = 0F0FFFFH

ColorSFG = COLOR:White

ColorSBG = COLOR:Silver

RandomAlphaData(LName)

RandomAlphaData(Init)

ADD(TreeDemo)

END

OPEN(Win)

?Show{prop:lineheight} = 10

?Show{PROP:iconlist,1} = ICON:VCRback !Icon 1 = <

?Show{PROP:iconlist,2} = ICON:VCRrewind !Icon 2 = <<

?Show{PROP:iconlist,4} = '~VCRnext.ico' !Icon 4 = >>связана с проектом

ACCEPT

END

RandomAlphaData PROCEDURE(*STRING Field)

CODE

y# = RANDOM(1,SIZE(Field)) !Произвольный размер

Field[x#] = CHR(RANDOM(97,122)) !случайной буквой с нижним регистром

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

IMAGE(),AT(0,0,,),USE(?Image)

BUTTON('Save Picture'),AT(80,180,60,20),USE(?SavePic)

BUTTON('New Picture'),AT(160,180,60,20),USE(?NewPic)

BUTTON('Last Picture'),AT(240,180,60,20),USE(?LastPic)

END

MyMemo MEMO(65520),BINARY

Rec RECORD

F1 LONG

. .

CODE

OPEN(SomeFile)

OPEN(WinView)

DISABLE(?LastPic)

IF NOT FILEDIALOG('Choose File to View',FileName,'BitMap|*.BMP|PCX|*.PCX',0)

END

?Image{PROP:Text} = FileName

ACCEPT

CASE ACCEPTED()

OF ?NewPic

IF NOT FILEDIALOG('Choose File to View',FileName,'BitMap|*.BMP|PCX|*.PCX',0)

END

?Image{PROP:Text} = FileName

OF ?SavePic

OF ?LastPic

END

END

WinView WINDOW('View'),AT(0,0,,),MDI,MAX,HVSCROLL,SYSTEM,RESIZE

TOOLBAR

BUTTON('Save Picture'),AT(80,180,60,20),USE(?SavePic)

END

LIST,AT(6,6,120,90),USE(?List),FORMAT('120L'),FROM(Q),IMM

END

CODE

OPEN(WinView)

IF ?SavePic{PROP:InToolbar} = TRUE

!DO Something

END

ACCEPT

END

Синтаксис:

Пример:

myfile{PROP:IPRequestCount} = 20 ! создать пакет с 20-ю запросами

NEXT(myfile) ! отправить пакет серверу с 20-ю операторами NEXT

nRecNum = myfile{PROP:IPRequestCount} ! получить число записей в пакете MRP

Que QUEUE

STRING(30)

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL,SYSTEM

LIST,AT(6,6,120,90),USE(?List),FORMAT('120L'),FROM(Q),IMM

END

CODE

OPEN(WinView)

SET(SomeFile)

NEXT(SomeFile)

Que = Fil:Record

ADD(Que)

END

ACCEPT

END

WinView APPLICATION('MyApp'),AT(0,0,320,200),MAX,HVSCROLL,SYSTEM

END

CODE

OPEN(WinView)

ACCEPT

END

ЗАМЕЧАНИЕ: Это свойство не поддерживается этим релизом.

IF SYSTEM{PROP:LFNSupport} = TRUE

MESSAGE('Long Filenames are supported')

ELSE

MESSAGE('Long Filenames are NOT supported')

END

MESSAGE('Runtime DLL from release ' & SYSTEM{PROP:LibVersion})

LineCount SHORT

MemoLine STRING(80)

CustRpt REPORT,AT(1000,1000,6500,9000),THOUS

Detail1 DETAIL,AT(0,0,6500,6000)

TEXT,AT(0,0,6500,6000),USE(Fil:MemoField)

END

Detail2 DETAIL,AT(0,0,6500,125)

STRING(@s80),AT(0,0,6500,125),USE(MemoLine)

END

END

CODE

OPEN(File)

SET(File)

OPEN(CustRpt)

LOOP

NEXT(File)

LineCount = CustRpt$?Fil:MemoField{PROP:LineCount}

LOOP X# = 1 TO LineCount

MemoLine = CustRpt$?Fil:MemoField{PROP:Line,X#}

PRINT(Detail2)

END

END

MDIChild WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

LIST,AT(0,0,220,220),USE(?L1),FROM(Que),IMM

END

CODE

OPEN(MDIChild)

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL,SYSTEM,RESIZE,|

LIST,AT(6,6,120,90),USE(?List),FORMAT('120L'),FROM(Q),IMM

END

CODE

OPEN(WinView)

WinView{PROP:MaxHeight} = 200 !Установить границы за пределы которых пользователь

WinView{PROP:MaxWidth} = 320 ! не может раздвинуть окно

WinView{PROP:MinHeight} = 90

WinView{PROP:MinWidth} = 120

ACCEPT

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL,SYSTEM,RESIZE,|

LIST,AT(6,6,120,90),USE(?List),FORMAT('120L'),FROM(Q),IMM

END

CODE

OPEN(WinView)

WinView{PROP:MaxHeight} = 200 !Установить границы за пределы которых пользователь

WinView{PROP:MaxWidth} = 320 ! не может раздвинуть окно

WinView{PROP:MinHeight} = 90

WinView{PROP:MinWidth} = 120

ACCEPT

END

MenubarFEQ = MyWindowLabel{PROP:Menubar} !получить метку соответствия меню

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL,SYSTEM,RESIZE,|

LIST,AT(6,6,120,90),USE(?List),FORMAT('120L'),FROM(Q),IMM

END

CODE

OPEN(WinView)

WinView{PROP:MaxWidth} = 320 ! не может раздвинуть окно

WinView{PROP:MinHeight} = 90

WinView{PROP:MinWidth} = 120

ACCEPT

END

CODE

OPEN(WinView)

WinView{PROP:MaxHeight} = 200 !Установить границы за пределы которых пользователь

WinView{PROP:MaxWidth} = 320 ! не может раздвинуть окно

WinView{PROP:MinHeight} = 90

WinView{PROP:MinWidth} = 120

ACCEPT

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

IMAGE(),AT(0,0,,),USE(?Image)

BUTTON('Save Picture'),AT(80,180,60,20),USE(?SavePic)

BUTTON('New Picture'),AT(160,180,60,20),USE(?NewPic)

BUTTON('Last Picture'),AT(240,180,60,20),USE(?LastPic)

END

ThisField SHORT(0)

CODE

OPEN(WinView)

LOOP

ThisField = WinView{PROP:NextField,ThisField} !Обработка каждого поля

IF ThisField

ThisField{PROP:FontSize} = 10

ELSE

BREAK !Прервать по окончании

. .

ACCEPT

END

CustRpt REPORT,AT(1000,1000,6500,9000),THOUS

HEADER

STRING(@n3),USE(?Page),PAGENO

END

Detail DETAIL,AT(0,0,6500,1000)

STRING,AT(10,10),USE(Fil:Field)

END

END

CODE

OPEN(File)

SET(File)

OPEN(CustRpt)

LOOP

NEXT(File)

END

PRINT(Detail)

END

CLOSE(CustRpt)

CLOSE(File)

Пример:

NextControlFEQ = window{PROP:NextTabStop} !получить следующее поле

PrevControlFEQ = window{PROP:PrevTabStop} !получить предыдущее поле

Window{PROP:NextTabStop} = ?List !Установить следующее поле

?Button {PROP:Icon} = 'Animated.GIF'

?Button {PROP:NoFrame} = TRUE

WinView WINDOW('View'),AT(0,0,,),MDI,MAX,HVSCROLL,SYSTEM,RESIZE

LIST,AT(6,6,120,90),USE(?List),FORMAT('120L'),FROM(Q),IMM

END

CODE

OPEN(WinView)

IF WinView{PROP:NoHeight} = TRUE

WinView{PROP:Height} = 200 !Установить высоту

END

IF WinView{PROP:NoWidth} = TRUE

WinView{PROP:Width} = 320 !Установить ширину

END

ACCEPT

END

WinView APPLICATION('MyApp'),AT(0,0,320,200),MAX,HVSCROLL,SYSTEM

END

CODE

OPEN(WinView)

ACCEPT

END

MDIChild WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

SHEET,AT(0,0,320,175),USE(SelectedTab)

TAB('Tab One'),USE(?TabOne)

OPTION('Option 1'),USE(OptVar1),KEY(F10Key),HLP('Option1Help')

RADIO('Radio 1'),AT(20,0,20,20),USE(?R1)

RADIO('Radio 2'),AT(40,0,20,20),USE(?R2)

END

OPTION('Option 2'),USE(OptVar2),MSG('Option 2')

RADIO('Radio 3'),AT(60,0,20,20),USE(?R3)

RADIO('Radio 4'),AT(80,0,20,20),USE(?R4)

END

END

TAB('Tab Two'),USE(?TabTwo)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P1)

ENTRY(@S8),AT(100,140,32,20),USE(E1)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P2)

ENTRY(@S8),AT(100,240,32,20),USE(E2)

END

TAB('Tab Three'),USE(?TabThree)

OPTION('Option 3'),USE(OptVar3)

RADIO('Radio 1'),AT(20,0,20,20),USE(?R5)

RADIO('Radio 2'),AT(40,0,20,20),USE(?R6)

END

OPTION('Option 4'),USE(OptVar4)

RADIO('Radio 3'),AT(60,0,20,20),USE(?R7)

RADIO('Radio 4'),AT(80,0,20,20),USE(?R8)

END

END

TAB('Tab Four'),USE(?TabFour)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P3)

ENTRY(@S8),AT(100,140,32,20),USE(E3)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P4)

ENTRY(@S8),AT(100,240,32,20),USE(E4)

END

END

BUTTON('Ok'),AT(100,180,20,20),USE(?Ok)

BUTTON('Cancel'),AT(200,180,20,20),USE(?Cancel)

END

CODE

OPEN(MDIChild)

MESSAGE('Number of TABs: ' & ?SelectedTab{PROP:NumTabs})

MESSAGE('Number of rows of TABs: ' & ?SelectedTab{PROP:TabRows})

ACCEPT

END

WinView WINDOW('MyApp'),AT(0,0,320,200),MAX,HVSCROLL,SYSTEM

END

OptionSelected STRING(6)

CODE

OPEN(WinView)

?OptionControl{PROP:use} = OptionSelected

?OptionControl{PROP:Text} = 'Pick one'

?OptionControl{PROP:Boxed} = TRUE

SETPOSITION(?OptionControl,10,10)

?Radio1{PROP:Text} = 'First'

SETPOSITION(?Radio1,12,20)

CREATE(?Radio2,CREATE:radio,?Radio1{PROP:Parent})

?Radio2{PROP:Text} = 'Second'

SETPOSITION(?Radio2,12,30)

ACCEPT

END

!-----------------------------------------------------------------------

WinParent WINDOW('Caption'),AT(0,0,320,200),SYSTEM,GRAY,MDI

SHEET,AT(x,x,x,x), USE(?Sheet)

TAB('Tab 1'), USE(?Tab1)

PROMPT('Prompt1:'), AT(x,x,x,x), USE(?Prompt1)

ENTRY(@s20), AT(x,x,x,x), USE(Loc.Var)

END

END

BUTTON('Close'),AT(x,x,x,x), USE(?Close)

END

! ?Sheet{Prop:Parent} Принадлежит WinParent

! ?Prompt1{Prop:Parent} Принадлежит ?Tab1

! ?Loc:Var{Prop:Parent} Принадлежит ?Tab1

! ?Close{Prop:Parent} Принадлежит WinParent

WinView WINDOW('MyApp'),AT(0,0,320,200),MAX,HVSCROLL,SYSTEM

END

CODE

OPEN(WinView)

ACCEPT

!все свойства и функции позиционирования теперь возвращают пиксели

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

IMAGE(),AT(0,0,,),USE(?Image)

BUTTON('Save Picture'),AT(80,180,60,20),USE(?SavePic)

BUTTON('New Picture'),AT(160,180,60,20),USE(?NewPic)

BUTTON('Last Picture'),AT(240,180,60,20),USE(?LastPic)

END

SomeFile FILE,DRIVER('TopSpeed'),PRE(Fil) !Файл с полем memo

MyBlob BLOB,BINARY

Rec RECORD

F1 LONG

. .

CODE

OPEN(SomeFile); OPEN(WinView)

DISABLE(?LastPic)

IF NOT FILEDIALOG('File to View',FileName,'Images|*.BMP;*.PCX;*.JPG;*.WMF',0)

RETURN !Завершить если файл не найден

END

?Image{PROP:Text} = FileName

ACCEPT

CASE ACCEPTED()

OF ?NewPic

IF NOT FILEDIALOG('File to View',FileName,'Images|*.BMP;*.PCX;*.JPG;*.WMF',0)

BREAK

END

?Image{PROP:Text} = FileName

OF ?SavePic

Fil:MyBlob{PROP:Handle} = ?Image{PROP:ImageBlob} !Поместить изображение в BLOB

ADD(SomeFile) ! и сохранить в файл на диске

ENABLE(?LastPic) ! активировать кнопку Last Picture

OF ?LastPic

?Image{PROP:ImageBlob} = Fil:MyBlob{PROP:Handle} !Записать последний сохраненный BLOB в файл

END

END

Win WINDOW('Batch Processing...'),AT(,,400,400),TIMER(1),MDI,CENTER

PROGRESS,AT(100,140,200,20),USE(?ProgressBar),RANGE(0,200)

BUTTON('Cancel'),AT(190,300,20,20),STD(STD:Close)

END

CODE

OPEN(Win)

OPEN(File)

?ProgressBar{PROP:rangehigh} = RECORDS(File)

ACCEPT

CASE EVENT()

OF EVENT:CloseWindow

BREAK

LOOP 3 TIMES

NEXT(File)

IF ERRORCODE() THEN BREAK.

?ProgressBar{PROP:progress} = ?ProgressBar{PROP:progress} + 1

. . .

CLOSE(File)

MDIChild WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P1)

ENTRY(@N8),AT(100,140,32,20),USE(E1)

BUTTON('Ok'),AT(100,180,20,20),USE(?Ok)

BUTTON('Cancel'),AT(200,180,20,20),USE(?Cancel)

END

CODE

OPEN(MDIChild)

ACCEPT

CASE EVENT()

OF EVENT:Completed

BREAK

END

CASE FIELD()

OF ?Ok

CASE EVENT()

OF EVENT:Accepted

SELECT

END

OF ?E1

CASE EVENT()

OF EVENT:Accepted

END

END

OF ?Cancel

CASE EVENT()

OF EVENT:Accepted

BREAK

END

END

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

SPIN(@n3),AT(0,0,320,180),USE(Fil:Field),RANGE(0,255)

END

CODE

OPEN(WinView)

ACCEPT

CASE FIELD()

OF ?Fil:Field

CASE EVENT()

OF EVENT:Rejected

MESSAGE(?Fil:Field{PROP:ScreenText} & ' is not in the range 0-255')

SELECT(?)

CYCLE

END

END

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

ENTRY(@S30),AT(0,0,320,180),USE(Fil:Field),ALRT(F10Key)

LIST,AT(6,6,120,90),USE(?List),FORMAT('120L'),FROM(Q),IMM

END

CODE

OPEN(WinView)

ACCEPT

CASE ACCEPTED()

OF ?List

OF ?Fil:Field

SETCLIPBOARD(Fil:Field[?Fil:Field{PROP:SelStart} : ?Fil:Field{PROP:SelEnd}])

!Поместить выделенную строку в буфер обмена Windows

END

END

!Пример использующий объект COMBO в конфигурации EIP

OF EVENT:NewSelection ! Если событие является новым выбором

! и это ключ который нам нужен...

IF KEYCODE() <> UpKey AND KEYCODE() <> DownKey AND |

KEYCODE() <> PgDnKey AND KEYCODE() <> PgUpKey

UPDATE(SELF.FEQ)

Loc:Offset = SELF.FEQ{PROP:SelStart} - 1 ! вычислить где находится курсор

!в пункте поля

! Поместить введенный код в локальную переменную:

Loc:ItemCode = SUB(ItemList.Q.SON:ItemCode,1,Loc:Offset)

! Цикл по всем пунктам очереди:

LOOP Loc:LqRecordCount = 1 to RECORDS(LQ:Queue)

GET(LQ:Queue, Loc:LqRecordCount)

IF LEFT(LQ:ItemCode,LEN(CLIP(Loc:ItemCode))) = CLIP(Loc:ItemCode)

IF Loc:LqRecordCount > 1

Loc:LQ:Position = Loc:LqRecordCount - 1 ! Нужная запись находится

! перед той где мы находимся.

ELSE

Loc:LQ:Position = 1 ! В противном случае она первая..

END

END

! Position to the LIST COMBO control:

(SELF:FEQ{PROP:ListFeq}){PROP:Selected}=Loc:LQ:Position

CHANGE(SELF.FEQ, LQ:ItemCode) ! Изменить очередь чтобы отобразить ее

BREAK

END

END

END

Names FILE,DRIVER('TopSpeed')

NbrKey KEY(Names:Number)

Rec RECORD

Name STRING(20)

Number SHORT

END

END

BlobSize LONG

WinView WINDOW('View BLOB Contents'),AT(0,0,320,200),SYSTEM

TEXT,AT(0,0,320,180),USE(BlobBuffer1),VSCROLL

TEXT,AT(0,190,320,180),USE(BlobBuffer2),VSCROLL,HIDE

END

CODE

OPEN(Names)

SET(Names)

NEXT(Names)

OPEN(WinView)

IF BlobSize > 65520

BlobBuffer1 = Names.Notes[0 : 65519]

BlobBuffer2 = Names.Notes[65520 : BlobSize - 1]

WinView{PROP:Height} = 400

UNHIDE(?BlobBuffer2)

ELSE

BlobBuffer1 = Names.Notes[0 : BlobSize - 1]

END

ACCEPT

END

PROGRAM

MAP

main

p1(STRING)

END

CODE

main

main PROCEDURE

window APPLICATION('SnapWidth & SnapHeight'),AT(,,262,243),STATUS,MAX,RESIZE

END

CODE

OPEN(window)

window{PROP:StatusText} = 'Drag the toolbar to any edge'

ACCEPT

IF EVENT()=Event:OpenWindow

START(p1,,system{PROP:target})

END

END

p1 PROCEDURE(w)

win &WINDOW

width SIGNED

height SIGNED

window WINDOW,AT(50,50,100,20),SYSTEM,TOOLBOX,GRAY,RESIZE,MDI,IMM

BUTTON,AT(80,2,15,15),USE(?Button4),ICON(ICON:Cut),FLAT

BUTTON,AT(31,2,15,15),USE(?Button2),ICON(ICON:Copy),FLAT

BUTTON,AT(55,2,15,15),USE(?Button3),ICON(ICON:Paste),FLAT

END

!**************************************************

! примере, когда toolbox прижато влево или вправо, оно принимает размер по Высоте

!**************************************************

CODE

win &= (w)

OPEN(window, win)

WINDOW{PROP:docked} = Dock:Float

window{PROP:dock} = DOCK:ALL

window{PROP:snapwidth, 1} = 20 ! Вертикальный размер, т.е., когда становиться высоким

window{PROP:snapheight, 1} = 150

window{PROP:snapwidth, 2} = 100 ! Горизонтальный размер, т.е., когда становиться широким

window{PROP:snapheight, 2} = 20

window{PROP:snapwidth, 3} = 50 ! квадрат

window{PROP:snapheight, 3} = 50

ACCEPT

IF EVENT() = EVENT:sized

! здесь ручное репозиционирование кнопок

IF window{PROP:Width} = 20 ! это высокое?

?Button4{PROP:xpos} = 2

?Button4{PROP:ypos} = 53

?Button2{PROP:xpos} = 2

?Button2{PROP:ypos} = 19

?Button3{PROP:xpos} = 2

?Button3{PROP:ypos} = 36

ELSIF window{PROP:Width} = 100 ! это широкое?

?Button4{PROP:xpos} = 70

?Button4{PROP:ypos} = 2

?Button2{PROP:xpos} = 50

?Button2{PROP:ypos} = 2

?Button3{PROP:xpos} = 30

?Button3{PROP:ypos} = 2

ELSE !должно быть квадратным

?Button4{PROP:xpos} = 27

?Button4{PROP:ypos} = 27

?Button2{PROP:xpos} = 27

?Button2{PROP:ypos} = 10

?Button3{PROP:xpos} = 5

?Button3{PROP:ypos} = 27

END

END

END

! Шрифт Tahoma установлен как шрифт по умолчанию для линейки статуса

SYSTEM{PROP:FontName + PROP:StatusFont} = 'Tahoma'

! Когда это окно активно, для линейки статуса используется Tahoma 10

Window{PROP:FontSize + PROP:StatusFont} = 10

MDIChild WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

SHEET,AT(0,0,320,175),USE(SelectedTab)

TAB('Tab One'),USE(?TabOne)

OPTION('Option 1'),USE(OptVar1),KEY(F10Key),HLP('Option1Help')

RADIO('Radio 1'),AT(20,0,20,20),USE(?R1)

RADIO('Radio 2'),AT(40,0,20,20),USE(?R2)

END

OPTION('Option 2'),USE(OptVar2),MSG('Option 2')

RADIO('Radio 3'),AT(60,0,20,20),USE(?R3)

RADIO('Radio 4'),AT(80,0,20,20),USE(?R4)

END

END

TAB('Tab Two'),USE(?TabTwo)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P1)

ENTRY(@S8),AT(100,140,32,20),USE(E1)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P2)

ENTRY(@S8),AT(100,240,32,20),USE(E2)

END

TAB('Tab Three'),USE(?TabThree)

OPTION('Option 3'),USE(OptVar3)

RADIO('Radio 1'),AT(20,0,20,20),USE(?R5)

RADIO('Radio 2'),AT(40,0,20,20),USE(?R6)

END

OPTION('Option 4'),USE(OptVar4)

RADIO('Radio 3'),AT(60,0,20,20),USE(?R7)

RADIO('Radio 4'),AT(80,0,20,20),USE(?R8)

END

END

TAB('Tab Four'),USE(?TabFour)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P3)

ENTRY(@S8),AT(100,140,32,20),USE(E3)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P4)

ENTRY(@S8),AT(100,240,32,20),USE(E4)

END

END

BUTTON('Ok'),AT(100,180,20,20),USE(?Ok)

BUTTON('Cancel'),AT(200,180,20,20),USE(?Cancel)

END

CODE

OPEN(MDIChild)

MESSAGE('Number of TABs: ' & ?SelectedTab{PROP:NumTabs})

MESSAGE('Number of rows of TABs: ' & ?SelectedTab{PROP:TabRows})

ACCEPT

END

MEMBER('MyApp')

MAP

END

MyReport PROCEDURE

STRING(64)

END

END

CODE

OPEN(Report)

NameVar STRING(260),STATIC

PageFile FILE,DRIVER('DOS'),NAME(NameVar),CREATE

Rec RECORD

F1 LONG

. .

CODE

NameVar = PATH() & '\PAGE' & FORMAT(PageNumber,@n04) & '.WMF'

CREATE(PageFile)

RETURN(NameVar)

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL,SYSTEM

END

ToolboxThread BYTE

CODE

OPEN(WinView)

ToolboxThread = ToolboxWin{PROP:Thread} !Получить номер процесса для окна

ACCEPT

END

PROGRAM

CODE

IF SomeCondition = TRUE

END

WinView APPLICATION('MyApp'),AT(0,0,320,200),MAX,HVSCROLL,SYSTEM

END

CODE

OPEN(WinView)

ACCEPT

END

SYSTEM {PROP:FontName + PROP:TipsFont} !установить/получить начертание шрифта

SYSTEM {PROP:FontColor + PROP:TipsFont} !установить/получить цвет шрифта

SYSTEM {PROP:FontStyle + PROP:TipsFont} !установить/получить стиль шрифта

ToolbarFEQ = MyWindowLabel{PROP:Toolbar} !получить метку соответствия линейки инструментов

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

ENTRY(@S30),AT(0,0,320,180),USE(Fil:Field)

BUTTON('Ok'),AT(100,180,20,20),USE(?Ok)

BUTTON('Cancel'),AT(200,180,20,20),USE(?Cancel)

END

SaveCancelPos LONG,DIM(4)

CODE

OPEN(WinView)

SaveCancelPos[2] = ?Cancel{PROP:Xpos}+?Cancel{PROP:Width}

SaveCancelPos[3] = ?Cancel{PROP:Ypos}

SaveCancelPos[4] = ?Cancel{PROP:Ypos}+?Cancel{PROP:Height}

ACCEPT

CASE FIELD()

OF ?Fil:Field

CASE EVENT()

OF EVENT:Selected

OF EVENT:Accepted

INRANGE(MOUSEX(),SaveCancelPos[1],SaveCancelPos[2]) AND |

INRANGE(MOUSEY(),SaveCancelPos[3],SaveCancelPos[4])

ELSE

! они пользователем или были в этих полях изначально

END

OF ?Ok

CASE EVENT()

OF EVENT:Accepted

!Записать данные на диск

END

OF ?Cancel

CASE EVENT()

OF EVENT:Accepted

!Не записывать данные на диск

END

END

END

MyField STRING(1)

?MyField EQUATE(100)

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

END

CODE

OPEN(WinView)

IF UserChoice = 'CheckField'

CREATE(?MyField,CREATE:Check)

ELSE

CREATE(?MyField,CREATE:Entry)

END

?MyField{PROP:Use} = MyField

SETPOSITION(?MyField,10,10)

?MyField{PROP:TrueValue} = 'T'

?MyField{PROP:FalseValue} = 'F'

END

ACCEPT

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,MAX,HVSCROLL

TAB('Tab One'),USE(?TabOne)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P1)

ENTRY(@S8),AT(100,140,32,20),USE(E1)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P2)

ENTRY(@S8),AT(100,240,32,20),USE(E2)

END

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P3)

ENTRY(@S8),AT(100,140,32,20),USE(E3)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P4)

ENTRY(@S8),AT(100,240,32,20),USE(E4)

END

END

BUTTON('Ok'),AT(100,180,20,20),USE(?Ok)

BUTTON('Cancel'),AT(200,180,20,20),USE(?Cancel)

END

CODE

OPEN(WinView)

ACCEPT

END

Loc:Any ANY

FEQ2 ANY

Window WINDOW('Caption'),AT(,,260,100),GRAY

ENTRY(@s20),AT(57,23,60,10),USE(Loc:Any)

ENTRY(@s20),AT(57,50,60,10),USE(FEQ2)

END

X LONG

CODE

OPEN(Window)

ACCEPT

X = ?Loc:Any{PROP:UseAddress}

?Feq2{PROP:UseAddress} = X

BREAK

END

MDIChild WINDOW('Child One'),AT(0,0,320,200),MDI,MAX,HVSCROLL

SHEET,AT(0,0,320,175),USE(SelectedTab)

TAB('Tab One'),USE(?TabOne)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P1)

ENTRY(@S8),AT(100,140,32,20),USE(E1)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P2)

ENTRY(@S8),AT(100,240,32,20),USE(E2)

END

TAB('Tab Two'),USE(?TabTwo)

PROMPT('Enter Data:'),AT(100,100,20,20),USE(?P3)

ENTRY(@S8),AT(100,140,32,20),USE(E3)

PROMPT('Enter More Data:'),AT(100,200,20,20),USE(?P4)

ENTRY(@S8),AT(100,240,32,20),USE(E4)

END

END

BUTTON('Ok'),AT(100,180,20,20),USE(?Ok)

BUTTON('Cancel'),AT(200,180,20,20),USE(?Cancel)

END

CODE

OPEN(MDIChild)

ACCEPT

CASE EVENT()

OF EVENT:Completed

BREAK

END

CASE FIELD()

OF ?Ok

CASE EVENT()

OF EVENT:Accepted

SELECT

END

OF ?E3

CASE EVENT()

OF EVENT:Accepted

IF ?E3{PROP:Visible} AND MDIChild{PROP:AcceptAll}

END

END

OF ?Cancel

CASE EVENT()

OF EVENT:Accepted

BREAK

END

END

END

VLBProc PROCEDURE(LONG,LONG,SHORT),STRING

PROGRAM

MAP

Main

END

StripedListQ QUEUE,TYPE

S STRING(20)

END

StripedList CLASS,TYPE

Init PROCEDURE(WINDOW w, SIGNED feq, StripedListQ Q)

VLBproc PROCEDURE(LONG row, SHORT column),STRING,PRIVATE

!Required first parameter is implicit in a CLASS method

Q &StripedListQ,PRIVATE

ochanges LONG,PRIVATE

END

CODE

Main

StripedList.Init PROCEDURE(WINDOW w, SIGNED feq, StripedListQ Q)

CODE

SELF.Q &= Q

SELF.ochanges = CHANGES(Q)

w $ feq{PROP:VLBproc} = ADDRESS(SELF.VLBproc) ! затем это

StripedList.VLBproc PROCEDURE(LONG row, SHORT col) !Подразумевается первый обязательный параметр

nchanges LONG

CODE

CASE row

RETURN RECORDS(SELF.Q)

OF -2 ! Сколько колонок?

RETURN 5 ! 1 данные, четыре поля цвета в “номинальной очереди”

OF -3 ! Это изменения

nchanges = CHANGES(SELF.Q)

IF nchanges <> SELF.ochanges THEN

SELF.ochanges = nchanges

RETURN 1

ELSE

RETURN 0

END

ELSE

GET(SELF.Q, row)

CASE col

OF 1 !Поле данных

RETURN WHAT(SELF.Q,1)

OF 3 !Поле цвета фона

RETURN CHOOSE(BAND(row,1), COLOR:none, 0c00000H)

ELSE !Все другие поля

RETURN COLOR:None ! использовать цвет по умолчанию

END

END

Main PROCEDURE

window WINDOW('Caption'),AT(,,153,103),GRAY,SYSTEM

LIST,AT(33,12,80,80),USE(?List1),FORMAT('20L*')

END

Q QUEUE(StripedListQ)

END

SL StripedList

i SIGNED

CODE

LOOP i = 1 TO 20

Q.s = 'Line ' & i

ADD(Q)

END

OPEN(window)

SL.Init(window, ?list1, Q)

ACCEPT

END

Que QUEUE

STRING(50)

END

WinView WINDOW('View'),AT(0,0,320,200),MDI,SYSTEM

LIST,AT(0,0,320,200),USE(?List),FROM(Que),IMM,VSCROLL

END

CODE

OPEN(WinView)

Fil:KeyField = 'A' ; DO BuildListQue

ACCEPT

CASE FIELD()

OF ?List

CASE EVENT()

OF EVENT:ScrollDrag

EXECUTE INT(?List{PROP:VscrollPos}/10) + 1

Fil:KeyField = 'A'

Fil:KeyField = 'C'

Fil:KeyField = 'E'

Fil:KeyField = 'G'

Fil:KeyField = 'K'

Fil:KeyField = 'M'

Fil:KeyField = 'P'

Fil:KeyField = 'S'

Fil:KeyField = 'V'

Fil:KeyField = 'Y'

END

DO BuildListQue

END

END

END

FREE(Que)

BuildListQue ROUTINE

FREE(Queue)

END

FileName STRING(256)

Customer FILE,DRIVER('Clarion')

Record RECORD

Name STRING(20)

. .

CODE

OPEN(Customer)

SET(Customer)

LOOP

WATCH(Customer)

NEXT(Customer)

IF ERRORCODE() THEN BREAK.

IF Customer{PROP:Watched} <> ''

MESSAGE('Record watched')

END

END

Пример:

GLO:WindowsVersion = SYSTEM{PROP:WindowsVersion}

PROGRAM

MAP

Main PROCEDURE

SubClassFunc1 PROCEDURE(UNSIGNED,UNSIGNED,UNSIGNED,LONG),LONG,PASCAL

SubClassFunc2 PROCEDURE(UNSIGNED,UNSIGNED,UNSIGNED,LONG),LONG,PASCAL

MODULE('') !SoftVelocity Win Library

CallWindowProc PROCEDURE(LONG,UNSIGNED,SIGNED,UNSIGNED,LONG),LONG,PASCAL,NAME('CallWindowProcA')

END

END

SavedProc1 LONG

SavedProc2 LONG

WM_MOUSEMOVE EQUATE(0200H)

PT GROUP

X SIGNED

Y SIGNED

END

CODE

Main

Main PROCEDURE

WinView WINDOW('View'),AT(0,0,320,200),HVSCROLL,MAX,TIMER(1),STATUS

STRING('X Pos'),AT(1,1,,),USE(?String1)

STRING(@n3),AT(24,1,,),USE(PT:X)

STRING('Y Pos'),AT(44,1,,),USE(?String2)

STRING(@n3),AT(68,1,,),USE(PT:Y)

BUTTON('Close'),AT(240,180,60,20),USE(?Close)

END

CODE

OPEN(WinView)

ACCEPT

CASE ACCEPTED()

OF ?Close

BREAK

END

END

PT.X = MOUSEX() ; PT.Y = MOUSEY() !Присвоить позицию мыши

END

RETURN(CallWindowProc(SavedProc1,hWnd,wMsg,wParam,lParam))!Передать управление в SavedProc1

IF wMsg = WM_MOUSEMOVE ! в клиентской части окна

PT.X = MOUSEX() ; PT.Y = MOUSEY() !Присвоить позицию мыши

END

RETURN(CallWindowProc(SavedProc2,hWnd,wMsg,wParam,lParam))!Передать управление в SavedProc2

?List {PROP:YOrigin} = n

PROGRAM

MAP

END

S STRING(20)

Window WINDOW('Caption'),AT(,,400,250),FONT('MS Sans Serif',8,,FONT:regular)|

,IMM,VSCROLL, STATUS,SYSTEM,GRAY,CENTER

ENTRY(@S20),AT(10,100),USE(S,,?S1),SCROLL

ENTRY(@S20),AT(10,500),USE(S,,?S2),SCROLL

ENTRY(@S20),AT(10,900),USE(S,,?S3),SCROLL

END

y1 UNSIGNED

y2 UNSIGNED

Wy1 UNSIGNED

Wy2 UNSIGNED

Control SIGNED

CODE

OPEN(Window)

ACCEPT

CASE EVENT()

OF EVENT:Selected

Control = SELECTED()

IF Control

y1 = Control {PROP:yPos}

y2 = y1 + Control {PROP:Height}

Wy2 = Wy1 + 0 {PROP:ClientHeight}

IF y1 < Wy1

0{PROP:YOrigin} = CHOOSE (y1 < 20, 0, y1 - 20)

ELSIF y2 > Wy2

0{PROP:YOrigin} = Wy1 + y2 - Wy2 + 20 !установить Yorigin

END

END

END

END

CLOSE(Window)

OwnerString STRING(20)

Customer FILE,DRIVER('ODBC'),OWNER(OwnerString)

Record RECORD

Name STRING(20)

. .

CODE

OwnerString = 'DataSourceName'

OPEN(Customer)

KeyRef &KEY

Customer FILE,DRIVER('Clarion'), PRE(Cus)

NameKey KEY(Cus:Name),DUP

Record RECORD

Name STRING(20)

. .

CODE

OPEN(Customer)

SET(Customer)

KeyRef &= Customer{PROP:CurrentKey) !Возвращает NULL

IF Customer{PROP:CurrentKey) &= NULL !Сравнивает с NULL

MESSAGE('SET to record order')

END

SET(Cus:NameKey)

GETINI(datadirectory)

file1name = datadirectory & 'file1'

file2name = datadirectory & 'file2'

file3name = datadirectory & 'file3'

IF Customer{PROP:DriverLogsoutAlias} = '' !Тест для алиаса позволенный в LOGOUT

MESSAGE('Driver does not allow files and their aliases in LOGOUT')

END

Пример:

IF Customer{PROP:DynamicFile} = 1 !Проверить, что файл был создан NEW

DISPOSE(Customer)

END

CODE

OPEN(MyFile)

KFile &FILE

Record &GROUP

CODE

KFile &= key{PROP:File}

MESSAGE(KFile{PROP:Label, key{PROP:Field, 1}}) !Возвращает метку компонента первого ключа

Header FILE,DRIVER('TopSpeed'),PRE(Hea)

OrderKey KEY(Hea:AcctNumber, Hea:OrderNumber)

Record RECORD

AcctNumber LONG

OrderNumber LONG

OrderDate LONG

. .

Detail FILE,DRIVER('TopSpeed'),PRE(Det)

OrderKey KEY(Det:AcctNumber,Det:OrderNumber)

Record RECORD

AcctNumber LONG

OrderNumber LONG

ItemNumber LONG

. .

AView VIEW(Header)

PROJECT(Hea:AcctNumber,Hea:OrderNumber,Hea:OrderDate)

JOIN(Det:OrderKey,Hea:AcctNumber,Hea:OrderNumber)

. .

!AView{PROP:Field,2} Возвращает 2, которое представляет собой Hea:OrderNumber

!AView{PROP:Field,3} Возвращает 3, которое представляет собой Hea:OrderDate

!AView{PROP:Field,4} Возвращает 1, которое представляет собой Det:AcctNumber

!AView{PROP:Field,5} Возвращает 2, которое представляет собой Det:OrderNumber

!AView{PROP:Field,6} Возвращает 3, которое представляет собой Det:ItemNumber

!AView{PROP:FieldsFile,2} Возвращает указатель на Header File

GetFileInfoFromKey PROCEDURE(*KEY key)

KFile &FILE

Record &GROUP

CODE

KFile &= key{PROP:File}

MESSAGE(KFile{PROP:Label, key{PROP:Field, 1}}) !Возвращает метку первого компонента ключа

AView VIEW(BaseFile) !Файл 1

JOIN(ParentFile,'BaseFile.parentID = ParentFile.ID') !Файл 2

END

END

JOIN(OtherParent.PrimaryKey,BaseFile.OtherParentID) !Файл 4

END

END ! AView{PROP:Files} возвращает 4

! AView{PROP:File,1} возвращает указатель нa BaseFile

! AView{PROP:File,3} возвращает указатель нa GrandParent

! AView{PROP:File,4} возвращает указатель нa OtherParent

FilesQ QUEUE

FileRef &FILE

END

CODE

FilesQ.FileRef &= AView{PROP:File,X#} !Указатель на каждый файл в VIEW

ADD(FilesQ) ! и добавить в очередь

END

v VIEW(PFile),ORDER('PFile:String1'),FILTER('PFile:ID = 3')

PROJECT(PFile:ID, PFile:String1)

JOIN(Child1:Keyname, PFile:ID) !Файл Child1 имеет 4 поля

JOIN(Child3, 'Child3:LinkField = Child2:ID')

PROJECT(Child3:String2)

END

END

JOIN(Child2Child1:KeyName, Child1:ID) !Файл Child2Child1 имеет 4 поля

END

END

END

v{PROP:Files, 1} возвратит 4

v{PROP:Files, 2} возвратит 3

v{PROP:Files, 3} возвратит 1

v{PROP:Files, 4} возвратит 0

v{PROP:Files, 5} возвратит 0

ProcessClass.Reset PROCEDURE

CODE

SELF.RecordsProcessed = 0

IF ~SELF.StepMgr &= NULL

SELF.SetProgressLimits

ELSIF ~SELF.RecordsToProcess

SELF.Primary.Me.UseFile

SELF.RecordsToProcess = RECORDS(SELF.Primary.Me.File)

IF ~SELF.RecordsToProcess ! Записи не поддерживаются

SELF.FileSize = SELF.Primary.Me.File{PROP:FileSize}

END

END

SELF.ChildRead = 0

PARENT.Reset

file{PROP:FlushLog} = TRUE

file{PROP:FlushLog} = FALSE

SYSTEM{PROP:GlobalHelp} = TRUE !Блокирует автозакрытие файла HLP

FileName STRING(256)

Customer FILE,DRIVER('Clarion')

Record RECORD

Name STRING(20)

. .

CODE

OPEN(Customer)

SET(Customer)

LOOP

HOLD(Customer,1)

NEXT(Customer)

IF ERRORCODE() THEN BREAK.

IF Customer{PROP:Held} <> ''

MESSAGE('Record Held')

END

END

FileName STRING(256)

Customer FILE,DRIVER('TopSpeed')

Record RECORD

Name STRING(20)

END

END

CODE

Customer{PROP:Profile} = 'CustLog.TXT'

OPEN(Customer)

Customer{PROP:Log} = CLIP(FileName) & ' ' & |

FORMAT(TODAY(),@D2) & ' ' & |

FORMAT(CLOCK(),@T1)

SET(Customer)

LOOP

END

Customer FILE,DRIVER('TopSpeed')

Record RECORD

CustNumber LONG

Name STRING(20)

END

END

Orders FILE,DRIVER('TopSpeed')

Record RECORD

CustNumber LONG

OrderNumber LONG

OrderDate LONG

END

END

Items FILE,DRIVER('TopSpeed')

Record RECORD

OrderNumber LONG

ItemNumber LONG

END

END

CODE

! и очистить список подключений

X# = Items{PROP:Logout} !Возвращает 0 т.к.оператор LOGOUT очистил список подключений.

Items{PROP:Logout} = 1 !Добавить Items в список подключений (теперь одна таблица в файле есть)

COMMIT !Завершить транзакцию

Orders{PROP:Logout} = 1 !Добавить также Orders (теперь в списке 2 записи)

COMMIT !Завершить транзакцию