Français
Comprend

Modellbahnsteuerung Ausschnitt

 
GDL 2006 Codeausschnitt aus Modellbahnsteuerung ++++++++++
++++++++++++++ de Débutant,tout autor simple gehalten et pour Débutant gedacht ++++
++++++++++++++ allez seulement avec Xprofan10 !!!!!!!!!!+++++++++++++++++++++++++++
KompilierenMarqueSéparation
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 effacer
FreeDll hdll&
freedll dll&
dispose rtf#
dispose string#
dispose image#
 
13.07.2006  
 



répondre


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

2.815 Views

Untitledvor 0 min.
Langer29.01.2022
p.specht22.07.2018
KJ24.07.2017
GDL12.09.2015
plus...

Themeninformationen

cet Thema hat 1 participant:

unbekannt (1x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie