Когда-то делал программу для построения схемы жд станции. С изменением, соответственно, и размера, и положения и т.д.
Вот, куски кода, может пригодится
| Код |
unit Putj;
....
type
TPutj = class(TGraphicControl)
protected
public
Name:string[15];
SetMove,setSizeVL,setSizeVR,SetSizeGT,setSizeGB,selected:Boolean;
XPosR,YPosR,nom:integer;
....
constructor Create(AOwner:TComponent);override;
procedure CreateOpen;virtual;
procedure Drw(Bounds:TRect;Canvas:TCanvas);virtual;
procedure Paint;override;
procedure DblClick(var MousePt:TWMLButtonDblClk);message
wm_LBUTTONDBLCLK;
procedure MouseClick(var MousePt:TWMLButtonDown);message
wm_LButtonDown;
procedure MouseUp(var MousePt:TWMLButtonUp);message
wm_LButtonUp;
procedure MouseMov(var MousePt:TWMMouseMove);message
wm_MouseMove;
procedure MouseLiv(var MousePt:TWMMouseMove);message
cm_MouseLeave;
....
....
end;
implementation
procedure TPutj.Drw(Bounds:TRect;Canvas:TCanvas);
var ...
begin
with bounds,Canvas do
begin
if Selected then
pen.Color:=clBlue
else
pen.Color:=clBtnFace;
brush.Style:=bsClear;
pen.Style:=psDashDotDot;
Rectangle(left,top,right,bottom);
if (elem[1]<>0) or (elem[2]<>0) then
.....
MoveTo(left,top+7*form[TekForm].ZoomIn div 2);
LineTo(right-7*form[TekForm].ZoomIn div 2,bottom);
Canvas.TextOut((left+right)div 2-4*form[TekForm].ZoomIn,
(top+bottom)div 2,a);
end else begin
.....
end;
constructor TPutj.Create(AOwner:TComponent);
var i,j:integer;
begin
inherited Create(AOwner);
Selected:=true;
if nomglobp<>0 then form[TekForm].UnSel;
SetMove:=False;
nomglobp:=nomglobp+1;
nom:=form[TekForm].teknom;
end;
procedure TPutj.CreateOpen;
begin
inherited Create(form[TekForm]);
selected:=false;
end;
procedure TPutj.Paint;
var
DrawRct:TRect;
begin
with Canvas, DrawRct do begin
DrawRct:=ClientRect;
drw(DrawRct,Canvas);
end;
end;
procedure TPutj.MouseClick(var MousePt:TWMLButtonDown);
begin
form[TekForm].element:=1;
if not form[TekForm].setDrag then begin
form[TekForm].UnSel;
if orient = 1 then
if (MousePt.XPos<=5) then
setSizeVL:=true
else
....
end;
procedure TPutj.MouseUp(var MousePt:TWMLButtonUp);
begin
...
end;
procedure TPutj.MouseMov(var MousePt:TWMMouseMove);
var a,b:string;
v:boolean;
begin
Hint:=
...
if SetMove then begin
if v then form[TekForm].vnesIzm:=true;
if grid7(Left+MousePt.XPos-XPosR) then Left:=Left+MousePt.XPos-XPosR;
if grid7(Top+MousePt.YPos-YPosR) then Top:=Top+MousePt.YPos-YPosR;
end;
if SetSizeVL then begin
if v then form[TekForm].vnesIzm:=true;
if Grid7(Width+XPosR-MousePt.XPos) then Width:=Width+XPosR-MousePt.XPos;
if Grid7(Left+MousePt.XPos-XPosR) then Left:=Left+MousePt.XPos-XPosR;
end;
if setsizeVR then begin
if Grid7(MousePt.XPos) then Width:=MousePt.XPos;
end;
if setsizeGT then begin
if Grid7(Height+YPosR-MousePt.YPos) then Height:=Height+YPosR-MousePt.YPos;
if Grid7(Top+MousePt.YPos-YPosR) then Top:=Top+MousePt.YPos-YPosR;
end;
.....
end;
procedure TPutj.MouseLiv(var MousePt:TWMMouseMove);
begin
if (not SetMove) and (form[TekForm].cursor<>crDrag) and (form[TekForm].cursor<>crDefault)
and not setsizeVL and not setsizeVR and not setsizeGT
and not setsizeGB
then begin
form[TekForm].cursor:=crDefault;
end;
end;
procedure TPutj.DblClick(var MousePt:TWMLButtonDblClk);
begin
form[TekForm].element:=1;
Form2.FormCreate(Form2);
form2.showmodal;
end;
function TPutj.Grid7(g:integer):boolean;
begin
if g div (7*Form[TekForm].ZoomIn) =g/(7*Form[TekForm].ZoomIn) then
grid7:=true
else
grid7:=false;
end;
end.
unit Stans;
interface
uses
...
type
TForm1 = class(TForm)
...
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClick(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Putj: array of TPutj;
strel: array of TStr;
soed: array of TSoedin;
...
end;
var
Form:array [1..100] of TForm1;
TekForm:integer;
const kolform:integer=1;
implementation
uses panel,table, change;
{$R *.DFM}
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var el:TPutj;
begin
if setdrag then
cursor:= crDrag;
el:=nil;
if putj[form[TekForm].TekNom]<>nil then
if putj[form[TekForm].TekNom].selected then
el:=putj[form[TekForm].TekNom];
if strel[form[TekForm].TekNom]<>nil then
if strel[form[TekForm].TekNom].selected then
el:=strel[form[TekForm].TekNom];
if el<>nil then begin
if el.setmove=true then begin
if not VnesIzm then VnesIzm:=true;
if el.Grid7(X-el.XPosR) then el.left:=X-el.XPosR;
if el.Grid7(Y-el.YPosR) then el.top:=Y-el.YPosR;
end;
if el.SetSizeVL then begin
if not VnesIzm then VnesIzm:=true;
if el.Grid7(el.width+el.Left-X+el.XPosR) then el.width:=el.width+el.Left-X+el.XPosR;
if el.Grid7(X-el.XPosR) then el.Left:=X-el.XPosR;
end;
if el.setsizeVR then begin
if not VnesIzm then VnesIzm:=true;
if el.Grid7(X-el.Left) then el.Width:=X-el.Left;
end;
if el.SetSizeGT then begin
if not VnesIzm then VnesIzm:=true;
if el.Grid7(el.Height+el.Top-Y+el.YPosR) then el.Height:=el.Height+el.Top-Y+el.YPosR;
if el.Grid7(Y-el.YPosR) then el.Top:=Y-el.YPosR;
end;
if el.setsizeGB then begin
if not VnesIzm then VnesIzm:=true;
if el.Grid7(Y-el.Top) then el.Height:=Y-el.Top;
end;
if (el.orient=1) and (el.Width<14*ZoomIn)
then el.Width:=14*ZoomIn;
if (el.orient=2) and (el.Height<14*ZoomIn)
then el.Height:=14*ZoomIn;
if (not (el is TStr))and (el.orient=1) then
if el.hvost=1 then el.height:=el.width else
el.height:=7*form[TekForm].ZoomIn;
if (not (el is TStr))and (el.orient=2) then
if el.hvost=1 then el.width:=el.height else
el.width:=7*form[TekForm].ZoomIn;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Soedin;
if putj[form[TekForm].TekNom]<>nil then begin
if putj[form[TekForm].TekNom].selected then
if (cursor=crSizeWE) or (cursor=crSizeNS) then
if Auto then Opredlin;
putj[form[TekForm].TekNom].UnSet;
cursor:=crDefault;
end;
if strel[form[TekForm].TekNom]<>nil then begin
if strel[form[TekForm].TekNom].selected then
if Auto then Opredlin;
strel[form[TekForm].TekNom].UnSet;
cursor:=crDefault;
end;
end;
procedure TForm1.FormClick(Sender: TObject);
begin
unSel;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var j,i:integer;
begin
if setdrag then begin
if not VnesIzm then VnesIzm:=true;
if element=1 then begin
j:=1;
while (j<>KolPutj+1) and (putj[j]<>nil) do J:=J+1;
if j<>KolPutj+1 then begin
form[TekForm].TekNom:=j;
putj[j]:=TPutj.Create(self);
if Putj[j]=nil then exit;
putj[j].Parent:=Self;
putj[j].elem[1]:=0;
putj[j].elem[2]:=0;
...
|
Добавлено @ 10:31
и еще в форме-панели кнопочки
| Код |
procedure TForm3.SpeedButton1Click(Sender: TObject);
begin
form[TekForm].drag;
form[TekForm].orientaz:=1;
form[TekForm].element:=1;
form[TekForm].hvostg:=2;
end;
|
|
