|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
17.03.2017, 08:59 | #1 |
Новичок
Джуниор
Регистрация: 17.03.2017
Сообщений: 2
|
Карта локальной сети
Как мне сделать карту локальной сети на основе графического редактора ?
[SPOILER] [DELPHI] unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Buttons, StdCtrls, Menus, ImgList, JPEG; type TForm1 = class(TForm) Panel1: TPanel; SpeedButton1: TSpeedButton; ColorBox1: TColorBox; ColorBox2: TColorBox; Label1: TLabel; Label2: TLabel; ScrollBox1: TScrollBox; PaintBox1: TPaintBox; MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; SpeedButton2: TSpeedButton; SpeedButton3: TSpeedButton; ComboBox1: TComboBox; Image1: TImage; Image2: TImage; Image3: TImage; procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure PaintBox1Paint(Sender: TObject); procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end; TShape=(sPen, sRect, sEllipse, sPoly, sFill); var Form1: TForm1; nowdrawing:TShape; img, buffer:TBitmap; x0,y0:integer; dwn:boolean; move:boolean; implementation var bmp:TBitmap; {$R *.dfm} //Открытие картинок procedure TForm1.N2Click(Sender: TObject); begin OpenDialog1.Title := 'Открыть как...'; if (OpenDialog1.Execute) then begin bmp:=TBitmap.create; bmp.loadfromfile(OpenDialog1.FileNa me); paintbox1.width:=bmp.width; paintbox1.height:=bmp.height; end; end; //Скриншот рабочего стола procedure TForm1.N3Click(Sender: TObject); var JpegIm: TJpegImage; bm: TBitMap; begin bm := TBitMap.Create; bm.Width := Screen.Width; bm.Height := Screen.Height; BitBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, GetDC(0), 0, 0, SRCCOPY); JpegIm := TJpegImage.Create; JpegIm.Assign(bm); JpegIm.CompressionQuality := 20; JpegIm.Compress; JpegIm.SaveToFile('C:\Рабочий стол\Screen.jpg'); bm.Destroy; JpegIm.Destroy; end; //Выход procedure TForm1.N5Click(Sender: TObject); begin close; end; //Очистка procedure TForm1.PaintBox1Paint(Sender: TObject); begin paintbox1.canvas.draw(0,0,bmp); end; procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button=mbLeft then begin img.assign(buffer); x0:=x; y0:=y; if SpeedButton1.Down then begin nowdrawing:=sPoly; img.canvas.MoveTo(x,y); end else if SpeedButton2.Down then nowdrawing:=sRect else if SpeedButton3.Down then nowdrawing:=sFill; dwn:=true; img.Canvas.Pen.Color:=ColorBox1.Sel ected; img.Canvas.Brush.Color:=ColorBox2.S elected; if nowdrawing=sFill then begin img.Canvas.FloodFill(x0,y0,img.Canv as.Pixels[x,y],fsSurface); buffer.Assign(img); dwn:=false; end end else begin if (dwn)and(nowdrawing=sPoly) then begin x0:=x; y0:=y; buffer.Assign(img); end; end; paintbox1.Canvas.CopyRect(bounds(0, 0,img.Width,img.Height),img.Canvas, bounds(0,0,img.Width,img.Height)); end; procedure TForm1.FormCreate(Sender: TObject); begin Img:=TBitmap.Create; buffer:=TBitmap.Create; img.Width:=PaintBox1.ClientWidth; buffer.Width:=PaintBox1.ClientWidth ; img.Height:=PaintBox1.ClientHeight; buffer.Height:=PaintBox1.ClientHeig ht; nowdrawing:=sPen; dwn:=false; end; procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if not dwn then exit; img.assign(buffer); case nowdrawing of sPen:begin img.Canvas.LineTo(x,y); buffer.Assign(img); end; sRect:begin img.Canvas.Rectangle(x0,y0,x,y); end; sEllipse:begin img.Canvas.Ellipse(x0,y0,x,y); end; sPoly:begin img.Canvas.MoveTo(x0,y0); img.Canvas.LineTo(x,y); end; sFill:begin //nothing. end; end; paintbox1.Canvas.CopyRect(bounds(0, 0,img.Width,img.Height),img.Canvas, bounds(0,0,img.Width,img.Height)); end; procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if button=mbLeft then dwn:=false; buffer.Assign(img); end; end. [/DELPHI] [/SPOILER] |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Соннект по локальной сети | Madmaxisss | C/C++ Базы данных | 1 | 19.06.2012 03:28 |
Socket: Подключение клиента из глобальной сети к серверу, расположенному в локальной сети | Дамир | Общие вопросы .NET | 4 | 01.12.2010 12:12 |
Интернет в локальной сети | StartMis | Компьютерное железо | 1 | 21.07.2010 16:53 |
сообщение по локальной сети | Demonmov | Общие вопросы C/C++ | 2 | 17.07.2010 16:27 |
эмуляция локальной сети | Vasya | Свободное общение | 2 | 26.10.2007 19:27 |