Tin học Phần mềm Paint viết bằng.......Pascal !

trà nguyễn hữu nghĩa · 4 Tháng tám 2018

Tống Huy said:
Anh giỏi quá ! =)
Cái gì cũng giỏi
Em mượn code nhé ! ( Xin để tránh lỗi bản quyền )

Mượn là sao

Tống Huy · 4 Tháng tám 2018

trà nguyễn hữu nghĩa said:
Mượn là sao

Em nói vậy là để mượn dùng code đó =)

trà nguyễn hữu nghĩa · 4 Tháng tám 2018

Tống Huy said:
Em nói vậy là để mượn dùng code đó =)

dùng được không...........

Tống Huy · 4 Tháng tám 2018

trà nguyễn hữu nghĩa said:
dùng được không...........

Em chưa dùng nữa =)
Bận quá ! Nhưng em sẽ dùng

Bùi Thành Công · 7 Tháng tám 2018

trà nguyễn hữu nghĩa said:

Bây giờ mới thấy Pascal nó lợi hại đến mức nào. Cả Paint mà nó cũng làm được luôn nè

Mã:

 Program Paint;
 uses crt,dos,graph;
 const
      _Line = 1;
      _Rectangle = 2;
      _Ellipse = 3;
      _Free = 4;
      _Fill = 5;
      _Clear = 6;

      _MnX = 5;
      _MnY = 105;
      _MxX = 635;
      _MxY = 455;

 type TPoint = record
               X1,Y1,X2,Y2: integer;
               N: integer;
               end;

 var gd,gm: integer;
     Pt,Pm: TPoint;
     Shape : integer;
     Col: Word;
     Size: integer;
     k: char;
     f: Text;

 function mousex:word;assembler;asm
 mov ax,3; int 33h; mov ax,cx end;

 function mousey:word;assembler;asm
 mov ax,3; int 33h; mov ax,dx end;

 function leftclick:boolean;assembler;asm
 mov ax,3; int 33h; and bx,1; mov ax,bx end;

 function MouseArea(x1,y1,x2,y2:word):boolean;
 begin
 if     (LeftClick)
        and (mousex >=x1)
        and (mousex <=x2)
        and (mousey >=y1)
        and (mousey <=y2)
 then mousearea:=true
 else mousearea:=false;
 end;

 Function InitMouse : boolean;
 var r: registers;
 Begin
 r.ax:=$00;intr($33,r);
 if r.ax<>0 then InitMouse:=true
 else InitMouse:=false;
 End;

 Procedure ShowMouse;
 Var r: registers;
 begin
 r.ax:=$01;intr($33,r);
 End;

 Procedure HideMouse;
 Var r:registers;
 Begin
 r.ax:=$002;
 intr($33,r);
 End;

 Function PointNear(Cx,Cy: integer): Boolean;
 var x,y: integer;
 Begin
      PointNear := False;
      for x := Cx - 5 to Cx + 5 do
          for y := Cy - 5 to Cy + 5 do
          if (Mousex = x) and (Mousey = y) then PointNear := True;
 End;

 Procedure DrawMouse;
 var x,y: string;
 Begin
      if (Mousex <> Pm.X1) or (Mousey <> Pm.Y1) then
      begin
      SetFillStyle(1,Black);
      Bar(0,_MxY+5,639,479);
      Str(Mousex-_MnX,X);
      Str(Mousey-_MnY,y);
      Pm.X1 := Mousex;
      Pm.Y1 := Mousey;
      OutTextXy(10,_MxY+10,X+' , ' + Y);
      end;
 End;

 Procedure Choose(sh: integer);
 Begin
      HideMouse;
      SetFillStyle(1,Black);
      Bar(_MnX,81,_MxX,_MnY-7);

      SetLineStyle(0,0,1);
      SetFillStyle(1,Red);
      SetColor(Red);
      FillEllipse((sh-1)*80+40,90,5,5);
      ShowMouse;
 End;

 Procedure DrawShape;
 Begin
      SetColor(White);
      SetLineStyle(0,0,3);
      RecTangle(0,0,639,_MnY-5);
      RecTangle(0,_MnY-5,639,_MxY+5);

      SetLineStyle(0,0,1);

      RecTangle(10,20,70,80);
      RecTangle(90,20,150,80);
      RecTangle(170,20,230,80);
      RecTangle(250,20,310,80);
      RecTangle(330,20,390,80);
      RecTangle(410,20,470,80);
      RecTangle(490,20,550,80);
      RecTangle(570,20,630,80);

      SetLineStyle(0,0,3);
      Line(15,25,65,75);
      Rectangle(100,30,140,70);
      Circle(200,50,20);
      Line(255,25,270,35);
      Line(270,35,263,55);
      Line(263,55,305,75);
      SetFillStyle(1,White);
      Bar(350,40,370,70);
      Bar(340,30,370,40);

      SetFillStyle(1,Col);
      Bar(420,30,460,70);

      SetFillStyle(1,White);
      FillEllipse(520,50,Size*7,Size*7);

      OutTextXy(580,45,'Clear');
 End;

 Procedure Draw;
 Begin
      HideMouse;
      SetColor(White);
      SetLineStyle(0,0,Size);
      case Shape of
      _Line: if Pt.N = 2 then begin Line(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);Pt.N := 0;end;
      _RecTangle: if Pt.N = 2 then begin RecTangle(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);Pt.N := 0;end;
      _Ellipse: if Pt.N = 2 then begin Ellipse((Pt.X1+Pt.X2) div 2,
      (Pt.Y1+Pt.Y2) div 2,0,360,
      abs(Pt.X2 - Pt.X1) div 2,abs(Pt.Y2 - Pt.Y1) div 2);
      PutPixel(Pt.X1,Pt.Y1,Black);Pt.N := 0;end;
      _Free: if (Pt.N <> 0) and (Pt.X2 > 1) then begin
             Line(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);
             if Pt.N = 2 then Pt.N := 0;end;
      _Fill: begin PutPixel(Pt.X1,Pt.Y1,Col);
      SetFillStyle(1,Col);FloodFill(Pt.X1+1,Pt.Y1+1,White);Pt.N:=0;end;
      _Clear: if (Pt.N <> 0) and (Pt.X1 >= _MnX+3*Size)
      and (Pt.Y1 >= Size*3+_MnY) then begin SetFillStyle(1,Black);
      SetColor(Black);
              FillEllipse(Pt.X1,Pt.Y1,3*Size,3*Size);Pt.N := 0;end;
                 end;
      ShowMouse;
 End;

 Procedure GetShape;
 Begin
      if MouseArea(10,20,70,80) then begin Shape := _Line;Pt.N:=0;Choose(1);end
      else
      if MouseArea(90,20,150,80) then begin Shape := _RecTangle;Pt.N:=0;Choose(2);end
      else
      if MouseArea(170,20,230,80) then begin Shape := _Ellipse;PT.N:=0;Choose(3);end
      else
      if MouseArea(250,20,310,80) then begin Shape := _Free;Pt.X2 := 0;Pt.N:=0;choose(4);end
      else
      if MouseArea(330,20,390,80) then begin Shape := _Fill;Pt.N:=0;choose(5);end
      else
      if MouseArea(410,20,470,80) then
      begin
           inc(col);
           if col > 15 then Col := 1;

           HideMouse;
           SetFillStyle(1,Col);
           Bar(420,30,460,70);
           ShowMouse;
      end
      else
      if MouseArea(490,20,550,80) then
      begin
           inc(Size,2);
           if Size > 3 then Size := 1;

           HideMouse;
           SetFillStyle(1,Black);
           Bar(491,21,549,79);
           SetFillStyle(1,white);
           SetColor(White);
           FillEllipse(520,50,Size*7,Size*7);
           ShowMouse;
      end
      else
      if MouseArea(570,20,630,80) then begin Shape := _Clear;Pt.N:=0;Choose(8);end;
 End;

 Procedure GetPoint;
 Begin
      if LeftClick then
      begin
           if (Pt.N = 0) and not PointNear(Pt.X2,Pt.Y2) then
           begin Pt.X1 := Mousex-1;Pt.Y1 := Mousey-1;
           Pt.N := 1;PutPixel(Mousex-1,Mousey-1,White);end
           else
           if (Pt.N = 1) and not PointNear(Pt.X1,Pt.Y1) then
           begin Pt.X2 := Mousex;Pt.Y2 := Mousey;
           Pt.N := 2;end;
      end;
      Draw;
 End;

 Procedure Save;
 var x,y,c: integer;
 Begin
      HideMouse;
      OutTextXy(150,_MxY+10,'Saving...');
      ReWrite(f);
      for x := _MnX to _MxX do
          for y := _MnY to _MxY do
          begin
               c := GetPixel(x,y);
               writeln(f,c);
          end;
      Close(f);
      sound(1000);
      Delay(100);
      Nosound;
      ShowMouse;
      DrawMouse;
 End;

 Procedure Open;
 var x,y,c,code: integer;
     s: string;
 Begin
      HideMouse;
      Reset(f);
      OutTextXy(150,_MxY+10,'Opening...');
      for x := _MnX to _MxX do
          for y := _MnY to _MxY do
          begin
               Readln(f,s);
               Val(s,c,Code);
               if Code = 0 then
               PutPixel(x,y,c)
               else begin break;x := 635;end;
          end;
      Close(f);
      sound(1000);
      Delay(100);
      Nosound;
      ShowMouse;
      DrawMouse;
 End;

 Procedure Start;
 Begin
      Shape := _Line;
      Col := white;
      Size := 1;
      Pt.N := 0;
      Choose(1);
      Assign(f,'Picture.txt');
 End;

 BEGIN
      InitGraph(gd,gm,'');
      InitMouse;
      ShowMouse;
      Start;
      DrawShape;
      repeat
      if (Mousex >= _MnX) and (MouseX <= _MxX) and
      (Mousey >= _MnY) and (Mousey <= _MxY) then
      DrawMouse;
      k := #0;
      if Keypressed then k := readkey;
      GetShape;
      if MouseArea(_MnX,_MnY,_MxX,_MxY) then
      GetPoint;
      if k = 's' then Save
      else if k = 'o' then Open;
      until k = #27;
      CloseGraph;
 END.

