Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1] 2  Все   Вниз
  Печать  
Автор Тема: Volk:=Помогите!  (Прочитано 26901 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Volk
Гость
« : 20-05-2005 11:44 » 

Привет всем я Volk. Первый раз на этом форуме , но не первый день за делфи. Мне нужна помошь следуюшего плана. Кнонить может объяснить  построчно что написанно в этом исходняке?

sb: TStatusBar;
    Button1: TButton;
  private
    SX, SY, PrevX, PrevY: integer;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SX := X;
  SY := Y;
  PrevX := X;
  PrevY := Y;
  Canvas.MoveTo(X, Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  c: double;
begin
  if ssLeft in Shift then
  begin
    PrevX := Canvas.PenPos.X;
    PrevY := Canvas.PenPos.Y;
    Canvas.MoveTo(SX, SY);
    Canvas.LineTo(PrevX, PrevY);
    Canvas.MoveTo(SX, SY);
    Canvas.LineTo(X, Y);
    SB.Panels[0].Text := format('Start %d:%d', [SX, SY]);
    SB.Panels[1].Text := format('Curr %d:%d', [X, Y]);
    c := Sqr(Sqrt(Abs(X-SX))+Sqrt(Abs(Y-SY)));
    SB.Panels[2].Text := format('Length: %.2f', [c]);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Canvas.Pen.Mode := pmNot;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Brush.Color := clBtnFace;
  Canvas.FillRect(ClientRect);
end;

Зараниее спасибо!
« Последнее редактирование: 03-12-2007 19:54 от Алексей1153++ » Записан
aleliko
Гость
« Ответ #1 : 20-05-2005 12:03 » 

Если я не ошибаюсь, тут при движении мышки вычисляются координаты, ресуется траектория движения и координаты выводятся на экран, также выводится длинна пути
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #2 : 20-05-2005 12:18 » 

Это что, вопрос на "засыпку", или как? Здесь написана "рисовалка" линий на канве, с выводом в статус координат и длины линии.
« Последнее редактирование: 20-05-2005 12:34 от Oldy » Записан

С уважением, Oldy.
Volk
Гость
« Ответ #3 : 21-05-2005 08:45 » 

Не не. Не думайте что я вас прикалываю. Я просто спросил там упрограмера одного про рисовалку, он оставил этот исходник я попробовал всё работает действительно как в паинте чертится линия. И вот мне надо тоже знаете как в Паинте чтоб проводился прямоугольник или типа квадрат Как это сделать? Я думал на подобие этого , но я тут некоторые строчки не знаю и погэтому спросил. А да и ещё
1) Как мне сделать так чтоб всё изображение сохранялось после того как форму перекроеш чем нить или после того как свернёх? А то веть всё стирается!
2) Как мне сделать так чтоб при пересечении прямых в месте пересечения неостовалось велых промежуткоа? А то вот например рисуеш крест и на перекрестье белый квадрат(это заметно когда линии потолше сделаеш.
3)Как мне имея КологДиалог И Btton1 изменять цвет линий?
Пробую
if ColorDialog1.Execute then
Canvas.Pen.Color:=ColorDialog1.Color;
FormPaint(nil);
И не фига!
4) Как мне сохранять изображение с формы? как в Паинте? ColorDialog1.Execut; не помогает он открывается а сохранять не хочет.
Помогите пожалуйсто! Заранее Спасибо.
« Последнее редактирование: 21-05-2005 08:58 от Volk » Записан
RomCom
Опытный

ru
Offline Offline
Пол: Мужской

WWW
« Ответ #4 : 21-05-2005 12:46 » 

Чтоб изображение сохранялось при перепрорисовки формы рисовать лучше на компаненте Image. А чтоб потом сохранить нарисованное достаточно гденибудь добавит код:
 Image1.Picture.SaveToFile(<Имя файла>);
Записан

R.O.M.C.O.M.: Robotic Operational Mathematics and Ceaseless Observation Machine
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #5 : 21-05-2005 18:15 » 

