delphi4arab منتديات دلفي للعرب

[FONT=Courier New]بسم الله الرحمان الرحيم[FONT=Courier New]

السلام عليكم ورحمة الله تعالى وبركاته
هذه أول مشاركة لي وأحببت أن أعمل برنامج معكم خطوة بخطوة

البرنامج هو الأمر تشغيل ومن لا يعرفه واللغة هي طبعا دلفي7
الشرح رايح يكون بالصور

أولا اعمل كما هو موضح في الصورة التالية

ثانيا في الحدث OnCreate لـ Form ضع الكود التالي

كود :
procedure TForm1.FormCreate(Sender: TObject);
begin
     Form1.Caption:=' Run...';
     Form1.BorderStyle:=bsSingle;
     Form1.BorderIcons:=[biSystemMenu];
     Timer1.Interval:=1;
     Label1.Caption:='Type the name of a Program,folder,document,Or Internet'+
                      #13+' resource,and Windows will Open it for you.';
     Label2.Caption:='Open : ';
     BitBtn1.Caption:='Ok';
     BitBtn2.Caption:='Cancel';
     BitBtn3.Caption:='Browse...';
end;

ثالثا في الحدث OnShow لـ Form ضع الكود التالي

كود :
procedure TForm1.FormShow(Sender: TObject);
begin
     //موقع ضهور النافذة عند تشغيل البرنامج
     Height := 205;
     Width  := 420;
     Top := Screen.Height - Height - 38;
     Left := Screen.Width - Width - 5;
     //هنا عدم ظهور الايقونة في شريط المهام
     hwndOwner := GetWindow(Handle, GW_OWNER);
     ShowWindow(hwndOwner, SW_HIDE);
end;

ضع الكود التالي كما هو موضح في الصورة
[صورة: 111451435.jpg]

كود :
var
  FRun: TFRun;
  //أضف هذا
  Path, Dir, MyMsg: string;
  I, Returnvalue:integer;
  hwndOwner: HWnd;
implementation
  //أضف الوحدتين 
 uses
  Shellapi,TypInfo;

{$R *.dfm}
//عند حفظ ComboBox المسارات الموجودة مسبقا لا يحفظها إلا إذا كانت مسارات جديدة
Function TheStr(Str:string;CBoxTxt:TComboBox):Variant;
Var
     i: integer;
begin
     i:= CBoxTxt.Items.IndexOf(Str);
     if I > -1 then
    //ShowMessage('')
     else If (Str <> '') then CBoxTxt.Items.Add(Str);
end;
//عندما يكون ComboBox لم يكتب فيه شيئ أي text:=''; 
function TForm1.SelectBox(InString: string): boolean;
const TheList: array[1..2] of string = ('',' ');
var X: integer;
begin
     Result := false;
     InString := StringReplace(InString, ' ', '',[rfReplaceAll]);
     InString := StringReplace(InString, #$A, '',[rfReplaceAll]);
     InString := StringReplace(InString, #$D, '',[rfReplaceAll]);
     for X := 1 to High(TheList) do
     if TheList[X] = lowercase(InString) then Result := true;
end;

في الحدث OnClick لـ BitBtn1 ضع الكود التالي

كود :
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
     Path:=ExtractFilePath(Application.ExeName);
     Dir:=ComboBox1.Text;
     if ShellExecute(FRun.Handle, nil,PChar(Dir),nil,nil,SW_SHOW)<=32 then begin
     MyMsg := Format('Windows can not find the "%s" Make sure you typed the '+
     'name,correctly and then try again',[Dir]);
     MessageDlg(MyMsg, mtError, [mbOk],0);
     end else begin
     theStr(ComboBox1.Text,CBox);
     ComboBox1.Items.SaveToFile(Path+'ComboBox1.txt');
     Form1.Close;
   end;
end;

في الحدث OnClick لـ BitBtn2 ضع الكود التالي

كود :
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
     Path:=ExtractFilePath(Application.ExeName);
     ComboBox1.Items.SaveToFile(Path+'ComboBox1.txt');
     Application.Terminate;
end;

في الحدث OnClick لـ BitBtn3 ضع الكود التالي

كود :
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
     if OpenDialog1.Execute then
        ComboBox1.Text:=OpenDialog1.FileName;
end;

في الحدث OnKeyPress لـ ComboBox1 ضع الكود التالي

كود :
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
     if key=#13 then begin
      if SelectBox(ComboBox1.Text) then begin
         Label2.Caption:='Open : '; //هذا السطر مجرد كذبة لكي ينفذ الشرط فقط ههههههههه
          end else BitBtn1Click(Sender);
  end;
end;

في الحدث OnTimer لـ Timer1 ضع الكود التالي

كود :
procedure TForm1.Timer1Timer(Sender: TObject);
begin
     if SelectBox(ComboBox1.Text) then
       BitBtn1.Enabled:=False
     else BitBtn1.Enabled:=True;
end;

وهذا كل شيئ ماعليك سوى حفظ المشروع وتجربته
والكود سورس في المرفقات
وفي الاخير اعذروني عن طريقة الشرح ومنكم الدعاء لي ولوالدي

وبالتوفيق للجميع

وعليكم السلام ورحمة الله وبركاته
أهلا ومرحبا بك في المنتدى Smile

بداية موفقة...
حاول التخلي عن الـ TTimer، إبحث عن أقصر الحلول واستخدام أقل عدد ممكن من المكتبات
إضافة صغيرة:

PHP كود :
...
  public
    { Public declarations }
  end;

procedure RunFileDlg(OwnerWnd: HWND; Icon: HICON; lpstrDirectory: PWideChar;
  lpstrTitle: PWideChar; lpstrDescription: PWideChar; Flags: Longint); stdcall;
  external 'Shell32.dll' index 61;

var
... 

الاستخدام:

كود :
procedure TForm1.btRunClick(Sender: TObject);
begin
  RunFileDlg(Handle, Application.Icon.Handle, 'c:\', 'Open a file', '', $0001);
end;

بخصوص الـ Flags

PHP كود :
#define RFF_NOBROWSE        0x0001    // Removes the browse button 
#define RFF_NODEFAULT        0x0002    // No default item selected 
#define RFF_CALCDIRECTORY    0x0004    // Calculates the working directory from the file name 
#define RFF_NOLABEL            0x0008    // Removes the edit box label 
#define RFF_NOSEPARATEMEM    0x0020  // Removes the Separate Memory Space check box, NT only 

عفا الله عنك وعن والديك
بالتوفيق.

شكرا لك اخي kachwahed على الاضافة والتشجيع
ومنكم نستفيد .

شكرا لك اخى الفاضل

جزاك الله خيرا

BouDjeM

kachwahed

BouDjeM

الطناملى