View attachment 63449

Từ trái sang phải lần lượt là
1) Đường thẳng: Cần tọa độ 2 điểm để vẽ. Các bạn chấm 2 điểm thì nó sẽ vẽ một đường màu trắng, không có màu khác nha.
2) Hình chữ nhật: Cũng cần tọa độ 2 điểm để vẽ, đó là tọa độ 2 đỉnh đối của hình chữ nhật.
3) Hình Ellipse: Cũng cần tọa độ 2 điểm để vẽ. Hình Ellipse vẽ được sẽ nội tiếp hình chữ nhật với 2 điểm mà mình đã chấm.
4) Vẽ tự do: Cứ mỗi lần Click chuột trên màn hình thì nó sẽ nối điểm trước đó với điểm mình Click, để Vẽ hình mới thì cần phải Click lại ô này một làn nữa.
5,6) Tô màu: Màu sắc sẽ được chọn ở ô thứ 6, Click vào hình kín để tô màu.
7) Kích thước đường: Click vào thì nó sẽ thay đổi kích thước đường mình vẽ ra.
8) Xóa: Click vào một điểm thì nó sẽ tạo một đường tròn màu đen có tâm là điểm mình Click để xóa hình.

Ngoài ra nó còn có thể Lưu hình mình vẽ rồi mở lên.
Bấm "s" để lưu hình,"o" để mở hình, sau khi thực hiện xong nó sẽ có tiếng "bip". Vì nó lưu hơi lâu nên mình làm vậy để biết khi nào nó làm xong.