//Здесь цвет карандаша определен как инверсный цвету фона.
procedure TForm1.FormCreate(Sender: TObject);
begin
  Canvas.Pen.Mode := pmNot; //Если установить Pen.Mode := pmCopy, то цвет будет определяться свойством Pen.Color   
end;

По остальным вопросам лучше смотреть Help - методы класса TCanvas: PoliLine, Restangle, CopyRect.
« Последнее редактирование: 22-05-2005 07:52 от Oldy » Записан

С уважением, Oldy.
Volk
Гость
« Ответ #6 : 22-05-2005 08:16 » 

Спасибо спасибо ОГРОМНОЕ! Люди помогите мне прогу очень нужно сделать! А я перевёл весь код в точности с PaintBox1 где она у меня всё рисовала на Image1 как сказали чтоб не проподало. Начилась такая гомоза с прямыми и квадратами что  прямо огогог! Кто может и хочет посмотреть, помочь и разобраться, ОТЗОВИТЕСЬ и напишите мыло на форуме в ответе я пришлю исходник он всего 500кб. ПОЖАЛУЙСТО люди!!!
---------------------------------------------------------------------------------------------------
Заранее спасибо.
« Последнее редактирование: 22-05-2005 08:19 от Volk » Записан
Volk
Гость
« Ответ #7 : 23-05-2005 11:13 » 

Ну отзовитесь кто-нибудь! Там гомоза такая что долго объяснять я лучше по мылу перешлю. Кто может помочь? Please!
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #8 : 23-05-2005 13:59 » 

Нда, заманчивое предложение, и главное - взаимовыгодное. Улыбаюсь
Прошу прощения, но я бы рекомендовал Вам, посетить следующий каталог -
C:\Program Files\Borland\Delphi\Demos\Doc\Graphex, и изучить (просмотреть хотя-бы) предложенную там программу графического редактора. Возможно основная масса вопросов отпадет, а на оставшиеся постараемся
ответить.
Записан

С уважением, Oldy.
Volk
Гость
« Ответ #9 : 24-05-2005 11:01 » 

Дельное предложени! Но посмотреть мог бы и взять для обшего развития:-) Ну да ладно не об этом речь. А о том что у меня Делф не слушает IF вообше! Вот например у меня есть на панели кнопка которая при нажатии выполняет Label1.Left:=300; а в процедуре MouseDown записан код чтоб рисовать квадрат. И так для линии Только лэфт не тристо а 200. И значит в идеале должно получится так шёлкаю я на кнопку она двигает лэйбл и я рисую квадрат , потом жму на другую красивую кнопку, вожу по Image1 и она не рисуется квадрат а рисует прямую. А у меня нажал на кнопку квадрат потом на прямую и всё рисуется вместе! Почему? И чё делать??? А и вот ещё есть ли какойнить if для MouseDovn? Типа если нажата кнопка мыши в процедуре MouseMove.
-------------------------------------------------------------------------------------------------
Заранее спасибо! 
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #10 : 25-05-2005 07:14 » 

Цитата
перевёл весь код в точности с PaintBox1 где она у меня всё рисовала на Image1 как сказали чтоб не проподало.
Нужно еще создавать BitMap.
Цитата
А и вот ещё есть ли какойнить if для MouseDovn?
А он (IF), там и не нужен. Нужен "CASE" в MouseMove
Записан

С уважением, Oldy.
Volk
Гость
« Ответ #11 : 25-05-2005 11:04 » 

Так так так. Давай пожалуйсто по подробнее Про BitMap и про CASE. Хорошо? Да и ещё: Открыл я этот пример в C:/Program... и там есть такой прелестный код который мне как раз нужен Drawing := True; DrawingTool := dtRectangle; а Делфи его не воспринимает и выдаёт ошибку. Почему???
--------------------------------------------------------------------------------------------------------------------
Заранее спасибо!
« Последнее редактирование: 25-05-2005 11:10 от Volk » Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #12 : 25-05-2005 12:20 » 

Drawing и DrawingTool это члены класса (переменные), объявленные в секции Public

Код:
    Drawing: Boolean;
    Origin, MovePt: TPoint;
    DrawingTool: TDrawingTool;

