¡Hola,
quería mi toolbar.bmp, como en el Ayuda 29.3.1 beschrieben, en mi "Graphen.exe" einbetten.
El DOS-Befehle son sin Fehlermeldung gelaufen. (Bildschirmfoto)
In el Quellcode Yo el Byte-Werte de toolbar.bmp y prfrun32_toolbar.exe eingegeben.
Wenn Yo el Graphen.exe en un otro Directorio starte se auch una toolbar.bmp producido. El toolbar.bmp es aber hier nun no gültige bitmap mehr.
Bitte schreibt veces Yo hier falso mache.
Vielen Dank!
KompilierenMarcaSeparación'######### Toolbar.BMP einbinden #################
Declare FileBuffer#
Dim FileBuffer#, 38202'Hier die Groesse toolbar.bmp
@set("filemode",0)'FileMode 0
Assign #1, "Graphen.EXE"'Hier der Name dises fertigen Programms
OpenRW #1
Seek #1, 1093946'Hier die Groesse von prfrun32_toolbar.exe
@BlockRead(#1, FileBuffer#, 0, 38202)
Close #1
Assign #1, "toolbar.bmp"'Hier der Name der bmp-datei
OpenRW #1
BlockWrite #1, FileBuffer#, 0, 38202
Close #1
Dispose FileBuffer#
'#################################################
Declare hToolBar&, hBild&, ende%
declare x%,x!,y!,xp!,yp!,yp2!,y2!
declare streck%,a%,b$[16]
declare maus%,Astreck%,streckcos%,Astreckcos%,strecktan%
declare hBMP&,hil&,nr%,fenster$,name$,erster%
declare aa%,wertaa%,aa$,hb%,ok%
Astreck%=100
streck%=100
streckcos%=100
Astreckcos%=100
strecktan%=100
maus%=0
mcls 1000,2000
proc drucken
startPRINT
if fenster$="parabel2"
parabel2
elseif fenster$="s2"
s2
elseif fenster$="c2"
c2
elseif fenster$="ta2"
ta2
endif
endPRINT
endproc
proc parabel'f(x)=x²
'f(x) = x²
color 1,15
locate 35,20
print "f(x) = x²"
'sleep 188
x!=-1.56
while 1.58>x!
let x!=x!+.008
let y2!=@sqr(x!)
let xp!=400+x!*streck%
let yp!=400+y!*streck%
let yp2!=300-y2!*streck%
setpixel xp!,yp2!,@rgb(55,55,255)
endwhile
endproc
proc parabel2'f(x)=x²
fenster$ = "parabel2"
'f(x) = x²
color 1,15
mcopybmp 0,0-810,610>0,50;0
locate 5,20
print "f(x) = x²"
'sleep 188()
line (-2),(-2)-(-3),(-3)
x!=-1.50
usepen 0,1,@rgb(10,10,250)
erster%=1
while 1.50>x!
let x!=x!+.008
let y2!=@sqr(x!)
let xp!=400+x!*100
let yp2!=300-y2!*100
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(55,55,255)
lineto xp!,yp2!
endwhile
endproc
proc s1'sinus
'f(x) = sin(x)
color 12,15
locate 36,20
print "f(x) = sin(x)"
'sleep 188
x!=-6.26
while 6.28>x!
let x!=x!+.015
let y2!=@sin(x!)
let xp!=400+x!*streck%
let yp2!=300+y2!*streck%
setpixel xp!,yp2!,@rgb(255,10,10)
endwhile
endproc
proc s2'sinus
maus%=0
Fenster$ ="s2"
'rectangle -10,500-810,610
'f(x) = sin(x)
color 12,15
mcopybmp 0,0-810,610>0,50;0
locate 6,20
print "f(x)=sin(x) "';streck%;" ";Astreck%
'sleep 188
usepen 0,1,@rgb(255,10,10)
let x!=(-36.26)
erster%=1
while 36.28>x!
let x!=x!+.015
let y2!=@sin(x!)
let xp!=400+x!*streck%
let yp2!=300+y2!*Astreck%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(255,10,10)
lineto xp!,yp2!
endwhile
endproc
proc c1'cosinus
'f(x) = cos(x)
color 2,15
locate 37,20
print "f(x) = cos(x)"
'sleep 188
x!=-6.26
while 6.28>x!
let x!=x!+.015
let y2!=@cos(x!)
let xp!=400+x!*streck%
let yp2!=300+y2!*streck%
setpixel xp!,yp2!,@rgb(1,155,1)
endwhile
endproc
proc c2'cosinus
fenster$="c2"
'f(x) = cos(x)
color 2,15
mcopybmp 0,0-810,610>0,50;0
locate 7,20
print "f(x) = cos(x)"
'sleep 188
usepen 0,1,@rgb(1,188,1)
x!=-36.26
erster%=1
while 36.28>x!
let x!=x!+.015
let y2!=@cos(x!)
let xp!=400+x!*streckcos%
let yp2!=300+y2!*Astreckcos%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(1,155,1)
lineto xp!,yp2!
endwhile
endproc
proc t1'tangens
'f(x) = tan(x)
color 0,15
locate 38,20
print "f(x) = tan(x)"
'sleep 188
x!=-1.16
while 1.16>x!
let x!=x!+.015
let y2!=@tan(x!)
let xp!=400+x!*streck%
let yp2!=300+y2!*50'streck%
setpixel xp!,yp2!,@rgb(0,0,0)
endwhile
endproc
proc ta2'tangens
fenster$="ta2"
'f(x) = tan(x)
color 11,15
mcopybmp 0,0-810,610>0,50;0
locate 8,20
print "f(x) = tan(x)"
'sleep 188
'line (-2),(-2)-(-3),(-3)
usepen 0,1,@rgb(255,10,200)
x!=-1.06
erster%=1
while 1.06>x!
let x!=x!+.015
let y2!=@tan(x!)
let xp!=400+x!*strecktan%
let yp2!=300+y2!*140'streck%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
lineto xp!,yp2!
endwhile
endproc
proc cota1'cotangens
fenster$="ta2"
'f(x) = cot(x)
color 5,15
'mcopybmp 0,0-810,610>0,50;0
locate 39,20
print "f(x) = cot(x)"
'sleep 188
'line (-2),(-2)-(-3),(-3)
usepen 0,1,@rgb(64,128,128)
x!=-1.56
erster%=1
while -0.56>x!
let x!=x!+.015
let y2!=@cot(x!)
let xp!=400+x!*strecktan%
let yp2!=300+y2!*140'streck%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
lineto xp!,yp2!
endwhile
x!=0.56
erster%=1
while 1.56>x!
let x!=x!+.015
let y2!=@cot(x!)
let xp!=400+x!*strecktan%
let yp2!=300+y2!*140'streck%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
lineto xp!,yp2!
endwhile
endproc
proc cota2'cotangens
fenster$="ta2"
'f(x) = cot(x)
color 5,15
mcopybmp 0,0-810,610>0,50;0
locate 8,20
print "f(x) = cot(x)"
'sleep 188
'line (-2),(-2)-(-3),(-3)
usepen 0,1,@rgb(64,128,128)
x!=-1.56
erster%=1
while -0.56>x!
let x!=x!+.015
let y2!=@cot(x!)
let xp!=400+x!*strecktan%
let yp2!=300+y2!*140'streck%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
lineto xp!,yp2!
endwhile
x!=0.56
erster%=1
while 1.56>x!
let x!=x!+.015
let y2!=@cot(x!)
let xp!=400+x!*strecktan%
let yp2!=300+y2!*140'streck%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
lineto xp!,yp2!
endwhile
endproc
proc diagramm
cls @rgb(252,252,252)
UsePen 0,1,@RGB(222,222,222)
whileloop 80
line &loop*20,0-&loop*20,660
endwhile
whileloop 60
line 0,&loop*20-860,&loop*20
endwhile
UsePen 0,1,@RGB(33,33,33)
line 0,300-800,300
line -1,300-11,304
line -1,300-11,296
line 790,296-801,300
lineto 790,304
line 400,60-400,600
line 396,71-400,61
lineto 404,71
line 396,590-400,601
lineto 404,590
whileloop 50,550,50
line 398,&loop-402,&loop
endwhile
whileloop 50,750,50
line &loop,298-&loop,302
endwhile
'rectangle 125,425-300,510
locate 4,49
print "y"
locate 25,102
print "x"
usefont "arial",12,9,0,0,0
TextColor @RGB(111,111,111),-1
clear a%
whileloop 11
a%=a%+50
drawtext 404,a%,b$[&loop+2]
endwhile
a%=761
whileloop 13
a%=a%-51
drawtext a%,300,b$[&loop+1]
endwhile
copyBMPtoMem 0,50-810,610>0,0
endproc
proc diagramm2
cls @rgb(2,62,2)
UsePen 0,1,@RGB(22,22,22)
whileloop 80
line &loop*20,0-&loop*20,660
endwhile
whileloop 60
line 0,&loop*20-860,&loop*20
endwhile
UsePen 0,1,@RGB(33,33,33)
line 0,300-800,300
line -1,300-11,304
line -1,300-11,296
line 790,296-801,300
lineto 790,304
line 400,60-400,600
line 396,71-400,61
lineto 404,71
line 396,590-400,601
lineto 404,590
whileloop 50,550,50
line 398,&loop-402,&loop
endwhile
whileloop 50,750,50
line &loop,298-&loop,302
endwhile
'rectangle 125,425-300,510
'locate 4,49
'print "y"
locate 48,88
print "-time->"
usefont "arial",12,9,0,0,0
TextColor @RGB(111,111,111),-1
'clear a%
'whileloop 11
' a%=a%+50
' drawtext 404,a%,b$[&loop+2]
'endwhile
'a%=761
'whileloop 13
' a%=a%-51
' drawtext a%,300,b$[&loop+1]
'endwhile
'copyBMPtoMem 0,50-810,610>0,0
endproc
proc beschriftung
b$[0]="4,0"
b$[1]="3,5"
b$[2]="3,0"
b$[3]="2,5"
b$[4]="2,0"
b$[5]="1,5"
b$[6]="1,0"
b$[7]="0,5"
b$[8]="0,0"
b$[9]="-0,5"
b$[10]="-1,0"
b$[11]="-1,5"
b$[12]="-2,0"
b$[13]="-2,5"
b$[14]="-3,0"
endproc
PROC Mail
@MessageBox("mail an mich ... einbauen ","Heiko Dix - Funktionen darstellen",64)
ENDPROC
PROC www
SHELL "C:\Programme\Internet Explorer\IEXPLORE.EXE www.dixheiko.de/exe"
ENDPROC
proc heiko
@messagebox("programiert mit RGH Profan² im Jahr 2000\nwww.profan.de\nüberarbeitet 2011 mit XProfan 11.2\nwww.xprofan.de www.xprofan.com\nverwendet wurde XPofed 2.2 für XProfan 11.2 \nund die Hilfe von XProfan\n\nnach einer Basic-Vorlage aus BASIC für Anfänger\nPlotten von Sinusfunktionen\nvon Peter Fischer Verlag Die Wirtschaft "+chr$(169)+" 1987\n\n© 2011 Heiko Dix - Thüringen","©-Infos",0)
endproc
PROC ohnefunktion
@messagebox("Bitte im Menu klicken","INFO",0)
'Mausklick ausserhalb vom Menu ignorieren
ENDPROC
proc startbild
beschriftung
diagramm
s1
c1
t1
parabel
cota1
endproc
proc formel_A_MAL_SIN_X
'f(x) = sin(x)
color 14,0
mcopybmp 0,0-810,610>0,50;0
locate 36,20
print "f(x) = sin(";aa%;" * x)"
'sleep 188
usepen 0,1,@rgb(123,45,123)
erster%=1
x!=-6.26
while 6.28>x!
let x!=x!+.015
let y2!=@sin(aa%*x!)
let xp!=400+x!*100
let yp2!=300+y2!*100
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(255,10,10)
lineto xp!,yp2!
endwhile
endproc
proc formel_x_hoch_2_minus_x_hoch_zwei_und_x
'f(x) = sin(x)
color 1,15
mcopybmp 0,0-810,610>0,50;0
locate 09,5
print "Funktionen "
locate 10,5
color 4,15
print "x^2"
locate 11,5
color 2,15
print "2-x^2"
locate 12,5
color 1,15
print "x"
'sleep 188
usepen 0,1,@rgb(123,45,45)
erster%=1
x!=-2.26
while 2.28>x!
let x!=x!+.015
let y2!=(x!*x!)
let xp!=400+x!*100
let yp2!=300+y2!*100
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(255,10,10)
lineto xp!,yp2!
endwhile
usepen 0,1,@rgb(45,123,45)
erster%=1
x!=-2.11
while 2.05>x!
let x!=x!+.045
let y2!=(2-x!*x!)
let xp!=400+x!*streck%
let yp2!=300+y2!*streck%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(255,10,10)
lineto xp!,yp2!
endwhile
usepen 0,1,@rgb(45,45,123)
erster%=1
x!=-2.26
while 2.28>x!
let x!=x!+.015
let y2!=(x!)
let xp!=400+x!*streck%
let yp2!=300+y2!*streck%
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(255,10,10)
lineto xp!,yp2!
endwhile
endproc
Proc Werta
wertaa% = @Create("window",%HWnd,"Werte eingeben ",150,150,240,250)
@create("text",wertaa%,"Bitte einen Wert für A eingeben!",10,10,550,20)
@create("text",wertaa%,"f(x) = sin( A * x)",10,40,200,24)
aa% = @Create("Edit",wertaa%,"",10, 70,50,24)
hB% = @Create("Button",wertaa%,"&OK",10,100,100,25)
@SetFocus(aa%)
clear OK%
WhileNot Ok%
If @GetFocus(hB%)'ok wurde angeklickt
Ok% = 1
EndIf
endwhile
aa$ = @GetText$(aa%)
aa% = @val(aa$)
if aa%<=0
aa%=1
endif
@DestroyWindow(wertaa%)
endproc
proc formel_sin10x_sin9x'f(x) = sin(10 x) + sin (9 x)
'f(x) = sin(x)
color 14,0
mcopybmp 0,0-810,610>0,50;0
locate 36,20
print "f(x) = sin(10*x)+sin(9*x) Streckung=";streck%
'sleep 188
usepen 0,1,@rgb(123,45,123)
erster%=1
x!=-6.26
while 6.28>x!
let x!=x!+.015
let y2!=@sin(10*x!)+@sin(9*x!)
let xp!=400+x!*100
let yp2!=300+y2!*100
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(255,10,10)
lineto xp!,yp2!
endwhile
endproc
proc formel_x_sin1_x''x sin(1/x)
'f(x) = sin(x)
color 14,0
mcopybmp 0,0-810,610>0,50;0
locate 36,20
print "f(x)=x*sin(1/x)"
'sleep 188
usepen 0,1,@rgb(123,45,123)
erster%=1
x!=-6.26
while 6.28>x!
let x!=x!+.015
let y2!=x!*sin(1/x!)
let xp!=400+x!*100
let yp2!=300+y2!*100
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
'setpixel xp!,yp2!,@rgb(255,10,10)
lineto xp!,yp2!
endwhile
endproc
proc sim_herz''1/(x^5 - 5*x - 1)
'f(x) = sin(x)
color 1,15
'mcopybmp 0,0-810,610>0,50;0
diagramm2
locate 48,14
print "f(x)=1/(x^5 - 5*x - 1)"
'sleep 188
locate 10,5
usepen 0,1,@rgb(15,15,255)
whileloop 5
'locate 10,5
'print "Lauf:";int(10-&loop)
usepen 0,1,@rgb(111,255,111)
erster%=1
x!=-2.00
SOUND 900,166
'SOUND 840,220
while 2.00>x!
let y2!=1/(x!*x!*x!*x!*x!-5*x!-1)
let xp!=400+x!*100
let yp2!=450+y2!*10
if erster%=1
setpixel xp!,yp2!,@rgb(0,0,0)
line xP!,yp2!-(xp!+1),yp2!
erster%=99
endif
usepen 0,1,@rgb(111,255,111)
lineto xp!,yp2!
usepen 0,1,@rgb(222,222,222)
chord xp!,yp2!-(xp!+5),(yp2!+5);(xp!+1),(yp2!+1);(xp!+1),(yp2!+1)
let x!=x!+.015
whileloop 5555
endwhile
usepen 0,1,@rgb(2,62,2)
chord xp!,yp2!-(xp!+5),(yp2!+5);(xp!+1),(yp2!+1);(xp!+1),(yp2!+1)
'lineto xp!,yp2!
endwhile
endwhile
SOUND 840,36
cls @rgb(2,62,2)
usepen 0,1,@rgb(111,255,111)
line 220,450-680,450
sound 150,460
endproc
proc mainmenu1
PopUp "Datei "
separator
AppendMenu 1000,"Ende"
separator
AppendMenu 1020,"Bild speichern"
AppendMenu 1025,"Bild kopieren"
separator
appendmenubar 2000,"Sinus "
appendmenubar 3000,"Cosinus "
appendmenubar 4000,"Tangens"
appendmenubar 4400,"Cotangens"
appendmenubar 5000,"Parabel"
popup "andere Funktionen"
appendmenu 6010,"f(x)=sin(a*x)"
separator
appendmenu 6020,"f(x)=x^2 f(x)=-x^2 f(x)=x"
appendmenu 6030,"f(x)=sin(10*x)+sin(9*x)"
appendmenu 6040,"f(x)=x*sin(1/x)"
separator
appendmenu 6050,"Simulation Herzfrequenz"
popup "Kontakt"
AppendMenu 8010,"www.dixheiko.de"
AppendMenu 8020,"E-Mail"'muß noch ein parameter finden der "neue mail" aufmacht :-(
AppendMenubar 7000,"©"
hBild& = @Create("HPIC", -1, "toolbar.bmp")
hToolbar& = @Create("TOOLBAR", %hWnd, hBild&, 0, 32, 2000, 0)
@Toolbar("AddButton", hToolBar&, 0, 1020, "Bild speichern")
@Toolbar("AddButton", hToolBar&, 1, 1040, "Bild kopieren")
@Toolbar("Separator", hToolbar&)
@Toolbar("AddButton", hToolBar&, 2, 2001, "Frequenz -")
@Toolbar("AddButton", hToolBar&, 3, 2002, "Frequenz +")
@Toolbar("AddButton", hToolBar&, 4, 2003, "Amplitude -")
@Toolbar("AddButton", hToolBar&, 5, 2004, "Amplitude +")
@Toolbar("AddButton", hToolBar&, 6, 3001, "Frequenz -")
@Toolbar("AddButton", hToolBar&, 7, 3002, "Frequenz +")
@Toolbar("AddButton", hToolBar&, 8, 3003, "Amplitude +")
@Toolbar("AddButton", hToolBar&, 9, 3004, "Amplitude +")
whileloop 45
@Toolbar("Separator", hToolbar&)
endwhile
@Toolbar("AddButton", hToolBar&,11, 9999, "Beenden")
endproc
windowtitle "Darstellen von Funktionen mit XProfan"
WindowStyle 16'63
window 810,700
startbild
mainmenu1
WhileNot ende%
WaitInput
If %KEY = 2
ende% = 1
ElseIf %KEY = 4
'SetWindowPos hToolbar& = 0, 0 - 0, 0; 0
ElseIf @MenuItem(1020)
name$=@savefile$("Bild speichern","neu.bmp")
if name$<>""
savebmp name$,0,60-800,565
endif
ElseIf @MenuItem(1040)
SaveBMPtoClip 0,60-800,565
ElseIf @MenuItem(1100)
Startbild
ElseIf @MenuItem(2000)
s2
ElseIf @MenuItem(2001)
streck%=streck%+5
if streck%>130
streck%=130
beep
endif
s2
ElseIf @MenuItem(2002)
streck%=streck%-5
if streck%<0
streck%=0
beep
endif
s2
ElseIf @MenuItem(2003)
Astreck%=Astreck%-10
if Astreck%<1
Astreck%=1
beep
endif
s2
ElseIf @MenuItem(2004)
Astreck%=Astreck%+10
if Astreck%>250
Astreck%=250
beep
endif
s2
ElseIf @MenuItem(3000)
c2
ElseIf @MenuItem(3001)
streckcos%=streckcos%+5
if streckcos%>130
streckcos%=130
beep
endif
c2
ElseIf @MenuItem(3002)
streckcos%=streckcos%-5
if streckcos%<0
streckcos%=0
beep
endif
c2
Elseif @menuitem(3003)
Astreckcos%=Astreckcos%-10
if Astreckcos%<1
Astreckcos%=1
beep
endif
c2
Elseif @menuitem(3004)
Astreckcos%=Astreckcos%+10
if Astreckcos%>250
Astreckcos%=250
beep
endif
c2
ElseIf @menuitem(4000)
ta2
ElseIf @menuitem(4400)
cota2
ElseIf @menuitem(5000)
parabel2
ElseIf @menuitem(6010)
werta
formel_a_mal_sin_x
ElseIf @menuitem(6020)
formel_x_hoch_2_minus_x_hoch_zwei_und_x
ElseIf @menuitem(6030)
formel_sin10x_sin9x
ElseIf @menuitem(6040)
formel_x_sin1_x
ElseIf @menuitem(6050)
sim_herz
ElseIf @menuitem(7000)
heiko
ElseIf @menuitem(8010)
www
ElseIf @menuitem(8020)
Mail
ass=s4 href='./../../funktionsreferenzen/XProfan/elseif/'>ElseIf @ MenuItem(1000)
ende% = 1
ElseIf @ MenuItem(9999)
ende% = 1
EndIf
EndWhile
DeleteObject hBild&
'##### si einbetten de toolbar.bmp erfolgreich
'Asignar #1, "toolbar.bmp"
'Borrar #1
'#################################################
End
|
(169)
Deutsch
English
Français
Español
Italia
