تاپيك مخصوص كامپوننتها ،ابزارها ،راه حلها ،پروژه ها و ايده هاي مربوط به دلفي

[GhAeM]

اين تاپيك رو ايجاد كردم تا دوستان موارد زير در اون ذكر بشه:
1- كامپونتهاي مخصوص دلفي
2- ابزارهاي مخصوص دلفي
3- پروژه هاي كامل و جواب داده در دافي
4- راهكارها و ايده هاي مفيددر زمينه دلفي

دوستان دقت كنن كه مشكلات و سوالاتشون رو در تاپيك اشكالات و سوالات در مورد دلفي ([Only registered and activated users can see links]) اعلام كنند و اينجا را فقط براي موارد بالا استفاده كنند.

[GhAeM]

بهترين- زيباترين - جالب ترين
هر چي بگم كم گفتم اين كامپوننت خيلي عجيبه! من حاضرم از هيچ كامپونتي استفاده نكنم ولي اين داشته باشم:

افكتهاي دلفي ([Only registered and activated users can see links])
به همرا كرك

[Foroud]

قطعه كد زير براي باز و بسته كردن در CD ROM‌ به كار مي رود



procedure TForm1.Button1Click(Sender: TObject);
begin
{ open CD-ROM drive; returns 0 if successfull }
mciSendString('set cdaudio door open wait', nil, 0, handle);

{ close the CD-ROM drive; returns 0 if successfull }
mciSendString('set cdaudio door closed wait', nil, 0, handle);
end;

[Foroud]

برنامه زير مي تواند رزولوشن صفحه نمايش كامپيوتر را تغيير دهد



procedure TForm1.Button1Click(Sender: TObject);
var
lDeviceMode : TDeviceMode;
begin
EnumDisplaySettings(nil, 0, lDeviceMode);
lDeviceMode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT;
lDeviceMode.dmPelsWidth :=800;
lDeviceMode.dmPelsHeight:=600;
ChangeDisplaySettings(lDeviceMode, 0);
end;

[Foroud]

با استفاده از كد زير مي توانيد درايو CD ROM كامپيوتر را پيدا كنيد





procedure TForm1.FormCreate(Sender: TObject);
var
Drive: Char;
AddedIndex: Integer;
CDRom : Array[0..10]of Char;
begin
for Drive := 'A' to 'Z' do { iterate through all possible drives }
begin
CDROM[0] := Drive;
CDROM[1] := #0;
strcat(CDROM,':/');
If GetDriveType(CDROM) = DRIVE_CDROM then
begin
ShowMessage('Found CDROM In Letter Drive '+Drive);
Break;
End;
end;
end;

[Dokht Esmati]

برای نشان دادنِ کدها ، از تگِ Code استفاده کنید. از دکمه ی #
پست های شما اسلاح شدند.

[Foroud]

استفاده از دستور زير شما مي توانيد Title‌ برنامه خود را تغيير دهيد


Application.Title := DateTimeToStr(Now);

دستور فوق زمان را در Title برنامه شما نمايش مي دهد اگر مي خواهيد ساعت را كامل نشان دهد بايد يك timer در فرم خود قراردهيد و كد زير را وارد كنيد



procedure TForm1.Timer1Timer(Sender: TObject);
begin
Application.Title := DateTimeToStr(Now);
end;

[هيدارنه]

جناب غفوری کامپوننتهای شما که دانلود نشد . ولی اگه دوستان کامپوننتی رو معرفی می کنن این که مال نسخه چند دلفی رو به بقیه دارن می دن هم بگن .

[GhAeM]

جناب غفوری کامپوننتهای شما که دانلود نشد . ولی اگه دوستان کامپوننتی رو معرفی می کنن این که مال نسخه چند دلفی رو به بقیه دارن می دن هم بگن .
دانلود ميشه من همين الان امتحان كردم. 80/1 حجمش براي نسخه 7 دلفي

[ab1168]