Bitmap создается в процедуре FormCreate. Именно на нем и рисуют (что-бы не пропадал рисунок при перекрытии)
Код:
    Bitmap := TBitmap.Create;
    Bitmap.Width := 200;  //Можно ClientWidth
    Bitmap.Height := 200; //Можно ClientHeight
    Image.Picture.Graphic := Bitmap;

По поводу "Case" - смотри процедуры MouseMove и DrawShape.
Записан

С уважением, Oldy.
Volk
Гость
« Ответ #13 : 25-05-2005 18:08 » 

Спасибо но вот слушай ну уже и так и так, пишу в Публик:BrushStyle: TBrushStyle;
    PenStyle: TPenStyle;
    PenWide: Integer;
    Drawing: Boolean;
    Origin, MovePt: TPoint;
    DrawingTool: TDrawingTool;
    CurrentFile: string;
    procedure SaveStyles;
    procedure RestoreStyles;
    procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
А на DrawingTool: TDrawingTool; всё равно ОШИБКУ выдаёт!!! Почиму? Что надо делать?
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #14 : 25-05-2005 19:34 » 

Сравни то,  что указано в Uses.
Записан

С уважением, Oldy.
Volk
Гость
« Ответ #15 : 26-05-2005 07:14 » 

Спасибо!!! А я вот рисую на Image есть ли разница между Bitmap и Image?
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #16 : 26-05-2005 08:09 » 

RTFM:

Цитата
TBitmap contains an internal image of the bitmap graphic and automatically manages realization of the palette when drawn. A bitmap is a powerful graphics object used to create, manipulate (scale, scroll, rotate, and paint), and store images in memory and as files on a disk.

To draw a bitmap on a canvas, call the Draw or StretchDraw methods of a TCanvas object, passing a TBitmap as a parameter.

Creating copies of a TBitmap is very fast since the handle is copied rather than the image. If the image is modified and the handle is shared by more than one TBitmap object, the image is copied before the modification is performed (that is, copy on write).

Цитата
Use TImage to display a graphical image on a form. Use a TPicture object to specify the actual bitmap, icon, metafile, or other graphic object displayed by TImage. TImage introduces several properties to determine how the image is displayed within the boundaries of the TImage object.

To add an image to a form or data module so that it is available for display by other controls, use TImageList instead.
Записан

С уважением, Oldy.
Volk
Гость
« Ответ #17 : 26-05-2005 08:40 » 

С этим примером столько замороче что прям *** !!! Вот у меня исходник моей проги которая у меня сейчас:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Menus, Buttons, ExtCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    SB: TStatusBar;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ColorDialog1: TColorDialog;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    Splitter2: TSplitter;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Edit1: TEdit;
    N4: TMenuItem;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    FontDialog1: TFontDialog;
    GroupBox1: TGroupBox;
    UpDown1: TUpDown;
    SpeedButton6: TSpeedButton;
    Image1: TImage;
    SpeedButton7: TSpeedButton;
    SavePictureDialog1: TSavePictureDialog;
    Label1: TLabel;
    SpeedButton8: TSpeedButton;
    ColorDialog2: TColorDialog;
    SpeedButton9: TSpeedButton;
    Com: TComboBox;
    N5: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    N6: TMenuItem;
    Panel2: TPanel;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Button2: TButton;
    N7: TMenuItem;
    N8: TMenuItem;


    procedure FormCreate(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);

    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);





  private
    SX, SY, DDX, DDY, DX, DY, PrevX, PrevY, SSX, SSY, KX, KY, KKX, KKY: integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}



procedure TForm1.FormCreate(Sender: TObject);
begin
Canvas.Pen.Mode := pmNot;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(ClientRect);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
M, C, W, E: Integer;
begin
M:=Image1.Width;

ColorDialog1.Color:=Image1.Canvas.Brush.Color;
if ColorDialog1.Execute then
Image1.Canvas.Brush.Color:=ColorDialog1.Color;
Image1.Canvas.Brush.Style:=bsSolid;
Image1.Canvas.Rectangle(M,C,W,E);
end;

procedure TForm1.FormShow(Sender: TObject);

