PDA

View Full Version : سوال: مشکل در رنگ ناحیه کپی شده با CopyRect!



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 رو هم تنظیم کردم؟!