عمل برنامج الامر تشغيل

[BouDjeM]

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

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

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


http://www3.0zz0.com/2010/12/15/16/161605883.jpg

ثانيا في الحدث 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;ضع الكود التالي كما هو موضح في الصورة
http://www3.0zz0.com/2010/12/15/16/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;وهذا كل شيئ ماعليك سوى حفظ المشروع وتجربته
والكود سورس في المرفقات
وفي الاخير اعذروني عن طريقة الشرح ومنكم الدعاء لي ولوالدي

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

[kachwahed]

وعليكم السلام ورحمة الله وبركاته
أهلا ومرحبا بك في المنتدى :)
بداية موفقة...
حاول التخلي عن الـ TTimer، إبحث عن أقصر الحلول واستخدام أقل عدد ممكن من المكتبات
إضافة صغيرة:
...
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
#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

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

[BouDjeM]

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

[الطناملى]

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

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