Var
X: Integer;
Y: Integer;
W: Integer;
begin
SB.Panels[0].Width:=90;
SB.Panels[1].Width:=140;
SB.Panels[2].Width:=90;
SB.Panels[3].Width:=90;
W:=Canvas.Pen.Width;
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
Image1.Canvas.Pen.Width:=UpDown1.Position;
Repaint;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Label1.Left:=220;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
Edit1.Visible:=True;
SpeedButton5.Visible:=True;
Label1.Left:=180;
SpeedButton3.Visible:=False;
SpeedButton4.Visible:=True;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
SpeedButton5.Visible:=False;
SpeedButton4.Visible:=False;
SpeedButton3.Visible:=True;
Label1.Left:=176;
Edit1.Visible:=False;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
if FontDialog1.Execute then // если пользователь выбрал шрифт
Image1.Canvas.Font:=FontDialog1.Font;
end;

procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
Label1.Left:=250;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If Label1.Left=220 then
  SX := X;
  SY := Y;
  if Label1.Left=180 then
Image1.Canvas.TextOut(X, Y, (Edit1.Text));
if Label1.Left=250 then
DX:=X;
DY:=Y;
if Label1.Top=80 then
KX := X;
KY := Y;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  c:Double;
begin
SB.Panels[4].Text:= FormatFloat('##0', X);
SB.Panels[5].Text:= FormatFloat('##0', Y);
SB.Panels[0].Text := format('Начало %d:%d', [SX, SY]);
SB.Panels[1].Text := format('Положен. курсора %d:%d', [X, Y]);
c := Sqr(Sqrt(Abs(X-SX))+Sqrt(Abs(Y-SY)));
SB.Panels[2].Text := Format('Длинна: %.2f', [c/33]);
if Label1.Top=80 then
    PrevX := Canvas.PenPos.X;
    PrevY := Canvas.PenPos.Y;
    Canvas.MoveTo(KX, KY);
    Canvas.LineTo(PrevX, PrevY);
    Canvas.MoveTo(KX, KY);
    Image1.Canvas.LineTo(X, Y);

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Label1.Left=250 then
DDX:=X;
DDY:=Y;
Image1.Canvas.Rectangle(DX, DY, DDX, DDY);
if Label1.Left=220 then
SSX := X;
SSY := Y;
if Com.Text='Штрих' then
Image1.Canvas.Pen.Style:=psDash;
if Com.Text='Штрих мелкий' then
Image1.Canvas.Pen.Style:=psDot;
if Com.Text='Штрихпунктир' then
Image1.Canvas.Pen.Style:=psDashDot;
if Com.Text='Двойной Ш.П.' then
Image1.Canvas.Pen.Style:=psDashDotDot;
if Com.Text='Квадратн.Сплошн.' then
Image1.Canvas.Pen.Style:=psInsideFrame;

Image1.Canvas.MoveTo(SX,SY);
Image1.Canvas.LineTo(SSX,SSY);



if Label1.Top=80 then
KKX := X;
KKY := Y;

end;

procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
Image1.Picture.SaveToFile('C:\Documents and Settings\Администратор\Мои документы\Мои рисунки\fff.bmp');
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
begin


ColorDialog2.Color:=Image1.Canvas.Pen.Color;
if ColorDialog2.Execute then
Image1.Canvas.Pen.Color:=ColorDialog2.Color;
end;

procedure TForm1.SpeedButton9Click(Sender: TObject);
begin
Label1.Top:=80;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.N6Click(Sender: TObject);
begin
if SavePictureDialog1.Execute then
Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
end;

procedure TForm1.N8Click(Sender: TObject);
begin
Panel2.Visible:=True;
GroupBox2.Visible:=True;
Edit2.Text:=IntToStr(Image1.Width);
Edit3.Text:=IntToStr(Image1.Height);
Image1.Enabled:=False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Height:=StrToInt(Edit3.Text);
Image1.Width:=StrToInt(Edit2.Text);
Image1.Enabled:=True;
GroupBox2.Visible:=False;
Panel2.Visible:=False;
end;

end.

