Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.03.2017, 08:59   #1
Bronson715x
Новичок
Джуниор
 
Регистрация: 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]
Изображения
Тип файла: jpg Безымянный.jpg (45.3 Кб, 140 просмотров)
Bronson715x вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Соннект по локальной сети 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