بسم الله الرحمن الرحيم
السلام عليكم ورحمة الله و بركاته
اردت في هذا المثال أن أطرح طريقة تغيير شكل الفورم و الازرار الى أي شكل من تصميمك الذي تحب مثل قلب مفتوح من الوسط ، شكل بيضوي ، شكل سحابة ......
الصور التالية لاشكال الفورم و اﻷزرار بعد التنفيذ :
كيف نقوم بذلك :
أولا : نقوم بفتح برنامج الرسام و نصمم الأشكال التي نريدها على أن تكون :
الخلفية ىسوداء
نحفظ التصميمات بصيغة bmp
كما في الصور :
نقوم ايضا بتصميم اشكال صغيرة مشابهة للسابقة لتغيير أشكال اﻷزرار مثل الصورة التالية :
ثانيا :
ننشيء مشروع جديد و نضيف لمجلد المشروع مجلد نسميه images نحفظ فيه صور الاشكال التي قمنا بتصميمها سابقا
نضيف للفورم أزرار buttons الخاصة بتغيير شكل الفورم
ثالثا :
نضيف لكود المشروع اجراءين : اﻷول ChangeFormShape لتغير شكل الفورم و الثاني ChangeButtonShape لتغيير شكل الازرار :
رابعا : نضيف اجراءات الضغط على الازرار لتغيير شكل الفورم و اجراءات تحريك الفورم بالماوس .....
وكود الوحدة unit لكامل كود المشروع مع الشرح :
كود المشروع و الملف التنفيذي :
السلام عليكم ورحمة الله و بركاته
اردت في هذا المثال أن أطرح طريقة تغيير شكل الفورم و الازرار الى أي شكل من تصميمك الذي تحب مثل قلب مفتوح من الوسط ، شكل بيضوي ، شكل سحابة ......
الصور التالية لاشكال الفورم و اﻷزرار بعد التنفيذ :
كيف نقوم بذلك :
أولا : نقوم بفتح برنامج الرسام و نصمم الأشكال التي نريدها على أن تكون :
الخلفية ىسوداء
نحفظ التصميمات بصيغة 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.
كود المشروع و الملف التنفيذي :