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>**************************straighten up
whilenot num& > objekt&
DeleteObject bild_&[num&]
num&=num&+1
wend
SKCtrl_DeInitDll() Farb DLL delete
FreeDll hdll&
freedll dll&
dispose rtf#
dispose string#
dispose image#