Главный модуль графического редактора
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; end; TItemList = class(TList) private function GetItem(Index: Integer): TProcess; procedure SetItem(Index: Integer; Value: TProcess); public property Items[Index: Integer]: TProcess read GetItem write SetItem; function Add(Item: TProcess): Integer; procedure Clear; override; end; TForm1 = class(TForm) ImageList1: TImageList; ToolBar2: TToolBar; ImageList2: TImageList; tbOpen: TToolButton; tbSave: TToolButton; ToolButton3: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; ToolButton6: TToolButton; OpenDialog1: TOpenDialog; ToolButton7: TToolButton; ToolButton8: TToolButton; PopupMenu1: TPopupMenu; N1: TMenuItem; ToolButton13: TToolButton; CoolBar1: TCoolBar; ToolButton20: TToolButton; N2: TMenuItem; ToolButton21: TToolButton; ToolButton22: TToolButton; ScrollBox1: TScrollBox; STDPanel1: TSTDPanel; ToolBar1: TToolBar; ImageList3: TImageList; BitBtn1: TBitBtn; SaveDialog1: TSaveDialog; Button1: TButton; procedure STDPanel1Click(Sender: TObject); procedure ToolButtonClick(Sender: TObject); procedure STDPanel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ItemDblClick(Sender: TObject); procedure LinkDblClick(Sender: TObject); procedure ItemMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure LinkMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ToolButton6Click(Sender: TObject); procedure ToolButton7Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure AcadDocument1BeginCommand(Sender: TObject; var CommandName: OleVariant); procedure AcadDocument1EndCommand(Sender: TObject; var CommandName: OleVariant); procedure ToolButton4Click(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure STDPanel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure STDPanel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure STDPanel2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure STDPanel2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure STDPanel2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ToolButton20Click(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure ToolButton21Click(Sender: TObject); procedure tbSaveClick(Sender: TObject); procedure ToolButton5Click(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } Successful: Boolean; CommandEnded: Boolean; CommandsCount: Integer; public { Public declarations } Item:array [1..10000] of TProcess; links:array [1..10000] of TLink; SaveFile: TStringList; OpenFile: TStringList; SelectItems: Boolean; Drag: Boolean; OldSelect: TPoint; SelectedItems: TItemList; SelectedLinks: TLinkList; // procedure DefineLinkInACAD(Link: TLink; NewParams: TStrings; IdentLinks: TLinkList); // procedure SelectParams(Item: TProcess); // function GetInput(Bits: Integer; KeyWordList, Prompt: OLEVariant): WideString; // procedure CreateProfile(Item: TProcess); //тючтЁр•рхЄ False хёыш яюы№чютрЄхы№ юЄьхэшы end; type item_type=record left,top,width,height:integer; hint:string[80]; pic_path:string[80]; kol: Word; par:array [1..100] of string[80]; end; link_type=record first,second: Word; caption:string[80]; kol: Word; par:array [1..100] of string[80]; end; det=record kol_tool: Word; end; const FlipInds: array[1..2] of Char = ('a','b'); var Form1: TForm1; program_dir:string; index: Word; Item_index,index_item: Word; click_arr:array [1..2] of Word; mx,my:integer; link_index,index_link: Word; first_click,second_click:boolean; dx,dy: Word; destroy_flag:boolean; rr:TRect; p_rr:PRect; detal1,detal2:word; current_item:word; current_Link: Word; flip_flag:Boolean; labs:array of TLabel; kol:byte; t,ht,e:real; method:integer; desc:string; implementation uses WaitCommand, LinkEdit, Variables, Progress,Unit2, Unit3, relation,model_param_dlg; {$R *.DFM} procedure TForm1.LinkDblClick(Sender: TObject); var st:TStringList; t:Tlink; s:string; begin st:=(sender as Tlink).Param; t:=sender as Tlink; linksfm.showEdit(t); end; procedure TForm1.ItemDblClick(Sender: TObject); begin if (Sender as TProcess).Hint='=хяюфтшцэр _юяюЁр' then begin massafm.Edit6.Visible:=false; massafm.Edit7.Visible:=false; massafm.label8.Visible:=false; massafm.label9.Visible:=false; massafm.Edit1.Text:=(Sender as TProcess).FileName.Strings[2]; massafm.Edit2.Text:=(Sender as TProcess).FileName.Strings[3]; massafm.Edit3.Text:=(Sender as TProcess).FileName.Strings[4]; massafm.Edit4.Text:=(Sender as TProcess).FileName.Strings[5]; massafm.Edit5.Text:=(Sender as TProcess).FileName.Strings[6]; if (Sender as TProcess).FileName.Strings[7]='TRUE' then massafm.CheckBox1.Checked:=true else massafm.CheckBox1.Checked:=false; massafm.Caption:=(Sender as TProcess).FileName.Strings[0]; massafm.ShowModal; (Sender as TProcess).FileName.Clear; (Sender as TProcess).FileName.Add(massafm.Caption); (Sender as TProcess).FileName.Add('notmov'); (Sender as TProcess).FileName.Add(massafm.Edit1.Text); (Sender as TProcess).FileName.Add(massafm.Edit2.Text); (Sender as TProcess).FileName.Add(massafm.Edit3.Text); (Sender as TProcess).FileName.Add(massafm.Edit4.Text); (Sender as TProcess).FileName.Add(massafm.Edit5.Text); if massafm.CheckBox1.Checked=true then (Sender as TProcess).FileName.Add('TRUE') else (Sender as TProcess).FileName.Add('FALSE'); end; if (Sender as TProcess).Hint='TюёЁхфюЄюўхээр _ьрёёр' then begin massafm.Edit6.Visible:=true; massafm.Edit7.Visible:=true; massafm.label8.Visible:=true; massafm.label9.Visible:=true; massafm.Edit1.Text:=(Sender as TProcess).FileName.Strings[2]; massafm.Edit2.Text:=(Sender as TProcess).FileName.Strings[3]; massafm.Edit3.Text:=(Sender as TProcess).FileName.Strings[4]; massafm.Edit4.Text:=(Sender as TProcess).FileName.Strings[5]; massafm.Edit5.Text:=(Sender as TProcess).FileName.Strings[6]; massafm.Edit6.Text:=(Sender as TProcess).FileName.Strings[7]; massafm.Edit7.Text:=(Sender as TProcess).FileName.Strings[8]; if (Sender as TProcess).FileName.Strings[9]='TRUE' then massafm.CheckBox1.Checked:=true else massafm.CheckBox1.Checked:=false; massafm.Caption:=(Sender as TProcess).FileName.Strings[0]; massafm.ShowModal; (Sender as TProcess).FileName.Clear; (Sender as TProcess).FileName.Add(massafm.Caption); (Sender as TProcess).FileName.Add('notmov'); (Sender as TProcess).FileName.Add(massafm.Edit1.Text); (Sender as TProcess).FileName.Add(massafm.Edit2.Text); (Sender as TProcess).FileName.Add(massafm.Edit3.Text); (Sender as TProcess).FileName.Add(massafm.Edit4.Text); (Sender as TProcess).FileName.Add(massafm.Edit5.Text); (Sender as TProcess).FileName.Add(massafm.Edit6.Text); (Sender as TProcess).FileName.Add(massafm.Edit7.Text); if massafm.CheckBox1.Checked=true then (Sender as TProcess).FileName.Add('TRUE') else (Sender as TProcess).FileName.Add('FALSE'); end; Abort; end; procedure TForm1.LinkMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i,j, k: Integer; begin j := 0; while (j < SelectedLinks.Count) and (Sender as TLink <> SelectedLinks.Items[j]) do Inc(j); if j = SelectedLinks.Count then begin if not (ssShift in Shift) then SelectedLinks.Clear; SelectedLinks.Add(Sender as TLink); (Sender as TLink).Selected := True; end else begin SelectedLinks.Delete(j); (Sender as TLink).Selected := False; end; if ToolBar2.Buttons[5].Down then begin for k := 0 to SelectedLinks.Count - 1 do begin i := 1; while (i < link_index) and (links[i]<>SelectedLinks.Items[k]) do Inc(i); if i = link_index then Exit; links[i].Free; for j:=i to link_index-2 do begin links[j]:=links[j+1]; end; link_index:=link_index-1; end; ToolBar2.Buttons[5].Down:=False; SelectedLinks.Free; SelectedLinks := TLinkList.Create; end; end; procedure TForm1.ItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var i: Integer; j: Integer; begin if ssLeft in Shift then begin rr.Left:=STDPanel1.Left+Form1.Left+7; rr.Top:=STDPanel1.Top+Form1.Top+25; rr.Right:=STDPanel1.Left+STDPanel1.Width+Form1.Left; rr.Bottom:=STDPanel1.Top+STDPanel1.Height+Form1.Top+20; p_rr:=@rr; ClipCursor(p_rr); for j := 0 to SelectedItems.Count - 1 do begin if (SelectedItems.Items[j].Left+x-dx>0) and (SelectedItems.Items[j].Left+x-dx+SelectedItems.Items[j].Width<STDPanel1.Width-5) then begin SelectedItems.Items[j].Left:=SelectedItems.Items[j].Left+x-dx; end; if (SelectedItems.Items[j].Top+y-dy>0) and (SelectedItems.Items[j].Top+y-dy+SelectedItems.Items[j].Height<STDPanel1.Height-5) then begin SelectedItems.Items[j].Top:=SelectedItems.Items[j].Top+y-dy; end; end; for i:=1 to link_index-1 do for j := 0 to SelectedItems.Count - 1 do begin if links[i].First= SelectedItems.Items[j] then Links[i].First:=SelectedItems.Items[j]; if links[i].Second=SelectedItems.Items[j] then Links[i].Second:=SelectedItems.Items[j]; end; end; end; procedure TForm1.ItemMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); label Again; var i, j, k: Integer; l1,l2:integer; Sel_Item: Tprocess; Sel_Link: Tlink; IdentLinks: TLinkList; str:TStringList; begin rr.Left:=Screen.DesktopLeft; rr.Top:=Screen.DesktopTop; rr.Right:=Screen.DesktopLeft+Screen.DesktopWidth; rr.Bottom:=Screen.DesktopTop+Screen.DesktopHeight; p_rr:=@rr; ClipCursor(p_rr); //яЁютхЁър эр єфрыхэшх for k := 0 to SelectedItems.Count - 1 do SelectedItems.Items[k].Mode := pmNormal; //яЁютхЁър эр єёЄрэютъє ёт чш Sel_Item := Sender as TProcess; if ToolBar2.Buttons[4].Down then begin for i:=1 to item_index-1 do if Sel_Item = item[i] then Break; if (not first_click) then begin click_arr[1]:=i; first_click:=True; exit; end; if i<>click_arr[1] then click_arr[2]:=i; for i:=1 to 2 do if click_arr[i]=0 then exit; ToolBar2.Buttons[4].Down:=False; links[link_index]:=TLink.Create(STDPanel1); first_click:=False; links[link_index].Parent:=STDPanel1; links[link_index].Caption:=''; links[link_index].First:=item[click_arr[1]]; links[link_index].Second:=item[click_arr[2]]; links[link_index].Param:=TStringList.Create; links[link_index].OnMouseDown:=LinkMouseDown; links[link_index].OnDblClick:=LinkDblClick; links[link_index].NameBoxSize:=0; links[link_index].Param.Add('Tт ч№ '+inttostr(index_link)); str:=links[link_index].Param; linksfm.showEdit(links[link_index]); links[link_index].Param:=str; click_arr[1]:=0; click_arr[2]:=0; { if (AnsiUpperCase(links[link_index].First.Hint) = '¦¦+LLT-') or (AnsiUpperCase(links[link_index].Second.Hint) = '¦¦+LLT-') then // begin links[link_index].Kind := lkJoin; { IdentLinks := TLinkList.Create; try DefineLinkInACAD(links[link_index], links[link_index].Param, IdentLinks); except links[link_index].Free; Exit; end; end else} inc(link_index); inc(index_link); end; end; procedure TForm1.ItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: Integer; j: Integer; begin if ssLeft in Shift then begin j := 0; while (j < SelectedItems.Count) and (Sender as TProcess <> SelectedItems.Items[j]) do Inc(j); if j = SelectedItems.Count then begin if not (ssShift in Shift) then SelectedItems.Clear; SelectedItems.Add(Sender as TProcess); (Sender as TProcess).Selected := True; end else begin if (ssShift in Shift) then begin SelectedItems.Delete(j); (Sender as TProcess).Selected := False; end; end; for j := 0 to SelectedItems.Count - 1 do SelectedItems.Items[j].Mode:=pmMove; dx:=x; dy:=y; end; if ssRight in Shift then begin if (Sender as TProcess).FileName.Count>0 then PopupMenu1.Items.Items[0].Enabled:=True else PopupMenu1.Items.Items[0].Enabled:=False; if (Sender as TProcess).FileName.IndexOf('TOOL')>=0 then PopupMenu1.Items.Items[1].Enabled:=True else PopupMenu1.Items.Items[1].Enabled:=False; PopupMenu1.Items.Items[1].Checked := (Sender as TProcess).OnlyTool; for i:=1 to item_index-1 do if (Sender as TProcess)=item[i] then begin current_item:=i; break; end; PopupMenu1.Popup((Sender as TProcess).left+STDPanel1.Left+x+Form1.Left+ScrollBox1.Left,(Sender as TProcess).top+STDPanel1.Top+y+Form1.Top+ScrollBox1.Top+40); end; end; procedure TForm1.STDPanel1Click(Sender: TObject); label Ex; var i: Integer; pic:TBitmap; Res: TModalResult; begin pic:=TBitmap.Create; for i:=0 to ToolBar1.ButtonCount-1 do begin if ToolBar1.Buttons[i].Down then begin ToolBar1.Buttons[i].Down:=False; Item[Item_index]:=TProcess.Create(STDPanel1); pic.LoadFromFile(ToolBar1.Buttons[i].Caption); Item[item_index].PicPath:=ToolBar1.Buttons[i].Caption; Item[item_index].Width:=pic.Width+3; Item[item_index].Height:=pic.Height+3; Item[item_index].Mode:=pmNormal; Item[item_index].left:=mx; Item[item_index].top:=my; Item[item_index].FileName:=TStringList.Create; first_click:=False; Item[item_index].Parent:=STDPanel1; Item[item_index].Hint:=ToolBar1.Buttons[i].Hint; Item[item_index].ShowHint:=True; Item[item_index].Picture.LoadFromFile(ToolBar1.Buttons[i].Caption); Item[item_index].OnMouseDown:=ItemMouseDown; Item[item_index].OnMouseUp:=ItemMouseUp; Item[item_index].OnMouseMove:=ItemMouseMove; Item[item_index].OnDblClick:=ItemDblClick; if Item[item_index].Hint='=хяюфтшцэр _юяюЁр' then begin massafm.Edit6.Visible:=false; massafm.Edit7.Visible:=false; massafm.label8.Visible:=false; massafm.label9.Visible:=false; massafm.Edit5.Text:='=хяюфтшцэр _юяюЁр'; massafm.Caption:='¦рёёр '+inttostr(index_item); massafm.ShowModal; Item[item_index].FileName.Add('¦рёёр '+inttostr(index_item)); Item[item_index].FileName.Add('=хяюфтшцэр _юяюЁр'); Item[item_index].FileName.Add(massafm.Edit1.Text); Item[item_index].FileName.Add(massafm.Edit2.Text); Item[item_index].FileName.Add(massafm.Edit3.Text); Item[item_index].FileName.Add(massafm.Edit4.Text); Item[item_index].FileName.Add(massafm.Edit5.Text); if massafm.CheckBox1.Checked=true then Item[item_index].FileName.Add('TRUE') else Item[item_index].FileName.Add('FALSE'); end; if Item[item_index].Hint='TюёЁхфюЄюўхээр _ьрёёр' then begin massafm.Edit6.Visible:=true; massafm.Edit7.Visible:=true; massafm.label8.Visible:=true; massafm.label9.Visible:=true; massafm.Edit5.Text:='TюёЁхфюЄюўхээр _ьрёёр'; massafm.Caption:='¦рёёр '+inttostr(index_item); massafm.ShowModal; Item[item_index].FileName.Add('¦рёёр '+inttostr(index_item)); Item[item_index].FileName.Add('TюёЁхфюЄюўхээр _ьрёёр'); Item[item_index].FileName.Add(massafm.Edit1.Text); Item[item_index].FileName.Add(massafm.Edit2.Text); Item[item_index].FileName.Add(massafm.Edit3.Text); Item[item_index].FileName.Add(massafm.Edit4.Text); Item[item_index].FileName.Add(massafm.Edit5.Text); Item[item_index].FileName.Add(massafm.Edit6.Text); Item[item_index].FileName.Add(massafm.Edit7.Text); if massafm.CheckBox1.Checked=true then Item[item_index].FileName.Add('TRUE') else Item[item_index].FileName.Add('FALSE'); end; { if AnsiUpperCase(Item[item_index].Hint) = '¦¦+LLT-' then try CreateProfile(Item[item_index]); except on E: Exception do MessageDlg(E.Message, mtError,[mbOK],0); end else SelectParams(Item[item_index]); if Item[item_index].FileName.Text = '' then begin Item[item_index].Free; Pic.Free; Exit; end;} inc(item_index); inc(index_item); break; end; end; Pic.Free; end; procedure TForm1.ToolButtonClick(Sender: TObject); var i: Word; begin for i:=0 to ToolBar2.ButtonCount-1 do ToolBar2.Buttons[i].Down:=False; if (Sender as TToolButton).Down then begin index:=(Sender as TToolButton).Index; for i:=0 to ToolBar1.ButtonCount-1 do 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; end; TItemList = class(TList) private function GetItem(Index: Integer): TProcess; procedure SetItem(Index: Integer; Value: TProcess); public property Items[Index: Integer]: TProcess read GetItem write SetItem; function Add(Item: TProcess): Integer; procedure Clear; override; end; TForm1 = class(TForm) ImageList1: TImageList; ToolBar2: TToolBar; ImageList2: TImageList; tbOpen: TToolButton; tbSave: TToolButton; ToolButton3: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; ToolButton6: TToolButton; OpenDialog1: TOpenDialog; ToolButton7: TToolButton; ToolButton8: TToolButton; PopupMenu1: TPopupMenu; N1: TMenuItem; ToolButton13: TToolButton; CoolBar1: TCoolBar; ToolButton20: TToolButton; N2: TMenuItem; ToolButton21: TToolButton; ToolButton22: TToolButton; ScrollBox1: TScrollBox; STDPanel1: TSTDPanel; ToolBar1: TToolBar; ImageList3: TImageList; BitBtn1: TBitBtn; SaveDialog1: TSaveDialog; Button1: TButton; procedure STDPanel1Click(Sender: TObject); procedure ToolButtonClick(Sender: TObject); procedure STDPanel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ItemDblClick(Sender: TObject); procedure LinkDblClick(Sender: TObject); procedure ItemMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure LinkMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ToolButton6Click(Sender: TObject); procedure ToolButton7Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure AcadDocument1BeginCommand(Sender: TObject; var CommandName: OleVariant); procedure AcadDocument1EndCommand(Sender: TObject; var CommandName: OleVariant); procedure ToolButton4Click(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure STDPanel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure STDPanel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure STDPanel2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure STDPanel2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure STDPanel2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ToolButton20Click(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure ToolButton21Click(Sender: TObject); procedure tbSaveClick(Sender: TObject); procedure ToolButton5Click(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } Successful: Boolean; CommandEnded: Boolean; CommandsCount: Integer; public { Public declarations } Item:array [1..10000] of TProcess; links:array [1..10000] of TLink; SaveFile: TStringList; OpenFile: TStringList; SelectItems: Boolean; Drag: Boolean; OldSelect: TPoint; SelectedItems: TItemList; SelectedLinks: TLinkList; // procedure DefineLinkInACAD(Link: TLink; NewParams: TStrings; IdentLinks: TLinkList); // procedure SelectParams(Item: TProcess); // function GetInput(Bits: Integer; KeyWordList, Prompt: OLEVariant): WideString; // procedure CreateProfile(Item: TProcess); //тючтЁр•рхЄ False хёыш яюы№чютрЄхы№ юЄьхэшы end; type item_type=record left,top,width,height:integer; hint:string[80]; pic_path:string[80]; kol: Word; par:array [1..100] of string[80]; end; link_type=record first,second: Word; caption:string[80]; kol: Word; par:array [1..100] of string[80]; end; det=record kol_tool: Word; end; const FlipInds: array[1..2] of Char = ('a','b'); var Form1: TForm1; program_dir:string; index: Word; Item_index,index_item: Word; click_arr:array [1..2] of Word; mx,my:integer; link_index,index_link: Word; first_click,second_click:boolean; dx,dy: Word; destroy_flag:boolean; rr:TRect; p_rr:PRect; detal1,detal2:word; current_item:word; current_Link: Word; flip_flag:Boolean; labs:array of TLabel; kol:byte; t,ht,e:real; method:integer; desc:string; implementation uses WaitCommand, LinkEdit, Variables, Progress,Unit2, Unit3, relation,model_param_dlg; {$R *.DFM} procedure TForm1.LinkDblClick(Sender: TObject); var st:TStringList; t:Tlink; s:string; begin st:=(sender as Tlink).Param; t:=sender as Tlink; linksfm.showEdit(t); end; procedure TForm1.ItemDblClick(Sender: TObject); begin if (Sender as TProcess).Hint='=хяюфтшцэр _юяюЁр' then begin massafm.Edit6.Visible:=false; massafm.Edit7.Visible:=false; massafm.label8.Visible:=false; massafm.label9.Visible:=false; massafm.Edit1.Text:=(Sender as TProcess).FileName.Strings[2]; massafm.Edit2.Text:=(Sender as TProcess).FileName.Strings[3]; massafm.Edit3.Text:=(Sender as TProcess).FileName.Strings[4]; massafm.Edit4.Text:=(Sender as TProcess).FileName.Strings[5]; massafm.Edit5.Text:=(Sender as TProcess).FileName.Strings[6]; if (Sender as TProcess).FileName.Strings[7]='TRUE' then massafm.CheckBox1.Checked:=true else massafm.CheckBox1.Checked:=false; massafm.Caption:=(Sender as TProcess).FileName.Strings[0]; massafm.ShowModal; (Sender as TProcess).FileName.Clear; (Sender as TProcess).FileName.Add(massafm.Caption); (Sender as TProcess).FileName.Add('notmov'); (Sender as TProcess).FileName.Add(massafm.Edit1.Text); (Sender as TProcess).FileName.Add(massafm.Edit2.Text); (Sender as TProcess).FileName.Add(massafm.Edit3.Text); (Sender as TProcess).FileName.Add(massafm.Edit4.Text); (Sender as TProcess).FileName.Add(massafm.Edit5.Text); if massafm.CheckBox1.Checked=true then (Sender as TProcess).FileName.Add('TRUE') else (Sender as TProcess).FileName.Add('FALSE'); end; if (Sender as TProcess).Hint='TюёЁхфюЄюўхээр _ьрёёр' then begin massafm.Edit6.Visible:=true; massafm.Edit7.Visible:=true; massafm.label8.Visible:=true; massafm.label9.Visible:=true; massafm.Edit1.Text:=(Sender as TProcess).FileName.Strings[2]; massafm.Edit2.Text:=(Sender as TProcess).FileName.Strings[3]; massafm.Edit3.Text:=(Sender as TProcess).FileName.Strings[4]; massafm.Edit4.Text:=(Sender as TProcess).FileName.Strings[5]; massafm.Edit5.Text:=(Sender as TProcess).FileName.Strings[6]; massafm.Edit6.Text:=(Sender as TProcess).FileName.Strings[7]; massafm.Edit7.Text:=(Sender as TProcess).FileName.Strings[8]; if (Sender as TProcess).FileName.Strings[9]='TRUE' then massafm.CheckBox1.Checked:=true else massafm.CheckBox1.Checked:=false; massafm.Caption:=(Sender as TProcess).FileName.Strings[0]; massafm.ShowModal; (Sender as TProcess).FileName.Clear; (Sender as TProcess).FileName.Add(massafm.Caption); (Sender as TProcess).FileName.Add('notmov'); (Sender as TProcess).FileName.Add(massafm.Edit1.Text); (Sender as TProcess).FileName.Add(massafm.Edit2.Text); (Sender as TProcess).FileName.Add(massafm.Edit3.Text); (Sender as TProcess).FileName.Add(massafm.Edit4.Text); (Sender as TProcess).FileName.Add(massafm.Edit5.Text); (Sender as TProcess).FileName.Add(massafm.Edit6.Text); (Sender as TProcess).FileName.Add(massafm.Edit7.Text); if massafm.CheckBox1.Checked=true then (Sender as TProcess).FileName.Add('TRUE') else (Sender as TProcess).FileName.Add('FALSE'); end; Abort; end; procedure TForm1.LinkMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i,j, k: Integer; begin j := 0; while (j < SelectedLinks.Count) and (Sender as TLink <> SelectedLinks.Items[j]) do Inc(j); if j = SelectedLinks.Count then begin if not (ssShift in Shift) then SelectedLinks.Clear; SelectedLinks.Add(Sender as TLink); (Sender as TLink).Selected := True; end else begin SelectedLinks.Delete(j); (Sender as TLink).Selected := False; end; if ToolBar2.Buttons[5].Down then begin for k := 0 to SelectedLinks.Count - 1 do begin i := 1; while (i < link_index) and (links[i]<>SelectedLinks.Items[k]) do Inc(i); if i = link_index then Exit; links[i].Free; for j:=i to link_index-2 do begin links[j]:=links[j+1]; end; link_index:=link_index-1; end; ToolBar2.Buttons[5].Down:=False; SelectedLinks.Free; SelectedLinks := TLinkList.Create; end; end; procedure TForm1.ItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var i: Integer; j: Integer; begin if ssLeft in Shift then begin rr.Left:=STDPanel1.Left+Form1.Left+7; rr.Top:=STDPanel1.Top+Form1.Top+25; rr.Right:=STDPanel1.Left+STDPanel1.Width+Form1.Left; rr.Bottom:=STDPanel1.Top+STDPanel1.Height+Form1.Top+20; p_rr:=@rr; ClipCursor(p_rr); for j := 0 to SelectedItems.Count - 1 do begin if (SelectedItems.Items[j].Left+x-dx>0) and (SelectedItems.Items[j].Left+x-dx+SelectedItems.Items[j].Width<STDPanel1.Width-5) then begin SelectedItems.Items[j].Left:=SelectedItems.Items[j].Left+x-dx; end; if (SelectedItems.Items[j].Top+y-dy>0) and (SelectedItems.Items[j].Top+y-dy+SelectedItems.Items[j].Height<STDPanel1.Height-5) then begin SelectedItems.Items[j].Top:=SelectedItems.Items[j].Top+y-dy; end; end; for i:=1 to link_index-1 do for j := 0 to SelectedItems.Count - 1 do begin if links[i].First= SelectedItems.Items[j] then Links[i].First:=SelectedItems.Items[j]; if links[i].Second=SelectedItems.Items[j] then Links[i].Second:=SelectedItems.Items[j]; end; end; end; procedure TForm1.ItemMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); label Again; var i, j, k: Integer; l1,l2:integer; Sel_Item: Tprocess; Sel_Link: Tlink; IdentLinks: TLinkList; str:TStringList; begin rr.Left:=Screen.DesktopLeft; rr.Top:=Screen.DesktopTop; rr.Right:=Screen.DesktopLeft+Screen.DesktopWidth; rr.Bottom:=Screen.DesktopTop+Screen.DesktopHeight; p_rr:=@rr; ClipCursor(p_rr); //яЁютхЁър эр єфрыхэшх for k := 0 to SelectedItems.Count - 1 do SelectedItems.Items[k].Mode := pmNormal; //яЁютхЁър эр єёЄрэютъє ёт чш Sel_Item := Sender as TProcess; if ToolBar2.Buttons[4].Down then begin for i:=1 to item_index-1 do if Sel_Item = item[i] then Break; if (not first_click) then begin click_arr[1]:=i; first_click:=True; exit; end; if i<>click_arr[1] then click_arr[2]:=i; for i:=1 to 2 do if click_arr[i]=0 then exit; ToolBar2.Buttons[4].Down:=False; links[link_index]:=TLink.Create(STDPanel1); first_click:=False; links[link_index].Parent:=STDPanel1; links[link_index].Caption:=''; links[link_index].First:=item[click_arr[1]]; links[link_index].Second:=item[click_arr[2]]; links[link_index].Param:=TStringList.Create; links[link_index].OnMouseDown:=LinkMouseDown; links[link_index].OnDblClick:=LinkDblClick; links[link_index].NameBoxSize:=0; links[link_index].Param.Add('Tт ч№ '+inttostr(index_link)); str:=links[link_index].Param; linksfm.showEdit(links[link_index]); links[link_index].Param:=str; click_arr[1]:=0; click_arr[2]:=0; { if (AnsiUpperCase(links[link_index].First.Hint) = '¦¦+LLT-') or (AnsiUpperCase(links[link_index].Second.Hint) = '¦¦+LLT-') then // begin links[link_index].Kind := lkJoin; { IdentLinks := TLinkList.Create; try DefineLinkInACAD(links[link_index], links[link_index].Param, IdentLinks); except links[link_index].Free; Exit; end; end else} inc(link_index); inc(index_link); end; end; procedure TForm1.ItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: Integer; j: Integer; begin if ssLeft in Shift then begin j := 0; while (j < SelectedItems.Count) and (Sender as TProcess <> SelectedItems.Items[j]) do Inc(j); if j = SelectedItems.Count then begin if not (ssShift in Shift) then SelectedItems.Clear; SelectedItems.Add(Sender as TProcess); (Sender as TProcess).Selected := True; end else begin if (ssShift in Shift) then begin SelectedItems.Delete(j); (Sender as TProcess).Selected := False; end; end; for j := 0 to SelectedItems.Count - 1 do SelectedItems.Items[j].Mode:=pmMove; dx:=x; dy:=y; end; if ssRight in Shift then begin if (Sender as TProcess).FileName.Count>0 then PopupMenu1.Items.Items[0].Enabled:=True else PopupMenu1.Items.Items[0].Enabled:=False; if (Sender as TProcess).FileName.IndexOf('TOOL')>=0 then PopupMenu1.Items.Items[1].Enabled:=True else PopupMenu1.Items.Items[1].Enabled:=False; PopupMenu1.Items.Items[1].Checked := (Sender as TProcess).OnlyTool; for i:=1 to item_index-1 do if (Sender as TProcess)=item[i] then begin current_item:=i; break; end; PopupMenu1.Popup((Sender as TProcess).left+STDPanel1.Left+x+Form1.Left+ScrollBox1.Left,(Sender as TProcess).top+STDPanel1.Top+y+Form1.Top+ScrollBox1.Top+40); end; end; procedure TForm1.STDPanel1Click(Sender: TObject); label Ex; var i: Integer; pic:TBitmap; Res: TModalResult; begin pic:=TBitmap.Create; for i:=0 to ToolBar1.ButtonCount-1 do begin if ToolBar1.Buttons[i].Down then begin ToolBar1.Buttons[i].Down:=False; Item[Item_index]:=TProcess.Create(STDPanel1); pic.LoadFromFile(ToolBar1.Buttons[i].Caption); Item[item_index].PicPath:=ToolBar1.Buttons[i].Caption; Item[item_index].Width:=pic.Width+3; Item[item_index].Height:=pic.Height+3; Item[item_index].Mode:=pmNormal; Item[item_index].left:=mx; Item[item_index].top:=my; Item[item_index].FileName:=TStringList.Create; first_click:=False; Item[item_index].Parent:=STDPanel1; Item[item_index].Hint:=ToolBar1.Buttons[i].Hint; Item[item_index].ShowHint:=True; Item[item_index].Picture.LoadFromFile(ToolBar1.Buttons[i].Caption); Item[item_index].OnMouseDown:=ItemMouseDown; Item[item_index].OnMouseUp:=ItemMouseUp; Item[item_index].OnMouseMove:=ItemMouseMove; Item[item_index].OnDblClick:=ItemDblClick; if Item[item_index].Hint='=хяюфтшцэр _юяюЁр' then begin massafm.Edit6.Visible:=false; massafm.Edit7.Visible:=false; massafm.label8.Visible:=false; massafm.label9.Visible:=false; massafm.Edit5.Text:='=хяюфтшцэр _юяюЁр'; massafm.Caption:='¦рёёр '+inttostr(index_item); massafm.ShowModal; Item[item_index].FileName.Add('¦рёёр '+inttostr(index_item)); Item[item_index].FileName.Add('=хяюфтшцэр _юяюЁр'); Item[item_index].FileName.Add(massafm.Edit1.Text); Item[item_index].FileName.Add(massafm.Edit2.Text); Item[item_index].FileName.Add(massafm.Edit3.Text); Item[item_index].FileName.Add(massafm.Edit4.Text); Item[item_index].FileName.Add(massafm.Edit5.Text); if massafm.CheckBox1.Checked=true then Item[item_index].FileName.Add('TRUE') else Item[item_index].FileName.Add('FALSE'); end; if Item[item_index].Hint='TюёЁхфюЄюўхээр _ьрёёр' then begin massafm.Edit6.Visible:=true; massafm.Edit7.Visible:=true; massafm.label8.Visible:=true; massafm.label9.Visible:=true; massafm.Edit5.Text:='TюёЁхфюЄюўхээр _ьрёёр'; massafm.Caption:='¦рёёр '+inttostr(index_item); massafm.ShowModal; Item[item_index].FileName.Add('¦рёёр '+inttostr(index_item)); Item[item_index].FileName.Add('TюёЁхфюЄюўхээр _ьрёёр'); Item[item_index].FileName.Add(massafm.Edit1.Text); Item[item_index].FileName.Add(massafm.Edit2.Text); Item[item_index].FileName.Add(massafm.Edit3.Text); Item[item_index].FileName.Add(massafm.Edit4.Text); Item[item_index].FileName.Add(massafm.Edit5.Text); Item[item_index].FileName.Add(massafm.Edit6.Text); Item[item_index].FileName.Add(massafm.Edit7.Text); if massafm.CheckBox1.Checked=true then Item[item_index].FileName.Add('TRUE') else Item[item_index].FileName.Add('FALSE'); end; { if AnsiUpperCase(Item[item_index].Hint) = '¦¦+LLT-' then try CreateProfile(Item[item_index]); except on E: Exception do MessageDlg(E.Message, mtError,[mbOK],0); end else SelectParams(Item[item_index]); if Item[item_index].FileName.Text = '' then begin Item[item_index].Free; Pic.Free; Exit; end;} inc(item_index); inc(index_item); break; end; end; Pic.Free; end; procedure TForm1.ToolButtonClick(Sender: TObject); var i: Word; begin for i:=0 to ToolBar2.ButtonCount-1 do ToolBar2.Buttons[i].Down:=False; if (Sender as TToolButton).Down then begin index:=(Sender as TToolButton).Index; for i:=0 to ToolBar1.ButtonCount-1 do 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:
Популярное: Как распознать напряжение: Говоря о мышечном напряжении, мы в первую очередь имеем в виду мускулы, прикрепленные к костям ... Почему люди поддаются рекламе?: Только не надо искать ответы в качестве или количестве рекламы... ©2015-2024 megaobuchalka.ru Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав. (248)
|
Почему 1285321 студент выбрали МегаОбучалку... Система поиска информации Мобильная версия сайта Удобная навигация Нет шокирующей рекламы |