سلام آقای غفوری، کار قشنگی کردی دستت درد نکنه.
در مورد کامپوننت افکت - من دانلودش کردم کرک هم کردم ولی ضاهرا موقعی که کرک میشه فایل BE3d.BPL کار نمیکنه و وقتی هم که با فایل BE3DsgD7.bpl نصب و کامپایلش میکنم میگه که دمو ورژن هست. اگه نکته دیگه ای هست ممنون میشم بنویسی.

[ab1168]

اینم یه کد راحت برای بردن مانیتور به standby :
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_MO NITORPOWER,2);

[GhAeM]

براي كرك يه فايل ريدمي هست كه ميگه بتيد چيكار كنيد.مطابق اون عمل كنيد درست ميشه

[ab1168]

با سلام به همه دوستان و با تشکر از آقای غفوری بخاطر اون فایل readme که من ندیده بودمش
امروز چند تا procedure مربوط به سیستم عامل برا کسایی که به دستکاری سیستم علاقه مندن میزارم و سعی می کنم این کار رو ادامه بدم.

کد زیر برای فعال و غیر فعال کردن CTRL+ALT+DELETE از داخل دلفی هستش که با کمک رجیستری ویندوز عمل می کنه :


procedure EnableCTRLALTDEL(YesNo : boolean) ;
const
sRegPolicies = '\Software\Microsoft\Windows\CurrentVersion\Polici es';
begin
with TRegistry.Create do
try
RootKey:=HKEY_CURRENT_USER;
if OpenKey(sRegPolicies+'\System\',True) then
begin
case YesNo of
False:
begin
WriteInteger('DisableTaskMgr',1) ;
end;
True:
begin
WriteInteger('DisableTaskMgr',0) ;
end;
end;
end;
CloseKey;
if OpenKey(sRegPolicies+'\Explorer\',True) then
begin
case YesNo of
False:
begin
WriteInteger('NoChangeStartMenu',1) ;
WriteInteger('NoClose',1) ;
WriteInteger('NoLogOff',1) ;
end;
True:
begin
WriteInteger('NoChangeStartMenu',0) ;
WriteInteger('NoClose',0) ;
WriteInteger('NoLogOff',0) ;
end;
end;
end;
CloseKey;
finally
Free;
end;
end;




توجه داشته باشید که حتما از unit رجیستری استفاده کنید (uses registry)

[ab1168]

اینم یه کد برای مخفی کردن یا نمایش آیکونهای desktop بصورت runtime :





procedure ShowDesktop(const YesNo : boolean) ;
var h : THandle;
begin
h := FindWindow('ProgMan', nil) ;
h := GetWindow(h, GW_CHILD) ;
if YesNo = True then
ShowWindow(h, SW_SHOW)
else
ShowWindow(h, SW_HIDE) ;
end;

[ab1168]

این یکی مثل بالایی هست ولی این فقط Desktop رو فعال و غیر فعال می کنه






{Enable:}
EnableWindow( FindWindowEx( FindWindow('Progman', nil), HWND(0), 'ShellDll_DefView', nil),TRUE) ;



{Disable:}
EnableWindow(FindWindowEx(FindWindow('Progman', nil), HWND(0), 'ShellDll_DefView', nil),FALSE) ;





باید از این unit هم استفاده کنید ShellApi

[ab1168]

کپی کردن فایلها با امکان نشون دادن روند پیشرفت بوسیله پروگرس بار :




procedure CopyFileWithProgressBar1(Source, Destination: string);
var
FromF, ToF: file of byte;
Buffer: array[0..4096] of char;
NumRead: integer;
FileLength: longint;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with Progressbar1 do
begin
Min := 0;
Max := FileLength;
while FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
Position := Position + NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end;




البته حتما تو فرمتون باید یه ProgressBar داشته باشین و اگه تو کد نمیخواین تغییر بدین اسم Progress bar رو بذارین Progressbar1.