تقديم طريقة ميريز MERISE

السلام عليكم ورحمة الله و بركاته اخواني اخواتي متابعي مدونة مينا سوفت للبرمجة

عدنا بعد غياب طويل نوعا ما بحلة جديدة للمدونة اضافة الى مجموعة دروس جديدة من بينها دروس حيل و أفكار في الدلفي

أمور قد تظهر للعيان انها بسيطة و لكن هي جد مهمة للمبرمجين خاصة بالنسبة للمكونات

نبدأ على بركة الله مع الجزء الأول

  لا يقبل سوى الأعداد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

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;

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.

8- تحريك  label من اليمين إلى اليسار

procedure TForm1.Timer1Timer(Sender: TObject);
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; 

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.

 10- تعيين مسار قاعدة البيانات

  

procedure TForm1.FormCreate(Sender: TObject);
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.

12- الكتابة في label بسطرين

 procedure TForm1.Button1Click(Sender: TObject);
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

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;

تعديل المقال