Demo trước vài hình

View attachment 63451
(Cái này là lúc nó đang mở File)

View attachment 63452
(Cái này là nó mở xong rồi, mình vẽ trước rồi lưu lại

)

View attachment 63453
(Cái này là mình chọn chế độ Xóa)

À quên nữa.....Bấm ESC để thoát chương trình nha

@ka1412 , @Nguyễn Tùng Ân

bạn ơi, bạn viết code hiện để điều khiển và hiện chuột cho mình đk ko, thanks bạn nhiều.

trà nguyễn hữu nghĩa · 7 Tháng tám 2018

Bùi Thành Công said:
bạn ơi, bạn viết code hiện để điều khiển và hiện chuột cho mình đk ko, thanks bạn nhiều.

Mã:

function mousex:word;assembler;asm
 mov ax,3; int 33h; mov ax,cx end;

 function mousey:word;assembler;asm
 mov ax,3; int 33h; mov ax,dx end;

 function leftclick:boolean;assembler;asm
 mov ax,3; int 33h; and bx,1; mov ax,bx end;

 function MouseArea(x1,y1,x2,y2:word):boolean; {sự kiện click chuột vào một vị trí nào đó}
 begin
 if     (LeftClick)
        and (mousex >=x1)
        and (mousex <=x2)
        and (mousey >=y1)
        and (mousey <=y2)
 then mousearea:=true
 else mousearea:=false;
 end;

 Function InitMouse : boolean; {khởi tạo chuột ở giữa màn hình}
 var r: registers;
 Begin
 r.ax:=$00;intr($33,r);
 if r.ax<>0 then InitMouse:=true
 else InitMouse:=false;
 End;

 Procedure ShowMouse; {hiện chuột}
 Var r: registers;
 begin
 r.ax:=$01;intr($33,r);
 End;

 Procedure HideMouse; {Ẩn chuột}
 Var r:registers;
 Begin
 r.ax:=$002;
 intr($33,r);
 End;

Bùi Thành Công · 7 Tháng tám 2018

trà nguyễn hữu nghĩa said:

Mã:

function mousex:word;assembler;asm
 mov ax,3; int 33h; mov ax,cx end;

 function mousey:word;assembler;asm
 mov ax,3; int 33h; mov ax,dx end;

 function leftclick:boolean;assembler;asm
 mov ax,3; int 33h; and bx,1; mov ax,bx end;

 function MouseArea(x1,y1,x2,y2:word):boolean; {sự kiện click chuột vào một vị trí nào đó}
 begin
 if     (LeftClick)
        and (mousex >=x1)
        and (mousex <=x2)
        and (mousey >=y1)
        and (mousey <=y2)
 then mousearea:=true
 else mousearea:=false;
 end;

 Function InitMouse : boolean; {khởi tạo chuột ở giữa màn hình}
 var r: registers;
 Begin
 r.ax:=$00;intr($33,r);
 if r.ax<>0 then InitMouse:=true
 else InitMouse:=false;
 End;

 Procedure ShowMouse; {hiện chuột}
 Var r: registers;
 begin
 r.ax:=$01;intr($33,r);
 End;

 Procedure HideMouse; {Ẩn chuột}
 Var r:registers;
 Begin
 r.ax:=$002;
 intr($33,r);
 End;

cảm ơn nha

Võ Thế Anh · 30 Tháng chín 2018

trà nguyễn hữu nghĩa said:

Bây giờ mới thấy Pascal nó lợi hại đến mức nào. Cả Paint mà nó cũng làm được luôn nè

Mã:

 Program Paint;
 uses crt,dos,graph;
 const
      _Line = 1;
      _Rectangle = 2;
      _Ellipse = 3;
      _Free = 4;
      _Fill = 5;
      _Clear = 6;

      _MnX = 5;
      _MnY = 105;
      _MxX = 635;
      _MxY = 455;

 type TPoint = record
               X1,Y1,X2,Y2: integer;
               N: integer;
               end;

 var gd,gm: integer;
     Pt,Pm: TPoint;
     Shape : integer;
     Col: Word;
     Size: integer;
     k: char;
     f: Text;

 function mousex:word;assembler;asm
 mov ax,3; int 33h; mov ax,cx end;

 function mousey:word;assembler;asm
 mov ax,3; int 33h; mov ax,dx end;

 function leftclick:boolean;assembler;asm
 mov ax,3; int 33h; and bx,1; mov ax,bx end;

 function MouseArea(x1,y1,x2,y2:word):boolean;
 begin
 if     (LeftClick)
        and (mousex >=x1)
        and (mousex <=x2)
        and (mousey >=y1)
        and (mousey <=y2)
 then mousearea:=true
 else mousearea:=false;
 end;

 Function InitMouse : boolean;
 var r: registers;
 Begin
 r.ax:=$00;intr($33,r);
 if r.ax<>0 then InitMouse:=true
 else InitMouse:=false;
 End;

 Procedure ShowMouse;
 Var r: registers;
 begin
 r.ax:=$01;intr($33,r);
 End;

 Procedure HideMouse;
 Var r:registers;
 Begin
 r.ax:=$002;
 intr($33,r);
 End;

 Function PointNear(Cx,Cy: integer): Boolean;
 var x,y: integer;
 Begin
      PointNear := False;
      for x := Cx - 5 to Cx + 5 do
          for y := Cy - 5 to Cy + 5 do
          if (Mousex = x) and (Mousey = y) then PointNear := True;
 End;

 Procedure DrawMouse;
 var x,y: string;
 Begin
      if (Mousex <> Pm.X1) or (Mousey <> Pm.Y1) then
      begin
      SetFillStyle(1,Black);
      Bar(0,_MxY+5,639,479);
      Str(Mousex-_MnX,X);
      Str(Mousey-_MnY,y);
      Pm.X1 := Mousex;
      Pm.Y1 := Mousey;
      OutTextXy(10,_MxY+10,X+' , ' + Y);
      end;
 End;

 Procedure Choose(sh: integer);
 Begin
      HideMouse;
      SetFillStyle(1,Black);
      Bar(_MnX,81,_MxX,_MnY-7);

      SetLineStyle(0,0,1);
      SetFillStyle(1,Red);
      SetColor(Red);
      FillEllipse((sh-1)*80+40,90,5,5);
      ShowMouse;
 End;

 Procedure DrawShape;
 Begin
      SetColor(White);
      SetLineStyle(0,0,3);
      RecTangle(0,0,639,_MnY-5);
      RecTangle(0,_MnY-5,639,_MxY+5);

      SetLineStyle(0,0,1);

      RecTangle(10,20,70,80);
      RecTangle(90,20,150,80);
      RecTangle(170,20,230,80);
      RecTangle(250,20,310,80);
      RecTangle(330,20,390,80);
      RecTangle(410,20,470,80);
      RecTangle(490,20,550,80);
      RecTangle(570,20,630,80);

      SetLineStyle(0,0,3);
      Line(15,25,65,75);
      Rectangle(100,30,140,70);
      Circle(200,50,20);
      Line(255,25,270,35);
      Line(270,35,263,55);
      Line(263,55,305,75);
      SetFillStyle(1,White);
      Bar(350,40,370,70);
      Bar(340,30,370,40);

      SetFillStyle(1,Col);
      Bar(420,30,460,70);

      SetFillStyle(1,White);
      FillEllipse(520,50,Size*7,Size*7);

      OutTextXy(580,45,'Clear');
 End;

 Procedure Draw;
 Begin
      HideMouse;
      SetColor(White);
      SetLineStyle(0,0,Size);
      case Shape of
      _Line: if Pt.N = 2 then begin Line(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);Pt.N := 0;end;
      _RecTangle: if Pt.N = 2 then begin RecTangle(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);Pt.N := 0;end;
      _Ellipse: if Pt.N = 2 then begin Ellipse((Pt.X1+Pt.X2) div 2,
      (Pt.Y1+Pt.Y2) div 2,0,360,
      abs(Pt.X2 - Pt.X1) div 2,abs(Pt.Y2 - Pt.Y1) div 2);
      PutPixel(Pt.X1,Pt.Y1,Black);Pt.N := 0;end;
      _Free: if (Pt.N <> 0) and (Pt.X2 > 1) then begin
             Line(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);
             if Pt.N = 2 then Pt.N := 0;end;
      _Fill: begin PutPixel(Pt.X1,Pt.Y1,Col);
      SetFillStyle(1,Col);FloodFill(Pt.X1+1,Pt.Y1+1,White);Pt.N:=0;end;
      _Clear: if (Pt.N <> 0) and (Pt.X1 >= _MnX+3*Size)
      and (Pt.Y1 >= Size*3+_MnY) then begin SetFillStyle(1,Black);
      SetColor(Black);
              FillEllipse(Pt.X1,Pt.Y1,3*Size,3*Size);Pt.N := 0;end;
                 end;
      ShowMouse;
 End;

 Procedure GetShape;
 Begin
      if MouseArea(10,20,70,80) then begin Shape := _Line;Pt.N:=0;Choose(1);end
      else
      if MouseArea(90,20,150,80) then begin Shape := _RecTangle;Pt.N:=0;Choose(2);end
      else
      if MouseArea(170,20,230,80) then begin Shape := _Ellipse;PT.N:=0;Choose(3);end
      else
      if MouseArea(250,20,310,80) then begin Shape := _Free;Pt.X2 := 0;Pt.N:=0;choose(4);end
      else
      if MouseArea(330,20,390,80) then begin Shape := _Fill;Pt.N:=0;choose(5);end
      else
      if MouseArea(410,20,470,80) then
      begin
           inc(col);
           if col > 15 then Col := 1;

           HideMouse;
           SetFillStyle(1,Col);
           Bar(420,30,460,70);
           ShowMouse;
      end
      else
      if MouseArea(490,20,550,80) then
      begin
           inc(Size,2);
           if Size > 3 then Size := 1;

           HideMouse;
           SetFillStyle(1,Black);
           Bar(491,21,549,79);
           SetFillStyle(1,white);
           SetColor(White);
           FillEllipse(520,50,Size*7,Size*7);
           ShowMouse;
      end
      else
      if MouseArea(570,20,630,80) then begin Shape := _Clear;Pt.N:=0;Choose(8);end;
 End;

 Procedure GetPoint;
 Begin
      if LeftClick then
      begin
           if (Pt.N = 0) and not PointNear(Pt.X2,Pt.Y2) then
           begin Pt.X1 := Mousex-1;Pt.Y1 := Mousey-1;
           Pt.N := 1;PutPixel(Mousex-1,Mousey-1,White);end
           else
           if (Pt.N = 1) and not PointNear(Pt.X1,Pt.Y1) then
           begin Pt.X2 := Mousex;Pt.Y2 := Mousey;
           Pt.N := 2;end;
      end;
      Draw;
 End;

 Procedure Save;
 var x,y,c: integer;
 Begin
      HideMouse;
      OutTextXy(150,_MxY+10,'Saving...');
      ReWrite(f);
      for x := _MnX to _MxX do
          for y := _MnY to _MxY do
          begin
               c := GetPixel(x,y);
               writeln(f,c);
          end;
      Close(f);
      sound(1000);
      Delay(100);
      Nosound;
      ShowMouse;
      DrawMouse;
 End;

 Procedure Open;
 var x,y,c,code: integer;
     s: string;
 Begin
      HideMouse;
      Reset(f);
      OutTextXy(150,_MxY+10,'Opening...');
      for x := _MnX to _MxX do
          for y := _MnY to _MxY do
          begin
               Readln(f,s);
               Val(s,c,Code);
               if Code = 0 then
               PutPixel(x,y,c)
               else begin break;x := 635;end;
          end;
      Close(f);
      sound(1000);
      Delay(100);
      Nosound;
      ShowMouse;
      DrawMouse;
 End;

 Procedure Start;
 Begin
      Shape := _Line;
      Col := white;
      Size := 1;
      Pt.N := 0;
      Choose(1);
      Assign(f,'Picture.txt');
 End;

 BEGIN
      InitGraph(gd,gm,'');
      InitMouse;
      ShowMouse;
      Start;
      DrawShape;
      repeat
      if (Mousex >= _MnX) and (MouseX <= _MxX) and
      (Mousey >= _MnY) and (Mousey <= _MxY) then
      DrawMouse;
      k := #0;
      if Keypressed then k := readkey;
      GetShape;
      if MouseArea(_MnX,_MnY,_MxX,_MxY) then
      GetPoint;
      if k = 's' then Save
      else if k = 'o' then Open;
      until k = #27;
      CloseGraph;
 END.

