openglisoengine.pas

一款RPG游戏的引擎可以自己制作一款RPG游戏的引擎可以自己制作

  { DONE : Draw the Image. }
  if not (ImageIndex in [0..ImageList.Count -1]) then
    Exit;
  with ImageList.Images[ImageIndex] do
  begin
    glRasterPos2f(0, 0);
    // use trick with bitmap to prevent that the raster positions is cliped.
    glBitmap(0, 0, 0, 0, x, -y-Height, nil);
    // Draw the image.
    glDrawPixels(Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, ImageData);
  end;
end;

procedure TOpenGLIsoMap.IsoMapFlip;
begin
  { DONE : Flip }
  { TODO : Assigned Flip should be done before flush, (I could be wrong though...) }
  glFlush;
  if Assigned(OnFlip) then
    OnFlip(Self);
end;

procedure TOpenGLIsoMap.IsoMapGetImageCount(var ResultInt: Integer);
begin
  ResultInt := ImageList.Count;
end;

procedure TOpenGLIsoMap.IsoMapGetImageHeight(ImageIndex : integer; var ResultInt: Integer);
begin
  { DONE : Return the Height of the image. }
  ResultInt := ImageList.Images[ImageIndex].Height;
end;

procedure TOpenGLIsoMap.IsoMapGetImageName(Index: Integer;
  var Name: string);
begin
  { DONE : Return the name of the image. }
  Name := ImageList.Names[Index];
end;

procedure TOpenGLIsoMap.IsoMapGetImageTransparentColor(Index: Integer;
  var Color: TColor);
begin
  { DONE 3 : Return the transparent color of the image. }
  Color := ImageList.TransparentColors[Index];
end;

procedure TOpenGLIsoMap.IsoMapGetImageWidth(ImageIndex: integer;
  var ResultInt: Integer);
begin
  { DONE : Return the Width of the image. }
  ResultInt := ImageList.Images[ImageIndex].Width;
end;

procedure TOpenGLIsoMap.IsoMapGetPixel(ImageIndex, x, y: Integer;
  var color: TColor);
begin
  { TODO 3 : Return the Color of the pixel of the image. }
end;

procedure TOpenGLIsoMap.IsoMapGetSurfaceHeight(var ResultInt: Integer);
begin
  { DONE : Return the Height of the surface. }
  ResultInt := Height;
end;

procedure TOpenGLIsoMap.IsoMapGetSurfaceWidth(var ResultInt: Integer);
begin
  { DONE : Return the Width of the Surface. }
  ResultInt := Width;
end;

procedure TOpenGLIsoMap.IsoMapLoadBMPFromStream(Index: integer;
  Stream: TStream; Version: string);
begin
  ImageList.LoadBMPFromStream(Index, Stream, Version);
end;

procedure TOpenGLIsoMap.IsoMapLoadImageListFromStream(Stream: TStream;
  Version: string);
begin
  ImageList.LoadFromStream(Stream, Version);
end;

procedure TOpenGLIsoMap.IsoMapSaveBmpToStream(Index: integer;
  Stream: TStream; Version: string);
begin
  ImageList.SaveBMPToStream(Index, Stream, Version);
end;

procedure TOpenGLIsoMap.IsoMapSaveImageListToStream(Stream: TStream;
  Version: string);
begin
  ImageList.SaveToStream(Stream, Version);
end;

procedure TOpenGLIsoMap.IsoMapSetImageName(Index: Integer; Name: string);
begin
  { DONE : Change the name of the image. }
  ImageList.Names[Index] := Name;
end;

procedure TOpenGLIsoMap.IsoMapSetImageTransparentColor(Index: Integer;
  Color: TColor);
begin
  { DONE 3 : Change the transparnt color of the image. }
  ImageList.TransparentColors[Index] := Color;
end;

procedure TOpenGLIsoMap.LoadFromFile(filename: string);
begin
  IsoMap.LoadFromFile(filename);
end;

procedure TOpenGLIsoMap.SaveToFile(filename: string);
begin
  IsoMap.SaveToFile(filename);
end;

procedure TOpenGLIsoMap.SetCellSize(const Width, Height: Integer);
begin
  IsoMap.CellWidth := Width;
  IsoMap.CellHeight := Height;
end;

procedure TOpenGLIsoMap.SetHeight(const Value: Integer);
begin
  FHeight := Value;
  glViewport(0,0,Width,Height);						// Reset The Current Viewport
  glMatrixMode(GL_PROJECTION);						// Select The Projection Matrix
  glLoadIdentity();							// Reset The Projection Matrix
  glOrtho(0.0,Width,Height,0.0,-1.0,1.0);				// Create Ortho 640x480 View (0,0 At Top Left)
  glMatrixMode(GL_MODELVIEW);						// Select The Modelview Matrix
end;

procedure TOpenGLIsoMap.SetImageName(ImageIndex: integer;
  const Value: string);
begin
  ImageList.FImages[ImageIndex].Name := Value;
end;

procedure TOpenGLIsoMap.SetMapName(const Value: string);
begin
  IsoMap.MapName := Value;
end;

