program KCEMU;
{$C MOVEABLE PRELOAD PERMANENT} {gleiche Attribute wie Unit SYSTEM}
{$D KC-Emulator 0.40 (03/98)}
{$S 65535}
{$R KCEMU.RES}
{$R ROMS.RES}
uses
WinTypes, WinProcs, MMSystem, Win31, CommDlg, ShellApi,
WUtils,KCHdr,KCDeb;
type
TKCPixmap=record {Bitmap für KC85/2..4}
case Integer of
1: (bih: TBitmapInfoHeader; {der Header}
col: array[0..31] of Integer); {Paletten-Indizes}
2: (f0,f1,x,f3,y,f5,f6,b,f8,f9,fa,fb,fc,fd,fe,ff,c: Integer);
{zum einfacheren Zugriff auf x,y und die Farbzahl}
3: (bi: TBitmapInfo); {Typecast für BitBlt}
end;
TKCPalette=record
palVersion: Word;
palNumEntries: Word;
col: array[0..31] of LongInt;
end;
PArgs=^TArgs;
TArgs=record
argn: Byte; {Anzahl}
arg: array[1..3] of Word; {Argumente}
end;
TKccHdr=record
name: array[0..10]of Char;
rsv: array[11..15]of Byte;
args: TArgs;
end;
{Die anderen KC's arbeiten mit einer Bitmap (S/W),
abgesehen vom Z9001 mit Farboption (wer hat den je gehabt?).
Formate: Z9001: Pixel 320x192, Zeichenraster 8x8,
Z1013: Pixel 256x256, gleiches Zeichenraster und Font}
TCallEvent=function(Msg,wParam:Word; lParam:LongInt):LongInt;
const
AnimCol=PC_Reserved shl 24; {max. 8 Farbpaare werden animiert}
KCPixmap: TKCPixmap=(
bih: (
biSize: sizeof(TBitmapInfoHeader);
biWidth: 320; {variabel}
biHeight: 256; {variabel}
biPlanes: 1;
biBitCount: 8; {variabel}
biCompression: BI_RGB;
biSizeImage: 0;
biXPelsPerMeter: 0;
biYPelsPerMeter: 0;
biClrUsed: 32; {variabel}
biClrImportant: 0);
col:(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
25,26,27,28,29,30,31)
);
KCPalette: TKCPalette=(
palVersion: $0300;
palNumEntries: 32;
col:($000000,$B00000,$0000B0,$B000B0,$00B000,$B0B000,$00B0B0,$B0B0B0,
$000000,$FF0000,$0000FF,$FF00FF,$00FF00,$FFFF00,$00FFFF,$FFFFFF,
$000000,$FF0080,$0080FF,$8000FF,$80FF00,$FF8000,$00FF80,$FFFFFF,
AnimCol,AnimCol,AnimCol,AnimCol,AnimCol,AnimCol,AnimCol,AnimCol)
);
var
cticks: LongInt;
expire: Word;
Display: Word; {Windows-DIB mit 2 oder 256 Farben; Offset ist Null}
hCharMap: THandle;
KCTyp: Integer;
MenuFlags: Integer;
Saum: TPoint; {Add-On von Client auf Fenster}
AppName: array[0..31] of Char;
hPal: HPalette;
ClrsRealized: Word;
{ KC4Pixel,KC4Color: PChar; {Zeiger auf Pixel- und Farbbereich}
KC4Port84H: Byte; {Bit 3: KC 85/4 im /HRG-Modus, Bit 2: Bild-Nr.}
KC4Port86H: Byte;
KCIRM: PtrRec; {KC85/(erst mal nur)4 Videospeicher}
KCMem: THandle; {64K oder 256K}
KC4Port88H: Byte;
KC4Port89H: Byte;
AccRights: array[0..31] of Byte;
{Bit 0: Read-Only (ROM oder kein Speicher), Bit 7: IRM (Aktualisierung)}
{ InHandlers: array[0..255] of Pointer;
OutHandlers: array[0..255] of Pointer;}
MemWr: Word; {Speicherschreib-Routine}
IORd,IOWr: Word;
IrqPtr: Word;
CallEvent: TCallEvent;
Mrom,Mram:array[0..3] of LongRec;
TickTaken: LongInt;
TimeTaken: Word;
EmuBlock: Byte; {Register: <>0: Z80 blockieren!
Bit 0: Block wegen modalem Fenster, Bit 1: wegen Icon,
Bit 2: wegen Hintergrund, Bit 4: wegen F9, Bit 5: wegen ungültiger DLL}
EmuBlockMask: Integer;
EmuShowClock: Integer; {0: keine Anzeige, 1: MHz, 2: Prozent}
KCClock: Word; {Taktfrequenz in Kilohertz}
LastPaintTime: Word; {Zeit für WM_Paint entscheided über Emu-Dauer}
Freq: Word; {Zuletzt gemessene Z80-Frequenz}
SelectedRegion: HRgn; {Momentane Markierung}
SelectedRect: TRect; {Momentane Markierung}
RandL,RandR: Integer; {Ränder links und rechts}
LoadSaveArgs: TArgs; {Global ist eben einfacher zu handhaben!}
const
Installed:Boolean=false; {Entscheidet über's automatische Speichern}
AutoInsert:Boolean=false; {künftig INS vor jedem ASCII senden!}
Blinken:Boolean=true;
Foreground:Boolean=true; {Momentan dargestellte Blinkfarbe, ist später
der Ausgang eines virtuellen D-Flip-Flops im KC (am Timer U856-Z80CTC)}
HelpFile:array[0..9]of Char='KCEMU.HLP';
var
InUpdate: array[0..159] of Byte; {pro Cursorpos ein Bit}
{Pro Bildschirmlöschen kommen so max. 1280 Aufrufe von InvalidateRect()
zusammen; immer noch besser als per-Pixel-Basis}
ScrShift: Byte; {enthält 3 (normal) oder 4 (doppelt)}
GC_ShortCircuit: Boolean; {Kurzschlußroutine: keine Garbage Collection}
BlinkFarben: array[0..7] of Byte;
{enthält KC-Farbattribute mit gesetztem Blinkbit (7) oder 0 für freie
Einträge. Korrespondiert zu den 8 animierten Farben der Farbpalette}
procedure SetAnimColor(I:Integer);
var
idx: Word;
begin
idx:=BlinkFarben[I];
if idx=0 then exit; {Eintrag nicht belegt}
if Foreground {or (ClrsRealized<=I+24)}
then idx:=(idx shr 3) and $0F +8
else idx:=idx and 7;
KCPalette.col[24+I]:=KCPalette.col[idx] or AnimCol;
end;
procedure Animate;
var
I: Integer;
begin
for I:=0 to 7 do SetAnimColor(I);
{ SelectPalette(GetDC(MainWnd),hPal,false);}
AnimatePalette(hPal,24,8,KCPalette.col[24]);
end;
procedure Blink_GC; assembler;
{Garbage Collection für BlinkFarben: Durchbrowst die 80-KB-Pixmap
nach Einträgen zwischen 24 und 31 und entfernt Fehlreferenzen
aus BlinkFarben[]. Sind alle Farben in Beschlag, dann CY=1.
PE: CLD! VR: BX,CX}
asm push ax; push ds; push si
cmp [KCTyp],7
mov bx,320*192 {Extrawurst für KC87}
mov ds,[Display]
jz @@0
xor bx,bx {ausnahmsweise als Zähler: 64K}
@@0: xor si,si
mov ah,$FF {Alles frei...}
@@l: lodsb {Byte laden}
sub al,24
cmp al,8
jnc @@no {keine Blinkfarbe}
mov cl,al
mov al,$FE
rol al,cl
and ah,al {Bitstelle ist NICHT mehr frei}
@@no: dec bx
jnz @@l
or si,si
jnz @@w {in 2. Runde raus! (SI ist 4000h)}
mov bx,ds
add bx,offset __ahincr
mov ds,bx
mov bx,$4000 {Neuer Zähler für restliche 16K}
jmp @@l
@@w:
pop si; pop ds
cmp ah,1 {Null?}
jc @@e
mov bx,offset BlinkFarben
@@l2: shr ah,1 {Bit ausschieben}
jnc @@used
mov byte ptr [bx],0
@@used: inc bx
or ah,ah {Noch freie Bits? (und CY löschen!)}
jnz @@l2
@@e: pop ax
end;
procedure GetVFarbe; assembler;
{PE: CL=Pixelbyte (KC85/4), <>0 (andere KCs),
AL=Farbattribut; PA: AL=Palettenindex für VFarbe; VR: AL,Flags}
{N: HFarbe ist stets AL and 7}
asm
cmp al,$80 {Blinkbit?}
jbe @@nb {wenn kein Blinkbit oder schwarz auf schwarz}
cmp [Blinken],false
jz @@nb {wenn global ausgeschaltet}
cmp al,$C0 {Auch schwarz auf schwarz?}
je @@nb
or cl,cl {Bits gesetzt? (am /3 immer)}
je @@nb {nein-auch nicht blinken lassen!}
push bx; push cx
mov bx,offset BlinkFarben-1
mov cx,8
@@l1: inc bx
cmp [bx],al {Gleichen Eintrag suchen}
loopnz @@l1
jz @@f_e {Gleichen Eintrag gefunden!}
@@try: mov bx,offset BlinkFarben-1
mov cx,8
@@l2: inc bx
cmp byte ptr [bx],0 {Freien Eintrag suchen}
loopnz @@l2
jz @@f_f {Freien Eintrag gefunden!}
cmp [GC_ShortCircuit],0
jnz @@sc
call Blink_GC {"Garbage Collection" aufrufen}
jnc @@try {Wenn neue freie Einträge gefunden}
mov [GC_ShortCircuit],1
@@sc: pop cx; pop bx
jmp @@nb {nicht-blinkende Farben nehmen}
@@f_f: mov [bx],al {Farbe allozieren}
{Neu allozierte Farbe müßte nun auch animiert werden!}
pusha
push es
sub bx,offset BlinkFarben {I}
mov ax,bx
push [hPal]
add ax,24
push ax {I+24}
push 1
push ds
shl ax,2 {*sizeof(LongInt)}
add ax,offset KCPalette.col
push ax
push bx
call SetAnimColor
call AnimatePalette
pop es
popa
@@f_e: sub bx,offset BlinkFarben-24
mov al,bl {aus BX=Zeiger Palettenindex machen}
pop cx; pop bx
ret
@@nb: shr al,3
and al,$0F
add al,8 {VFarbe}
end;
procedure adr2pixcolxy; assembler;
{PE: BX=Schreibadresse,
PA: SI=Pixeladresse, DI=Farbadresse, DX=Spalte(X), CX=Zeile(Y),
AL=0 (kein Update), 1 (Pixel-Update), 4(Farb-Update)}
asm mov di,bx
mov si,bx
xor ch,ch
xor dh,dh
xor al,al {Fehler-Code}
sub bh,$B2
{$IFOPT D+}
jnc @@err
{$ENDIF}
add bh,2
jc @@cr
add bh,8
jc @@cl
add bh,8
jc @@pr
add bh,$20
{$IFOPT D+}
jnc @@err
{$ENDIF}
{PE: Pixeladresse links}
@@pl: mov dl,bl
and dl,$1F {H}
add bx,bx
mov cl,bh
shr bh,2
or bh,$50
mov di,bx
stc
rcr di,1 {Farbadresse fertig!}
shl bx,4
and bh,$FC
and cl,$03
or cl,bh {V}
mov al,1
ret
{PE: Pixeladresse rechts}
@@pr: mov dl,bl
and dl,7
or dl,$20 {H}
add bx,bx
mov ax,bx {AH enthält: V7 V6 V1 V0, AL: V3 V2 V5 V4}
shr bh,2
shr bx,1
or bh,$B0
mov di,bx {Farbadresse fertig!}
mov bx,ax
shl bx,4
and bh,$CC
and ax,$0330
or al,ah
or al,bh
mov cl,al {V}
mov al,1
ret
{PE: Farbadresse links}
@@cl: mov dl,bl
and dl,$1F {H}
shl bx,5
mov cl,bh
and cl,$FC {V}
shr bx,4
shr bl,1
add bh,bh
or bh,$80
mov si,bx {Pixeladresse fertig!}
mov al,4
ret
{PE: Farbadresse rechts}
@@cr:
mov dl,bl
and dl,7
or dl,$20 {H}
add bx,bx
mov cl,bl {V4 und V5 bit-richtig!}
shr bl,1 {V1 und V0 =0 setzen!}
add bh,bh
or bh,$A0
mov si,bx {Pixeladresse fertig!}
shl bx,5
and bh,$FC
and cl,$30
or cl,bh {V}
mov al,4
{PE: fehlerhafte Adresse}
@@err:
end;
procedure Inval8x8; assembler;
{Invaliditiert Bildschirm-Bereich in Cursor-Schritten
PE: DL=Zeile(Y), DH=Spalte(X) (also gerade andersherum als im PC-BIOS)
BX=eindeutiger Bit-Bezeichner für InUpdate-BitArray
VR: BX,CL,Flags}
asm cmp [Test8086],2 {386er?}
jc @@286
db $0F,$AB,$1E {BTS [InUpdate],bx}
dw offset InUpdate
jnc @@w
jmp @@e
@@286:
mov cl,bl
and cl,7
mov al,1
shl al,cl {AL=Bitmaske}
shr bx,3 {BX nun max. 124}
add bx,offset InUpdate
test [bx],al
jnz @@e
or [bx],al {Bit setzen}
@@w: pusha; push es
mov bl,dh {BX=X}
xor dh,dh {DX=Y}
xor bh,bh
mov cl,[ScrShift]
mov ax,dx
inc ax
shl ax,cl
push ax {R.bottom}
mov ax,bx
inc ax
shl ax,cl
push ax {R.right}
shl dx,cl
push dx {R.top}
shl bx,cl
push bx {R.left}
mov ax,sp {SS:AX=Adresse von TRect}
push [MainWnd]
push ss; push ax {auf dem Stack liegendes TRect}
push false
call InvalidateRect
add sp,8 {TRect entfernen}
pop es; popa
@@e: end;
procedure InvalWnd; assembler;
{PE: -, PA: -, VR: alle außer DS,SI,SP,BP}
asm xor ax,ax
push [MainWnd]
push ax; push ax {lpRect=NIL}
push ax {fErase=FALSE}
call InvalidateRect
push ds
pop es
mov di,offset InUpdate
mov cx,type InUpdate/2
mov ax,$FFFF
cld
rep stosw {FillChar: Alles in Update-Region}
end;
procedure IRM_Access1; assembler;
{PE: BX=Schreibadresse, (ES:BX bereits geschrieben), AL=Zeichen
PA: -, VR: Flags}
asm pusha
mov ch,al {Zeichen retten}
sub bh,0ECh
{$IFOPT D+}
cmp bh,04h
jnc @@e
{$ENDIF}
mov ax,bx
mov cl,40
div cl {AH=ZeichenSpalte, AL=ZeichenZeile}
cmp al,24 {24. oder 25. Zeile?}
jnc @@e {Ja-raus (kein Zugriff)}
xchg ax,dx {DH=Spalte(X), DL=Zeile(Y)}
{Test auf InUpdate und Aufruf von InvalidateRect}
push es
call Inval8x8 {mit DH=X und DL=Y}
shl dl,3 {Pixelzeilen}
mov ax,40*256+24*8-1 {DIB-Adresse berechnen, =40*y+x}
sub al,dl {Pixelzeile stürzen, z.B. 0->191}
mul ah
add al,dh {X dazu}
adc ah,0 {AX ist Offset}
mov es,[Display]
xchg ax,di {ES:DI: fertig ist die DIB-Adresse!}
mov cl,0
shr cx,5 {Zeichencode in Position bringen}
push ds
mov ds,[hCharMap]
mov si,cx {und DS:SI zeigt auf Zeichenbildtabelle}
{Hauptschleife mit: ES:DI=Windows-DIB-Adresse, DS:SI=Zeichenbild,
CX=Schleifenzähler}
cld
mov cx,8
@@l: movsb
sub di,1+40 {DIB ist "verkehrtherum"}
loop @@l
pop ds
pop es
@@e: popa
end;
procedure IRM_Access3; near; assembler;
{PE: BX=Schreibadresse, ES=MemKCSel (ES:BX bereits geschrieben)
PA: -, VR: Flags}
asm pusha
call adr2pixcolxy {4 Parameter ausrechnen}
{$IFOPT D+}
or al,al
jz @@e
{$ENDIF}
push ax {Zeilen retten}
pusha
mov dh,dl
mov dl,cl
mov bx,dx
shr bx,3
shr dl,3 {Y}
call Inval8x8 {Aktualisieren lassen}
popa
not cl {Zeile stürzen für DIB}
mov ax,cx
add ax,ax
add ax,ax {Spalte*4}
add ax,cx {*5}
shl ax,3 {*40}
add ax,dx {Zeile*40+Spalte}
mov dx,[Display]
shl ax,3 {Pixel-Adresse, wird CY richtig gesetzt??}
jnc @@1
add dx,offset __ahincr
@@1: {DX:AX nun Adresse in Pixmap}
pop cx {Zeilenzahl in CL}
cld
{Hauptschleife mit: DX:AX (temp.alias ES:DI)=Windows-DIB-Adresse,
AL=Akku, BL=Pixelbyte, BH=VFarbe, AH=HFarbe, CH=Bitmaske, CL=Schleifenzähler,
ES:SI=KC-Pixel-Adresse, ES:DI=KC-Farb-Adresse}
@@l2: mov bl,es:[si] {Pixel-Byte}
mov bh,es:[di] {Farb-Byte}
push es; push di
mov es,dx {Segment-"Umschaltung"}
mov di,ax
mov al,bh
call GetVFarbe {CL trickreicherweise immer <>0}
xchg ah,al {VFarbe nach AH}
and bh,7 {HFarbe}
mov ch,$80 {Start mit Bit 7}
@@l1: test bl,ch
mov al,bh {HFarbe?}
jz @@hf
mov al,ah {nimm VFarbe!}
@@hf: stosb {Pixel setzen, kein Segmentüberlauf (außer am Ende)}
shr ch,1
jnz @@l1
xchg ax,di {xchg ax,r ist kürzer als mov ax,r}
pop di; pop es
dec cl
jz @@e {fertig, nicht mehr rechnen}
dec ax {"Anlauf" nehmen gegen Segmentüberlauf}
sub ax,320+7 {Pixel pro Zeile + 1 Byte - 1 Bit}
jnc @@3
sub dx,offset __ahincr
@@3: add si,80h {nächste KC-Pixelzeile (Farbe bleibt)}
jmp @@l2
@@e:
popa
end;
{dieselbe Routine für den KC85/4}
procedure IRM_Access4; near; assembler;
{PE: BX=Schreibadresse, (ES:BX bereits geschrieben)
PA: -, VR: Flags}
asm pusha
push es
sub bh,80h
{$IFOPT D+}
cmp bh,28h
jnc @@e {BH=X, BL=Y}
{$ENDIF}
mov si,bx {KC-Adresse retten}
les di,[KCIRM]
mov es:[di+bx],al {in den 10-K-Spiegel schreiben}
mov al,[KC4Port84H]
and al,5 {Anzeige und Zugriff verschieden?}
jpo @@e {ja (unpaarig) - raus!}
{Test auf InUpdate und Aufruf von InvalidateRect}
mov dx,bx
shr bx,3 {Unterste Bits (X) uninteressant!}
shr dl,3 {nun DL=Y, DH=X}
call Inval8x8
mov dx,si
not dl {Zeile stürzen für DIB}
mov bl,dh
xor bh,bh {BX=Spalte(X)}
xor dh,dh {DX=Zeile(Y), gestürzt}
mov di,dx
add di,di
add di,di {Spalte*4}
add di,dx {*5}
shl di,3 {*40}
add di,bx {Zeile*40+Spalte}
mov dx,[Display]
shl di,3 {Pixel-Adresse, CY ist das letzte Bit}
jnc @@1
add dx,offset __ahincr
@@1: {DX:DI nun Adresse in Pixmap}
cld
{Hauptschleife mit: DX:DI=Windows-DIB-Adresse,
AL=Akku, CL=Pixelbyte, CH=HFarbe, AH=VFarbe, BH=Bitmaske,
SI=KC-Pixel-Adresse, [KC4Pixel], [KC4Color]: Basiszeiger}
mov al,[KC4Port84H]
and ax,1
ror ax,1 {0 oder 8000h}
add si,ax
mov cl,es:[si] {Pixel-Byte}
mov al,es:[si+4000h]{Farb-Byte}
mov ch,al
mov es,dx {DISPLAY-Segment}
test [KC4Port84H],8 {HRG-Modus? (Bit invertiert!)}
mov bh,$80 {Start mit Bit 7}
jz @@hrg
call GetVFarbe {CL enthält Pixel-Byte}
mov ah,al
and ch,7 {HFarbe}
@@l1: test cl,bh
mov al,ch {HFarbe?}
jz @@hf
mov al,ah {nimm VFarbe!}
@@hf: stosb {Pixel setzen}
shr bh,1
jnz @@l1
@@e: pop es
popa
ret
@@hrg: {im HRG-Modus liefern die Pixel-Bits den Rot- und die Farb-Bits
den Türkis-Anteil - beide zusammen weiß}
@@l2: mov al,8 {Vordergrundfarbe Schwarz}
test cl,bh
jz @@p0
or al,2 {Vordergrundfarbe Rot}
@@p0: test ch,bh
jz @@c0
or al,5 {Vordergrundfarbe Türkis oder Weiß}
@@c0: stosb
shr bh,1
jnz @@l2
pop es
popa
end;
{Routine für die Umschaltung der KC85/4-Bildseite oder -Auflösung}
procedure IRM_Update4; near; assembler;
{PE: -, PA: -, VR: Flags}
asm pusha
cld
push es
mov bh,[KC4Port84H]
ror bh,1 {Bit7 je nach Anzeige-Bild}
mov si,[KCIRM].Sel
mov dx,[Display]
xor di,di {fangen unten links an}
mov bl,$FF
@@ll0: and bh,80h {entsprechende KC-Adresse}
@@ll: {ES:DI nun Adresse in Pixmap}
{Hauptschleife mit: DX:DI=Windows-DIB-Adresse, SI=[KCIRM]
AL=Akku(VFarbe), AH=Bitmaske, BL=Zeile, BH=Spalte (+80h),
CL=Pixelbyte, CH=HFarbe, [KC4Pixel], [KC4Color]: Basiszeiger}
mov es,si
mov cl,es:[bx] {Pixel-Byte}
mov ch,es:[bx+4000h]{Farb-Byte}
mov es,dx
test [KC4Port84H],$08 {HRG-Modus? (Bit invertiert!)}
mov ah,$80 {Start mit Bit 7}
jz @@hrg
mov al,ch
and ch,7 {HFarbe}
call GetVFarbe
@@l1: test cl,ah
jnz @@vf
xchg al,ch
stosb {HFarbe setzen}
xchg ch,al
shr ah,1 {Doppelt zur Sprungvermeidung}
jnz @@l1
jmp @@w
@@vf: stosb {VFarbe setzen}
@@w1: shr ah,1
jnz @@l1
jmp @@w
@@hrg: {im HRG-Modus liefern die Pixel-Bits den Rot- und die Farb-Bits
den Türkis-Anteil - beide zusammen weiß. Blinken gibt's nicht}
@@l2: mov al,8 {Vordergrundfarbe Schwarz}
test cl,ah
jz @@p0
or al,2 {Vordergrundfarbe Rot}
@@p0: test ch,ah
jz @@c0
or al,5 {Vordergrundfarbe Türkis oder Weiß}
@@c0: stosb
shr ah,1
jnz @@l2
@@w: or di,di
jnz @@ni
add dx,offset __ahincr
mov es,dx {nächstes Segment}
@@ni: inc bh {X - nach rechts}
mov al,bh
and al,7Fh
cmp al,40
jc @@ll
sub bl,1 {Y - nach oben}
jnc @@ll0
call InvalWnd
pop es
@@e: popa
end;
procedure IRM_Access7; assembler;
{PE: BX=Schreibadresse, (ES:BX bereits geschrieben), AL=Zeichen oder Farbcode
PA: -, VR: Flags}
asm pusha
{$IFOPT D+}
sub bh,0E8h
cmp bh,08h
jnc @@e
{$ENDIF}
and bh,3 {auf Pixeladresse}
mov si,bx {Adresse retten}
mov ax,bx
mov cl,40
div cl {AH=ZeichenSpalte, AL=ZeichenZeile}
cmp al,24 {24. oder 25. Zeile?}
jnc @@e {Ja-raus}
xchg ax,dx {DH=Spalte(X), DL=Zeile(Y)}
{Test auf InUpdate und Aufruf von InvalidateRect}
push es
call Inval8x8
shl dl,3
mov ax,40*256+24*8-1 {DIB-Adresse berechnen, =(40*y<<3+x)<<3}
sub al,dl {Zeile stürzen wegen DIB, 0-->191}
mul ah
add al,dh {X dazu}
adc ah,0
shl ax,3
xchg ax,di {DI ist Offset}
mov cl,es:[si+0EC00h] {ASCII}
mov ch,0
shl cx,3 {Zeichencode in Position bringen}
mov al,es:[si+0E800h] {Farbe}
mov es,[Display] {ES:DI: fertig ist die DIB-Adresse!}
mov si,cx {und (DS:)SI zeigt auf Zeichenbildtabelle}
mov ah,al
and ah,7 {8 Hintergrundfarben}
mov cl,8 {Schleifenzähler UND Kennung für GetVFarbe}
call GetVFarbe {AL->Index, GetVFarbe braucht DS!}
mov bh,al
push ds
mov ds,[hCharMap]
{Hauptschleife mit: ES:DI=Windows-DIB-Adresse, DS:SI=Zeichenbild, AH=HFarbe
BH=VFarbe, BL=Bits, CH=Maske, CL=Schleifenzähler}
cld
@@l2: mov ch,80h
lodsb {Zeichentabellen-Zugriff}
mov bl,al
@@l: test bl,ch {Pixel gesetzt}
mov al,ah
jz @@1 {nein, HFarbe verwenden}
mov al,bh
@@1: stosb
shr ch,1 {Nächstes Bit}
jnz @@l
sub di,8+320 {DIB ist "verkehrtherum"}
loop @@l2 {CH ist hier Null!}
pop ds
pop es
@@e: popa
end;
procedure IRM_Access9; assembler;
{PE: BX=Schreibadresse, (ES:BX bereits geschrieben), AL=Zeichen
PA: -, VR: Flags}
asm pusha
mov ch,al {Zeichen retten}
sub bh,0ECh
{$IFOPT D+}
cmp bh,04h
jnc @@e
{$ENDIF}
mov dx,bx
shl dx,3
shr dl,3
mov di,dx
xchg dl,dh {DL=Zeile(Y), DH=Spalte(X)}
{Test auf InUpdate und Aufruf von InvalidateRect}
push es
call Inval8x8
xor di,1FE0h {Zeile stürzen für DIB}
mov es,[Display] {ES:DI: fertig ist die DIB-Adresse!}
mov cl,0
ror cx,5 {Zeichen 'runterholen und *8}
push ds
mov ds,[hCharMap]
mov si,cx {und DS:SI zeigt auf Zeichenbildtabelle}
{Hauptschleife mit: ES:DI=Windows-DIB-Adresse, DS:SI=Zeichenbild,
CX=Schleifenzähler}
cld
mov cx,8
@@l: movsb
sub di,1+32 {DIB ist "verkehrtherum"}
loop @@l
pop ds
pop es
@@e: popa
end;
type
TUserInfo=record
hDrv: THandle;
hLib: THandle; {Da sind die ROMs}
memwrite: Pointer; {4 schnelle Prozeduren: Speicherschreiben}
ioread: Pointer; {Portlesen}
iowrite: Pointer; {Portschreiben}
intchk: Pointer; {Interrupttest}
{Alle anderen Ereignisse gehen über DriverProc}
user: LongInt; {für den Treiber zur freien Verwendung}
screen: TPoint; {(anfängliche) Bildschirmgröße in Pixeln}
color: Boolean;
coldpc: Word; {Kalt-Boot-Start}
warmpc: Word; {Warm-Boot-Start}
freq: Word; {Nominelle Taktfrequenz}
rom: array[0..3] of LongRec; {4 ROMs sollten reichen}
ram: array[0..3] of LongRec; {4 RAMs sollten reichen}
end;
var
UserInfo: TUserInfo;
{Speicherschreibroutinen mov [ES:BX],AL
PE: BX=Speicheradresse, AL=Zu schreibendes Byte; PA: -; VR: -}
procedure MemWrite1; near; assembler;
asm cmp bh,0C0h
jb @@set ;{0000-BFFF=RAM (bei 48K-Ausbau}
cmp bh,0ECh
jb @@e ;{C000-EBFF=ROM-Modul (BASIC) oder frei}
cmp bh,0F0h
jnb @@e ;{EC00-EFFF=IRM, dahinter ROM}
@@irm: cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access1
@@set: mov [es:bx],al
@@e:
end;
procedure MemWrite3; near; assembler;
asm cmp bh,0c0h
jae @@e
cmp bh,80h
jb @@set
cmp bh,0b2h
jae @@set
cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access3
@@set: mov [es:bx],al
@@e:
end;
procedure MemWrite4; near; assembler;
asm cmp bh,0c0h
jae @@e
cmp bh,80h
jb @@set
cmp bh,0A8h
jae @@set
test [KC4Port88H],4 {IRM eingeschaltet?}
jz @@set {nein, normaler RAM}
cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access4
@@set: mov [es:bx],al
@@e:
end;
procedure MemWrite7; near; assembler;
asm cmp bh,0C0h
jb @@set ;{0000-BFFF=RAM (bei 48K-Ausbau}
cmp bh,0E8h
jb @@e ;{C000-E7FF=ROM-Modul (BASIC)}
cmp bh,0F0h
jnb @@e ;{E800-EFFF=IRM, dahinter ROM}
@@irm: cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access7
@@set: mov [es:bx],al
@@e:
end;
procedure MemWrite8; near; assembler;
asm call [UserInfo.memwrite] {FAR weiterreichen}
end;
procedure MemWrite9; near; assembler;
asm cmp bh,0ECh
jb @@set ;{0000-EBFF=RAM (bei 64K-Ausbau}
cmp bh,0F0h
jb @@irm ;{EC00-EFFF=IRM}
cmp bh,0F8h
jae @@set ;{F800-FFFF=RAM (bei 64K-Ausbau)}
ret ;{F000-F7FF=ROM-nicht schreiben}
@@irm: cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access9
@@set: mov [es:bx],al
@@e:
end;
procedure MemWrite; near; assembler;
asm mov [es:bx],al
end;
procedure XchgD(var a1,a2; len:Word); assembler;
asm pusha; push ds; push es
cmp [Test8086],2 {386er?}
cld
mov cx,[len]
jcxz @@e
lds si,[a1]
les di,[a2]
jnc @@l3
shl cx,1
@@l2: lodsw
mov dx,es:[di]
stosw
mov [si-2],dx
loop @@l2
jmp @@e
@@l3: db $66; lodsw
db $66; mov dx,es:[di]
db $66; stosw
db $66; mov [si-4],dx
loop @@l3
@@e: pop es; pop ds; popa
end;
function PageAlloc(KBytes:Integer):THandle;
{KBytes MSB: Allokation von ständig gemapptem Speicher: es erfolgt dann
KEIN GlobalAlloc, jedoch im VxD dennoch PageAllocate}
{Belegt später im VxD}
begin
if KBytes<0 then PageAlloc:=MemKCSel
else begin
if KBytes=0 then KBytes:=64; {Sonderfall: 64K-Fenster mit FF-Seite}
PageAlloc:=GlobalAlloc(GMEM_Fixed,LongMul(KBytes,1024));
end;
end;
function PageFree(HMem:THandle):THandle;
{gibt später im VxD frei, sollte 0 liefern}
{"Normaler" Speicher mit Handle=MemKCSel NICHT freigeben!}
begin
PageFree:=0;
if HMem<>0 then PageFree:=GlobalFree(HMem);
end;
procedure MovD(src,dst:Pointer; KBytes:Integer); assembler;
{maximal 64K am Stück! Kein Selektor-Übergang!}
asm push ds
mov cx,[KBytes]
jcxz @@e
shl cx,9 {Words}
cmp [Test8086],2 {386er?}
cld
lds si,[src] {jetzt ist DS weg!}
les di,[dst]
jc @@286
shr cx,1 {DWords}
db $66
@@286: rep movsw
@@e: pop ds
end;
procedure FillD(dst:Pointer; KBytes:Integer); assembler;
{maximal 64K am Stück! Kein Selektor-Übergang! Füllt mit $FF!}
asm mov cx,[KBytes]
jcxz @@e
shl cx,9 {Words}
cmp [Test8086],2 {386er?}
cld
les di,[dst]
mov ax,$FFFF
jc @@286
shr cx,1 {DWords}
db $66; cbw {cwde, AX-->EAX}
db $66
@@286: rep stosw
@@e: end;
procedure Map(KCOfs:Word;HMem:THandle;Start,KBytes:Integer; Dir:Boolean);
{Speicher ab Adresse KCOfs ein/ausblenden, Start in KBytes vom HMem-Anfang}
{Wird später ins VxD verlegt und von der MMU erledigt}
var
P1,P2: PChar;
begin
P1:=Ptr(MemKCSel,KCOfs);
if HMem<>0 then begin {Speicherhandle okay?}
P2:=Ptr(HMem,0);
IncHPL(P2,LongMul(Start,1024));
if Dir then MovD(P2,P1,KBytes) {Dir=TRUE: MapIn}
else MovD(P1,P2,KBytes); {Dir=FALSE: MapOut}
end else begin
if Dir then FillD(P1,KBytes); {Dir=TRUE: Speicherloch simulieren}
end; {Dir=FALSE: Nichts tun}
end;
procedure IOWrite; near; assembler;
asm
end;
procedure IOW4_88; near; assembler;
asm
push ax
mov al,bl
xchg al,[KC4Port88H]
xor al,bl ;{Bit-Veränderungen}
test al,80h ;{Betrifft BASIC-ROMC?}
jz @@1
test [KC4Port86H],80h {CAOS ROMC eingeschaltet?}
jnz @@1 ;{Nichts tun! (der ist höherpriorisiert)}
pusha
push es
push 0c000h
test bl,80h ;{EIN oder AUS?}
jnz @@ein
push 0
jmp @@aus
@@ein: push word ptr [MRom+10] {HC-BASIC}
@@aus: push 0 ;{Start im Segment}
push 8 ;{Kilobytes}
push 1
call map
pop es
popa
@@1: pop ax
end;
procedure IOW4_89; near; assembler;
asm
push ax
mov al,bl
xchg al,[KC4Port89H]
xor al,bl ;{Bit-Veränderungen}
test al,80h ;{Betrifft Blinken?}
jz @@1
@@1: pop ax
end;
procedure IOW4_84; near; assembler;
asm
push ax
mov al,bl
xchg al,[KC4Port84H]
xor al,bl ;{Bit-Veränderungen}
test al,6 ;{Pixel/Farb- oder Bild-Umschaltung?}
jz @@1
pusha
push es
push 8000h
push [KCIRM].Sel
mov al,[KC4Port84H]
and ax,6
shl ax,13
mov [KCIRM].Ofs,ax ;{neu!}
shr ax,10 ;{in Kilobytes}
push ax
push 10 ;{Kilobytes}
push true
call Map ;{Map-In, kein Map-Out erforderlich!}
pop es
popa
@@1: test al,9 ;{Modus- oder Bild-Umschaltung?}
jz @@2
call IRM_Update4 ;{Komplett neu zeichnen}
@@2: pop ax
end;
procedure IOW4_86; near; assembler;
asm
push ax
mov al,bl
xchg al,[KC4Port86H]
xor al,bl ;{Bit-Veränderungen}
test al,80h ;{Betrifft CAOS-ROMC?}
jz @@1
pusha
push es
push 0c000h
test bl,80h ;{EIN oder AUS?}
jnz @@caos
test [KC4Port88H],80h
jnz @@basic
push 0
jmp @@aus
@@caos: push word ptr [MRom+6] {CAOS-ROMC}
jmp @@aus
@@basic: push word ptr [MRom+10] {HC-BASIC}
@@aus: push 0 ;{Start im Segment}
push 8 ;{Kilobytes}
push 1
call map
pop es
popa
@@1: pop ax
end;
procedure IOWrite4; near; assembler;
asm cmp al,88h
jne @@w1
jmp IOW4_88
@@w1: cmp al,89h
jne @@w2
jmp IOW4_89
@@w2: cmp al,84h
jne @@w3
jmp IOW4_84
@@w3: cmp al,86h
jne @@w4
jmp IOW4_86
@@w4: end;
procedure IrqProc; near; assembler;
asm
end;
procedure IORead; near; assembler;
asm mov al,$ff
end;
procedure IORead4; near; assembler;
asm cmp al,88h
jnz @@w
mov al,[KC4Port88H]
ret
@@w: cmp al,89h
jnz @@w2
mov al,[KC4Port89H]
ret
@@w2: mov al,$ff
end;
procedure CPUEmu; near; external;
procedure CallAX; near; external;
procedure DoNMI; near; external;
procedure DoINT; near; external; {Interrupt mit Vektor AL ausführen}
{$L KC880.OBJ}
{Die KC's müßten sich eigentlich strukturieren lassen!}
type
TKCInfo=record
memwrite: Word; {Speicherschreib-Prozedur}
ioread: Word;
iowrite: Word;
intchk: Word;
event: TCallEvent; {Langsame Prozeduren mit KCEV_xxx-Konstanten}
screen: TPoint; {(anfängliche) Bildschirmgröße in Pixeln}
color: Boolean;
coldpc: Word; {Kalt-Boot-Start}
warmpc: Word; {Warm-Boot-Start}
freq: Word; {Nominelle Taktfrequenz}
chargen: Word; {Zeichengenerator-Ressourcen-ID}
rom: array[0..3] of LongRec; {4 ROMs sollten reichen}
ram: array[0..3] of LongRec; {4 RAMs sollten reichen}
end;
{rom: LongRec.Lo:Einblend-Adresse, .Hi:Ressourcen-ID
ram: LongRec.Lo:Einblend-Adresse, .Hi:Länge in KB}
const
KCEV_Init=DRV_User+1;
KCEV_Done=DRV_User+2;
KCEV_KeyDown=DRV_User+3;
KCEV_KeyUp=DRV_User+4;
KCEV_Copy=DRV_User+5;
KCEV_Paste=DRV_User+6;
KCEV_ColdBoot=DRV_User+7;
KCEV_WarmBoot=DRV_User+8;
KCEV_Load=DRV_User+9;
KCEV_Save=DRV_User+10;
KCEV_ReasCallHint=DRV_User+11;
{nach CALL zu bestimmten Adressen steht oft DB xx als UP-Nr., systemabh.}
procedure LoadKCMem(src:Pointer; dst:Word; len:Word); assembler;
asm cld
les si,[src]
mov bx,[dst]
mov cx,[len]
jcxz @@e
@@l: seges lodsb
push es
mov es,[MemKCSel]
call [memwr]
inc bx
pop es
loop @@l
@@e: end;
function ModulProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
{nichtmodales Fenster zum Stecken und Ziehen von KC-Modulen}
var
S: array[byte] of Char;
I,K: Integer;
W: HWnd;
IA: array[0..34] of Integer; {Index-Array, wir haben 35 Module}
begin
ModulProc:=false;
case Msg of
WM_InitDialog: begin
W:=GetDlgItem(Wnd,104);
for I:=2048 to 2082 do begin
LoadString(Seg(HInstance),I,S,sizeof(S));
SendMessageP(W,LB_AddString,0,@S);
end;
ModulProc:=true;
end;
WM_Activate: if wParam<>0 then hKBWnd:=Wnd else hKBWnd:=0;
WM_EnterIdle: SendMessage(MainWnd,Msg,wParam,lParam);
{wird nur fürs Systemmenü gebraucht}
WM_Command: case wParam of
102: begin {Dazu}
W:=GetDlgItem(Wnd,104);
K:=SendMessageP(W,LB_GetSelItems,sizeof(IA) div 2,@IA);
for I:=0 to K-1 do begin
SendMessageP(W,LB_GetText,IA[I],@S);
SendDlgItemMsgP(Wnd,101,LB_AddString,0,@S);
end;
end;
103: begin {Weg}
W:=GetDlgItem(Wnd,101);
K:=SendMessageP(W,LB_GetSelItems,sizeof(IA) div 2,@IA);
for I:=0 to K-1 do begin
SendMessage(W,LB_DeleteString,IA[I],0);
end;
end;
ID_OK: ; {Module wirksam machen}
ID_Cancel: DestroyWindow(Wnd); {Wegtreten}
9: WinHelp(Wnd,HelpFile,HELP_Context,105);
end;
WM_Destroy: hModul:=0;
end;
end;
function KeySetProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
{Modaler Dialog: Scancode setzen}
var
f: Integer;
begin
KeySetProc:=false;
case Msg of
WM_InitDialog: begin
SetDlgItemText(Wnd,100,PChar(lParam));
KeySetProc:=true;
end;
WM_Command: case wParam of
ID_OK,ID_Cancel: EndDialog(Wnd,1);
9: WinHelp(Wnd,HelpFile,HELP_Context,205);
end;
end;
end;
function KeymapProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
{nichtmodales Fenster zum Festlegen der Tastaturzuordnung}
var
lPar: LongRec absolute lParam;
S: array[0..31] of Char;
I,K: Integer;
W: HWnd;
begin
KeymapProc:=false;
case Msg of
WM_InitDialog: begin
W:=GetWindow(Wnd,GW_Child); {Fensterliste durchgehen}
repeat
I:=GetDlgCtrlID(W)-100;
if (0<I) and (I<100) then begin {Scancode?}
if I>=70 then I:=I or $100; {Nicht den num. Block!}
if GetKeyNameText(MakeLong(0,I),S,sizeof(S)-1)>0 then begin
S[4]:=#0; {String begrenzen}
SetWindowText(W,S); {Neuer Schriftzug!}
end;
end;
W:=GetWindow(W,GW_HWndNext);
until W=0;
KeymapProc:=true;
end;
WM_Activate: if wParam<>0 then hKBWnd:=Wnd else hKBWnd:=0;
WM_EnterIdle: SendMessage(MainWnd,Msg,wParam,lParam);
{wird nur fürs Systemmenü gebraucht}
WM_Command: case wParam of
101..199: begin
I:=wParam-100;
if I>=70 then I:=I or $100; {Nicht den num. Block!}
if GetKeyNameText(MakeLong(0,I),S,sizeof(S)-1)<=0
then GetWindowText(lPar.Lo,S,sizeof(S));
DialogBoxParam(Seg(HInstance),MakeIntResource(205),Wnd,@KeySetProc,
LongInt(@S));
end;
ID_OK: ; {Tastatur wirksam machen}
ID_Cancel: DestroyWindow(Wnd); {Wegtreten}
9: WinHelp(Wnd,HelpFile,HELP_Context,204);
end;
WM_Destroy: hKeymap:=0;
end;
end;
function AboutProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
const
RME: array[0..18]of Char='NOTEPAD README.TXT';
var
f: Integer;
begin
AboutProc:=false;
case Msg of
WM_InitDialog: AboutProc:=PostMessage(Wnd,WM_User+100,0,0);
WM_User+100: begin
f:=_lopen(RME+8,0);
if f<>-1 then begin
_lclose(f);
EnableWindow(GetDlgItem(Wnd,11),true);
end;
end;
WM_Command: case wParam of
ID_OK,ID_Cancel: EndDialog(Wnd,1);
11: WinExec(RME,SW_Show);
end;
end;
end;
procedure SetBlinken(NewBlinken:Boolean);
begin
if Blinken<>NewBlinken then begin
Blinken:=NewBlinken;
if (2<=KCTyp) and (KCTyp<=6) then begin
if Blinken
then SetTimer(MainWnd,1,400,nil)
else KillTimer(MainWnd,1);
end;
end;
end;
procedure ShowFreq;
var
vsrec: record
sp: PChar;
hz: LongInt; {bestehend aus Zahl und Rest}
end;
S: array[0..63] of Char;
begin
vsrec.sp:=AppName;
if EmuShowClock<>1 then begin
vsrec.hz:=LongDivWR(Freq,1000);
wvsprintf(S,'%s - %u.%03u MHz',vsrec);
end else begin
vsrec.hz:=LongDivWR(MulDivW(Freq,1000,KCClock),10);
wvsprintf(S,'%s - %u.%u %%',vsrec);
end;
SetWindowText(MainWnd,S);
end;
procedure SetFreq(NewFreq:Word); {Freq in Kilohertz}
begin
if Freq<>NewFreq then begin
Freq:=NewFreq;
if EmuShowClock=0 then exit; {nichts tun!}
ShowFreq;
end;
end;
procedure ShowBlocked; {Anzeige "KC-Emulator (Angehalten)"}
var
vsrec: record
s1,s2: PChar;
end;
S: array[0..63] of Char;
S1: array[0..16] of Char;
begin
vsrec.s1:=AppName;
LoadString(Seg(HInstance),107,S1,sizeof(S1));
vsrec.s2:=S1;
wvsprintf(S,'%s (%s)',vsrec);
SetWindowText(MainWnd,S);
end;
procedure SetBlock(NewBlock:Byte); {<>0 wenn Blockierung}
begin
if EmuBlock<>NewBlock then begin
if EmuShowClock<>0 then begin {sonst nichts an Titelzeile tun!}
if (EmuBlock=0) and (NewBlock<>0) then ShowBlocked;
if (EmuBlock<>0) and (NewBlock=0) then begin
ShowFreq; {Frequenz wieder anzeigen}
TickTaken:=cTicks;
TimeTaken:=Word(GetTickCount); {Neue Messung}
end;
end;
EmuBlock:=NewBlock;
end;
end;
procedure SetShowClock(NewShowClock:Integer);
begin
if EmuShowClock<>NewShowClock then begin
EmuShowClock:=NewShowClock;
if EmuShowClock=0 then SetWindowText(MainWnd,AppName)
else if EmuBlock<>0 then ShowBlocked else ShowFreq;
end;
end;
function EmuSetProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
lPar: LongRec absolute lParam;
W,Mask: Word;
begin
EmuSetProc:=false;
case Msg of
WM_InitDialog: begin
Mask:=EmuBlockMask;
for W:=101 to 103 do begin
if Mask and 1 =0 then CheckDlgButton(Wnd,W,1);
Mask:=Mask shr 1;
end;
CheckDlgButton(Wnd,105+EmuShowClock,1);
if Blinken then CheckDlgButton(Wnd,108,1);
EmuSetProc:=true;
end;
WM_Command: case wParam of
ID_OK: begin
Mask:=0;
for W:=103 downto 101 do begin
Mask:=Mask shl 1;
if IsDlgButtonChecked(Wnd,W)<>1 then Inc(Mask);
end;
EmuBlockMask:=Mask;
for W:=105 to 107 do if IsDlgButtonChecked(Wnd,W)=1 then break;
SetShowClock(W-105);
SetBlinken(IsDlgButtonChecked(Wnd,108)=1);
EndDialog(Wnd,1);
end;
ID_Cancel: EndDialog(Wnd,2);
9: WinHelp(Wnd,HelpFile,HELP_Context,208);
end;
end;
end;
function GetWindowArgs(Wnd: HWnd; var Args:TArgs):Boolean;
{liefert TRUE, wenn alle Argumente okay oder auch leere Zeichenkette.
Args.argn enthält die gewandelte Argumente-Zahl, auch bei Rückkehr mit FALSE}
var
S: array[0..31] of Char;
SP,SP1,SP2: PChar;
EC: Integer;
begin
GetWindowArgs:=false;
SP:=S+1;
GetWindowText(Wnd,SP,sizeof(S)-1);
Args.argn:=0;
while (Args.argn<3)
and (SP^<>#0) do begin
SP1:=lStrChr(SP,' ');
if SP1<>nil then SP1^:=#0; {am Leerzeichen terminieren}
if SP^='#' then SP2:=SP+1 {Dezimal-Kennung}
else begin
SP2:=SP-1;
SP2^:='$'; {Präfix für Hex-VAL}
end;
Val(SP2,Args.arg[Args.argn+1],EC);
if EC<>0 then exit; {Fehler!}
if SP1<>nil then SP:=SP1+1 else SP^:=#0;
Inc(Args.argn);
end;
GetWindowArgs:=true;
end;
procedure SetWindowArgs(Wnd: HWnd; const Args:TArgs);
{setzt bis zu 3 hexadezimale Argumente, mit je 1 Leerzeichen getrennt}
var
S: array[0..31] of Char;
I: Byte;
Z: Integer;
begin
Z:=0; {Zeichenzahl}
for I:=1 to Args.argn do begin
Inc(Z,wvsprintf(S+Z,'%04X',Args.arg[I]));
if I<>Args.argn then begin
S[Z]:=' '; Inc(Z);
end;
end;
SetWindowText(Wnd,S);
end;
function GetFileArgs(f,Typ: Integer; var Args:TArgs):Boolean;
{Typ ist hierbei bitteschön niemals 0!
f ist eine frisch zum Lesen geöffnete Datei, Dateizeiger=0!
liefert FALSE wenn keine gültige .KCC-Datei, zu große Binärdatei oder
ungültiges BASIC-Programm. Bei FALSE ist Args.argn undefiniert!}
var
KccHdr: TKccHdr;
L: LongInt;
begin
GetFileArgs:=false;
case Typ of
1: begin
_lread(f,PChar(@KCCHdr),sizeof(KCCHdr));
if (KccHdr.args.argn<2) or (KccHdr.args.argn>10) then exit;
_llseek(f,$80,0);
Move(KccHdr.args,Args,sizeof(Args));
if Args.argn>3 then Args.argn:=3;
end;
2: begin
L:=_llseek(f,0,2);
if L>$BE00 then exit; {SOO große Programme gibt's ja gar nicht!}
_llseek(f,0,0);
Args.argn:=2;
Args.arg[1]:=$200; {mal angenommen}
Args.arg[2]:=Args.arg[1]+LongRec(L).Lo;
end;
3: begin
Args.argn:=2;
Args.arg[1]:=$401; {Anfang für ROM-BASIC}
_lread(f,PChar(@Args.arg[2]),2);{Zeiger jetzt richtig}
if Args.arg[2]>$BB00 then exit; {BASIC-Programm zu groß}
Inc(Args.arg[2],Args.arg[1]);
end;
end;
GetFileArgs:=true;
end;
const
ID_OfnFileEdit=1152;
ID_OfnFileList=1120;
ID_OfnFilter=1136;
ID_OfnComment=100;
ID_OfnHelp=1038;
ID_OfnWriteProt=1040;
var
WM_FileOK: Word;
function OFNHook(Wnd:HWnd; Msg,wParam:Word; lParam:Longint):Word; export;
{Diese Hook-Funktion verlängert die Datei-Öffnen-Standarddialoge um eine
Zeile für Anfangs-, End- und (ggf) Startadresse.
lCustData zeigt auf TArgs-Struktur.}
var
lPar: LongRec absolute lParam;
S: array[0..31]of Char; {Dateiname sowie Lade-Strings}
f: Integer;
R: TRect;
P: TPoint;
Fnt: HFont;
W: HWnd absolute P;
ofnp: POpenFileName absolute lParam;
begin
OFNHook:=0;
case Msg of
WM_InitDialog: begin
WM_FileOK:=RegisterWindowMessage(FileOKString);
Longint(P):=GetDialogBaseUnits;
GetClientRect(Wnd,R); {Neue Dialogelemente an die Unterkante}
LoadString(Seg(HInstance),104,S,sizeof(S));
SetDlgItemText(Wnd,ID_OfnWriteProt,S);
LoadString(Seg(HInstance),103,S,sizeof(S));
Fnt:=SendMessage(Wnd,WM_GetFont,0,0);
SendMessage(CreateWindow('STATIC',S,
WS_Child or WS_Visible or SS_Left or WS_Group,
MulDiv(P.X,6,4),R.bottom,MulDiv(P.X,34,4),MulDiv(P.Y,8,8),
Wnd,Word(-1),Seg(HInstance),nil),WM_SetFont,Fnt,0);
SendMessage(CreateWindow('EDIT','?',
WS_Child or WS_Visible or WS_Border or WS_TabStop
or ES_Left or ES_AutoHScroll or ES_ReadOnly,
MulDiv(P.X,40,4),R.bottom+MulDiv(P.Y,-2,8),
R.right+MulDiv(P.X,-46,4),MulDiv(P.Y,10,8),
Wnd,ID_OfnComment,Seg(HInstance),nil),WM_SetFont,Fnt,0);
GetWindowRect(Wnd,R); {Fenster vergrößern}
MoveWindow(Wnd,R.left,R.top,R.right-R.left,
R.bottom-R.top+MulDiv(P.Y,14,8),false);
OfnHook:=1;
end;
WM_Command: case wParam of
{ID_OfnFilter unnötig, Dateiliste wird ohnehin neu aufgebaut}
ID_OfnFileList: if lPar.Hi=LBN_SelChange then begin
R.bottom:=SendDlgItemMessage(Wnd,ID_OfnFilter,CB_GetCurSel,0,0)+1;
R.left:=SendMessage(lPar.Lo,LB_GetCurSel,0,0);
W:=GetDlgItem(Wnd,ID_OfnComment);
SetWindowText(W,'?');
if R.left<0 then exit; {mit Fragezeichen stehenlassen}
SendMessageP(lPar.Lo,LB_GetText,R.left,@S);
f:=_lopen(S,0);
if f=-1 then exit;
if GetFileArgs(f,R.bottom,LoadSaveArgs)
then SetWindowArgs(W,LoadSaveArgs);
_lclose(f);
end;
ID_OfnHelp: WinHelp(Wnd,HelpFile,HELP_Context,102);
end{case wParam};
else if Msg=WM_FileOK then begin
W:=GetDlgItem(Wnd,ID_OfnComment);
if (not GetWindowArgs(W,LoadSaveArgs))
or (LoadSaveArgs.argn<2) then begin
MBox1(Wnd,106,nil);
SetFocus(W);
SendMessage(W,EM_SetSel,0,$FFFF0000);
OfnHook:=1; {Nicht weiterarbeiten!}
end;
end;
end{case Msg};
end;
function ScanInt(var SP: PChar; var I:Integer):Boolean;
var
SP1: PChar;
K,EC: Integer;
begin
ScanInt:=false;
SP1:=lStrChr(SP,' ');
if SP1<>nil then SP1^:=#0;
Val(SP,K,EC);
if EC=0 then begin
if SP1<>nil then SP:=SP1+1 else Inc(SP,lstrlen(SP));
I:=K;
ScanInt:=true;
end;
end;
procedure SetNewPixmap(x,y:Integer; Bunt:Boolean);
{x darf nicht 0 sein, sonst würde das Fenster zu schmal gesetzt werden.
y dagegen darf 0 sein und stellt den Client-Bereich auf Höhe Null}
var
WP: TWindowPlacement;
NewDisplay: Boolean absolute WP;
I: Integer absolute WP;
begin
NewDisplay:=Display=0; {neues Display auf jeden Fall wenn Null}
if (KCPixmap.x<>x) or (KCPixmap.y<>y) then begin
KCPixmap.x:=x;
KCPixmap.y:=y; {Neue Dimensionen eintragen}
if y<>0 then begin {Nullclient sieht erst mal doof aus!}
wp.length:=sizeof(wp);
if GetWindowPlacement(MainWnd,@WP)
then with WP,WP.rcNormalPosition do begin
right:=left+x+Saum.x;
bottom:=top+y+Saum.y;
SetWindowPlacement(MainWnd,@WP); {Fenster umsetzen}
if IsZoomed(MainWnd) then MoveWindow(MainWnd,
ptMaxPosition.x,ptMaxPosition.y,x*2+Saum.x,y*2+Saum.y,true);
end; {Extrawurst für maximiertes Fenster}
end;
NewDisplay:=true;
end;
if bunt and (KCPixmap.b=1) then begin
KCPixmap.b:=8;
KCPixmap.c:=32;
for I:=0 to 31 do KCPixmap.col[I]:=I;
NewDisplay:=true;
end;
if not bunt and (KCPixmap.b<>1) then begin
KCPixmap.b:=1;
KCPixmap.c:=2;
KCPixmap.col[0]:=0;
KCPixmap.col[1]:=15;
NewDisplay:=true;
end;
if NewDisplay then begin
if Display<>0 then Display:=GlobalFree(Display);
if not bunt then x:=x shr 3; {S/W: 1 Byte für 8 Pixel!}
if y<>0 then Display:=GlobalAlloc(GMEM_Fixed,LongMul(x+3 and not 3,y));
InvalWnd;
end; {Auf /4 teilbare Bytezahl aufrunden}
end;
procedure TouchVideo(start,len,IRM_Acc:Word); assembler;
asm call InvalWnd {keine Einzel-Regionen "updaten"!}
mov cx,[len]
jcxz @@e
mov es,[MemKCSel]
mov bx,[start]
@@l: mov al,es:[bx]
call [IRM_Acc]
inc bx
loop @@l
@@e: end;
procedure PokeKC3Char(C:Char); assembler;
asm mov es,[MemKCSel]
mov al,[C]
mov bx,[Regs.IX]
add bx,0dh
call [MemWR]
add bx,8-0dh
mov al,es:[bx]
or al,1
call [MemWR] {Keycode-Avail-Bit setzen}
jmp @@e
@@e: end;
procedure KeyUpKC3; assembler;
asm mov es,[MemKCSel]
mov bx,[Regs.IX]
add bx,0dh
mov al,0
call [MemWR]
{Tastencode löschen, Keycode-Avail-Bit bleibt stehen!}
end;
{Event-Routine, ES=MemKCSel, AX=Ereignis (KCEV_xxx)}
function Event1(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
case Msg of
KCEV_Init: begin
if KCTyp=1 then wParam:=Ofs(IRM_Access1)
else wParam:=Ofs(IRM_Access7);
TouchVideo($EC00,$0400,wParam);
end;
KCEV_KeyDown: asm
mov es,[MemKCSel]
mov al,byte ptr [wParam]
mov bx,25h
call [memwr]
end;
KCEV_KeyUp: ;
end;
end;
function Event3(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
case Msg of
KCEV_Init: begin
TouchVideo($A800,$0A00,Ofs(IRM_Access3)); {Farbe "berühren" genügt}
end;
KCEV_KeyDown: PokeKC3Char(Char(wParam));
KCEV_KeyUp: KeyUpKC3;
end;
end;
function Event4(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
case Msg of
KCEV_Init: begin
MRom[1].Hi:=GlobalReAlloc(MRom[1].Hi,$2000,GMEM_ZeroInit);
KCIRM.Sel:=PageAlloc(64);
KCIRM.Ofs:=0;
KC4Port84H:=0; {z.Z. Pixel-Zugriff, hohe Auflösung}
KC4Port86H:=0;
KC4Port88H:=$FF;
KC4Port89H:=$FF;
IRM_Update4;
{InitKCModules;}
end;
KCEV_KeyDown: PokeKC3Char(Char(wParam));
KCEV_KeyUp: KeyUpKC3;
KCEV_Done: begin
{DoneKCModules;}
KCIRM.Sel:=PageFree(KCIRM.Sel);
end;
end;
end;
function Event8(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin SendDriverMessage(UserInfo.hDrv,Msg,lParam,LongInt(@UserInfo));
end;
function Event9(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
case Msg of
KCEV_Init: begin
TouchVideo($EC00,$0400,Ofs(IRM_Access9));
end;
end;
end;
const
KCInfo: array[1..9] of TKCInfo=(( {KC85/1 - Z9001}
memwrite: ofs(MemWrite1);
ioread: ofs(IORead);
iowrite: ofs(IOWrite);
intchk: ofs(IrqProc);
event: Event1;
screen: (x:320; y: 192);
color: false;
coldpc: $F000;
warmpc: $F000;
freq: 2500;
chargen: 911;
rom:((Lo:$F000;Hi:701),(Lo:$C000; Hi:006),(Lo:0;Hi:0),(Lo:0;Hi:0));
ram:((Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))
),( {KC85/2 - HC900}
memwrite: ofs(MemWrite3);
ioread: ofs(IORead);
iowrite: ofs(IOWrite);
intchk: ofs(IrqProc);
event: Event3;
screen: (x:320; y: 256);
color: true;
coldpc: $F000;
warmpc: $E000;
freq: 1750;
chargen: 0;
rom:((Lo:$E000;Hi:0),(Lo:$F000; Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0));
ram:((Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))
),( {KC85/3}
memwrite: ofs(MemWrite3);
ioread: ofs(IORead);
iowrite: ofs(IOWrite);
intchk: ofs(IrqProc);
event: Event3;
screen: (x:320; y: 256);
color: true;
coldpc: $F000;
warmpc: $E000;
freq: 1750;
chargen: 0;
rom:((Lo:$E000;Hi:301),(Lo:$C000; Hi:006),(Lo:0;Hi:0),(Lo:0;Hi:0));
ram:((Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))
),( {KC85/4}
memwrite: ofs(MemWrite4);
ioread: ofs(IORead4);
iowrite: ofs(IOWrite4);
intchk: ofs(IrqProc);
event: Event4;
screen: (x:320; y: 256);
color: true;
coldpc: $F000;
warmpc: $E000;
freq: 1750;
chargen: 0;
rom:((Lo:$E000;Hi:420),(Lo:$C000; Hi:421),(Lo:0;Hi:6),(Lo:0;Hi:0));
ram:((Lo:0;Hi:16),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))
),( {KC85/5}
memwrite: ofs(MemWrite4);
ioread: ofs(IORead4);
iowrite: ofs(IOWrite4);
intchk: ofs(IrqProc);
event: Event4;
screen: (x:320; y: 256);
color: true;
coldpc: $F000;
warmpc: $E000;
freq: 1750;
chargen: 0;
rom:((Lo:$E000;Hi:422),(Lo:$C000; Hi:423),(Lo:0;Hi:6),(Lo:0;Hi:0));
ram:((Lo:0;Hi:16),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))
),( {KC85/3 mit CAOS 3.4}
memwrite: ofs(MemWrite3);
ioread: ofs(IORead);
iowrite: ofs(IOWrite);
intchk: ofs(IrqProc);
event: Event3;
screen: (x:320; y: 256);
color: true;
coldpc: $F000;
warmpc: $E000;
freq: 1750;
chargen: 0;
rom:((Lo:$E000;Hi:304),(Lo:$C000; Hi:006),(Lo:0;Hi:0),(Lo:0;Hi:0));
ram:((Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))
),( {KC87 mit Farboption}
memwrite: ofs(MemWrite7);
ioread: ofs(IORead);
iowrite: ofs(IOWrite);
intchk: ofs(IrqProc);
event: Event1;
screen: (x:320; y: 192);
color: true;
coldpc: $F000;
warmpc: $F000;
freq: 2500;
chargen: 911;
rom:((Lo:$F000;Hi:701),(Lo:$C000; Hi:006),(Lo:0;Hi:0),(Lo:0;Hi:0));
ram:((Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))
),( {benutzerdefiniert: KC in der KCEMU.DLL}
memwrite: ofs(MemWrite8);
ioread: ofs(IORead);
iowrite: ofs(IOWrite);
intchk: ofs(IrqProc);
event: Event8;
screen: (x:320; y: 0);
color: false;
coldpc: 0;
warmpc: 0;
freq: 2500;
chargen: 0;
rom:((Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0));
ram:((Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))
),( {Z1013}
memwrite: ofs(MemWrite9);
ioread: ofs(IORead);
iowrite: ofs(IOWrite);
intchk: ofs(IrqProc);
event: Event9;
screen: (x:256; y: 256);
color: false;
coldpc: $F000;
warmpc: $F000;
freq: 2000;
chargen: 911;
rom:((Lo:$F000;Hi:901),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0));
ram:((Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0),(Lo:0;Hi:0))));
procedure PowerOn;
var
I: Integer;
begin {geladene ROMs einblenden}
for I:=0 to 3 do with Mrom[I] do if (Hi<>0) and (Lo<>0)
then Move(Mem[Hi:0],Mem[MemKCSel:Lo],GlobalSize(Hi));
FillChar(Regs,sizeof(Regs),0);
Regs.pc:=KCInfo[KCTyp].coldpc; {PowerOn-Startpunkt}
CallEvent(KCEV_ColdBoot,0,0);
SetBlock(EmuBlock and not $10); {F9-Block aufheben}
end;
procedure DoReset;
begin
FillChar(Regs,sizeof(Regs),0);
Regs.pc:=KCInfo[KCTyp].warmpc; {Reset-Startpunkt}
CallEvent(KCEV_WarmBoot,0,0);
SetBlock(EmuBlock and not $10); {F9-Block aufheben}
end;
procedure RemoveAnySelection; forward;
procedure SetNewKC(NewKCTyp: Integer);
{hier erfolgt zentral die Ressourcenverwaltung für die einzelnen Typen.
Bei Übergabe von 0 werden alle Ressourcen freigegeben}
var
M: HMenu;
R: TRect;
I: Integer;
begin
RemoveAnySelection;
if KCTyp<>NewKCTyp then begin
M:=GetMenu(MainWnd);
if KCTyp<>0 then begin
CheckMenuItem(M,KCTyp+210,MF_Unchecked);
CallEvent(KCEV_Done,0,0);
if Blinken and (KCPixMap.c>2) then KillTimer(MainWnd,1);
if hCharMap<>0 then hCharMap:=THandle(FreeResource(hCharMap));
for I:=0 to 3 do with Mrom[I] do if Hi<>0
then Hi:=THandle(FreeResource(Hi));
for I:=0 to 3 do with Mram[I] do Hi:=PageFree(Hi);
if KCTyp=8 then begin
if UserInfo.hDrv<>0
then CloseDriver(UserInfo.hDrv,UserInfo.user,LongInt(@UserInfo));
SetBlock(EmuBlock and not $20); {NoDLL-Block aufheben}
end;
end;
KCTyp:=NewKCTyp;
if KCTyp<>0 then with KCInfo[KCTyp] do begin
CheckMenuItem(M,KCTyp+210,MF_Checked);
if KCTyp=8 then begin
Move(screen,UserInfo.screen,12);
Move(rom,UserInfo.rom,32);
UserInfo.hDrv:=OpenDriver('USER.KEL',nil,LongInt(@UserInfo));
if UserInfo.hDrv<>0 then begin
Move(UserInfo.screen,screen,12);
Move(UserInfo.rom,rom,32);
end else begin
SetBlock(EmuBlock or $20); {NoDLL-Block setzen}
MBox1(MainWnd,108,'USER.KEL');
end;
end;
SetNewPixmap(screen.x,screen.y,color);
if Blinken and (KCPixMap.c>2) then SetTimer(MainWnd,1,400,nil);
KCClock:=freq;
MemWR:=memwrite;
IORd:=ioread;
IOWr:=iowrite;
CallEvent:=event;
if chargen<>0 then begin
hCharMap:=LoadResource(Seg(HInstance),
FindResource(Seg(HInstance),MakeIntResource(chargen),RT_RCData));
if hCharMap=0 then RunError(220);
end;
for I:=0 to 3 do with Mrom[I] do if rom[I].Hi<>0 then begin
Hi:=LoadResource(Seg(HInstance),
FindResource(Seg(HInstance),MakeIntResource(rom[I].Hi),RT_RCData));
if Hi=0 then RunError(220);
Lo:=rom[I].Lo; {Standard-Einblendadresse}
end;
for I:=0 to 3 do with Mram[I] do if ram[I].Hi<>0 then begin
Hi:=PageAlloc(ram[I].Hi);
if Hi=0 then RunError(221);
end;
PowerOn;
CallEvent(KCEV_Init,0,0);
end else if Display<>0 then Display:=GlobalFree(Display);
end;
end;
procedure SetMenuFlags(NewMenuFlags:Integer);
var
M: HMenu;
I,Mask,Check: Word;
begin
M:=GetMenu(MainWnd);
Mask:=1;
for I:=201 to 203 do begin
if (NewMenuFlags xor MenuFlags) and Mask <>0 then begin
MenuFlags:=MenuFlags xor Mask;
if MenuFlags and Mask <>0
then Check:=MF_Checked
else Check:=MF_Unchecked;
CheckMenuItem(M,I,Check);
end;
end;
end;
const
stConfigKey: array[0..12] of Char='KCEMU\config';
stPlacement: array[0..9] of Char='placement';
stKCTyp: array[0..5] of Char='kctyp';
procedure LoadConfig;
var
wp: TWindowPlacement;
S: array[0..255]of Char;
SP: PChar;
I: Integer;
Key: HKey; {Mit geöffnetem Schlüssel geht's schneller!}
begin
if RegOpenKey(HKCR,stConfigKey,Key)<>0 then exit;
if RegGetVal(Key,stPlacement,S,sizeof(S))
then with wp do begin
Installed:=true;
SP:=S;
length:=sizeof(wp);
ScanInt(SP,Integer(CmdShow));
if HPrevInst=0 then begin {nur das 1. Fenster nach Konfig setzen!}
ShowCmd:=SW_Hide;
flags:=0;
ScanInt(SP,rcNormalPosition.left);
rcNormalPosition.right:=rcNormalPosition.left+KCPixmap.x+Saum.x;
ScanInt(SP,rcNormalPosition.top);
rcNormalPosition.bottom:=rcNormalPosition.top+KCPixmap.y+Saum.y;
ScanInt(SP,ptMaxPosition.x);
ScanInt(SP,ptMaxPosition.y);
SetWindowPlacement(MainWnd,@wp);
end;
end;
if RegGetVal(Key,stKCTyp,S,sizeof(S)) then begin
SP:=S;
if ScanInt(SP,I) then SetNewKC(I);
if ScanInt(SP,I) then SetMenuFlags(I);
if ScanInt(SP,I) then EmuBlockMask:=I;
if ScanInt(SP,I) then SetShowClock(I);
if ScanInt(SP,I) then SetBlinken(I=1);
end;
RegCloseKey(Key);
end;
procedure SaveConfig;
var
wp: TWindowPlacement;
S: array[0..255]of Char;
ia: array[0..4] of Integer;
Key: HKey; {mit geöffnetem Schlüssel sollte das Speichern schneller sein}
begin
if RegCreateKey(HKCR,stConfigKey,Key)<>0 then exit;
wp.length:=sizeof(wp);
if GetWindowPlacement(MainWnd,@wp) then begin
ia[0]:=wp.showCmd;
ia[1]:=wp.rcNormalPosition.left;
ia[2]:=wp.rcNormalPosition.top;
ia[3]:=wp.ptMaxPosition.x;
ia[4]:=wp.ptMaxPosition.y;
wvsprintf(S,'%d %d %d %d %d',ia);
RegSetVal(Key,stPlacement,S);
end;
ia[0]:=KCTyp;
ia[1]:=MenuFlags;
ia[2]:=EmuBlockMask;
ia[3]:=EmuShowClock;
ia[4]:=Integer(Blinken);
wvsprintf(S,'%d %d %d %d %d',ia);
RegSetVal(Key,stKCTyp,S);
RegCloseKey(Key);
end;
function InputArgsProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool;
export;
var
ArgP: PArgs absolute lParam;
begin
InputArgsProc:=false;
case Msg of
WM_InitDialog: begin
SetWindowArgs(GetDlgItem(Wnd,100),LoadSaveArgs);
InputArgsProc:=true;
end;
WM_Command: case wParam of
ID_OK: begin
if GetWindowArgs(GetDlgItem(Wnd,100),LoadSaveArgs)
then EndDialog(Wnd,ID_OK)
else begin
MBox1(Wnd,106,nil);
SetFocus(GetDlgItem(Wnd,100));
end;
end;
ID_Cancel: EndDialog(Wnd,ID_Cancel);
9: WinHelp(Wnd,HelpFile,HELP_Context,102);
end;
end;
end;
function LoadFile(Name:PChar; Typ: Integer; IgnoreROM: Boolean):Boolean;
{Benutzt die globale Variable LoadSaveArgs}
{Typ=0: je nach Endung, =1: .COM,.KCC, =2: .BIN, =3: .SSS,.BAS,...}
{IgnoreROM=true, wenn ROM gnadenlos überschrieben werden soll}
var
Ext: PChar;
f: Integer;
P: PChar; {Hilfsspeicher}
aa,ea,len: Word;
begin
f:=_lopen(Name,0);
if f=-1 then begin
MBox1(MainWnd,105,Name); {Huch?}
exit;
end;
if Typ=0 then begin
Ext:=GetFileNameExt(Name);
Typ:=2; {Normalerweise: Speicherabzug}
if (lstrcmpi(Ext,'.COM')=0) or (lstrcmpi(Ext,'.KCC')=0) then Typ:=1;
if (lstrcmpi(Ext,'.SSS')=0) or (lstrcmpi(Ext,'.BAS')=0) then Typ:=3;
end;
if LoadSaveArgs.argn=0 then begin {Adressen erfragen}
if not GetFileArgs(f,Typ,LoadSaveArgs) then begin
MBox1(MainWnd,105,nil);
exit;
end;
if DialogBox(Seg(HInstance),MakeIntResource(102),MainWnd,
@InputArgsProc)<>ID_OK then exit;
end;
aa:=LoadSaveArgs.arg[1]; len:=LoadSaveArgs.arg[2]-aa;
case Typ of
1: _llseek(f,$80,0); {Maschinenprogramm}
2: _llseek(f,0,0); {Speicherabzug}
3: begin {BASIC-Programm}
_llseek(f,2,0); {Länge übergehen}
ea:=aa+len;
LoadKCMem(@ea,$3D7,2);
LoadKCMem(@ea,$3D9,2);
LoadKCMem(@ea,$3DB,2); {Endadresse eintragen, Variablen löschen}
end;
end;
if IgnoreROM then _lread(f,Ptr(MemKCSel,aa),len)
else begin
P:=Ptr(GlobalAlloc(GMEM_Fixed,len),0);
_lread(f,P,len);
LoadKCMem(P,aa,len);
GlobalFree(PtrRec(P).Sel);
end;
_lclose(f);
end;
procedure PokeChar(C:Char);
begin
CallEvent(KCEV_KeyDown,Word(C),0);
end;
procedure PokeKey(W:Word); assembler;
asm push VK_Shift
call GetKeyState
test ax,$FFFE
mov ax,W {Low-Teil ohne Shift}
jz @@1
xchg al,ah {High-Teil mit Shift}
@@1: push ax
call PokeChar
end;
var
BremsZeit: Word;
BremsTick: LongInt;
procedure DirtyHack; near; assembler;
asm mov es,[MemKCSel]
mov bx,[Regs.IX]
add bx,8
mov al,es:[bx]
test al,2
jz @@e
and al,not 2
jmp [memwr]
@@e: end;
function IdleAction:Boolean;
{Hier kommt der Code der Emulation hin. Routine sollte nicht länger als
100 ms in Anspruch nehmen, da dann gestörter Bildaufbau und zähes Windows.
IdleAction liefet normalerweise TRUE, was bedeutet: Emulation fortsetzen.
Wenn das Programm dagegen z.B. auf Taste wartet, FALSE zurückgeben, damit
Windows "idlen" kann.}
var
T,I: Word;
L: LongInt;
begin
IdleAction:=false;
if MemWr=0 then exit;
SetBlock(EmuBlock and not 4); {Es fehlt da ein WM_LeaveIdle...}
if EmuBlock<>0 then exit;
{$Q-}
IdleAction:=true;
T:=Word(GetTickCount);
if MenuFlags and 1 <>0 then begin {Bremsen!}
I:=T-BremsZeit; {Differenz seit letzter Zeitnahme}
L:=cTicks-BremsTick;
if LongRec(L).Hi>=KCClock then begin
L:=0; {Notnagel!}
BremsTick:=cTicks;
end;
if I+54 < LongDivW(L,KCClock) then exit;
if I>100 then begin {nicht zu lange "nachlaufen"!}
if cTicks-BremsTick > LongMulW(200,KCClock)
then BremsTick:=cTicks-LongMulW(0,KCClock)
else Inc(BremsTick,LongMulW(I,KCClock));
BremsZeit:=T;
end;
end{ else BremsTick:=cTicks}; {Hm, immer?}
repeat
Expire:=65535;
CpuEmu;
DirtyHack;
until Word(GetTickCount)-T >= LastPaintTime;
LastPaintTime:=0;
GC_ShortCircuit:=false;
if EmuShowClock<>0 then begin
T:=Word(GetTickCount); I:=T-TimeTaken;
if I>=1000 then begin {Zeitdifferenz (Intervall) >=1 Sekunde?}
SetFreq(LongDivW(cTicks-TickTaken,I)); {in kHz}
TickTaken:=cTicks;
TimeTaken:=T;
end;
end;
end;
function TakeScreenshot:THandle;
{kopiert die momentane Pixmap und entfernt Blinkfarben}
var
HMem: THandle;
SP: PChar; {Wandernder Zeiger}
bih: PBitmapInfoHeader absolute SP; {Alias}
col: ^TRGBQuad absolute SP; {Alias}
siz: LongInt; {Bytes in Pixmap}
I,J: Integer;
begin
TakeScreenshot:=0;
if Display=0 then exit;
siz:=GlobalSize(Display);
if siz=0 then exit;
J:=min(KCPixmap.c,24); {Farbzahl, Blinkfarben auslassen!}
HMem:=GlobalAlloc(GMEM_Share,sizeof(TBitmapInfoHeader)+(J shl 2)+siz);
SP:=GlobalLock(HMem);
bih^:=KCPixmap.bih; {ganze Struktur kopieren}
bih^.biClrUsed:=J; {Farbzahl ggf. minimieren}
Inc(SP,sizeof(TBitmapInfoHeader));
for I:=0 to J-1 do with col^,TPaletteEntry(KCPalette.col[I]) do begin
rgbBlue:=peBlue; {einzelbyteweise, weil verdreht!}
rgbGreen:=peGreen; {in Assembler wäre hier ein stosb so schön!}
rgbRed:=peRed;
rgbReserved:=0;
Inc(SP,sizeof(TRGBQuad)); {4 Bytes vorrücken}
end;
hmemcpy(SP,Ptr(Display,0),siz); {Pixmap kopieren (lassen)}
if KCPixmap.c>24 then begin {Blinkfarben ausfiltern?}
repeat
I:=Byte(SP^)-24;
if (0<=I) and (I<8) then begin
Byte(SP^):=(BlinkFarben[I] shr 3) and $F +8;{Farbe 8..23 (VFarbe) setzen}
end;
IncHP(SP,1); {als Huge-Zeiger vorrücken}
Dec(siz);
until siz=0
end;
GlobalUnlock(HMem);
TakeScreenshot:=HMem;
end;
function CreateTRectRegion:HRgn;
var
R2: TRect;
Rgn1,Rgn2: HRgn; {Hilfsregion zum Zusammensetzen}
label
L1;
begin
Rgn1:=0; Rgn2:=0;
CopyRect(R2,SelectedRect);
if (RandL<RandR) and (R2.top<>R2.bottom) then begin
{So umsortieren, daß der 1. Punkt oben und der 2. Punkt unten ist}
if R2.top>R2.bottom then SetRect(R2,R2.right,R2.bottom,R2.left,R2.top);
{Test auf Anomalie (Mittelbereich hat negative Breite)}
if R2.top+1>R2.bottom then begin
SortRect(R2); {richtig sortieren}
goto L1; {weiter wie ohne Ränder}
end;
{Oberer Schwanz}
if R2.left<RandR then begin
Rgn1:=CreateRectRgn(R2.left,R2.top,RandR,R2.top+1);
end else Rgn1:=0;
Inc(R2.top,1); {weiter 'runter}
{Unterer Schwanz}
if R2.right>RandL then begin
Rgn2:=CreateRectRgn(RandL,R2.bottom,R2.right,R2.bottom+1);
end else Rgn2:=0;
{Kombinieren zu Rgn1}
if Rgn2<>0 then begin
if Rgn1=0 then Rgn1:=Rgn2
else begin
CombineRgn(Rgn1,Rgn1,Rgn2,RGN_XOR);
DeleteObject(Rgn2);
end;
end;
{Mittelbereich}
if R2.top<R2.bottom then begin
Rgn2:=CreateRectRgn(RandL,R2.top,RandR,R2.bottom);
end else Rgn2:=0;
{Kombinieren zu Rgn1}
if Rgn2<>0 then begin
if Rgn1=0 then Rgn1:=Rgn2
else begin
CombineRgn(Rgn1,Rgn1,Rgn2,RGN_XOR);
DeleteObject(Rgn2);
end;
end;
{Wert-Rückgabe}
CreateTRectRegion:=Rgn1;
end else begin
SortRect(R2);
{Nun Rechteck auf (mindestens) Buchstabenhöhe aufblasen}
L1:
Inc(R2.bottom);
CreateTRectRegion:=CreateRectRgnIndirect(R2);
end;
end;
procedure DrawSelection(DC:HDC);
var
OldMap,I: Integer;
begin
if SelectedRegion<>0 then begin
OldMap:=SetMapMode(DC,MM_AnIsotropic);
I:=1 shl ScrShift;
SetViewportExt(DC,I,I); {Bildschirm-Buchstaben}
SetWindowExt(DC,1,1); {ganze Buchstaben}
InvertRgn(DC,SelectedRegion);
SetMapMode(DC,OldMap);
end;
end;
procedure SelectionChanged;
{Aufruf, wenn sich SelectedRect oder RandL/R geändert hat}
var
DC:HDC;
hReg:HRgn;
begin
DC:=GetDC(MainWnd);
if SelectedRegion<>0 then begin
hReg:=CreateTRectRegion;
CombineRgn(SelectedRegion,SelectedRegion,hReg,RGN_XOR);
DrawSelection(DC); {die Differenzmenge "umklappen"}
DeleteObject(SelectedRegion); {alte Selektierung weg!}
SelectedRegion:=hReg; {neue Region setzen}
end else begin
SelectedRegion:=CreateTRectRegion;
DrawSelection(DC);
end;
ReleaseDC(MainWnd,DC);
end;
procedure MouseDrag(x,y:Integer); {Linke Maustaste gedrückt...}
var
R: TRect;
begin
GetClientRect(MainWnd,R);
x:=max(min(x,R.right-1),0) shr ScrShift;
asm jnc @@1; inc [x]; @@1: end;
y:=max(min(y,R.bottom-1),0) shr ScrShift;
{Clipping und in Zeichen umrechnen}
if (SelectedRect.right<>x) or (SelectedRect.bottom<>y) then begin
SelectedRect.right:=x;
SelectedRect.bottom:=y; {Neue zweite Ecke}
SelectionChanged;
end;
end;
procedure RemoveAnySelection;
var
DC:HDC;
begin
if SelectedRegion<>0 then begin
DC:=GetDC(MainWnd);
DrawSelection(DC);
SelectedRegion:=0; {Nichts mehr selektiert}
ReleaseDC(MainWnd,DC);
end;
end;
var
MouseX: Integer; {Maus-Position bevor TrackPopupMenu()}
LineDrawn: Boolean;
procedure DrawRandLinie(DC:HDC);
var
I: Integer;
R: TRect;
begin
GetClientRect(MainWnd,R);
I:=min(MouseX shl ScrShift,R.right-1);
SetRect(R,I,0,I,R.bottom-1);
I:=SetROP2(DC,R2_NOT);
PolyLine(DC,R,2);
SetROP2(DC,I);
end;
procedure MakeModeless(var Wnd:HWnd; Res:Word; Proc: TFarProc);
begin
if Wnd<>0 then begin
ShowWindow(Wnd,SW_Restore); {falls ikonifiziert}
SetFocus(Wnd); {sonst: Fokus wechseln!}
end else begin
Wnd:=CreateDialog(Seg(HInstance),MakeIntResource(Res),0,Proc);
end;
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: array[0..255] of Char;
SFilter: array[0..255] of Char;
SExt: array[0..15] of Char;
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_FileMustExist 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
Ofn.hWndOwner:=MainWnd;
LoadString(Seg(HInstance),102,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 einfügen}
end;
end;
SFile[0]:=#0;
end;
function KCWndProc(Wnd:HWnd; Msg:Word; wParam:Word; lParam:LongInt):
LongInt; export;
var
CallOld: Boolean;
PS: TPaintStruct;
lPar: LongRec absolute lParam;
mmi: PMinMaxInfo absolute lParam;
R: TRect;
pt: TPoint absolute lParam;
W: Word;
S: array[0..255] of Char;
I: Integer;
const
SExt: array[0..15]of Char=#0; {Filter-Merker (sonst ist's lästig)}
begin
CallOld:=false;
case Msg of
WM_Create: begin
MainWnd:=Wnd;
W:=GetSystemMenu(Wnd,FALSE);
DeleteMenu(W,SC_SIZE,MF_BYCOMMAND);
LoadString(Seg(HInstance),101,S,sizeof(S)); {Großbild}
ModifyMenu(W,SC_Zoom,MF_ByCommand,SC_Zoom,S);
hPal:=CreatePalette(PLogPalette(@KCPalette)^);
SelectPalette(GetDC(Wnd),hPal,false); {muß sein!}
MemKCSel:=PageAlloc(0); {64K-Fenster}
LoadConfig; {setzt KCTyp usw.}
TimeTaken:=Word(GetTickCount);
TickTaken:=cTicks;
if lstrlen(CmdLine)<>0
then LoadFile(CmdLine,0,false);
end;
WM_GetMinMaxInfo: with mmi^ do begin
ptMaxSize.x:=KCPixmap.x*2+Saum.x;
ptMaxSize.y:=KCPixmap.y*2+Saum.y;
end;
WM_Size: case wParam of
SIZE_Minimized: begin
ClrsRealized:=0; {sonst Falschfarben nach Icon öffnen}
SetBlock(EmuBlock or (EmuBlockMask and 1));
end;
SIZE_Maximized: begin
ScrShift:=4;
SetBlock(EmuBlock and not 1);
end;
SIZE_Restored: begin {Korrektur bei 2zeiligem Menü}
ScrShift:=3;
GetClientRect(Wnd,R);
I:=R.bottom-R.top-KCPixmap.y; {sollte Null sein}
if I<>0 then begin {Korrektur!}
GetWindowRect(Wnd,R);
MoveWindow(Wnd,R.left,R.top,R.right-R.left,R.bottom-R.top-I,true);
end;
SetBlock(EmuBlock and not 1);
end;
end;
WM_EnterIdle: if EmuBlockMask and 4 <>0
then SetBlock(EmuBlock or 4)
else IdleAction;
WM_ActivateApp: if wParam<>0 then SetBlock(EmuBlock and not 2)
else SetBlock(EmuBlock or (EmuBlockMask and 2));
WM_QueryNewPalette: if ClrsRealized<32 then begin
InvalWnd;
KCWndProc:=1;
end;
WM_PaletteChanged: if wParam<>Wnd then begin
ClrsRealized:=0;
InvalWnd;
end;
WM_Paint: begin
BeginPaint(Wnd,PS);
if Display<>0 then begin
LastPaintTime:=Word(GetTickCount);
SelectPalette(PS.hDC,hPal,false); {Muß auch hier sein!}
if ClrsRealized<32 then ClrsRealized:=RealizePalette(PS.hDC);
if ScrShift>3 then StretchDIBits(PS.HDC,0,0,KCPixmap.x*2,
KCPixmap.y*2,0,0,KCPixmap.x,KCPixmap.y,Ptr(Display,0),
KCPixmap.bi,DIB_Pal_Colors,SrcCopy)
else SetDIBitsToDevice(PS.HDC,0,0,KCPixmap.x,KCPixmap.y,
0,0,0,KCPixmap.y,Ptr(Display,0),
KCPixmap.bi,DIB_Pal_Colors);
FillChar(InUpdate,sizeof(InUpdate),0);
LastPaintTime:=(Word(GetTickCount)-LastPaintTime) div 4;
end else FillRect(PS.hDC,PS.rcPaint,GetStockObject(Gray_Brush));
DrawSelection(PS.HDC);
if LineDrawn then DrawRandLinie(PS.hDC);
EndPaint(Wnd,PS);
end;
WM_Command: case wParam of
2: SendMessage(Wnd,WM_SysCommand,SC_Close,0);
101: asm int 3 end; {Debug-Break}
102: begin {Datei laden}
PrepareOFN;
if GetOpenFileName(ofn) then begin
LoadFile(SFile,Integer(ofn.nFilterIndex),
Integer(ofn.Flags) and OFN_ReadOnly <>0);
end;
end;
105: MakeModeless(hModul,wParam,@ModulProc);
106: WinExec('LOAD',SW_Show);
108: begin {Installieren}
RegSetRoot('.KCC','KCEMU');
RegSetRoot('KCEMU',AppName);
GetModuleFileName(Seg(HInstance),S,sizeof(S));
lstrcat(S,' %1');
RegSetRoot('KCEMU\shell\open\command',S);
SaveConfig;
Installed:=true;
end;
109: begin {Deinstallieren}
RegDeleteKey(HKCR,'.KCC');
I:=RegDeleteKey(HKCR,'KCEMU');
if I<>0 then begin
wvsprintf(S,'Fehlercode %d',I);
MessageBox(Wnd,S,nil,0);
end;
end;
151: ; {Markieren}
152: begin {Kopieren}
if OpenClipboard(Wnd) then begin
EmptyClipboard;
SetClipboardData(CF_DIB,TakeScreenshot);
CallEvent(KCEV_Copy,wParam,lParam);
CloseClipboard;
end else MessageBeep(0);
end;
153: ; {Einfügen (Text)}
160: begin {Linken Rand setzen}
RandL:=MouseX;
if RandR<=RandL then RandR:=KCPixmap.x shr 3; {Ganz rechts!}
if SelectedRegion<>0 then SelectionChanged;
end;
161: begin {Rechten Rand setzen}
RandR:=MouseX;
if RandL>=RandR then RandL:=0; {Ganz links!}
if SelectedRegion<>0 then SelectionChanged;
end;
162: begin {Rechteckig markieren}
RandL:=0; RandR:=0; {Nichts was dazwischen paßt}
if SelectedRegion<>0 then SelectionChanged;
end;
201..203: SetMenuFlags(MenuFlags xor (1 shl (wParam-201)));
204: MakeModeless(hKeymap,wParam,@KeymapProc);
205: begin SetBlock(EmuBlock and not $10); DoNMI; end; {F9-Block}
206: begin DoReset; end;
207: begin PowerOn; end;
208: DialogBox(Seg(HInstance),MakeIntResource(wParam),Wnd,@EmuSetProc);
211..219: SetNewKC(wParam-210);
220: SetBlock(EmuBlock xor $10); {Run/Stop-Taste F9}
301: MakeModeless(hDebug,wParam,@DebugProc);
901: WinHelp(Wnd,HelpFile,HELP_Index,0);
909: DialogBox(Seg(HInstance),MakeIntResource(wParam),Wnd,@AboutProc);
end;
WM_KeyDown: case wParam of
VK_Capital: PokeChar(#$16);
VK_Pause: PokeKey($131B); {STOP/ESC}
VK_Prior: PokeKey($1011); {Page Mode/HOME}
VK_Next: PokeKey($0C12); {Scroll Mode/CLS}
VK_End: PokeKey($1318); {Cursor ans Zeilenende/STOP}
VK_Home: if GetKeyState(VK_Shift) and $FFFE<>0
then AutoInsert:=not AutoInsert {PC-verwöhnte bedienen!}
else PokeChar(#$19); {Cursor auf Zeilenanfang/AutoInsert}
VK_Left: PokeKey($1908);
VK_Up: PokeKey($110B);
VK_Right: PokeKey($1809);
VK_Down: PokeKey($120A);
VK_Insert: PokeKey($141A); {INS/CLICK}
VK_Delete: PokeKey($021F); {DEL/CLLN}
VK_F1..VK_F6: PokeKey((wParam-VK_F1+$F1)*$101+$600); {F-Tasten}
end;
WM_KeyUp: CallEvent(KCEV_KeyUp,0,0);
WM_Char: case Char(wParam) of
'─': PokeChar(#$7B); {'Ä'}
'╓': PokeChar(#$7C); {'Ö'}
'▄': PokeChar(#$7D); {'Ü'}
'Σ': PokeChar(#$5B); {'ä'}
'÷': PokeChar(#$5C); {'ö'}
'ⁿ': PokeChar(#$5D); {'ü'}
'▀': PokeChar(#$7E); {'ß'}
' ': PokeKey($5B20); {Vollcursor mit Shift}
#27: PokeKey($1B03); {Escape=BRK/ESC}
#8: PokeKey($0F01); {Backspace=CLR/HCOPY}
#9: PokeChar(#$16); {TAB als Shiftlock-Taste mißbrauchen}
'A'..'Z': PokeChar(Char(wParam+$20));
'a'..'z': PokeChar(Char(wParam-$20));
else PokeChar(Char(wParam));{auch: Enter}
end;
WM_DropFiles: begin
for I:=0 to Integer(DragQueryFile(wParam,$FFFF,nil,0))-1 do begin
DragQueryFile(wParam,I,S,sizeof(S));
LoadFile(S,0,false);
end;
DragFinish(wParam);
end;
WM_LButtonDown: begin
RemoveAnySelection; {Selektion weg vom Bildschirm}
pt.x:=pt.x shr ScrShift;
asm jnc @@1; inc [pt.x]; @@1: end; {Bei ausgeschobenem Bit eins dazu}
pt.y:=pt.y shr ScrShift;
SetRect(SelectedRect,pt.x,pt.y,pt.x,pt.y);
SetCapture(Wnd); {Mausereignisse GLOBAL abfangen}
end;
WM_MouseMove: if GetCapture=Wnd
then MouseDrag(pt.x,pt.y);
WM_LButtonUp: if GetCapture=Wnd
then ReleaseCapture; {Globale Mausereignisse abschalten}
WM_RButtonDown: begin
if wParam and MK_LButton <>0
then SendMessage(Wnd,WM_Command,152,0) {Kopieren (wie bei X und OS)}
else begin
MouseX:=(pt.x) shr ScrShift; {merken zum Rand setzen}
asm jnc @@1; inc [MouseX]; @@1: end; {Bei ausgeschobenem Bit eins dazu}
W:=LoadMenu(Seg(HInstance),MakeIntResource(304));
ClientToScreen(Wnd,pt);
if RandL>=RandR then CheckMenuItem(W,162,MF_Checked);
TrackPopupMenu(GetSubMenu(W,0),TPM_LeftAlign or TPM_RightButton,
pt.x,pt.y,0,Wnd,nil);
DestroyMenu(W);
end;
end;
WM_MenuSelect: if LineDrawn {vert. Hilfslinie zeichnen/löschen}
xor (((wParam=160) or (wParam=161)) and (lPar.Hi<>0))
then begin {flüchtige Linie zeichnen, beim Schließen des Popup-Menüs
entfernt sie sich wieder, weil Windows WM_MenuSelect lPar.Hi=0 setzt}
PS.hDC:=GetDC(Wnd);
DrawRandLinie(PS.hDC); {Linie zeichnen/löschen}
ReleaseDC(Wnd,PS.hDC);
LineDrawn:=not LineDrawn;
end;
WM_Timer: begin
Foreground:=not Foreground;
Animate;
end;
WM_EndSession: if (wParam<>0) and Installed then SaveConfig;
WM_Close: begin
if Installed then SaveConfig;
WinHelp(Wnd,HelpFile,HELP_Quit,0);
PostQuitMessage(0);
CallOld:=true;
end;
WM_Destroy: begin
SetNewKC(0);
PageFree(MemKCSel);
end;
else CallOld:=true;
end;
if CallOld then KCWndProc:=DefWindowProc(Wnd,Msg,wParam,lParam);
end;
const
wc: TWndClass=( {Hauptfenster}
style: CS_ByteAlignClient or CS_DblClks or CS_HRedraw or CS_VRedraw;
lpfnWndProc: @KCWndProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackground: 0; {kein Hintergrund!}
lpszMenuName: MakeIntResource(100);
lpszClassName: 'KCEMU');
wc2: TWndClass=( {Debug-Listenfenster ASM, MEM und STACK}
style: CS_ParentDC or CS_DblClks;
lpfnWndProc: @DebugListProc;
cbClsExtra: 0;
cbWndExtra: 2; {speichert alle zusätzlichen Daten dynamisch}
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: 'KCDEB');
var
Msg: TMsg;
hAccel: THandle;
begin
if HPrevInst=0 then begin
wc.hIcon:=LoadIcon(Seg(HInstance),MakeIntResource(100));
wc.hCursor:=LoadCursor(0,IDC_Arrow);
RegisterClass(wc);
wc2.hCursor:=wc.hCursor;
RegisterClass(wc2);
end;
hAccel:=LoadAccelerators(Seg(HInstance),MakeIntResource(100));
LoadString(Seg(HInstance),100,AppName,sizeof(AppName));
StdMBoxTitle:=AppName;
Saum.x:=2*GetSystemMetrics(SM_CXBorder);
Saum.y:=2*GetSystemMetrics(SM_CYBorder)
+GetSystemMetrics(SM_CYCaption)+GetSystemMetrics(SM_CYMenu);
EmuBlock:=$10; {Blockiert durch F9}
MainWnd:=CreateWindowEx(WS_EX_AcceptFiles,'KCEMU',AppName,
WS_Border or WS_Caption or WS_MinimizeBox or WS_MaximizeBox
or WS_Overlapped or WS_SysMenu,
CW_UseDefault,CW_UseDefault,
KCPixmap.x+Saum.x,KCPixmap.y+Saum.y,
0,0,Seg(HInstance),nil);
if MainWnd=0 then Halt(255);
ShowWindow(MainWnd,CmdShow);
repeat
if PeekMessage(Msg,0,0,0,PM_Remove) then begin
if Msg.message=WM_Quit then break;
if (hAccel<>0) and (TranslateAccelerator(MainWnd,hAccel,Msg)<>0)
then continue;
if (hKBWnd<>0) and IsDialogMessage(hKBWnd,Msg) then continue;
TranslateMessage(Msg);
DispatchMessage(Msg);
continue;
end;
if not IdleAction then WaitMessage;
until false;
Halt(Msg.wParam);
end.
Vorgefundene Kodierung: OEM (CP437) | 1
|
|