Unit Windows;{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º T E C H N I S C H E U N I V E R S I T Ž T C H E M N I T Z º
º º
º Programm zur Ansteuerung des AD/DA-Wandlermoduls mit Einchip- º
º rechner 68HC11 º
º º
º UNIT Graphische Benutzeroberfl„che º
º º
º Programmierer: Torsten Levin º
º 03 AET 89 º
º TU Chemnitz-Zwickau º
º º
º Chemnitz, Januar-April 1993 º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
Katastrophe leider nur unvollst„ndig �berarbeitet, h#s 12/02}
INTERFACE
uses WinDos,Strings,Crt,Graph,dos,maus,image,bss,LW_Test,AutoGraf;
Const
Urheber = 'U/!Mfwjo'; { Name des Urhebers }
MaxWin=4; { Maximalanzahl der gleichzeitig offenen Fenster }
Alt:Array['A'..'Z'] of byte=(30,48,46,32,18,33,34,35,23,
36,37,38,50,49,24,25,16,19,31,20,22,47,17,45,44,21);
{ Scancode-Zuordnung (deutsche Tastatur!) }
Sanduhr: array[0..31] of Word=(
$FFFF,$C001,$E003,$E003,$E003,$F007,$F80F,$FC1F,
$FC1F,$FC1F,$F80F,$F007,$E003,$E003,$E003,$C001,
$0000,$0000,$07F0,$07F0,$07F0,$02A0,$0140,$0080,
$0080,$0080,$0140,$03E0,$0770,$06B0,$0550,$0000);
Sanduhr_Hotspot_X=8;
Sanduhr_Hotspot_Y=8;
{************* Liste der im Selbsttest gepr�ften Dateien **************}
Dateienliste:array[0..18] of PChar=(
'SETUP.EXE','!!!.PIC','ADU.PIC','COPY.PIC',
'DAU.PIC','DRUCK.PIC','LESE.PIC','NOPARK.PIC',
'SANDUHR.PIC','SCHREIBE.PIC','STOP.PIC',
'STOPUHR.PIC','AD_DIR.REC','AD_PROG.REC',
'DA_DIR.REC','DA_PROG.REC','EMPF_DAT.REC',
'SEND_DAT.REC','AD_DA.PIC');
{***********************************************************************}
Farben : Array[1..12] of PChar=(
'Fenster-Hintergrund',
'Men�-Hintergrund',
'Fenster-Vordergrund',
'Men�-Vordergrund',
'Warnung-Hintergrund',
'Warnung-Vordergrund',
'Schalter-Lichtseite',
'Schalter-Schattenseite',
'Kurve 1',
'Kurve 2',
'Kurve 3',
'Kurve 4');
Type Ext = String[3];
Titelstr = String[20];
{ Auswahlfeld = Array[1..8] of String[10];}
{Achtung die folgenden Typen geh”ren nicht zur WINDOWS-Unit, genauso wie
Variablen dieses Typs. Sie stehen nur hier, da sie als Optionen mit
gesichert werden sollen. Sie sind also gegebenenfalls im "Datentyp" und
im "INIT" wieder zu l”schen.}
{***********************************************************************}
Kanaltyp = Array[0..7] of Boolean;
Betriebstyp = (Einmalig,Zyklisch);
InstTyp = Record
LPT,COM : Byte;
End;
{***********************************************************************}
type
ColorPal=array[1..12] of Byte;
DatenTyp=Record
on : boolean;
ver,nr : byte;
text : string[30];
sterne, speed : integer;
Color : ColorPal;
Pause : Word;
KanalNr : Kanaltyp;
BetriebNr : Betriebstyp;
SStellen,Urate : Real; {von Datei - igitt!}
BildDatenNr : Integer;
End;
var
Daten : DatenTyp;
type
TSubMenu=record
name: PChar;
last:Integer;
item: array[0..5] of PChar;
end;
Var
ta: Char; {ASCII-Code der Taste}
tahi: Byte; {Scan-Code falls ta=#0}
mx,my,mb : Integer; {Maus-Position und -Kn”pfe}
xmerk,ymerk : Integer;
MausAvail: Boolean;
p : array[1..MaxWin] of pointer;
size : array[1..MaxWin] of word;
koord : array[1..MaxWin,1..4] of integer;
wincounter : Integer;
Inst : InstTyp;
ProgDir: array[0..63] of Char;
Procedure Schalter(x,y:integer;gesetzt:boolean);
Procedure Knopf(x1,y1,x2,y2:integer;const text:string;HGFarbe,Textfarbe:Byte);
Procedure PressKnopf(x1,y1,x2,y2:integer);
Procedure BackKnopf(x1,y1,x2,y2:integer);
Procedure Eingabe;
Procedure Eingabe2;
Procedure Clearscreen(const Titel,Copyright:String);
function MenuInput(Menu:array of TSubMenu):Word;
Procedure Openwindow(x1,y1,x2,y2,HGColor,VGColor:Integer;
const titel:String;top:boolean);
Procedure Openwindow2(x,y,w,h,HGi,VGi:Integer;
const titel:String;top:boolean);
Procedure CloseWindow;
procedure CloseStatus;
function Dateifenster(const Filter,Titel:String;Load:Boolean;
X,Y:Integer;Var Dateiname:String):Boolean;
function Sicherheitsfenster(X,Y:Integer;const Zeile1,Zeile2,Zeile3:Titelstr):Boolean;
Procedure Copyright(const Programm,Version,Jahr,Firma:String);
Procedure Status(X,Y:Integer;const Zeile1,Zeile2,Zeile3,Zeile4:String);
Procedure Fehler(X,Y:Integer;Was:Boolean;const Zeile1,Zeile2,Zeile3,Zeile4:String);
Procedure Hinweis(X,Y:Integer;const Zeile1,Zeile2,Zeile3,Zeile4:String);
Procedure Dosshell(const Text:String);
function Dateifehler(X,Y:Integer;Error:byte):Boolean;
Procedure Selftest(Dateien:array of PChar);
Procedure BSSMenue;
function Auswahl(X,Y:Integer;const Titel:String;
Texte:array of PChar; Var Nr:Integer):Boolean;
function Farbwahl(X,Y:Integer):Boolean;
Procedure StatusZeile(Text:String);
function Edit(X,Y:Integer;const Titel:Titelstr;Max,Typ:Byte;
const Komm1,Komm2,Komm3:String;Var Text:String):Boolean;
function MausTest:Boolean;
procedure Beep(freq,dur:Word);
procedure pOutTextXY(x,y:Integer; s:PChar);
function pTextWidth(s:PChar):Word;
procedure RightTextXY(x,y:Integer; const s:String);
procedure CenterTextXY(x,y:Integer; const s:String);
function MausKnopf(x,y,w,h:Integer):Boolean;
function MausInRect(x,y,w,h:Integer):Boolean;
function Hit(c:Char; x,y,w,h:Integer):Boolean;
Procedure Knopf2(x,y,w,h:integer;const text:string;HGFarbe,Textfarbe:Integer);
procedure WaitMouseRelease;
procedure pressknopf2(x,y,w,h:Integer; press:Boolean);
function Taste:Boolean;
procedure OutTextUL(x,y:Integer;s:PChar);
procedure SetWaitCursor(wait:Boolean);
IMPLEMENTATION
procedure pressknopf2(x,y,w,h:Integer; press:Boolean);
begin
if press then pressknopf(x,y,x+w,y+h) else backknopf(x,y,x+w,y+h);
end;
Procedure Knopf2(x,y,w,h:integer;const text:string;HGFarbe,Textfarbe:Integer);
var
t2:string;
amp: Integer;
begin
t2:=text;
amp:=Pos('&',t2);
if amp<>0 then begin
Delete(t2,amp,1);
end;
Knopf(x,y,x+w,y+h,t2,Daten.color[HgFarbe],Daten.color[Textfarbe]);
if amp<>0 then begin
OutTextXY(x+(w-TextWidth(t2)) div 2+TextWidth(Copy(t2,1,amp-1))-1,
y+(h-TextHeight(t2))div 2+2,'_');
end;
end;
function Hit(c:Char; x,y,w,h:Integer):Boolean;
begin
Hit:=false;
if (c<>#0) and (Upcase(ta)=c)
or (c in [LOW(Alt)..HIGH(Alt)]) and (ta=#0) and (tahi=Alt[c])
or (mb<>0) and MausInRect(x,y,w,h) then begin
Hit:=MausKnopf(x,y,w,h);
end;
end;
function MausInRect(x,y,w,h:Integer):Boolean;
begin
MausInRect:=(Word(mx-x)<Word(w)) and (Word(my-y)<Word(h));
end;
procedure WaitMouseRelease;
begin
repeat
mauspos(mx,my,mb);
until mb=0;
end;
function MausKnopf(x,y,w,h:Integer):Boolean;
{Liefert FALSE, wenn Maus das Knopfrechteck verlassen hat}
var
inside:Boolean;
begin
pressknopf2(x,y,w,h,true);
showmaus;
if mb<>0 then begin
inside:=true;
repeat
mauspos(mx,my,mb);
if MausInRect(x,y,w,h)<>inside then begin
inside:=not inside;
hidemaus;
pressknopf2(x,y,w,h,inside);
showmaus;
end;
until mb=0;
Mausknopf:=inside;
end else begin
delay(200); {bei Tastaturbedienung fehlt WM_KeyUp}
Mausknopf:=true;
end;
hidemaus;
pressknopf2(x,y,w,h,false);
end;
procedure CenterTextXY(x,y:Integer; const s:String);
var
TS:TextSettingsType;
begin
GetTextSettings(TS);
SetTextJustify(CenterText,TS.Vert);
OutTextXY(x,y,s);
SetTextJustify(TS.Horiz,TS.Vert);
end;
procedure RightTextXY(x,y:Integer; const s:String);
var
TS:TextSettingsType;
begin
GetTextSettings(TS);
SetTextJustify(RightText,TS.Vert);
OutTextXY(x,y,s);
SetTextJustify(TS.Horiz,TS.Vert);
end;
function pTextWidth(s:PChar):Word;
begin
pTextWidth:=TextWidth(StrPas(s));
end;
procedure pOutTextXY(x,y:Integer; s:PChar);
begin
OutTextXY(x,y,StrPas(s));
end;
procedure Beep(freq,dur:Word);
begin
sound(freq);
delay(dur);
nosound;
end;
{---Schalter---------------------------------------------------------}
Procedure Schalter(x,y:integer;gesetzt:boolean);
begin
backknopf(x,y,x+12,y+12);
if gesetzt then setcolor(Daten.Color[3]) else setcolor(Daten.Color[1]);
line(x+3,y+3,x+9,y+9);
line(x+9,y+3,x+3,y+9);
end;
{---Knopf------------------------------------------------------------}
Procedure Knopf(x1,y1,x2,y2:integer;const text:string;HGFarbe,Textfarbe:Byte);
begin
setcolor(Daten.Color[7]);
line(x1,y1,x1,y2);
line(x1,y1,x2,y1);
setcolor(Daten.Color[8]);
line(x2,y1,x2,y2);
line(x1,y2,x2,y2);
setfillstyle(1,HGFarbe);
bar(x1+1,y1+1,x2-1,y2-1);
setcolor(TextFarbe);
settextstyle(0,0,1);
outtextxy((x1+x2-textwidth(text)) div 2,
(y1+y2-textheight(text))div 2,text);
end;
{---Knopf-dr�cken----------------------------------------------------}
Procedure PressKnopf(x1,y1,x2,y2:integer);
begin
setcolor(Daten.Color[8]);
line(x1,y1,x1,y2);
line(x1,y1,x2,y1);
setcolor(Daten.Color[7]);
line(x2,y1,x2,y2);
line(x1,y2,x2,y2);
end;
{---Knopf-loslassen--------------------------------------------------}
Procedure BackKnopf(x1,y1,x2,y2:integer);
begin
setcolor(Daten.Color[7]);
line(x1,y1,x1,y2);
line(x1,y1,x2,y1);
setcolor(Daten.Color[8]);
line(x2,y1,x2,y2);
line(x1,y2,x2,y2);
end;
{---Eingabe----------------------------------------------------------}
function Taste:Boolean;
begin
Taste:=false;
if keypressed then begin
ta:=readkey;
if ta=#0 then tahi:=Byte(readkey);
Taste:=true; {eine Tastatur-Nachricht}
end;
end;
function sub(a,b:Word):Word; {mit gewolltem Bereichs�berlauf!}
inline($5A/$58/$D029); {pop dx; pop ax; sub ax,dx}
Procedure Eingabe;
const
LastKeyDown:Word=0;
var
tic: Word;
timer: Word absolute $40:$6C;
mxm,mym,mbm: Integer;
begin
tic:=timer;
while keypressed do readkey;
ta:=chr(1); tahi:=0;
repeat
if mausavail then begin
mauspos(mxm,mym,mbm);
if (mbm<>mb) or (mxm<>mx) or (mym<>my) then begin
mx:=mxm; my:=mym;
if (mbm=0) and (mb=0) then tic:=timer {ohne Taste kein Interesse}
else begin
if (mbm<>0) and (mb=0) then begin {KeyDown}
if sub(timer,lastkeydown)<6
then mbm:=mbm or $80 {Doppelklick-Bit}
else lastkeydown:=timer;
end;
mb:=mbm; exit; {eine Maus-Žnderung}
end;
end;
end;
if Taste then exit;
until Daten.on and ((sub(timer,tic)>sqr(Daten.ver)*100)
or (mxm=639) and (mym=0));
darkness(Daten.nr,Daten.Text,Daten.Sterne,Daten.Speed);
End;
Procedure Eingabe2;
begin
if mausavail then showmaus;
eingabe;
if mausavail then hidemaus;
end;
{---Clearscreen------------------------------------------------------}
Procedure Clearscreen(const Titel,Copyright:String);
begin
{ mausxRange(0,639);
mausyrange(0,479);}
setmauspos(320,350);
setfillstyle(1,Daten.Color[1]);
bar(0,0,639,479);
knopf2(1,1,637,477,'',1,3);
knopf2(3,3,633,20,titel,2,4);
setcolor(Daten.Color[4]);
settextstyle(2,0,4);
Righttextxy(630,7,Copyright);
settextstyle(0,0,0);
pressknopf(3,25,636,45);
pressknopf(3,462,636,475);
end;
procedure OutTextUL(x,y:Integer;s:PChar);
{Ausgabe String, erstes Zeichen unterstrichen}
begin
pouttextxy(x,y,s);
outtextxy(x-1,y+2,'_');
end;
function Max(a,b:Integer):Integer; {Maximum ermitteln}
begin
if a>b then Max:=a else Max:=b;
end;
{---HauptFenster-----------------------------------------------------}
function MenuInput(Menu:array of TSubMenu):Word;
{Zeichnet und verwaltet das Men�}
Const
Freiraum2=10; {Freiraum links und rechts vom MenuBarItem}
Hauptfenster='Alt+Buchstabe f�r Men� Cursortasten f�r Auswahl Best„tigen mit >RETURN<';
Var
Range: array[0..9] of integer; { Range f�r Mausabfragen in der Men�zeile }
x,y: Integer;
last: Integer; {Kopie von Menu[x].last}
procedure DrawTitelzeileItem(i:Integer);
{zeichnet MenuBar-Item hervorgehoben oder auch nicht, je nach x}
var
fg,bg:Integer;
begin
if i<0 then exit;
fg:=3; bg:=1; {Vordergrund- und Hintergrund-Indizes}
if i=x then begin fg:=1; bg:=3; end;
setfillstyle(1,Daten.color[bg]);
bar(range[i],28,range[i+1],42);
SetColor(Daten.color[fg]);
OutTextUL(range[i]+Freiraum2,32,Menu[i].name);
end;
procedure SetY(NewY:Integer); forward;
procedure SetX(NewX:Integer);
{Setzt neuen MenuBar-Men�punkt; keine Hervorhebung f�r NewX<0}
var
OldX,OldY:Integer;
begin
if NewX=X then exit;
if NewX>HIGH(Menu) then exit; {falsches X ignorieren}
OldY:=Y; SetY(-2); {Bei Žnderung Sub-Men� entfernen}
OldX:=X; X:=NewX;
DrawTitelzeileItem(OldX);
DrawTitelzeileItem(NewX);
if NewX>=0 then begin
last:=Menu[x].last;
if OldY>=-1 then if mb<>0 then SetY(-1) else SetY(0);
end;
end;
var
left,width: Integer;
procedure DrawSubmenuItem(j:Integer);
{zeichnet SubMenu-Item hervorgehoben oder auch nicht, je nach y, an x}
var
fg,bg,py:Integer;
begin
if j<0 then exit;
fg:=3; bg:=1; {Vordergrund- und Hintergrund-Indizes}
if j=y then begin fg:=1; bg:=3; end;
py:=52+j*15; {Y-Position}
setfillstyle(1,Daten.color[bg]);
bar(left+10,py,left+30+width,py+13);
SetColor(Daten.color[fg]);
pouttextxy(left+20,py+2,Menu[x].item[j]);
end;
procedure SetY(NewY:Integer);
{Setzt neuen SubMenu-Men�punkt; kein Sub-Men�, wenn NewY<-1}
var
OldY,j:Integer;
begin
if NewY=Y then exit;
if x<0 then exit; {ohne Men�auswahl kein Submen�}
if NewY>last then exit; {falsches Y ignorieren}
OldY:=Y; Y:=NewY;
if OldY<-1 then begin
if NewY>=-1 then with Menu[x] do begin
left:=range[x];
width:=0;
for j:=0 to last do width:=Max(width,ptextwidth(item[j]));
openwindow(left,47,left+40+width,72+last*15,7,1,'',false);
for j:=0 to last do DrawSubmenuItem(j); {zun„chst 1. Punkt markiert}
end;
end else begin
if NewY<-1 then CloseWindow {Subfenster entfernen}
else begin
DrawSubmenuItem(OldY);
DrawSubmenuItem(NewY);
end;
end;
end;
Var
buttonstatus:Boolean;
j,position: Integer;
begin
x:=-1; y:=-2; {Nichts ausgew„hlt}
last:=-1; {šberl„ufe vermeiden}
{ if wincounter>0 then closewindow; {??}
setfillstyle(1,Daten.Color[1]);
bar(5,26,634,44);
SetColor(Daten.color[3]);
position:=Freiraum2;
for j:=0 to HIGH(Menu) do begin
range[j]:=position;
Inc(position,Freiraum2);
OutTextUL(position,32,Menu[j].name);
Inc(position,ptextwidth(Menu[j].name)+Freiraum2);
end;
range[HIGH(Menu)+1]:=position;
StatusZeile(Hauptfenster);
repeat
buttonstatus:=mb<>0; {Vorheriger Status (zum Loslassen erkennen)}
Eingabe2;
if mb<>0 then begin
for j:=0 to HIGH(Menu) do if MausInRect(
range[j],25,range[j+1]-range[j],20) then begin
SetX(j); {neuer Men�punkt}
SetY(-1); {neues Submen�, 1. Zeile NICHT markiert}
end;
if y>=-1 then begin {sichtbares Submen�?}
position:=-1;
for j:=0 to last do if MausInRect(left+5,50+j*15,30+width,15)
then position:=j;
SetY(position);
end;
end else if buttonstatus then begin {Maustaste losgelassen}
if MausInRect(left+5,50,30+width,15*(last+1)) and (Y>=0)
then break
else if MausInRect(5,26,629,18) then SetY(0)
else SetX(-1);
end;
case ta of
#0: begin
case tahi of
68: begin {F10 - wie Windows}
if X>=0 then SetX(-1) else SetX(0);
end;
72: {if x>=0 then} begin
if y=-2 then j:=0
else begin
j:=y-1; if j<0 then j:=last; {Cursor hoch}
end;
SetY(j);
end;
80: begin
if y=-2 then j:=0
else begin
j:=y+1; if j>last then j:=0; {Cursor runter}
end;
SetY(j);
end;
77: begin {Cursor rechts}
j:=x+1; if j>HIGH(Menu) then j:=0;
SetX(j);
end;
75: begin {Cursor links}
j:=x-1; if j<0 then j:=HIGH(Menu);
SetX(j);
end;
45,107: begin {Alt+X, Alt+F4 (wie Windows)}
SetX(0); SetY(5); break;
end;
end{case tahi};
for j:=0 to HIGH(Menu) do if tahi=alt[Menu[j].name[0]] then begin
SetX(j);
SetY(0);
end;
end;
#13,' ': if y>=0 then break else SetY(0); {Auswahl OK}
^X: begin {Abbruch-Hotkey}
SetX(0); SetY(5); break;
end;
#27: begin
if y>=-1 then SetY(-2) else SetX(-1);
end;
end{case ta};
until false;
MenuInput:=(x+1)shl 8 +y+1;
SetY(-2); {Pulldown entfernen, X stehen lassen}
end;
{---OpenWindow-------------------------------------------------------}
Procedure Openwindow(x1,y1,x2,y2,HGColor,VGColor:Integer;
const titel:String;top:boolean);
begin
if wincounter=MaxWin then halt(1)
else Inc(wincounter);
koord[wincounter,1]:=x1;
koord[wincounter,2]:=y1;
koord[wincounter,3]:=x2;
koord[wincounter,4]:=y2;
Size[wincounter]:=Imagesize(x1,y1,x2,y2);
Getmem(P[wincounter],Size[wincounter]);
Getimage(x1,y1,x2,y2,P[wincounter]^);
Setbkcolor(0);
knopf(x1,y1,x2,y2,'',Daten.Color[1],VGColor);
knopf(x1+1,y1+1,x2-1,y2-1,'',Daten.Color[1],VGColor);
if top then knopf(x1+3,y1+3,x2-3,y1+23,titel,HGColor,VGColor);
end;
Procedure Openwindow2(x,y,w,h,HGi,VGi:Integer;
const titel:String;top:boolean);
begin
OpenWindow(x,y,x+w,y+h,Daten.color[hgi],Daten.color[vgi],titel,top);
end;
{---CloseWindow-------------------------------------------------------}
Procedure CloseWindow;
begin
if wincounter=0 then halt(2);
putimage(koord[wincounter,1],koord[wincounter,2],P[wincounter]^,normalput);
Freemem(P[wincounter],Size[wincounter]);
wincounter:=wincounter-1;
end;
Procedure CloseStatus;
begin
SetWaitCursor(false);
CloseWindow;
end;
function FileAttr(const fname:String):Word;
var
f: file;
a: Word;
begin
{$I-}
Assign(f,fname);
GetFAttr(f,a);
if DosError<>0 then a:=$80; {Existiert-nicht-Bit}
FileAttr:=a;
end;
{---Dateiauswahlfenster----------------------------------------------}
function Dateifenster(const Filter,Titel:String; Load:Boolean;
X,Y:Integer;Var Dateiname:String):Boolean;
Const
Hauptfensterl=#27' '#26' Laufwerkwahl '#24#25+
' Dateiwahl >Return< OK >ESC< Abbruch';
Hauptfensters=#27' '#26' Laufwerkwahl '#24#25+
' Dateiwahl >N< Neue Datei >Return< OK >ESC< Abbruch';
NeueDatei='Eingabe des Dateinamens >Return< OK >ESC< Abbruch';
Var
position: Integer; {Selektierte Datei}
start : Integer; {Erste Datei im Fenster}
anzfiles: Integer; {Anzahl der Dateien}
dirstart: Integer; {Index f�r erstes Verzeichnis in Liste}
drives : array[0..7] of char;
anzdrivs: Integer; {letztes Element in drives[]}
driveindex: Integer;
pfad : String;
files: array[0..255] of String[13];
{---Unterprozedur---Laufwerk malen----------------}
Procedure Lw(x,y:Integer;Bez:Char);
Begin
knopf2(x,y,30,15,'',1,3);
setcolor(Daten.Color[3]);
line(x+12,y+7,x+26,y+7); {"Laufwerks-Schlitz"}
line(x+16,y+6,x+22,y+6);
line(x+16,y+8,x+22,y+8);
outtextxy(x+3,y+4,Bez);
End;
procedure SetStatuszeile;
begin
If load Then StatusZeile(Hauptfensterl) else StatusZeile(Hauptfensters);
end;
procedure ShowDateiname;
begin
setfillstyle(1,Daten.Color[1]);
bar(x+159,y+61,x+259,y+73);
setcolor(Daten.Color[3]);
outtextxy(x+161,y+64,Dateiname);
end;
procedure SetDateiname;
begin
if position>=dirstart
then Dateiname:=Filter
else Dateiname:=files[position];
ShowDateiname;
end;
{---Unterprozedur---Files ausgeben---------------}
procedure PutFile(zeile,index:Integer);
{Ausgabe mit Hervorhebung je nach <position>}
var
fg,bg:Integer;
begin
fg:=3; bg:=1;
if index=position then begin
fg:=1; bg:=3;
SetDateiname;
end;
SetFillStyle(1,Daten.Color[bg]);
bar(x+18,y+61+zeile*12,x+125,y+72+zeile*12);
if index>=anzfiles then exit;
SetColor(Daten.Color[fg]);
OutTextXY(x+20,y+63+zeile*12,files[index]);
end;
Procedure PutFiles;
{Ausgabe des Dateifensters - komplett - ab <start>}
Var zeile,index:Integer;
Begin
index:=start;
for zeile:=0 to 9 do begin
PutFile(zeile,index);
Inc(index);
end;
End;
{---Unterprozedur Roll-Balken-Position ausgeben----------------}
Procedure OutBar;
begin
setfillstyle(1,Daten.Color[1]);
bar(x+133,y+76,x+140,y+164);
setcolor(Daten.Color[3]);
if anzfiles>1
then outtextxy(x+133,y+76+(position*80)div (anzfiles-1),#177);
end;
{---Unterprozedur Pfad ausgeben------------------}
Procedure OutPfad(Outpfad:String);
begin
setfillstyle(1,Daten.Color[1]);
bar(x+11,y+187,x+297,y+199);
setcolor(Daten.Color[3]);
if length(Outpfad)>33 then
begin
delete(Outpfad,32,length(Outpfad)-31);
Outpfad:=Outpfad+'...';
end;
outtextxy(x+14,y+190,Outpfad);
end;
{---Unterprozedur---Files finden-----------------}
Procedure NewDir;
var
zaehler : Integer;
DirInfo : Searchrec;
ausgabepfad: string[63];
Begin
SetWaitCursor(true);
getdir(0,ausgabepfad); {kann dauern}
SetWaitCursor(false);
OutPfad(ausgabepfad);
zaehler:=LOW(Files);
setcolor(Daten.Color[3]);
SetWaitCursor(true); {FindFirst/Next kann dauern}
FindFirst(Filter, Archive, DirInfo);
while DosError=0 do begin
Files[zaehler]:=DirInfo.Name;
Inc(zaehler);
if zaehler>HIGH(Files) then break;
FindNext(DirInfo);
end;
dirstart:=zaehler;
if Length(ausgabepfad)>3 then begin
Files[zaehler]:='..\'; {Nicht jedes LW hat '.' und '..' !}
Inc(zaehler);
end;
if zaehler<=HIGH(Files) then begin
FindFirst('*.*',Directory, DirInfo);
while DosError=0 do begin
if (Dirinfo.attr and directory <>0)
and (Dirinfo.Name[1]<>'.') then begin
Files[zaehler]:= DirInfo.Name+'\';
inc(zaehler);
if zaehler>HIGH(Files) then break;
end;
FindNext(DirInfo);
end;
end;
anzfiles:=zaehler;
SetWaitCursor(false);
start:=0; position:=0;
Putfiles;
SetDateiname;
OutBar;
End;
procedure NewDrive(index:Integer);
begin
if driveindex>=0 then pressknopf2(x+20+driveindex*35,y+37,30,15,false);
driveindex:=index;
SetWaitCursor(true);
chdir(drives[index]+':'); {kann dauern}
SetWaitCursor(false);
pressknopf2(x+20+index*35,y+37,30,15,true);
NewDir;
end;
procedure ScrollFiles(index:Integer);
var
oldpos:Integer;
begin
if index>=anzfiles then index:=anzfiles-1;
if index<0 then index:=0;
if index=position then exit; {Flackern vermeiden}
oldpos:=position;
position:=index;
if Word(index-start)<10 then begin {Rollen nicht notwendig}
PutFile(oldpos-start,oldpos);
PutFile(index-start,index);
end else begin
if index<start then begin
start:=index;
PutFiles;
end else begin
start:=index-9; if start<0 then start:=0;
PutFiles;
end;
end;
SetDateiname;
OutBar;
end;
function HandleEnter:Boolean;
{liefert TRUE wenn Dateiname ausgew„hlt}
begin
HandleEnter:=true;
if Dateiname<>Filter then exit; {Datei ausgew„hlt}
HandleEnter:=false;
if anzfiles=0 then begin
Beep(500,100);
exit;
end;
delete(files[position],Length(files[position]),1);
chdir(files[position]);
NewDir;
end;
{---Dateifenster-----------------------------------------------------}
var
drv: Char;
i,j:Integer;
mousebefore:Boolean;
Begin
Dateifenster:=true;
SetStatuszeile;
Openwindow2(x,y,308,210,2,4,Titel,true);
Setbkcolor(0);
knopf2(x+208,y+150,90,20,'Abbruch',1,3);
knopf2(x+208,y+120,90,20,'OK',1,3);
if not load then knopf2(x+208,y+90,90,20,'&Neue Datei',1,3);
knopf2(x+129,y+60,15,15,'',1,3); {Pfeil hoch}
outtextxy(x+134,y+64,#24);
knopf2(x+129,y+165,15,15,'',1,3); {Pfeil runter}
outtextxy(x+134,y+169,#25);
setcolor(Daten.Color[3]);
line(x+141,y+75,x+141,y+164); {Begrenzung f�r Rollbalken}
line(x+132,y+75,x+132,y+164);
setfillstyle(1,Daten.Color[3]);
pressknopf2(x+158,y+60,102,14,true); {Rahmen f�r Dateiname/Filter}
pressknopf2(x+10,y+186,288,14,true); {Rahmen f�r (verk�rzten) Pfad}
pressknopf2(x+15,y+59,112,122,true); {Rahmen f�r Dateien}
getdir(0,pfad);
j:=LOW(drives); driveindex:=-1;
for drv:='A' to 'Z' do begin
If LW_exist(drv) Then Begin
drives[j]:=drv;
lw(x+20+j*35,y+37,drv);
if drv=pfad[1] then i:=j;
Inc(j);
if j>HIGH(drives) then break; {Kein Platz f�r weitere Laufwerke}
End;
end;
anzdrivs:=j-1; {hier: letztes Laufwerk!}
NewDrive(i);
{==Eingabeabfrage==========================================}
repeat
mousebefore:=mb<>0;
eingabe2;
{===Cancel=================================================}
if Hit(#27,x+208,y+150,90,20) then begin
Dateifenster:=false;
break;
end;
{===OK=====================================================}
if Hit(#13,x+208,y+120,90,20) then begin
if HandleEnter then break;
end;
{===Laufwerke w„hlen=======================================}
for i:=0 to anzdrivs do begin
drv:=drives[i];
if not load and (drv='N') then drv:=#0; {LW N ohne Hotkey}
if Hit(drv,x+20+i*35,y+37,30,15)
then NewDrive(i);
end;
{===Tasten auswerten=======================================}
case ta of
#0: case tahi of
77: begin {Pfeil rechts}
i:=driveindex+1; if i>anzdrivs then i:=0; NewDrive(i);
end;
75: begin {Pfeil links}
i:=driveindex-1; if i<0 then i:=anzdrivs; NewDrive(i);
end;
72: ScrollFiles(position-1);
80: ScrollFiles(position+1);
end;
end;
{===Dateiwahl==============================================}
If MausInRect(x+20,y+60,108,120) then begin
if mb<>0 then Begin
ScrollFiles(start+(my-y-60)div 12);
if not mousebefore and (mb and $84 <>0) {Mittlere Taste oder Doppelklick}
and HandleEnter then break;
end;
end;
{===Scrollen===============================================}
if Hit(#0,x+129,y+60,15,15) then ScrollFiles(position-1);
if Hit(#0,x+129,y+165,15,15) then ScrollFiles(position+1);
if (mb<>0) and MausInRect(x+129,y+75,15,90)
and (anzfiles>1)
then ScrollFiles((my-(y+77))*(anzfiles-1) div 80);
{===Neue Datei=============================================}
if not load and Hit('N',x+208,y+90,90,20) then begin
StatusZeile(NeueDatei);
if edit(x+120,y+100,'Neue Datei',12,4,
'Geben Sie bitte den','gew�nschten Namen an','[max. 12 Zeichen]',
Dateiname) then begin
if (Length(Dateiname)<>0)
and ((FileAttr(Dateiname) and $80 <>0)
or SicherheitsFenster(x+100,y+80,'Soll die Datei',Dateiname+' �ber-',
'schrieben werden?'))
then break;
end;
if position<dirstart
then Dateiname:=Filter
else Dateiname:=files[position];
ShowDateiname;
SetStatuszeile;
End;
until false;
closewindow;
{==R�ckgabeparameter=======================================}
getdir(0,pfad);
if pfad[length(pfad)]<>'\' then pfad:=pfad+'\';
Dateiname:=pfad+Dateiname;
end;
{---Prozedur Sicherheitsfenster-----------------------------}
function Sicherheitsfenster(X,Y:Integer;const Zeile1,Zeile2,Zeile3:Titelstr):Boolean;
Const Status='Best„tigen Sie nur mit >Return<, wenn Sie ganz sicher sind! >ESC< Abbruch';
begin
Sicherheitsfenster:=False;
openwindow2(X,Y,240,140,5,6,'Sicherheitsabfrage',True);
putpicture('stop',X+13,Y+40);
StatusZeile(Status);
setcolor(Daten.Color[3]);
settextstyle(0,0,1);
outtextxy(X+80,Y+50,Zeile1);
outtextxy(X+80,Y+65,Zeile2);
outtextxy(X+80,Y+80,Zeile3);
knopf2(X+20,Y+110,90,20,'OK',1,3);
knopf2(X+130,Y+110,90,20,'Abbruch',1,3);
Beep(500,100);
repeat
eingabe2;
if Hit(#13,X+20,Y+110,90,20) then begin
Sicherheitsfenster:=True; break;
end;
if Hit(#27,X+130,Y+110,90,20) then break;
until false;
closewindow;
end;
{---Prozedur Copyright-Fenster-----------------------------}
Procedure Copyright(const Programm,Version,Jahr,Firma:String);
Const Welcome= 'Willkommen beim AD/DA-Wandlermodul der TU Chemnitz! Weiter mit >RETURN<';
var
Owner : String;
i : Byte;
begin
Owner:=Urheber;
for i:=1 to length(Owner) do Dec(Owner[i]);
openwindow2(200,150,240,160,2,4,'šber...',True);
putpicture('COPY',210,200);
setcolor(Daten.Color[3]);
settextstyle(0,0,1);
outtextxy(280,200,Programm);
settextstyle(2,0,4);
outtextxy(280,215,'Version '+Version);
outtextxy(280,225,'Copyright (c) '+Jahr);
outtextxy(280,235,Firma);
outtextxy(281,236,'TU');
outtextxy(280,255,'Programmierer : '+Owner);
knopf2(280,280,80,20,'OK',1,3);
Statuszeile(Welcome);
repeat
eingabe2;
until Hit(#13,280,280,80,20);
closewindow;
end;
{---Prozedur Status-Fenster-----------------------------}
var
mausbuffer:PChar;
mausbuffersize:Word;
procedure SetWaitCursor(wait:Boolean);
var
x,y,b:Integer;
begin
if not MausAvail then exit;
if wait then begin
MausGrafikCursor(Sanduhr_Hotspot_X,Sanduhr_Hotspot_Y,@Sanduhr);
ShowMaus;
end else begin
HideMaus;
MausPos(x,y,b);
asm mov bx,[mausbuffersize]
les dx,[mausbuffer]
mov ax,17h
int 33h
end;
SetMausPos(x,y); {auf die letzten Werte}
end;
end;
Procedure Status(X,Y:Integer;const Zeile1,Zeile2,Zeile3,Zeile4:String);
Const Status='Einen Moment bitte, es geht gleich weiter...';
begin
openwindow2(x,y,240,140,2,4,'Status',True);
putpicture('Sanduhr',x+15,y+40);
StatusZeile(Status);
setcolor(Daten.Color[3]);
settextstyle(0,0,1);
outtextxy(x+80,y+50,Zeile1);
outtextxy(x+80,y+65,Zeile2);
outtextxy(x+80,y+80,Zeile3);
outtextxy(x+80,y+95,Zeile4);
SetWaitCursor(true);
end;
{---Prozedur Fehler-Fenster-----------------------------}
procedure MBoxHandler(x,y:Integer);
begin
knopf2(x+80,y+110,80,20,'OK',1,3);
Beep(500,100);
repeat
eingabe2;
until Hit(#13,x+80,y+110,80,20);
closewindow;
end;
Procedure Fehler(X,Y:Integer;Was:Boolean;const Zeile1,Zeile2,Zeile3,Zeile4:String);
Const Status='Ein Fehler ist aufgetreten. Die Operation wird abgebrochen. >Return< OK';
begin
openwindow2(x,y,240,140,5,6,'Fehler',True);
if was then putpicture('Teufel',x+10,y+45)
else putpicture('Nopark',x+10,y+45);
StatusZeile(Status);
setcolor(Daten.Color[3]);
settextstyle(0,0,1);
outtextxy(x+80,y+40,Zeile1);
outtextxy(x+80,y+55,Zeile2);
outtextxy(x+80,y+70,Zeile3);
outtextxy(x+80,y+85,Zeile4);
MBoxHandler(x,y);
end;
{---Prozedur Hinweis-Fenster----------------------------}
Procedure Hinweis(X,Y:Integer;const Zeile1,Zeile2,Zeile3,Zeile4:String);
Const Status='Solch ein Hinweis kann sehr sinnvoll f�r Sie sein >Return< OK';
begin
openwindow2(x,y,240,140,2,4,'Hinweis',True);
putpicture('!!!',x+25,y+40);
StatusZeile(Status);
setcolor(Daten.Color[3]);
settextstyle(0,0,1);
outtextxy(x+70,y+40,Zeile1);
outtextxy(x+70,y+55,Zeile2);
outtextxy(x+70,y+70,Zeile3);
outtextxy(x+70,y+85,Zeile4);
MBoxHandler(x,y);
end;
{---Prozedur DOS-Shell-------------------------------------
ACHTUNG !!
**********
Die DOS-Shell funktioniert nur, wenn mit der $M Direktive
ein gewisser Speicheranteil freigelassen wird. Deshalb
ist im Hauptprogramm (unbedingt nur dort!!!) folgende Zeile
am Anfang in geschweiften Klammern einzuf�gen:
$M 16384,0,300000
Das sind Richtwerte, die abh„ngig vom entsprechenden Programm
noch variiert werden m�ssen.
}
Procedure Dosshell(const Text:String);
begin
restorecrtmode;
clrscr;
writeln(Text);
writeln;
writeln('Geben Sie "EXIT" ein um zum Programm zur�ckzukehren...');
SwapVectors;
Exec(GetEnv('COMSPEC'),'');
SwapVectors;
setgraphmode(VGAHi);
end;
{---Prozedur Fehler beim Dateizugriff----------------------------}
function Dateifehler(X,Y:Integer;Error:byte):Boolean;
begin
Dateifehler:=False;
case error of
152: Fehler(X,Y,false,'Keine Diskette','im Laufwerk oder','Riegel nicht ge-','schlossen.');
162: Fehler(X,Y,false,'Unformatierte','oder defekte','Diskette im','Laufwerk.');
150: Fehler(X,Y,false,'Die Diskette ist','schreibgesch�tzt.','Die Sicherung kann','nicht erfolgen.');
101: Fehler(X,Y,false,'Die Diskette','ist voll.','Die Sicherung kann','nicht erfolgen.');
5 : Fehler(X,Y,false,'Keine bzw. defekte','Disk im Laufwerk','oder Datei/Medium','schreibgesch�tzt.');
0 : Dateifehler:=True;
1 : Fehler(X,Y,false,'Diese Datei','besitzt nicht das','geforderte Format.','Lesen unm”glich!');
else Fehler(X,Y,false,'Beim Dateizugriff','ist ein unbekannter','Fehler aufgetreten.','Operation beendet!');
end;
end;
{---Prozedur Selbsttest--------------------------------------------}
Procedure Selftest(Dateien:array of PChar);
Var
i: Integer;
DirInfo : TSearchRec;
s: array[0..255] of Char;
begin
for i:=LOW(Dateien) to HIGH(Dateien) do begin
StrECopy(StrECopy(s,ProgDir),Dateien[i]);
windos.FindFirst(s,0,DirInfo);
if windos.DosError<>0 then begin
writeln;
writeln('Fehler beim Selbsttest, ',i,'. Durchlauf.');
writeln('Die Datei ',Dateien[i],' wurde nicht gefunden.');
writeln;
writeln('Warnung :');
writeln('ÍÍÍÍÍÍÍÍÍ');
writeln('Das Programm l„uft m”glicherweise nicht korrekt, es kann zu Abst�rzen');
writeln('und Datenverlusten kommen.');
writeln;
while keypressed do readkey;
repeat
Beep(500,100);
write('M”chten Sie das Programm trotzdem starten? (J/N) :');
ta:=readkey;
until ta in['N','n','J','j'];
if ta in ['N','n'] then Halt(1);
end;
end;
end;
{---Prozedur Bildschirmschonermen�-----------------------------------}
Procedure BSSMenue;
Const
Hauptfenster='Anfangsbuchstabe f�r Auswahl >O< Optionen >Return< OK >ESC< Abbruch';
Text ='Eingabe des Textes f�r den Bildschirmschoner >Return< OK >ESC< Abbruch';
Astro='Eingabe der Anzahl der dargestellten Sterne >Return< OK >ESC< Abbruch';
Var
DatenS : DatenTyp;
AnzSterne : String;
Fehler : Integer;
procedure Schalter1Set;
begin
schalter(170,210,(DatenS.nr=1));
schalter(170,225,(DatenS.nr=2));
schalter(170,240,(DatenS.nr=3));
end;
procedure Schalter2Set;
begin
schalter(315,210,(DatenS.ver=1));
schalter(315,225,(DatenS.ver=2));
schalter(315,240,(DatenS.ver=3));
end;
Begin
openwindow2(150,150,340,150,2,4,'Bildschirmschoner',True);
DatenS:=Daten;
StatusZeile(Hauptfenster);
knopf2(400,190,80,20,'OK',1,3);
knopf2(400,220,80,20,'&Optionen',1,3);
knopf2(400,250,80,20,'Abbruch',1,3);
pressknopf2(160,190,140,67,true);
Schalter1Set;
pressknopf(305,190,390,257);
Schalter2Set;
pressknopf(160,265,390,285);
schalter(170,269,Daten.on);
setcolor(Daten.Color[3]);
outtextxy(167,197,'Schoner-Typ');
outtextUL(190,212,'Text-Drifter');
outtextUL(190,227,'Astronomie');
outtextUL(190,242,'Dunkelheit');
outtextxy(312,197,'Verz”gern');
outtextUL(335,212,'kurz');
outtextUL(335,227,'mittel');
outtextUL(335,242,'lang');
outtextUL(190,272,'Bildschirmschoner aktiv');
repeat
eingabe2;
if Hit(#13,400,190,80,20) then begin
Daten:=DatenS; break;
End;
if Hit(#27,400,250,80,20) then break;
if Hit('O',400,220,80,20) then begin
case DatenS.nr of
3: Beep(500,100);
1: begin
StatusZeile(Text);
Anzsterne:=DatenS.Text;
If edit(250,250,'Text-Drifter',24,3,'Eingabe des ge-','w�nschten Textes,',
'"Time" f�r die Uhrzeit',Anzsterne) Then DatenS.Text:=AnzSterne;
end;
2: begin
StatusZeile(Astro);
str(DatenS.Sterne,Anzsterne);
If edit(250,250,'Astronomie',3,0,'Eingabe der Anzahl',
'der gew�nschten Sterne','[ 1..999 ]',AnzSterne) Then Begin
If Length(AnzSterne)=0 Then AnzSterne:='1';
val(Anzsterne,DatenS.Sterne,Fehler);
If DatenS.Sterne<1 Then DatenS.Sterne:=1;
End;
End;
end{case};
StatusZeile(HauptFenster);
End;
if Hit('T',170,210,12,12) then begin
DatenS.nr:=1; Schalter1Set;
End;
if Hit('A',170,225,12,12) then begin
DatenS.nr:=2; Schalter1Set;
End;
if Hit('D',170,240,12,12) then begin
DatenS.nr:=3; Schalter1Set;
End;
if Hit('K',315,210,12,12) then begin
DatenS.ver:=1; Schalter2Set;
End;
if Hit('M',315,225,12,12) then begin
DatenS.ver:=2; Schalter2Set;
End;
if Hit('L',315,240,12,12) then begin
DatenS.ver:=3; Schalter2Set;
End;
if Hit('B',170,269,12,12) then begin
DatenS.On:=not DatenS.On;
schalter(170,269,DatenS.on);
End;
until false;
closewindow;
End;
{---Prozedur Auswahl von Men�punkten-----------------------}
function Auswahl(X,Y:Integer; const Titel:String; Texte:array of PChar;
Var Nr:Integer):Boolean;
Const Status='Bitte w„hlen Sie! '+Chr(24)+Chr(25)+' Auswahl >Return< OK >ESC< Abbruch';
label ok_raus;
Var
i, Merk : Integer;
Begin
Merk:=Nr-1;
Auswahl:=False;
Openwindow2(x,y,210,95+25*HIGH(Texte),2,4,Titel,true);
knopf2(x+10,y+40+25*(HIGH(Texte)+1),90,20,'OK',1,3);
knopf2(x+110,y+40+25*(HIGH(Texte)+1),90,20,'Abbruch',1,3);
StatusZeile(Status);
For i:=0 To HIGH(Texte) do Begin
schalter(x+50,y+35+25*i,i=Merk);
setcolor(Daten.Color[3]);
pouttextxy(x+90,y+38+25*i,Texte[i]);
Pressknopf2(x+40,y+31+25*i,130,20,true);
End;
repeat
eingabe2;
if Hit(#13,x+10,y+65+25*HIGH(Texte),90,20) then begin
Nr:=Merk+1;
Auswahl:=True;
break;
end;
if Hit(#27,x+110,y+65+25*HIGH(Texte),90,20) then break;
If (ta=#0) and (tahi in [72,80]) then begin
if tahi=72 then if merk>0 then dec(merk) else merk:=HIGH(Texte)
else if merk<HIGH(Texte) then inc(merk) else merk:=0;
pressknopf2(x+50,y+35+25*Merk,12,12,true);
delay(100);
for i:=0 to HIGH(Texte) do schalter(x+50,y+35+25*i,i=Merk);
end;
for i:=0 to HIGH(Texte) do if Hit(#0,x+50,y+35+25*i,12,12) then begin
schalter(x+50,y+35+25*merk,false);
merk:=i;
schalter(x+50,y+35+25*merk,true);
end;
Until false;
closewindow;
End;
{---Farbauswahlmen�---------------------------------------}
function Farbwahl(X,Y:Integer):Boolean;
Const Status=Chr(27)+' '+Chr(26)+' Farbe '+Chr(24)+Chr(25)+' Bereich >S< Standard >Return< OK >ESC< Abbruch';
Standard: ColorPal=(7,1,0,15,4,15,15,8,0,1,4,14);
Var
i,j : Integer;
Merk: ColorPal;
Wahl: Byte;
{==Unterprozedur Farbausgabe===============================}
Procedure OutFarbe;
Var i,j:byte;
Begin
for i:=0 to 3 do
for j:=0 to 3 do Begin
BackKnopf(x+205+i*35,y+30+j*25,x+235+i*35,y+50+j*25);
setfillstyle(1,i*4+j);
Bar(x+208+i*35,y+33+j*25,x+232+i*35,y+47+j*25);
End;
i:=Merk[Wahl] Div 4;
j:=Merk[Wahl]-(4*i);
PressKnopf2(x+205+i*35,y+30+j*25,30,20,true);
End;
{===Unterprozedur Testausgabe==============================}
Procedure OutTest;
Var
i: Byte;
tmp: ColorPal;
Begin
tmp:=Daten.color; Daten.color:=Merk;
setfillstyle(1,Daten.color[1]);
bar(x+19,y+249,x+111,y+291);
bar(x+129,y+249,x+221,y+291);
knopf2(x+20,y+250,90,20,'&Test',2,4);
knopf2(x+130,y+250,90,20,'&Warnung',5,6);
setcolor(Daten.color[7]);
line(x+18,y+248,x+18,y+292);
line(x+18,y+248,x+112,y+248);
line(x+17,y+247,x+17,y+293);
line(x+17,y+247,x+113,y+247);
line(x+128,y+248,x+128,y+272);
line(x+128,y+248,x+222,y+248);
line(x+127,y+247,x+127,y+293);
line(x+127,y+247,x+223,y+247);
line(x+20,y+250,x+20,y+270);
line(x+20,y+250,x+110,y+250);
line(x+130,y+250,x+130,y+270);
line(x+130,y+250,x+220,y+250);
setcolor(Daten.color[8]);
line(x+112,y+292,x+112,y+248);
line(x+112,y+292,x+18,y+292);
line(x+113,y+293,x+113,y+247);
line(x+113,y+293,x+17,y+293);
line(x+222,y+292,x+128,y+292);
line(x+222,y+292,x+222,y+248);
line(x+223,y+293,x+127,y+293);
line(x+223,y+293,x+223,y+247);
line(x+110,y+270,x+110,y+250);
line(x+110,y+270,x+20,y+270);
line(x+220,y+270,x+130,y+270);
line(x+220,y+270,x+220,y+250);
setcolor(Daten.color[3]);
outtextxy(x+45,y+277,'Hallo');
outtextxy(x+150,y+277,'Fehler');
For i:=9 To 12 Do Begin
Setcolor(Daten.color[i]);
pouttextxy(x+160,y+13+18*i,Farben[i]);
End;
Daten.color:=tmp;
End;
{===Unterprozedur Schalterausgabe=========================}
Procedure OutSchalter;
Var i:byte;
Begin
pressknopf2(x+15,y+10+18*Wahl,12,12,true);
delay(100);
pressknopf2(x+15,y+10+18*Wahl,12,12,false);
for i:=1 to 12 do Schalter(x+15,y+10+18*i,Wahl=i);
End;
Begin
Farbwahl:=False;
Wahl:=1;
Merk:=Daten.color;
Openwindow2(x,y,350,310,2,4,'Bildschirmfarben',true);
knopf2(x+250,y+210,90,20,'OK',1,3);
knopf2(x+250,y+240,90,20,'Abbruch',1,3);
knopf2(x+250,y+270,90,20,'&Standard',1,3);
StatusZeile(Status);
pressknopf2(x+10,y+243,220,54,true);
pressknopf2(x+145,y+170,85,70,true);
OutTest;
Outfarbe;
OutSchalter;
setcolor(Daten.color[3]);
for i:=1 to 12 do pouttextxy(x+40,y+13+18*i,Farben[i]);
repeat
eingabe2;
if Hit(#13,x+250,y+210,90,20) then begin
Daten.color:=Merk;
Farbwahl:=True;
break;
end;
if Hit(#27,x+250,y+240,90,20) then break;
if Hit('S',x+250,y+270,90,20) then begin
Merk:=Standard;
OutFarbe;
OutTest;
end;
If ta=#0 then begin
case tahi of
72: if Wahl>1 then dec(Wahl) else Wahl:=12;
80: if Wahl<12 then inc(Wahl) else Wahl:=1;
75: if Merk[Wahl]>0 then dec(Merk[Wahl]) else Merk[Wahl]:=15;
77: if Merk[Wahl]<15 then inc(Merk[Wahl]) else Merk[Wahl]:=0;
end;
OutSchalter;
OutFarbe;
OutTest;
end;
for i:=1 to 12 do if Hit(#0,x+15,y+10+18*i,12,12) then begin
Wahl:=i;
outschalter;
outfarbe;
break;
end;
for i:=0 to 3 do for j:=0 to 3 do
if Hit(#0,x+205+i*35,y+30+j*25,30,20) then begin
Merk[Wahl]:=4*i+j;
outfarbe;
outtest;
end;
Until false;
CloseWindow;
End;
{---Ausgabe der Statuszeile--------------------------------}
Procedure StatusZeile(Text:String);
Begin
setfillstyle(1,Daten.Color[1]);
Bar(4,463,635,474);
Setcolor(Daten.Color[3]);
Settextstyle(0,0,0);
OuttextXY(10,465,Text);
End;
{---Universelle Editier-Prozedur---------------------------}
function Edit(X,Y:Integer;const Titel:Titelstr;Max,Typ:Byte;
const Komm1,Komm2,Komm3:String;Var Text:String):Boolean;
{ X,Y : Bildschirmkoordinaten
Max : Maximalanzahl der einzugebenden Zeichen [1..24]
Typ : Auswahl der erlaubten Zeichen [0..6]
0 : nur Zahlen [0..9]
1 : nur Zahlen [0..9] und Punkt
2 : nur Groábuchstaben
3 : Groá- und Kleinbuchstaben
4 : Dateinamen ohne Extension
5 : Dateinamen mit Extensionen
6 : Alle Zeichen
Text : Vorgabewert, r�ckgegeben wird der editierte Wert,
immer als String }
Var i : Byte;
Pos : Byte;
Start,
Erlaubt:Boolean;
Wert : String;
Procedure Cursor;
Var i : Integer;
begin
setcolor(Daten.Color[1]);
for i:=0 to Max-1 Do outtextxy(x+110-(Max*4)+i*8,y+95,'_');
setcolor(Daten.Color[3]);
outtextxy(x+110-(Max*4)+Pos*8,y+95,'_');
End;
begin
Edit:=False;
{ Ende:=False;}
Wert:=Text;
Start:=True;
If Max>24 Then Max:=24;
If Max<1 Then Max:=1;
openwindow2(x,y,220,150,2,4,Titel,true);
knopf2(x+10,y+120,90,20,'OK',1,3);
knopf2(x+120,y+120,90,20,'Abbruch',1,3);
pressknopf(x+107-(Max*4),y+90,x+113+(Max*4),y+105);
setcolor(Daten.Color[3]);
CenterTextXY(x+110,y+40,Komm1);
CenterTextXY(x+110,y+55,Komm2);
CenterTextXY(x+110,y+70,Komm3);
setfillstyle(1,Daten.Color[3]);
settextstyle(0,0,0);
setcolor(Daten.Color[1]);
bar(x+110-(Max*4),y+92,x+110-(Max*4)+Textwidth(Wert),Y+103);
outtextxy(x+110-(Max*4),Y+94,Wert);
setfillstyle(1,Daten.Color[1]);
setcolor(Daten.Color[3]);
Pos:=Length(Wert);
If pos>Max-1 Then Pos:=Max-1;
outtextxy(x+110-(Max*4)+Pos*8,y+95,'_');
Repeat
Eingabe2;
Erlaubt:=False;
Case Typ Of
0: If Ta in ['0'..'9'] then Erlaubt:=True;
1: If Ta in ['.','0'..'9'] then Erlaubt:=True;
2: If Ta in [' '..'~','Ž','™','š','„','”','�','á'] then Begin
Erlaubt:=True;
asm
mov dl,[ta]
mov ax,6520h
int 21h {country dependent character capitalization}
mov [ta],dl
end;
End;
3: If Ta in [' '..'~','Ž','™','š','„','”','�','á'] then Erlaubt:=True;
4: If Ord(Ta) in [33,35..41,45,48..58,64..90,95,97..123,125,126] then
Begin
Erlaubt:=True;
ta:=Upcase(ta);
End;
5: If Ord(Ta) in [33,35..41,45,46,48..58,64..90,95,97..123,125,126] then
Begin
Erlaubt:=True;
ta:=Upcase(ta);
End;
6: Erlaubt:=True;
End;
If erlaubt then begin
if Start Then begin
Wert:='';
Pos:=0;
Start:=False;
End;
bar(x+110-(Max*4),y+92,x+110+(Max*4),Y+103);
if (Pos=Length(Wert)) and (Length(Wert)<Max) then Begin
Wert:=Wert+Ta;
Inc(Pos);
If Pos>Max-1 Then Pos:=Max-1;
End;
if (Pos=Length(Wert)-1) and (Length(Wert)=Max) then Begin
Wert:=Copy(Wert,1,Pos)+Ta;
Inc(Pos);
If Pos>Max-1 Then Pos:=Max-1;
End;
if (Pos<Length(Wert)) then Begin
Wert:=Copy(Wert,1,Pos)+Ta+Copy(Wert,pos+1,Length(Wert)-Pos);
Inc(Pos);
If Pos>Max-1 Then Pos:=Max-1;
if length(Wert)>Max Then delete(Wert,Length(Wert),1);
End;
if (Pos>Length(Wert)) and (Length(Wert)<Max) then Begin
While (Length(Wert) < Pos) do Wert:=Wert+' ';
Wert:=Wert+Ta;
Inc(Pos);
If Pos>Max-1 Then Pos:=Max-1;
if length(Wert)>Max Then delete(Wert,Length(Wert),1);
End;
Erlaubt:=False;
end;
if Hit(#13,x+10,y+120,90,20) then begin
While Copy(Wert,Length(Wert),1)=' ' do delete(Wert,Length(Wert),1);
{ ende:=true;}
Text:=Wert;
Edit:=True;
break;
end;
if Hit(#27,x+120,y+120,90,20) then break;
If ta=#8 then Begin
bar(x+110-(Max*4),y+92,x+110-(Max*4)+Textwidth(Wert),Y+103);
if pos>0 then begin
Dec(Pos);
Delete(Wert,Pos+1,1);
Start:=False;
End;
End;
if Ta=#0 Then begin
case tahi of
75: if pos>0 then Dec(pos);
77: begin
if Typ in [3,6] then if pos<Max-1 then Inc(pos);
If Typ in [0,1,2,4,5]
then if (pos<Length(Wert)) and (pos<Max-1) then Inc(pos);
end;
71: pos:=0;
79: If Max-1>Length(Wert) Then pos:=Length(Wert) else pos:=Max-1;
83: begin
bar(x+110-(Max*4),y+92,x+110-(Max*4)+Textwidth(Wert),Y+103);
Delete(Wert,Pos+1,1);
end;
end{case};
If Start and (tahi in [71,75,77,79,83]) Then begin
If tahi in [71,75,77,79] Then else begin
Wert:='';
pos:=0;
end;
bar(x+110-(Max*4),y+92,x+110-(Max*4)+Textwidth(Wert),Y+103);
Start:=False;
End;
End;
if (mb=0) and not Start then begin
Cursor;
outtextxy(x+110-(Max*4),Y+94,Wert);
end;
Until false;
Closewindow;
End;
{---Prozedur zum Test der Maus-----------------------------}
function MausTest:Boolean;
Begin
MausAvail:=MausOK;
MausTest:=MausAvail;
if MausAvail then exit;
Hinweis(200,150,
'Die Benutzung einer','Maus erleichtert die',
'Arbeit mit diesem','Programm erheblich.')
End;
{---Initialisierungen--------------------------------------}
var
sp:PChar;
f:file;
Gd,Gm:Integer;
s: array[0..79] of Char;
const
StdDaten:DatenTyp=(
{ Standardwerte f�r den Bilschirmschoner }
on: false; { Bildschirmschoner ein }
ver: 2; { Verz”gerung 1..3 }
nr: 1; { Bildschirmschoner-Nummer 1..3 }
text: 'Time'; { Text f�r Text-Drifter }
sterne: 150; { Sternanzahl bei Astronomie }
speed: 10; { Verz”gerung beim Sternemalen }
Color: (
7, { Fenster Hintergrund }
1, { Men�balken Hintergrund }
0, { Fenster Vordergrund }
15, { Men�balken Vordergrund }
4, { Warnung Hintergrund }
15, { Warnung Vordergrund }
15, { Knopf Lichtseite }
8, { Knopf Schattenseite }
0, { Kurve 1 }
1, { Kurve 2 }
4, { Kurve 3 }
14); { Kurve 4 }
{ Die folgenden Initialisierungen sind WINDOW-fremde Variablen }
{h#s: Jetzt wird mir der Schwachsinn langsam klar;
ich h„tte es doch gleich neu schreiben sollen!}
Pause: 0; { Pausenzeit zwischen zyklischen Umsetzungen }
KanalNr: (false,true,false,false,false,false,false,false);
BetriebNr: Einmalig; { Betriebsart des ADU (zykl./einmal.) }
SStellen: 1024; { St�tzstellenzahl }
Urate: 0.1; { 1/Umsetzrate in ms}
BildDatenNr: 2); { gew„hlte Dastellungsart [Linien] }
begin
FileMode:=0;
GetArgStr(ProgDir,0,sizeof(ProgDir)); {fernstartf„hig!}
sp:=StrRScan(ProgDir,'\');
if sp<>nil then sp[1]:=#0 {Normalfall}
else begin {Extrawurst f�rs Debuggen in der IDE}
GetCurDir(ProgDir,0);
if (StrEnd(ProgDir)-1)^<>'\' then StrCat(ProgDir,'\');
end;
Selftest(Dateienliste);
If Lo(DosVersion)<4 Then Begin
Writeln('Die Version des Betriebssystems ist zu alt!');
Writeln('Das Programm ben”tigt eine DOS-Version ab 4 aufw„rts.');
Writeln('Das Programm wird damit beendet.');
Halt(0);
End;
wincounter:=0;
Daten:=StdDaten;
StrECopy(StrECopy(s,ProgDir),'SETUP.DAT');
Assign(f,s);
{$I-}
reset(f,1);
if ioresult=0 then begin
BlockRead(f,Inst,sizeof(Inst),gm);
close(f);
{$I+}
end else begin
clrscr;
Writeln('Die Konfigurationsdatei SETUP.DAT wurde nicht gefunden!');
Writeln('Bitte starten Sie die SETUP.EXE, um die Konfigurationsdatei neu zu generieren.');
Writeln('Das Programm wird beendet.');
Halt(0);
End;
{ Grafikinitialisierung }
Gm:=VGAHi;
Init_Link_Graf_VGA(Gm);
If GraphResult <> grOk then Begin
Writeln('Fehler beim Umschalten in den VGA-Grafik-Modus !');
Writeln('Das Programm wird beendet.');
Halt(0);
End;
MausTest;
if MausAvail then begin
asm mov ax,15h
int 33h
mov [mausbuffersize],bx
end;
GetMem(mausbuffer,mausbuffersize);
asm mov bx,[mausbuffersize]
les dx,[mausbuffer]
mov ax,16h
int 33h {Es geht hier um den Behalt des Standard-Mauspfeils}
end;
end;
{ Laden der Konfigurationsdatei }
StrECopy(StrECopy(s,ProgDir),'AD_DA.INI');
assign(f,s);
{$I-}
reset(f,1);
if ioresult=0 then begin
BlockRead(f,Daten,sizeof(Daten),gm);
close(f);
{$I+}
end else begin
{ setmauspos(320,350);}
fehler(200,150,False,'Konfigurationsdatei','AD_DA.INI nicht ge-','funden, benutze','Standardwerte.');
end;
end.
| Detected encoding: ANSI (CP1252) | 4
|
|
|