Source file: /~heha/basteln/8bit/KC85/kcemu/kcemusrc.zip/KCEMU.PAS

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.
Detected encoding: OEM (CP437)1
Wrong umlauts? - Assume file is ANSI (CP1252) encoded