И кнопки у меня на форме типа рисовать линию , квадрат только двигают лэйбл, а у же от положения лэйбла зависит что будет рисоваться. Вроде всё в поряде, ан нет, Нажмёж сначала на линию потом на квадрат и ресуется и линия и квадрат!!! Почему? И где ошибка???
Заранее Спасибо! 
« Последнее редактирование: 03-12-2007 19:56 от Алексей1153++ » Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #18 : 26-05-2005 11:12 » 

Блин, я уже рыдаю.   Так больше нельзя...  Молчу

procedure TForm1.FormCreate(Sender: TObject);
begin
Canvas.Pen.Mode := pmNot; // Всегда будет выбран цвет инверсный цвету фона.
end;

procedure TForm1.N3Click(Sender: TObject); //Здесь производится очистка формы от шедевров изобразительного искусства
begin
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(ClientRect);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
M, C, W, E: Integer;
begin
M:=Image1.Width;

ColorDialog1.Color:=Image1.Canvas.Brush.Color;
if ColorDialog1.Execute then
Image1.Canvas.Brush.Color:=ColorDialog1.Color;
Image1.Canvas.Brush.Style:=bsSolid;
Image1.Canvas.Rectangle(M,C,W,E); должно быть 4 параметра, известен 1 - M
end;

procedure TForm1.FormShow(Sender: TObject);

Var
X: Integer;
Y: Integer;
W: Integer;
begin
SB.Panels[0].Width:=90;
SB.Panels[1].Width:=140;
SB.Panels[2].Width:=90;
SB.Panels[3].Width:=90;
W:=Canvas.Pen.Width;
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
Image1.Canvas.Pen.Width:=UpDown1.Position;
Repaint;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Label1.Left:=220;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
Edit1.Visible:=True;
SpeedButton5.Visible:=True;
Label1.Left:=180;
SpeedButton3.Visible:=False;
SpeedButton4.Visible:=True;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
SpeedButton5.Visible:=False;
SpeedButton4.Visible:=False;
SpeedButton3.Visible:=True;
Label1.Left:=176;
Edit1.Visible:=False;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
if FontDialog1.Execute then // если пользователь выбрал шрифт
Image1.Canvas.Font:=FontDialog1.Font;
end;

procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
Label1.Left:=250;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If Label1.Left=220 then
  SX := X;
  SY := Y;
  if Label1.Left=180 then
Image1.Canvas.TextOut(X, Y, (Edit1.Text)); А "рисовать" - игде?
if Label1.Left=250 then
DX:=X;
DY:=Y; DY определяем всегда, DX - только если Label1.Left=250
if Label1.Top=80 then
KX := X;
KY := Y;KY определяем всегда, KX - только если Label1.Top=80
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  c:Double;
begin
SB.Panels[4].Text:= FormatFloat('##0', X);
SB.Panels[5].Text:= FormatFloat('##0', Y);
SB.Panels[0].Text := format('Начало %d:%d', [SX, SY]);
SB.Panels[1].Text := format('Положен. курсора %d:%d', [X, Y]);
c := Sqr(Sqrt(Abs(X-SX))+Sqrt(Abs(Y-SY)));
SB.Panels[2].Text := Format('Длинна: %.2f', [c/33]);
if Label1.Top=80 then
    PrevX := Canvas.PenPos.X;
    PrevY := Canvas.PenPos.Y;
    Canvas.MoveTo(KX, KY);          //Ну таки линии и рисуем, где квадрат - не пойму.
    Canvas.LineTo(PrevX, PrevY);
    Canvas.MoveTo(KX, KY);
    Image1.Canvas.LineTo(X, Y);

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Label1.Left=250 then
DDX:=X;
DDY:=Y; //DDY- определяем всегда, а DDX только если  Label1.Left=250
Image1.Canvas.Rectangle(DX, DY, DDX, DDY); Ах вот и квадрат, появится при отпускании мышки (только вот чему равны DX, DY?)
if Label1.Left=220 then
SSX := X;
SSY := Y;SSY - определяем всегда, а DDX только если Label1.Left=220
if Com.Text='Штрих' then
Image1.Canvas.Pen.Style:=psDash;
if Com.Text='Штрих мелкий' then
Image1.Canvas.Pen.Style:=psDot;
if Com.Text='Штрихпунктир' then
Image1.Canvas.Pen.Style:=psDashDot;
if Com.Text='Двойной Ш.П.' then
Image1.Canvas.Pen.Style:=psDashDotDot;
if Com.Text='Квадратн.Сплошн.' then
Image1.Canvas.Pen.Style:=psInsideFrame;

