XProfan

Source wurde am 13.07.2006 in die Babyklappe auf XProfan.Com abgelegt:
**************************************************************************
######### OHNE Bilderverzeichniss nicht Lauffähig ########################
++++++++++++++ GDL 2006  Codeausschnitt aus Modellbahnsteuerung ++++++++++
++++++++++++++ von Anfänger,darum einfach gehalten und für Anfänger gedacht ++++
++++++++++++++ Geht nur mit Xprofan10 !!!!!!!!!!+++++++++++++++++++++++++++
++++++++++++++ Benötigt das Bilderverzeichnis !!!++++++++++++++++++++++++++
++++++++++++++ Benötigt iFs Thread Unit+++++++++++++++++++++++++++++++++++
++++++++++++++ Benötigt die SKControl von Sebastian König++++++++++++++++++
****************************************************************************
declare ende%,tbar&,tbar1&,objekt&,objekt_&[9000],num&,oname_$[9000],vertikal%,start%,speichern%
declare datei$,odatei$,astart$,name$,xpos_&[9000],ypos_&[9000],lang_&[9000],breit_&[9000]
declare num1&,x%,y%,num&,result%,xn%,yn%,weiche%,gerade%,runde%,signal%,ap%,bm%,rect#
declare rectpt#,kfenster&,ktext&,akmin&,akplus&,xplus&,xmin&,ymin&,yplus&,text1&,text2&
declare lplus&,lmin&,bplus&,bmin&,vertikal_&[9000],bild_&[9000],bild%,string#,image#
declare hdll&,dll&,rtf#,style_&[9000],komponente$[9000],anzahl&,bilda_&[9000],bn&
declare taster%,arbeitsleiste&,n$,numa&,dwei&[5],winkel&[4],winkel%
declare ger1&,ger2&,bog1&,bog2&,bog3&,bog4&,wei1&,wei2&,wei3&,wei4&,wei5&,wei6&
declare wei7&,wei8&,kw1&,kw2&,sig1&,sig2&,ap&,bm&,tas&,text&
declare xwert&,ywert&,xbalken%,ybalken%,name$,button&,button1&,druck&,drucki%,b&
declare ypos_1&[9000],xpos_1&[9000]
dim string#,255
dim image#,255
SetTrueColor 1
USERMESSAGES 16
Def GetSysColor(1) !USER32,GetSysColor
Def GetCursorPos(1) !USER32,GetCursorPos
Def ScreenToClient(2) !USER32,ScreenToClient
Def PtInRect(3) !USER32,PtInRect
 $U thread.pcu = thread.
astart$=$ProgDir
case left$(astart$,4)=C:P:astart$=C:\Steuerung\Gleisplaner
chdir astart$
 $I SKCONTROL.INC
let hdll& = UseDll(SKControl.dll)        Farb DLL laden
SKCtrl_InitDll()

ifnot findfirst$(gleis.str) = gleis.str

    beep
    assign #1,gleis.str
    rewrite #1,gleis.str
    print #1,bild;C;20;0
    print #1,was;C;20;0
    print #1,x;C;4;0
    print #1,y;C;4;0
    print #1,lang;C;4;0
    print #1,breit;C;4;0
    print #1,style;C;10;0
    close #1
    dbcreate gleis.str > gleis.dbf

endif

windowstyle 31
window 0,0-%maxx,%maxy
windowtitle Gleisplaner zur grafischen Verknüpfungserstellung      GDL 2006
tbar&=@Create(Toolbar,%hwnd,1,0,1,0,100)
@Toolbar(AddTextButton,tbar&,0,100,Neu,Neues Gleisbild erstellen)
@Toolbar(AddTextButton,tbar&,0,200,laden,Bestehendes Gleisbild öffnen)
@Toolbar(AddTextButton,tbar&,0,300,save,Gleisbild speichern)
@Toolbar(AddTextButton,tbar&,0,310,druck,Gleisbild drucken)
@Toolbar(AddTextButton,tbar&,0,400,Ende,Programmende)
@Toolbar(Separator,tbar&)
@Toolbar(Separator,tbar&)
@Toolbar(AddTextButton,tbar&,0,500,Ge hor,Gerade horizontal)
@Toolbar(AddTextButton,tbar&,0,510,Ge ver,Gerade vertikal)
@Toolbar(AddTextButton,tbar&,0,600,Bog 1,Bogensegment 1)
@Toolbar(AddTextButton,tbar&,0,610,Bog 2,Bogensegment 2)
@Toolbar(AddTextButton,tbar&,0,620,Bog 3,Bogensegment 3)
@Toolbar(AddTextButton,tbar&,0,630,Bog 4,Bogensegment 4)
@Toolbar(AddTextButton,tbar&,0,700,W o l,Weiche oben links)
@Toolbar(AddTextButton,tbar&,0,710,W o r,Weiche oben rechts)
@Toolbar(AddTextButton,tbar&,0,720,W u l,Weiche unten links)
@Toolbar(AddTextButton,tbar&,0,730,W u r,Weiche unten rechts)
@Toolbar(AddTextButton,tbar&,0,735,KW,Doppelkreuzweiche)
@Toolbar(AddTextButton,tbar&,0,740,lösch,aktuelle Komponente löschen)
@Toolbar(AddTextButton,tbar&,0,750,Text,Text hinzufügen)
@Toolbar(Separator,tbar&)
@Toolbar(Separator,tbar&)
@Toolbar(AddTextButton,tbar&,0,800,Si hor,Signal horizontal)
@Toolbar(AddTextButton,tbar&,0,810,Si ver,Signal vertikal)
@Toolbar(AddTextButton,tbar&,0,900,AP,Abfragepunkt)
@Toolbar(AddTextButton,tbar&,0,1000,BM,Besetztmelder)
@Toolbar(AddTextButton,tbar&,0,1100,Ta,Taster)
@Toolbar(Separator,tbar&)
@Toolbar(Separator,tbar&)
@Toolbar(AddTextButton,tbar&,0,1200,Hilfe,Hilfe anzeigen)
ktext&=create(text,%hwnd,aktuelle Komponente =,%maxx-724,%maxy-80,150,20)
kfenster&=create(edit,%hwnd,,%maxx-564,%maxy-80,100,20)
akplus&=create(button,%hwnd,+,%maxx-454,%maxy-90,15,15)
akmin&=create(button,%hwnd,-,%maxx-454,%maxy-70,15,15)
text1&=create(text,%hwnd,Position,%maxx-404,%maxy-80,55,20)
xplus&=create(button,%hwnd,x+,%maxx-344,%maxy-90,20,15)
xmin&=create(button,%hwnd,x-,%maxx-344,%maxy-70,20,15)
yplus&=create(button,%hwnd,y+,%maxx-314,%maxy-90,20,15)
ymin&=create(button,%hwnd,y-,%maxx-314,%maxy-70,20,15)
text1&=create(text,%hwnd,Gerade,%maxx-274,%maxy-80,55,20)
lplus&=create(button,%hwnd,l+,%maxx-214,%maxy-90,20,15)
lmin&=create(button,%hwnd,l-,%maxx-214,%maxy-70,20,15)
bplus&=create(button,%hwnd,b+,%maxx-174,%maxy-90,20,15)
bmin&=create(button,%hwnd,b-,%maxx-174,%maxy-70,20,15)
xwert&=@Create(HScroll,%hwnd,,1,%maxy-117,1013,15)
ywert&=@Create(VScroll,%hwnd,,%maxx-25,30,15,%maxy-148)
SetScrollRange xwert&,0,1013
SetScrollRange ywert&,0,680
********************************************************************

