Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 03.06.2009, 15:25
grisha575 grisha575 вне форума
Прохожий
 
Регистрация: 03.06.2009
Сообщения: 1
Репутация: 10
По умолчанию Помогите немного переделать проги

Вобщем проги сделаны,работают но их надо немного переделать.Помогите плизз.
1.По нажатии левой кнопки мыши нарисовать прямоугольник,соотношение сторон которого 3:5.Точка указателя - точка пересечения диагоналей.По отпускании кнопки - преобразовать прямоугольник в квадрат.
Проблема в том что по отпускании кнопки он преобразовывается в эллипс.
Код:
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Image1: TImage;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  d,a:integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if edit1.Text='' then exit;
d:=round(strtoint(edit1.Text)/2);
if shift=[ssleft] then begin
a:=round(d/7.3);
with image1.Canvas do begin
rectangle(x-round(a*3.5),y-a,x+round(a*3.5),y+a);
end;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if edit1.Text='' then exit;
d:=round(strtoint(edit1.Text)/2);
a:=round(d/7.3);
with image1.Canvas do begin
//pen.Color:=clwhite;
//rectangle(x-round(a*3.5),y-a,x+round(a*3.5),y+a);
FillRect(Rect(x-round(a*3.5),y-a,x+round(a*3.5),y+a));
ellipse(x-round(a*3.5),y-a,x+round(a*3.5),y+a);
 
end;
end;
end.

2.Прога гафического ввода и редактирования ломанной многоугольник на paintbox.Конец и начало многоугольника совпадают.
Надо сделать чтобы при нажатии правой кнопки мыши с каким-нить модификатором,выделялсясамый дальний,к заданной точке,отрезок ломанной.
Код:
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  f,f1,f2:boolean;
  xx,yy:array of integer;
  i,j,k,n:integer;
  rasst1,rasst2:real;
implementation
 
{$R *.dfm}
procedure figure(xxx,yyy:array of integer);
var i,l:integer;
begin
with form1.Canvas do begin
l:=length(xxx)-2;
pen.Color:=clwhite;
rectangle(0,0,form1.Width,form1.Height);
moveto(xxx[0],yyy[0]);
pen.Color:=clblack;
for i:=0 to l do lineto(xxx[i],yyy[i]);
if f=true then lineto(xxx[0],yyy[0]);
pen.Width:=1;
end;
end;
 
//нажатие/////////////////////////////////////////////////////////////////////////
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
with form1.Canvas do begin
   if (shift=[ssleft])and(f=false) then begin  //рисование
   i:=i+1;
      if (10>abs(x-xx[0]))and(10>abs(y-yy[0])) then begin
      f:=true;
      end
      else begin
      xx[i]:=x;
      yy[i]:=y;
      setlength(xx,length(xx)+1);
      setlength(yy,length(yy)+1);
      end;
   figure(xx,yy);
   end;      //конец рисования
   if (shift=[ssleft])and(f=true) then begin  //перетаскивание фигуры
      for j:=0 to i-1 do begin
 
 
 
      end;
   end;    //конец перетаскивания фигуры
   if (shift=[ssright,ssctrl])and(f=true) then begin //перетаскивание точки
      for j:=0 to length(xx) do begin
         if (10>abs(x-xx[j]))and(10>abs(y-yy[j])) then begin
         f1:=true;
         exit;
         end;
      end;
   end//конец перетаскивания точки
   if (shift=[ssright,ssshift])and(f=true) then begin //удаление точки
      for j:=0 to length(xx) do begin
         if (10>abs(x-xx[j]))and(10>abs(y-yy[j])) then begin
            for k:=j to length(xx)-2 do begin
            xx[k]:=xx[k+1];
            yy[k]:=yy[k+1];
            end;
         setlength(xx,length(xx)-1);
         setlength(yy,length(yy)-1);
         figure(xx,yy);
         exit;
         end;
      end;
   end; //конец удаления точки
   if (shift=[ssright,ssalt])and(f=true) then begin //добавление точки
   n:=length(xx);
      for j:=0 to n-1 do begin
      rasst1:=sqr(power(x-xx[j],2)+power(y-yy[j],2))+sqr(power(x-xx[j+1],2)+power(y-yy[j+1],2));
      rasst2:=sqr(power(xx[j+1]-xx[j],2)+(power(yy[j+1]-yy[j],2)));
         if rasst1-rasst2<0 then begin
         edit1.text:='yes';
         setlength(xx,length(xx)+1);
         setlength(yy,length(yy)+1);
            for k:=n downto j+1 do begin
            xx[k]:=xx[k-1];
            yy[k]:=yy[k-1];
            end;
         xx[j]:=x;
         yy[j]:=y;
         figure(xx,yy);
         exit;
         end;
      end;
   end//конец добавления точки
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
i:=-1;
setlength(xx,1);
setlength(yy,1);
end;
//отпускание/////////////////////////////////////////////////////////////////
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
with form1.canvas do begin
   if (Button=mbright)and(shift=[ssctrl])and(f1=true) then begin //перетаскивание точки
   f1:=false;
   figure(xx,yy);
   end//конец перетаскивания точки
end;
end;
//перемещение/////////////////////////////////////////////////////////////////////////
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
with form1.Canvas do begin
   if (shift=[ssright,ssctrl])and(f1=true) then begin //перетаскивание точки
   xx[j]:=x;
   yy[j]:=y;
   pen.Width:=2;
   figure(xx,yy);
   end//конец перетаскивания точки
end;
end;
end.

3.Надо чтобы вместо подстроки,последовательно выводилось самое короткое слово в каждом предложении.
Код:
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
s,sub,sl:string;
i,n,t,k,a:integer;
f:text;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
ss: string;
c:integer;
begin
if opendialog1.execute then begin
memo1.Text:='';
assignfile(f,opendialog1.filename);
reset(f);
while not eof(f) do begin
  readln(f,ss);
  Memo1.Lines.Add(ss);
end;
closefile(f);
end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Text:='';
opendialog1.filter:='textfiles(*.txt)|*.TXT';
savedialog1.filter:='textfiles(*.txt)|*.TXT';
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
if timer1.enabled=false then timer1.Enabled:=true;
sub:=edit1.text;
s:=memo1.Text;
n:=length(s);
t:=1;
k:=0;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
if SaveDialog1.Execute then begin
  AssignFile(f,SaveDialog1.FileName);
  rewrite(f);
  write(f,memo1.text);
  CloseFile(f);
end;
 
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
for i:=t to n do begin
   if ((s[i]=' ') or (ord(s[i])=13)) then k:=i;
   if (s[i+1]=' ') or (ord(s[i+1])=13) then begin
   sl:=copy(s,k+1,i-k);
   a:=pos(sub,sl);
      if a>0 then begin
      memo1.SelLength:=0;
      memo1.SelStart:=k;
      memo1.SelLength:=i-k;
      memo1.SetFocus;
      t:=i+1;
      break;
      end;
   end;
end;
end;
 
end.

Еще плюс к этому залил сами проги чтобы Вы имели представление как все это выглядет.(архив весит 557 кб)
http://www.anyfiles.net/download/ce83d7738177/Progi.rar
Ответить с цитированием
Ответ


Delphi Sources

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

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 02:05.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025