mapproperties.pas

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

unit MapProperties;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, Buttons, EditMaps, ExtCtrls;

type
  TMapProps = class(TForm)
    Origine: TLabel;
    OrgX: TSpinEdit;
    OrgY: TSpinEdit;
    Dimensions: TLabel;
    SizeX: TSpinEdit;
    SizeY: TSpinEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Label1: TLabel;
    Label2: TLabel;
    cbDayLight: TCheckBox;
    Label3: TLabel;
    Shape1: TShape;
    ColorDialog1: TColorDialog;
    procedure SpeedButton1Click(Sender: TObject);
    procedure OrgXChange(Sender: TObject);
    procedure SizeXChange(Sender: TObject);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure cbDayLightClick(Sender: TObject);
  private
    { Private declarations }
    fWnd:THandle;
    fMap:TEditMap;
    Freeze:boolean;
    procedure SetMap(Value:TEditMap);
  public
    { Public declarations }
    property Map:TEditMap read fMap write SetMap;
  end;

var
  MapProps: TMapProps;

procedure EditMapProps(AWnd:THandle; AMap:TEditMap);

implementation

uses IsoMap1, ADKMaps;

{$R *.dfm}

procedure EditMapProps(AWnd:THandle; AMap:TEditMap);
begin
 if MapProps=nil then MapProps:=TMapProps.Create(Application);
 MapProps.fWnd:=AWnd;
 MapProps.Map:=AMap;
 MapProps.ShowModal;
end;

procedure TMapProps.SetMap(Value:TEditMap);
begin
 fMap:=Value;
 Freeze:=True;
 OrgX.Value:=fMap.Origin.x;
 OrgY.Value:=fMap.Origin.y;
 SizeX.Value:=fMap.Width;
 SizeY.Value:=fMap.Height;
 Freeze:=False;
 Shape1.Brush.Color:=fMap.Ambient;
 cbDayLight.Checked:=moDayLight in fMap.Options;
end;

procedure TMapProps.SpeedButton1Click(Sender: TObject);
var
 tag,dx,dy:integer;
begin
 tag:=TComponent(Sender).Tag;
 dx:=48*((tag and 3)-2);
 OrgX.Value:=OrgX.Value+dx;
 dy:=24*((tag div 100)-2);
 OrgY.Value:=OrgY.Value+dy;
end;

procedure TMapProps.OrgXChange(Sender: TObject);
begin
 if Freeze then exit;
 Map.Origin:=Point(OrgX.Value,OrgY.Value);
 InvalidateRect(fWnd,nil,false);
end;

procedure TMapProps.SizeXChange(Sender: TObject);
begin
 if not Freeze then begin
  Map.SetSize(SizeX.Value,SizeY.Value);
  InvalidateRect(fWnd,nil,False);
 end;
end;

procedure TMapProps.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 cl:integer;
begin
 ColorDialog1.Color:=Shape1.Brush.Color;
 if ColorDialog1.Execute then begin
  cl:=ColorDialog1.Color;
  Map.Ambient:=cl;
  Shape1.Brush.Color:=cl;
 end;
end;

procedure TMapProps.cbDayLightClick(Sender: TObject);
var
 mo:TMapOptions;
begin
 mo:=fMap.Options;
 if cbDayLight.Checked then
  Include(mo,moDayLight)
 else
  Exclude(mo,moDayLight);
 fMap.Options:=mo;
end;

end.