Форум программистов [Powered by Invision Power Board]

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)

    ScrollBox1: TScrollBox;
    PaintBox1: TPaintBox;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ColorDialog1: TColorDialog;
    PrintDialog1: TPrintDialog;
    N10: TMenuItem;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    N11: TMenuItem;
    f1: TMenuItem;
    SpinEdit1: TSpinEdit;
    N4: TMenuItem;
    N12: TMenuItem;
    ColorGrid1: TColorGrid;
    SpeedButton5: TSpeedButton;
    ControlBar1: TControlBar;
    procedure  PaintBox1MouseDown(Sender:TObject; Button: TMouseButton;
    Shift:TShiftState; x,y:Integer);
    procedure  PaintBox1MouseUp(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
    procedure N9Click(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure f1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure ColorGrid1Change(Sender: TObject);







  private
    { Private declarations }
  public
    { Public declarations }

  end;

var
  Form1: TForm1;
  drag:boolean;
  Start: TPoint;
  a:integer;

implementation

{$R *.dfm}



procedure  TForm1.PaintBox1MouseUp(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
begin

drag:=false;
end;

procedure TForm1.PaintBox1MouseDown(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
begin
Start.X:=X;
Start.Y:=Y;
drag:=true;

end;



procedure TForm1.N9Click(Sender: TObject);
begin
Form1.Close;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer );
begin
 

 if speedbutton1.Down then
 begin
   if drag=true then
   begin
      
      paintbox1.Canvas.Pen.Width:=1;
      paintbox1.Canvas.LineTo(x,y);
   end;
   if drag=false then
   begin
     paintbox1.Canvas.MoveTo(x,y);
   end;
  end;

  if speedbutton2.Down then
  begin
    if drag=true then
       begin
       a:=spinedit1.Value;
       paintbox1.Canvas.Pen.Width:=a;

       PaintBox1.Canvas.Rectangle(x,y,x+n,y+n);

       end;
    end;
   if speedbutton3.Down then
   begin
     if drag=true then
      begin
      a:=spinedit1.Value;
      paintbox1.Canvas.Pen.Width:=a;
      paintbox1.Canvas.Ellipse(start.X,start.Y,x,y);

      end;
   end;
   if speedbutton4.Down then
   begin
     if drag=true then
   begin
      a:=spinedit1.Value;
      paintbox1.Canvas.Pen.Width:=a;
      paintbox1.Canvas.LineTo(x,y);
   end;
   if drag=false then
   begin
     paintbox1.Canvas.MoveTo(x,y);
   end;
   end;
   if speedbutton5.Down then
    begin
     if drag=true then
      begin
      paintbox1.Canvas.MoveTo(start.X,start.Y);
      paintbox1.Canvas.LineTo(x,y);
      end;

    end;
end;




procedure TForm1.N10Click(Sender: TObject);
begin
paintbox1.Canvas.Pen.Width:=0;
paintbox1.Repaint;
paintbox1.Canvas.Rectangle(0,0,width,height);
end;



procedure TForm1.N11Click(Sender: TObject);
begin
panel1.Visible:=false;
  if panel1.Visible=false then

  begin
   n11.Checked:=false;
   end
   else
   begin
   n11.Checked:=true;
   end ;
  if panel1.Visible=false then

end;

procedure TForm1.f1Click(Sender: TObject);
begin
 panel1.Visible:=false or true
end;



procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
if spinedit1.Value<0 then
 begin
 spinedit1.Value:=0;
 MessageDlg('Are you noob?',mtConfirmation,[mbYes],0);
 end;
if speedbutton1.Down=true then
 begin
 spinedit1.Value:=1;
 end;

end;



procedure TForm1.N12Click(Sender: TObject);
begin
colordialog1.Execute;
paintbox1.Canvas.Pen.Color:=colordialog1.Color;
end;



procedure TForm1.ColorGrid1Change(Sender: TObject);
begin
paintbox1.Canvas.pen.Color:=ColorGrid1.ForeGroundColor;
colordialog1.Color:=ColorGrid1.ForeGroundColor;;
end;



end.

Цитата(furious @ 28.10.2009, 22:38

)

только потом если нарисовать еще один круг, то предыдущий стирается

Цитата(furious @ 28.10.2009, 22:43

)

а можно это в виде кода

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, Spin;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    PaintBox1: TPaintBox;
    SpeedButton5: TSpeedButton;
    SpinEdit1: TSpinEdit;
    procedure  PaintBox1MouseDown(Sender:TObject; Button: TMouseButton;
    Shift:TShiftState; x,y:Integer);
    procedure  PaintBox1MouseUp(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure DrawImg(Canvas : TCanvas; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  //  procedure ERACEBKG(msg : ) message WM_ERASEBKG;
  private
    { Private declarations }
  public
    { Public declarations }
    BackImage : TBitmap;
  end;

var
  Form1 : TForm1;
  drag  : boolean;
  Start : TPoint;
  a     : integer;

implementation

{$R *.dfm}

procedure  TForm1.PaintBox1MouseUp(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
begin
  DrawImg(BackImage.Canvas, x, y);
  PaintBox1.Canvas.Draw(0, 0, BackImage);
  drag := false;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, BackImage);
end;

procedure TForm1.DrawImg(Canvas: TCanvas; X, Y: Integer);
begin
 PaintBox1.Canvas.Brush.Color := clWhite;
 if speedbutton1.Down then
 begin
   if drag=true then
   begin
      Canvas.Pen.Width:=1;
      Canvas.LineTo(x,y);
   end;
   if drag=false then
   begin
     Canvas.MoveTo(x,y);
   end;
  end;
  if speedbutton2.Down then
  begin
    if drag=true then
       begin
         a:=spinedit1.Value;
         Canvas.Pen.Width:=a;
   //    PaintBox1.Canvas.Rectangle(x,y,x+n,y+n);
       end;
    end;
   if speedbutton3.Down then
   begin
     if drag=true then
      begin
        a:=spinedit1.Value;
        Canvas.Pen.Width := a;
        Canvas.Ellipse(start.X, start.Y, x,y);
      end;
   end;
   if speedbutton4.Down then
   begin
     if drag=true then
   begin
      a:=spinedit1.Value;
      Canvas.Pen.Width:=a;
      Canvas.LineTo(x,y);
   end;
   if drag=false then
   begin
     paintbox1.Canvas.MoveTo(x,y);
   end;
   end;
   if speedbutton5.Down then
    begin
     if drag=true then
      begin
        Canvas.MoveTo(start.X,start.Y);
        Canvas.LineTo(x,y);
      end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BackImage := TBitmap.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BackImage.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
var
  tmp : TBitmap;
begin
  tmp := TBitmap.Create;
  tmp.SetSize(ClientWidth, ClientHeight);
  tmp.Canvas.Draw(0, 0, BackImage);

  BackImage.Free;
  BackImage := tmp;
end;

procedure TForm1.PaintBox1MouseDown(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
begin
  Start.X:=X;
  Start.Y:=Y;
  drag:=true;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer );
begin
   PaintBox1.Canvas.Draw(0, 0, BackImage);
   DrawImg(PaintBox1.Canvas, x, y);
end;


end.

Цитата(furious @ 29.10.2009, 12:34

)

можно как-нибудь без этого? и за что setsize отвечает ?

Цитата(furious @ 29.10.2009, 14:20

)

а как сделать кнопки такие как в вашем проекте?

Цитата(furious @ 29.10.2009, 14:20

)

спс, но уже начал делать немного по-другому, пока получается.