⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 hgeimages.pas

📁 完整的Delphi游戏开发控件
💻 PAS
字号:
unit HGEImages;
//---------------------------------------------------------------------------
//                                                     Modified: 17-Dec-2008
// HGE Images class                                          
//---------------------------------------------------------------------------
// Important Notice:
//
// If you modify/use this code or one of its parts either in original or
// modified form, you must comply with Mozilla Public License v1.1,
// specifically section 3, "Distribution Obligations". Failure to do so will
// result in the license breach, which will be resolved in the court.
// Remember that violating author's rights is considered a serious crime in
// many countries. Thank you!
//
// !! Please *read* Mozilla Public License 1.1 document located at:
//  http://www.mozilla.org/MPL/
//---------------------------------------------------------------------------
// The contents of this file are subject to the Mozilla Public License
// Version 1.1 (the "License"); you may not use this file except in
// compliance with the License. You may obtain a copy of the License at
// http://www.mozilla.org/MPL/
//
// Software distributed under the License is distributed on an "AS IS"
// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
// License for the specific language governing rights and limitations
// under the License.
//
// The Original Code is AsphyreImages.pas.
//
// The Initial Developer of the Original Code is Yuriy Kotsarenko.
// Portions created by M. Sc. Yuriy Kotsarenko are Copyright (C) 2007 - 2008,
// Yuriy Kotsarenko. All Rights Reserved.
//---------------------------------------------------------------------------
(*
** hgeImages helper class
** Extension to the HGE engine
** Extension added by DraculaLin
** This extension is NOT part of the original HGE engine.
*)

interface

uses
  Windows, SysUtils, StrUtils, HGE;

type

 THGEImages = class
 private
   Images: array of ITexture;
   SearchObjects: array of Integer;
   SearchDirty  : Boolean;
   function GetItem(Index: Integer): ITexture;
   function GetItemCount(): Integer;
   procedure InitSearchObjects();
   procedure SwapSearchObjects(Index1, Index2: Integer);
   function CompareSearchObjects(Obj1, Obj2: ITexture): Integer;
   function SplitSearchObjects(Start, Stop: Integer): integer;
   procedure SortSearchObjects(Start, Stop: integer);
   procedure UpdateSearchObjects();
   function GetImage(const Name: string): ITexture;
 public
   property Items[Index: Integer]: ITexture read GetItem; default;
   property ItemCount: Integer read GetItemCount;
   property Image[const Name: string]: ITexture read GetImage;
   function IndexOf(Element: ITexture): Integer; overload;
   function IndexOf(const Name: string): Integer; overload;
   procedure Remove(Index: Integer);
   procedure LoadFromFile(FileName: string); overload;
   procedure LoadFromFile(FileName: string; PatternWidth, PatternHeight: Integer); overload;
   procedure RemoveAll();
   procedure MarkSearchDirty();
   constructor Create();
   destructor Destroy(); override;
 end;

implementation
var
  FHGE: IHGE = nil;

constructor THGEImages.Create();
begin
 //inherited;
  FHGE := HGECreate(HGE_VERSION);
  SearchDirty:= False;
end;

destructor THGEImages.Destroy();
begin
  RemoveAll();
  inherited;
end;

function THGEImages.GetItem(Index: Integer): ITexture;
begin
  if (Index >= 0)and(Index < Length(Images)) then
    Result:= Images[Index] else Result:= nil;
end;

function THGEImages.GetItemCount(): Integer;
begin
  Result:= Length(Images);
end;

function THGEImages.IndexOf(Element: ITexture): Integer;
var
 I: Integer;
begin
  Result:= -1;

  for I:= 0 to Length(Images) - 1 do
    if (Images[i] = Element) then
    begin
      Result:= I;
      Break;
    end;
end;

procedure THGEImages.RemoveAll();
begin
  SetLength(Images, 0);
  SearchDirty:= True;
end;

procedure THGEImages.Remove(Index: Integer);
var
 I: Integer;
begin
  if (Index < 0)or(Index >= Length(Images)) then Exit;
  for I:= Index to Length(Images) - 2 do
    Images[I]:= Images[I + 1];
  SetLength(Images, Length(Images) - 1);
  SearchDirty:= True;
