program LOAD;
{$D KC-Load 0.41 (09/99)}
{$C MOVEABLE PRELOAD PERMANENT}
{$R KCLOAD.RES}
uses
WinTypes, WinProcs, Win31, MMSystem, CommDlg{, ShellApi},
WUtils;
const
RegPath='KCEMU\KCLOAD';
HelpFileName='KCLOAD.HLP';
UserDllFilter='*.KCL';
WaveFileName='KCLOAD.WAV';
var
hWav: HWaveIn; {fr Ein- und Ausgabe (erfolgt nie gleichzeitig)}
Waves: array[0..1] of THandle;
Modus: Integer; {0=frei, 1=LOADing, 2=SAVEteimas}
{Gespeicherte Setup-Daten (Registry), MšSSEN HINTEREINANDER LIEGEN BLEIBEN}
Retries: Integer; {Anzahl Wiederholungen beim Lesen}
Coding: Integer; {Modus KC normal, Turbo MPM, Turbo h#s, Z1013}
WaveVol: Integer; {Lautst„rke-Multiplikator (log.) bei Ausgabe}
WaveInDev, WaveOutDev: Integer;
{Nummer des Ein- bzw. Ausgabeger„tes}
Installed: Boolean;
BytesToWrite: LongInt;
BufPtr: LongInt;
AppName: array[0..31] of Char;
CurWaveHdr: PWaveHdr; {ZeigerZeiger auf momentan zu prozessierende Daten}
Task: THandle;
LibInst: THandle; {Geladene KCL-Bibliothek}
Back: HBrush; {Hintergrundpinsel fr Statuszeile (Blau)}
type
TWaveFileHdr=record {Header der WAVE-Datei}
riff: array[0..3] of Char;
rlen: LongInt; {Offset 4, enth„lt filesize-8}
wave,fmt: array[0..3] of Char;
flen: LongInt;
MyWav: TPCMWaveFormat;
data: array[0..3] of Char;
dlen: LongInt; {Offset 28h, enth„lt filesize-2Ch}
end;
const
WAVBLK=$4000; {je grӇer, desto weniger Aussetzer, aber asynchroner}
WaveFileHdr: TWaveFileHdr=(
riff: 'RIFF';
rlen: -1;
wave: 'WAVE';
fmt : 'fmt ';
flen: sizeof(TPCMWaveFormat); {10h}
MyWav:(
wf:(
wFormatTag: WAVE_Format_PCM;
nChannels: 1;
nSamplesPerSec: 22050;
nAvgBytesPerSec: 22050;
nBlockAlign: 1);
wBitsPerSample: 8);
data: 'DATA';
dlen: -1);
WM_ContinueInit=WM_User+10;
WM_EndProcess=WM_User+11;
WM_SetStatus=WM_User+12;
WM_ReportWaveError=WM_User+13;
type
TBlock=array[0..127] of Byte;
TCallProc=procedure; {Formatabh„ngige Lese/Schreibfunktion}
TS255=array[0..255] of Char;
TS31=array[0..31] of Char;
var
MainWnd: HWnd; {Global ist besser im Zugriff!}
hBuffer: THandle; {Speicherabbild der Datei, Wachstum durch Verdopplung}
{ S: array[byte]of Char;}
ByteIndex: Word;
Amp: ShortInt;
procedure EndProcess1(OK:Boolean); forward;
function SaveFile:Boolean; forward;
procedure FreeWaveBlock(var M:THandle); forward;
function GetFileName(S,buf:PChar):integer; forward;
procedure SetStat(S:PChar);
begin
PostMessage(MainWnd,WM_SetStatus,0,LongInt(S));
end;
function GetSize:LongInt;
begin
case Modus of
1: GetSize:=BufPtr;
2: GetSize:=BytesToWrite-BufPtr;
end;
end;
function GetData(P:PChar; Size:Integer):Integer;
var
Buf: PChar;
begin
Buf:=GlobalLock(hBuffer);
IncHPL(Buf,BufPtr);
if Size>BytesToWrite-BufPtr then Size:=BytesToWrite-BufPtr;
hmemcpy(P,Buf,Size);
Inc(BufPtr,Size);
GetData:=Size;
GlobalUnlock(hBuffer);
end;
procedure AddData(P:PChar; Size:Integer);
var
Buf: PChar;
begin
if BufPtr+Size>GlobalSize(hBuffer) then begin
hBuffer:=GlobalReAlloc(hBuffer,GlobalSize(hBuffer) shl 1,0);
if hBuffer=0 then EndProcess1(false); {sollte nie passieren}
end;
Buf:=GlobalLock(hBuffer);
IncHPL(Buf,BufPtr);
hmemcpy(Buf,P,Size);
Inc(BufPtr,Size);
GlobalUnlock(hBuffer);
end;
procedure ProcessBlock;
{Kontext: MMTASK.TSK}
var
Msg: TMsg;
begin
with CurWaveHdr^ do case Modus of
1: begin
if WaveInDev=-2 then begin
LongRec(dwBytesRecorded).Lo:=
_lread(hWav,lpData,LongRec(dwBufferLength).Lo);
if LongRec(dwBytesRecorded).Lo=0 then EndProcess1(false);
PeekMessage(Msg,0,0,0,PM_Remove); {Windows zum Zug kommen lassen}
if Msg.message=WM_Quit then EndProcess1(false);
end else begin
WaveInAddBuffer(hWav,CurWaveHdr,sizeof(TWaveHdr)); {leeren Puffer hinein}
if not GetMessage(Msg,0,0,0) then EndProcess1(false);
{gibt Rechenzeit frei}
{$IFOPT D+} if Msg.message<>MM_WIM_Data then asm int 3 end; {$ENDIF}
CurWaveHdr:=Pointer(Msg.lParam); {Neuer Block, gefllt mit Daten, steht bereit}
end;
ByteIndex:=0; {Lesezeiger}
end;
2: begin
if WaveOutDev=-2 then begin
if _lwrite(hWav,CurWaveHdr^.lpData,
LongRec(CurWaveHdr^.dwBufferLength).Lo)<>
LongRec(CurWaveHdr^.dwBufferLength).Lo
then EndProcess1(false);
PeekMessage(Msg,0,0,0,PM_Remove); {Windows zum Zug kommen lassen}
if Msg.message=WM_Quit then EndProcess1(false);
end else begin
WaveOutWrite(hWav,CurWaveHdr,sizeof(TWaveHdr)); {vollen Puffer hinein}
if not GetMessage(Msg,0,0,0) then EndProcess1(false);
{gibt Rechenzeit frei}
{$IFOPT D+} if Msg.message<>MM_WOM_Done then asm int 3 end; {$ENDIF}
CurWaveHdr:=Pointer(Msg.lParam); {Geleerter Puffer}
end;
ByteIndex:=0; {Schreibzeiger}
end;
end;
end;
procedure EndProcess1(OK:Boolean);
{Kontext: MMTASK.TSK, Funktion beendet Task}
var
os: TOfStruct;
FPos: LongInt absolute os;
begin
case Modus of
1: begin
if WaveInDev<>-2 then begin
WaveInReset(hWav); {Restliche (leere) Puffer "ausspucken"}
WaveInClose(hWav); {Ger„t schlieáen}
end else _lclose(hWav);
end;
2: begin
if WaveOutDev<>-2 then begin
if OK then begin
if ByteIndex<>0 then begin
LongRec(CurWaveHdr^.dwBufferLength).Lo:=ByteIndex;
ProcessBlock;
end;
while WaveOutClose(hWav)<>0 {=WAVERR_StillPlaying}
do MMTaskBlock(Task);
end else begin
WaveOutReset(hWav); {im Abbruch-Fall}
end;
WaveOutClose(hWav);
end else begin
if OK then begin {WAV-Datei patchen}
FPos:=_llseek(hWav,0,1); {Momentanposition}
Dec(FPos,8);
_llseek(hWav,4,0);
_lwrite(hWav,PChar(@FPos),4);
Dec(FPos,$2C-8);
_llseek(hWav,$28,0);
_lwrite(hWav,PChar(@FPos),4);
end;
_lclose(hWav);
if not OK then OpenFile(WaveFileName,os,OF_Delete);
end;
end;
end{case};
FreeWaveBlock(Waves[0]);
if WaveInDev<>-2 then FreeWaveBlock(Waves[1]);
PostMessage(MainWnd,WM_EndProcess,Word(OK),0);
halt;
end;
function MakeWaveBlock(var M:THandle):PWaveHdr;
{benutzt globale Variablen hWav und Modus}
var
WH: PWaveHdr;
begin
M:=GlobalAlloc(GHND or GMEM_Share,sizeof(TWaveHdr)+WAVBLK);
WH:=GlobalLock(M);
WH^.lpData:=PChar(WH)+sizeof(TWaveHdr);
WH^.dwBufferLength:=WAVBLK;
if Modus=1
then WaveInPrepareHeader(hWav,WH,sizeof(TWaveHdr))
else WaveOutPrepareHeader(hWav,WH,sizeof(TWaveHdr));
MakeWaveBlock:=WH;
end;
procedure FreeWaveBlock(var M:THandle);
{benutzt globale Variablen hWav und Modus}
var
WH: PWaveHdr;
begin
GlobalUnlock(M); {der Block war die ganze Zeit gelockt!}
WH:=GlobalLock(M); {Pointer beschaffen}
if Modus=1
then WaveInUnprepareHeader(hWav,WH,sizeof(TWaveHdr))
else WaveOutUnprepareHeader(hWav,WH,sizeof(TWaveHdr));
GlobalUnlock(M);
M:=GlobalFree(M);
end;
function memcmpw(var p1, p2; vlen: Word):Boolean; assembler;
asm push ds
lds si,[p2]
les di,[p1]
mov cx,vlen
mov al,FALSE
cld
rep cmpsb {[SI]-[DI]}
pop ds
jnz @@e
inc al {TRUE}
@@e:
end;
procedure WaveInTask(CallProc:TCallProc);far;
{Kontext: MMTASK.TSK, Funktion beendet Task und kehrt nicht zurck}
var
I: Integer;
ThisWaveFileHdr: TWaveFileHdr;
begin
asm mov ax,seg @data; mov ds,ax; {$IFOPT D+} int 3 {$ENDIF} end;
if WaveInDev=-2 then begin
I:=mmsyserr_InvalHandle; {5}
hWav:=_lopen(WaveFileName,0);
if (_lread(hWav,PChar(@ThisWaveFileHdr),sizeof(TWaveFileHdr))
=sizeof(TWaveFileHdr))
then begin
I:=mmsyserr_NotSupported; {8}
if memcmpw(ThisWaveFileHdr.riff,WaveFileHdr.riff,2)
and memcmpw(ThisWaveFileHdr.wave,WaveFileHdr.wave,$10)
then I:=0
else _lclose(hWav);
end else _lclose(hWav);
end else begin
I:=Integer(WaveInOpen(@hWav,Word(WaveInDev),@WaveFileHdr.MyWav.wf,
MMGetCurrentTask,0,Callback_Task));
if I<>0 then begin
PostMessage(MainWnd,WM_ReportWaveError,I,0);
halt;
end;
MMTaskBlock(Task); {MM_WIM_Open entfernen}
WaveInAddbuffer(hWav,MakeWaveBlock(Waves[0]),sizeof(TWaveHdr));
CurWaveHdr:=MakeWaveBlock(Waves[1]);
ByteIndex:=$FFFF;
WaveInStart(hWav);
end;
CallProc;
EndProcess1(true);
end;
procedure WaveOutTask(CallProc:TCallProc);far;
{Kontext: MMTASK.TSK, Funktion beendet Task und kehrt nicht zurck}
var
I: Integer;
begin
asm mov ax,seg @data; mov ds,ax; {$IFOPT D+} int 3 {$ENDIF} end;
if WaveOutDev=-2 then begin
I:=mmsyserr_InvalHandle; {5}
hWav:=_lcreat(WaveFileName,0);
if hWav<>-1 then begin
if _lwrite(hWav,PChar(@WaveFileHdr),sizeof(WaveFileHdr))
=sizeof(WaveFileHdr)
then I:=0 {mmsyserr_NoError}
else _lclose(hWav);
end;
end else I:=Integer(WaveOutOpen(@hWav,Word(WaveOutDev),@WaveFileHdr.MyWav.wf,
MMGetCurrentTask,0,Callback_Task));
if I<>0 then begin
PostMessage(MainWnd,WM_ReportWaveError,I,0);
halt;
end;
if WaveOutDev<>-2 then begin
MMTaskBlock(Task); {MM_WOM_Open entfernen}
CurWaveHdr:=MakeWaveBlock(Waves[0]);
PostAppMessage(MMGetCurrentTask,MM_WOM_Done,hWav,
LongInt(MakeWaveBlock(Waves[1])));
end;
ByteIndex:=0;
CallProc;
EndProcess1(true);
end;
{-Laden-von-Kassette---------------------------------------------------------}
function ReadB:ShortInt;
{Kontext: MMTASK.TSK}
begin
with CurWaveHdr^ do begin
if ByteIndex>=LongRec(dwBytesRecorded).Lo
then ProcessBlock; {N„chsten Block einlesen}
end; {CurWaveHdr ge„ndert, WITH beenden!!!}
with CurWaveHdr^ do begin
ReadB:=Integer(lpData[ByteIndex])-$80;
Inc(ByteIndex);
end;
end;
function ReadSwing1:Integer;
{Kontext: MMTASK.TSK}
var
W: Integer;
begin
W:=1;
if ReadB<0
then repeat Inc(W) until ReadB>0
else repeat Inc(W) until ReadB<0;
ReadSwing1:=W;
end;
function ReadSwing2: Integer;
{Kontext: MMTASK.TSK}
begin
ReadSwing2:=ReadSwing1+ReadSwing1;
end;
{*************************************}
{*** Formatabh„ngige Lese-Routinen ***}
{*************************************}
procedure ReadDataKCC; far;
{Kontext: MMTASK.TSK}
function KCBytein:Byte;
var
I,W:Integer;
B:Byte;
begin
for I:=0 to 7 do begin
w:=ReadSwing2;
B:=B SHR 1;
if w>16 then B:=B or $80;
end;
ReadSwing2;
KCBytein:=B;
end;
function ReadBlock(var BlkNr:Byte; var Buffer:TBlock):Boolean;
var
I,W:Integer;
B,Sum:Byte;
begin
ReadBlock:=false;
{Schritt 1: Vorton erkennen und aufsynchronisieren}
for I:=1 to 22 do begin
W:=ReadSwing2;
if (W<18) or (W>30) then begin
I:=0;
continue;
end;
end;
{Schritt 2: 1. Trennzeichen holen}
for I:=1 to 2 do begin
W:=ReadSwing1;
if (W<15) then begin
I:=0;
continue;
end;
end;
{Schritt 3: Bytes lesen}
BLKNr:=KCByteIn;
Sum:=0;
for I:=0 to 127 do begin
B:=KCByteIn;
Inc(Sum,b);
Buffer[I]:=b;
end;
If Sum=KCByteIn then ReadBlock:=true;
end;
var
ExpectBlock: Byte;
FirstBlock: Boolean;
BlkNr:Byte;
L:LongInt;
ok: Boolean;
S: TS31;
X,I,J: Integer; {Index fr Blocknummer-OK und Blocknummer-Aktuell}
buf: TBlock;
SP2: PChar;
vsrec: record
bn: Integer;
ch: Char;
end;
w: Word;
begin
L:=$7FFFFFFF;
FirstBlock:=true;
for I:=300 downto 0 do begin
W:=ReadSwing2;
if (W<18) or (W>30) then I:=200;
end;
I:=wvsprintf(S,'LOAD ',I);
SetStat(S);
repeat
ok:=ReadBlock(BlkNr,buf);
vsrec.bn:=BlkNr;
if Firstblock then ExpectBlock:=BlkNr;
if OK then begin
if (BlkNr=ExpectBlock) or ((BlkNr=$FF) and not FirstBlock) then begin
vsrec.ch:='>';
J:=0;
AddData(PChar(@Buf),sizeof(buf));
if (BlkNr=$FF) and (ExpectBlock<>$FF) then exit;
if FirstBlock then begin
if buf[0]=$D3 then L:=buf[11]+buf[12]*256+14;
SP2:=PChar(@buf);
I:=GetFileName(S,SP2);
FirstBlock:=false;
end;
Inc(ExpectBlock);
end else begin
vsrec.ch:='*';
J:=4;
end;
end else begin
vsrec.ch:='?';
J:=4;
end;
wvsprintf(S+I+J,' %02X%c',vsrec);
SetStat(S);
until GetSize>L;
end;
procedure ReadDataMPMTurbo; far;
{Kontext: MMTASK.TSK}
function KCBytein:Byte;
var
I,W:Integer;
B:Byte;
begin
for I:=0 to 7 do begin
w:=ReadSwing1;
B:=B SHR 1;
if w>=10 then B:=B or $80;
end;
KCBytein:=B;
end;
function ReadBlock(var BlkNr:Byte; var Buffer:TBlock):Boolean;
label Try;
var
I,W:Integer;
B,Sum:Byte;
begin
ReadBlock:=false;
{Schritt 1: Vorton erkennen und aufsynchronisieren}
Try:
for I:=1 to 40 do begin
W:=ReadSwing1;
if W>=10 then begin
I:=0;
continue;
end;
end;
{Schritt 2: 1. Trennzeichen holen}
for I:=1 to 2 do begin
W:=ReadSwing1;
if W<10 then begin
if I=2 then Goto Try else I:=0;
continue;
end;
end;
{Schritt 3: Bytes lesen}
BLKNr:=KCByteIn;
Sum:=0;
for I:=0 to 127 do begin
B:=KCByteIn;
Inc(Sum,B);
Buffer[I]:=B;
end;
If Sum=KCByteIn then ReadBlock:=true;
end;
var
ExpectBlock: Byte;
FirstBlock: Boolean;
L:LongInt;
BlkNr:Byte;
ok: Boolean;
S: array[0..31] of Char;
I,J: Integer; {Index fr Blocknummer-OK und Blocknummer-Aktuell}
buf: TBlock;
SP2: PChar;
vsrec: record
bn: Integer;
ch: Char;
end;
begin
L:=$7FFFFFFF;
FirstBlock:=true;
ExpectBlock:=1;
I:=wvsprintf(S,'TLOAD ',I);
SetStat(S);
repeat
ok:=ReadBlock(BlkNr,buf);
vsrec.bn:=BlkNr;
if OK then begin
if (BlkNr=ExpectBlock) or ((BlkNr=$FF) and not FirstBlock) then begin
vsrec.ch:='>';
J:=0;
AddData(PChar(@Buf),sizeof(buf));
if (BlkNr=$FF) and (ExpectBlock<>$FF) then exit;
if FirstBlock then begin
if buf[0]=$D3 then L:=buf[11]+buf[12]*256+14;
SP2:=PChar(@buf);
I:=GetFileName(S,SP2);
FirstBlock:=false;
end;
Inc(ExpectBlock);
end else begin
vsrec.ch:='*';
J:=4;
end;
end else begin
vsrec.ch:='?';
J:=4;
end;
wvsprintf(S+I+J,' %02X%c',vsrec);
SetStat(S);
until GetSize>L;
end;
procedure ReadDataHSTurbo; far;
{Kontext: MMTASK.TSK}
var
S: array[0..31] of Char;
I,W: integer;
Sum,B:Byte;
begin
ReadDataKCC;
SetStat(lstrcpy(S,'H#S TURBO'));
for I:=0 to 40 do begin
W:=ReadSwing1;
if W<12 then begin I:=0;continue;end;
end;
repeat
until ReadSwing1<12;
Sum:=0;
Repeat
for I:=0 to 7 do begin
w:=ReadSwing1;
B:=B SHL 1;
if w>20 then begin AddData(PChar(@Sum),1);exit;end;
if w>6 then B:=B or 1;
end;
inc(Sum,B);
AddData(PChar(@B),1);
until false
end;
procedure ReadDataZ1013; far;
{Kontext: MMTASK.TSK}
type
TBlk=array[0..15] of Word;
function Wordin:Word;
var
I:Integer;
W:Word;
begin
for I:=0 to 15 do begin
W:=W SHR 1;
if ReadSwing1>6 then W:=W or $8000 else ReadSwing1;
end;
Wordin:=W;
end;
function ReadBlock(var Buffer:TBlk):Boolean;
var
I:Integer;
W,Sum:Word;
begin
ReadBlock:=false;
{Schritt 2: 1. Trennzeichen holen}
for I:=1 to 2 do begin
W:=ReadSwing1;
if W>15 then begin
I:=0;
continue;
end;
end;
{Schritt 3: Bytes lesen}
Wordin;
Sum:=0;
for I:=0 to 15 do begin
W:=WordIn;
Inc(Sum,W);
Buffer[I]:=W;
end;
{If Sum=WordIn then} ReadBlock:=true;
end;
var
ok: Boolean;
S: array[0..31] of Char;
I,J: Integer; {Index fr Blocknummer-OK und Blocknummer-Aktuell}
buf: TBlk;
begin
SetStat(lstrcpy(S,'Z1013LOAD '));
repeat
ok:=ReadBlock(buf);
if OK then begin
AddData(PChar(@Buf),sizeof(buf));
SetStat(lstrcpy(S,'>'));
end else begin
SetStat(lstrcpy(S,'?'));
end;
until Readswing2<100;
end;
procedure ReadDataBasicode; far;
{Kontext: MMTASK.TSK}
var
S: array[0..31] of Char;
I: Integer;
B,Sum:Byte;
function Bytein:Byte;
var
I,W:Integer;
B:Byte;
begin
for I:=1 to 2 do begin
W:=ReadSwing1;
if W<7 then begin
I:=0;
continue;
end;
end;
for I:=0 to 7 do begin
w:=ReadSwing2;
B:=B SHR 1;
if w<16 then begin B:=B or $80;ReadSwing2;end;
end;
Sum:=Sum xor B;
Bytein:=B xor $80;
end;
var
w: Word;
begin
SetStat(lstrcpy(S,'BASICODE '));
for I:=1 to 40 do begin
W:=ReadSwing1;
if W>=6 then begin
I:=0;
continue;
end;
end;
SetStat(lstrcat(S,'2400Hz'));
Sum:=$0;
If ByteIn=1 then ByteIn;
Repeat
B:=ByteIn;
If B=3 then begin
B:=Sum;
If ByteIn<>B then SetStat(lstrcpy(S,'Lesefehler erkannt!'));
ShortYield;
exit;
end;
AddData(PChar(@B),1);
if B=$0D then B:=0;
B:=B and $7F;
if B in [1..$1F,$7F] then B:=Byte('.');
S[I]:=Char(B);
if I<sizeof(S)-1 then Inc(I);
if B=0 then begin
SetStat(S);
I:=0;
end;
until false;
end;
{-Speichern-auf-Kassette-----------------------------------------------------}
procedure WriteB;
{Kontext: MMTASK.TSK}
begin
with CurWaveHdr^ do begin
lpData[ByteIndex]:=Char(Integer(Amp)+$80);
Inc(ByteIndex);
if ByteIndex>=LongRec(dwBufferLength).Lo
then begin
{$IFOPT D+} asm int 3 end; {$ENDIF}
ProcessBlock; {vollen Block schreiben}
end;
end;
end;
procedure WriteSwing1(Len:Integer);
{Kontext: MMTASK.TSK}
begin
for Len:=Len downto 1 do begin
WriteB;
end;
Amp:=-Amp;
end;
procedure WriteSwing2(Len:Integer);
{Kontext: MMTASK.TSK}
var
Len1:integer;
begin
Len1:=Len div 2;
WriteSwing1(Len1);
WriteSwing1(Len-Len1)
end;
procedure WriteDataKCC; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
procedure WriteByte(B:Byte);
var
I,W:Integer;
begin
for I:=0 to 7 do begin
W:=12;
if B and 1 <>0 then W:=22;
WriteSwing2(W);
B:=B shr 1;
end;
WriteSwing2(38);
end;
procedure WriteBlock(BlkNr:Byte; const Buffer:TBlock; Vorton:Integer);
var
I,W:Integer;
B,Sum:Byte;
begin
for I:=1 to Vorton do WriteSwing2(22); {Vorton}
WriteSwing2(38); {Trennzeichen}
WriteByte(BlkNr);
Sum:=0;
for I:=0 to $7F do begin
Inc(Sum,Buffer[I]);
WriteByte(Buffer[I]);
end;
WriteByte(Sum);
end;
var
CurBlk: Byte;
S: array[0..31] of Char;
I: Integer;
buf: TBlock;
Erster_Block, Letzter_Block: Boolean;
begin
CurBlk:=1;
Erster_Block:=true;
Letzter_Block:=false;
repeat
I:=GetData(PChar(@buf),sizeof(buf));
if ((I<sizeof(buf)) or (GetSize=0))
and (not Erster_Block)
and (CurBlk<>$FF) then begin
Letzter_Block:=true;
CurBlk:=$FF;
end;
I:=$A0;
if Erster_Block then I:=$A00;
WriteBlock(CurBlk,buf,I);
I:=CurBlk;
Inc(CurBlk);
wvsprintf(S,'%02X<',I);
SetStat(S);
Erster_Block:=false;
until Letzter_Block;
end;
procedure WriteDataMPMTurbo; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
procedure WriteByte(B:Byte);
var
I,W:Integer;
begin
for I:=0 to 7 do begin
W:=5;
if B and 1 <>0 then W:=9;
WriteSwing1(W);
B:=B shr 1;
end;
end;
procedure WriteBlock(BlkNr:Byte; const Buffer:TBlock; Vorton:Integer);
var
I,W:Integer;
B,Sum:Byte;
begin
for I:=1 to Vorton do WriteSwing2(9); {Vorton}
WriteSwing2(24); {Trennzeichen}
WriteByte(BlkNr);
Sum:=0;
for I:=0 to $7F do begin
Sum:=Sum xor Buffer[I];
WriteByte(Buffer[I]);
end;
WriteByte(Sum);
end;
var
CurBlk: Byte;
S: array[0..31] of Char;
I: Integer;
buf: TBlock;
Erster_Block, Letzter_Block: Boolean;
begin
CurBlk:=1;
Erster_Block:=true;
Letzter_Block:=false;
repeat
I:=GetData(PChar(@buf),sizeof(buf));
if ((I<sizeof(buf)) or (GetSize=0))
and (not Erster_Block)
and (CurBlk<>$FF) then begin
Letzter_Block:=true;
CurBlk:=$FF;
end;
I:=$70;
if Erster_Block then I:=$1000;
WriteBlock(CurBlk,buf,I);
I:=CurBlk;
Inc(CurBlk);
wvsprintf(S,'%02X<',I);
SetStat(S);
Erster_Block:=false;
until Letzter_Block;
end;
procedure WriteDataHSTurbo; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
var
BTW: Longint;
I,J,W:Integer;
B:Byte;
S: TS255;
begin
{Loader saven}
BTW:=BytestoWrite;BytestoWrite:=256;
WriteDataKCC;
BytestoWrite:=BTW;
{eigentliche Daten speichern}
SetStat(lstrcpy(S,'H#S TURBO'));
for I:=0 to 512 do WriteSwing2(30);
WriteSwing1(9);
while GetData(PChar(@B),1)<>0 do begin
for I:=0 to 7 do begin
W:=5;
if B and 1 <>0 then W:=9;
WriteSwing1(W);
B:=B shr 1;
end;
end;
end;
procedure WriteDataZ1013; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
type
TBlk=array[0..15] of Word;
var
S: array[0..31] of Char;
I:integer;
buf:TBlk;
procedure WriteWord(W:Word);
var
I:Integer;
begin
wvsprintf(S,'%04X',W);Setstat(s);
for I:=0 to 15 do begin
if W and 1 <>0 then WriteSwing1(9) else WriteSwing2(9);
W:=W shr 1;
end;
end;
procedure WriteBlock(const Buffer:TBlk; Vorton:Integer);
var
I:Integer;
Sum:Word;
begin
for I:=1 to Vorton do WriteSwing1(17); {Vorton}
WriteSwing2(16); {Trennzeichen}
WriteWord(0);
Sum:=0;
for I:=0 to 15 do begin
inc(Sum,Buffer[I]);
WriteWord(Buffer[I]);
end;
WriteWord(Sum);
end;
begin
I:=2000;
SetStat(lstrcpy(S,'Z1013 Save'));
While GetSize>0 do begin
GetData(PChar(@buf),sizeof(buf));
WriteBlock(buf,I);
I:=14;
end;
end;
procedure WriteDataBasicode; far;
{Kontext: MMTASK.TSK}
{Schreibt BytesToWrite Bytes aus dem hBuffer}
var
S: array[0..31] of Char;
I: Integer;
B,Sum:Byte;
procedure WriteByte(B:Byte);
var
I,W:Integer;
begin
Sum:=Sum xor B;
WriteSwing2(18);
for I:=0 to 7 do begin
if B and 1 =0 then WriteSwing2(18)
else begin WriteSwing2(9);WriteSwing2(9);end;
B:=B shr 1;
end;
WriteSwing2(9);WriteSwing2(9);
end;
begin
Sum:=0;
for I:=1 to 9000 do WriteSwing2(9);
WriteByte(2);
I:=0;
while GetData(PChar(@B),1)<>0 do begin
WriteByte(B);
if B=$0D then B:=0;
B:=B and $7F;
if B in [1..$1F,$7F] then B:=Byte('.');
S[I]:=Char(B);
if I<sizeof(S)-1 then Inc(I);
if B=0 then begin
SetStat(S);
I:=0;
end;
end;
WriteByte(3);
WriteByte(Sum xor $80);
for I:=1 to 3500 do WriteSwing2(9);
end;
{-Dialogfunktionen-----------------------------------------------------------}
const
ID_OfnWriteProt=1040;
function OFNHook(Wnd:HWnd; Msg,wParam:Word; lParam:Longint):Word; export;
{tr„gt lediglich 'mit Vorblock' ein;
sollt bei SAVE aber erkennen, ob es eine BASIC-Datei ist und das
OFN_ReadOnly-Flag entsprechend setzen! }
var
S: TS31;
begin
OFNHook:=0;
case Msg of
WM_InitDialog: begin
LoadString(Seg(HInstance),108,S,sizeof(S));
SetDlgItemText(Wnd,ID_OfnWriteProt,S);
end;
end{case Msg};
end;
function lstrcmpin2(LongS,ShortS:PChar):Integer;
{Ist ShortS der Anfang von LongS?}
var
c: Char;
SP: PChar;
begin
SP:=LongS+lstrlen(ShortS);
c:=SP^;
SP^:=#0;
lstrcmpin2:=lstrcmpi(LongS,ShortS);
SP^:=c;
end;
var
SFile: TS255;
SFilter: TS255;
SExt: TS31;
const
hm: Word=WM_User+100; {HelpMessageString-Nachricht}
const
Ofn: TOpenFileName=(
lStructSize: sizeof(TOpenFileName);
hWndOwner: 0;
hInstance: Seg(HInstance);
lpstrFilter: SFilter;
lpstrCustomFilter: SExt;
nMaxCustFilter: sizeof(SExt);
nFilterIndex: 0;
lpstrFile: SFile;
nMaxFile: sizeof(SFile);
lpstrFileTitle: nil;
nMaxFileTitle: 0;
lpstrInitialDir: nil;
lpstrTitle: nil;
Flags: OFN_LongNames or OFN_ShowHelp
or OFN_EnableHook or OFN_OverwritePrompt;
nFileOffset: 0;
nFileExtension: 0;
lpstrDefExt: nil;
lCustData: 0;
lpfnHook: OFNHook;
lpTemplateName: nil);
procedure PrepareOFN;
var
SP1,SP2:PChar;
I: Integer;
begin
hm:=RegisterWindowMessage(HelpMsgString);
Ofn.hWndOwner:=MainWnd;
LoadString(Seg(HInstance),107,SFilter,sizeof(SFilter));
if Integer(Ofn.nFilterIndex)<>0 then begin
SP1:=SFilter; {Miábrauch!}
for I:=Integer(Ofn.nFilterIndex)*2 downto 2 {min. 1x}
do Inc(SP1,lstrlen(SP1)+1);
{Bug der COMMDLG.DLL bereinigen}
if lstrcmpin2(SP1,SExt+1)<>0 then begin
SP2:=SP1+lstrlen(SP1); {String-Ende}
memmove(SP1+lstrlen(SExt+1),SP2,SFilter+sizeof(SFilter)-SP2);
lstrcpy(SP1,SExt+1); {User-Extension einfgen}
end;
end;
SFile[0]:=#0;
end;
procedure PutFileName(pBuf:PChar); assembler;
{Dateiname vom globalen String SFile einbauen;
dabei Name und Erweiterung mit Leerzeichen auffllen;
weitere Voraussetzungen sind gltige Eintr„ge ofn.nFileOffset,
ofn.nFileExtension und ofn.nFilterIndex.
Bei Erweiterungen mit 3 gleichen Buchstaben UND ofn.nFilterIndex=3
(BASIC-Programm) wird diese an den Anfang gezogen und 80h addiert,
als Extrawurst fr BASIC-Programme und ~Daten}
asm cld
les di,[pBuf]
xor dx,dx {Merk-Register}
mov al,byte ptr [ofn.nFilterIndex]
cmp al,3 {BASIC ausgew„hlt?}
jne @@1 {nein, Extension egal}
mov cx,[ofn.nFileExtension]
jcxz @@1 {keine Endung!}
mov si,offset SFile
add si,cx
lodsb {1. Zeichen der Endung}
cmp [si],al {Vgl. mit 2. Zeichen}
jnz @@1
cmp [si+1],al {Vgl. mit 3. Zeichen}
jnz @@1
or al,80h {zuerst Extension+80h}
stosb
stosb
stosb
inc dl {Kennungs-Bit: Extension geschrieben}
@@1: mov si,offset SFile
add si,[ofn.nFileOffset]
mov cx,8
@@l1: lodsb
or al,al {Ende extensionsloser Dateiname}
jz @@2
cmp al,'.' {Ende Dateiname (Namensbestandteil)}
je @@2 {eigentlich ist der LETZTE Punkt maágebend!}
stosb
loop @@l1
@@2: mov al,' '
rep stosb {Rest mit Leerzeichen auffllen (CX=0 = nix)}
or dl,dl {Endung vorgezogen?}
jnz @@3
inc dl {keine Rekursion!}
mov cx,[ofn.nFileExtension]
jcxz @@2 {Keine Extension?}
mov si,offset SFile
add si,cx
mov cx,3 {noch 3 Bytes l”schen!}
jmp @@l1 {Extension <blank-padded> anh„ngen}
@@3: end;
function GetFileName(S,buf:PChar):integer;assembler;
{Dateiname von Pufferzeiger buf (hier: 11 Bytes, mit Leerzeichen aufgefllt)
nach S (als ASCIIZ 8.3) extrahieren}
asm cld
push ds
les di,[S]
lds si,[Buf]
xor dx,dx
xor bx,bx
mov cx,8 {8 Zeichen}
lodsb {1. Zeichen}
test al,al {Endung am Anfang?}
jns @@1
mov dx,11 {Kennung}
add si,2 {mit dem 4. Zeichen loslegen}
@@l1: lodsb
@@1: and al,7Fh
cmp al,' ' {Leer- und Steuerzeichen?}
jbe @@2 {einfach auslassen}
stosb {Alle anderen (auch verbotene W31) in Puffer}
inc bx
@@2: loop @@l1
mov al,'.'
stosb {jetzt kommt die Extension!}
inc bx
sub si,dx {Korrektur, wenn Extension vorn war!}
mov cx,3
@@l2: lodsb
and al,7Fh
cmp al,' '
jbe @@3
stosb
inc bx
@@3: loop @@l2
xor al,al
stosb {Terminierende Null}
@@e: pop ds
mov ax,bx
end;
function LoadFile:Boolean;
var
BytesWritten:Longint;
f,Add,I: Integer;
Sum: Byte;
pBuf: PChar;
buf: TBlock;
hLdr: THandle;
C: Char;
begin
LoadFile:=false;
PrepareOfn;
with ofn do begin
Flags:=Flags or OFN_FileMustExist;
if not GetOpenFileName(ofn) then exit;
f:=_lopen(SFile,0);
if f=-1 then exit;
BytesToWrite:=_llseek(f,0,2); {Dateil„nge}
_llseek(f,0,0); {Zeiger zurck}
Add:=0;
if nFilterIndex in [2,3] then Add:=11; {Speicherabzug/BASIC-Prg.}
If coding=2 Then begin
hLdr:=LoadResource(Seg(HInstance), {Turboloadervorblock}
FindResource(Seg(HInstance),MakeIntResource(102),RT_RCData));
if hLdr=0 then RunError(220);
hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share,BytesToWrite+256);
pBuf:=GlobalLock(hBuffer);
MemMove(pBuf,Ptr(hLdr,0),GlobalSize(hLdr));
hLdr:=THandle(FreeResource(hLdr));
case nFilterIndex of
1: begin
_hread(f,pBuf+$100,$80);
asm
les di,[pBuf]
mov si,di
add si,80h
mov cx,0Bh
@@l1: seges lodsb {Name bertragen}
stosb
loop @@l1
add si,85h {Adressen bertragen}
add di,76h
seges lodsb
push ax {ARGN}
seges lodsw {AADR}
stosw
mov cx,ax
inc di
seges lodsw {EADR}
stosw
xchg ax,cx
sub ax,cx
add di,22h
stosw {L„nge}
pop ax
cmp al,3
jnz @@e
mov al,0C3h
add di,36h
stosb
seges lodsw {SADR}
stosw
@@e: end;
BytesWritten:=_hread(f,pBuf+$100,BytesToWrite-$80);
sum:=0;
for i:=$100 to Byteswritten do inc(sum,byte(pBuf[I]));
pBuf[$D8]:=char(Sum);
inc(BytesWritten,$80);
end;
2: Add:=$100;
3: begin;
PutFileName(pBuf);
_hread(f,pBuf+$100,2);
asm
les di,[pBuf]
mov si,di
add si,70h
add di,80h
mov cx,10
@@l1: seges lodsb
stosb
loop @@l1
add si,86h
seges lodsw
inc ax
sub di,9
stosw {BASIC-L„nge [3D7]}
sub ax,400
add di,25h
stosw {File-L„nge}
add di,56h
xor al,al
stosb
end;
BytesWritten:=_hread(f,pBuf+$100,BytesToWrite-2);
sum:=0;
for i:=$100 to Byteswritten do inc(sum,byte(pBuf[I]));
pBuf[$D8]:=char(Sum);
inc(BytesWritten,2);
end;
4: exit; {Unsinn!}
end;
GlobalUnlock(hBuffer);
end
else begin
hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share,BytesToWrite+Add);
pBuf:=GlobalLock(hBuffer);
if (Add<>0)
or (nFilterIndex=1) and (pbuf[0]=#0)
then PutFileName(pBuf);
BytesWritten:=_hread(f,pBuf+Add,BytesToWrite);
GlobalUnlock(hBuffer);
end;
if (_lclose(f)<>0) or (BytesWritten<>BytesToWrite) then begin
MBox1(MainWnd,105,SFile);
hBuffer:=GlobalFree(hBuffer);
exit;
end;
Inc(BytesToWrite,Add);
LoadFile:=true;
end;
end;
function SaveFile:Boolean;
var
BytesWritten: Longint;
f,Add: Integer; {Add= 0 oder 11}
pBuf: PChar;
C: Char;
begin
SaveFile:=false;
Add:=0;
PrepareOfn;
{fr Turbolader h#s und Z1013 Dateinamensinklusion weglassen}
pBuf:=GlobalLock(hBuffer);
GetFileName(SFile,pBuf);
with ofn do begin
if pBuf[0]<char($80) then Flags:=Flags or OFN_ReadOnly
else Flags:=Flags and not OFN_ReadOnly;
Flags:=Flags or OFN_PathMustExist;
if not GetSaveFileName(ofn) then exit;
if coding=2 then begin
if pBuf[$D8]<>pBuf[BufPtr-1] then
if MBox1(MainWnd,111,SFile)=IDCANCEL then exit;
if pBuf[$80]=char($21) then begin {Maschinenprg.}
Dec(BufPtr,$81);
asm
les di,[pBuf]
mov si,di
add di,11
xor ax,ax
mov cx,6
rep stosb
add si,81h
seges lodsw
stosw
inc si
seges lodsw
stosw
add si,5Ah
sub di,5
push si
seges lodsb
cmp al,0C3h
jnz @@1
mov al,3
stosb
add di,4
seges lodsw
jmp @@2
@@1: mov al,2
stosb
add di,4
xor ax,ax
@@2: stosw
mov cx,69h
xor ax,ax
rep stosb
pop si
add si,20h
mov cx,word[BufPtr]
@@3: seges lodsb
stosb
loop @@3
end;
end else begin {BASIC Prg.}
asm
les di,[pBuf]
mov si,di
add si,81h
seges lodsw
dec ax
stosw
add si,7Eh
mov cx,word[BufPtr]
@@1: seges lodsb
stosb
loop @@1
end;
Dec(BufPtr,$100);
end;
end else begin
if Flags and OFN_ReadOnly <>0 then
if pBuf[0]>char($7F) then begin
Add:=11;
if pBuf[0]=char($D3) then BufPtr:=byte(pBuf[11])+byte(pBuf[12])*256+14;
end else Add:=$80;
end;
f:=_lcreat(SFile,0);
if f=-1 then begin
GlobalUnlock(hBuffer);
exit;
end;
Dec(BufPtr,Add);
BytesWritten:=_hwrite(f,pBuf+Add,BufPtr);
GlobalUnlock(hBuffer);
if (_lclose(f)<>0) or (BytesWritten<>BufPtr) then begin
MBox1(MainWnd,106,SFile);
exit;
end;
SaveFile:=true;
end;
end;
function GetInt(var S: PChar; Def:Integer):Integer;
var
SP: PChar;
I,J: Integer;
begin
GetInt:=Def;
if S=nil then exit;
SP:=lStrChr(S,' ');
if SP<>nil then begin
SP^:=#0;
end;
Val(S,I,J);
if SP<>nil then S:=SP+1;
if J=0 then GetInt:=I;
end;
procedure HandleMMError(Code:Integer);
var
S: array[0..255] of Char;
begin
case Code of
MMSysErr_Allocated: MBox1(MainWnd,102,nil);
WAVERR_Sync: MBox1(MainWnd,101,nil);
else begin
WaveInGetErrorText(Code,S,sizeof(S));
MBox1(MainWnd,103,S)
end;
end;
end;
procedure SetModus(NewModus:Integer);
begin
if Modus<>NewModus then begin
Modus:=NewModus;
EnableWindow(GetDlgItem(MainWnd,1),Modus=0);
EnableWindow(GetDlgItem(MainWnd,22),Modus=0);
ShowWindow(GetDlgItem(MainWnd,2),Integer(Modus<>0));
ShowWindow(GetDlgItem(MainWnd,3),Integer(Modus=0));
end;
if GetFocus=0 then SetFocus(GetDlgItem(MainWnd,12));
end;
function GetLibProc(Entry:PChar):TFarProc;
var
P: TFarProc;
LibName: TS31;
begin
GetLibProc:=nil;
SendDlgItemMsgP(MainWnd,12,CB_GetLbText,coding,@LibName);
LibInst:=LoadLibrary(LibName);
if LibInst<32 then begin
MBox1(MainWnd,114,LibName);
exit;
end;
P:=GetProcAddress(LibInst,Entry);
if P=nil then begin
MBox1(MainWnd,115,Entry);
FreeLibrary(LibInst);
LibInst:=0;
exit;
end;
GetLibProc:=P;
end;
procedure DoEndProcess(OK:Boolean);
begin
if OK and (Modus=1) then SaveFile;
if hBuffer<>0 then hBuffer:=GlobalFree(hBuffer);
if LibInst>=32 then FreeLibrary(LibInst);
SetModus(0);
end;
procedure Change(Wnd:HWnd;ID:Word;Min,Max:Integer;B:Boolean);
var
I,C: Integer;
OK: Bool;
begin
I:=GetDlgItemInt(Wnd,ID,@OK,true);
if not OK then exit;
If B Then begin If (I<Max) Then Inc(I) end
Else If (I>Min) Then Dec(I);
SetDlgItemInt(Wnd,ID,I,true);
end;
function LoadProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
lPar: LongRec absolute lParam;
WH: PWaveHdr absolute lParam;
S: array[0..255] of Char;
WaveOutCaps: TWaveOutCaps;
WaveInCaps: TWaveInCaps absolute WaveOutCaps; {ist krzer!}
LF: TLogFont absolute S;
SP: PChar;
Proc: TFarProc absolute SP;
W: Word;
I,J,K: Integer;
B: Bool absolute K;
vsrec: array[0..4] of Integer;
begin
LoadProc:=false;
case Msg of
WM_InitDialog: begin
MainWnd:=Wnd; {Globale Variable setzen}
W:=GetSystemMenu(Wnd,false);
DeleteMenu(W,SC_Zoom,MF_ByCommand);
DeleteMenu(W,SC_Size,MF_ByCommand);
ShowWindow(Wnd,CmdShow); {Icon? - Sofort wirksam machen!}
Back:=CreateSolidBrush($FF0000); {Blau}
PostMessage(Wnd,WM_ContinueInit,0,0);
end;
WM_ContinueInit: begin
UpdateWindow(Wnd); {wrde in InitDialog nichts bringen !!}
SP:=nil;
if RegGetRoot(RegPath,S,sizeof(S)) then begin
SP:=S;
Installed:=true;
end;
Retries:=GetInt(SP,4);
Coding:=GetInt(SP,0);
WaveVol:=GetInt(SP,4);
WaveInDev:=GetInt(SP,0);
WaveOutDev:=GetInt(SP,0);
SetDlgItemInt(Wnd,11,Retries,true);
LoadString(Seg(HInstance),104,S,sizeof(S));
SP:=S;
W:=GetDlgItem(Wnd,12);
while SP^<>#0 do begin
SendMessageP(W,CB_AddString,0,SP);
Inc(SP,lstrlen(SP)+1);
end;
SendMessageP(W,CB_Dir,0,PChar(UserDllFilter));
SendMessage(W,CB_SetCurSel,Coding,0);
SetDlgItemInt(Wnd,13,WaveVol,true);
W:=GetDlgItem(Wnd,14); {Handle Kombobox WaveIN}
LoadString(Seg(HInstance),112,S,sizeof(S));
K:=SendMessageP(W,CB_AddString,0,@S);
SendMessage(W,CB_SetItemData,K,-2);
I:=WaveInGetNumDevs;
for J:=-1 to I-1 do begin {mit Wave_Mapper beginnen}
if (WaveInGetDevCaps(Word(J),@WaveInCaps,sizeof(WaveInCaps))=0)
and (WaveInCaps.dwFormats and WAVE_Format_2M08 <>0) then begin
K:=SendMessageP(W,CB_AddString,0,@WaveInCaps.szPName);
SendMessage(W,CB_SetItemData,K,J);
if J=WaveInDev then SendMessage(W,CB_SetCurSel,K,0);
end;
end;
W:=GetDlgItem(Wnd,15); {Handle Kombobox WaveOUT}
K:=SendMessageP(W,CB_AddString,0,@S);
SendMessage(W,CB_SetItemData,K,-2);
I:=WaveOutGetNumDevs;
for J:=-1 to I-1 do begin {mit Wave_Mapper beginnen}
if (WaveOutGetDevCaps(Word(J),@WaveOutCaps,sizeof(WaveOutCaps))=0)
and (WaveOutCaps.dwFormats and WAVE_Format_1M08 <>0)
and (WaveOutCaps.dwSupport and WAVECAPS_Sync =0) then begin
K:=SendMessageP(W,CB_AddString,0,@WaveOutCaps.szPName);
SendMessage(W,CB_SetItemData,K,J);
if J=WaveOutDev then SendMessage(W,CB_SetCurSel,K,0);
end;
end;
GetObject(SendMessage(Wnd,WM_GetFont,0,0),sizeof(lf),@lf);
lstrcpy(lf.lfFaceName,'Courier');
SendDlgItemMessage(Wnd,10,WM_SetFont,CreateFontIndirect(lf),0);
end;
WM_CtlColor: if (lPar.Hi=CtlColor_Static)
and (GetWindowWord(lPar.Lo,GWW_ID)=10) then begin
LoadProc:=Bool(Back);
SetTextColor(wParam,$FFFFFF);
SetBkMode(wParam,Transparent);
end;
WM_EndProcess: DoEndProcess(Boolean(wParam));
WM_SetStatus: SetDlgItemText(Wnd,10,PChar(lParam));
WM_ReportWaveError: begin {in MMTASK Fehler bei WaveInOpen()}
HandleMMError(wParam);
hBuffer:=GlobalFree(hBuffer);
SetModus(0);
end;
WM_VScroll: begin
lPar.Lo:=GetDlgCtrlID(GetWindow(lPar.Hi,GW_HWndPrev));
if (wParam=SB_LineUp) or (wParam=SB_LineDown) then begin
Change(Wnd,lPar.Lo,0,7,wParam=SB_LineUp);
end;
end;
WM_QueryEndSession: if (Modus<>0)
and (MBox1(Wnd,113,nil)<>IDYes) then LoadProc:=true;
WM_EndSession: if Bool(wParam) and Installed
then SendMessage(Wnd,WM_Command,23,0);
WM_Close: begin
if (Modus<>0) then begin
if MBox1(Wnd,113,nil)<>IDYes then begin
LoadProc:=true; {Nicht beenden!}
exit;
end;
SendMessage(Wnd,WM_Command,IDCancel,0);
end;
DeleteObject(Back);
if Installed then SendMessage(Wnd,WM_Command,23,0);
EndDialog(Wnd,1);
end;
WM_Command: case wParam of
{Žnderungen an den Eingabe-Elementen erfassen}
11: if lPar.Hi=EN_Change then begin
I:=GetDlgItemInt(Wnd,wParam,@B,true);
if B and (I>=0) and (I<=255) then Retries:=I;
end;
12: if lPar.Hi=CBN_SelChange then begin
I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
if I>=0 then Coding:=I{SendMessage(lPar.Lo,CB_GetItemData,I,0)};
end;
13: if lPar.Hi=EN_Change then begin
I:=GetDlgItemInt(Wnd,wParam,@B,true);
if B and (I>=0) and (I<=7) then begin
WaveVol:=I;
I:=sqr(WaveVol)*2;
if Amp>=0 then Amp:=I else Amp:=-I;
end;
end;
14: if lPar.Hi=CBN_SelChange then begin
I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
if I>=0 then WaveInDev:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
end;
15: if lPar.Hi=CBN_SelChange then begin
I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
if I>=0 then WaveOutDev:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
end;
{Tastendrcke}
3: SendMessage(Wnd,WM_Close,0,0); {Programmende}
IDCancel: begin {Abbruch}
LoadString(Seg(HInstance),110,S,sizeof(S));
SetDlgItemText(MainWnd,10,S);
if Modus<>0 then begin
if IsTask(Task) then PostAppMessage(Task,WM_Quit,0,0)
else SetModus(0);
end;
end;
1: if Modus=0 then begin {Datei einlesen}
case coding of
0: Proc:=@ReadDataKCC;
1: Proc:=@ReadDataMPMTurbo;
2: Proc:=@ReadDataHSTurbo;
3: Proc:=@ReadDataZ1013;
4: Proc:=@ReadDataBasicode;
else begin
Proc:=GetLibProc('LOAD'); {Benutzer-definiert...}
if Proc=nil then exit;
end;
end;
hBuffer:=GlobalAlloc(GMEM_MoveAble or GMEM_Share,$8000);
BufPtr:=0;
SetModus(1);
MMTaskCreate(@WaveInTask,Task,LongInt(Proc));
end;
22: if Modus=0 then begin {Datei ausgeben}
if not LoadFile then exit;
case coding of
0: Proc:=@WriteDataKCC;
1: Proc:=@WriteDataMPMTurbo;
2: Proc:=@WriteDataHSTurbo;
3: Proc:=@WriteDataZ1013;
4: Proc:=@WriteDataBasicode;
else begin
Proc:=GetLibProc('SAVE');
if Proc=nil then exit;
end;
end;
BufPtr:=0;
Amp:=sqr(WaveVol)*2;
SetModus(2);
MMTaskCreate(@WaveOutTask,Task,LongInt(Proc));
end;
23: begin
Installed:=true;
wvsprintf(S,'%d %d %d %d %d',Retries);
RegSetRoot(RegPath,S);
end;
9: WinHelp(Wnd,HelpFileName,HELP_Contents,0);
end{WM_Command};
else if Msg=hm then WinHelp(Wnd,HelpFileName,HELP_Context,1);
end;
end;
const
wc:TWndClass=(
style: CS_VRedraw or CS_HRedraw;
lpfnWndProc: @DefDlgProc;
cbClsExtra: 0;
cbWndExtra: DlgWindowExtra;
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackground:Color_Background+1;
lpszMenuName: nil;
lpszClassName:'KCLOAD');
{FAR+EXPORT-Wrapper-Routinen (interne Routinen arbeiten mit NEAR)}
function ReadSwing:Integer; export;
begin ReadSwing:=ReadSwing1; end;
procedure WriteSwing(Len:Integer); export;
begin WriteSwing1(Len); end;
procedure EndProcess(OK:Boolean); export;
begin EndProcess1(OK); end;
procedure SetStatus(S:PChar); export;
begin SetStat(S); end;
function GetSizeData:Longint; export;
begin GetSizeData:=GetSize; end;
function GetDataBlock(P:PChar; Size:Integer):Integer; export;
begin GetDataBlock:=GetData(P,Size); end;
procedure AddDataBlock(P:PChar; Size:Integer); export;
begin AddData(P,Size); end;
exports
ReadSwing index 2, {Fluáwechsel lesen}
WriteSwing index 3, {Fluáwechsel schreiben}
EndProcess index 4, {Vorzeitig abbrechen}
SetStatus index 5, {Statuszeile setzen}
GetSizeData index 6, {restliche Bytes ermitteln}
GetDataBlock index 7, {N„chsten Datenblock aus Puffer lesen}
AddDataBlock index 8; {Neuen Datenblock in Puffer anh„ngen}
begin
LoadString(Seg(HInstance),100,AppName,sizeof(AppName));
WUtils.StdMBoxTitle:=AppName; {MessageBox-Titel in Unit setzen}
if HPrevInst<>0 then begin {Nicht doppelt starten!}
MainWnd:=FindWindow('KCLOAD',nil);
SetActiveWindow(MainWnd);
ShowWindow(MainWnd,SW_Restore);
halt(221);
end;
wc.hIcon:=LoadIcon(Seg(HInstance),MakeIntResource(100));
wc.hCursor:=LoadCursor(0,IDC_Arrow);
RegisterClass(wc);
DialogBox(Seg(HInstance),MakeIntResource(100),0,@LoadProc);
end.
Test fr das MFM-Verfahren am KC
var
I,J,W:Integer;
B:Byte;
begin
{Loader saven, Adressen und CTC poken}
for I:=0 to 2000 do WriteSwing1(6);
WriteSwing1(12);WriteSwing1(12);
J:=0;I:=7;
while GetData(PChar(@B),1)<>0 do begin
for I:=0 to 7 do begin
case J of
0: if B and 1 =0 then begin WriteSwing1(6);end
else begin WriteSwing1(19);J:=1;end;
1: if B and 1 =0 then begin J:=2;end
else begin WriteSwing1(6);end;
2: if B and 1 =0 then begin WriteSwing1(12);J:=0;end
else begin WriteSwing1(19);J:=1;end;
end;
B:=B shr 1;
end;
end;
end;
| Detected encoding: UTF-8 | 0
|