mbshareat
یک شنبه 30 مهر 1391, 18:31 عصر
سلام
من برای ترسیم دایره با حالت ضد پلگی یه کد در قسمت نمونه کدهای آموزشی گذاشتم.
خواستم ساده ترش کنم از کد پایین استفاده کردم:
procedure SmoothDraw(Can:TCanvas;XY:Array Of Integer;Shape,Mode:String;BorderColor,FillColor:TC olor;DecPixel:Integer=1;Zoom:Integer=3);OverLoad;
Var
B:TBitmap;
W,H,X1,Y1,X2,Y2,X3,Y3:Word;
begin
B:=TBitmap.Create;
B.PixelFormat:=pf24Bit;
X1:=XY[0];
Y1:=XY[1];
X2:=XY[2];
Y2:=XY[3];
X3:=XY[4];
Y3:=XY[5];
W:=X2-X1;
H:=Y2-Y1;
B.Width:=W*Zoom;
B.Height:=H*Zoom;
B.Canvas.CopyRect(Rect(0,0,B.Width,B.Height),Can,R ect(X1,Y1,X2,Y2));
B.Canvas.Pen.Color:=BorderColor;
B.Canvas.Brush.Color:=FillColor;
If UpperCase(Mode)='B' then
B.Canvas.Brush.Style:=bsClear;
If UpperCase(Mode)='F' then
B.Canvas.Pen.Style:=psClear;
B.Canvas.Pen.Width:=Zoom;
If UpperCase(Shape)='L' then
Begin
B.Canvas.MoveTo(DecPixel,DecPixel);
B.Canvas.LineTo(B.Width-DecPixel,B.Height-DecPixel);
End;
If UpperCase(Shape)='R' then
B.Canvas.Rectangle(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel);
If UpperCase(Shape)='RR' then
B.Canvas.RoundRect(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel,X3*3,Y3*3);
If UpperCase(Shape)='E' then
B.Canvas.Ellipse(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel);
SetStretchBltMode(B.Canvas.Handle, HalfTone);
// StretchBlt(Can.Handle,X1,Y1,W,H
// ,B.Canvas.Handle,0,0,B.Width,B.Height, SRCCOPY);
Can.CopyRect(Rect(X1,Y1,X2,Y2),B.Canvas,Rect(0,0,B .Width,B.Height));
B.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
Var
Can:TCanvas;
begin
Image1.Picture.Bitmap.PixelFormat:=pf24bit;
SmoothDraw(Image1.Picture.Bitmap.Canvas,[0,0,200,200],'E','BF',clRed,ClYellow,1,5);
end;
اما با این روش رنگ ناحیه تعیین شده به عنوان پارامتر مختصات تغییر می کنه!
تصویر زیر رو ببینین:
94213
مشکل از کجاست؟
من که PixelFormat رو هم تنظیم کردم؟!
من برای ترسیم دایره با حالت ضد پلگی یه کد در قسمت نمونه کدهای آموزشی گذاشتم.
خواستم ساده ترش کنم از کد پایین استفاده کردم:
procedure SmoothDraw(Can:TCanvas;XY:Array Of Integer;Shape,Mode:String;BorderColor,FillColor:TC olor;DecPixel:Integer=1;Zoom:Integer=3);OverLoad;
Var
B:TBitmap;
W,H,X1,Y1,X2,Y2,X3,Y3:Word;
begin
B:=TBitmap.Create;
B.PixelFormat:=pf24Bit;
X1:=XY[0];
Y1:=XY[1];
X2:=XY[2];
Y2:=XY[3];
X3:=XY[4];
Y3:=XY[5];
W:=X2-X1;
H:=Y2-Y1;
B.Width:=W*Zoom;
B.Height:=H*Zoom;
B.Canvas.CopyRect(Rect(0,0,B.Width,B.Height),Can,R ect(X1,Y1,X2,Y2));
B.Canvas.Pen.Color:=BorderColor;
B.Canvas.Brush.Color:=FillColor;
If UpperCase(Mode)='B' then
B.Canvas.Brush.Style:=bsClear;
If UpperCase(Mode)='F' then
B.Canvas.Pen.Style:=psClear;
B.Canvas.Pen.Width:=Zoom;
If UpperCase(Shape)='L' then
Begin
B.Canvas.MoveTo(DecPixel,DecPixel);
B.Canvas.LineTo(B.Width-DecPixel,B.Height-DecPixel);
End;
If UpperCase(Shape)='R' then
B.Canvas.Rectangle(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel);
If UpperCase(Shape)='RR' then
B.Canvas.RoundRect(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel,X3*3,Y3*3);
If UpperCase(Shape)='E' then
B.Canvas.Ellipse(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel);
SetStretchBltMode(B.Canvas.Handle, HalfTone);
// StretchBlt(Can.Handle,X1,Y1,W,H
// ,B.Canvas.Handle,0,0,B.Width,B.Height, SRCCOPY);
Can.CopyRect(Rect(X1,Y1,X2,Y2),B.Canvas,Rect(0,0,B .Width,B.Height));
B.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
Var
Can:TCanvas;
begin
Image1.Picture.Bitmap.PixelFormat:=pf24bit;
SmoothDraw(Image1.Picture.Bitmap.Canvas,[0,0,200,200],'E','BF',clRed,ClYellow,1,5);
end;
اما با این روش رنگ ناحیه تعیین شده به عنوان پارامتر مختصات تغییر می کنه!
تصویر زیر رو ببینین:
94213
مشکل از کجاست؟
من که PixelFormat رو هم تنظیم کردم؟!