السلام عليكم ورحمة الله و بركاته اخواني اخواتي متابعي مدونة مينا سوفت للبرمجة
عدنا بعد غياب طويل نوعا ما بحلة جديدة للمدونة اضافة الى مجموعة دروس جديدة من بينها دروس حيل و أفكار في الدلفي
أمور قد تظهر للعيان انها بسيطة و لكن هي جد مهمة للمبرمجين خاصة بالنسبة للمكونات
نبدأ على بركة الله مع الجزء الأول
لا يقبل سوى الأعدادEDIT1- جعل الــ
- نضع مكون TEdit في فورم (Form) - نذهب بعدها إلى الأحداث (Event) وبالخصوص إلى "OnKeyPress" - نضغط مرتين على الحدث من الجهة اليمنى ونكتب الكود (Code) التالي بعد Begin مباشرة
كود:
begin
if not (Key in ['0'..'9', #8]) then
begin
Key := #0;
Beep;
end;
end;
لا يقبل سوى الرموز و الحروفEDIT2- الأن العكس نجعل الــ
كود:
begin
if (Key in ['0'..'9', #8]) then
begin
Key := #0;
Beep;
end;
end;
وجعله لا يقبل سوى الأعدادEDIT3- الأن توسيط الكتابة في
كود
;(procedure TForm1.Button13Click(Sender: TObject)
var
;Style: LongInt
;Style: LongInt
begin
;(Style := GetWindowLong(Edit1.Handle, GWL_STYLE
;(SetWindowLong(Edit1.Handle, GWL_STYLE, Style or ES_NUMBER
;Edit1.Invalidate
;end
ES_NUMBER : الأرقام فقط
ES_CENTER : وسط
ES_RIGHT : يمين
4- طريقة اغلاق البرنامج تلقائيا بعد ادخال كلمة المرور 3 مرات خطأ
الكود
var
NumTry: Byte = 0;
procedure TForm1.Button1Click(Sender: T******);
begin
if Edit1.**** + Edit2.**** = 'ab' then
Form2.Show
else
begin
Inc(NumTry);
if NumTry > 3 then
ShowMessage(IntToStr(NumTry));
end;
end;
الكود
var
NumTry: Byte = 0;
procedure TForm1.Button1Click(Sender: T******);
begin
if Edit1.**** + Edit2.**** = 'ab' then
Form2.Show
else
begin
Inc(NumTry);
if NumTry > 3 then
ShowMessage(IntToStr(NumTry));
end;
end;
5- تغيير لون ProgressBar إلى اللون الأحمر
الكود
procedure TForm1.FormCreate(Sender: TObject);
begin ProgressBar1. =ProgressBar1.Max; PostMessage(ProgressBar1.Handle,PBM_SETBARCOLOR,0,clRed); end; end. |
6- تحديد رقمين بعد الفاصلة
procedure TForm1.Button1Click(Sender: TObject);
begin
edit2.Text := FormatFloat('0.00',strtocurr( edit1.Text));
end;
end.
7- ترتيب الأرقام من الأصغر إلى الأكبر في listbox
procedure TForm1.Button1Click(Sender: TObject);
var
i, n : integer;
begin
if listbox1.Count<2 then
Exit;
for i:=1 to listbox1.Count-1 do
for n:=0 to i-1 do
if StrToFloat(listbox1.Items[i])< StrToFloat(listbox1.Items[n]) then
begin
listbox1.Items.Move(i,n);
Break;
end;
end;
end.
var
i, n : integer;
begin
if listbox1.Count<2 then
Exit;
for i:=1 to listbox1.Count-1 do
for n:=0 to i-1 do
if StrToFloat(listbox1.Items[i])< StrToFloat(listbox1.Items[n]) then
begin
listbox1.Items.Move(i,n);
Break;
end;
end;
end.
8- تحريك label من اليمين إلى اليسار
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Left:=Label1.Left-20; //20 est la vitesse de rotation de label
begin
Label1.Left:=Label1.Left-20; //20 est la vitesse de rotation de label
if Label1.Left<=-Label1.Width then
Label1.Left:=Form1.ClientWidth-Label1.Width;
end;
Label1.Left:=Form1.ClientWidth-Label1.Width;
end;
9- كتابة في label عموديا
procedure TForm1.Button1Click(Sender: TObject);
Var
St:String;
i:Integer;
begin
St:='startimes'; //Texte à écrire verticalement
Label1.Caption:=''; //Efface le contenu du label
for i:=1 to Length(St) do
Label1.Caption:=Label1.Caption+St[i]+#13;
end;
end.
Var
St:String;
i:Integer;
begin
St:='startimes'; //Texte à écrire verticalement
Label1.Caption:=''; //Efface le contenu du label
for i:=1 to Length(St) do
Label1.Caption:=Label1.Caption+St[i]+#13;
end;
end.
10- تعيين مسار قاعدة البيانات
procedure TForm1.FormCreate(Sender: TObject);
begin
table1.Active := false;
table1.TableName := extractfilepath(application.ExeName) + 'tadjou.db';
table1.Active := true;
end;
end;
end.
begin
table1.Active := false;
table1.TableName := extractfilepath(application.ExeName) + 'tadjou.db';
table1.Active := true;
end;
end;
end.
11 - زيادة شهر على التاريخ
procedure TForm1.Button1Click(Sender: TObject);
var
A1,M1,J1 : Word;
begin
DecodeDate(DateTimePicker1.date,A1,M1,J1 );
M1:=M1+1;
Label1.Caption := DateToStr(EncodeDate(A1,M1,J1));
end;
end.
end;
end.
var
A1,M1,J1 : Word;
begin
DecodeDate(DateTimePicker1.date,A1,M1,J1 );
M1:=M1+1;
Label1.Caption := DateToStr(EncodeDate(A1,M1,J1));
end;
end.
end;
end.
12- الكتابة في label بسطرين
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:='minasoft'+#13#10+'minasoft';
end;
end.
begin
Label1.Caption:='minasoft'+#13#10+'minasoft';
end;
end.
-13 أول الحروف * majuscule في
edit *
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (Edit1.SelStart = 0) or (Text[Edit1.SelStart] = ' ') then
if Key in ['a'..'z'] then
Key := UpCase(Key);
end
begin
if (Edit1.SelStart = 0) or (Text[Edit1.SelStart] = ' ') then
if Key in ['a'..'z'] then
Key := UpCase(Key);
end
14- لحساب النسبه المئويه
procedure TForm1.Button1Click(Sender: TObject);
var
a:real;
b:real;
c:real;
begin
If (Edit1.Text = '') Or (Edit2.Text = '') Then
Messagedlg('Please Enter Numbers',mterror,[mbok],0)
else
Try
a:=strtofloat(edit1.Text );
b:=strtofloat(edit2.Text );
c:=100/b;
Edit3.Text := floattostr(a*c) + '%';
except
Messagedlg('Please Enter Numbers',mterror,[mbok],0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
a:real;
b:real;
c:real;
begin
If (Edit1.Text = '') Or (Edit2.Text = '') Then
Messagedlg('Please Enter Numbers',mterror,[mbok],0)
else
Try
a:=strtofloat(edit1.Text );
b:=strtofloat(edit2.Text );
c:=100/b;
Edit3.Text := floattostr(a*c) + '%';
except
Messagedlg('Please Enter Numbers',mterror,[mbok],0);
end;
قد يعجبك ايضا