Image1.Canvas.MoveTo(SX,SY); И к квадрату пришпандорили линию
Image1.Canvas.LineTo(SSX,SSY);



if Label1.Top=80 then Потом посмотрели где верхушка лейбочки, и запомнили координаты карандаша, на всякий случай
KKX := X;
KKY := Y;Причем Y запоминаем всегда, а X-если верхушка лейбочки на 80-м пикселе сверху формы

end;

А дальше смотреть не могу - плАчу   Так больше нельзя...

procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
Image1.Picture.SaveToFile('C:\Documents and Settings\Администратор\Мои документы\Мои рисунки\fff.bmp');
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
begin


ColorDialog2.Color:=Image1.Canvas.Pen.Color;
if ColorDialog2.Execute then
Image1.Canvas.Pen.Color:=ColorDialog2.Color; А оно сработет при Canvas.Pen.Mode:=pmNot?
end;

procedure TForm1.SpeedButton9Click(Sender: TObject);
begin
Label1.Top:=80;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.N6Click(Sender: TObject);
begin
if SavePictureDialog1.Execute then
Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
end;

procedure TForm1.N8Click(Sender: TObject);
begin
Panel2.Visible:=True;
GroupBox2.Visible:=True;
Edit2.Text:=IntToStr(Image1.Width);
Edit3.Text:=IntToStr(Image1.Height);
Image1.Enabled:=False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Height:=StrToInt(Edit3.Text);
Image1.Width:=StrToInt(Edit2.Text);
Image1.Enabled:=True;
GroupBox2.Visible:=False;
Panel2.Visible:=False;
end;

end.
« Последнее редактирование: 03-12-2007 19:56 от Алексей1153++ » Записан

С уважением, Oldy.
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #19 : 26-05-2005 18:33 » 

Begin ... End; расставить по вкусу?

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Label1.Left=250 then
      Begin
        DDX:=X;
        DDY:=Y; 
        Image1.Canvas.Rectangle(DX, DY, DDX, DDY);
     End;
if Label1.Left=220 then
   Begin
       SSX := X;
       SSY := Y;
       if Com.Text='Штрих' then Image1.Canvas.Pen.Style:=psDash;
       if Com.Text='Штрих мелкий' then Image1.Canvas.Pen.Style:=psDot;
       if Com.Text='Штрихпунктир' then Image1.Canvas.Pen.Style:=psDashDot;
       if Com.Text='Двойной Ш.П.' then Image1.Canvas.Pen.Style:=psDashDotDot;
       if Com.Text='Квадратн.Сплошн.' then Image1.Canvas.Pen.Style:=psInsideFrame;

       Image1.Canvas.MoveTo(SX,SY);
       Image1.Canvas.LineTo(SSX,SSY);
  End;

if Label1.Top=80 then
   Begin
      KKX := X;
      KKY := Y;
   End;
end;
« Последнее редактирование: 20-12-2007 20:09 от Алексей1153++ » Записан

С уважением, Oldy.
Volk
Гость
« Ответ #20 : 27-05-2005 06:35 » 

"Без базара твоя правда..." Все мои проблеммы происходили лиш из зи того что я не ставил после IF  Begin и End!!!!!  Да это будит для меня отличным уроком! А я и вправду думал что это ставить необязательно. СПАСИБО ТЕБЕ ОГРОМНОЕ!!!!!
Но остался ещё один последний вопрос:
Что надо писать в MouseMove когда поставил курсор, нажал кнопку и тянеш, чтоб ты видел куда ты тянеш квадрат или прямую. Ну как в Паинте. А то тянеш и невидно!!! На старый моусмув не обращай внимание что там написанно это для другого щас у меня там всё стёрто.
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #21 : 27-05-2005 10:35 » 

