⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.~pas

📁 delphi 2d simple drawer
💻 ~PAS
字号:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Linia: TButton;
    Lamana: TButton;
    RysujKolo: TButton;
    RuchMyszy: TButton;
    Prostokat: TButton;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Label4: TLabel;
    CheckBoxWypelnij: TCheckBox;
    Image6: TImage;
    procedure klik(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure LiniaClick(Sender: TObject);
    procedure LamanaClick(Sender: TObject);
    procedure RysujKoloClick(Sender: TObject);
    procedure ruch(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure klik2(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RuchMyszyClick(Sender: TObject);
    procedure linia2(Sender: TObject; X1, Y1, X2, Y2 : integer);
    procedure ProstokatClick(Sender: TObject);
    procedure Image2Click(Sender: TObject);
    procedure Image3Click(Sender: TObject);
    procedure Image4Click(Sender: TObject);
    procedure Image5Click(Sender: TObject);
    procedure Image6Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure WypelnijObszar(Sender: TObject; x, y : integer);
  private
    { Private declarations }

    P : TPoint;
    clik : integer;
    wybor : integer;
    krok1 : integer;
    licz, A, B : integer;
    Tab : array [0..3] of integer;
    Kolor : TColor;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.klik(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     clik:=1;
     P.X:=X;
     P.Y:=Y;
     if ((wybor=0) or (wybor=1)) and (CheckBoxWypelnij.Checked = false) then //and (wybor<>4) then
     begin
        Tab[licz] := X;
        inc(licz);
        Tab[licz]:=Y;
        inc(licz);
        Image1.Picture.Bitmap.Canvas.Pixels[X,Y]:=Kolor;
     end;
     if (licz=2) and (krok1<>1) and (wybor=1) and (CheckBoxWypelnij.Checked = false) then
     begin
        krok1:=0;
        licz:=2;
        linia2(Image1,Tab[2],Tab[3],Tab[0],Tab[1]);

     end;
     if (licz=4) and ((wybor=0) or (wybor=1)) and (CheckBoxWypelnij.Checked = false) then //and (wybor<>4) then
     begin
        krok1:=0;
        licz:=0;
        linia2(Image1,Tab[0],Tab[1],Tab[2],Tab[3]);
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i, j : integer;
begin
Image1.Canvas.Pixels[0,0];

for i := 0 to Image2.Height -1 do
begin
   for j := 0 to Image2.Width - 1 do
   begin
      Image2.Canvas.Pixels[i, j] := clRed;
      Image3.Canvas.Pixels[i, j] := clGreen;
      Image4.Canvas.Pixels[i, j] := clBlue;
      Image5.Canvas.Pixels[i, j] := clYellow;
      Image6.Canvas.Pixels[i, j] := clBlack;
    end;
end;
Kolor := 0 ;
licz:=0;
krok1:=1;
wybor := 0;
clik:=0;
A := -1000;
B := -1000;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Image1.Picture.Bitmap:=nil;
     Image1.Canvas.Pixels[0,0];
     krok1:=1;
     licz:=0;
     wybor := 0;
     clik:=0;
     A := -1000;
     B := -1000;
end;

procedure TForm1.LiniaClick(Sender: TObject);
begin
  wybor := 0;
end;

procedure TForm1.LamanaClick(Sender: TObject);
begin
  wybor := 1;
end;

procedure TForm1.RysujKoloClick(Sender: TObject);
begin
  wybor:=4;
end;

procedure TForm1.ruch(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var xk,yk,r:integer;
i:real ;
farba : TColor;
begin
      if (clik=1) then
      begin
         if CheckBoxWypelnij.Checked = false then
         begin
          case wybor of
            2 :
            begin
              Image1.Picture.Bitmap.Canvas.Pixels[X,Y]:=Kolor;
              Image1.Picture.Bitmap.Canvas.Pixels[X+1,Y+1]:=Kolor;
              Image1.Picture.Bitmap.Canvas.Pixels[X-1,Y-1]:=Kolor;
              Image1.Picture.Bitmap.Canvas.Pixels[X,Y+1]:=Kolor;
              Image1.Picture.Bitmap.Canvas.Pixels[X+1,Y]:=Kolor;
              Image1.Picture.Bitmap.Canvas.Pixels[X,Y-1]:=Kolor;
              Image1.Picture.Bitmap.Canvas.Pixels[X-1,Y]:=Kolor;
              Image1.Picture.Bitmap.Canvas.Pixels[X-1,Y+1]:=Kolor;
              Image1.Picture.Bitmap.Canvas.Pixels[X+1,Y-1]:=Kolor;
            end;
            3:
            begin
              if A<>-1000 then
              begin
                if (A<>X) or (B<>Y) then
                begin
                  farba:=Kolor;
                  Kolor:=clWhite;
                  linia2(Image1,P.X,P.Y,P.X,B);
                  linia2(Image1,P.X,P.Y,A,P.Y);
                  linia2(Image1,A,B,P.X,B);
                  linia2(Image1,A,P.Y,A,B);
                  Kolor:=farba;
                end;
              end;
              A:=X;
              B:=Y;
              linia2(Image1,P.X,P.Y,P.X,Y);
              linia2(Image1,P.X,P.Y,X,P.Y);
              linia2(Image1,X,P.Y,X,Y);
              linia2(Image1,X,Y,P.X,Y);
            end;
            4:
            begin
              if A<>-1000 then
              begin
                if (A<>X) or (B<>Y) then
                begin
                   i:=-1;
                   r:=round(abs(sqrt(sqr(A-P.X)+sqr(B-P.Y))));
                   repeat
                    xk:=round(sin(i)*r);
                    yk:=round(cos(i)*r);
                    i:=i+1/(r);
                    Image1.Picture.Bitmap.Canvas.Pixels[xk+P.X,yk+P.Y]:=clWhite;
                   until i>2*pi ;
                end;
              end;
              A:=X;
              B:=Y;
              i:=-1;
              r:=round(abs(sqrt(sqr(X-P.X)+sqr(Y-P.Y))));
              repeat
                xk:=round(sin(i)*r);
                yk:=round(cos(i)*r);
                i:=i+1/(r);
                Image1.Picture.Bitmap.Canvas.Pixels[xk+P.X,yk+P.Y]:=Kolor;
              until i>2*pi ;
            end;
          end;
         end;
      end;
end;

procedure TForm1.klik2(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    clik:=0;
    A:=0;
    B:=0;
end;

procedure TForm1.RuchMyszyClick(Sender: TObject);
begin
    wybor :=2;
end;
procedure TForm1.linia2(Sender: TObject; X1, Y1, X2, Y2 : integer);
var i, m : integer;
    j : real;
begin
   if (X1<>X2) or (Y1<>Y2) then
   begin
   if abs(X1-X2) > abs(Y1-Y2) then
      m := abs(X1 - X2)
   else
      m := abs(Y1-Y2);
   for i := 0 to m do
      begin
          j := i / m;
          Image1.Picture.Bitmap.Canvas.Pixels[X1 + round((X2-X1)*j), Y1 + round((Y2-Y1)*j)] := Kolor;
      end;
   end;
end;

procedure TForm1.ProstokatClick(Sender: TObject);
begin
    wybor := 3;
end;

procedure TForm1.Image2Click(Sender: TObject);
begin
    Kolor := clred;
end;

procedure TForm1.Image3Click(Sender: TObject);
begin
   Kolor := clGreen;
end;

procedure TForm1.Image4Click(Sender: TObject);
begin
   Kolor := clBlue;
end;

procedure TForm1.Image5Click(Sender: TObject);
begin
   Kolor := clYellow;
end;

procedure TForm1.Image6Click(Sender: TObject);
begin
   Kolor := clBlack;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
   if CheckBoxWypelnij.Checked = true then
   begin
      WypelnijObszar(Image1, p.x, p.y);

   end;
end;

procedure TForm1.WypelnijObszar(Sender: TObject; x, y : integer);
var   kk : TColor;
begin
   kk := Image1.Canvas.Pixels[x, y];
   Image1.Canvas.Pixels[x, y] := Kolor;
   if  Image1.Canvas.Pixels[x + 1, y] = kk then
   begin
       WypelnijObszar(Image1, x + 1, y);
   end;
   if  Image1.Canvas.Pixels[x - 1, y] = kk then
   begin
       WypelnijObszar(Image1, x - 1, y);
   end ;
   if  Image1.Canvas.Pixels[x, y + 1] = kk then
   begin
       WypelnijObszar(Image1, x, y + 1);
   end ;
   if Image1.Canvas.Pixels[x, y - 1] = kk then
   begin
       WypelnijObszar(Image1, x, y - 1);
   end;
end;
                              
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -