if i<>index then ToolBar1.Buttons[i].Down:=False;
end;
end;
procedure TForm1.STDPanel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i: Integer;
begin
if Button = mbLeft then
begin
mx:=x;
my:=y;
OldSelect.x := mx;
OldSelect.y := my;
if not SelectItems then
begin
SelectItems := True;
end;
if not (ssShift in Shift) then
begin
for i := 0 to SelectedItems.Count - 1 do
SelectedItems.Items[i].Selected := False;
for i := 0 to SelectedLinks.Count - 1 do
SelectedLinks.Items[i].Selected := False;
SelectedItems.Clear;
SelectedLinks.Clear;
end;
end;
end;
procedure TForm1.ToolButton6Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.ToolButton7Click(Sender: TObject);
var
ii: Word;
begin
if item_index<>1 then
begin
end;
for ii:=1 to link_index-1 do links[ii].Destroy;
link_index:=1;
for ii:=1 to item_index-1 do item[ii].Destroy;
item_index:=1;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
mask,pic:TBitmap;
icons,icons1:TextFile;
s,icon_name,hint_string:string;
tool_button:TToolButton;
idx: Word;
ii: Word;
szAcadCaption: PChar;
begin
kol:=0;
CommandEnded := True;
Successful := True;
CommandsCount := 0;
program_dir:=application.ExeName;
for ii:=length(program_dir) downto 1 do
if program_dir[ii]='\' then break;
delete(program_dir,ii,length(program_dir)-1);
SaveDialog1.InitialDir:=program_dir+'\save';
OpenDialog1.InitialDir:=program_dir+'\save';
item_index:=1;
index_item:=1;
link_index:=1;
index_link:=1;
first_click:=false;
second_click:=false;
destroy_flag:=false;
mask:=TBitmap.create;
mask.Width:=46;
mask.height:=46;
mask.Canvas.brush.color:=clBlack;
mask.Canvas.pen.color:=clBlack;
mask.Canvas.FillRect(rect(0,0,45,45));
AssignFile(icons,program_dir+'\icons.lst');
Reset(icons);
idx:=0;
ImageList1.Clear;
While not eof(icons) do
begin
readln(icons,s);
if s = '' then break;
icon_name:=copy(s,1,pos(' ',s)-1);
Delete(s,1,pos(' ',s));
if Pos(' ', S) > 0 then
s := Copy(s,1,Pos(' ', s) - 1);
hint_string := s;
tool_button:=TToolButton.Create(ToolBar1);
With tool_button do
begin
pic:=TBitmap.create;
try
pic.LoadFromFile(program_dir+'\images\'+icon_name+'.bmp');
except
MessageDlg('=х єфрыюё№ юЄъЁvЄ№ шчюсЁрцхэшх фхЄрыш '+Hint_string+#13#10+
'Lрщы \IMAGES\'+icon_name+'.bmp',mtError,[mbOK],0);
tool_button.Free;
Continue;
end;
ImageList1.Add(pic,mask);
ImageIndex:=idx;
inc(idx);
Parent:=ToolBar1;
delete(icon_name,1,1);
Caption:=program_dir+'\images\'+icon_name+'.bmp';
hint:=hint_string;
showhint:=true;
grouped:=false;
AllowAllUp:=false;
style:=tbsCheck;
Wrap:=False;
Height:=21;
Width:=21;
onClick:=ToolButtonClick;
end;
pic.Free;
end;
CloseFile(icons);
mask.free;
ToolBar1.Images:=ImageList1;
OpenFile := TStringList.Create;
SaveFile := TStringList.Create;
SelectedItems := TItemList.Create;
SelectedLinks := TLinkList.Create;
end;
procedure TForm1.AcadDocument1BeginCommand(Sender: TObject;
var CommandName: OleVariant);
begin
CommandEnded := False;
FormCommand.Show;
Form1.Enabled := False;
end;
procedure TForm1.AcadDocument1EndCommand(Sender: TObject;
var CommandName: OleVariant);
begin
CommandEnded := True;
FormCommand.Hide;
Form1.Enabled := True;
Inc(CommandsCount);
end;
procedure TForm1.ToolButton4Click(Sender: TObject);
begin
if ToolBar2.Buttons[4].Down then
begin
first_click := False;
click_arr[1] := 0;
click_arr[2] := 0;
end;
end;
function TLinkList.Add(Item: TLink): Integer;
begin
Result := inherited Add(Item);
end;
procedure TLinkList.Clear;
var
i: Integer;
begin
for i := 0 to Count - 1 do
begin
try
Items[i].Selected := False;
Items[i].Refresh;
except
end;
end;
inherited Clear;
end;
function TLinkList.GetItem(Index: Integer): TLink;
begin
Result := TLink(inherited Items[Index]);
end;
procedure TLinkList.SetItem(Index: Integer; Value: TLink);
begin
inherited Items[Index] := Value;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
OpenFile.Free;
SaveFile.Free;
end;
procedure TForm1.STDPanel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i: Integer;
begin
if SelectItems then
begin
SelectItems := False;
STDPanel1.Refresh;
for i := 1 to item_index - 1 do
if not Item[i].Selected then
begin
Item[i].Selected := False;
with Item[i] do
if (Left > mx) and (Left+Width < OldSelect.x) and (Top > my) and (Top+Height < OldSelect.y) then
begin
SelectedItems.Add(Item[i]);
Item[i].Selected := True;
end;
end;
for i := 1 to link_index - 1 do
if not Links[i].Selected then
begin
Links[i].Selected := False;
with Links[i] do
if (Left > mx) and (Left+Width < OldSelect.x) and (Top > my) and (Top+Height < OldSelect.y) then
begin
SelectedLinks.Add(Links[i]);
Links[i].Selected := True;
end;
end;
end;
end;
procedure TForm1.STDPanel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if SelectItems then
begin
STDPanel1.DrawRect(mx,my,OldSelect.x,OldSelect.y, clBlack);
STDPanel1.DrawRect(mx,my,x,y, clBlack);
OldSelect.x := x;
OldSelect.y := y;
end;
if Drag then
begin
// STDPanel1.DrawRect(mx, my, mx+STDPanel2.Width, my + STDPanel2.Height,STDPanel1.Color);
// STDPanel1.DrawRect(x, y, x+STDPanel2.Width, y + STDPanel2.Height,clBlack);
mx := x;
my := y;
end;
end;
function TItemList.Add(Item: TProcess): Integer;
begin
Result := inherited Add(Item);
end;
procedure TItemList.Clear;
var
i: Integer;
begin
for i := 0 to Count - 1 do
begin
try
Items[i].Selected := False;
Items[i].Refresh;
except
end;
end;
inherited Clear;
end;
function TItemList.GetItem(Index: Integer): TProcess;
begin
Result := TProcess(inherited Items[Index]);
end;
procedure TItemList.SetItem(Index: Integer; Value: TProcess);
begin
inherited Items[Index] := Value;
end;
procedure TForm1.STDPanel2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (x in [0..10]) and (y in [0..10]) then
Drag := True;
end;
procedure TForm1.STDPanel2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drag := False;
end;
procedure TForm1.STDPanel2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Drag then
begin
// STDPanel2.Left := x + STDPanel2.Left;
// STDPanel2.Top := y + STDPanel2.Top;
end
end;
procedure TForm1.ToolButton20Click(Sender: TObject);
var
i: Integer;
// CopyOfItem: TProcess;
// CopyLink: TLink;
CopiedItems: TItemList;
function DoCopyItem(CopyItem: TProcess): TProcess;
begin
item[item_index]:=TProcess.Create(STDPanel1);
item[item_index].Parent:=STDPanel1;
item[item_index].Id:= CopyItem.Id;
item[item_index].Left:= CopyItem.Left + 10;
item[item_index].Top := CopyItem.Top + 10;
item[item_index].Height := CopyItem.Height;
item[item_index].Width := CopyItem.Width;
item[item_index].Hint := CopyItem.Hint;
item[item_index].PicPath:= CopyItem.PicPath;
item[item_index].FileName:=TStringList.Create;
item[item_index].FileName.AddStrings(CopyItem.FileName);
item[item_index].FileName.Strings[0]:='¦рёёр '+inttostr(index_item);
item[item_index].ShowHint:=True;
item[item_index].OnDblClick:=ItemDblClick;
item[item_index].OnMouseDown:=ItemMouseDown;
item[item_index].OnMouseUp:=ItemMouseUp;
item[item_index].OnMouseMove:=ItemMouseMove;
item[item_index].Mode:=pmNormal;
CopyItem.Selected := False;
Result := item[item_index];
Inc(item_index);
Inc(index_item);
end;
begin
CopiedItems := TItemList.Create;
//ъюяшЁютрэшх ¤ыхьхэЄют
i := 0;
while SelectedItems.Count > 0 do
begin
CopiedItems.Add(DoCopyItem(SelectedItems.Items[i]));
SelectedItems.Delete(0);
end;
for i := 0 to CopiedItems.Count - 1 do
begin
SelectedItems.Add(CopiedItems.Items[i]);
CopiedItems.Items[i].Selected := True;
end;
SelectedLinks.Clear;
CopiedItems.Free;
for i := 0 to SelectedItems.Count - 1 do
SelectedItems.Items[i].Selected := True;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_DELETE then
ToolButton5.Click;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
Res: TModalResult;
begin
if Item_index > 1 then
begin
Res := MessageDlg('TюїЁрэшЄ№ Єхъє•шщ яЁюхъЄ?',mtConfirmation,[mbYes,mbNo,mbCancel],0);
if Res = mrYes then
tbSave.Click
else
if Res = mrCancel then
CanClose := False;
end;
end;
procedure TForm1.ToolButton21Click(Sender: TObject);
begin
if ShellExecute(Handle,'open',PChar(Program_dir+'\Help\TшёЄхьр +Єрья.htm'), '', '', 0) = 0 then
raise Exception.Create('');
end;
procedure TForm1.tbSaveClick(Sender: TObject);
var i,j,k,k1,l:integer;
f:TIniFile;
s:string;
begin
SaveDialog1.Execute;
form1.Caption:=SaveDialog1.FileName;
if SaveDialog1.FileName<>'' then
begin
f:= TIniFile.Create(SaveDialog1.FileName);
for i:=0 to 1000 do
f.EraseSection(inttostr(i));
f.WriteString('Model','Class','MDF');
f.WriteFloat('Model','T',t);
f.WriteFloat('Model','Ht',ht);
f.WriteFloat('Model','E',e);
f.WriteInteger('Model','Method',Method);
f.WriteString('Model','Description',desc);
for i:=1 to Item_index-1 do
begin
//f.WriteString(inttostr(i-1),'Type','Massa');
if item[i].FileName.Strings[1]='TюёЁхфюЄюўхээр _ьрёёр' then
f.WriteString(inttostr(i-1),'Class','TPointMassa')
else
f.WriteString(inttostr(i-1),'Class','TSupport');
f.WriteString(inttostr(i-1),'Name','¦рёёр '+inttostr(i));
f.WriteString(inttostr(i-1),'X0',item[i].FileName.Strings[2]);
f.WriteString(inttostr(i-1),'Y0',item[i].FileName.Strings[3]);
f.WriteString(inttostr(i-1),'W',item[i].FileName.Strings[4]);
f.WriteString(inttostr(i-1),'H',item[i].FileName.Strings[5]);
f.WriteString(inttostr(i-1),'Description',item[i].FileName.Strings[6]);
if item[i].FileName.Strings[1]='TюёЁхфюЄюўхээр _ьрёёр' then
begin
f.WriteString(inttostr(i-1),'M',item[i].FileName.Strings[7]);
f.WriteString(inttostr(i-1),'V0',item[i].FileName.Strings[8]);
if item[i].FileName.Strings[9]='TRUE' then
f.Writebool(inttostr(i-1),'GraphFlag',true)
else f.Writebool(inttostr(i-1),'GraphFlag',false);
end
else if item[i].FileName.Strings[7]='TRUE' then
f.Writebool(inttostr(i-1),'GraphFlag',true)
else f.Writebool(inttostr(i-1),'GraphFlag',false);
end;
k:=Item_index-1;k1:=0;
for i:=1 to link_index-1 do
for j:=0 to links[i].CountRelation-1 do
begin inc(k1);
f.WriteString(inttostr(k),'Type','Relation');
f.WriteString(inttostr(k),'Class',links[i].relations[j].classname);
f.WriteString(inttostr(k),'Name','Tт ч№ '+inttostr(k1));
for l:=1 to Item_index-1 do
if links[i].First=Item[l] then
f.WriteInteger(inttostr(k),'M1',l);
for l:=1 to Item_index-1 do
if links[i].Second=Item[l] then
f.WriteInteger(inttostr(k),'M2',l);
l:=0;
repeat
if links[i].relations[j].Param.strings[l]<>'GraphFlag' then
f.WriteString(inttostr(k),links[i].relations[j].Param.strings[l],links[i].relations[j].Param.strings[l+1])
else
if links[i].relations[j].Param.strings[l+1]='TRUE' then
f.WriteBool(inttostr(k),links[i].relations[j].Param.strings[l],true)
else f.WriteBool(inttostr(k),links[i].relations[j].Param.strings[l],false);
l:=l+2;
until links[i].relations[j].Param.Count=l;
k:=k+1;
end;
end;
end;
procedure TForm1.ToolButton5Click(Sender: TObject);
var
i, k, j: Integer;
idx, l1, l2: Integer;
Sel_Item: Tprocess;
Sel_Link: Tlink;
b16_check,b2_check: boolean;
begin
for i:=0 to ToolBar1.ButtonCount-1 do ToolBar1.Buttons[i].Down:=False;
if (Sender as TToolButton).Down then
begin
idx:=(Sender as TToolButton).Index;
for i:=0 to ToolBar2.ButtonCount-1 do
if i<>idx then ToolBar2.Buttons[i].Down:=False;
end;
if ((Sender as TToolButton).Hint = 'Lфрыхэшх') and
(SelectedItems.Count + SelectedLinks.Count > 0) then
if MessageDlg('LфрышЄ№ '+ IntToStr(SelectedItems.Count) + ' ¤ыхьхэЄ(ют) ш ' +
IntToStr(SelectedLinks.Count) + ' ёт чхщ?', mtWarning, [mbYes, mbNo], 0) = mrYes then
begin
for k := 0 to SelectedItems.Count - 1 do
begin
Sel_Item := SelectedItems.Items[k];
l1:=1;
while l1<link_index do
begin
if (links[l1].First=Sel_Item) or
(links[l1].Second=Sel_Item) then
begin
links[l1].Free;
links[l1] := nil;
for l2:=l1 to link_index-2 do
begin
links[l2]:=links[l2+1];
// links[l2].Caption:=inttostr(l2);
end;
links[link_index-1] := nil;
dec(link_index);
dec(l1);
end;
inc(l1);
if l1<=0 then break;
end;
i := 1;
while (i < item_index) and (Sel_Item <> Item[i]) do
Inc(i);
FreeAndNil(item[i]);
destroy_flag:=True;
for j:=i to item_index-2 do item[j]:=item[j+1];
item_index:=item_index-1;
end;
for k := 0 to SelectedLinks.Count - 1 do
begin
Sel_Link := SelectedLinks.Items[k];
i := 1;
while (i < Link_index) and (links[i]<>Sel_Link) do
Inc(i);
if i = Link_Index then Continue;
try
links[i].Free;
except
end;
links[i] := nil;
for j:=i to link_index-2 do
begin
links[j]:=links[j+1];
end;
links[link_index-1] := nil;
link_index:=link_index-1;
end;
current_item := 1;
SelectedItems.Clear;
SelectedLinks.Clear;
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var form:TInputDlg;
begin
form:=TInputDlg.Create(form1);
form.ShowModal;
t:=StrToFloat(form.Edit1.Text);
ht:=StrToFloat(form.Edit2.Text);
e:=StrToFloat(form.Edit3.Text);
method:=form.RadioGroup1.ItemIndex;
desc:=form.Edit4.Text;
form.Destroy;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//ShellExecute();
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ImgList, ComCtrls, ToolWin, ExtCtrls, STDPanel, StdCtrls, Process, Link,
Menus, comobj,activeX,
OleServer, FileCtrl, ShellAPI, Variants, IniFiles, Buttons;
type
TLinkList = class(TList)
private
function GetItem(Index: Integer): TLink;
procedure SetItem(Index: Integer; Value: TLink);
public
property Items[Index: Integer]: TLink read GetItem write SetItem;
function Add(Item: TLink): Integer;
procedure Clear; override;