View attachment 63449

Từ trái sang phải lần lượt là
1) Đường thẳng: Cần tọa độ 2 điểm để vẽ. Các bạn chấm 2 điểm thì nó sẽ vẽ một đường màu trắng, không có màu khác nha.
2) Hình chữ nhật: Cũng cần tọa độ 2 điểm để vẽ, đó là tọa độ 2 đỉnh đối của hình chữ nhật.
3) Hình Ellipse: Cũng cần tọa độ 2 điểm để vẽ. Hình Ellipse vẽ được sẽ nội tiếp hình chữ nhật với 2 điểm mà mình đã chấm.
4) Vẽ tự do: Cứ mỗi lần Click chuột trên màn hình thì nó sẽ nối điểm trước đó với điểm mình Click, để Vẽ hình mới thì cần phải Click lại ô này một làn nữa.
5,6) Tô màu: Màu sắc sẽ được chọn ở ô thứ 6, Click vào hình kín để tô màu.
7) Kích thước đường: Click vào thì nó sẽ thay đổi kích thước đường mình vẽ ra.
8) Xóa: Click vào một điểm thì nó sẽ tạo một đường tròn màu đen có tâm là điểm mình Click để xóa hình.

Ngoài ra nó còn có thể Lưu hình mình vẽ rồi mở lên.
Bấm "s" để lưu hình,"o" để mở hình, sau khi thực hiện xong nó sẽ có tiếng "bip". Vì nó lưu hơi lâu nên mình làm vậy để biết khi nào nó làm xong.

Demo trước vài hình

View attachment 63451
(Cái này là lúc nó đang mở File)

View attachment 63452
(Cái này là nó mở xong rồi, mình vẽ trước rồi lưu lại

)

View attachment 63453
(Cái này là mình chọn chế độ Xóa)

À quên nữa.....Bấm ESC để thoát chương trình nha

@ka1412 , @Nguyễn Tùng Ân

sao em chạy ko được
nó hiện ra cái này nè

kaito kuroba · 4 Tháng một 2020

trà nguyễn hữu nghĩa said:

Bây giờ mới thấy Pascal nó lợi hại đến mức nào. Cả Paint mà nó cũng làm được luôn nè

Mã:

 Program Paint;
 uses crt,dos,graph;
 const
      _Line = 1;
      _Rectangle = 2;
      _Ellipse = 3;
      _Free = 4;
      _Fill = 5;
      _Clear = 6;

      _MnX = 5;
      _MnY = 105;
      _MxX = 635;
      _MxY = 455;

 type TPoint = record
               X1,Y1,X2,Y2: integer;
               N: integer;
               end;

 var gd,gm: integer;
     Pt,Pm: TPoint;
     Shape : integer;
     Col: Word;
     Size: integer;
     k: char;
     f: Text;

 function mousex:word;assembler;asm
 mov ax,3; int 33h; mov ax,cx end;

 function mousey:word;assembler;asm
 mov ax,3; int 33h; mov ax,dx end;

 function leftclick:boolean;assembler;asm
 mov ax,3; int 33h; and bx,1; mov ax,bx end;

 function MouseArea(x1,y1,x2,y2:word):boolean;
 begin
 if     (LeftClick)
        and (mousex >=x1)
        and (mousex <=x2)
        and (mousey >=y1)
        and (mousey <=y2)
 then mousearea:=true
 else mousearea:=false;
 end;

 Function InitMouse : boolean;
 var r: registers;
 Begin
 r.ax:=$00;intr($33,r);
 if r.ax<>0 then InitMouse:=true
 else InitMouse:=false;
 End;

 Procedure ShowMouse;
 Var r: registers;
 begin
 r.ax:=$01;intr($33,r);
 End;

 Procedure HideMouse;
 Var r:registers;
 Begin
 r.ax:=$002;
 intr($33,r);
 End;

 Function PointNear(Cx,Cy: integer): Boolean;
 var x,y: integer;
 Begin
      PointNear := False;
      for x := Cx - 5 to Cx + 5 do
          for y := Cy - 5 to Cy + 5 do
          if (Mousex = x) and (Mousey = y) then PointNear := True;
 End;

 Procedure DrawMouse;
 var x,y: string;
 Begin
      if (Mousex <> Pm.X1) or (Mousey <> Pm.Y1) then
      begin
      SetFillStyle(1,Black);
      Bar(0,_MxY+5,639,479);
      Str(Mousex-_MnX,X);
      Str(Mousey-_MnY,y);
      Pm.X1 := Mousex;
      Pm.Y1 := Mousey;
      OutTextXy(10,_MxY+10,X+' , ' + Y);
      end;
 End;

 Procedure Choose(sh: integer);
 Begin
      HideMouse;
      SetFillStyle(1,Black);
      Bar(_MnX,81,_MxX,_MnY-7);

      SetLineStyle(0,0,1);
      SetFillStyle(1,Red);
      SetColor(Red);
      FillEllipse((sh-1)*80+40,90,5,5);
      ShowMouse;
 End;

 Procedure DrawShape;
 Begin
      SetColor(White);
      SetLineStyle(0,0,3);
      RecTangle(0,0,639,_MnY-5);
      RecTangle(0,_MnY-5,639,_MxY+5);

      SetLineStyle(0,0,1);

      RecTangle(10,20,70,80);
      RecTangle(90,20,150,80);
      RecTangle(170,20,230,80);
      RecTangle(250,20,310,80);
      RecTangle(330,20,390,80);
      RecTangle(410,20,470,80);
      RecTangle(490,20,550,80);
      RecTangle(570,20,630,80);

      SetLineStyle(0,0,3);
      Line(15,25,65,75);
      Rectangle(100,30,140,70);
      Circle(200,50,20);
      Line(255,25,270,35);
      Line(270,35,263,55);
      Line(263,55,305,75);
      SetFillStyle(1,White);
      Bar(350,40,370,70);
      Bar(340,30,370,40);

      SetFillStyle(1,Col);
      Bar(420,30,460,70);

      SetFillStyle(1,White);
      FillEllipse(520,50,Size*7,Size*7);

      OutTextXy(580,45,'Clear');
 End;

 Procedure Draw;
 Begin
      HideMouse;
      SetColor(White);
      SetLineStyle(0,0,Size);
      case Shape of
      _Line: if Pt.N = 2 then begin Line(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);Pt.N := 0;end;
      _RecTangle: if Pt.N = 2 then begin RecTangle(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);Pt.N := 0;end;
      _Ellipse: if Pt.N = 2 then begin Ellipse((Pt.X1+Pt.X2) div 2,
      (Pt.Y1+Pt.Y2) div 2,0,360,
      abs(Pt.X2 - Pt.X1) div 2,abs(Pt.Y2 - Pt.Y1) div 2);
      PutPixel(Pt.X1,Pt.Y1,Black);Pt.N := 0;end;
      _Free: if (Pt.N <> 0) and (Pt.X2 > 1) then begin
             Line(Pt.X1,Pt.Y1,Pt.X2,Pt.Y2);
             if Pt.N = 2 then Pt.N := 0;end;
      _Fill: begin PutPixel(Pt.X1,Pt.Y1,Col);
      SetFillStyle(1,Col);FloodFill(Pt.X1+1,Pt.Y1+1,White);Pt.N:=0;end;
      _Clear: if (Pt.N <> 0) and (Pt.X1 >= _MnX+3*Size)
      and (Pt.Y1 >= Size*3+_MnY) then begin SetFillStyle(1,Black);
      SetColor(Black);
              FillEllipse(Pt.X1,Pt.Y1,3*Size,3*Size);Pt.N := 0;end;
                 end;
      ShowMouse;
 End;

 Procedure GetShape;
 Begin
      if MouseArea(10,20,70,80) then begin Shape := _Line;Pt.N:=0;Choose(1);end
      else
      if MouseArea(90,20,150,80) then begin Shape := _RecTangle;Pt.N:=0;Choose(2);end
      else
      if MouseArea(170,20,230,80) then begin Shape := _Ellipse;PT.N:=0;Choose(3);end
      else
      if MouseArea(250,20,310,80) then begin Shape := _Free;Pt.X2 := 0;Pt.N:=0;choose(4);end
      else
      if MouseArea(330,20,390,80) then begin Shape := _Fill;Pt.N:=0;choose(5);end
      else
      if MouseArea(410,20,470,80) then
      begin
           inc(col);
           if col > 15 then Col := 1;

           HideMouse;
           SetFillStyle(1,Col);
           Bar(420,30,460,70);
           ShowMouse;
      end
      else
      if MouseArea(490,20,550,80) then
      begin
           inc(Size,2);
           if Size > 3 then Size := 1;

           HideMouse;
           SetFillStyle(1,Black);
           Bar(491,21,549,79);
           SetFillStyle(1,white);
           SetColor(White);
           FillEllipse(520,50,Size*7,Size*7);
           ShowMouse;
      end
      else
      if MouseArea(570,20,630,80) then begin Shape := _Clear;Pt.N:=0;Choose(8);end;
 End;

 Procedure GetPoint;
 Begin
      if LeftClick then
      begin
           if (Pt.N = 0) and not PointNear(Pt.X2,Pt.Y2) then
           begin Pt.X1 := Mousex-1;Pt.Y1 := Mousey-1;
           Pt.N := 1;PutPixel(Mousex-1,Mousey-1,White);end
           else
           if (Pt.N = 1) and not PointNear(Pt.X1,Pt.Y1) then
           begin Pt.X2 := Mousex;Pt.Y2 := Mousey;
           Pt.N := 2;end;
      end;
      Draw;
 End;

 Procedure Save;
 var x,y,c: integer;
 Begin
      HideMouse;
      OutTextXy(150,_MxY+10,'Saving...');
      ReWrite(f);
      for x := _MnX to _MxX do
          for y := _MnY to _MxY do
          begin
               c := GetPixel(x,y);
               writeln(f,c);
          end;
      Close(f);
      sound(1000);
      Delay(100);
      Nosound;
      ShowMouse;
      DrawMouse;
 End;

 Procedure Open;
 var x,y,c,code: integer;
     s: string;
 Begin
      HideMouse;
      Reset(f);
      OutTextXy(150,_MxY+10,'Opening...');
      for x := _MnX to _MxX do
          for y := _MnY to _MxY do
          begin
               Readln(f,s);
               Val(s,c,Code);
               if Code = 0 then
               PutPixel(x,y,c)
               else begin break;x := 635;end;
          end;
      Close(f);
      sound(1000);
      Delay(100);
      Nosound;
      ShowMouse;
      DrawMouse;
 End;

 Procedure Start;
 Begin
      Shape := _Line;
      Col := white;
      Size := 1;
      Pt.N := 0;
      Choose(1);
      Assign(f,'Picture.txt');
 End;

 BEGIN
      InitGraph(gd,gm,'');
      InitMouse;
      ShowMouse;
      Start;
      DrawShape;
      repeat
      if (Mousex >= _MnX) and (MouseX <= _MxX) and
      (Mousey >= _MnY) and (Mousey <= _MxY) then
      DrawMouse;
      k := #0;
      if Keypressed then k := readkey;
      GetShape;
      if MouseArea(_MnX,_MnY,_MxX,_MxY) then
      GetPoint;
      if k = 's' then Save
      else if k = 'o' then Open;
      until k = #27;
      CloseGraph;
 END.

View attachment 63449

Từ trái sang phải lần lượt là
1) Đường thẳng: Cần tọa độ 2 điểm để vẽ. Các bạn chấm 2 điểm thì nó sẽ vẽ một đường màu trắng, không có màu khác nha.
2) Hình chữ nhật: Cũng cần tọa độ 2 điểm để vẽ, đó là tọa độ 2 đỉnh đối của hình chữ nhật.
3) Hình Ellipse: Cũng cần tọa độ 2 điểm để vẽ. Hình Ellipse vẽ được sẽ nội tiếp hình chữ nhật với 2 điểm mà mình đã chấm.
4) Vẽ tự do: Cứ mỗi lần Click chuột trên màn hình thì nó sẽ nối điểm trước đó với điểm mình Click, để Vẽ hình mới thì cần phải Click lại ô này một làn nữa.
5,6) Tô màu: Màu sắc sẽ được chọn ở ô thứ 6, Click vào hình kín để tô màu.
7) Kích thước đường: Click vào thì nó sẽ thay đổi kích thước đường mình vẽ ra.
8) Xóa: Click vào một điểm thì nó sẽ tạo một đường tròn màu đen có tâm là điểm mình Click để xóa hình.

Ngoài ra nó còn có thể Lưu hình mình vẽ rồi mở lên.
Bấm "s" để lưu hình,"o" để mở hình, sau khi thực hiện xong nó sẽ có tiếng "bip". Vì nó lưu hơi lâu nên mình làm vậy để biết khi nào nó làm xong.

Demo trước vài hình

View attachment 63451
(Cái này là lúc nó đang mở File)

View attachment 63452
(Cái này là nó mở xong rồi, mình vẽ trước rồi lưu lại

)

View attachment 63453
(Cái này là mình chọn chế độ Xóa)

À quên nữa.....Bấm ESC để thoát chương trình nha

@ka1412 , @Nguyễn Tùng Ân

Tìm kiếm

Tìm kiếm

Tin học Phần mềm Paint viết bằng.......Pascal !

trà nguyễn hữu nghĩa

Cựu Mod Vật Lí |Cây bút Thơ|Thần tượng VH

Tống Huy

Cựu TMod Cộng đồng

trà nguyễn hữu nghĩa

Cựu Mod Vật Lí |Cây bút Thơ|Thần tượng VH

Tống Huy

Cựu TMod Cộng đồng

Bùi Thành Công

Học sinh

trà nguyễn hữu nghĩa

Cựu Mod Vật Lí |Cây bút Thơ|Thần tượng VH

Bùi Thành Công

Học sinh

Võ Thế Anh

Học sinh chăm học

kaito kuroba

Học sinh mới