منتدى فيجوال بيسك لكل العرب

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


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



[attachment=17453]
[attachment=17454]
[attachment=17455]
[attachment=17456]
[attachment=17457]

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

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

[attachment=17452]

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

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

PHP كود :
procedure TForm1.ChangeFormShape(pathstring);
 
 var ABitmapTBitmap;
 
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;pathstring);
 
 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
SysUtilsFileUtilFormsControlsGraphicsDialogsStdCtrls,
 
 ExtCtrlsTypes ;

type


  
TForm1 }

 
 TForm1 = class(TForm)
 
   btnEllipseTButton;
 
   btnInfo1TButton;
 
   btnRectangleRTButton;
 
   btnInfo2TButton;
 
   btnClaudTButton;
 
   btnHeartTButton;
 
   btnCloseTButton;

 
   procedure btnClaudClick(SenderTObject);
 
   procedure btnCloseClick(SenderTObject);
 
   procedure btnEllipseClick(SenderTObject);
 
   procedure btnHeartClick(SenderTObject);
 
   procedure btnInfo1Click(SenderTObject);
 
   procedure btnInfo2Click(SenderTObject);
 
   procedure btnRectangleRClick(SenderTObject);
 
   procedure FormMouseDown(SenderTObjectButtonTMouseButton;
 
     ShiftTShiftStateXYInteger);

 
   procedure FormMouseMove(SenderTObjectShiftTShiftStateXYInteger);
 
   procedure FormMouseUp(SenderTObjectButtonTMouseButton;
 
     ShiftTShiftStateXYInteger);
 
   procedure FormShow(SenderTObject);


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

var
 
 Form1TForm1;
 
 X0,Y0 integer;
 
 move:Boolean;
implementation

{$R *.lfm}

TForm1 }


procedure TForm1.FormShow(SenderTObject);

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(pathstring);
 
 var ABitmapTBitmap;
 
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;pathstring);
 
 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(SenderTObjectButtonTMouseButton;
 
 ShiftTShiftStateXYInteger);

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

procedure TForm1.FormMouseMove(SenderTObjectShiftTShiftStateX,
 
 YInteger);
begin
    if move then
    begin

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

 
   end;

end;

procedure TForm1.FormMouseUp(SenderTObjectButtonTMouseButton;
 
 ShiftTShiftStateXYInteger);
begin
   move
:= false;
end;

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

end;

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

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

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

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

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

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




end


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

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

سأجربه فوراً إن شاء الله.
Thanxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
شكرا لك جزيل الشكر بارك الله فيك على المجهود