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 Benutzeroberflche
Programmierer: Torsten Levin
03 AET 89
TU Chemnitz-Zwickau
Chemnitz, Januar-April 1993
藩様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様様夕
Katastrophe leider nur unvollstndig 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 geprften 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 gehren 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 lschen.}
{***********************************************************************}
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 -Knpfe}
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-drcken----------------------------------------------------}
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 Bereichsberlauf!}
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 fr Men Cursortasten fr Auswahl Besttigen mit >RETURN<';
Var
Range: array[0..9] of integer; { Range fr Mausabfragen in der Menzeile }
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-Menpunkt; keine Hervorhebung fr 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-Menpunkt; kein Sub-Men, wenn NewY<-1}
var
OldY,j:Integer;
begin
if NewY=Y then exit;
if x<0 then exit; {ohne Menauswahl 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); {zunchst 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 ausgewhlt}
last:=-1; {berlufe 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 Menpunkt}
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 fr 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 ausgewhlt}
begin
HandleEnter:=true;
if Dateiname<>Filter then exit; {Datei ausgewhlt}
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 fr Rollbalken}
line(x+132,y+75,x+132,y+164);
setfillstyle(1,Daten.Color[3]);
pressknopf2(x+158,y+60,102,14,true); {Rahmen fr Dateiname/Filter}
pressknopf2(x+10,y+186,288,14,true); {Rahmen fr (verkrzten) Pfad}
pressknopf2(x+15,y+59,112,122,true); {Rahmen fr 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 fr 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 whlen=======================================}
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','gewnschten 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;
{==Rckgabeparameter=======================================}
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='Besttigen 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 fr 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 einzufgen:
$M 16384,0,300000
Das sind Richtwerte, die abhngig vom entsprechenden Programm
noch variiert werden mssen.
}
Procedure Dosshell(const Text:String);
begin
restorecrtmode;
clrscr;
writeln(Text);
writeln;
writeln('Geben Sie "EXIT" ein um zum Programm zurckzukehren...');
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','schreibgeschtzt.','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','schreibgeschtzt.');
0 : Dateifehler:=True;
1 : Fehler(X,Y,false,'Diese Datei','besitzt nicht das','geforderte Format.','Lesen unmglich!');
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 luft mglicherweise nicht korrekt, es kann zu Abstrzen');
writeln('und Datenverlusten kommen.');
writeln;
while keypressed do readkey;
repeat
Beep(500,100);
write('Mchten 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 fr Auswahl >O< Optionen >Return< OK >ESC< Abbruch';
Text ='Eingabe des Textes fr 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,'Verzgern');
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-','wnschten Textes,',
'"Time" fr 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 gewnschten 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 Menpunkten-----------------------}
function Auswahl(X,Y:Integer; const Titel:String; Texte:array of PChar;
Var Nr:Integer):Boolean;
Const Status='Bitte whlen 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 Grobuchstaben
3 : Gro- und Kleinbuchstaben
4 : Dateinamen ohne Extension
5 : Dateinamen mit Extensionen
6 : Alle Zeichen
Text : Vorgabewert, rckgegeben 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 fr den Bilschirmschoner }
on: false; { Bildschirmschoner ein }
ver: 2; { Verzgerung 1..3 }
nr: 1; { Bildschirmschoner-Nummer 1..3 }
text: 'Time'; { Text fr Text-Drifter }
sterne: 150; { Sternanzahl bei Astronomie }
speed: 10; { Verzgerung beim Sternemalen }
Color: (
7, { Fenster Hintergrund }
1, { Menbalken Hintergrund }
0, { Fenster Vordergrund }
15, { Menbalken 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 htte 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; { Sttzstellenzahl }
Urate: 0.1; { 1/Umsetzrate in ms}
BildDatenNr: 2); { gewhlte Dastellungsart [Linien] }
begin
FileMode:=0;
GetArgStr(ProgDir,0,sizeof(ProgDir)); {fernstartfhig!}
sp:=StrRScan(ProgDir,'\');
if sp<>nil then sp[1]:=#0 {Normalfall}
else begin {Extrawurst frs 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 bentigt eine DOS-Version ab 4 aufwrts.');
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.
Vorgefundene Kodierung: UTF-8 | 0
|