{ VgaMem, Windows implementation
  Copr. 1996 Matthias Koeppe

  This is designed to appear compatible to higher layers of software,
  so lots of null functions are included.
}

uses WinTypes, WinProcs, WinGr, WinRes;

{ Restspeicherverwaltung
}
procedure InitVgaMem; begin end;
procedure DoneVgaMem; begin end;
function GetVgaMem(Size: Word): Word; begin GetVgaMem := 0 end;
procedure FreeVgaMem(P, Size: Word); begin end;

{ Restspeicherpufferung
}
function PrepBuf(var R: Objects.TRect; Action: Word; var Buf: TVgaBuf): Boolean;
begin PrepBuf := false end;
procedure EndBufDraw; begin end;
procedure ReleaseBuf(var Buf: TVgaBuf); begin end;
procedure PasteRect(var R: Objects.TRect; var Buf: TVgaBuf); begin end;
procedure PasteRectAt(var R: Objects.TRect; P: Objects.TPoint; var Buf: TVgaBuf); begin end;

{ Kopierroutinen
}
function GetSize(x1, y1, x2, y2: Integer): Word; begin GetSize := 0 end;
function GetBPL(x1, x2: Integer): Word; begin GetBPL := 0 end;
procedure SaveScreen(x1, y1, x2, y2: Integer; Addr: Word); begin end;
procedure RestoreScreen(x1, y1, x2, y2, x3, y3: Integer; Addr: Word); begin end;

procedure CopyScreen(x1, y1, x2, y2, x3, y3: Integer);
begin
  BitBlt(DC, x3-DrawOrigin.x, y3-DrawOrigin.y,
    x2-x1, y2-y1, DC, x1-DrawOrigin.x, y1-DrawOrigin.y, SRCCOPY);
end;

{ Icon-Darstellung
}
procedure PutIconAnd16(x1, y1: Integer; MapMask: Byte; Icon: Pointer); begin end;
procedure PutIconOr16(x1, y1: Integer; MapMask: Byte; Icon: Pointer); begin end;

{ BGI-like Image routines
}

function CopyImage(Image: pointer): pointer;
var
  I: PImage;
begin
  If Image = nil
  then CopyImage := nil
  else begin
    New(I);
    with PImage(Image)^ do
    begin
      I^.Color := Color;
      I^.BkColor := BkColor;
      I^.BitmapRef := BitmapRef;
      BitmapRef^.IncRef;
    end;
    CopyImage := I
  end
end;

function CutImage(x1, y1, x2, y2: Integer): pointer;
begin
  CutImage := nil;
end;

procedure FreeImage(Image: pointer);
begin
  If Image <> nil then
  with PImage(Image)^ do
  begin
    {DeleteObject(Bmp);}
    If BitmapRef <> nil then BitmapRef^.DecRef;
    Dispose(PImage(Image))
  end;
end;

procedure GetImageExtent(Image: pointer; var Extent: Objects.TPoint);
var
  B: wintypes.TBitmap;
begin
  If (Image = nil) or (PImage(Image)^.BitmapRef^.Bmp = 0)
  then LongInt(Extent) := 0
  else begin
    GetObject(PImage(Image)^.BitmapRef^.Bmp, SizeOf(B), @B);
    Extent.X := B.bmWidth;
    Extent.Y := B.bmHeight
  end
end;

function LoadImage(var S: TStream): pointer;
begin
  LoadImage := nil
end;

function MaskedImage(Image: pointer): pointer;
var
  B: WinTypes.TBitmap;
  Info, InfoCopy: PBitmapInfo;
  InfoSize: Word;
  BitHandle: THandle;
  Bits: pointer;
  DataSize: LongInt;
  Masked: PImage;
  i: Integer;

  function bmAlignDouble(Size: Longint): Longint;
  begin
    bmAlignDouble := (Size + 31) div 32 * 4;
  end;

