PDA

View Full Version : ابزار پاكن فقط بتواند خطوط مشكي را پاك كند


khanboloky
پنج شنبه 04 تیر 1388, 12:19 عصر
PAINT را در دلفي استفاده ميکنم وکد نويسي انرا در زير نوشته ام به کدنويسي احتياج دارم که درزير اعمال کنم وپاکن فقط نوشته هاي رنگ مشکي را از BITMAP :عصبانی++: پاک کند .با تشکر.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ToolWin, ComCtrls, ExtCtrls, Buttons, StdCtrls, ExtDlgs,
ImgList, jpeg, Grids;

type
TDrawingTool = (dtPencil, dtLine, dtRectangle, dtEllipse, dtRoundRect, dtArc, dtBrush, dtErase);
TForm1 = class(TForm)
StatusBar: TStatusBar;
ToolBar1: TToolBar;
MainMenu: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
N1: TMenuItem;
PrintSetup1: TMenuItem;
Print1: TMenuItem;
N2: TMenuItem;
SaveAs1: TMenuItem;
Save1: TMenuItem;
Open1: TMenuItem;
New1: TMenuItem;
OpenPictureDialog: TOpenPictureDialog;
ToolBox: TPanel;
Free: TSpeedButton;
Select: TSpeedButton;
Eraser: TSpeedButton;
FillWithColor: TSpeedButton;
PickColor: TSpeedButton;
Magnifier: TSpeedButton;
Pencil: TSpeedButton;
Brush: TSpeedButton;
AirBrush: TSpeedButton;
Text: TSpeedButton;
Line: TSpeedButton;
Curve: TSpeedButton;
Rectangle: TSpeedButton;
Polygon: TSpeedButton;
Ellipse: TSpeedButton;
RoundedRectangle: TSpeedButton;
Details: TPanel;
Edit1: TMenuItem;
Pastfrom: TMenuItem;
Copyto: TMenuItem;
N4: TMenuItem;
clear: TMenuItem;
Paste1: TMenuItem;
Copy1: TMenuItem;
Cut1: TMenuItem;
N5: TMenuItem;
Repeatcommand1: TMenuItem;
Undo1: TMenuItem;
View1: TMenuItem;
ToolBox1: TMenuItem;
ColorBox1: TMenuItem;
StatusBar2: TMenuItem;
extToolbar1: TMenuItem;
N3: TMenuItem;
Zoom1: TMenuItem;
ViewBitmap1: TMenuItem;
NormalSize1: TMenuItem;
LargeSize1: TMenuItem;
Custom1: TMenuItem;
N6: TMenuItem;
ShowGrid1: TMenuItem;
ShowThumbnail1: TMenuItem;
Image2: TMenuItem;
FlipRotate1: TMenuItem;
Stretchskew1: TMenuItem;
InvertColors1: TMenuItem;
Attributes1: TMenuItem;
ClearImage1: TMenuItem;
DrawOpaque1: TMenuItem;
Colors1: TMenuItem;
EditColors1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
N7: TMenuItem;
HelpTopics1: TMenuItem;
SavePictureDialog: TSavePictureDialog;
FontDialog: TFontDialog;
Panelimage: TPanel;
Image: TImage;
ColorDialog: TColorDialog;
Panel1: TPanel;
Forground: TPanel;
BackGround: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Panel8: TPanel;
Panel9: TPanel;
Panel10: TPanel;
Panel11: TPanel;
Panel12: TPanel;
Panel13: TPanel;
Panel14: TPanel;
Panel15: TPanel;
Panel16: TPanel;
Panel17: TPanel;
Panel18: TPanel;
Panel19: TPanel;
Panel20: TPanel;
Panel21: TPanel;
Panel22: TPanel;
Panel23: TPanel;
Panel24: TPanel;
Panel25: TPanel;
Panel26: TPanel;
Panel27: TPanel;
Panel28: TPanel;
Panel29: TPanel;
Panel30: TPanel;
Panel31: TPanel;
ImageList1: TImageList;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure FormCreate(Sender: TObject);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure Open1Click(Sender: TObject);
procedure FreeClick(Sender: TObject);
procedure AirBrushClick(Sender: TObject);
procedure BrushClick(Sender: TObject);
procedure CurveClick(Sender: TObject);
procedure EllipseClick(Sender: TObject);
procedure EraserClick(Sender: TObject);
procedure FillWithColorClick(Sender: TObject);
procedure LineClick(Sender: TObject);
procedure MagnifierClick(Sender: TObject);
procedure PencilClick(Sender: TObject);
procedure PickColorClick(Sender: TObject);
procedure PolygonClick(Sender: TObject);
procedure RectangleClick(Sender: TObject);
procedure RoundedRectangleClick(Sender: TObject);
procedure SelectClick(Sender: TObject);
procedure TextClick(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure SaveAs1Click(Sender: TObject);
procedure Copy1Click(Sender: TObject);
procedure Cut1Click(Sender: TObject);
procedure EditColors1Click(Sender: TObject);
procedure Edit7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel10MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel12MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel13MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel14Click(Sender: TObject);
procedure Panel15MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel16MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel17MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel18MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel19MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel20MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel21MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel22MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel23MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel24MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel25MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel26MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel27MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel28MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel29MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel30MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel31MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel6MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel8MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel9MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
// procedure Paste1Click(Sender: TObject);

private
{ Private declarations }
public
str : string ;
x1,y1 : integer ;
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);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := True;
Image.Canvas.MoveTo(X, Y);
Origin := Point(X, Y);
MovePt := Origin;
StatusBar.Panels[2].Text := ('1x1');

end;

procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Drawing then
begin
DrawShape(Origin, Point(X, Y), pmCopy);
Drawing := False;
end;
end;

procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (drawing) and ((drawingtool = dtRectangle )
or (drawingtool = dtEllipse )
or (drawingtool = dtRoundRect)
or (drawingtool = dtline)) then
begin
x1 := x - Origin.X ;
y1 := y - Origin.Y ;
StatusBar.Panels[1].Text := format('%d,%d', [Origin.x,Origin.Y]);
StatusBar.Panels[2].Text := format('%dx%d', [x1,y1]);
end;
if drawing = false then
begin
StatusBar.Panels[2].Text := '';
StatusBar.Panels[1].Text := format('%d,%d', [x,y]);
end;

if Drawing then
begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
// StatusBar.Panels[1].Text := Format('%d,%d', [X, Y]);
end;


procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
with Image.Canvas do
begin
Pen.Mode := AMode;
case DrawingTool of
dtLine:
begin
Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
Image.Canvas.LineTo(BottomRight.X, BottomRight.Y);
end;
dtRectangle : Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,BottomRight.Y);
dtEllipse : Image.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,BottomRight.Y);
dtRoundRect : Image.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,BottomRight.Y,
(TopLeft.X - BottomRight.X) div 2,(TopLeft.Y - BottomRight.Y) div 2);
dtpencil : Image.Canvas.LineTo(MovePt.X,MovePt.Y);
dtBrush : begin
Image.Canvas.Brush.Style := bsHorizontal;
Image.Canvas.LineTo(MovePt.X,MovePt.Y);
end;
dtErase : begin
Image.Canvas.Pen.Color := clwhite ;
canvas.MoveTo(topleft.x,topleft.y);
image.Canvas.Pen.Mode := pmcopy ;
image.Canvas.Rectangle(topleft.x,topleft.y,movept. X,movept.y);
end;

end;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
try
image.Canvas.FillRect(Image.Canvas.ClipRect);
Pencil.Down := true ;
except
image.free;
end;
end;



procedure TForm1.SaveStyles;
begin

end;

procedure TForm1.RestoreStyles;
begin
with Image.Canvas do
begin
Brush.Style := BrushStyle;
Pen.Style := PenStyle;
Pen.Width := PenWide;
end;
end;





procedure TForm1.FreeClick(Sender: TObject);
begin
// DrawingTool :=
end;

procedure TForm1.AirBrushClick(Sender: TObject);
begin
// DrawingTool :=
end;

procedure TForm1.BrushClick(Sender: TObject);
begin
DrawingTool := dtBrush ;
end;

procedure TForm1.CurveClick(Sender: TObject);
begin
// DrawingTool :=
end;

procedure TForm1.EllipseClick(Sender: TObject);
begin
DrawingTool := dtEllipse ;
end;

procedure TForm1.EraserClick(Sender: TObject);
begin
DrawingTool := dtErase ;
end;

procedure TForm1.FillWithColorClick(Sender: TObject);
begin
// DrawingTool :=
end;

procedure TForm1.LineClick(Sender: TObject);
begin
DrawingTool := dtLine ;
end;

procedure TForm1.MagnifierClick(Sender: TObject);
begin
// DrawingTool :=
end;

procedure TForm1.PencilClick(Sender: TObject);
begin
DrawingTool := dtPencil ;
end;

procedure TForm1.PickColorClick(Sender: TObject);
begin
// DrawingTool :=
end;

procedure TForm1.PolygonClick(Sender: TObject);
begin
// DrawingTool :=
end;

procedure TForm1.RectangleClick(Sender: TObject);
begin
DrawingTool := dtRectangle ;
end;

procedure TForm1.RoundedRectangleClick(Sender: TObject);
begin
DrawingTool := dtRoundRect ;
end;

procedure TForm1.SelectClick(Sender: TObject);
begin
// DrawingTool :=
end;

procedure TForm1.TextClick(Sender: TObject);
begin
if FontDialog.Execute then
image.canvas.Font.Size := FontDialog.Font.Size ;
image.canvas.Font.Style := FontDialog.Font.Style ;

