imageinfo.pas

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

unit imageinfo;
{****************************************************************************
     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 IsoEditMdi.

     The Initial Developer of the Original Code is Crystal Software (Canada) Inc.
     and Chris Bruner. Portions created by Chris Bruner are Copyright
     (C) Crystal Software (Canada) Inc.  All Rights Reserved.

     Contributor(s): Chris Bruner of Crystal Software (Canada) Inc.
     (sign your name here)
******************************************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  isoengine,dxdraws,Grids, StdCtrls, ExtCtrls, Menus, ExtDlgs, DIB,util,inifiles;

type
  TImages = class(TForm)
    Panel1: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    IG: TStringGrid;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    PopupMenu1: TPopupMenu;
    Insert1: TMenuItem;
    Delete1: TMenuItem;
    Load1: TMenuItem;
    Exit1: TMenuItem;
    DeleteBmp1: TMenuItem;
    N1: TMenuItem;
    MoveDown1: TMenuItem;
    MoveUp1: TMenuItem;
    SaveBmptofile1: TMenuItem;
    N2: TMenuItem;
    SaveImageListtofile1: TMenuItem;
    SaveDialog1: TSaveDialog;
    SaveAlltofile1: TMenuItem;
    N3: TMenuItem;
    Selectalltilesofthistype1: TMenuItem;
    Properties1: TMenuItem;
    N4: TMenuItem;
    procedure IGDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure Button1Click(Sender: TObject);
    procedure IGMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Insert1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MoveDown1Click(Sender: TObject);
    procedure SaveBmptofile1Click(Sender: TObject);
    procedure MoveUp1Click(Sender: TObject);
    procedure DeleteBmp1Click(Sender: TObject);
    procedure SaveImageListtofile1Click(Sender: TObject);
    procedure SaveAlltofile1Click(Sender: TObject);
    procedure Selectalltilesofthistype1Click(Sender: TObject);
    procedure IGMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Properties1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
  private
    { Private declarations }
    acol,arow : Integer; // row and col of ig clicked on
  public
    { Public declarations }
  end;

var
  Images: TImages;

implementation

uses Main, ImageProperties;

{$R *.DFM}

procedure TImages.IGDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
function CentreH(s : string) : integer;
var tw : Integer;
begin
  tw := IG.Canvas.TextWidth(s);
  result := (rect.right + rect.left - tw) div 2;
  if tw >= (Rect.Right - Rect.Left) then IG.ColWidths[Acol] := tw + 5;
end;
function CentreV(s : string) : integer;
begin
  result := (rect.Top + rect.Bottom - IG.Canvas.TextHeight(s)) div 2;
end;

procedure OutText(s : string);
begin
  IG.Canvas.TextRect(rect,CentreH(s),CentreV(s),s);
end;

begin
  if (MainForm.ActiveChild=nil) or (MainForm.ActiveChild.IsoMap = nil)  then Exit;
{  index := ARow * IG.ColCount + ACol;
  with Sender as TDrawGrid do
  begin
    Canvas.Brush.Color := clBackGround;
    Canvas.FillRect(Rect);
//    ImageList1.Draw(Canvas,Rect.Left,Rect.Top,index);
    if gdFocused in State then
      Canvas.DrawFocusRect(Rect);
  end;
}
  if (ARow = 0) then
  begin
    ig.RowHeights[0] := IG.Canvas.TextHeight('Ay') + 10;
    IG.Canvas.pen.Color := clblack;
    case ACol of
    0 : OutText('Name'); //IG.Canvas.TextRect(rect,rect.left,rect.top+2,'Name');
    1 : OutText('Picture');
    2 : OutText('Width');
    3 : OutText('Height');
    end;
  end
  else
  begin
    case ACol of
    0: begin
        OutText(MainForm.Activechild.IsoMap.FImageList.Items[ARow-1].Name);
       end;
    1: begin
        IG.RowHeights[ARow] := MainForm.Activechild.IsoMap.ImageHeight[ARow-1] + 10;
        if (IG.ColWidths[ACol] < (MainForm.Activechild.IsoMap.ImageWidth[ARow-1] + 10)) then
          IG.ColWidths[ACol] := MainForm.Activechild.IsoMap.ImageWidth[ARow-1] + 10;
        IG.Canvas.Draw( Rect.Left + 5,Rect.Top + 5,MainForm.Activechild.IsoMap.FImageList.Items[ARow-1].Picture.Graphic);
        MainForm.Activechild.IsoMap.FImageList.Items[ARow-1].PatternSurfaces[0].Canvas.Release;
       end;
    2: OutText(IntToStr(MainForm.Activechild.IsoMap.ImageWidth[ARow-1]));
    3: begin
        IG.RowHeights[ARow] := MainForm.Activechild.IsoMap.ImageHeight[ARow-1]+10;
        OutText(IntToStr(MainForm.Activechild.IsoMap.ImageHeight[ARow-1]));
       end;
    end;
  end;
end;

procedure TImages.Button1Click(Sender: TObject);
var i : integer;
begin
  // search from current row down
  for i := iG.row+1 to IG.RowCount-1 do
  begin
    if (Pos(LowerCase(Edit1.Text),
        LowerCase(MainForm.Activechild.IsoMap.FImageList.Items[i-1].Name))<>0) then
    begin
      IG.Row := i;
      IG.TopRow := i;
      Exit;
    end;
  end;
  // start search over from top
  for i := 1 to IG.RowCount-1 do
  begin
    if (Pos(LowerCase(Edit1.Text),
        LowerCase(MainForm.Activechild.IsoMap.FImageList.Items[i-1].Name))<>0) then
    begin
      IG.Row := i;
      IG.TopRow := i;
      Exit;
    end;
  end;
end;

procedure TImages.IGMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IG.MouseToCell(X,Y,acol,arow);
  if ([ssright] = shift) and (arow<>0) and (acol<>0) then
  begin
    MoveUp1.Enabled := (arow<>1);
    movedown1.Enabled := (arow<>(IG.RowCount-1));
    popupmenu1.Popup(IG.Left + Left + X,IG.Top + Top + Y - 130);
  end;
end;

procedure TImages.Insert1Click(Sender: TObject);
var // dib : TDib;  //  c : TPictureCollectionItem;
  i : integer; // image index
  s : string;
  IVar : Integer;
begin
  if (OpenPictureDialog1.Execute) then
  begin
    { DONE -cStuff Yet to be done : Fix This Code }
    { Gladly -- MEW }
    try
      MainForm.AllowDrawing := False;
      i:=MainForm.Activechild.IsoMap.FImageList.Items.Add.Index;
      MainForm.Activechild.IsoMap.FImageList.Items[i].Picture.LoadFromFile(OpenPictureDialog1.FileName);
      MainForm.Activechild.IsoMap.FImageList.Items[i].Restore;
      MainForm.ActiveChild.IsoMap.RestoreGridAnts;
      MainForm.AllowDrawing := True;
      s := extractfilename(openpictureDialog1.filename);
      if (pos('.',s)>0) then
        delete(s,pos('.',s),9999);
    finally
    end;
    MainForm.Activechild.IsoMap.Initialize;
    IVar := MainForm.Activechild.IsoMap.FImageList.Items.Count;
    IG.RowCount := IVar +1;
  end;
end;

procedure TImages.MoveDown1Click(Sender: TObject);
var c : TPictureCollectionItem;
  img : TDXImageList;
  dib : TDib;
  s : string;
begin
  MainForm.ActiveChild.IsoMap.FIsoMap.SwapImages(arow-1,arow);
  img := MainForm.Activechild.IsoMap.FImageList;
  c := img.Items[arow];
  dib := tdib.Create;
  dib.assign(c.Picture.Graphic);
  s := img.Items[arow].Name;
  img.Items[arow].Name := img.Items[arow-1].Name;
  img.Items[arow-1].Name := s;
  img.Items[arow].Assign(img.Items[arow-1]);
  c := img.items[arow-1];
  c.picture.Graphic := dib;
  dib.Free;
  IG.Invalidate;
end;


procedure TImages.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = vk_return) then
    Button1Click(Sender);
end;

procedure TImages.FormCreate(Sender: TObject);
var IniFile : TInifile;
begin
  Inifile := GetInifile;
  LoadFormPosition(Self,inifile);
  Inifile.Free;
end;

procedure TImages.FormDestroy(Sender: TObject);
var IniFile : TInifile;
begin
  Inifile := GetInifile;
  SaveFormPosition(Self,inifile);
  inifile.Free;
end;


procedure TImages.SaveBmptofile1Click(Sender: TObject);
var dib : TDib;
  c : TPictureCollectionItem;
begin
      SavePictureDialog1.FileName := MainForm.Activechild.IsoMap.FImageList.Items[ARow-1].Name + '.bmp';
      if (SavePictureDialog1.Execute) then
      begin
        c := mainform.Activechild.IsoMap.FImageList.Items[arow-1];
        dib := TDIB.Create;
        try
          dib.Assign(c.Picture.Graphic);
          dib.SaveToFile(SavePictureDialog1.FileName);
        finally
        dib.Free;
        end;
      end;
end;

procedure TImages.MoveUp1Click(Sender: TObject);
begin
      Dec(arow);
      Movedown1click(Sender);
end;

procedure TImages.DeleteBmp1Click(Sender: TObject);
var x,y,l : integer;
begin
      MainForm.Activechild.IsoMap.FImageList.Items.Delete(arow-1);
      IG.RowCount := MainForm.Activechild.IsoMap.FImageList.Items.Count+1;
      with MainForm.Activechild.IsoMap do
      begin
        for x:= 0 to FIsoMap.MapWidth-1 do
          for y := 0 to FIsoMap.MapHeight-1 do
            for l := 0 to Length(FIsoMap.Cell[x,y].ImageIndexes)-1 do
            begin
              if (FIsoMap.Cell[x,y].ImageIndexes[l].ImageIndex = arow-1) then
                FIsoMap.Cell[x,y].ImageIndexes[l].ImageIndex := -1;
              if (FIsoMap.Cell[x,y].ImageIndexes[l].ImageIndex > arow-1) then
                dec(FIsoMap.Cell[x,y].ImageIndexes[l].ImageIndex);
            end;
      end;
