[أبو ناصر]

بسم الله الرحمن الرحيم 
السلام عليكم ورحمة الله و بركاته 
اردت في هذا المثال أن أطرح طريقة تغيير شكل الفورم و الازرار الى أي شكل من تصميمك الذي تحب مثل قلب مفتوح من الوسط ، شكل بيضوي ، شكل سحابة ......


الصور التالية لاشكال الفورم و اﻷزرار بعد التنفيذ :


   
   
   
   
   

 كيف نقوم بذلك :

أولا : نقوم بفتح برنامج الرسام و نصمم الأشكال التي نريدها على أن تكون :
             الخلفية ىسوداء 
              نحفظ التصميمات بصيغة bmp
      كما في الصور :
   
   
   
   
   
      
   نقوم ايضا بتصميم اشكال صغيرة مشابهة للسابقة لتغيير أشكال اﻷزرار مثل الصورة التالية :

   

 ثانيا :
ننشيء مشروع جديد و نضيف لمجلد المشروع مجلد نسميه images نحفظ فيه صور الاشكال التي قمنا بتصميمها سابقا
 نضيف للفورم أزرار buttons الخاصة بتغيير شكل الفورم 

ثالثا : 
نضيف لكود المشروع اجراءين : اﻷول ChangeFormShape لتغير شكل الفورم و الثاني ChangeButtonShape لتغيير شكل الازرار :

PHP كود :

procedure TForm1.ChangeFormShape(path: string);
  var ABitmap: TBitmap;
 begin

 BorderStyle:=bsNone;
 ABitmap:=TBitmap.Create;
 ABitmap.LoadFromFile(path);

 Width:=ABitmap.Width;
 Height:=ABitmap.Height;

 SetShape(ABitmap);

 ABitmap.Free;


end; 


PHP كود :

procedure TForm1.ChangeButtonShape(Sender:TObject;path: string);
  var ABitmap:TBitmap;
 begin

ABitmap:=TBitmap.Create;

ABitmap.LoadFromFile(path);

(sender as Tbutton).Width:=ABitmap.Width;
(sender as Tbutton).Height:=ABitmap.Height;
(sender as Tbutton).SetShape(ABitmap);
 ABitmap.Free;
end; 


 
رابعا : نضيف اجراءات الضغط على الازرار لتغيير شكل الفورم و اجراءات تحريك الفورم بالماوس .....
  
   وكود الوحدة unit لكامل كود المشروع مع الشرح  :

PHP كود :

unit frm1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Types ;

type


  { TForm1 }

  TForm1 = class(TForm)
    btnEllipse: TButton;
    btnInfo1: TButton;
    btnRectangleR: TButton;
    btnInfo2: TButton;
    btnClaud: TButton;
    btnHeart: TButton;
    btnClose: TButton;

    procedure btnClaudClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnEllipseClick(Sender: TObject);
    procedure btnHeartClick(Sender: TObject);
    procedure btnInfo1Click(Sender: TObject);
    procedure btnInfo2Click(Sender: TObject);
    procedure btnRectangleRClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);


  private
    { private declarations }
  public
    { public declarations }
    procedure ChangeFormShape(path:string);
    procedure ChangeButtonShape(sender:TObject;path:string);
  end;

var
  Form1: TForm1;
  X0,Y0 : integer;
  move:Boolean;
implementation

{$R *.lfm}

{ TForm1 }


procedure TForm1.FormShow(Sender: TObject);

begin
    ChangeFormShape('images/big/heart.bmp');

    ChangeButtonShape(btnEllipse,'images/small/ellipse.bmp');
    ChangeButtonShape(btnHeart,'images/small/heart.bmp');
    ChangeButtonShape(btnRectangleR,'images/small/rectangleR.bmp');
    ChangeButtonShape(btnClaud,'images/small/claud.bmp');
    ChangeButtonShape(btnInfo1,'images/small/info1.bmp');
    ChangeButtonShape(btnInfo2,'images/small/info2.bmp');


end;
   //اجراء تغيير شكل الفورم
procedure TForm1.ChangeFormShape(path: string);
  var ABitmap: TBitmap;
 begin

 BorderStyle:=bsNone;
 ABitmap:=TBitmap.Create;
 ABitmap.LoadFromFile(path);

 Width:=ABitmap.Width;
 Height:=ABitmap.Height;

 SetShape(ABitmap);

 ABitmap.Free;


end;
  //اجراء تغيير شكل الباتنز
procedure TForm1.ChangeButtonShape(Sender:TObject;path: string);
  var ABitmap:TBitmap;
 begin

ABitmap:=TBitmap.Create;

ABitmap.LoadFromFile(path);

(sender as Tbutton).Width:=ABitmap.Width;
(sender as Tbutton).Height:=ABitmap.Height;
(sender as Tbutton).SetShape(ABitmap);

 ABitmap.Free;
end;

  // الاجراءات التالية لاعطاء الفورم امكانية التحريك بالماوس

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

begin
  X0:=X;
  Y0:= y;
  move:=true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    if move then
    begin

     Left := Left - X0 + x;
     Top := Top - Y0 + y;

    end;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   move:= false;
end;

//  اجراءات الضغط على الازرار  لتغيرشكل الفورم
procedure TForm1.btnEllipseClick(Sender: TObject);
begin
    ChangeFormShape('images/big/ellipse.bmp');
    color:=clSkyBlue;

end;

procedure TForm1.btnClaudClick(Sender: TObject);
begin
  ChangeFormShape('images/big/claud.bmp');
  color:=clWhite;
end;

procedure TForm1.btnHeartClick(Sender: TObject);
begin
  ChangeFormShape('images/big/heart.bmp');
  color:=clRed;
end;

procedure TForm1.btnInfo1Click(Sender: TObject);
begin
  ChangeFormShape('images/big/info1.bmp');
  color:=clTeal;
end;

procedure TForm1.btnInfo2Click(Sender: TObject);
begin
  ChangeFormShape('images/big/info2.bmp');
  color:=clOlive;
end;

procedure TForm1.btnRectangleRClick(Sender: TObject);
begin
  ChangeFormShape('images/big/rectangleR.bmp');
  color:=clFuchsia;
end;

//اجراء الضغط على زر الخروج
procedure TForm1.btnCloseClick(Sender: TObject);
begin
  close;
end;




end. 


  كود المشروع  و الملف التنفيذي : 

---

[أبو ناصر]

  Shaped_form_buttons(exe).rar (الحجم : 653.46 ك ب / التحميلات : 171)

  Shaped_form_buttons (source code ).rar (الحجم : 2.69 م ب / التحميلات : 180)

[أبوبكر سويدان]

ما شاء الله.. موضوع اكثر من رائع. الله يبارك فيك ويرحم والدينا ووالديك.

سأجربه فوراً إن شاء الله.

[mal0042002]

Thanxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

[vbtemp]

شكرا لك جزيل الشكر بارك الله فيك على المجهود