www.pudn.com > MapEditor.zip > wmUtil.pas

unit wmutil; 
 
interface 
 
uses 
  Windows, SysUtils, Classes, Graphics, Controls, DIB, 
  DXDraws, DXClass; 
 
type 
 
   TWMImageHeader = record 
      Title: String[40];        //'WEMADE Entertainment inc.' 
      ImageCount: integer; 
      ColorCount: integer; 
      PaletteSize: integer; 
      VerFlag:integer; 
   end; 
 
{ 
   TWMImageHeader = record 
      Title: string[40];        //'WEMADE Entertainment inc.' 
      ImageCount: integer; 
      ColorCount: integer; 
      PaletteSize: integer; 
   end; 
} 
   PTWMImageHeader = ^TWMImageHeader; 
 
   TWMImageInfo = record 
     nWidth    :SmallInt; 
     nHeight   :SmallInt; 
      px: smallint; 
      py: smallint; 
      bits: PByte; 
   end; 
   PTWMImageInfo = ^TWMImageInfo; 
 
   TWMIndexHeader = record 
      Title: string[40];        //'WEMADE Entertainment inc.' 
      IndexCount: integer; 
      VerFlag:integer; 
   end; 
{ 
   TWMIndexHeader = record 
      Title: string[40];        //'WEMADE Entertainment inc.' 
      IndexCount: integer; 
   end; 
} 
   PTWMIndexHeader = ^TWMIndexHeader; 
 
   TWMIndexInfo = record 
      Position: integer; 
      Size: integer; 
   end; 
   PTWMIndexInfo = ^TWMIndexInfo; 
 
 
   TDXImage = record 
     nPx          :SmallInt; 
     nPy          :SmallInt; 
     Surface      :TDirectDrawSurface; 
     dwLatestTime :LongWord; 
   end; 
   pTDxImage = ^TDXImage; 
 
 
function WidthBytes(w: Integer): Integer; 
function PaletteFromBmpInfo(BmpInfo: PBitmapInfo): HPalette; 
function  MakeBmp (w, h: integer; bits: Pointer; pal: TRGBQuads): TBitmap; 
procedure DrawBits(Canvas: TCanvas; XDest, YDest: integer; PSource: PByte; Width, Height: integer); 
 
implementation 
 
 
function WidthBytes(w: Integer): Integer; 
begin 
  Result := (((w * 8) + 31) div 32) * 4; 
end; 
 
function PaletteFromBmpInfo(BmpInfo: PBitmapInfo): HPalette; 
var 
   PalSize, n: Integer; 
   Palette: PLogPalette; 
begin 
     //Allocate Memory for Palette 
     PalSize := SizeOf(TLogPalette) + (256 * SizeOf(TPaletteEntry)); 
     Palette := AllocMem(PalSize); 
 
     //Fill in structure 
     with Palette^ do 
     begin 
          palVersion := $300; 
          palNumEntries := 256; 
          for n := 0 to 255 do 
          begin 
               palPalEntry[n].peRed := BmpInfo^.bmiColors[n].rgbRed; 
               palPalEntry[n].peGreen := BmpInfo^.bmiColors[n].rgbGreen; 
               palPalEntry[n].peBlue := BmpInfo^.bmiColors[n].rgbBlue; 
               palPalEntry[n].peFlags := 0; 
          end; 
     end; 
     Result := CreatePalette(Palette^); 
     FreeMem(Palette, PalSize); 
end; 
 
procedure CreateDIB256(var Bmp: TBitmap; BmpInfo: PBitmapInfo; Bits: PByte); 
var 
   dc, MemDc: HDC; 
   OldPal: HPalette; 
begin 
   dc:=0; 
   MemDc:=0;//jacky 
   //First Release Handle and Palette from BMP 
   DeleteObject(Bmp.ReleaseHandle); 
   DeleteObject(Bmp.ReleasePalette); 
 
   try 
      dc := GetDC(0); 
      try 
         MemDC := CreateCompatibleDC(DC); 
         DeleteObject(SelectObject(MemDC, CreateCompatibleBitmap(dc, 1, 1))); 
 
         OldPal := 0; 
         Bmp.Palette := PaletteFromBmpInfo(BmpInfo); 
         OldPal := SelectPalette(MemDc, Bmp.Palette, False); 
         RealizePalette(MemDc); 
         try 
            Bmp.Handle := CreateDIBitmap(MemDc, BmpInfo^.bmiHeader, CBM_INIT, 
                     Pointer(Bits), BmpInfo^, DIB_RGB_COLORS); 
         finally 
            if OldPal <> 0 then 
               SelectPalette(MemDc, OldPal, True); 
         end; 
      finally 
         if MemDC <> 0 then 
            DeleteDC(MemDC); 
      end; 
   finally 
      if dc <> 0 then 
         ReleaseDC(0, DC); 
   end; 
   if Bmp.Handle = 0 then 
      Exception.Create('CreateDIBitmap failed'); 
end; 
 
function  MakeBmp (w, h: integer; bits: Pointer; pal: TRGBQuads): TBitmap; 
var 
   i, k: integer; 
   BmpInfo: PBitmapInfo; 
   HeaderSize: Integer; 
   bmp: TBitmap; 
begin 
   HeaderSize := SizeOf(TBitmapInfo) + (256 * SizeOf(TRGBQuad)); 
   GetMem (BmpInfo, HeaderSize); 
   for i:=0 to 255 do begin 
      BmpInfo.bmiColors[i] := pal[i]; 
   end; 
   with BmpInfo^.bmiHeader do begin 
      biSize := SizeOf(TBitmapInfoHeader); 
      biWidth := w; 
      biHeight := h; 
      biPlanes := 1; 
      biBitCount := 8; //8bit 
      biCompression := BI_RGB; 
      biClrUsed := 0; 
      biClrImportant := 0; 
   end; 
   Bmp := TBitmap.Create; 
   CreateDIB256 (Bmp, BmpInfo, bits); 
   FreeMem (BmpInfo); 
   Result := Bmp; 
end; 
 
procedure DrawBits(Canvas: TCanvas; XDest, YDest: integer; PSource: PByte; Width, Height: integer); 
var 
  HeaderSize : integer; 
  bmpInfo : PBitmapInfo; 
begin 
  if PSource = nil then exit; 
 
  HeaderSize := Sizeof(TBitmapInfo) + (256 * Sizeof(TRGBQuad)); 
  BmpInfo := AllocMem(HeaderSize); 
  if BmpInfo = nil then raise Exception.Create('TNoryImg: Failed to allocate a DIB'); 
  with BmpInfo^.bmiHeader do begin 
    biSize        := SizeOf(TBitmapInfoHeader); 
    biWidth       := Width; 
    biHeight      := -Height; 
    biPlanes      := 1; 
    biBitCount    := 8; 
    biCompression := BI_RGB; 
    biClrUsed     := 0; 
    biClrImportant:= 0; 
  end; 
  SetDIBitsToDevice(Canvas.Handle, XDest, YDest, Width, Height, 0, 0, 0, Height, 
                    PSource, BmpInfo^, DIB_RGB_COLORS); 
  FreeMem(BmpInfo, HeaderSize); 
end; 
 
end.