Цитата
Что надо писать в MouseMove...

Не только в  MouseMove, но и в  MouseUp, и в MouseDown примерно следующее:

Код:
Var
   Origin, MovePt : TPoint; //Глобальные переменные (лучше вынести в Public раздел класса)

//Начинаем рисовать.
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Image.Canvas.MoveTo(X, Y); //Поставить карандаш в начало рисунка
  Origin := Point(X, Y); //Запомнить координаты
  MovePt := Origin;
  {Здесь будут инструкции вывода координат в СтатусБар}
end;

//Рисуем
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
begin
    Canvas.Pen.Mode := pmNotXor;
    Case
     (рисуем линию):
        begin
          Image.Canvas.MoveTo(Origin.X, Origin.Y);
          Image.Canvas.LineTo(MovePt.X, MovePt.Y);
          MovePt := Point(X, Y);
          Image.Canvas.MoveTo(Origin.X, Origin.Y);
          Image.Canvas.LineTo(MovePt.X, MovePt.Y);
        end;
    (рисуем квадрат):
      Begin
         Image.Canvas.Rectangle(Origin.X, Origin.Y, MovePt.X, MovePt.Y);
         MovePt := Point(X, Y);
         Image.Canvas.Rectangle(Origin.X, Origin.Y, MovePt.X, MovePt.Y);
      End;
    (Рисуем окружность):
      Begin
         Image.Canvas.Ellipse(Origin.X, Origin.Y, MovePt.X, MovePt.Y);
         MovePt := Point(X, Y);
         Image.Canvas.Ellipse(Origin.X, Origin.Y, MovePt.X, MovePt.Y);
      End;
   End; //Case
{Здесь будут инструкции вывода координат в СтатусБар}
end;

//Завершаем рисунок
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
Var
   Pt : TPoint;
begin
    Canvas.Pen.Mode :=  pmCopy; // Чтобы рисовать любым цветом
    Pt := Point(X, Y);
 
    If (рисовали линию) Then
        begin
          Image.Canvas.MoveTo(Origin.X, Origin.Y);
          Image.Canvas.LineTo(Pt.X, Pt.Y);
        end;

    If (рисовали квадрат) Then
      Begin
         Image.Canvas.Rectangle(Origin.X, Origin.Y, Pt.X, Pt.Y);
      End;

    If (Рисовали окружность) Then
      Begin
         Image.Canvas.Ellipse(Origin.X, Origin.Y, Pt.X, Pt.Y);
      End;
end;
Записан

С уважением, Oldy.
Volk
Гость
« Ответ #22 : 27-05-2005 10:37 » 

А нет вот ещё какие вопросы назрели.
1) как? какой код нужен для сохранения рисунка как в паинте? Я пробую:
if SavePictureDialog1.Execute then
Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
оно то сохраняет но вот только как неизвестный формат и чтоб открыть надо заходить в меню "Выбрать программу из списка..."
2) Элипс. Всё зделал как для квадрата только другие переменные и вместо Rectangl  Ellips написал так вот он рисуется , но всё время левый вершний край в левом верхнем углу Image1.
Как мне всё это победить???
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #23 : 27-05-2005 11:32 » 

1) На Image нужно было ложить BitMap и из него сохранять.  Код в примере GraphEx,  процедуры:
    FormCreate, New1Click, Save1Click, SaveAs1Click.
2) Наверное не те переменные используешь. Посмотри на трассировке что там за значения, и меняются ли они
    в MouseDown (начало прорисовки).
« Последнее редактирование: 27-05-2005 11:48 от Oldy » Записан

С уважением, Oldy.
Volk
Гость
« Ответ #24 : 30-05-2005 13:10 » 

Блин чё за злая шутка элипса??? Я пробую как ты написал и посвоему пробую, он то рисуется и оттягивается, да только он постоянно прижат к Верхниму и Левому краю Image1!!!!!!! Чё это за прикол!?!?!?
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #25 : 30-05-2005 13:38 » 

Приведи фрагменты кода для прямоугольника и элипса, посмотрим.
« Последнее редактирование: 30-05-2005 13:41 от Oldy » Записан

