تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[مثال] تغيير شكل الفورم و الازرار الى شكل من تصميمك
#1
بسم الله الرحمن الرحيم 
السلام عليكم ورحمة الله و بركاته 
اردت في هذا المثال أن أطرح طريقة تغيير شكل الفورم و الازرار الى أي شكل من تصميمك الذي تحب مثل قلب مفتوح من الوسط ، شكل بيضوي ، شكل سحابة ......


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



   
   
   
   
   

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

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

   

 ثانيا :
ننشيء مشروع جديد و نضيف لمجلد المشروع مجلد نسميه 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


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

الرد
تم الشكر بواسطة:
#2

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

.rar   Shaped_form_buttons (source code ).rar (الحجم : 2.69 م ب / التحميلات : 115)
الرد
تم الشكر بواسطة: العيد1403 , أبوبكر سويدان , vbtemp
#3
ما شاء الله.. موضوع اكثر من رائع. الله يبارك فيك ويرحم والدينا ووالديك.

سأجربه فوراً إن شاء الله.
الرد
تم الشكر بواسطة: أبو ناصر , أبو ناصر
#4
Thanxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
الرد
تم الشكر بواسطة:
#5
شكرا لك جزيل الشكر بارك الله فيك على المجهود
الرد
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  تغيير لغة لوحة المفاتيح العيد1403 4 1,412 29-11-16, 11:30 AM
آخر رد: العيد1403
  [سؤال] تغيير لون button العيد1403 4 1,115 01-04-16, 12:22 AM
آخر رد: أبوبكر سويدان
Question [سؤال] تمت اﻹجابة - ما هو كود فتح فورم ثاني، وما هو أمر إغلاق الفورم؟ Microformt 1 1,357 28-07-15, 10:58 PM
آخر رد: أبوبكر سويدان

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم