miniviews.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit MiniViews;

{
 projet ADK-ISO (c)2002-2003 Paul TOTH <[e-mail]>

 http://www.web-synergy.net/naug-land/

}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus;

type
  TMiniView = class(TForm)
    PopupMenu1: TPopupMenu;
    ColorDialog1: TColorDialog;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    bmp:TBitmap;
    mm,mx,my:integer;
    procedure WMEraseBkGnd(var msg:TMessage); message wm_erasebkgnd;
    procedure MeasureColorItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure DrawColorItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    procedure ColorClick(Sender:TObject);
  public
    { Public declarations }
    procedure ResetMap;
    procedure Redraw;
    property Bitmap:TBitmap read bmp;
  end;

var
  MiniView: TMiniView;

implementation

uses IsoMap1,EditMaps, CommonData,ADKMaps;

{$R *.dfm}

var
 colors:array[TObstacle] of integer;

procedure TMiniView.WMEraseBkGnd(var msg:TMessage);
begin
 msg.Result:=1;
end;

procedure TMiniView.FormPaint(Sender: TObject);
var
 sw,sh:single;
 r:TRect;
begin
 if bmp.Width=0 then exit;
 with Canvas do begin
  StretchDraw(ClientRect,bmp);

  Brush.Style:=bsClear;

  sw:=2*ClientWidth/bmp.Width/96;
  sh:=2*ClientHeight/bmp.height/48;
  r.Left:=round((48*MainForm.MapFrame1.EditMap.Height-MainForm.MapFrame1.ScrollX-MainForm.MapFrame1.EditMap.Origin.x)*sw);
  r.Top:=round((12-MainForm.MapFrame1.ScrollY-MainForm.MapFrame1.EditMap.Origin.y)*sh);
  r.Right:=r.Left+round(MainForm.MapFrame1.Width*sw);
  r.Bottom:=r.Top+round(MainForm.MapFrame1.Height*sh);
  Pen.color:=clRed;
  Rectangle(r);
 end;

end;

procedure TMiniView.FormCreate(Sender: TObject);
var
 o:TObstacle;
 m:TMenuItem;
begin
 bmp:=TBitmap.Create;
 for o:=low(TObstacle) to High(TObstacle) do begin
  m:=NewItem(ObstacleNames[o],0,False, True, ColorClick,0,'');
  m.OnMeasureItem:=MeasureColorItem;
  m.OnDrawItem:=DrawColorItem;
  m.Tag:=ord(o);
  PopupMenu1.Items.Add(m);
 end;
end;

procedure TMiniView.MeasureColorItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
 inc(Width,24);
end;

procedure TMiniView.DrawColorItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
 o:TObstacle;
begin
 o:=TObstacle(TMenuItem(Sender).Tag);
 with ACanvas do begin
  TextRect(ARect,ARect.Left+24,ARect.Top+2,ObstacleNames[o]);
  Brush.Color:=colors[o];
  Rectangle(ARect.Left+2,ARect.Top+2,ARect.Left+20,ARect.Bottom-2);
 end;
end;

procedure TMiniView.ColorClick(Sender:TObject);
var
 o:TObstacle;
begin
 o:=TObstacle(TMenuItem(Sender).Tag);
 ColorDialog1.Color:=Colors[o];
 if ColorDialog1.Execute then Colors[o]:=ColorDialog1.Color;
end;

procedure TMiniView.FormDestroy(Sender: TObject);
begin
 bmp.Free;
end;

procedure TMiniView.ResetMap;
var
 mw,mh:integer;
 x:integer;
begin
 mw:=MainForm.MapFrame1.EditMap.Width;
 mh:=MainForm.MapFrame1.EditMap.Height;
 bmp.Width :=mw+mh;
 bmp.Height:=mw+mh+1;
 x:=MainForm.Width div 2;
 ClientWidth:=x;
 ClientHeight:=x div 2;
 Redraw;
end;

procedure TMiniView.Redraw;
var
 mw,mh:integer;
 x,y:integer;
 i,j:integer;
 cl:TColor;
begin
 mw:=MainForm.MapFrame1.EditMap.Width;
 mh:=MainForm.MapFrame1.EditMap.Height;
 with bmp.Canvas do begin
  Brush.Color:=clSilver;
  FillRect(ClipRect);
 end;
 x:=mh-1;
 y:=1;
 for i:=0 to mw-1 do begin
  for j:=0 to mh-1 do begin
   cl:=colors[MainForm.MapFrame1.EditMap.Cells[i,j].Obstacle];
   bmp.Canvas.Pixels[x  ,y]:=cl;
   bmp.Canvas.Pixels[x+1,y]:=cl;
   dec(x);
   inc(y);
  end;
  inc(x,mh+1);
  dec(y,mh-1);
 end;
 Invalidate;
end;

procedure TMiniView.FormResize(Sender: TObject);
begin
 Invalidate;
end;

procedure TMiniView.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 mm:=ord(button)+1;
 mx:=x;
 my:=y;
end;

procedure TMiniView.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 mm:=0;
end;

procedure TMiniView.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
 sw,sh:single;
begin
 if mm=1 then begin
  sw:=2*ClientWidth/bmp.Width/96;
  sh:=2*ClientHeight/bmp.height/48;
  MainForm.MapFrame1.ScrollX:=MainForm.MapFrame1.ScrollX+Round((mx-x)/sw);
  MainForm.MapFrame1.ScrollY:=MainForm.MapFrame1.ScrollY+Round((my-y)/sh);
  MainForm.MapFrame1.Invalidate;
  mx:=x;
  my:=y;
  RePaint;
 end;
end;

procedure getColors;
var
 o:TObstacle;
begin
 for o:=low(TObstacle) to high(TObstacle) do colors[o]:=Ini.ReadInteger('MiniMap',ObstacleNames[o],15*ord(o));
end;

procedure setColors;
var
 o:TObstacle;
begin
 for o:=low(TObstacle) to high(TObstacle) do Ini.WriteInteger('MiniMap',ObstacleNames[o],colors[o]);
end;

initialization
 getColors;
finalization
 setColors;
end.