С уважением, Oldy.
Volk
Гость
« Ответ #26 : 30-05-2005 18:36 » 

Для прямоугольника:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
if Label1.Left=250 then
begin
DX:=X;
DY:=Y;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
if Label1.Left=250 then
begin
DDX:=X;
DDY:=Y;
Image1.Canvas.Rectangle(DX, DY, DDX, DDY);
end;
--------------------------------------------------------------------------------------------------
Для Элипса:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
if Label1.Left=125 then
begin
OX:=X;
OY:=Y;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
if Label1.Left=125 then
begin
OOX:=X;
OOY:=Y;
Image1.Canvas.Ellipse(OX, OY, OOX, OOY);
end;
---------------------------------------------------------------------------------------------------
В MouseMove ничё не писал потому что незнаю чё. Ничё не срабатывает!
« Последнее редактирование: 30-05-2005 18:40 от Volk » Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #27 : 31-05-2005 06:58 » 

И для квадрата, и для элипса, не вижу инструкции Image.Canvas.MoveTo(X, Y); в MouseDown, что и определяет начальные координаты рисунка.
Так-же не вижу смысла в применении разных переменных для квадрата и элипса. Так если будут использоваться одни и те-же переменные, то процедура MouseDown сведется до трех 3 строк кода для ВСЕХ фигур:
Код:
private
    DX, DY, DDX, DDY: integer;
End;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Image.Canvas.MoveTo(X, Y);
   DX:=X;
   DY:=Y;
End;

MouseMove я уже писал. Смени Origin.X на DX, а Origin.Y на DY.  MovePt соответсвенно DDX, DDY. Если не знаешь что делать с CASE - удали его и используй полюбившийся If, то есть:

 Case
    (рисуем квадрат):
      Begin
         Image.Canvas.Rectangle(Origin.X, Origin.Y, MovePt.X, MovePt.Y);
         MovePt := Point(X, Y);
         Image.Canvas.Rectangle(Origin.X, Origin.Y, MovePt.X, MovePt.Y);
      End;
 End;
 
Будет выглядеть:
Код:
Canvas.Pen.Mode := pmNotXor;
if Label1.Left=250 then
begin
  Image1.Canvas.Rectangle(DX, DY, DDX, DDY);
  DDX:=X; DDY:=Y;
  Image1.Canvas.Rectangle(DX, DY, DDX, DDY);
End;

if Label1.Left=125 then
begin
  Image1.Canvas.Ellipse(DX, DY, DDX, DDY);
  DDX:=X;
  DDY:=Y;
  Image1.Canvas.Ellipse(DX, DY, DDX, DDY);
End;

ВСЁ
« Последнее редактирование: 31-05-2005 07:01 от Oldy » Записан

С уважением, Oldy.
Volk
Гость
« Ответ #28 : 31-05-2005 09:50 » 

СПАСИБО!!! Но с элипсом то я сам сёдня разобрался там мелоч...
Но вот ещё какая проблемка появилась: я написал код чтобь рисовать кистью как в паинте:
if Label1.Left=401 then
 begin
 Image1.Canvas.Brush.Color:=clBlack;
 Image1.Canvas.Brush.Style:=bsSolid;
 Image1.Canvas.Ellipse(X, Y, X+3, Y+3);
end;
Всё вроде нормально нажал мыш водиш рисует как кистью, но когда резко матнёш курсором он не рисует сплошную линию а рисует несколько удалённых кружков. Как от этого избавится а? Я думаю что надо сделать такой код чтоб "элипс постоянно летал за крсором но не рисовался" Как это сделать???
Записан
Oldy
Команда клуба

ru
Offline Offline
Пол: Мужской

« Ответ #29 : 31-05-2005 12:30 » 

Image1.Canvas.Brush - это заливка области (Rectangle или Ellipse),
а "чтобы рисовать кистью как в паинте" - это Canvas.Pen.Mode+Canvas.Pen.Style+Canvas.Pen.Width

RTFM, вдумчиво и внимательно
« Последнее редактирование: 31-05-2005 12:52 от Oldy » Записан

С уважением, Oldy.
Страниц: [1] 2  Все   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines