PDA

View Full Version : نکات برنامه نویسی در دلفی



صفحه : 1 [2]

علی کشاورز
یک شنبه 17 شهریور 1387, 16:40 عصر
لینکهای آخر فهرست ، اشتباها همه به تغییر ولیوم اشاره میکند
مشکل از نرم افزار سایت هست.

lolojoon
دوشنبه 18 شهریور 1387, 16:44 عصر
کد بستن Alt + F4 :




if (key =VK_F4 ) And ( ssAlt in shift ) then Key:=0





کد On Top کردن فرم :



procedure TForm1.FormShow(Sender: TObject);

begin

SetWindowPos(Form1.Handle,HWND_TOPMOST,

0, 0, 0, 0,

SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);



end;

Mah6447
چهارشنبه 20 شهریور 1387, 19:44 عصر
جناب آقای babak_delphi دست شما درد نکند تست زدم درست کار می کند
حال آیا می توان با استفاده از کلیک های Up , Down و با توجه به Taborder های تعریف شده
حرکت کرد (راهی شبیه به راه عنوان شده)
با تشکر

dornasho
جمعه 10 آبان 1387, 12:33 عصر
Uses ..., axctrls;

procedure TForm1.Open1Click(Sender: TObject);
var
f : TFileStream;
graphic : TOleGraphic;
begin
if OpenDialog1.Execute then
begin
graphic := TOleGraphic.Create;
f := TFileStream.Create (OpenDialog1.FileName,
fmOpenRead or fmShareDenyNone);
try
graphic.LoadFromStream(f);
Image1.Picture.Assign(graphic);
finally
f.Free
end
end
end;

dornasho
جمعه 10 آبان 1387, 12:45 عصر
تبدیل اشیاء موجود در فرم به تصویر

توضیح با یک مثال:

یک استرینق گراید در فرم داریم می خواهیم تصویری از محتویاتش در فرم داشته باشیم:


uses clipbrd;


procedure TForm1.Button1Click(Sender: TObject);
var
CopiaGRID : TBitmap;
begin
CopiaGRID := TBitmap.Create;
CopiaGRID.Width := StringGrid1.Width;
CopiaGRID.Height := StringGrid1.Height ;
StringGrid1.PaintTo (CopiaGRID.Canvas.Handle, 0, 0);
clipboard.assign(CopiaGRID);
CopiaGRID.Destroy;
end;

حالا تصویر استرینق گراید ما در کلیپ برد موجود است و با دستور زیر در یک Timag لود می کنیم:

procedure TForm1.Button2Click(Sender: TObject);
var
bmp: TBitmap;
begin
if Clipboard.HasFormat(CF_PICTURE) then
begin
bmp := TBitmap.Create;
try
bmp.Assign(Clipboard);
Image1.Picture.Bitmap.Assign(bmp);
except
// Can't convert
end;
bmp.Free;
end else
begin
ShowMessage('تصويري در حافظه مو جود نيست');
end;
end;

dornasho
جمعه 10 آبان 1387, 12:49 عصر
توضیح با مثال:

یک استرینق گراید در فرم داریم می خواهیم تصویری از محتویاتش در یک TImage داشته باشیم:

با فرمان زیر تصویر استرینق گراید را به حافظه کلیپ برد منتقل می کنیم:


uses clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
CopiaGRID : TBitmap;
begin
CopiaGRID := TBitmap.Create;
CopiaGRID.Width := StringGrid1.Width;
CopiaGRID.Height := StringGrid1.Height ;
StringGrid1.PaintTo (CopiaGRID.Canvas.Handle, 0, 0);
clipboard.assign(CopiaGRID);
CopiaGRID.Destroy;
end;


حالا به دستور زیر تصویر را در یک TImage فرا خوانی می کنیم:


procedure TForm1.Button2Click(Sender: TObject);
var
bmp: TBitmap;
begin
if Clipboard.HasFormat(CF_PICTURE) then
begin
bmp := TBitmap.Create;
try
bmp.Assign(Clipboard);
Image1.Picture.Bitmap.Assign(bmp);
except
// Can't convert
end;
bmp.Free;
end else
begin
ShowMessage('تصويري در حافظه مو جود نيست');
end;
end;

مائده 100
چهارشنبه 15 آبان 1387, 08:12 صبح
با سلام و عرض خیر مقدم خدمت برنامه نویسان و برنامه نویسان بعد از این :wink: ...
در این بخش میخوایم در مورد مسائل و نکاتی از برنامه نویسی کاربردی بحث کنیم، مواردی که بعد از رسم تمامی دیاگرام ها و فلوچارتهای برنامه به آنها میرسیم و مثل ... میمونیم تو گل
امیدوارم دوستان دیگر هم اگه نکاتی دارن که به درد بقیه هم میخوره حتماً در اینجا مطرح کنن ... .


-- با اجازه آقا محمد --
hr110 : آدرس نکات برنامه نویسی درون این پست به این شرح می‌باشند:

باز و بسته کردن سیدی درایو (http://barnamenevis.org/forum/showpost.php?p=45449&postcount=3)
تغییر Volume ویندوز (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=4)
چگونه لیست سیدی درایوهای کامپیوتر را بدست آوریم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=5)
تغییر Resolution مونیتور (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=6)
قرار دادن یک Bitmap در یک متافایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=7)
بدست آوردن Serial Number درایو (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=8)
از بین بردن یک Task در ویندوز (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=9)
شناسایی یک فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=10)
کلیه اعمال قابل انجام روی فلاپی دیسک (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=11)
دیالوگ برای Select Directory (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=13)
روش چرخاندن یک نقطه در فضای دو بعدی حول یک نقطه دوبعدی دیگر: (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=14)
Screen Shots (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=15)
محاسبه سن یک فرد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=16)
محاسبه لگاریتم با پایه متغیر (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=17)
ضرب اعداد صحیح بزرگ (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=18)
استفاده از الگوریتم Base64 جهت Encoding و Decoding (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=19)
محاسبه فاکتوریل یک عدد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=20)
محاسبه معکوس یک ماتریس (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=21)
تعیین اول بودن یک عدد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=22)
تغییر مبنای یک عدد از مبنای هشت به Integer (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=23)
تغییر مبنای یک عدد Integer به مبنای هشت (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=24)
تعیین شماره روز در سال (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=25)
تبدیل یک عدد هگزادسیمال به باینری (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=26)
تغییر مقیاس یک تصویر (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=27)
رندر متن یک TrichEdit در یک Canvas (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=28)
تغییر وضوح یک Jpg (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=29)
اعمال فیلتر Emboss روی یک تصویر (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=30)
highlight کردن متن درون Twebbrowser (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=31)
بدست آوردن پروسسهای فعال شبکه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=32)
ایجاد یک TWebBrowser در RunTime (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=33)
استفاده از ClientSocket و ServerSocket (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=34)
بدست آوردن لیست کاربران موجود در شبکه Remote (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=35)
چاپ یک صفحه در TwebBrowser (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=36)
انتخاب یک کامپیوتر در شبکه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=37)
لود کردن یک کد html بصورت مستقیم در TWebBrowser (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=38)
ارسال پیام در ICQ (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=39)
تبدیل یک فایل CSV به XML (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=40)
لیست تمام فایلهای موجود در یک دایرکتوری (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=41)
نصب یک فایل INF در دلفی (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=42)
دسترسی به ListBox از طریق API (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=43)
لیست تمام زیرپوشه های یک پوشه اصلی (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=44)
جایگزینی یک متن درون TextFile (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=45)
تغییر نام یک دایرکتوری (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=46)
خواندن یک فایل table-textfile درون یک StringGrid (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=47)
استفاده از توابع shell برای copy/move یک فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=48)
اضافه کردن اطلاعات به یک فایل EXE (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=49)
پاک کردن یک فایل درون پوشه Document (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=50)
توابع مفید جهت کار با Stream (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=51)
تبدیل OEM به ANSI (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=52)
ثبت خروجی یک برنامه DOS (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=53)
قرار دادن یک فایل Exe درون برنامه و اجرای آن (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=54)
پاک کردن برنامه توسط خودش بعد از اجرای آن (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=55)
غیر فعال کردن دکمه Close در فرم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=56)
روش استفاده از TFileStream (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=57)
جایگزینی یک Dll در حال استفاده از آن (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=58)
تغییر صفات یک فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=59)
خواندن یک فایل متنی بصورت خط به خط و تغییر آن (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=60)
تعیین فضای آزاد دیسک (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=61)
استفاده از فایلهای INI (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=62)
سایز یک دایرکتوری (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=63)
کپی کردن یک فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=64)
روش بدست آوردن اطلاعات CPU (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=65)
مشخص کردن وجود Terminal Service ها (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=66)
کپی فایلهای دایرکتوری (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=67)
تعیین نسخه MS Word نصب شده روی کامپیوتر (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=68)
وارد کردن یک متن RTF در Word (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=69)
فشرده سازی و ترمیم یک بانک اطلاعاتی Access (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=70)
ایجاد Database در یک بانک اطلاعاتی sql sever 2000 در حالت local (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=71)
پیدا کردن یک مقدار در فیلد ایندکس نشده به کمک TTable (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=72)
تهیه خروجی از جداول ADO به فرمتهای مختلف (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=73)
ایجاد خروجی از TDBGrid به قالب Excel (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=74)
دسترسی به جداول paradox روی cdrom یا درایوهای Read Only (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=75)
ایجاد یک جدول مجازی (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=76)
ایجاد سریع یک جدول پارادوکس به کمک کد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=77)
ایجاد یک اتصال DBExpress در زمان اجرا (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=78)
رنگ آمیزی یک TDBGrid (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=79)
خواندن تمام رکوردهای یک جدول در TstringGrid (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=80)
جلوگیری از لیست توماری شدن منو (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=82)
به چرخش در آوردن متن (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=83)
یافتن فایل در تمام شاخه و زیر شاخه هایش (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=84)
بدست آوردن Handle یک پروسه با نام فایلش (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=85)
فرم شفاف شده و فقط کنترل ها نشان داده شود (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=86)
مخفی و ظاهر ساختن عنوان فرم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=87)
خذف یا انتقال فایل در حال اجرا توسط برنامه دیگر ( فقط در ویندوز نوع NT) (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=88)
تعیین وضعیت مانیتور (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=89)
طریقه بوت کردن ویندوز 2000 و XP (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=90)
چگونه میتوان پنجره اضافه کردن چاپگر را نمایش داد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=91)
چگونه میتوان کنترل صفحه کلید را در تمامی ویندوزها بدست گرفت (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=92)
کد خطا های زمان اجرای دلفی (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=93)
نشان دادن تمام گزینه های منو در روی دکمه برنامه در Taskbar (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=94)
زمان آخرین دسترسی به یک فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=95)
فهمیدن اینکه آیا یک ایمیل از نظر املایی درست است یا نه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=96)
حذف داده های تکراری از لیست (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=97)
ساده ترین راه برای باز کردن یک فایل توسط برنامه مرتبط با آن (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=98)
ایجاد سایه در زیر فرم ها (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=99)
پیدا کردن یک پروسه در پروسه های دیگر با نام فایلش (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=100)
تقریبا کلیه فانکشن هایی که برای کار با فلاپی نیاز میشه ... (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=101)
بدست آوردن پسورد فایلهای اکسس 97 (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=102)
تشخیص نصب بودن یا نبودن کارت صدا ... (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=103)
بدست آوردن و تنظیم کردن صدا در سیستم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=104)
چگونه دکمه Caps Lock را روشن و خاموش کنیم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=105)
چگونه می توان از جابجایی فرم جلوگیری کرد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=106)
چگونه می توان RecycleBin را خالی کرد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=107)
فرمت کردن یک دریاو در win32 (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=108)
عوض کردن wallpaper (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=109)
این یه کد برای نوشتن یک عدد به حروف (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=110)
ذخیره کردن یک فرم به عنوان یک عکس (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=112)
Drop Dawn کردن آیتم های لیست باکس (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=113)
گذاشتن هرگونه عکس بر روی BitBtn ... (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=114)
نمایش صفحه مشخصات یک فایل ( Properties ) ... (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=115)
مشخص نمودن وضعیت اتصال به اینترنت (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=116)
بدت آوردن نام کاربر (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=117)
Extract an Icon from EXE or DLL file (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=118)
این تابع برنامه مورد نظر را اجر میکند و تا زمان خاتمه آن منتظر میماند. (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=119)
روشن و خاموش کردن Numlock (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=120)
نمایش سطرهای یک Grid به صورت یکی در میان (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=121)
چگونه سایز Col را در یک DBGrid به صورت اتوماتیک قرار دهیم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=123)
اضافه نمودن یک کاربر جدید داخل یک دیتابیس در SQLServer 2000 (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=124)
کنترل ولوم صدا با استفاده از کد نویسی (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=125)
نحوه استفاده بررسی خالی بودن کنترل TImage (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=126)
رنگ آمیزی کنترلهای تمکرز یافته(Focused Control) (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=127)
CheckBox در DBGrid (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=130)
تبدیل عدد به حرف (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=134)
نشان دادن فرم بدون دکمه ای در تسکبار (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=135)
تشخیص اتصال به شبکه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=138)
چه مدت است که ویندوز شما در حال اجراست (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=139)
ایجاد میانبر از یک فایل در ویندوز (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=140)
minimize کردن کلیه پنجره ها (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=141)
تغییر تاریخ سیستم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=142)
نمایش مجموع مقادیر در DbGrid (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=143)
تغییر Resolution مونیتور (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=144)
shutdown and restart and logof windows (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=145)
تصویر توسعه‌دهندگان دلفی 7 (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=147)
تعریف آرایه های ثابت (Constant) در Delphi (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=157)
دو کد نمونه برای کار با آرایه هایی از کامپوننتها (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=158)
بر زدن (Shuffle) آرایه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=159)
تشخیص اتصال (connection) به اینترنت (internet) (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=163)
دانلود (download) فایل از اینترنت با نمایش درصد پیشرفت (progress indicator) (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=164)
خواندن (Get) لیست favorites از IE (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=165)
تغییر صفحه Home Page در IE (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=166)
بدست آوردن لیست NetWork Drive ها (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=167)
تعیین screen saver (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=169)
تعیین زمان در حال اجرا بودن windows (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=170)
تشخیص Administrator بودن کاربر (user) (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=171)
تبدیل RGB به CMYK (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=172)
یافتن MyDouments برای کاربر جاری (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=173)
Cool how Can I Read a unicode text file in Delphi (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=174)
تغییر اندازه کلید Start (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=175)
چک کردن اینکه آیا فایل در Local Drive می باشد. (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=176)
چک کردن اینکه پارتیشن Fat میباشد یا NTFS (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=177)
چک کردن اینکه آیا سرویسی مورد نظر start می باشد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=178)
چک کردن اینکه آیا Sound card نصب شده است (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=179)
چک کردن اینکه آیا دلفی در حال اجراست (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=180)
پیدا کردن و بارگذاری Icon داخل فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=181)
با این تابع می توانید ولوم سریالِ دیسک را بدست آوردید (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=182)
چگونه Edit فقط عدد بگیرد (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=183)
چگونه برنامه مان فقط یک نسخه اجرا شود (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=184)
تغییر رزولوشن مانیتور (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=185)
خالی کردن Editهای یک فرم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=186)
چک کردن خالی بودن یک مسیر (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=187)
آیا فایل مورد نظر باینری است یا نوشتاری است (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=188)
چگونه فایلهای INI را نصب کنی (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=189)
چگونه تعداد ایتمها ی ListBox را با API بدست اوریم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=190)
چگونه یک ایتم ListBox را با API حذف کنی (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=191)
چگونه ایتم انتخاب شده ی ListBox را توسط API بدست اوریم (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=192)
گرفتن ایتم یک ایتم ListBox توسط API (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=193)
بدست اوردن تمامی ایتم های یک ListBox توسط API (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=194)
تغییر نام یک پوشه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=195)
باز کردن یک پوشه توسط Windows Explorer (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=196)
بدست اوردن مالک ( Owner ) یک فای (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=197)
مقایسه ی اندازه ی دو فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=198)
بدست اوردن تاریخ یک فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=199)
ایا فایل ما ASCII است (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=200)
بدست اوردن حجم یک فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=201)
کپی کردن یک پوشه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=202)
جا به جا کردن یک پوشه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=203)
حذف یک پوشه (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=204)
گرفتن مسیر جاری و تغییر مسیر جاری (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=205)
کپی کردن فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=206)
خواندن Version Info یک فایل (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=207)
ریختن یک فایل در سطل زباله ویندوز ... (http://barnamenevis.org/forum/showpost.php?p=45450&postcount=208)
ما هر قسمتی را روش کلیک می کنیم فقط بخش تغییر vllow سیستم را می آره

علی کشاورز
چهارشنبه 15 آبان 1387, 16:45 عصر
ما هر قسمتی را روش کلیک می کنیم فقط بخش تغییر vllow سیستم را می آره
در پست شماره 252 یک بار توضیح دادم.

cayberfox
یک شنبه 19 آبان 1387, 20:05 عصر
کسانی که از بانک اطلاعاطی پارادوکس استفاده ميکنن برای جلوگيری از تخريب فايل و حذف فيزيکی رکوردها از جداول اطلاعاتی هرچند وقت يکبار اقدامبه فشرده کردن جدول کنند تابع زير که به paradoxpack موسوم است جهت فشرده كردن جداول پارادوكس ارائه ميشود
يونيتDBIPROCS را به قسمت uses اضافه کنید



procedure TForm1.ParadoxPack(Tabela: TTable);

var TBDesc: CRTblDesc;

hDb: hDbiDb;

CaminhoTabela: array[0..dbiMaxPathLen] of char;

begin

If not Tabela.Active then

Tabela.Open;

FillChar(TBDesc,Sizeof(TBDesc),0);

With TBDesc do begin

StrPCopy(szTblName,Tabela.TableName);

StrPCopy(szTblType,szParadox);

bPack:=True;

end;

hDb:=nil;

Check(DbiGetDirectory(Tabela.DBHandle,True,Caminho Tabela));

Tabela.Close;

Check(DbiOpenDatabase(nil,'STANDARD',dbiReadWrite, dbiOpenExcl,nil,0,nil,nil,hDb) );

Check(DbiSetDirectory(hDb,CaminhoTabela));

Check(DBIDoRestructure(hDb,1,@TBDesc,nil,nil,nil,F alse));

Tabela.Open;

end;


procedure TForm1.Button1Click(Sender: TObject);

begin

ParadoxPack(Table1);

end;

cayberfox
سه شنبه 21 آبان 1387, 07:16 صبح
خیلی ها از بانک اطلاعاتی اکسس تو برنامه هاشون استفاده میکنن
این کد برای فشرده سازی و تعمیر بانک های اکسس


uses
ComObj;

function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var
v: OLEvariant;
begin
Result := True;
try
v := CreateOLEObject('JRO.JetEngine');
try
V.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4. 0;Data Source='+DB,
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB+'x;Jet OLEDB:Engine Type=5');
DeleteFile(DB);
RenameFile(DB+'x',DB);
finally
V := Unassigned;
end;
except
Result := False;
end;
end;