end;

procedure THGEImages.InitSearchObjects();
var
 I: Integer;
begin
  if (Length(Images) <> Length(SearchObjects)) then
    SetLength(SearchObjects, Length(Images));
  for I:= 0 to Length(Images) - 1 do
    SearchObjects[I]:= I;
end;

procedure THGEImages.SwapSearchObjects(Index1, Index2: Integer);
var
 Aux: Integer;
begin
  Aux:= SearchObjects[Index1];
  SearchObjects[Index1]:= SearchObjects[Index2];
  SearchObjects[Index2]:= Aux;
end;

function THGEImages.CompareSearchObjects(Obj1, Obj2: ITexture): Integer;
begin
  Result:= CompareText(Obj1.Name, Obj2.Name);
end;

function THGEImages.SplitSearchObjects(Start, Stop: Integer): Integer;
var
  Left, Right: Integer;
  Pivot: ITexture;
begin
  Left := Start + 1;
  Right:= Stop;
  Pivot:= Images[SearchObjects[Start]];
  while (Left <= Right) do
  begin
    while (Left <= Stop)and(CompareSearchObjects(Images[SearchObjects[Left]],
    Pivot) < 0) do Inc(Left);

    while (Right > Start)and(CompareSearchObjects(Images[SearchObjects[Right]],
    Pivot) >= 0) do Dec(Right);

    if (Left < Right) then SwapSearchObjects(Left, Right);
  end;

  SwapSearchObjects(Start, Right);
  Result:= Right;
end;


procedure THGEImages.SortSearchObjects(Start, Stop: Integer);
var
 SplitPt: integer;
begin
  if (Start < Stop) then
  begin
    SplitPt:= SplitSearchObjects(Start, Stop);
    SortSearchObjects(Start, SplitPt - 1);
    SortSearchObjects(SplitPt + 1, Stop);
  end;
end;


procedure THGEImages.UpdateSearchObjects();
begin
  InitSearchObjects();
  SortSearchObjects(0, Length(SearchObjects) - 1);
  SearchDirty:= False;
end;

function THGEImages.IndexOf(const Name: string): Integer;
var
 Lo, Hi, Mid: Integer;
begin
  if (SearchDirty) then UpdateSearchObjects();
  Result:= -1;
  Lo:= 0;
  Hi:= Length(SearchObjects) - 1;
  while (Lo <= Hi) do
  begin
    Mid:= (Lo + Hi) div 2;
    if (CompareText(Images[SearchObjects[Mid]].Name, Name) = 0) then
    begin
      Result:= SearchObjects[Mid];
      Break;
    end;
    if (CompareText(Images[SearchObjects[Mid]].Name, Name) > 0) then
      Hi:= Mid - 1 else Lo:= Mid + 1;
  end;
end;

function THGEImages.GetImage(const Name: string): ITexture;
var
 Index: Integer;
begin
  Index:= IndexOf(Name);
  if (Index <> -1) then Result:= Images[Index] else Result:= nil;
end;

procedure THGEImages.MarkSearchDirty();
begin
  SearchDirty:= True;
end;

procedure THGEImages.LoadFromFile(FileName: string);
var
  Index: Integer;
begin
  Index:= Length(Images);
  SetLength(Images, Index + 1);
  Images[Index] := FHGE.Texture_Load(FileName);
  Images[Index].Name := ExtractFileName(MidStr(FileName, 0, Length(FileName)-4));
  Images[Index].PatternWidth := Images[Index].GetWidth(True);
  Images[Index].PatternHeight := Images[Index].GetHeight(True);
  SearchDirty:= True;
end;

procedure THGEImages.LoadFromFile(FileName: string; PatternWidth, PatternHeight: Integer);
var
  Index: Integer;
begin
  Index:= Length(Images);
  SetLength(Images, Index + 1);
  Images[Index] := FHGE.Texture_Load(FileName);
  Images[Index].Name := ExtractFileName(MidStr(FileName, 0, Length(FileName)-4));
  Images[Index].PatternWidth := PatternWidth;
  Images[Index].PatternHeight := PatternHeight;
  SearchDirty:= True;
end;

initialization
  FHGE := nil;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -