چطور می تونم یک دایره با کیفیت در دلفی رسم کنم ؟

[mahdy.asia]

من یک shape روی فرم گذاشتم و شکل آن را دایره کردم لبه های دایره کیفیت پایینی داره چطور می تونم یک دایره با کیفیت بالا رسم کنم.

Circle.JPG

[hadisalahi2]

عزیزم این کامپوننت فقط به همین صورت دایره یا اشکال رو رسم میکنه
اگه میخوای اشکال گرافیکی با کیفیت داشته باشی ، بهتره از مجموعه کامپوننت های TMS استفاده کنی که کیفیت طراحی هاش خیلی بالاتره

[mahdy.asia]

ممنون اما tms هم از این بهتر دایره رو نمی کشه لطفا یک راه عملی پیشنهاد بدید متشکرم
Circle2.JPG

[hadisalahi2]

کلا برای چه کاری لازم داری دایره رسم کنی
شاید یک روش بهتر از ترسیم دایره وجود داشته باشه

[mahdy.asia]

من عکس پرسنل را می خواهم در دایره نمایش دهم هم از Canvas فرم استفاده کردم هم از Shape در هر دو روش مشکل اینه که حاشیه دایره (تصویر) کیفیت پایینی داره و مشتری این را اشکال گرفته
از راهنمایی دوستان متشکرم.
https://barnamenevis.org/showthread.p...8C%D8%B1%D9%87

[یوسف زالی]

شما با هر چیزی دایره بکشی همین می شه مگر این که سایه زنی کنی.
تکنیک های سایه زنی هم راحت نیست.
یک پیشنهاد، دایره رو در بیت مپ در حافظه بصورت بزرگ و با خط پررنگ بکشید، بعد اون رو بصورت استرچ شده دربیارید. امتحان کنید ببینید بهتر می شه؟

[hadisalahi2]

توصیه میکنم به جای استفاده از کامپوننت Shape از کنترل Image همراه با یک تصویر PNG استفاده کنید
خیلی راحت یک عکس بزارید که یک دایره با کیفیت داخلش باشه
بعد عکس خودتون رو در داخل اون دایره نمایش بدید

یا حق

[Ananas]

سلام.
یک نمونه که یک سری آپشن اضافی هم داره:

Graphics::TBitmap * DrawCycleBlure(

    Graphics::TBitmap * b,

    const float X,

    const float Y,

    const float R,

    const float LineWidth,

    const float FadeWidth,

    const float FaceMulti)

{

    for (int j = 0; j < b->Height; j++)

    {

        for (int i = 0; i < b->Width; i++)

        {

            float x = (float)i - X;

            float y = (float)j - Y;

            float c = fabs(R - sqrt(x * x + y * y));

            if (c < LineWidth)

            {

                b->Canvas->Pixels[i][j] = 0x00000000L;

            }

            else

            {

                c = (c - LineWidth) / FadeWidth;

                if (c > 1.0f) c = 1.0f;

                c = (1.0f - c) * FaceMulti;

                c *= c;

                c = (1.0f - c) * 255.0f;

                DWORD d = (DWORD)c;

                d |= (d << 8) | (d << 16);

                b->Canvas->Pixels[i][j] = d;

            };

        };

    };

};



void __fastcall TForm1::FormMouseDown(TObject *Sender, TMouseButton Button, TShiftState Shift,

          int X, int Y)

{

    Graphics::TBitmap * b = new Graphics::TBitmap();

    int w = this->ClientWidth;

    int h = this->ClientHeight;



    b->SetSize(w, h);

    DrawCycleBlure(b, (float)X * 0.5f, (float)Y * 0.5f, (float)X * 0.5f, 0.5f, 1.0f, 1.0f);



    this->Canvas->Draw(0, 0, b);

    delete b;

}

[Ananas]

procedure DrawCycleBlure(

    b : TBitmap;

    const X, Y, R, LineWidth, FadeWidth, FaceMulti: Single);

var

  i, j : Integer;

  lx, ly, c : Single;

  d : DWORD;

begin

    for j := 0 to b.Height - 1 do

    begin

        for i := 0 to b.Width - 1 do

        begin

            lx := i - X;

            ly := j - Y;

            c := Abs(R - Sqrt(lx * lx + ly * ly));

            if (c < LineWidth) then

            begin

                b.Canvas.Pixels[i,j] := $00000000;

            end

            else

            begin

                c := (c - LineWidth) / FadeWidth;

                if (c > 1.0) then c := 1.0;

                c := (1.0 - c) * FaceMulti;

                c := c * c;

                c := (1.0 - c) * 255.0;

                d := Trunc(c);

                d := d or (d shl 8) or (d shl 16);

                b.Canvas.Pixels[i, j] := d;

            end;

        end;

    end;

end;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  b : TBitmap;

  w, h : Integer;

begin

  b := TBitmap.Create();

  w := Self.ClientWidth;

  h := Self.ClientHeight;



  b.SetSize(w, h);

  DrawCycleBlure(b, X * 0.5, Y * 0.5, X * 0.5, 0.5, 1.0, 1.0);



  Self.Canvas.Draw(0, 0, b);

  b.Free;

end;

[Jarvis]

شما دو راه دارید ، یا این که همونطور که دوستان گفتن بصورت استاتیک یعنی استفاده از یک فایل PNG از قبل آماده شده استفاده کنید
اما راه دوم که داینامیک هست و عملا یکم دنگ و فنگ داره اینه که شما دایره رو بصورت یک وکتور استفاده کنید ، اینجوری توی هر سایزی با کیفیت مطلوب و ثابت براتون عملکرد خوب داره و افت کیفیت نداره
یک نمونه اش استفاده از فایل های SVG هست ... البته شخصا استفاده از فایل های وکتور رو توی دلفی کار نکردم اما شاید دوستان اطلاعاتی در این باره داشته باشند

موفق باشید.

[mahdy.asia]

procedureDrawCycleBlure( b : TBitmap;
const X, Y, R, LineWidth, FadeWidth, FaceMulti: Single);
var
i, j : Integer;
lx, ly, c : Single;
d : DWORD;
begin
for j := 0 to b.Height - 1 do
begin
for i := 0 to b.Width - 1 do
begin
lx := i - X;
ly := j - Y;
c := Abs(R - Sqrt(lx * lx + ly * ly));
if (c < LineWidth) then
begin
b.Canvas.Pixels[i,j] := $00000000;
end
else
begin
c := (c - LineWidth) / FadeWidth;
if (c > 1.0) then c := 1.0;
c := (1.0 - c) * FaceMulti;
c := c * c;
c := (1.0 - c) * 255.0;
d := Trunc(c);
d := d or (d shl 8) or (d shl 16);
b.Canvas.Pixels[i, j] := d;
end;
end;
end;
end;

دوست عزیز Ananas کد شما دایره رو با کیفیت مورد نیاز رسم می کند اما من نتونستم از اون برای نمایش تصاویر پرسنل که با فرمت jpg است به شکل دایره استفاده کنم متشکر می شم از دوستان اگر بیشتر راهنمایی کنند

[Ananas]

در قسمت Uses یونیت jpeg رو اضافه کنید و :

function ColorMultiply(const Clr: TColor; const Multi: Single):TColor;

var

  r, g, b : Single;

begin

  r := Multi * ( Clr and $000000FF);

  g := Multi * ((Clr and $0000FF00) shr 8);

  b := Multi * ((Clr and $00FF0000) shr 16);



  Result := ( Trunc(r) and $000000FF) or

            ((Trunc(g) and $000000FF) shl 8) or

            ((Trunc(b) and $000000FF) shl 16);

end;



procedure DrawCycleBlure(

          Src_Img    : TJPEGImage;

          Dst_Bitm   : TBitmap;

    const Radius,

          LineWidth,

          FadeWidth,

          FaceMulti  : Single);



var

  i, j, X, Y        : Integer;

  lx, ly, c, leng   : Single;

  d                 : DWORD;

begin

    X := Dst_Bitm.Width  div 2; // Cenetr.X

    Y := Dst_Bitm.Height div 2; // Center.Y



    for j := 0 to Dst_Bitm.Height - 1 do

    begin

        for i := 0 to Dst_Bitm.Width - 1 do

        begin

            lx := i - X;

            ly := j - Y;

            leng := Sqrt(lx * lx + ly * ly);

            c := Abs(Radius - leng);

            if (c < LineWidth) then

            begin

                c := 0.0;

            end

            else

            begin

                c := (c - LineWidth) / FadeWidth;

                if (c > 1.0) then c := 1.0;

                c := (1.0 - c) * FaceMulti;

                c := 1.0 - c * c;

            end;

            if (leng < Radius) then

            begin

              d := ColorMultiply(Src_Img.Canvas.Pixels[i, j], c);

            end

            else

            begin

              d := Trunc(c * 255.0);

              d := d or (d shl 8) or (d shl 16);

            end;

            Dst_Bitm.Canvas.Pixels[i, j] := d;

        end;

    end;

end;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  b : TBitmap;

  w, h : Integer;

  img : TJPEGImage;

