Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
16 / 4 / 0
Регистрация: 27.06.2016
Сообщений: 99
1

Карта локальной сети

13.03.2017, 17:28. Показов 733. Ответов 1
Метки нет (Все метки)

Добрый день! Помогите пожалуйста с программой.

1. Когда добавляю картинку в paintbox и начинаю рисовать она пропадает.
2. Когда нажимаю в TMainMenu на кнопку сохранить, она делает скриншот всего рабочего стола, а надо что бы сохранял рабочую область в формате .bmp.
3. Как добавить формат .bmp во время сохранения т.к. там пусто.
4. В первом пункте нужно сделать свободное перемещение по paintbox'y.
5. Как сделать ластик ?


Кликните здесь для просмотра всего текста

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
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;
    ImageList1: TImageList;
  
    Image1: TImage;
    ComboBox1: TComboBox;
    
 
    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.FileName);
      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.Selected;
    img.Canvas.Brush.Color:=ColorBox2.Selected;
 
    if nowdrawing=sFill then
    begin
      img.Canvas.FloodFill(x0,y0,img.Canvas.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.ClientHeight;
  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.
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Миниатюры
Карта локальной сети   Карта локальной сети  
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
13.03.2017, 17:28
Ответы с готовыми решениями:

Тестирование по локальной сети
Здравствуйте. У меня есть программа тестовик, и мне нужно сделать примерно такое: Допустим она...

брутфорс в локальной сети
народ нужна помощь в таком вопросе!!! необходимо написать прогу каторая в локалной сетке будет...

Копирование файла по локальной сети
Здравствуйте, первый раз попробовал написать программу, подскажите как доделать в ней следующее: ...

Проверка существования ПК в локальной сети
Возник вопрос, есть такой код: begin if DirectoryExists('//user1/test/') then begin ...

1
5025 / 3918 / 1296
Регистрация: 14.04.2014
Сообщений: 18,019
Записей в блоге: 18
13.03.2017, 21:35 2
PaintBox - это компонент, который нужно рисовать в его событии OnPaint

если есть процедура, которая рисует на PaintBox.Canvas , то не проблема исполнить ее для bitmap.Canvas
для этого нужно просто создать bitmap:=TBitmap.Create и задать width и height

по формату читайте док по SaveDialog. там есть Default extension
кроме того, проверяйте имя файла после SaveDialog. Если расширение не bmp, то добавляйте его к полученному имени файла

кого чего надо перемещать по paintBox ?

если вы хотите иметь растровый редактор с ластиком, то нужно вместо PaintBox иметь TImage
разница принципиальна
Все что нарисовано на TImage - это битмап, обычная картинка
Все что рисуется на PaintBox вообще нигде не сохраняется.
Способ с image лучше подходит для растровых редакторов, PaintBox - для векторных

Добавлено через 1 минуту
кстати, карта локальной сети - это скорее векторный редактор
и с ластиком там как бы напряг
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
13.03.2017, 21:35

Вывод списка компьютеров в локальной сети
Что с этим кодом не так ? В Label ни чего не выводится BitBtn 1 и 2 не работают, а при переносе в...

Проектирование схемы локальной вычислительной сети
Добрый день! Нужна помощь в построении схемы ЛВС. На просторах Интернета есть какие-то демо-версии,...

Защита локальной сети
Привет=) Нам дали задание, "создать программу для защиты локальной сети". Я вообще не поняла, как...

Голос по локальной сети
Простенький исходник не могу нигде найти - мне нужно передавать голос, общаться с собеседником по...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.