proc kommentare

    --- Buttonbilder -----
    bild1& = Gerade horizontal
    bild2& = Gerade vertikal
    bild3& = Seg. I
    bild4& = Seg. II
    bild5& = Seg. III
    bild6& = Seg. IV

endproc

********************************************************************

proc balken

    xbalken%=@GetScrollPos(xwert&)
    ybalken%=@GetScrollPos(ywert&)
    name$=XWeite : +str$(xbalken%)+  YWeite : +str$(ybalken%)

endproc

===================================================================

proc leiste

    windowstyle 3
    arbeitsleiste&=create(window,%hwnd,Arbeitsleiste,1,%maxy-190,1000,90)
    name$= astart$+\bilder\bild1.BMP
    bild_&[9000] = @Create(HPIC, -1, name$)
    ger1&=@Create(PicButton,arbeitsleiste&,bild_&[9000],1,1,30,30,)
    name$= astart$+\bilder\bild2.BMP
    bild_&[8999] = @Create(HPIC, -1, name$)
    ger2&=@Create(PicButton,arbeitsleiste&,bild_&[8999],31,1,30,30,)
    name$= astart$+\bilder\bild3.BMP
    bild_&[8998] = @Create(HPIC, -1, name$)
    bog1&=@Create(PicButton,arbeitsleiste&,bild_&[8998],61,1,30,30,)
    name$= astart$+\bilder\bild4.BMP
    bild_&[8997] = @Create(HPIC, -1, name$)
    bog2&=@Create(PicButton,arbeitsleiste&,bild_&[8997],91,1,30,30,)
    name$= astart$+\bilder\bild5.BMP
    bild_&[8996] = @Create(HPIC, -1, name$)
    bog3&=@Create(PicButton,arbeitsleiste&,bild_&[8996],121,1,30,30,)
    name$= astart$+\bilder\bild6.BMP
    bild_&[8995] = @Create(HPIC, -1, name$)
    bog4&=@Create(PicButton,arbeitsleiste&,bild_&[8995],151,1,30,30,)
    name$= astart$+\bilder\bild7.BMP
    bild_&[8994] = @Create(HPIC, -1, name$)
    wei1&=@Create(PicButton,arbeitsleiste&,bild_&[8994],181,1,30,30,)
    name$= astart$+\bilder\bild8.BMP
    bild_&[8993] = @Create(HPIC, -1, name$)
    wei2&=@Create(PicButton,arbeitsleiste&,bild_&[8993],211,1,30,30,)
    name$= astart$+\bilder\bild9.BMP
    bild_&[8992] = @Create(HPIC, -1, name$)
    wei3&=@Create(PicButton,arbeitsleiste&,bild_&[8992],241,1,30,30,)
    name$= astart$+\bilder\bild10.BMP
    bild_&[8991] = @Create(HPIC, -1, name$)
    wei4&=@Create(PicButton,arbeitsleiste&,bild_&[8991],271,1,30,30,)
    name$= astart$+\bilder\bild11.BMP
    bild_&[8990] = @Create(HPIC, -1, name$)
    wei5&=@Create(PicButton,arbeitsleiste&,bild_&[8990],301,1,30,30,)
    name$= astart$+\bilder\bild12.BMP
    bild_&[8989] = @Create(HPIC, -1, name$)
    wei6&=@Create(PicButton,arbeitsleiste&,bild_&[8989],331,1,30,30,)
    name$= astart$+\bilder\bild13.BMP
    bild_&[8988] = @Create(HPIC, -1, name$)
    wei7&=@Create(PicButton,arbeitsleiste&,bild_&[8988],361,1,30,30,)
    name$= astart$+\bilder\bild14.BMP
    bild_&[8987] = @Create(HPIC, -1, name$)
    wei8&=@Create(PicButton,arbeitsleiste&,bild_&[8987],391,1,30,30,)
    name$= astart$+\bilder\bild19.BMP
    bild_&[8986] = @Create(HPIC, -1, name$)
    kw1&=@Create(PicButton,arbeitsleiste&,bild_&[8986],421,1,30,30,)
    name$= astart$+\bilder\bild20.BMP
    bild_&[8985] = @Create(HPIC, -1, name$)
    kw2&=@Create(PicButton,arbeitsleiste&,bild_&[8985],451,1,30,30,)
    name$= astart$+\bilder\bild15.BMP
    bild_&[8984] = @Create(HPIC, -1, name$)
    sig1&=@Create(PicButton,arbeitsleiste&,bild_&[8984],481,1,30,30,)
    name$= astart$+\bilder\bild16.BMP
    bild_&[8983] = @Create(HPIC, -1, name$)
    sig2&=@Create(PicButton,arbeitsleiste&,bild_&[8983],511,1,30,30,)
    name$= astart$+\bilder\bild18.BMP
    bild_&[8982] = @Create(HPIC, -1, name$)
    ap&=@Create(PicButton,arbeitsleiste&,bild_&[8982],541,1,30,30,)
    name$= astart$+\bilder\bild17.BMP
    bild_&[8981] = @Create(HPIC, -1, name$)
    bm&=@Create(PicButton,arbeitsleiste&,bild_&[8981],571,1,30,30,)
    tas&=@Create(Button,arbeitsleiste&,Ta,601,1,30,30,)
    text&=@Create(Button,arbeitsleiste&,Text,631,1,50,30,)
    name$= astart$+\bilder\bild21.BMP
    bild_&[8980] = @Create(HPIC, -1, name$)
    dwei&[1]=@Create(PicButton,arbeitsleiste&,bild_&[8980],690,1,60,36)
    name$= astart$+\bilder\bild22.BMP
    bild_&[8979] = @Create(HPIC, -1, name$)
    dwei&[2]=@Create(PicButton,arbeitsleiste&,bild_&[8979],755,1,60,36)
    name$= astart$+\bilder\bild23.BMP
    bild_&[8978] = @Create(HPIC, -1, name$)
    dwei&[3]=@Create(PicButton,arbeitsleiste&,bild_&[8978],820,1,36,60)
    name$= astart$+\bilder\bild24.BMP
    bild_&[8977] = @Create(HPIC, -1, name$)
    dwei&[4]=@Create(PicButton,arbeitsleiste&,bild_&[8977],875,1,36,60)
    name$= astart$+\bilder\bild25.BMP
    bild_&[8976] = @Create(HPIC, -1, name$)
    winkel&[1]=@Create(PicButton,arbeitsleiste&,bild_&[8976],1,35,30,30)
    name$= astart$+\bilder\bild26.BMP
    bild_&[8975] = @Create(HPIC, -1, name$)
    winkel&[2]=@Create(PicButton,arbeitsleiste&,bild_&[8975],31,35,30,30)

endproc

======================================================================

proc doppelweiche

    richtige Bildnummer zuweisen!!
    case xn%=0:xn%=%maxx-500
    case yn%=0:yn%=%maxy-735
    inc weiche%
    objekt&=objekt&+1

    if bild%=21

        name$= astart$+\bilder\bild21.BMP
        bilda_&[objekt&]=21
        lang_&[objekt&]=60
        breit_&[objekt&]=35

    elseif bild%=22

        name$= astart$+\bilder\bild22.BMP
        bilda_&[objekt&]=22
        lang_&[objekt&]=60
        breit_&[objekt&]=35

    elseif bild%=23

        name$= astart$+\bilder\bild23.BMP
        bilda_&[objekt&]=23
        lang_&[objekt&]=35
        breit_&[objekt&]=60

    elseif bild%=24

        name$= astart$+\bilder\bild24.BMP
        bilda_&[objekt&]=24
        lang_&[objekt&]=35
        breit_&[objekt&]=60

    endif

    bild_&[objekt&] = @Create(HPIC, -1, name$)
    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    oname_$[objekt&]=Weiche +right$(0000+str$(weiche%),4)
    objekt_&[objekt&]=control(STATIC,,$5400000e,xpos_&[objekt&],ypos_&[objekt&],lang_&[objekt&],breit_&[objekt&],%hwnd,0,%hinstance,$0)
    Sendmessage(objekt_&[objekt&],$172,0,bild_&[objekt&])
    style_&[objekt&]=$5400000e
    bild%=0
    xn%=0
    yn%=0
    settext kfenster&,oname_$[objekt&]

endproc

================================================================

proc gerver

    case xn%=0:xn%=%maxx-755
    case yn%=0:yn%=%maxy-735
    inc gerade%
    objekt&=objekt&+1
    vertikal_&[objekt&]=1
    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    lang_&[objekt&]=8
    breit_&[objekt&]=30
    oname_$[objekt&]=Gerade +right$(0000+str$(gerade%),4)
    objekt_&[objekt&]=control(STATIC,,$54010087,xpos_&[objekt&],ypos_&[objekt&],lang_&[objekt&],breit_&[objekt&],%hwnd,0,%hinstance,$0)
    bild%=0
    style_&[objekt&]=$54010087
    xn%=0
    yn%=0
    settext kfenster&,oname_$[objekt&]

endproc

=======================================================================

proc gerhor

    case xn%=0:xn%=%maxx-800
    case yn%=0:yn%=%maxy-735
    inc gerade%
    objekt&=objekt&+1
    vertikal_&[objekt&]=0
    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    lang_&[objekt&]=30
    breit_&[objekt&]=8
    oname_$[objekt&]=Gerade +right$(0000+str$(gerade%),4)
    objekt_&[objekt&]=control(STATIC,oname_$[objekt&],$54010087,xpos_&[objekt&],ypos_&[objekt&],lang_&[objekt&],breit_&[objekt&],%hwnd,0,%hinstance,$0)
    style_&[objekt&]=$54010087
    xn%=0
    yn%=0
    settext kfenster&,oname_$[objekt&]

endproc

==============================================================

proc winkel

    inc winkel%
    objekt&=objekt&+1

    if bild%=1

        name$= astart$+\bilder\bild25.BMP
        bilda_&[objekt&]=25
        case xn%=0:xn%=%maxx-730
        case yn%=0:yn%=%maxy-735

    elseif bild%=2

        name$= astart$+\bilder\bild26.BMP
        bilda_&[objekt&]=26
        case xn%=0:xn%=%maxx-685
        case yn%=0:yn%=%maxy-735

    elseif bild%=3

        name$= astart$+\bilder\bild5.BMP
        bilda_&[objekt&]=5
        case xn%=0:xn%=%maxx-640
        case yn%=0:yn%=%maxy-735

    elseif bild%=4

        name$= astart$+\bilder\bild6.BMP
        bilda_&[objekt&]=6
        case xn%=0:xn%=%maxx-600
        case yn%=0:yn%=%maxy-735

    endif

    bild_&[objekt&] = @Create(HPIC, -1, name$)
    vertikal_&[objekt&]=1
    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    lang_&[objekt&]=30
    breit_&[objekt&]=15
    oname_$[objekt&]=Winkel +right$(0000+str$(winkel%),4)
    objekt_&[objekt&]=control(STATIC,,$5400000e,xpos_&[objekt&],ypos_&[objekt&],lang_&[objekt&],breit_&[objekt&],%hwnd,0,%hinstance,$0)
    Sendmessage(objekt_&[objekt&],$172,0,bild_&[objekt&])
    style_&[objekt&]=$5400000e
    bild%=0
    xn%=0
    yn%=0
    settext kfenster&,oname_$[objekt&]

endproc

==========================================================

proc bogen

    richtige Bildnummer zuweisen!!
    inc runde%
    objekt&=objekt&+1

    if bild%=1

        name$= astart$+\bilder\bild3.BMP
        bilda_&[objekt&]=3
        case xn%=0:xn%=%maxx-730
        case yn%=0:yn%=%maxy-735

    elseif bild%=2

        name$= astart$+\bilder\bild4.BMP
        bilda_&[objekt&]=4
        case xn%=0:xn%=%maxx-685
        case yn%=0:yn%=%maxy-735

    elseif bild%=3

        name$= astart$+\bilder\bild5.BMP
        bilda_&[objekt&]=5
        case xn%=0:xn%=%maxx-640
        case yn%=0:yn%=%maxy-735

    elseif bild%=4

        name$= astart$+\bilder\bild6.BMP
        bilda_&[objekt&]=6
        case xn%=0:xn%=%maxx-600
        case yn%=0:yn%=%maxy-735

    endif

    bild_&[objekt&] = @Create(HPIC, -1, name$)
    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    lang_&[objekt&]=30
    breit_&[objekt&]=30
    oname_$[objekt&]=Bogen +right$(0000+str$(runde%),4)
    objekt_&[objekt&]=control(STATIC,,$5400000e,xpos_&[objekt&],ypos_&[objekt&],lang_&[objekt&],breit_&[objekt&],%hwnd,0,%hinstance,$0)
    Sendmessage(objekt_&[objekt&],$172,0,bild_&[objekt&])
    style_&[objekt&]=$5400000e
    bild%=0
    xn%=0
    yn%=0
    settext kfenster&,oname_$[objekt&]

endproc

===========================================================

proc weiche

    inc weiche%
    objekt&=objekt&+1

    if bild%=1								 o li hor

        name$= astart$+\bilder\bild7.BMP
        bilda_&[objekt&]=7
        case xn%=0:xn%=%maxx-561
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=30
        breit_&[objekt&]=20

    elseif bild%=2								 o li ver

        name$= astart$+\bilder\bild8.BMP
        bilda_&[objekt&]=8
        case xn%=0:xn%=%maxx-561
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=20
        breit_&[objekt&]=30

    elseif bild%=3								 o re hor

        name$= astart$+\bilder\bild9.BMP
        bilda_&[objekt&]=9
        case xn%=0:xn%=%maxx-528
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=30
        breit_&[objekt&]=20

    elseif bild%=4								 o re ver

        name$= astart$+\bilder\bild10.BMP
        bilda_&[objekt&]=10
        case xn%=0:xn%=%maxx-528
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=20
        breit_&[objekt&]=30

    elseif bild%=5								 u li hor

        name$= astart$+\bilder\bild11.BMP
        bilda_&[objekt&]=11
        case xn%=0:xn%=%maxx-488
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=30
        breit_&[objekt&]=20

    elseif bild%=6								 u li ver

        name$= astart$+\bilder\bild12.BMP
        bilda_&[objekt&]=12
        case xn%=0:xn%=%maxx-488
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=20
        breit_&[objekt&]=30

    elseif bild%=7								 u re hor

        name$= astart$+\bilder\bild13.BMP
        bilda_&[objekt&]=13
        case xn%=0:xn%=%maxx-441
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=30
        breit_&[objekt&]=20

    elseif bild%=8								 u re ver

        name$= astart$+\bilder\bild14.BMP
        bilda_&[objekt&]=14
        case xn%=0:xn%=%maxx-441
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=20
        breit_&[objekt&]=30

    elseif bild% = 19							Kreuzw hor

        case xn%=0:xn%=%maxx-410
        case yn%=0:yn%=%maxy-700
        bilda_&[objekt&]=19
        name$= astart$+\bilder\bild19.BMP
        lang_&[objekt&]=60
        breit_&[objekt&]=40

    elseif bild% = 20							Kreuzw vert

        case xn%=0:xn%=%maxx-410
        case yn%=0:yn%=%maxy-700
        bilda_&[objekt&]=20
        name$= astart$+\bilder\bild20.BMP
        lang_&[objekt&]=40
        breit_&[objekt&]=60

    endif

    bild_&[objekt&] = @Create(HPIC, -1, name$)
    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    oname_$[objekt&]=Weiche +right$(0000+str$(weiche%),4)
    objekt_&[objekt&]=control(STATIC,,$5400000e,xpos_&[objekt&],ypos_&[objekt&],lang_&[objekt&],breit_&[objekt&],%hwnd,0,%hinstance,$0)
    Sendmessage(objekt_&[objekt&],$172,0,bild_&[objekt&])
    style_&[objekt&]=$5400000e
    bild%=0
    xn%=0
    yn%=0
    settext kfenster&,oname_$[objekt&]

endproc

=================================================================

proc signal

    inc signal%
    objekt&=objekt&+1
    oname_$[objekt&]=Signal +right$(0000+str$(signal%),4)

    if vertikal%=1

        case xn%=0:xn%=%maxx-220
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=8
        breit_&[objekt&]=30
        name$= astart$+\bilder\bild16.BMP
        bild_&[objekt&] = @Create(HPIC, -1, name$)
        bilda_&[objekt&]=16

    else

        case xn%=0:xn%=%maxx-270
        case yn%=0:yn%=%maxy-735
        lang_&[objekt&]=30
        breit_&[objekt&]=8
        name$= astart$+\bilder\bild15.BMP
        bild_&[objekt&] = @Create(HPIC, -1, name$)
        bilda_&[objekt&]=15

    endif

    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    objekt_&[objekt&]=control(STATIC,,$5400000e,xpos_&[objekt&],ypos_&[objekt&],lang_&[objekt&],breit_&[objekt&],%hwnd,0,%hinstance,$0)
    Sendmessage(objekt_&[objekt&],$172,0,bild_&[objekt&])
    style_&[objekt&]=$5400000e
    bild%=0
    xn%=0
    yn%=0
    settext kfenster&,oname_$[objekt&]

endproc

=======================================================

proc bmelder

    inc bm%
    objekt&=objekt&+1
    oname_$[objekt&]=BMelder +right$(0000+str$(bm%),4)
    lang_&[objekt&]=15
    breit_&[objekt&]=15

    if bild%=17

        name$= astart$+\bilder\bild17.BMP
        bilda_&[objekt&]=17
        case xn%=0:xn%=%maxx-140
        case yn%=0:yn%=%maxy-735

    elseif bild%=18

        name$= astart$+\bilder\bild18.BMP
        bilda_&[objekt&]=18
        case xn%=0:xn%=%maxx-180
        case yn%=0:yn%=%maxy-735

    endif

    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    bild_&[objekt&] = @Create(HPIC, -1, name$)
    objekt_&[objekt&]=control(STATIC,,$54000004,xpos_&[objekt&],ypos_&[objekt&],lang_&[objekt&],breit_&[objekt&],%hwnd,0,%hinstance,$0)
    Sendmessage(objekt_&[objekt&],$172,0,bild_&[objekt&])
    style_&[objekt&]=$5400000e
    clear bild%
    xn%=0
    yn%=0

endproc

==============================================================

proc taster

    inc taster%
    case xn%=0:xn%=%maxx-130
    case yn%=0:yn%=%maxy-735
    objekt&=objekt&+1
    oname_$[objekt&]=Taster +right$(0000+str$(taster%),4)
    xpos_&[objekt&]=xn%
    ypos_&[objekt&]=yn%
    lang_&[objekt&]=10
    breit_&[objekt&]=10
    objekt_&[objekt&]=Control(static,Ta,$54010084,xn%,yn%,10,10,%hwnd,0,%hinstance,$0)
    style_&[objekt&]=$54010084
    xn%=0
    yn%=0

endproc

====================================================================

proc horverbox

    Declare t$,n$,aresult%
    Let t$=Standardfrage
    Let n$=Soll die Komponente horizontal   = ja
    oder                          vertikal       = nein
    dargestellt werden?
    aresult%=MessageBox(n$,t$,292)

    if aresult%=6

        vertikal%=1

    else

        vertikal%=0

    endif

endproc

=======================================================