دکمه64
دوشنبه 27 آبان 1387, 21:15 عصر
کدی برای تست روشن بودن چراغ های سه گانه


public
procedure CheckCapslock;
procedure CheckNumlock;
procedure CheckInslock;
procedure CheckScrlock;
{ public declarations }
end;
procedure TForm1.CheckCapslock;
begin
if Odd (GetKeyState (VK_CAPITAL)) then
StatusBar1.Panels[1].Text := 'Caps'
else
StatusBar1.Panels[1].Text := '';
end;
procedure TForm1.CheckNumlock;
begin
if Odd (GetKeyState (VK_NUMLOCK)) then
StatusBar1.Panels[2].Text := 'Num'
else
StatusBar1.Panels[2].Text := '';
end;
procedure TForm1.CheckInslock;
begin
if Odd (GetKeyState (VK_INSERT)) then
StatusBar1.Panels[3].Text := 'Ins'
else
StatusBar1.Panels[3].Text := '';
end;
procedure TForm1.CheckScrlock;
begin
if Odd (GetKeyState (VK_SCROLL)) then
StatusBar1.Panels[4].Text := 'Scr'
else
StatusBar1.Panels[4].Text := '';
end;
procedure TForm1. Timer1Timer(Sender: TObject);
begin
CheckCapslock;
end;
procedure TForm1. Timer2Timer(Sender: TObject);
begin
CheckNumlock;
end;
procedure TForm1. Timer3Timer(Sender: TObject);
begin
CheckInslock;
end;
procedure TForm1. Timer4Timer(Sender: TObject);
begin
CheckScrlock;
end;

دکمه64
دوشنبه 27 آبان 1387, 21:23 عصر
کدی برای بزرگ کردن حرف اول در ادیت باکس ها
[
CODE]
procedure TForm1.DBEdit1Change(Sender: TObject);
var

Cursor : Integer;
begin
if DBEdit1.Text <> '' then
begin
Cursor:=DBEdit1.SelStart;
DBEdit1.Text := UpperCase(Copy(DBEdit1.Text,1,1)) +
LowerCase(Copy(DBEdit1.Text,2,Length(DBEdit1.Text) ));
DBEdit1.SelStart := Cursor;
end;
end;



[/CODE]

alireza71
سه شنبه 28 آبان 1387, 18:30 عصر
سلام
ببخشيد ميخواستم بدونم چه طوري ميشه فونت را به فايل اجرايي(exe) در دلفي اضافه كنيم.
email:alireza2756@gmail.com

negarin5340
دوشنبه 04 آذر 1387, 07:49 صبح
سلام
من یه مشکل بزرگ دارم اگه بهم کمک کنید ممنون میشم مشکل من اینه که :
بعد از این که اطلاعاتم رو ذخیره می کنم با بستن برنامه و ویا خاموش کردن کامپیوتر اطلاعات ذخیره شده حذف می شود تو رو خدا کمکم کنید . راه حل رو بهم بگید

دکمه64
دوشنبه 04 آذر 1387, 21:20 عصر
سلام
من یه مشکل بزرگ دارم اگه بهم کمک کنید ممنون میشم مشکل من اینه که :
بعد از این که اطلاعاتم رو ذخیره می کنم با بستن برنامه و ویا خاموش کردن کامپیوتر اطلاعات ذخیره شده حذف می شود تو رو خدا کمکم کنید . راه حل رو بهم بگید

لطفا کمی کاملتر توضیح بدین،چه اطلاعاتی،اصلا برنامتون چیه و چی کار می کنه؟

negarin5340
سه شنبه 05 آذر 1387, 07:50 صبح
سلام مجدد
برنامه من برای یه شرکته که تمام حساب های دفتری اونها رو می خوام به برنامه تبدیل کنم این برنامه کارهای زیر رو اجام میده :
1- ثبت کردن اطلاعات
2 - ویرایش اطلاعات
3- حذف اطلاعات
و جستجو که این برنامه چون برای یه مرکز ISP است بطور مثال با وارد کردن شماره تلفن اطلاعات خواسته شده رو نمایش دهد
مشکل من حالا اینه اون اطلاعات مربوط به یک نفر رو که ذخیره می کنم باید باشه که بتونم کارهای دیگگگه رو انجام بدم نه اینکه هر روز صبح کاربر اطلاعات رو دوباره ذخیره کنه چون می خواهیم با این برنامه حساب های دفتری رو ببندیم تو رو خدا کمکم کنید

دکمه64
چهارشنبه 06 آذر 1387, 20:50 عصر
مشکل شما اون پایگاه داده ای هست که استفاده می کنید.
من معمولا از اکسس استفاده می کنم و با دستور post که بعد از هر بار وارد کردن اطلاعاتم انجام میشه ، اطلاعاتم از بین نمی ره ، حتی اگه وسط کار برق قطع بشه.

negarin5340
یک شنبه 10 آذر 1387, 08:34 صبح
سلام
من با access کار کردم ولی نمی دونم چه طوری اونو با دلفی ارتباط بدم اگه میشه منو راهنمایی کنید کتاب هم خوندم ولی چیزی داخلش نبوده
یه سوالبطور مثال در پارادوکس نام فیلدها رو می نویسیم
در accessهم بهمون طریقی که جدولها رو ایجاد می کردیم ابتدا database بعد ساختن جدول و در کل ذخیره کردن اون بعد که اونو ذخیره کردم چه طوری به دلفی معرفی کنم که دلفی بتونه اونو بشناسه تو رو خدا کمکم کنید

دکمه64
یک شنبه 10 آذر 1387, 21:55 عصر
سلام
من با access کار کردم ولی نمی دونم چه طوری اونو با دلفی ارتباط بدم اگه میشه منو راهنمایی کنید کتاب هم خوندم ولی چیزی داخلش نبوده
یه سوالبطور مثال در پارادوکس نام فیلدها رو می نویسیم
در accessهم بهمون طریقی که جدولها رو ایجاد می کردیم ابتدا database بعد ساختن جدول و در کل ذخیره کردن اون بعد که اونو ذخیره کردم چه طوری به دلفی معرفی کنم که دلفی بتونه اونو بشناسه تو رو خدا کمکم کنید

عناصر:
1) ADOTable1 از صفحه ADO
2) DBGrid1
3) DataSource1

خاصیت dataset عنصر DataSource1 را ADOTable1 انتخاب کنید
خاصیت DataSource عنصر DBGrid1 را DataSource1 انتخاب کنید
خاصیت ConnectionString عنصر ADOTable1 را کلیک کرده گزینه Use ConnectionString را انتخاب و دکمه build را کلیک کنید در صفحه بعد گزینه Microsoft.Jet.OLEDB.4.0 را انتخاب و دکمه next را کلیک کنید در صفحه Connection مسیر فایل اکسس ذخیره شده را انتخاب و دکمه ok را کلیک کنید.
حال خاصیت Tablename عنصر ADOTable1 را جدول مورد نظر ساخته شده در فایل اکسس انتخاب کنید و در آخر خاصیت active عنصر ADOTable1 را true کنید
بیشتر دستوراتی که باید با عنصر ADOTable استفاده کنید همانند عنصر Table هست.
موفق باشید.

دکمه64
یک شنبه 10 آذر 1387, 21:58 عصر
سلام
من با access کار کردم ولی نمی دونم چه طوری اونو با دلفی ارتباط بدم اگه میشه منو راهنمایی کنید کتاب هم خوندم ولی چیزی داخلش نبوده
یه سوالبطور مثال در پارادوکس نام فیلدها رو می نویسیم
در accessهم بهمون طریقی که جدولها رو ایجاد می کردیم ابتدا database بعد ساختن جدول و در کل ذخیره کردن اون بعد که اونو ذخیره کردم چه طوری به دلفی معرفی کنم که دلفی بتونه اونو بشناسه تو رو خدا کمکم کنید

عناصر:
1) ADOTable1 از صفحه ADO
2) DBGrid1
3) DataSource1

خاصیت dataset عنصر DataSource1 را ADOTable1 انتخاب کنید
خاصیت DataSource عنصر DBGrid1 را DataSource1 انتخاب کنید
خاصیت ConnectionString عنصر ADOTable1 را کلیک کرده گزینه Use ConnectionString را انتخاب و دکمه build را کلیک کنید در صفحه بعد گزینه Microsoft.Jet.OLEDB.4.0 را انتخاب و دکمه next را کلیک کنید در صفحه Connection مسیر فایل اکسس ذخیره شده را انتخاب و دکمه ok را کلیک کنید.
حال خاصیت Tablename عنصر ADOTable1 را جدول مورد نظر ساخته شده در فایل اکسس انتخاب کنید و در آخر خاصیت active عنصر ADOTable1 را true کنید
بیشتر دستوراتی که باید با عنصرADOTable استفاده کنید همانند عنصرTable هست.
موفق باشید.

Pr0grammer
سه شنبه 12 آذر 1387, 00:53 صبح
یه برنامه شبیه Magnifier ویندوز

Akam Zandi
یک شنبه 17 آذر 1387, 23:20 عصر
باسلام وتشکّر:
من روی هر لینکی که کلیک می کنم اون لینک باز نمی شه؟

hashem_te
دوشنبه 18 آذر 1387, 09:00 صبح
با سلام
اكثر لينكهاي فوق اشتباها به "تغییر Volume ویندوز" منتهي ميشوند
من با لينك "غير فعال كردن دگمه Close در فرم" كار داشتم ولي كليك روي آن صفحه "تغییر Volume ویندوز" را باز ميكند

در صورت امكان اصلاح نماييد
با تشكر
هاشمي
hashemi-te@esfahansteel.com

دکمه64
پنج شنبه 21 آذر 1387, 14:10 عصر
StatusBarروی ProgressBar نصب
StatusBar می باشد. انجام این کار بسیار ساده است. برای این کار کافی است بر روی فرم خود یک StatusBar اضافه نمایید حالا در قسمت تعاریف متغیر های عمومی کد زیر را بنویسید:


ProgressBar1: TprogressBar;

در ادامه دستورات زیر را در خاصیت OnCreate فرم خود بنویسید:

var
ProgressBarStyle: LongInt;
begin
{create a run progress bar in the status bar}
ProgressBar1 := TProgressBar.Create(StatusBar1);
ProgressBar1.Parent := StatusBar1;
{remove progress bar border}
ProgressBarStyle := GetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE);
ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);
{set progress bar position and size - put in Panel[2]}
ProgressBar1.Left := StatusBar1.Panels.Items[0].Width +
StatusBar1.Panels.Items[1].Width + 4;
ProgressBar1.Top := 4;
ProgressBar1.Height := StatusBar1.Height - 6;
ProgressBar1.Width := StatusBar1.Panels.Items[2].Width - 6;
{set range and initial state}
ProgressBar1.Min := 0;
ProgressBar1.Max := 100;
ProgressBar1.Step := 1;
ProgressBar1.Position := 0;
end;



حالا برای آنکه پس از خارج شدن از فرم حافظه اشغال شده آزاد گردد، در قسمت OnDestroy در Event فرمتان دستور زیر را اضافه نمایید:
ProgressBar1.free;

دکمه64
دوشنبه 25 آذر 1387, 22:52 عصر
تغییر Hint برای هر ستون از DBGrid در دلفی

ابتدا باید یک عنصر جدید مبتنی بر TDBGrid ایجاد کنید و رویداد OnMouseMove را فراخوانی کنید:

type
TMyDBGrid = class(TDBGrid)
published
property OnMouseMove;
end;


اگرچه شما در رویداد OnMouseMove مختصات X و Y را بدست خواهید آورد، اما شما باید ستون مورد نظر را پیدا کنید. برای ادامه کار لازم است که سطر زیر را در قسمت protected قرار دهید:

procedure WMMouseMove(var Message : TWMMouse); message WM_MOUSEMOVE;

همچنین متغیر های زیر را در قسمت public اضافه نمایید:

MouseRow : integer;
MouseCol : integer;

بنابراین متد WMMouseMove بصورت ریر خواهد بود:

procedure TMyDBGrid.WMMouseMove(var Message : TWMMouse);
var
t : TGridCoord;
begin
t := MouseCoord(Message.XPos, Message.YPos);
MouseCol := t.x;
MouseRow := t.y;
inherited;
end;


ما ابتدا فیلدهای XPost و YPos را از ساختار WMMouseMove تنظیم میکنیم:

procedure TForm2.MyDBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
Integer);
begin
if (((dgIndicator in MyDBGrid1.Options) and (MyDBGrid1.MouseCol > 0)) or
((not (dgIndicator in MyDBGrid1.Options)) and (MyDBGrid1.MouseCol <> -1)))
and (MyDBGrid1.MouseCol <> OldMouseCol) then begin
OldMouseCol := MyDBGrid1.MouseCol;
if dgIndicator in MyDBGrid1.Options then
MYDBGrid1.Hint := MyDBGrid1.Columns[MyDBGrid1.MouseCol - 1].FieldName
else
MYDBGrid1.Hint := MyDBGrid1.Columns[MyDBGrid1.MouseCol].FieldName;
end;
end;



حالا مجددا" تعریف زیر را در قسمت public قرار دهید:

HintMouseMessage(Control : TControl; var Message : TMessage)

در قسمت OnMouseMove از TDBGrid نیز فرامین زیر را اضافه نمایید:

var
r : TMessage;
begin

Application.HintMouseMessage(self, r);
TWMMouse(r).XPos := X;
TWMMouse(r).YPos := Y;
Application.HintMouseMessage(MyDBGrid1, r);
end;

دکمه64
دوشنبه 25 آذر 1387, 22:54 عصر
نمایش میزان كپی شدن فایل با ProgressBar در دلفی

چطور میتوان زمان کپی شدن فایل را با استفاده از ProgressBar نمایش داد؟
برای انجام این کار ابتدا بر روی یک فرم یک ProgressBar اضافه کنید سپس تابع زیر را تایپ کنید:

procedure TForm1.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;
end;


در این تابع شما در واقع فایل مبدا را خوانده و در مقصد مینویسید. حالا یک دکمه اضافه کرده کد زیر رو اضافه نمایید:

procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFileWithProgressBar1('c:\Welcome.exe', 'c:\temp\Welcome.exe');
end;



چطور می توان زمان کپی شدن فایل را محاسبه و نمایش داد؟
برای این کار نیز میتوانید از تابع زیر استفاده کنید:

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
FromF, ToF: file of byte;
Buffer: array[0..4096] of char;
NumRead: integer;
FileLength: longint;
t1, t2: DWORD;
maxi: integer;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with Progressbar1 do
begin
Min := 0;
Max := FileLength;
t1 := TimeGetTime;
maxi := Max div 4096;
while FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
t2 := TimeGetTime;
Min := Min + 1;
// Show the time in Label1
label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100);
Application.ProcessMessages;
Position := Position + NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
end;


در این تابغ ابتدا زمان اولیه در متغیر t1 ذخیره شده و سپس پس از کپی شدن هر قسمت از فایل، زمان در متغیر t2 ذخیره میشود و توسط فرمول زیر مقدار زمان باقی مانده تا کپی کامل فایل بدست می آید.


((t2 - t1) / min * maxi - t2 + t1) / 100

hadiaj168
جمعه 27 دی 1387, 23:19 عصر
بازی حدس زدن عدد.مثبت یعنی عدد و مکانش درسته،منفی یعنی فقط عدد درسته و جاش غلطه!

Naruto
شنبه 28 دی 1387, 05:17 صبح
من با لينك "غير فعال كردن دگمه Close در فرم" كار داشتم ولي كليك روي آن صفحه "تغییر Volume ویندوز" را باز ميكند


سلام.
غیرفعال کردن دکمه Close در SystemMenu :



Var
hMenuHandle: Integer;
Begin
hMenuHandle := GetSystemMenu(Handle, False);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
End;


فعال کردن دکمه Close در SystemMenu :



Var
hMenuHandle:Integer;
Begin
hMenuHandle := GetSystemMenu(Handle, True);
if (hMenuHandle <> 0) then
EnableMenuItem(hMenuHandle,SC_CLOSE,MF_BYCOMMAND OR MF_ENABLED);
End;

hadiaj168
پنج شنبه 08 اسفند 1387, 23:31 عصر
یه برنامه برای محاسبه هزینه تلفن و اینترنت یه چیزی شبیه DialSpy البته در اندازه های کوچیکتر:لبخندساده:
ممنون میشم اگه نظر بدین واشکالاتم رو بگید.
البته بیشترش حاصل کد ها و راه نمایی های خودتونه!
یک قسمت دیگه به برنا مه اضافه کردم که به صورت خودکار پروسه های مورد نظر رو اجرا یا متوقف کنه.
من خودم عادت دارم وقتی به اینترنت وصل میشم آنتی ویروس رو راه اندازی میکنم و پس از قطع ارتباط میبندمش قسمت اظافه شده این کار رو انجام میده.(آخر تن پروری:لبخند:!)
و برخی برنامه ها هم در هنگام اتصال باید بسته باشن تا تقلبی بودن شون توسط سرور معلوم نشه و از کار نیفتن مثل مجموعه CS4.
(سه فایل زیپ 1و2و3 را داخل یک پوشه خالی کنید)

Yasersadegh
چهارشنبه 24 تیر 1388, 08:48 صبح
در رويداد FormCreate ابتدا يك متغير تعريف مي كنيم :



var h: THandle;

سپس با استفاده از كد زير ابتدا يك بيضي ساخته و سپس فرم را به شكل اين بيضي در مي آوريم:




h := CreateEllipticRgn(40,40,300,200);
SetWindowRgn(form1.Handle,h,TRUE);

Yasersadegh
چهارشنبه 24 تیر 1388, 08:52 صبح
در دلفي مي توان با استفاده از متد Show يك فرم را نمايش داد.
در اين قسمت مي خواهيم كه در صورت صحيح بودن يك شرط از نمايش فرم جلوگيري شود.
براي اين كار، با توجه به اينكه با فراخواني متد Show در فرم اول ، رويداد Onshow از فرم دوم اجرا مي شود. بايد از كد زير در اين رويداد(يعني رويداد onShow فرم دوم) استفاده كنيم :



if Form1.Edit1.Text=IntToStr(1) then
PostMessage(form2.Handle,WM_CLOSE,0,0);



دستور PostMessage با پارامتر WM_CLOSE باعث عدم نمايش فرم مي شود. در كد بالا در صورتي كه مقدار Edit1 برابر با 1 شود، Form2 نمايش داده نمي شود.

MOJTABAATEFEH
پنج شنبه 26 شهریور 1388, 21:08 عصر
آقاي mzjahromi مطلب پست 127 روي عبارات IsPublishedProp و GetOrdProp و SetOrdProp خطا ميده و ناشناس تشخيص داده مي شوند لطفا رسيدگي كنيد

با تشكر

MOJTABAATEFEH
پنج شنبه 26 شهریور 1388, 21:18 عصر
با این کد می توانید عنوان دکمه برنامه خودتون رو در Taskbar متحرک کنید :



procedure TForm1.Timer1Timer(Sender: TObject);
const
{$J+}
animatedTitle : string = 'www.mojtabaie.persianblog.ir';
{$J-}
var
cnt: Integer;

begin
Application.Title := animatedTitle;
for cnt := 1 to (Length(animatedTitle) - 1) do
begin
animatedTitle[cnt] := Application.Title[cnt + 1];
animatedTitle[Length(animatedTitle)] := Application.Title[1];
end;
end;

منبع : http://delphi.about.com (http://www.delphi.about.com)
www.mojtabaie.persianblog.ir (http://www.mojtabaie.persianblog.ir)
(http://delphi.about.com/)

MOJTABAATEFEH
پنج شنبه 26 شهریور 1388, 21:41 عصر
بدست آوردن Event های یکComponent :


uses


TypInfo;

...
procedure TForm1.Button1Click(Sender: TObject);
var
ListProp: PPropList;
TD: PTypeData;
Num, i: Integer;
begin
GetMem(ListProp, SizeOf(PPropInfo)*TD.PropCount);
Num:=GetPropList(
Sender.ClassInfo,
[tkMethod],
ListProp);
for i:=0 to Num-1 do
Memo1.Lines.Add(ListProp[i]^.Name);
end;

شما می توانید بجای Sender که با رنگ قرمز مشخص شده نام کامپوننت مورد نظر را بنویسید

Naruto
شنبه 28 شهریور 1388, 23:27 عصر
سلام دوستان.

دستور زیر به شما نشون میده که چطور تو رجیستری یه مقدار Multi-String درست کنید و چندخط توش بنویسید.




procedure TForm1.FormCreate(Sender: TObject);
Var
Reg : TRegistry;
begin
With Reg do
Begin
RootKey:= HKEY_LOCAL_MACHINE;
OpenKey('SYSTEM\CurrentControlSet\Services\Naruto' , False);
RegSetValueEx(CurrentKey,'ValueName',0,REG_MULTI_S Z,
PWideChar('YouString1'+#0+'YourString2'+#0),
Length('YourSting1'+#0+'YourString2'+#0)*2);
End;
End;

hadiaj168
شنبه 23 آبان 1388, 22:37 عصر
یک لیست (http://www.dswag.com/modules.php?op=modload&name=FAQ&file=index&myfaq=yes&id_cat=9&categories=WINDOWS+API&parent_id=0#89) از توابع WINDOWS API
· Determine the last access time of a given file
· Using the Shell API function SHBrowseForFolder()
· Detecting if the system time has been changed
· Trapping for when a user is done resizing a window
· Using the WIN API high resolution performance counter
· Getting modem status under Win32
· adding system menu items to a form
· Clearing the recent Documents from the Start Menu
· Copying files using the Standard Windows Copy file dialog box
· Creating a custom word break procedure
· How can I get serial number of my drive
· Determining Drive Type
· Using FindFirst to search for files.
· Getting an handle to a window in another application.
· Checking drive ready status.
· External function failure when passing boolean parms.
و....

مجتبی تاجیک
جمعه 25 دی 1388, 06:37 صبح
سلام

برنامه اتصال به اینترنت به صورت خودکار در ساعت مشخص.
ویژگی ها و تنظیمات:

1-تنظیم زمان اتصال.
2-تنظیم زمان قطع ارتباط .
3-خاموش شدن سیستم پس از قطع اتباط .
4-اجرای نرم افزار مدیریت دانلود .
5-خاموش شدن سیستم پس از سه بار خطا در برقراری ارتباط .
6-قرارگرفتن در startup .

چون از کامپوننت هایی استفاده کردم که به صورت پیش فرض روی دلفی نصب نیست و ممکنه دوستانی فقط به فایل اجرایی این برنامه احتیاج داشته باشن اون رو هم به صورت جداگانه آپ کردم.

امید وارم مفید واقع بشه...

[جناب کشاورز اگه دو دقیقه صبر میکردید محتواش هم میومد. بلا نسبت ... نیستم که ساعت 2 نصفه شب بشینم الکی تایپ کنم:عصبانی:]
:گریه:جای این مطلب به نظرت تو بخش پروژه های متن باز یا حداقل تاپیک جداگانه نبود ؟

zidane
دوشنبه 16 فروردین 1389, 08:12 صبح
اگر شما هم مثل من حالتون از http://contest2004.thinkquest.jp/tqj2004/70619/dic/dicmateria/crHandPoint.png(crHandPoint) به هم می خوره و می خواهید از شکل استاندارد ویندوز (http://telcontar.net/Misc/screeniecursors/Cursor%20hand%20white.png) استفاده کنید، کافیه در رویداد FormCreate خط زیر رو اضافه کنید تا crHandPoint به شکل استاندارد ویندوز تغییر کنه:

Screen.Cursors[crHandPoint] := LoadCursor(0, IDC_HAND);

Majid.Ebru
پنج شنبه 06 خرداد 1389, 13:04 عصر
اگر شما هم مثل من حالتون از http://contest2004.thinkquest.jp/tqj2004/70619/dic/dicmateria/crHandPoint.png(crHandPoint) به هم می خوره و می خواهید از شکل استاندارد ویندوز (http://telcontar.net/Misc/screeniecursors/Cursor%20hand%20white.png) استفاده کنید، کافیه در رویداد FormCreate خط زیر رو اضافه کنید تا crHandPoint به شکل استاندارد ویندوز تغییر کنه:

Screen.Cursors[crHandPoint] := LoadCursor(0, IDC_HAND);

سلام
آقا این کد کار نکرد میشه راهنمایی کنید؟؟
ممنون

مهران رسا
پنج شنبه 06 خرداد 1389, 13:14 عصر
سلام
آقا این کد کار نکرد میشه راهنمایی کنید؟؟
ممنون
بعد از اینکه اون خط رو در رویداد FormCreate نوشتید باید خاصیت Cursor کنترل مورد نظرتون رو به crHandPoint تغییر بدید .

Majid.Ebru
پنج شنبه 06 خرداد 1389, 13:48 عصر
بعد از اینکه اون خط رو در رویداد FormCreate نوشتید باید خاصیت Cursor کنترل مورد نظرتون رو به crHandPoint تغییر بدید .
این کار رو که باید انجام می دادم و انجام هم دادم اما نشد؟؟؟؟؟

مهران رسا
پنج شنبه 06 خرداد 1389, 14:35 عصر
این کار رو که باید انجام می دادم و انجام هم دادم اما نشد؟؟؟؟؟
به این صورت عمل کنید . دیگه نباید مشکلی باشه .

procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[crHandPoint] := LoadCursor(0, IDC_HAND);
Label1.Cursor := crHandPoint;
end;

حسین خانی
پنج شنبه 06 خرداد 1389, 17:24 عصر
با سلام :لبخندساده:

این کار رو که باید انجام می دادم و انجام هم دادم اما نشد؟؟؟؟؟
کد درست کار میکنه !
شما بایستی از پنجره Object Inspector دنبال خصوصیت Cursor فرم بگردید و crHandPoint را مقداردهی نمائید !
و اگر این کد را در فرم اصلی برنامه تان انجام دهید سایر فرم ها از فرم اصلی ارث بری کرده ( چون به فرم اصلی Use شدند ) و دیگر نیازی به استفاده این کد برای هر فرم نیست !!!
موفق باشید ...

mohssenfayaz
چهارشنبه 12 خرداد 1389, 12:04 عصر
سلام . آقا رو هركدوم كه كليك ميكنم فقط صفحه تغيير ولوم ويندوز باز ميشه ؟؟!!!!!

mohssenfayaz
چهارشنبه 12 خرداد 1389, 12:05 عصر
لطفا لينك ها رو طوري تنظيم كنيد كه هر كدوم مطالب مربوط به همون عنوان باز بشه ممنون ميشم سريعتر اين كار رو بكنين

KingDelphi
سه شنبه 08 تیر 1389, 12:53 عصر
من در دلفی 2005 امتحان کردم مشکلی نداشته.

shpegah
سه شنبه 20 مهر 1389, 12:12 عصر
سلام . آقا رو هركدوم كه كليك ميكنم فقط صفحه تغيير ولوم ويندوز باز ميشه ؟؟!!!!!

مثل اينكه كسي اينجانيست .هيچ كس جوابي نميدهد!!!!!!!!!!!!!!!:عصبانی::افسر ده::گریه:

كانتر آدرس اضافه ميشود
http://barnamenevis.org/forum/showpost.php?p=45450&postcount=20
ولي روي تاپيك مورد نظر نمي رود.

مجتبی تاجیک
سه شنبه 20 مهر 1389, 14:51 عصر
مثل اينكه كسي اينجانيست .هيچ كس جوابي نميدهد!!!!!!!!!!!!!!!:عصبانی::افسر ده::گریه:

كانتر آدرس اضافه ميشود
http://barnamenevis.org/forum/showpost.php?p=45450&postcount=20
ولي روي تاپيك مورد نظر نمي رود.

آدرس لینک ها اشتباه هست ، خودتون تو تاپیک بگردید و پست مورد نظرتون رو پیدا کنید .

zahra_no
سه شنبه 20 مهر 1389, 23:30 عصر
تغییر Volume ویندوز

یک TrackBar در فرم خود قرار دهید و Max value را به 15 تغییر دهید و در رویداد OnChange آن کد زیر را قرار دهید:


procedure TForm1.TrackBar1Change(Sender: TObject);
var
Count, i: integer;
begin
Count := waveOutGetNumDevs;
for i := 0 to Count do
begin
waveOutSetVolume(i,longint(TrackBar1.Position*4369 )*65536+longint(TrackBar1.Position*4369));
end;
end;و با TrackBar بازی کنید ...




برای waveOutSetVolume ایراد میگیره

Mahmood_M
چهارشنبه 21 مهر 1389, 00:31 صبح
برای waveOutSetVolume ایراد میگیره
تابع WaveOutSetVolume در یونیت MMSystem قرار داره ، باید یونیت MMSystem رو به قسمت Uses اضافه کنید

shpegah
چهارشنبه 21 مهر 1389, 09:42 صبح
آدرس لینک ها اشتباه هست ، خودتون تو تاپیک بگردید و پست مورد نظرتون رو پیدا کنید .

آخه جستجوي تالار هم درست جواب نميدهد كه بتوانيم دقيقا روي تاپيك مورد نظر برويم مگر اينكه يكي يكي تاپيكهارا بگرديم كه فكر ميكنم راحتتر باشه توكل اينترنت بگرديم تا اينجارا!!!!!!

مجتبی تاجیک
دوشنبه 26 مهر 1389, 20:56 عصر
آخه جستجوي تالار هم درست جواب نميدهد كه بتوانيم دقيقا روي تاپيك مورد نظر برويم مگر اينكه يكي يكي تاپيكهارا بگرديم كه فكر ميكنم راحتتر باشه توكل اينترنت بگرديم تا اينجارا!!!!!!

ترتیب پست ها به همون ترتیب قرار داده شده در فهرست هست ، شما وقتی یه پست نزدیک به پست مورد نظرت رو پیدا کنی دیگه پیدا کردن خود پست کار سختی نیست .

cayberfox
دوشنبه 25 بهمن 1389, 09:11 صبح
ایجاد یک Edit که فقط عدد دریافت کند


SetWindowLong(Edit1.Handle, GWL_STYLE, ES_NUMBER);

cayberfox
دوشنبه 25 بهمن 1389, 09:15 صبح
استفاده از ریسورس استرینگ به صورت مستقیم در بر نامه



implementation

{$R *.dfm}
resourcestring
msgcaption='ResSample';
msgText='this is a resource string sample';

procedure TForm1.Button1Click(Sender: TObject);
begin
MessageBox(0,PChar(msgtext),PChar(msgcaption),0);
end;

Gold
چهارشنبه 04 اسفند 1389, 18:26 عصر
ایجاد یک Edit که فقط عدد دریافت کند


SetWindowLong(Edit1.Handle, GWL_STYLE, ES_NUMBER);

ممنون. چرا این کد جواب نمیده؟

You-See
جمعه 30 اردیبهشت 1390, 08:29 صبح
با اجازه منم چند تا کار می ذارم.
به دست آوردن مختصات هر سلول از DBGrid:
1- در قسمت Type:


TDBGrid_PublishProtectedItems = class(TDBGrid)
property Row;
property Col;
function GetCellRect(ACol, ARow: Longint): TRect;
end;



2-پیاده سازی متد بالا:


function TDBGrid_PublishProtectedItems.GetCellRect(ACol,
ARow: Integer): TRect;
var
rect: TRect;
a, b: integer;
begin
a := Self.Left + (Self.Width - Self.ClientWidth) -2;
b := Self.Top + (Self.Height - Self.ClientHeight) -2;
rect := CellRect(ACol, ARow);
rect.Left := rect.Left + a;
rect.Top := rect.Top + b;
rect.Right := rect.Right + a;
rect.Bottom := rect.Bottom + b;
result := rect;
end;



3- هنگام استفاده:


procedure TForm1.Button2Click(Sender: TObject);
var
r: trect;
begin
r := TDBGrid_PublishProtectedItems(DBGrid1).GetCellRect (4, 7);
Edit1.Top := r.Top;
Edit1.Left := r.Left;
Edit1.Width := r.Right- r.Left;
Edit1.Height := r.Bottom- r.Top;
end;

You-See
جمعه 30 اردیبهشت 1390, 08:44 صبح
وقتی مثلا تو ClacField یه SP به ازای هر ردیفش یه عکس بخواهیم بسازیم.
(کاربرد : ما متن بارکد رو ذخیره می کنیم اما عکسش رو چاپ می گیریم).
تعریف:


procedure SaveImageToCalculatedField(Field: TField; Img: TImage);
var
DS: TCustomADODataSet;
i: integer;
begin
DS := Field.DataSet as TCustomADODataSet;
Field.Value := DS.Recordset.AbsolutePosition -1;
Img.Tag := Field.Value;
for i := 0 to Field.ComponentCount -1 do
if Field.Components[i] is TImage then
if (Field.Components[i] as TImage).Tag = Field.Value then
begin
Field.Components[i].Destroy;
break;
end;
Field.InsertComponent(Img);
end;
function GetImageFromCalculatedField(Field: TField): TImage;
var
i: integer;
begin
result := nil;
for i := 0 to Field.ComponentCount -1 do
if Field.Components[i] is TImage then
if (Field.Components[i] as TImage).Tag = Field.Value then
begin
result := Field.Components[i] as TImage;
break;
end;
end;



استفاده:
یه ClacField از نوع عددی می سازیم.

OnCalcField:


var
Img: TImage;
begin
Img := TImage.Create(nil);
GetBarCode(SPFetchGoodsBarCode.Value, Img);
SaveImageToCalculatedField(SPFetchGoodsclBarCodeIm age, Img);
end;



جایی که می خواهیمش:
Image1.Picture := GetImageFromCalculatedField(ADO.FieldByName(fieldn ame)).Picture

shamshiri1
سه شنبه 10 خرداد 1390, 12:28 عصر
خیلی ممنون ولی میخواستم بپرسم این پذوسجرهایی که اینجا نوشتید رو چچجوری من باید وارد برنامه کنم
آخه همش توی یک خطه و یکسری علامتهایی داره که مفهوم نیست

You-See
سه شنبه 10 خرداد 1390, 12:55 عصر
این به خاطر سایت هست نه کد.
با firefox ببینید.

Esmail Solhkhah
چهارشنبه 12 مرداد 1390, 02:21 صبح
فشرده سازی و بازگشایی فایل فشرده


uses
Zlib;

procedure CompressFiles(Files : TStrings; const Filename : String);
var
infile, outfile, tmpFile : TFileStream;
compr : TCompressionStream;
i,l : Integer;
s : String;

begin
if Files.Count > 0 then
begin
outFile := TFileStream.Create(Filename,fmCreate);
try
{ the number of files }
l := Files.Count;
outfile.Write(l,SizeOf(l));
for i := 0 to Files.Count-1 do
begin
infile := TFileStream.Create(Files[i],fmOpenRead);
try
{ the original filename }
s := ExtractFilename(Files[i]);
l := Length(s);
outfile.Write(l,SizeOf(l));
outfile.Write(s[1],l);
{ the original filesize }
l := infile.Size;
outfile.Write(l,SizeOf(l));
{ compress and store the file temporary}
tmpFile := TFileStream.Create('tmp',fmCreate);
compr := TCompressionStream.Create(clMax,tmpfile);
try
compr.CopyFrom(infile,l);
finally
compr.Free;
tmpFile.Free;
end;
{ append the compressed file to the destination file }
tmpFile := TFileStream.Create('tmp',fmOpenRead);
try
outfile.CopyFrom(tmpFile,0);
finally
tmpFile.Free;
end;
finally
infile.Free;
end;
end;
finally
outfile.Free;
end;
DeleteFile('tmp');
end;
end;

procedure DecompressFiles(const Filename, DestDirectory : String);
var
dest,s : String;
decompr : TDecompressionStream;
infile, outfile : TFilestream;
i,l,c : Integer;
begin
// IncludeTrailingPathDelimiter (D6/D7 only)
dest := IncludeTrailingPathDelimiter(DestDirectory);

infile := TFileStream.Create(Filename,fmOpenRead);
try
{ number of files }
infile.Read(c,SizeOf(c));
for i := 1 to c do
begin
{ read filename }
infile.Read(l,SizeOf(l));
SetLength(s,l);
infile.Read(s[1],l);
{ read filesize }
infile.Read(l,SizeOf(l));
{ decompress the files and store it }
s := dest+s; //include the path
outfile := TFileStream.Create(s,fmCreate);
decompr := TDecompressionStream.Create(infile);
try
outfile.CopyFrom(decompr,l);
finally
outfile.Free;
decompr.Free;
end;
end;
finally
infile.Free;
end;
end;

Esmail Solhkhah
چهارشنبه 12 مرداد 1390, 02:24 صبح
بررسی NTFS بودن درایو


uses
ComObj;

function IsNTFS(AFileName: string): Boolean;
var
fso, drv: OleVariant;
begin
IsNTFS := False;
fso := CreateOleObject('Scripting.FileSystemObject');
drv := fso.GetDrive(fso.GetDriveName(AFileName));
IsNTFS := drv.FileSystem = 'NTFS'
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if IsNTFS('X:\Temp\File.doc') then
ShowMessage('File is on NTFS File System')
else
ShowMessage('File is not on NTFS File System')
end;

Esmail Solhkhah
چهارشنبه 12 مرداد 1390, 02:29 صبح
function SplitFile(FileName : TFileName; SizeofFiles : Integer; ProgressBar : TProgressBar) : Boolean;
var
i : Word;
fs, sStream: TFileStream;
SplitFileName: String;
begin
ProgressBar.Position := 0;
fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
for i := 1 to Trunc(fs.Size / SizeofFiles) + 1 do
begin
SplitFileName := ChangeFileExt(FileName, '.'+ FormatFloat('000', i));
sStream := TFileStream.Create(SplitFileName, fmCreate or fmShareExclusive);
try
if fs.Size - fs.Position < SizeofFiles then
SizeofFiles := fs.Size - fs.Position;
sStream.CopyFrom(fs, SizeofFiles);
ProgressBar.Position := Round((fs.Position / fs.Size) * 100);
finally
sStream.Free;
end;
end;
finally
fs.Free;
end;

end;


function CombineFiles(FileName, CombinedFileName : TFileName) : Boolean;
var
i: integer;
fs, sStream: TFileStream;
filenameOrg: String;
begin
i := 1;
fs := TFileStream.Create(CombinedFileName, fmCreate or fmShareExclusive);
try
while FileExists(FileName) do
begin
sStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
fs.CopyFrom(sStream, 0);
finally
sStream.Free;
end;
Inc(i);
FileName := ChangeFileExt(FileName, '.'+ FormatFloat('000', i));
end;
finally
fs.Free;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
SplitFile('C:\temp\FileToSplit.chm',1000000, ProgressBar1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CombineFiles('C:\temp\FileToSplit.001','H:\temp\Fi leToSplit.chm');
end;

Esmail Solhkhah
جمعه 21 مرداد 1390, 17:36 عصر
function IsWrongIP(Ip: string): Boolean;
const
Z = ['0'..'9', '.'];
var
I, J, P: Integer;
W: string;
begin
Result := False;
if (Length(Ip) > 15) or (Ip[1] = '.') then Exit;
I := 1;
J := 0;
P := 0;
W := '';
repeat
if (Ip[I] in Z) and (J < 4) then
begin
if Ip[I] = '.' then
begin
Inc(P);
J := 0;
try
StrToInt(Ip[I + 1]);
except
Exit;
end;
W := '';
end
else
begin
W := W + Ip[I];
if (StrToInt(W) > 255) or (Length(W) > 3) then Exit;
Inc(J);
end;
end
else
Exit;
Inc(I);
until I > Length(Ip);
if P < 3 then Exit;
Result := True;
end;

Esmail Solhkhah
جمعه 21 مرداد 1390, 17:39 عصر
type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..100] of TNetResource;

function CreateNetResourceList(ResourceType: DWord;
NetResource: PNetResource;
out Entries: DWord;
out List: PNetResourceArray): Boolean;
var
EnumHandle: THandle;
BufSize: DWord;
Res: DWord;
begin
Result := False;
List := Nil;
Entries := 0;
if WNetOpenEnum(RESOURCE_GLOBALNET,
ResourceType,
0,
NetResource,
EnumHandle) = NO_ERROR then begin
try
BufSize := $4000; // 16 kByte
GetMem(List, BufSize);
try
repeat
Entries := DWord(-1);
FillChar(List^, BufSize, 0);
Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
if Res = ERROR_MORE_DATA then
begin
ReAllocMem(List, BufSize);
end;
until Res <> ERROR_MORE_DATA;

Result := Res = NO_ERROR;
if not Result then
begin
FreeMem(List);
List := Nil;
Entries := 0;
end;
except
FreeMem(List);
raise;
end;
finally
WNetCloseEnum(EnumHandle);
end;
end;
end;

procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);

procedure ScanLevel(NetResource: PNetResource);
var
Entries: DWord;
NetResourceList: PNetResourceArray;
i: Integer;
begin
if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
for i := 0 to Integer(Entries) - 1 do
begin
if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
(NetResourceList[i].dwDisplayType = DisplayType) then begin
List.AddObject(NetResourceList[i].lpRemoteName,
Pointer(NetResourceList[i].dwDisplayType));
end;
if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
ScanLevel(@NetResourceList[i]);
end;
finally
FreeMem(NetResourceList);
end;
end;

begin
ScanLevel(Nil);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items);
end;

Esmail Solhkhah
جمعه 21 مرداد 1390, 17:42 عصر
uses
Winsock;

function IAddrToHostName(const IP: string): string;
var
i: Integer;
p: PHostEnt;
begin
Result := '';
i := inet_addr(PChar(IP));
if i <> u_long(INADDR_NONE) then
begin
p := GetHostByAddr(@i, SizeOf(Integer), PF_INET);
if p <> nil then Result := p^.h_name;
end
else
Result := 'Invalid IP address';
end;

Esmail Solhkhah
جمعه 21 مرداد 1390, 17:44 عصر
uses
WinInet;

function GetProxyInformation: string;
var
ProxyInfo: PInternetProxyInfo;
Len: LongWord;
begin
Result := '';
Len := 4096;
GetMem(ProxyInfo, Len);
try
if InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len) then
if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
begin
Result := ProxyInfo^.lpszProxy
end;
finally
FreeMem(ProxyInfo);
end;
end;


procedure GetProxyServer(protocol: string; var ProxyServer: string;
var ProxyPort: Integer);
var
i: Integer;
proxyinfo, ps: string;
begin
ProxyServer := '';
ProxyPort := 0;

proxyinfo := GetProxyInformation;
if proxyinfo = '' then
Exit;

protocol := protocol + '=';

i := Pos(protocol, proxyinfo);
if i > 0 then
begin
Delete(proxyinfo, 1, i + Length(protocol));
i := Pos(';', ProxyServer);
if i > 0 then
proxyinfo := Copy(proxyinfo, 1, i - 1);
end;

i := Pos(':', proxyinfo);
if i > 0 then
begin
ProxyPort := StrToIntDef(Copy(proxyinfo, i + 1, Length(proxyinfo) - i), 0);
ProxyServer := Copy(proxyinfo, 1, i - 1)
end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ProxyServer: string;
ProxyPort: Integer;
begin
GetProxyServer('http', ProxyServer, ProxyPort);
Label1.Caption := ProxyServer;
label2.Caption := IntToStr(ProxyPort);
end;

Esmail Solhkhah
جمعه 21 مرداد 1390, 17:47 عصر
uses registry;

procedure ShowTypedUrls(Urls: TStrings);
var
Reg: TRegistry;
S: TStringList;
i: Integer;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Microsoft\Internet Explorer\TypedURLs', False) then
begin
S := TStringList.Create;
try
reg.GetValueNames(S);
for i := 0 to S.Count - 1 do
begin
Urls.Add(reg.ReadString(S.Strings[i]));
end;
finally
S.Free;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowTypedUrls(ListBox1.Items);
end;

Esmail Solhkhah
جمعه 21 مرداد 1390, 17:48 عصر
uses
Registry;

function GetIEVersion(Key: string): string;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('Software\Microsoft\Internet Explorer', False);
try
Result := Reg.ReadString(Key);
except
Result := '';
end;
Reg.CloseKey;
finally
Reg.Free;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('IE-Version: ' + GetIEVersion('Version')[1] + '.' + GetIEVersion('Version')[3]);
ShowMessage('IE-Version: ' + GetIEVersion('Version'));
// <major version>.<minor version>.<build number>.<sub-build number>
end;

Esmail Solhkhah
شنبه 22 مرداد 1390, 03:31 صبح
uses
WinInet;

procedure DeleteIECache;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
begin
repeat
DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName );
FreeMem(lpEntryInfo, dwEntrySize);
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
end;
FreeMem(lpEntryInfo, dwEntrySize);
FindCloseUrlCache(hCacheDir);
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteIECache;
end;

Esmail Solhkhah
شنبه 22 مرداد 1390, 03:33 صبح
function ConnectDrive(_drvLetter: string; _netPath: string; _showError: Boolean;
_reconnect: Boolean): DWORD;
var
nRes: TNetResource;
errCode: DWORD;
dwFlags: DWORD;
begin
{ Fill NetRessource with #0 to provide uninitialized values }
{ NetRessource mit #0 füllen => Keine unitialisierte Werte }
FillChar(NRes, SizeOf(NRes), #0);
nRes.dwType := RESOURCETYPE_DISK;
{ Set Driveletter and Networkpath }
{ Laufwerkbuchstabe und Netzwerkpfad setzen }
nRes.lpLocalName := PChar(_drvLetter);
nRes.lpRemoteName := PChar(_netPath); { Example: \\Test\C }
{ Check if it should be saved for use after restart and set flags }
{ Uberprüfung, ob gespeichert werden soll }
if _reconnect then
dwFlags := CONNECT_UPDATE_PROFILE and CONNECT_INTERACTIVE
else
dwFlags := CONNECT_INTERACTIVE;

errCode := WNetAddConnection3(Form1.Handle, nRes, nil, nil, dwFlags);
{ Show Errormessage, if flag is set }
{ Fehlernachricht aneigen }
if (errCode <> NO_ERROR) and (_showError) then
begin
Application.MessageBox(PChar('An error occured while connecting:' + #13#10 +
SysErrorMessage(GetLastError)),
'Error while connecting!',
MB_OK);
end;
Result := errCode; { NO_ERROR }
end;

function ConnectPrinterDevice(_lptPort: string; _netPath: string; _showError: Boolean;
_reconnect: Boolean): DWORD;
var
nRes: TNetResource;
errCode: DWORD;
dwFlags: DWORD;
begin
{ Fill NetRessource with #0 to provide uninitialized values }
{ NetRessource mit #0 füllen => Keine unitialisierte Werte }
FillChar(NRes, SizeOf(NRes), #0);
nRes.dwType := RESOURCETYPE_PRINT;
{ Set Printername and Networkpath }
{ Druckername und Netzwerkpfad setzen }
nRes.lpLocalName := PChar(_lptPort);
nRes.lpRemoteName := PChar(_netPath); { Example: \\Test\Printer1 }
{ Check if it should be saved for use after restart and set flags }
{ Uberprüfung, ob gespeichert werden soll }
if _reconnect then
dwFlags := CONNECT_UPDATE_PROFILE and CONNECT_INTERACTIVE
else
dwFlags := CONNECT_INTERACTIVE;

errCode := WNetAddConnection3(Form1.Handle, nRes, nil, nil, dwFlags);
{ Show Errormessage, if flag is set }
{ Fehlernachricht aneigen }
if (errCode <> NO_ERROR) and (_showError) then
begin
Application.MessageBox(PChar('An error occured while connecting:' + #13#10 +
SysErrorMessage(GetLastError)),
'Error while connecting!',
MB_OK);
end;
Result := errCode; { NO_ERROR }
end;

function DisconnectNetDrive(_locDrive: string; _showError: Boolean; _force: Boolean;
_save: Boolean): DWORD;
var
dwFlags: DWORD;
errCode: DWORD;
begin
{ Set dwFlags, if necessary }
{ Setze dwFlags auf gewünschten Wert }
if _save then
dwFlags := CONNECT_UPDATE_PROFILE
else
dwFlags := 0;
{ Cancel the connection see also at http://www.swissdelphicenter.ch/en/showcode.php?id=391 }
{ Siehe auch oben genannten Link (Netzlaufwerke anzeigen) }
errCode := WNetCancelConnection2(PChar(_locDrive), dwFlags, _force);
{ Show Errormessage, if flag is set }
{ Fehlernachricht anzeigen }
if (errCode <> NO_ERROR) and (_showError) then
begin
Application.MessageBox(PChar('An error occured while disconnecting:' + #13#10 +
SysErrorMessage(GetLastError)),
'Error while disconnecting',
MB_OK);
end;
Result := errCode; { NO_ERROR }
end;

Esmail Solhkhah
شنبه 22 مرداد 1390, 03:41 صبح
uses ShellAPI;

function DeleteFileWithUndo(sFileName: string): Boolean;
var
fos: TSHFileOpStruct;
begin
FillChar(fos, SizeOf(fos), 0);
with fos do
begin
wFunc := FO_DELETE;
pFrom := PChar(sFileName);
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
end;
Result := (0 = ShFileOperation(fos));
end;

Esmail Solhkhah
شنبه 22 مرداد 1390, 03:51 صبح
دریافت شماره سریال هارد - cpu و ...

مناسب برای ساخت قفل نرم افزاری

Esmail Solhkhah
شنبه 22 مرداد 1390, 03:54 صبح
جابجایی کنترلهای روی فرم در ران تیم

Esmail Solhkhah
یک شنبه 23 مرداد 1390, 02:00 صبح
Gradient-Panel with 6 Main-Propertys

hector2000
دوشنبه 02 آبان 1390, 10:07 صبح
با سلام و تشكر
لطفا مثال در زمينه كار با سوكت ها را هم قرار دهيد

تجلی
پنج شنبه 08 دی 1390, 13:41 عصر
سلام .
با یه مشکلی مواجه شده بودم که بعد از کلی جستجو و کلنجار رفتم تونستم راه حلش رو پیدا کنم و گفتم اینجا قرار بدم شاید به درد کسی بخوره .

موضوع در رابطه با تبدیل یک مقدار از نوع string به Pwidechar هست( تبدیل به Pwidechar هست نه Widechar ) که در برخی توابع از جمله تابع SetFileAttributes استفاده میشه که برای تبدیل باید از تابع StringToOleStr استفاده کرد .

cayberfox
دوشنبه 12 دی 1390, 08:48 صبح
روشی ساده برای شناسایی دیباگر



{$IFDEF DEBUG}
ShowMessage('Debuger Found');
{$ENDIF}

You-See
دوشنبه 12 دی 1390, 09:01 صبح
دوست عزیز این کدها مگه راهنمای کامپایلر نیستند؟
اگر در اگزه تست بشه اون پیغام یا هست یا نیست.
فکر نکنم به درد ضد دیباگ در مثلا olly بخوره.
ممکنه توضیح بدید؟

شاهین عشایری
دوشنبه 12 دی 1390, 10:10 صبح
این کد مربوط به ضد دیباگ نیست و یک راهنمای کامپایلر است که با آن می توانید تشخیص دهید که برنامه توسط دیباگر اجرا شده یا نه؟
از این تکنیک در بسیاری از جاها استفاده میشه و شاید شما هم نظیر آن را در بعضی کامپوننت های Trial دیده باشید که برنامه ساخته شده با آنها فقط در حالت دیباگ می تواند اجرا شود و یا مثلاً می خواهید کاری کنید که اگر برنامه در حالت دیباگ اجرا شد یک Log File تولید کنید و یا ... .

cayberfox
دوشنبه 12 دی 1390, 12:37 عصر
دوست عزیز این کدها مگه راهنمای کامپایلر نیستند؟
اگر در اگزه تست بشه اون پیغام یا هست یا نیست.
فکر نکنم به درد ضد دیباگ در مثلا olly بخوره.
ممکنه توضیح بدید؟

بله هست
در exe هم اون پیغام خواهد بود
اتفاقا روی Olly هم تست کردم و جواب داد

mbshareat
دوشنبه 04 اردیبهشت 1391, 17:44 عصر
تصحیح کدهای خراب سایت:
Var
S:String;
begin
S:=Memo1.Text;
S:=StringReplace(S,'&#40;','(',[rfReplaceAll]);
S:=StringReplace(S,'&#41;',')',[rfReplaceAll]);
S:=StringReplace(S,'&#58;',':',[rfReplaceAll]);
S:=StringReplace(S,'&#91;','[',[rfReplaceAll]);
S:=StringReplace(S,'&#93;',']',[rfReplaceAll]);
S:=StringReplace(S,'&lt;','<',[rfReplaceAll]);
S:=StringReplace(S,'&#123;','{/',[rfReplaceAll]);
S:=StringReplace(S,'&#125;','/}',[rfReplaceAll]);
Memo1.Text:=S;
Memo1.SelectAll;
Memo1.CopyToClipboard;
Memo1.SelLength:=0;
end;

86190