image.canvas.TextOut(origin.x,origin.y,str);
// DrawingTool :=
end;
{************************************************* **********************}
procedure TForm1.Open1Click(Sender: TObject);
begin
if OpenPictureDialog.Execute then
try
CurrentFile := OpenPictureDialog.FileName;
SaveStyles;
image.AutoSize := true ;
image.Picture.LoadFromFile(CurrentFile);
RestoreStyles;
except
messagebox(0,'Paint cannot Read This File'#13#10'This is not Valid Bitmap File,or it Format is not currently suppoted ','Paint',MB_ICONWARNING);
end;
end;
procedure TForm1.Save1Click(Sender: TObject);
begin
if CurrentFile <> EmptyStr then
Image.Picture.SaveToFile(CurrentFile)
else
SaveAs1Click(Sender);
end;

procedure TForm1.SaveAs1Click(Sender: TObject);
begin
if SavePictureDialog.Execute then
begin
CurrentFile := SavePictureDialog.FileName;
Save1Click(Sender);
end;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
// Clipboard.Assign(Image.Picture);
end;

procedure TForm1.Cut1Click(Sender: TObject);
var
ARect: TRect;
begin
Copy1Click(Sender);
with Image.Canvas do
begin
CopyMode := cmWhiteness;
ARect := Rect(0, 0, Image.Width, Image.Height);
CopyRect(ARect, Image.Canvas, ARect);
CopyMode := cmSrcCopy;
end;
end;


procedure TForm1.EditColors1Click(Sender: TObject);
begin if ColorDialog.Execute then
Image.Canvas.Pen.Color :=ColorDialog.Color ;
end;

procedure TForm1.Edit7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.Canvas.pen.Color := clred ;
end;

procedure TForm1.Panel4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel4.color ;
Forground.Color := panel4.color ;

end;

procedure TForm1.Panel10MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel10.color ;
Forground.Color := panel10.color ;
end;

procedure TForm1.Panel11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel11.color ;
Forground.Color := panel11.color ;
end;

procedure TForm1.Panel12MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel12.color ;
Forground.Color := panel12.color ;
end;

procedure TForm1.Panel13MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel13.color ;
Forground.Color := panel13.color ;
end;

procedure TForm1.Panel14Click(Sender: TObject);
begin
image.canvas.Pen.Color := panel14.color ;
Forground.Color := panel14.color ;
end;

procedure TForm1.Panel15MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel15.color ;
Forground.Color := panel15.color ;
end;

procedure TForm1.Panel16MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel16.color ;
Forground.Color := panel16.color ;
end;

procedure TForm1.Panel17MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel17.color ;
Forground.Color := panel17.color ;
end;

procedure TForm1.Panel18MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel18.color ;
Forground.Color := panel18.color ;
end;

procedure TForm1.Panel19MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel19.color ;
Forground.Color := panel19.color ;
end;

procedure TForm1.Panel20MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel20.color ;
Forground.Color := panel20.color ;
end;

procedure TForm1.Panel21MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel21.color ;
Forground.Color := panel21.color ;
end;

procedure TForm1.Panel22MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel22.color ;
Forground.Color := panel22.color ;
end;

procedure TForm1.Panel23MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel23.color ;
Forground.Color := panel23.color ;
end;

procedure TForm1.Panel24MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel24.color ;
Forground.Color := panel24.color ;
end;

procedure TForm1.Panel25MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel25.color ;
Forground.Color := panel25.color ;
end;

procedure TForm1.Panel26MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel26.color ;
Forground.Color := panel26.color ;
end;

procedure TForm1.Panel27MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel27.color ;
Forground.Color := panel27.color ;
end;

procedure TForm1.Panel28MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel28.color ;
Forground.Color := panel28.color ;
end;

procedure TForm1.Panel29MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel29.color ;
Forground.Color := panel29.color ;
end;

procedure TForm1.Panel30MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel30.color ;
Forground.Color := panel30.color ;
end;

procedure TForm1.Panel31MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel31.color ;
Forground.Color := panel31.color ;
end;

procedure TForm1.Panel5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel5.color ;
Forground.Color := panel5.color ;
end;

procedure TForm1.Panel6MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color :=clWindow;
Forground.Color :=clWindow ;
end;

procedure TForm1.Panel7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel7.color ;
Forground.Color := panel7.color ;
end;

procedure TForm1.Panel8MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel8.color ;
Forground.Color := panel8.color ;
end;

procedure TForm1.Panel9MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.canvas.Pen.Color := panel9.color ;
Forground.Color := panel9.color ;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Image.Canvas.Pen.Mode := pmnotxor ;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Image.Canvas.Pen.Mode := pmcopy ;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
Image.Canvas.Pen.Mode := pmxor ;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
str := str + key ;
end;

end.
tdkhakpur
پنج شنبه 04 تیر 1388, 13:17 عصر
سلام
لازم به این همه کد نیست شما bitmap رو باز کرده و فقط پیکسلهایی که کد رنگ آنها 0 هستند رو به رنگ زمینه تغییر بدید.
1485159
پنج شنبه 04 تیر 1388, 13:43 عصر
چطوری رنگ یک پیکسل رو بدس بیاریم؟