begin

  b := TBitmap.Create();

  w := Self.ClientWidth;

  h := Self.ClientHeight;



  img := TJPEGImage.Create;

  img.LoadFromFile('C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg');



  b.SetSize(w, h);

  DrawCycleBlure(img, b, w * 0.5, 0.5, 1.0, 1.0);



  Self.Canvas.Draw(0, 0, b);

  b.Free;

  img.Free;

end;

[mahdy.asia]

کد زیر را برای نمایش عکس نوشتم

procedure TForm2.FormPaint(Sender: TObject);var

  b : TBitmap;

  w, h : Integer;

  img : TJPEGImage;

begin

  b := TBitmap.Create();

  w := 100 ;

  h := 100 ;

  img := TJPEGImage.Create;

  img.LoadFromFile('C:\Pic.jpg');

  b.SetSize(w, h);

  DrawCycleBlure(img, b, 48 , 0.5, 1.0, 1.0);

  Self.Canvas.StretchDraw(rect(200, 48, 300 , 148) , b);

  b.Free;

  img.Free;

end;

اول اینکه به نظر میاد با وجود کد stretch تصویر stretch نمی شه
دوم جاشیه تصویر (دایره) یک مربع به رنگ سفید ایجاد می شه که نتونستم اون رو از بین ببرم

Popup.jpg

[Ananas]

function ColorMultiply(const Clr: TColor; const Multi: Single):TColor;

var

  r, g, b : Single;

begin

  r := Multi * ( Clr and $000000FF);

  g := Multi * ((Clr and $0000FF00) shr 8);

  b := Multi * ((Clr and $00FF0000) shr 16);



  Result := ( Trunc(r) and $000000FF)        or

            ((Trunc(g) and $000000FF) shl 8) or

            ((Trunc(b) and $000000FF) shl 16);

end;



procedure DrawCycleBlure(

          Src_Img    : TJPEGImage;

          Dst_Canv   : TCanvas;

    const DrawRect   : TRect;

    const Radius,

          LineWidth,

          FadeWidth,

          FaceMulti  : Single);



var

  i, j, X, Y, W, H, ic, jc  : Integer;

  lx, ly, c, leng   : Single;

  d                 : DWORD;

begin

    X := (DrawRect.Left  + DrawRect.Right ) div 2; // Cenetr.X

    Y := (DrawRect.Top   + DrawRect.Bottom) div 2; // Center.Y

    W := DrawRect.Right  - DrawRect.Left;

    H := DrawRect.Bottom - DrawRect.Top;

    for j := 0 to H - 1 do

    begin

        for i := 0 to W - 1 do

        begin

            ic := i + DrawRect.Left; // i_Canvas

            jc := j + DrawRect.Top;  // j_Canvas

            lx := ic - X;

            ly := jc - Y;

            leng := Sqrt(lx * lx + ly * ly);

            c := Abs(Radius - leng);

            if (c < LineWidth) then

            begin

                c := 0.0;

            end

            else

            begin

                c := (c - LineWidth) / FadeWidth;

                if (c > 1.0) then c := 1.0;

                c := (1.0 - c) * FaceMulti;

                c := 1.0 - c * c;

            end;

            if (leng < Radius) then

            begin

              d := ColorMultiply(Src_Img.Canvas.Pixels[i, j], c);

            end

            else

            begin

              d := ColorMultiply(Dst_Canv.Pixels[ic, jc], c);

            end;

            Dst_Canv.Pixels[ic, jc] := d;

        end;

    end;

end;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  img : TJPEGImage;

begin

  img := TJPEGImage.Create;

  img.LoadFromFile('C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg');

  DrawCycleBlure(img, Self.Canvas, Rect(X - 50, Y - 50, X + 50, Y + 50), 40.0 , 0.5, 1.0, 1.0);

  img.Free;

end;

[mahdy.asia]

وقتی موقعیت نمایش تصویر رو تغییر می دهم تصویر از وسط دایره خارج می شود، من می خواهم تصویر در موقعیت Shape دایره که من گذاشتم ایجاد شود.

[Ananas]

سلام.
ببخشید دیر جواب میدم.
Src_Img تصویر منبع هست و تصویر رو هم ماتریسی از پیکسل ها تصور کنید. اگر موقعیت عکس شما لازمه کمی جابجا بشه کافیه به i, j ای که تو کد برای اندیس Src_Img بکار میبریم یک offset اضافه کنیم. مثلا :

d := ColorMultiply(Src_Img.Canvas.Pixels[i + offset_x, j + offset_y], c);

حالا offset_x و offset_y رو با اعداد مناسب با تصویرتون مقدار دهی کنید.
در واقع تصویرتون رو به اندازهی _offset_x در راستای افقی و به اندازه ی offset_y در راستای همودی جابجا کردیم.