Source file: /~heha/j/japextra.zip/JAPRES.PAS

library japres;
{Diese Bibliothek beinhaltet die gesamten Bildchen sowie NEU: eine geeignete
 Routine zum Laden der komprimierten Bilder.}
{$R listfill}	{"Füllstand" der Kana und Kanji}
{$R kanagif}	{Kana (Hira- und Katakana) [2000 GIF]}
{$R kanjigif}	{Kanji-Bilder als GIF (1..900) [4001 GIF]}
{$R kanjigi2}	{mehr Kanji-Bilder (901..1945) [4901 GIF]}
{$R kanjiwin}	{Kanji-Texte [STRINGTABLE]}
{$R gk}		{Grundkurs-Info [200 RCDATA] von J. Schmidt}
{$R nelson}	{Index im Nelson-Wörterbuch [201 RCDATA]}
{$R jis}	{JIS-Tabelle [202 RCDATA] von Wolfgang Gröger}
{$R uni}	{Unicode-Tabelle [203 RCDATA] 03/04}
uses WinProcs,WinTypes,Win31,WUtils;

type
 TGifScreenDescriptor=record
  extent: TPoint;
  bDepth: Byte;
  bBackgroundIndex: Byte;
  bZero: Byte;
 end;
 TGifPalEntry=record
  bRed,bGreen,bBlue: Byte;
 end;
 TGifImageDescriptor=record
  bSeparator: Char;		{=';'}
  left,top,width,height: Integer;
  bDepth: Byte;
 end;

 PGifHdr=^TGifHdr;
 TGifHdr=record
  sig: array[0..5] of Char;	{'GIF87a' oder 'GIF89a', wird ignoriert}
  sd: TGifScreenDescriptor;		{wird ignoriert}
  pe: array[0..1] of TGifPalEntry;	{wird ignoriert}
  id: TGifImageDescriptor;	{nur id.width und id.height werden benutzt}
  data: Byte;			{das erste Byte...}
 end;

function GifDeco(LzwData:PChar; BitmapData:THandle;
  ImageWidth, xBytes: Integer;	{zum korrekten Inkrementieren}
  DesiredBits: Integer):Boolean; external; {$L GIFDECO}
{beachtet automatisch Windows-WORD-Zeilenausrichtung}
{Akzeptiert bei DesiredBits nur die Werte 1, 4 und 8}

procedure CalcCXDI; assembler;
{berechnet CX und inkrementiert DI, wenn erforderlich}
 asm	mov	ah,al
	jcxz	@@force
	test	ah,80h
	jz	@@e		{nicht (neu) berechnen!}
@@force:
	mov	cl,1		{schwarz/weiß}
	and	al,7
	jz	@@cxset
	mov	cl,4		{(bis zu) 16 Farben}
	cmp	al,4
	jc	@@cxset
	mov	cl,8		{(bis zu) 256 Farben}
@@cxset:
	test	ah,80h		{Globale Farbtabelle?}
	jz	@@e
	mov	ax,TYPE TGifPalEntry
	shl	ax,cl
	add	di,ax		{Größe der Palette addieren}
@@e:
 end;

function CreateBitmapFromGif(gh:PGifHdr):HBitmap; assembler;
{Erzeugt Windows-Bitmap (ohne Palette!) aus .GIF-Speicherabbild.
 Hier: Keine Verarbeitung von interlaced GIF möglich!
 Keine Verarbeitung von animierten GIFs u.ä.}
 var
  bits: THandle;
  xbytes: Integer;
  desiredbits: Integer;
 asm	les	di,[gh]
	mov	al,es:TGifHdr[di].sd.bDepth
	add	di,6+TYPE TGifScreenDescriptor
	xor	cx,cx
	call	CalcCXDI
	push	es
	push	cx
 {Länge einer Scanzeile berechnen}
	 mov	ax,es:TGifImageDescriptor[di].width
	 add	ax,15
	 shr	ax,4
	 add	ax,ax
	 mov	[xbytes],ax
	 mul	es:TGifImageDescriptor[di].height
	 push	GPTR
	 push	dx
	 push	ax
	 call	GlobalAlloc
	pop	cx
	pop	es
	or	ax,ax
	jz	@@e		{0 liefern}
	mov	[bits],ax
	mov	si,di
	mov	al,es:TGifImageDescriptor[di].bDepth
	add	di,TYPE TGifImageDescriptor
	call	CalcCXDI
	mov	[desiredbits],cx
	push	es
	push	si		{PGifImageDescriptor retten}
	 push	es
	 push	di		{@data}
	 push	[bits]		{bits}
	 push	es:TGifImageDescriptor[si].width
	 push	[xbytes]	{xbytes}
	 push	[desiredbits]
	 call	GifDeco
	pop	si
	pop	es
	cbw
	or	ax,ax
	jz	@@free
	push	es:TGifImageDescriptor[si].width
	push	es:TGifImageDescriptor[si].height
	push	1
	push	[desiredbits]
	push	[bits]
	push	0
	call	CreateBitmap
@@free:	xchg	di,ax
	 push	[bits]
	 call	GlobalFree
	xchg	di,ax
@@e:
 end;

function LoadGif(Inst:THandle; ResID:PChar):HBitmap; export;
{wie LoadBitmap, lädt jedoch 2-Farben-GIF-Ressource (Ressourcentyp GIF)
 mit festem Header-Aufbau (wie ihn Image Alchemy erzeugt),
 läuft nur ab 80386}
 var
  hRes: THandle;
 begin
  LoadGif:=0;
  if Test8086<2 then exit;		{benötigt 386!}
  hRes:=FindResource(Inst,ResID,'GIF');
  if hRes=0 then exit;
  hRes:=LoadResource(Inst,hRes);	{ein anderes HRes!}
  if hRes=0 then exit;
  LoadGif:=CreateBitmapFromGif(LockResource(hRes));
  UnlockResource(hRes);
  FreeResource(hRes);
 end;

exports LoadGif index 2;

begin
end.