unit Module;
interface
{$R 'res\icons\icons.res'}
{$R 'res\images\images.res'}
uses Windows, Messages, Types, Classes, Controls, Graphics, Basic,
Buttons, Forms, Dialogs, SysUtils, Port, IniFiles;
const
WM_DESTROY_MODULE=Messages.WM_USER+42;
type
TMessage=record
Msg: Word;
end;
TModule=class;
TModuleDestructionEvent=procedure(Sender: TObject;
var DoDestroy: Boolean; Module: TModule)
of object;
TRectArray=array
of TRect;
TPortArray=array
of TPort;
TSpeedButtonArray=array
of TSpeedButton;
TTool=(tlMove=0, tlDelete=1, tlWire=2, tlModule=3);
TModuleInfo=record
Group, ID: Byte;
Title:
string;
end;
TWirePoint=record
X, Y: Integer;
end;
TWire=record
Nodes:
array of TWirePoint;
BitWidth: Cardinal;
Sender, Recipient: TModule;
end;
TModule=class(TGraphicControl)
protected
FMovable: Boolean;
FInitialX, FInitialY: Integer;
FImage: TBitmap;
FInputPorts, FOutputPorts: TPortArray;
FActiveTool: TTool;
FTitle:
String;
FGroup, FID: Cardinal;
FInputPositions, FOutputPositions: TRectArray;
procedure HandleMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure HandleMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure HandleMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
public
constructor Create(AOwner: TComponent);
override;
class function GetTitle:
String;
procedure Compute;
virtual;
abstract;
property Group: Cardinal
read FGroup;
property ID: Cardinal
read FID;
published
property Movable: Boolean
read FMovable
write FMovable
default True;
property Image: TBitmap
read FImage
write FImage;
property InputPorts: TPortArray
read FInputPorts
write FInputPorts;
property OutputPorts: TPortArray
read FOutputPorts
write FOutputPorts;
property ActiveTool: TTool
read FActiveTool
write FActiveTool;
end;
TAutoLoadingModule=class(TModule)
public
constructor Create(AOwner: TComponent);
override;
procedure Paint;
override;
end;
TModuleClass=class
of TModule;
procedure AddModuleButton(Module: TModuleClass;
var ModuleButtons:
TSpeedButtonArray; Parent: TWinControl; OnClick: TNotifyEvent;
Indent: Integer=4; GroupIndex: Integer=1);
implementation
procedure AddModuleButton(Module: TModuleClass;
var ModuleButtons:
TSpeedButtonArray; Parent: TWinControl; OnClick: TNotifyEvent;
Indent: Integer=4; GroupIndex: Integer=1);
var Button: TSpeedButton;
begin
Button:=TSpeedButton.Create(Parent);
Button.Parent:=Parent;
Button.Glyph.LoadFromResourceName(HINSTANCE, Module.ClassName);
Button.Width:=28;
Button.Height:=28;
Button.Left:=Indent+length(ModuleButtons)*32;
Button.Top:=4;
Button.Tag:=Integer(Module);
Button.OnClick:=OnClick;
Button.GroupIndex:=GroupIndex;
Button.Hint:=Module.GetTitle;
Button.ShowHint:=True;
Button.Flat:=True;
setlength(ModuleButtons, length(ModuleButtons)+1);
ModuleButtons[high(ModuleButtons)]:=Button;
end;
constructor TModule.Create(AOwner: TComponent);
var ini: TIniFile;
CN:
String;
I, n: Integer;
begin
inherited Create(AOwner);
CN:=ClassName;
if csOpaque
in ControlStyle
then ControlStyle:=ControlStyle- [csOpaque];
OnMouseDown:=HandleMouseDown;
OnMouseUp:=HandleMouseUp;
OnMouseMove:=HandleMouseMove;
FMovable:=True;
ini:=TIniFile.Create(ModuleConfigFile);
try
if ini.SectionExists(CN)
then
begin
FGroup:=ini.ReadInteger(CN,'
Group',0);
FID:=ini.ReadInteger(CN,'
ID',0);
FTitle:=ini.ReadString(CN,'
Title','
');
n:=ini.ReadInteger(CN,'
InputPorts',0);
setlength(FInputPorts,n);
for I:=1
to n
do
FInputPorts[I]:=TPort.Create(Compute,1,Rect(
ini.ReadInteger(CN,'
Input'+inttostr(I)+'
Left',0),
ini.ReadInteger(CN,'
Input'+inttostr(I)+'
Top',0),
ini.ReadInteger(CN,'
Input'+inttostr(I)+'
Right',0),
ini.ReadInteger(CN,'
Input'+inttostr(I)+'
Bottom',0)));
n:=ini.ReadInteger(CN,'
OutputPorts',0);
setlength(FOutputPorts,n);
for I:=1
to n
do
FOutputPorts[I]:=TPort.Create(Compute,1,Rect(
ini.ReadInteger(CN,'
Output'+inttostr(I)+'
Left',0),
ini.ReadInteger(CN,'
Output'+inttostr(I)+'
Top',0),
ini.ReadInteger(CN,'
Output'+inttostr(I)+'
Right',0),
ini.ReadInteger(CN,'
Output'+inttostr(I)+'
Bottom',0)));
end;
finally
ini.Free;
end;
end;
class function TModule.GetTitle:
String;
var ini: TIniFile;
begin
ini:=TIniFile.Create(ModuleConfigFile);
try
Result:=ini.ReadString(ClassName,'
Title','
');
finally
ini.free;
end;
end;
procedure TModule.HandleMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FMovable
and (ActiveTool=tlMove)
then
begin
Screen.Cursor:=crSizeAll;
FInitialX:=X;
FInitialY:=Y;
end;
end;
procedure TModule.HandleMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FMovable
then
if (ActiveTool=tlMove)
then
begin
Screen.Cursor:=crDefault;
end;
if (ActiveTool=tlDelete)
then
begin
PostMessage(parent.Handle,WM_DESTROY_MODULE,Integer(Self),0);
end;
end;
procedure TModule.HandleMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if (Shift=[ssLeft])
and FMovable
and (ActiveTool=tlMove)
then
begin
Left:=(Left+X-FInitialX)
div 8*8;
Top:=(Top+Y-FInitialY)
div 8*8;
end;
end;
constructor TAutoLoadingModule.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FImage:=TBitmap.Create;
FImage.LoadFromResourceName(HInstance, '
_'+ClassName);
Width:=FImage.Width;
Height:=FImage.Height;
Constraints.MinWidth:=FImage.Width;
Constraints.MaxWidth:=FImage.Width;
Constraints.MinHeight:=FImage.Height;
Constraints.MaxHeight:=FImage.Height;
end;
procedure TAutoLoadingModule.Paint;
begin
inherited Paint;
Canvas.Brush.Style:=bsClear;
Canvas.Pen.Style:=psClear;
Canvas.BrushCopy(FImage.Canvas.ClipRect, FImage,
FImage.Canvas.ClipRect, clFuchsia);
end;
end.