end;

procedure TImages.SaveImageListtofile1Click(Sender: TObject);
var s : TFileStream;
begin
  if SaveDialog1.Execute then
  begin
    s := TFileStream.Create(SaveDialog1.FileName,fmCreate);
    mainform.Activechild.IsoMap.SaveImageListToStream(s);
    s.Free;
  end;
end;

procedure TImages.SaveAlltofile1Click(Sender: TObject);
var dib : TDib;
  c : TPictureCollectionItem;
  i : Integer;
  s : string;
begin
    ShowMessage('Select Location where to save first bmp, all bmps will be saved in the same location');
      SavePictureDialog1.FileName := MainForm.Activechild.IsoMap.FImageList.Items[0].Name + '.bmp';
      if (SavePictureDialog1.Execute) then
      begin
        s := ExtractFilePath(SavePictureDialog1.FileName);
        for i := 0 to MainForm.Activechild.IsoMap.FImageList.Items.Count-1 do
        begin
            c := mainform.Activechild.IsoMap.FImageList.Items[i];
            dib := TDIB.Create;
            try
              dib.Assign(c.Picture.Graphic);
              dib.SaveToFile(s + MainForm.Activechild.IsoMap.FImageList.Items[i].Name + '.bmp');
            finally
            dib.Free;
            end;
        end;
      end;
end;

procedure TImages.Selectalltilesofthistype1Click(Sender: TObject);
begin
  MainForm.Activechild.IsoMap.FIsoMap.SubAllState([TsSelected]);
  MainForm.Activechild.IsoMap.FIsoMap.FillAllImageState([tsSelected],arow-1,0);
end;

procedure TImages.IGMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if focused then
    if (ShowIsoHint(6)) then
      ShowIsoHint(5);
end;

procedure TImages.Properties1Click(Sender: TObject);
var  TransparentColor : TColor;
  r,g,b : Byte;
begin
  ImageProp.Caption :=MainForm.Activechild.IsoMap.FImageList.Items[ARow-1].DisplayName;
  ImageProp.ImageName.Text := ImageProp.Caption;
  ImageProp.Memo1.Text := MainForm.ActiveChild.IsoMap.FIsoMap.ImageStrings[Arow-1];
  ImageProp.Image1.Width := MainForm.Activechild.IsoMap.FImageList.Items[ARow-1].Picture.Graphic.Width;
  ImageProp.Image1.Height:= MainForm.Activechild.IsoMap.FImageList.Items[ARow-1].Picture.Graphic.Height;
  ImageProp.Image1.Canvas.Draw( 0,0,MainForm.Activechild.IsoMap.FImageList.Items[ARow-1].Picture.Graphic);
  TransparentColor := MainForm.Activechild.IsoMap.FImageList.Items[Arow-1].TransparentColor;
  r := TransparentColor and $0000ff;
  g := (TransparentColor and $00ff00) shr 8;
  b := (TransparentColor and $ff0000) shr(16);
  ImageProp.red.text := IntToStr(r);
  ImageProp.green.Text := IntToStr(g);
  ImageProp.blue.Text := IntToStr(b);
  if (ImageProp.ShowModal = mrOK) then
  begin
    r := StrToInt(ImageProp.red.Text);
    g := StrToInt(ImageProp.green.Text);
    b := StrToInt(ImageProp.blue.Text);
    TransparentColor := RGB(r,g,b);
    MainForm.Activechild.IsoMap.FImageList.Items[arow-1].Name := ImageProp.ImageName.Text;
    MainForm.ActiveChild.IsoMap.FIsoMap.ImageStrings[Arow-1] := ImageProp.memo1.Text;
    MainForm.Activechild.IsoMap.FImageList.Items[arow-1].TransparentColor := TransparentColor;
  end;
end;


procedure TImages.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caMinimize;
end;

procedure TImages.FormShow(Sender: TObject);
begin
  mainform.Images1.Checked := True;
end;

procedure TImages.FormHide(Sender: TObject);
begin
  mainform.Images1.Checked := false;
end;

end.