Hi,
wished my toolbar.bmp, How in the Help 29.3.1 described, in my "Graphen.exe" einbetten.
The DOS-command are without Error Message run. (Bildschirmfoto)
into Source have I The byte-values of toolbar.bmp and prfrun32_toolbar.exe association.
If I The Graphen.exe in another directory starte becomes too a toolbar.bmp created. The toolbar.bmp is here now no gültige bitmap More.
Please writes time I here wrong make.
Vielen Thanks!
CompileMarkSeparation'######### 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='./../../Function-References/XProfan/elseif/'>ElseIf @ MenuItem(1000)
end% = 1
ElseIf @ MenuItem(9999)
end% = 1
EndIf
EndWhile
DeleteObject hBild&
'##### if einbetten of toolbar.bmp successful
'Assign #1, "toolbar.bmp"
'Erase #1
'#################################################
End
|
(464)
Deutsch
English
Français
Español
Italia