proc speicherbox

    Declare t$,n$,aresult%
    case start%=0 : return
    Let t$=Kontrollfrage
    Let n$=Datei wurde nicht gespeichert?
    Jetzt speichern?
    aresult%=MessageBox(n$,t$,52)
    case aresult%=6:speichern datei$

endproc

=======================================================

proc loeschen

    case start%=0:return
    Declare t$,n$,num%,numa&,anzahl&,numneu&
    Let t$=Bestätigung
    Let n$=Soll die Komponente  +oname_$[num&]+ gelöscht werden?
    num%=MessageBox(n$,t$,324)

    if num% = 6

        num%=1

        whilenot num% > objekt&

            destroywindow(objekt_&[num%])
            DeleteObject bild_&[num%]
            inc num%

        wend

        oname_$[num&]=
        dbclose(#10)
        dbcreate gleis.str > odatei$+.dbf
        anzahl&=dbopen(#10,odatei$+.dbf)
        dbuse(#10)
        numa&=1

        whilenot numa& > objekt&

            ifnot oname_$[numa&]=

                dbappendblank()
                dbput(bild,str$(bilda_&[numa&]))
                dbput(was,oname_$[numa&])
                dbput(style,str$(style_&[numa&]))
                dbput(x,str$(xpos_1&[numa&]))
                dbput(y,str$(ypos_1&[numa&]))
                dbput(lang,str$(lang_&[numa&]))
                dbput(breit,str$(breit_&[numa&]))
                dbputrec(0)
                speichern%=1

            endif

            numa&=numa&+1

        wend

        clear signal%
        clear runde%
        clear gerade%
        clear weiche%
        clear bm%
        clear winkel%
        dbclose(#10)
        anzahl&=dbopen(#10,odatei$+.dbf)
        dbuse(#10)
        numa&=1

        whilenot numa& > anzahl&

            dbgo(numa&)
            style_&[numa&]=val(dbget$(style))
            xpos_&[numa&]=val(dbget$(x))
            ypos_&[numa&]=val(dbget$(y))
            breit_&[numa&]=val(dbget$(breit))
            lang_&[numa&]=val(dbget$(lang))
            oname_$[numa&]=dbget$(was)
            bilda_&[numa&]=val(dbget$(bild))
            objekt_&[numa&]=control(STATIC,,style_&[numa&],xpos_&[numa&],ypos_&[numa&],lang_&[numa&],breit_&[numa&],%hwnd,0,%hinstance,$0)
            name$=left$(oname_$[numa&],3)
            case name$=Ger:inc gerade%
            case name$=Bog:inc runde%
            case name$=Wei:inc weiche%
            case name$=Sig:inc signal%
            case name$=Win:inc winkel%
            case name$=BMe:inc bm%

            ifnot (name$ = Ger) or (bilda_&[numa&]< 3)

                case bilda_&[numa&] = 3 :name$= astart$+\bilder\bild3.BMP
                case bilda_&[numa&] = 4 :name$= astart$+\bilder\bild4.BMP
                case bilda_&[numa&] = 5 :name$= astart$+\bilder\bild5.BMP
                case bilda_&[numa&] = 6 :name$= astart$+\bilder\bild6.BMP
                case bilda_&[numa&] = 7 :name$= astart$+\bilder\bild7.BMP
                case bilda_&[numa&] = 8 :name$= astart$+\bilder\bild8.BMP
                case bilda_&[numa&] = 9 :name$= astart$+\bilder\bild9.BMP
                case bilda_&[numa&] = 10:name$= astart$+\bilder\bild10.BMP
                case bilda_&[numa&] = 11:name$= astart$+\bilder\bild11.BMP
                case bilda_&[numa&] = 12:name$= astart$+\bilder\bild12.BMP
                case bilda_&[numa&] = 13:name$= astart$+\bilder\bild13.BMP
                case bilda_&[numa&] = 14:name$= astart$+\bilder\bild14.BMP
                case bilda_&[numa&] = 15:name$= astart$+\bilder\bild15.BMP
                case bilda_&[numa&] = 16:name$= astart$+\bilder\bild16.BMP
                case bilda_&[numa&] = 17:name$= astart$+\bilder\bild17.BMP
                case bilda_&[numa&] = 18:name$= astart$+\bilder\bild18.BMP
                case bilda_&[numa&] = 19:name$= astart$+\bilder\bild19.BMP
                case bilda_&[numa&] = 20:name$= astart$+\bilder\bild20.BMP
                case bilda_&[numa&] = 21:name$= astart$+\bilder\bild21.BMP
                case bilda_&[numa&] = 22:name$= astart$+\bilder\bild22.BMP
                case bilda_&[numa&] = 23:name$= astart$+\bilder\bild23.BMP
                case bilda_&[numa&] = 24:name$= astart$+\bilder\bild24.BMP
                case bilda_&[numa&] = 25:name$= astart$+\bilder\bild25.BMP
                case bilda_&[numa&] = 26:name$= astart$+\bilder\bild26.BMP
                bild_&[numa&] = @Create(HPIC, -1, name$)
                Sendmessage(objekt_&[numa&],$172,0,bild_&[numa&])

            endif

            objekt&=numa&
            numa&=numa&+1

        wend

    endif

endproc

==============================================================================

proc speichern

    declare n$,numa&
    n$=@SaveFile$(Datei speichern,datei$)
    case n$=:return
    Hier wird Objektdatei erzeugt
    numa&=1
    dbuse(#10)

    whilenot numa& > objekt&

        case numa& > anzahl& : dbappendblank()
        case numa& > anzahl& : anzahl&=anzahl&+1
        dbgo(numa&)
        dbput(bild,str$(bilda_&[numa&]))
        dbput(was,oname_$[numa&])
        dbput(style,str$(style_&[numa&]))
        dbput(x,str$(xpos_1&[numa&]))
        dbput(y,str$(ypos_1&[numa&]))
        dbput(lang,str$(lang_&[numa&]))
        dbput(breit,str$(breit_&[numa&]))
        dbputrec(numa&)
        numa&=numa&+1

    wend

    speichern%=1

endproc

==========================================================

proc bearbeitbox

    Declare t$,n$
    Let t$=Dateifehler
    Let n$=Es ist keine Verknüpfung in Bearbeitung!
    MessageBox(n$,t$,48)

endproc

============================================================

proc laden

    balken
    declare f%,numa&
    f%=1
    case start%=1:speicherbox

    whilenot f% > objekt&

        destroywindow(objekt_&[f%])
        DeleteObject bild_&[f%]
        inc f%

    wend

    case start% = 1 : dbclose(#10)
    clear start%
    clear signal%
    clear runde%
    clear gerade%
    clear weiche%
    clear bm%
    clear winkel%
    clear objekt&
    odatei$ = @LoadFile$(ÖFFNE:,*.gpl)
    case odatei$= : return
    windowtitle Gleisplaner zur grafischen Verknüpfungserstellung   für : +odatei$+   GDL 2006
    datei$=odatei$
    f% = len(datei$)-4
    odatei$=left$(datei$,f%)
    clear name$

    whilenot mid$(odatei$,f%,1)=

        name$=mid$(odatei$,f%,1)+name$
        dec f%

    wend

    odatei$=name$

    if findfirst$(odatei$+.dbf)=odatei$+.dbf

        start%=1
        anzahl&=dbopen(#10,odatei$+.dbf)
        dbuse(#10)
        case anzahl&=0:return
        numa&=1

        whilenot numa& > anzahl&

            dbgo(numa&)
            style_&[numa&]=val(dbget$(style))
            xpos_1&[numa&]=val(dbget$(x))-xbalken%
            xpos_&[numa&]=val(dbget$(y))
            ypos_1&[numa&]=val(dbget$(y))-ybalken%
            ypos_&[numa&]=val(dbget$(y))
            breit_&[numa&]=val(dbget$(breit))
            lang_&[numa&]=val(dbget$(lang))
            oname_$[numa&]=dbget$(was)
            bilda_&[numa&]=val(dbget$(bild))
            objekt_&[numa&]=control(STATIC,,style_&[numa&],xpos_1&[numa&],ypos_1&[numa&],lang_&[numa&],breit_&[numa&],%hwnd,0,%hinstance,$0)
            name$=left$(oname_$[numa&],3)
            case name$=Ger:inc gerade%
            case name$=Bog:inc runde%
            case name$=Wei:inc weiche%
            case name$=Sig:inc signal%
            case name$=Win:inc winkel%
            case name$=BMe:inc bm%

            ifnot (name$ = Ger) or (bilda_&[numa&]< 3)

                case bilda_&[numa&] = 3 :name$= astart$+\bilder\bild3.BMP
                case bilda_&[numa&] = 4 :name$= astart$+\bilder\bild4.BMP
                case bilda_&[numa&] = 5 :name$= astart$+\bilder\bild5.BMP
                case bilda_&[numa&] = 6 :name$= astart$+\bilder\bild6.BMP
                case bilda_&[numa&] = 7 :name$= astart$+\bilder\bild7.BMP
                case bilda_&[numa&] = 8 :name$= astart$+\bilder\bild8.BMP
                case bilda_&[numa&] = 9 :name$= astart$+\bilder\bild9.BMP
                case bilda_&[numa&] = 10:name$= astart$+\bilder\bild10.BMP
                case bilda_&[numa&] = 11:name$= astart$+\bilder\bild11.BMP
                case bilda_&[numa&] = 12:name$= astart$+\bilder\bild12.BMP
                case bilda_&[numa&] = 13:name$= astart$+\bilder\bild13.BMP
                case bilda_&[numa&] = 14:name$= astart$+\bilder\bild14.BMP
                case bilda_&[numa&] = 15:name$= astart$+\bilder\bild15.BMP
                case bilda_&[numa&] = 16:name$= astart$+\bilder\bild16.BMP
                case bilda_&[numa&] = 17:name$= astart$+\bilder\bild17.BMP
                case bilda_&[numa&] = 18:name$= astart$+\bilder\bild18.BMP
                case bilda_&[numa&] = 19:name$= astart$+\bilder\bild19.BMP
                case bilda_&[numa&] = 20:name$= astart$+\bilder\bild20.BMP
                case bilda_&[numa&] = 21:name$= astart$+\bilder\bild21.BMP
                case bilda_&[numa&] = 22:name$= astart$+\bilder\bild22.BMP
                case bilda_&[numa&] = 23:name$= astart$+\bilder\bild23.BMP
                case bilda_&[numa&] = 24:name$= astart$+\bilder\bild24.BMP
                case bilda_&[numa&] = 25:name$= astart$+\bilder\bild25.BMP
                case bilda_&[numa&] = 26:name$= astart$+\bilder\bild26.BMP
                bild_&[numa&] = @Create(HPIC, -1, name$)
                Sendmessage(objekt_&[numa&],$172,0,bild_&[numa&])

            endif

            objekt&=numa&
            numa&=numa&+1

        wend

    else

        beep
        Declare t$,n$
        Let t$=Dateifehler
        Let n$=Eine bereits vorher bestandene .dbf Datei fehlt.
        Diese Verknüpfung kann nicht mehr bearbeitet
        werden.(ausser aus Backup rücksichern)
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        MessageBox(n$,t$,16)
        dbclose(#10)
        start%=0
        return

    endif

endproc

========================================================

proc neu

    declare f%
    f%=1
    case start%=1:speicherbox

    whilenot f% > objekt&

        destroywindow(objekt_&[f%])
        DeleteObject bild_&[f%]
        inc f%

    wend

    case start% = 1 : dbclose(#10)
    clear signal%
    clear runde%
    clear gerade%
    clear weiche%
    clear bm%
    clear objekt&
    clear taster%
    start%=1
    odatei$ = Input$(Name der Verknüpfung max. 8 Zeichen:, Neue Verknüpfung, test)
    datei$ = astart$+\+odatei$+.gpl

    if findfirst$(odatei$+.gpl) = odatei$+.gpl

        Declare t$,n$,aresult%
        Let t$=Dateifrage
        Let n$=Es existiert bereits so eine Verknüpfung.
        Soll diese überschrieben werden?
        aresult%=MessageBox(n$,t$,308)

        if aresult% = 6

            assign #1,datei$
            rewrite #1
            close #1
            dbcreate gleis.str > odatei$+.dbf

        else

            clear start%
            clear datei$
            clear odatei$
            speichern%=1
            windowtitle Gleisplaner zur grafischen Verknüpfungserstellung   für : +odatei$+   GDL 2006
            return

        endif

    else

        assign #1,datei$
        rewrite #1
        close #1
        dbcreate gleis.str > odatei$+.dbf

    endif

    windowtitle Gleisplaner zur grafischen Verknüpfungserstellung   für : +odatei$+   GDL 2006

    if findfirst$(odatei$+.dbf)=odatei$+.dbf

        anzahl&=dbopen(#10,odatei$+.dbf)
        dbuse(#10)

    else

        beep
        Declare t$,n$
        Let t$=Dateifehler
        Let n$=Eine bereits vorher bestandene .dbf Datei fehlt.
        Diese Verknüpfung kann nicht mehr bearbeitet
        werden.(ausser aus Backup rücksichern)
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        MessageBox(n$,t$,16)

    endif

endproc

==========================================================

proc thread.do

    parameters threadnr&
    clear result%

    if threadnr&=1

        textcolor rgb(200,001,241),getsyscolor(15)
        drawtext %maxx-120,%maxy-100,X Position : +right$((00+str$(%mousex)),3)
        drawtext %maxx-120,%maxy-80,Y Position : +right$((00+str$(%mousey)),3)

    elseif  threadnr&=2

    elseif  threadnr&=3

    elseif  threadnr&=4

    endif

endproc

================================================================================

Proc CheckMouse

    Parameters hw&,x%,y%,breite%[num%],hoehe%[num%]
    Dim rect#,16
    Dim rectpt#,8
    Long rect#,0=x%
    Long rect#,4=y%
    Long rect#,8=lang_&[num1&]
    Long rect#,12=breit_&[num1&]
    GetCursorPos(rectpt#)
    ScreenToClient(hw&,rectpt#)

    If Neq(PtInRect(rect#,Long(rectpt#,0),Long(rectpt#,4)),0)

        result%=1

    EndIf

    Dispose rect#
    Dispose rectpt#

EndProc

=====================================================================================

proc akamin

    num&=num&-1
    case num& < 1 : num& = 1
    settext kfenster&,oname_$[num&]

endproc

========================================================================

proc akaplus

    num&=num&+1
    case num& > objekt& : num& = objekt&
    settext kfenster&,oname_$[num&]

endproc

========================================================================

proc xaplus

    xpos_&[num&]=xpos_&[num&]+1
    xpos_1&[num&]=xpos_&[num&]+xbalken%
    destroywindow(objekt_&[num&])
    objekt_&[num&]=control(STATIC,,style_&[num&],xpos_&[num&],ypos_&[num&],lang_&[num&],breit_&[num&],%hwnd,0,%hinstance,$0)
    casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num&],$172,0,bild_&[num&])

endproc

================================================================

proc xamin

    xpos_&[num&]=xpos_&[num&]-1
    xpos_1&[num&]=xpos_&[num&]+xbalken%
    destroywindow(objekt_&[num&])
    objekt_&[num&]=control(STATIC,,style_&[num&],xpos_&[num&],ypos_&[num&],lang_&[num&],breit_&[num&],%hwnd,0,%hinstance,$0)
    casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num&],$172,0,bild_&[num&])

endproc

================================================================

proc yaplus

    ypos_&[num&]=ypos_&[num&]-1		Richtiges Koordinatensystem nutzen
    ypos_1&[num&]=ypos_&[num&]+ybalken%
    destroywindow(objekt_&[num&])
    objekt_&[num&]=control(STATIC,,style_&[num&],xpos_&[num&],ypos_&[num&],lang_&[num&],breit_&[num&],%hwnd,0,%hinstance,$0)
    casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num&],$172,0,bild_&[num&])

endproc

================================================================

proc yamin				Richtiges Koordinatensystem nutzen

    ypos_&[num&]=ypos_&[num&]+1
    ypos_1&[num&]=ypos_&[num&]+ybalken%
    destroywindow(objekt_&[num&])
    objekt_&[num&]=control(STATIC,,style_&[num&],xpos_&[num&],ypos_&[num&],lang_&[num&],breit_&[num&],%hwnd,0,%hinstance,$0)
    casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num&],$172,0,bild_&[num&])

endproc

================================================================

proc laplus

    ifnot left$(oname_$[num&],3)=Ger

        Declare t$,n$
        Let t$=Falsche Komponente
        Let n$=Aktion nur für Gerade gültig!
        MessageBox(n$,t$,64)
        return

    endif

    if vertikal_&[num&]=1

        Declare t$,n$
        Let t$=Falsche Komponente
        Let n$=Nur für horizontale Gerade
        MessageBox(n$,t$,64)
        return

    else

        lang_&[num&]=lang_&[num&]+1
        destroywindow(objekt_&[num&])
        objekt_&[num&]=control(STATIC,,style_&[num&],xpos_&[num&],ypos_&[num&],lang_&[num&],breit_&[num&],%hwnd,0,%hinstance,$0)
        casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num&],$172,0,bild_&[num&])

    endif

endproc

======================================================================

proc lamin

    ifnot left$(oname_$[num&],3)=Ger

        Declare t$,n$
        Let t$=Falsche Komponente
        Let n$=Aktion nur für Gerade gültig!
        MessageBox(n$,t$,64)
        return

    endif

    if vertikal_&[num&]=1

        Declare t$,n$
        Let t$=Falsche Komponente
        Let n$=Nur für horizontale Gerade
        MessageBox(n$,t$,64)
        return

    else

        lang_&[num&]=lang_&[num&]-1
        destroywindow(objekt_&[num&])
        objekt_&[num&]=control(STATIC,,style_&[num&],xpos_&[num&],ypos_&[num&],lang_&[num&],breit_&[num&],%hwnd,0,%hinstance,$0)
        casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num&],$172,0,bild_&[num&])

    endif

endproc

======================================================================

proc baplus

    ifnot left$(oname_$[num&],3)=Ger

        Declare t$,n$
        Let t$=Falsche Komponente
        Let n$=Aktion nur für Gerade gültig!
        MessageBox(n$,t$,64)
        return

    endif

    if vertikal_&[num&]=0

        Declare t$,n$
        Let t$=Falsche Komponente
        Let n$=Nur für vertikale Gerade
        MessageBox(n$,t$,64)
        return

    else

        breit_&[num&]=breit_&[num&]+1
        destroywindow(objekt_&[num&])
        objekt_&[num&]=control(STATIC,,style_&[num&],xpos_&[num&],ypos_&[num&],lang_&[num&],breit_&[num&],%hwnd,0,%hinstance,$0)
        casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num&],$172,0,bild_&[num&])

    endif

endproc

======================================================================

proc bamin

    ifnot left$(oname_$[num&],3)=Ger

        Declare t$,n$
        Let t$=Falsche Komponente
        Let n$=Aktion nur für Gerade gültig!
        MessageBox(n$,t$,64)
        return

    endif

    if vertikal_&[num&]=0

        Declare t$,n$
        Let t$=Falsche Komponente
        Let n$=Nur für vertikale Gerade
        MessageBox(n$,t$,64)
        return

    else

        breit_&[num&]=breit_&[num&]-1
        destroywindow(objekt_&[num&])
        objekt_&[num&]=control(STATIC,,style_&[num&],xpos_&[num&],ypos_&[num&],lang_&[num&],breit_&[num&],%hwnd,0,%hinstance,$0)
        casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num&],$172,0,bild_&[num&])

    endif

endproc

======================================================================

proc aktualisieren

    declare hj&
    balken
    hj&=1

    whilenot hj& > objekt&

        destroywindow(objekt_&[hj&])
        objekt_&[hj&]=control(STATIC,,style_&[hj&],xpos_1&[hj&]-xbalken%,ypos_1&[hj&]-ybalken%,lang_&[hj&],breit_&[hj&],%hwnd,0,%hinstance,$0)
        casenot left$(oname_$[hj&],3)=Ger:Sendmessage(objekt_&[hj&],$172,0,bild_&[hj&])
        hj&=hj&+1

    wend

endproc

=================================================================
leiste
clear gerade%
clear objekt&
clear start%
clear speichern%

whilenot ende%

    thread.start 1,1					Mauskoordinaten anzeigen
    settimer 300
    waitinput
    killtimer
    thread.stop 1

    If %UMESSAGE=16

        case speichern%=0 : speicherbox
        case start% = 1 : dbclose(#10)
        ende% = 1

    ElseIf %KEY = 4

        SetWindowPos tbar& = 0, 0 - 0, 0; 0

    elseif menuitem(100)				Neue Datei

        neu

    elseif menuitem(200)

        laden

    elseif menuitem(300)				Datei speichern

        if start%=1

            speichern
            speichern%=1

        else

            bearbeitbox

        endif

    ElseIf MenuItem(400)				Programmende

        case speichern%=0 : speicherbox
        case start% = 1 : dbclose(#10)
        ende%=1

    elseif (menuitem(500)) or (clicked(ger1&))	Gerade horizontal

        gerhor

    elseif (menuitem(510)) or (clicked(ger2&))	Gerade vertikal

        gerver

    elseif (menuitem(600)) or (clicked(bog1&)) 	Bogen1

        bild%=1
        bogen

    elseif (menuitem(610)) or (clicked(bog2&))	Bogen2

        bild%=2
        bogen

    elseif (menuitem(620)) or (clicked(bog3&))	Bogen3

        bild%=3
        bogen

    elseif (menuitem(630)) or (clicked(bog4&))	Bogen4

        bild%=4
        bogen

    elseif menuitem(700)				Weiche o li

        horverbox
        bild%=1					horizontal
        case vertikal%=0:bild%=2		vertikal
        weiche
        clear vertikal%

    elseif clicked(wei1&)

        vertikal%=1:bild%=1
        weiche
        clear vertikal%

    elseif clicked(wei2&)

        vertikal%=0:bild%=2
        weiche
        clear vertikal%

    elseif menuitem(710)				Weiche o re

        horverbox
        bild%=3					horizontal
        case vertikal%=0:bild%=4		vertikal
        weiche
        clear vertikal%

    elseif clicked(wei3&)

        vertikal%=1:bild%=3
        weiche
        clear vertikal%

    elseif clicked(wei4&)

        vertikal%=0:bild%=4
        weiche
        clear vertikal%

    elseif menuitem(720)				Weiche u li

        horverbox
        bild%=5					horizontal
        case vertikal%=0:bild%=6		vertikal
        weiche
        clear vertikal%

    elseif clicked(wei5&)

        vertikal%=1:bild%=5
        weiche
        clear vertikal%

    elseif clicked(wei6&)

        vertikal%=0:bild%=6
        weiche
        clear vertikal%

    elseif menuitem(730)				Weiche u re

        horverbox
        bild%=7					horizontal
        case vertikal%=0:bild%=8		vertikal
        weiche
        clear vertikal%

    elseif clicked(wei7&)

        vertikal%=1:bild%=7
        weiche
        clear vertikal%

    elseif clicked(wei8&)

        vertikal%=0:bild%=8
        weiche
        clear vertikal%

    elseif menuitem(735)				Doppelkreuzweiche

        horverbox
        bild%=19				horizontal
        case vertikal%=0:bild%=20		vertikal
        weiche
        clear vertikal%

    elseif clicked(kw1&)

        vertikal%=1:bild%=19
        weiche
        clear vertikal%

    elseif clicked(kw2&)

        vertikal%=0:bild%=20
        weiche
        clear vertikal%

    elseif clicked(dwei&[1])

        bild%=21
        doppelweiche

    elseif clicked(dwei&[2])

        bild%=22
        doppelweiche

    elseif clicked(dwei&[3])

        bild%=23
        doppelweiche

    elseif clicked(dwei&[4])

        bild%=24
        doppelweiche

    elseif clicked(winkel&[1])

        bild%=1
        winkel

    elseif clicked(winkel&[2])

        bild%=2
        winkel

    elseif menuitem(740)				löschen

        loeschen

    elseif (menuitem(800)) or (clicked(sig1&))	Signal hor

        vertikal%=0
        signal

    elseif (menuitem(810)) or (clicked(sig2&))	Signal ver

        vertikal%=1
        signal

    elseif (menuitem(900)) or (clicked(ap&))	Abfragepunkt

        bild%=18
        bmelder

    elseif (menuitem(1000)) or (clicked(bm&))	Besetztmelder

        bild%=17
        bmelder

    elseif (menuitem(1100)) or (clicked(tas&))				Taster

        taster

    elseif CLICKED(akmin&)

        akamin

    elseif CLICKED(akplus&)

        akaplus

    elseif clicked(xplus&)

        xaplus

    elseif clicked(xmin&)

        xamin

    elseif clicked(yplus&)

        yaplus

    elseif clicked(ymin&)

        yamin

    elseif clicked(lplus&)

        laplus

    elseif clicked(lmin&)

        lamin

    elseif clicked(bplus&)

        baplus

    elseif clicked(bmin&)

        bamin

    elseif getfocus(xwert&)

        aktualisieren
        setfocus(%hwnd)

    elseif getfocus(ywert&)

        aktualisieren
        setfocus(%hwnd)

    endif

    num1&=1
    clear result%

    whilenot num1& > objekt&        Erzeugte Objekte abfragen

        x%=1
        y%=1
        CheckMouse objekt_&[num1&],x%,y%,lang_&[num1&],breit_&[num1&]

        If result% = 1

            settext kfenster&,oname_$[num1&]
            num&=num1&
            clear result%

            whilenot %Mousepressed = 0

                UseCursor 3
                destroywindow(objekt_&[num1&])
                num&=num1&
                settext kfenster&,oname_$[num1&]
                xpos_&[num1&]=%mousex
                ypos_&[num1&]=%mousey
                xpos_1&[num1&]=%mousex+xbalken%
                ypos_1&[num1&]=%mousey+ybalken%
                objekt_&[num1&]=control(STATIC,,style_&[num1&],xpos_&[num1&],ypos_&[num1&],lang_&[num1&],breit_&[num1&],%hwnd,0,%hinstance,$0)
                casenot left$(oname_$[num&],3)=Ger:Sendmessage(objekt_&[num1&],$172,0,bild_&[num1&])

            wend

            UseCursor 0

        Endif

        num1&=num1&+1

    wend

    if %MouseKey=2

        xn%=%mousex
        yn%=%mousey
        drawtext 10,%maxy-80,(aktuelle Erstellkoordinate: x +right$((00+str$(%mousex)),3)+  y  +right$((00+str$(%mousey)),3))

    endif

wend

****************2>**************************Aufräumen

whilenot num& > objekt&

    DeleteObject bild_&[num&]
    num&=num&+1

wend

SKCtrl_DeInitDll()        Farb DLL löschen
FreeDll hdll&
freedll dll&
dispose rtf#
dispose string#
dispose image#