begin
  MaskedImage := nil;
  If Image <> nil then
  with PImage(Image)^ do
  begin
    GetObject(BitmapRef^.Bmp, SizeOf(B), @B);
    InfoSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) shl (B.bmBitsPixel * B.bmPlanes);
    GetMem(Info, InfoSize);
    GetMem(InfoCopy, InfoSize);
    DataSize := bmAlignDouble(B.bmWidth * B.bmBitsPixel * B.bmPlanes) * B.bmHeight;
    with Info^.bmiHeader do
    begin
      biSize := SizeOf(TBitmapInfoHeader);
      biWidth := B.bmWidth;
      biHeight := B.bmHeight;
      biPlanes := 1;
      biBitCount := B.bmBitsPixel * B.bmPlanes;
      biCompression := 0;
      biSizeImage := DataSize;
      biXPelsPerMeter := 0;
      biYPelsPerMeter := 0;
      biClrUsed := 0;
      biClrImportant := 0;
    end;
    BitHandle := GlobalAlloc(gmem_Moveable, DataSize);
    Bits := GlobalLock(BitHandle);
    BeginDraw;
    GetDIBits(DC, BitmapRef^.Bmp, 0, B.bmHeight, Bits, Info^, DIB_RGB_COLORS);
    Move(Info^, InfoCopy^, InfoSize);
    New(Masked);
    If (B.bmBitsPixel = 1) and (B.bmPlanes = 1)
    then begin
      If BkColor = WinGr.ExBkColor
      then begin
	Masked^.BkColor := $FFFFFF;
	BkColor := 0;
      end
      else Masked^.BkColor := 0;
      i := 1;
      LongInt(Info^.bmiColors[i]) := Masked^.BkColor;
      If Color = WinGr.ExBkColor
      then begin
	Masked^.Color := $FFFFFF;
	Color := 0
      end
      else Masked^.Color := 0;
      LongInt(Info^.bmiColors[0]) := Masked^.Color;
    end
    else
      For i := 0 to 1 shl (B.bmBitsPixel * B.bmPlanes) - 1 do
      begin
	If LongInt(Info^.bmiColors[i]) = WinGr.ExBkColor
	then begin
	  LongInt(Info^.bmiColors[i]) := $FFFFFF;
	  LongInt(InfoCopy^.bmiColors[i]) := 0
	end
	else LongInt(Info^.bmiColors[i]) := 0
      end;
    New(Masked^.BitmapRef, Init(CreateDIBitmap(DC, Info^.bmiHeader, CBM_INIT, Bits, Info^, DIB_RGB_COLORS)));
    SetDIBits(DC, BitmapRef^.Bmp, 0, B.bmHeight, Bits, InfoCopy^, DIB_RGB_Colors);
    GlobalUnlock(BitHandle);
    GlobalFree(BitHandle);
    FreeMem(Info, InfoSize);
    FreeMem(InfoCopy, InfoSize);
    MaskedImage := Masked;
  end;
end;

procedure PasteImage(X, Y: Integer; Image: pointer; BitBlt: Word);
const
  BitBlts: array[0..7] of LongInt =
    (SrcCopy, SrcInvert, SrcPaint, SrcAnd,
     NotSrcCopy, NotSrcCopy, MergePaint, NotSrcErase);
var
  OldBitmap: HBitmap;
  OldBk, OldText: TColorRef;
  Info: WinTypes.TBitmap;
begin
  If Image <> nil then
  with PImage(Image)^ do
  begin
    { Use the aux DC }
    OldBitmap := SelectObject(AuxDC, BitmapRef^.Bmp);
    OldBk := WinProcs.SetBkColor(DC, BkColor);
    OldText := WinProcs.SetTextColor(DC, Color);
    GetObject(BitmapRef^.Bmp, SizeOf(Info), @Info);
    WinProcs.BitBlt(DC, X, Y, Info.bmWidth, Info.bmHeight, AuxDC, 0, 0, BitBlts[BitBlt and 7]);
    SelectObject(AuxDC, OldBitmap);
    WinProcs.SetBkColor(DC, OldBk);
    WinProcs.SetTextColor(DC, OldText)
  end
end;

procedure StoreImage(var S: TStream; Image: pointer);
begin
end;

{ Low-level routines
}
procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
begin
end;

function GetImageLong(Image: pointer): LongInt;
begin
  GetImageLong := SizeOf(TImage)
end;

function GetImageSize(Image: pointer): Word;
begin
  GetImageSize := SizeOf(TImage)
end;

function ImageLong(x1, y1, x2, y2: Integer): LongInt;
begin
  ImageLong := SizeOf(TImage)
end;

function ImageSize(x1, y1, x2, y2: Integer): Word;
begin
  ImageSize := SizeOf(TImage)
end;

procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
begin
  PasteImage(X, Y, @Bitmap, BitBlt)
end;

{ Storing screen regions
}

function StoreScreen(x1, y1, x2, y2: Integer): PScreenBuf;
begin StoreScreen := nil end;
procedure FreeScreenBuf(Buf: PScreenBuf); begin end;
procedure DrawScreenBufAt(Buf: PScreenBuf; x3, y3: Integer); begin end;
procedure DrawScreenBuf(Buf: PScreenBuf); begin end;

function GetVgaMemCaps: Word;
begin
  GetVgaMemCaps := vmcImage + vmcCopy
end;

{ Old-style functions
}
procedure InitVGAMan; begin end;
procedure DoneVGAMan; begin end;
function GetSize16(x1, y1, x2, y2: Integer): Word; begin GetSize16 := 0 end;
function GetBPL16(x1, x2: Integer): Word; begin GetBPL16 := 0 end;
procedure SaveScreen16(x1, y1, x2, y2: Integer; Addr: Word); begin end;
procedure RestoreScreen16(x1, y1, x2, y2, x3, y3: Integer; Addr: Word); begin end;
procedure CopyScreen16(x1, y1, x2, y2, x3, y3: Integer); begin end;
procedure CopyMem16(Source, Dest, Count: Word); begin end;