procedure TOpenGLIsoMap.SetMapSize(MaxX, MaxY: TGridInt);
begin
  IsoMap.SetMapSize(MaxX, MaxY);
end;

procedure TOpenGLIsoMap.SetScrollXOffset(const Value: Integer);
begin
  IsoMap.ScrollXOffset := Value;
end;

procedure TOpenGLIsoMap.SetScrollYOffset(const Value: Integer);
begin
  IsoMap.ScrollYOffset := Value;
end;

procedure TOpenGLIsoMap.SetWidth(const Value: Integer);
begin
  FWidth := Value;
  glViewport(0,0,Width,Height);						// Reset The Current Viewport
  glMatrixMode(GL_PROJECTION);						// Select The Projection Matrix
  glLoadIdentity();							// Reset The Projection Matrix
  glOrtho(0.0,Width,Height,0.0,-1.0,1.0);				// Create Ortho 640x480 View (0,0 At Top Left)
  glMatrixMode(GL_MODELVIEW);						// Select The Modelview Matrix
end;

procedure TOpenGLIsoMap.SetXOffset(const Value: Integer);
begin
  IsoMap.XOffset := Value;
end;

procedure TOpenGLIsoMap.SetYOffset(const Value: Integer);
begin
  IsoMap.YOffset := Value;
end;

function TOpenGLIsoMap._GetCell(X, Y: TGridInt): TIsoCell;
begin
  Result := IsoMap.Cell[X, Y];
end;

function TOpenGLIsoMap._GetImageColor(ImageIndex: Integer): TColor;
begin
  Result := IsoMap.ImageColor[ImageIndex];
end;

{ TOpenGLImageList }

function TOpenGLImageList.AddImage: Integer;
begin
  Result := Length(FImages);
  SetLength(FImages, Result + 1);
  with FImages[Result] do
  begin
    Width := 0;
    Height := 0;
    ImageData := nil;
    Name := '';
  end;
end;

constructor TOpenGLImageList.Create;
begin
  inherited;
end;

destructor TOpenGLImageList.Destroy;
var
  I: Integer;
begin
  for I := Count -1 downto 0 do
    FreeMem(FImages[I].ImageData);
  inherited;
end;

function TOpenGLImageList.GetCount: Integer;
begin
  { DONE  : Return the number of images. }
  Result := Length(FImages);
end;

function TOpenGLImageList.GetName(Index: Integer): string;
begin
  { DONE : Return the image name. }
  Result := FImages[Index].Name;
end;

function TOpenGLImageList.GetImage(Index: Integer): TImageInfo;
begin
  { DONE : Return the Image. }
  Result := FImages[Index];
end;

procedure TOpenGLImageList.LoadBMPFromStream(ImageIndex: Integer; Stream: TStream; const Version: string);
type
  TBMPLine = packed array[0..MaxListSize] of TColor;
var
  Bitmap: TBitmap;
  I: Integer;

  function MakePowerOf2(Value: Integer): Integer;
  begin
    Result := 1;
    while Result < Value do
      Result := Result shl 1;
  end;

begin
  { DONE : Load the BMP from the stream. }
  Bitmap := TBitmap.Create;
  try
    if ImageIndex >= Count then
      ImageIndex := AddImage;
    Bitmap.LoadFromStream(Stream);
    Bitmap.PixelFormat := pf32bit;

    with FImages[ImageIndex] do
    begin
      ImageData := nil;
      Width := Bitmap.Width;
      Height := Bitmap.Height;
      ReallocMem(ImageData, Bitmap.Width * Bitmap.Height * 4);
      for I := 0 to Bitmap.Height -1 do
        Move(Bitmap.ScanLine[I]^, ImageData^[(Bitmap.Height - I -1) * Bitmap.Width], Bitmap.Width * 4);
    end;
  finally
    Bitmap.Free;
  end;
end;

procedure TOpenGLImageList.LoadFromStream(Stream: TStream; const Version: string);
begin
  { TODO 4 : Load the ImageList from the stream. }
  raise Exception.Create('Image List not supported');
end;

procedure TOpenGLImageList.SaveBMPToStream(ImageIndex: Integer; Stream: TStream; const Version: string);
begin
  { TODO 2 : Save the BMP to the stream. }
end;

procedure TOpenGLImageList.SaveToStream(Stream: TStream; const Version: string);
begin
  { TODO 4 : Save the ImageList to the stream. }
  raise Exception.Create('Image List not supported');
end;

procedure TOpenGLImageList.SetName(Index: Integer; const Value: string);
begin
  { DONE : Change the image name. }
  FImages[Index].Name := Value;
end;

function TOpenGLImageList.GetTransparentColor(Index: Integer): TColor;
begin
  Result := FImages[Index].TransparentColor
end;

procedure TOpenGLImageList.SetTransparentColor(Index: Integer;
  const Value: TColor);
var
  I: Integer;
begin
  with Images[Index] do
  begin
    for I := 0 to Width * Height do
    begin
      if ImageData^[I] = TColor($FF000000) then
        ImageData^[I] := TransparentColor;
      if ImageData^[I] = Value then
        ImageData^[I] := TColor($FF000000);
    end;
    TransparentColor := Value;
  end;
end;

end.