vehicles.pas

FlexGraphics是一套创建矢量图形的VCL组件

unit Vehicles;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FlexBase, FlexUtils, FlexControls, FlexProps, StdCtrls, ExtCtrls, Menus;

const
  VehicleInitialCount = 10;
  VehicleIconSize = 20 * PixelScaleFactor; // 20 pixels
  VehicleStep = 5 * PixelScaleFactor; // 5 pixels

type
  TfmVehicles = class(TForm)
    lbxVehicles: TListBox;
    panName: TPanel;
    cbColor: TComboBox;
    cd_Vehicle: TColorDialog;
    pmVehicles: TPopupMenu;
    miVehicleNew: TMenuItem;
    miVehicleDelete: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edHPos: TEdit;
    edVPos: TEdit;
    Label4: TLabel;
    chMovement: TCheckBox;
    tmMoves: TTimer;
    procedure cbColorDropDown(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lbxVehiclesClick(Sender: TObject);
    procedure cbColorDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure tmMovesTimer(Sender: TObject);
  private
    { Private declarations }
    procedure CreateVehicles(Flex: TFlexPanel; Scheme: TFlexCustomScheme);
    procedure UpdateForm;
  public
    { Public declarations }
  end;

var
  fmVehicles: TfmVehicles;

implementation

{$R *.DFM}

uses
  Main;

// TfmVehicles ////////////////////////////////////////////////////////////////

procedure TfmVehicles.FormCreate(Sender: TObject);
begin
 cbColor.ItemIndex := 0;
 CreateVehicles(fmMain.fpMain, fmMain.IdahoScheme);
 lbxVehicles.ItemIndex := 0;
 lbxVehiclesClick(Nil);
end;

procedure TfmVehicles.CreateVehicles(Flex: TFlexPanel; Scheme: TFlexCustomScheme);
var i: integer;
    Item: TFlexEllipse;
begin
 if not Assigned(Scheme) then Scheme := Flex.ActiveScheme;
 for i:=0 to VehicleInitialCount-1 do begin
  Item := TFlexEllipse.Create(Flex, Scheme, Flex.ActiveLayer);
  Item.Name := Format('Vehicle %d', [i+1]);
  Item.Hint := Item.Name;
  Item.Width := VehicleIconSize;
  Item.Height := VehicleIconSize;
  Item.BrushProp.Color := $0035B9FF;
  Item.PenProp.Color := $00006CA7;
  Item.Reference := Scheme;
  with fmMain.GeneratePos do begin
   Item.Left := X + Item.Width div 2;
   Item.Top := Y + Item.Height div 2;
  end;
  with fmMain.GeneratePos do begin
   Item.UserData.Values['DestX'] := IntToStr(X);
   Item.UserData.Values['DestY'] := IntToStr(Y);
  end;
  Item.UserData.Values['Movement'] := '1';
  lbxVehicles.Items.AddObject(Item.Name, Item);
 end;
end;

procedure TfmVehicles.cbColorDropDown(Sender: TObject);
var Brush: TBrushProp;
begin
 cbColor.DroppedDown := False;
 cd_Vehicle.Color := cbColor.Tag;
 if cd_Vehicle.Execute then begin
  cbColor.Tag := cd_Vehicle.Color;
  Brush := TBrushProp(fmMain.ActiveControl.Props['Brush']);
  if Assigned(Brush) then Brush.Color := cbColor.Tag;
  Refresh;
 end;
end;

procedure TfmVehicles.lbxVehiclesClick(Sender: TObject);
var R: TRect;
begin
 fmMain.ActiveControl :=
  TFlexControl(lbxVehicles.Items.Objects[lbxVehicles.ItemIndex]);
 UpdateForm;
 if Assigned(Sender) then with fmMain, ActiveControl.PaintRect do begin
  fpMain.ActiveScheme := IdahoScheme;
  if (Left < 0) or (Top < 0) or
     (Right > ClientWidth) or (Bottom > ClientHeight) then begin
   // Positioning
   R := ActiveControl.DocRect;
   fpMain.Zoom(fmMain.fpMain.Scale, @R);
  end;
 end;
end;

procedure TfmVehicles.UpdateForm;
var Brush: TBrushProp;
begin
 // Properties
 with fmMain.ActiveControl do begin
  panName.Caption := Format(' %s', [Name]);
  Brush := TBrushProp(fmMain.ActiveControl.Props['Brush']);
  if Assigned(Brush)
   then cbColor.Tag := Brush.Color
   else cbColor.Tag := 0;
  cbColor.Invalidate;
 end;
 // Context menu items
 miVehicleNew.Enabled := lbxVehicles.Items.Count < 1000;
 miVehicleDelete.Enabled := lbxVehicles.Items.Count > 1;
end;

procedure TfmVehicles.cbColorDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
 with cbColor.Canvas do begin
  Brush.Color := cbColor.Tag;
  FillRect(Rect);
 end;
end;

procedure TfmVehicles.tmMovesTimer(Sender: TObject);
var i: integer;
    Vehicle: TFlexControl;
    Pos, Dest: TPoint;
    K, Len, W, H: Extended; 
begin
 for i:=0 to lbxVehicles.Items.Count-1 do
 try
  Vehicle := TFlexControl(lbxVehicles.Items.Objects[i]);
  if Vehicle.UserData.Values['Movement'] = '0' then continue;
  Pos.X := Vehicle.Left + Vehicle.Width div 2;
  Pos.Y := Vehicle.Top + Vehicle.Height div 2;
  Dest.X := StrToInt(Vehicle.UserData.Values['DestX']);
  Dest.Y := StrToInt(Vehicle.UserData.Values['DestY']);
  // Do step
  W := Dest.X - Pos.X;
  H := Dest.Y - Pos.Y;
  Len := sqrt(W*W + H*H);
  if Len < VehicleStep then begin
   Pos.X := Dest.X;
   Pos.Y := Dest.Y;
  end else begin
   K := VehicleStep / Len;
   Pos.X := Pos.X + round(W * k);
   Pos.Y := Pos.Y + round(H * k);
  end;
  // Move
  Vehicle.Left := Pos.X - Vehicle.Width div 2;
  Vehicle.Top := Pos.Y - Vehicle.Height div 2;
  Vehicle.Hint := Format('%s'#13#10'X: %.3f'#13#10'Y: %.3f', [Vehicle.Name,
    Pos.X / PixelScaleFactor, Pos.Y / PixelScaleFactor]);
  // Check new dest point
  if (Pos.X = Dest.X) and (Pos.Y = Dest.Y) then
   with fmMain.GeneratePos do begin
    Vehicle.UserData.Values['DestX'] := IntToStr(X);
    Vehicle.UserData.Values['DestY'] := IntToStr(Y);
   end;
  // Check active
  if i = lbxVehicles.ItemIndex then begin
   edHPos.Text := Format('%.3f', [Pos.X / PixelScaleFactor]);
   edVPos.Text := Format('%.3f', [Pos.Y / PixelScaleFactor]);
  end;
 except
 end;
end;

end.