بدست آوردن موقعيت دقيق موس با كشيدن دو خط افقي و عمودي
دانلود سورس كد
بدست آوردن موقعيت دقيق موس با كشيدن دو خط افقي و عمودي
دانلود سورس كد
اجراي افكت روي متن
a
b...
d
da
db...
de
dea
deb
dec...
del
dela
delb
delc...
delp
...
delphi rulez
دانلود سورس كد
به لرزه در آوردن فرم دلخواهتون
دانلود سورس كد
يك خط كش توپ براي ويندوز
خداييش خودمم ديدم شوك شدم
دانلود سورس كد
اينم يك سورس كه باهاش ميشه هر برنامه اي كه مي خواند سريع اجرا كنيد تو اين نرم افزار Add كنيد و بعد با دابل كليك روي آن ها ، اجراشون كنيد
دانلود سورس كد
یاده سازی الگوریتم کلونی مورچه ها با دلفی
دانلود سورس كد
آخرین ویرایش به وسیله SayeyeZohor : یک شنبه 11 تیر 1391 در 22:32 عصر
تا حالا با مكينتاش كار كردين؟
من با گجت پايينش خيلي حال مي كنم
دانلود سورس كد
يك launcher جديد
دانلود سورس كد
کی این کد رو نوشته ؟ باید به صورت زیر تغییر پیدا کنه وگرنه در زمان های تک رقمی مشکل پیدا میکنه :
var
Str: String;
Hour, Min, Sec, MSec: Word;
begin
Str := TimeToStr(Time);
DecodeTime(Now, Hour, Min, Sec, MSec);
// recive 'binary' string
Label1.caption := IntToBin(Hour) + ':' + IntToBin(Min) + ':' + IntToBin(Sec);
// this label is for the others 01 people who don't
Label2.caption := Str;
end;
این بازی نیست ؛ پیاده سازی الگوریتم کلونی مورچه ها با دلفی هست !
سلام
من یک برنامه درست کردم برای multi ping کردن که به صورت فرم MDI می باشد ولی بلد نیستم که از Thread ها استفاده بکنم کسی می تواند کمک بکند.
اگر بشود از Thread استفاده کرد برای هر فرمی که ساخته می شود (هر IP یک نام که برای کپشن فرم می باشد می گیرد و یک form child ساخته میشود که داخلش یک timer می باشد که هر یک ثانیه یا هر زمانی که تنظیم کرده باشیم از طریق کامپوننت ایندی ICMP آی پی فرم مربوطه را پینگ می کند)،
برنامه بسیار خوبی برای مدیران شبکه ها می شود.
source کامل اش را گزاشته ام.
http://s1.picofile.com/file/74361611..._ICMP.rar.html
سلام علیکم
درورد بر برنامه نویسای دلفی
جستجوش و شکستن خط و ذخیره و نمایش نام فایل در نوار عنوان یه کم ایراد داشت یه کم درستش کردم!
این یه برنامه کوچیک همراه با سورشه که متن رو رنگی نشون میده.
تو محیط اصلی برنامه از لیست باکس استفاده کردم که با DrawItem متن و اشکال داخلش رو ترسیم می کنم و در محیط تایپ او یه ادیت با امکانات ساده داریم.استفاده اصلیش برای من تولید راهنمای رنگی برای برنامه است.
قابلیتهایی هم داره:
امکان ارسال تصویر متن به ClipBoard
تنظیم فاصله سطرها
تعیین رنگ پس زمینه
چهار نوع بولت
شش رنگ همزمان برای متن فارسی
جستجوی متن رو به پایین و رو به بالا با کلیدهای F5-F6-F7
(البته تو محیط اصلی کلمه رو مشخص نمی کنه!)
تصحیح "ی" و "ي"!
یه نکته :
اصطلاح صفحه در لیست کلیدهای محیط اصلی رو برای محدوده ای از متن که به سطر خالی برسه به کار بردم (برای درک مساله فایل ترجمه سوره حمد و بقره در کنار برنامه رو ببینین)
امیدوارم خوشتون بیاد و اگه حوصله کردین تکمیلش کنین.
آخرین ویرایش به وسیله mbshareat : چهارشنبه 26 مهر 1391 در 09:03 صبح
برنامه ماشین حساب
http://uploadkon.ir/?file=56531793b1...6ad175ffee.rar
ساخت Generate SQL Script با دلفي براي اسكيوال سرور 2000 با اين تفاوت كه انتقال اطلاعات هم داشته باشه
دانلود فايل ساخت Generate SQL Script
سلام
نیاز به یه برنامه برای تغییر نام فایلهای شاخه به دسته ای داشتم یه برنامه ساده نوشتم.تستش کردم ان شاء الله درست کار میکنه!!(مثل وقتی توی Total Commander ترکیب Ctrl+M رو فشار میدیم!)
یه برنامه ساده هم میخواستم که با فشاز ترکیب خاصی از کلیدها تصویر پنجره زیر ماوس یا قسمتی قابل انتخاب از دسکتاپ رو بگیره بفرسته به کلیپ برد یا ذخیره کنه!(برای گرفتن تصویر بازی از شبیه ساز بازی موبایل!)
چند تا تابع هم نیاز داشتم که قسمتی از رشته رو بگیرم.(مثلا گرفتن آدرس تصویر از لینک تصویر Google!)
گفتم شاید به درد کسی خورد براتون میذارم:
توابع رشته ای:
Uses
StrUtils;
Function CopyBetween(S,St,En:String):String;
begin
Result:=Copy(S,pos(St,S)+Length(St),pos(En,S)-pos(St,S)-Length(St));
end;
Function CopyAfter(S,St:String):String;
begin
Result:=Copy(S,pos(St,S)+Length(St),Length(S));
end;
Function CopyAfterLastTo(S,St,En:String):String;
Var
N:Word;
begin
N:=Pos(ReverseString(St),ReverseString(S));
Result:=RightStr(S,n-1);
If En<>'' then
Result:=LeftStr(Result,pos(En,Result)-1);
end;
Function LastPos(S,S2:String):Integer;
begin
Result:=Length(S)-
Pos(ReverseString(S2),ReverseString(S))+1;
end;
این هم دو برنامه ذکر شده:
آخرین ویرایش به وسیله mbshareat : یک شنبه 26 شهریور 1391 در 11:46 صبح
سلام دوستان!
یه برنامه کوچیک دارم برای بزرگ کردن و رنگی کردن نقطه های ریز متن.
کامل و دقیق نیست اما بدک نیست!؟
یه کم روش کار کردم زوائد نقطه ها رو برداشتم . حالا دیگه اعراب رو نقطه حساب نمی کنه و میشه محدوده برای رنگ کردن نقطه تعیین کرد!
یه سوتی داده بودم: رنگها در بیت مپ به ترتیی BGR هستش و به دلیل بی توجهی به این مساله نقطه ها در جای مناسب ترسیم نمی شدند که حالا اصلاح شد!
پروسیجر برای یکپارچه کردن نقاط واجد رنگ مشابه با رنگ داده شه هم بهش اضافه کردم.
فرض کنید چند نقطه با RGB نزدیک به AA00FF$ داریم میخوایم همه این نقاط دقیقا RGB معادل AA00FF$ داشته باشند.شباهت کوچکی هم به MagicWand داره. (بیشتر وقتی بیت مپی که متنی توش هست به صورت HalfTone کوچک بشه کمک می کنه!)
آخرین ویرایش به وسیله mbshareat : سه شنبه 02 آبان 1391 در 00:30 صبح
سلام
ترسیمات پیشفرض دایره و خط و .. دارای لبه سخت هستند.
با کد زیر می تونین ترسیمات دایره و خط و غیره رو با خطوط خارجی که رنگش کم کم کمرنگ و با رنگ نقاط اطراف ترکیب میشه، انجام بدید. به این شکل که سایه ای از رنگ خطوط محیطی بین شکستگیهای Pixel ها ایجاد میشه.
تصویر بزرگ شده زیر رو که با این پروسیجر ترسیم شده ملاحظه بفرمایید:
SmoothDraw.gif
نحوه استفاده:
قبل از هر کار یک بیت مپ برای نگه داشتن تصویر پشت شکل تعریف می کنیم( بیشتر به خاطر استفاده در برنامه طراحی با ماوس به درد می خوره)
پارامترها:
0)بیت مپ برای ذخیره ناحیه پشت شکل!(برای طراحی برنامه هایی مثل Paint خوبه)
1)کانواس مربوطه
2)آرایه عددی شامل 4 یا 6 عدد مختصات و شعاع گوشه مستطیل گوشه دار که به عنوان پارامتر در دستورات ترسیم به کار می رود
3)رشته معرف نوع شکل:
L: خط R: مستطیل RR: مستطیل لبه گرد E:بیضی
4)رشته معرف نحوه ترسیم:
B: تنها خط محیطی F: تنها رنگ داخلی BF: ترکیب خط محیطی و رنگ داخلی
5)رنگ خط محیطی
6)رنگ داخل
7)ضخامت خط
در برنامه نمونه میتونید با درگ ماوس روی تصویر مستطیل با گوشه گرد بکشید.
آخرین ویرایش به وسیله mbshareat : یک شنبه 08 آبان 1401 در 20:00 عصر
امروز داشتم یه خونه تکونی روی سورس های قدیمی شرکت میدادم و تصمیم گرفتم تمام Dynamic Query ها و ... رو به Stored Procedure تبدیل کنم ، تعداد این موارد خیلی بود بنابراین نوشتن متدهای تکراری برام خسته کننده بود ، 3 تا متد در یک کلاس پایه تعریف کردم که تو کل کلاس های برنامه ازشون استفاده کنم کد مربوط به این سه تابع رو اینجا قرار میدم ، به وسیله این توابع خیلی راحت میتونید Stored Procedure ها رو بدون انجام عملیات تکراری و خسته کننده مقداردهی و اجرا کنید :
تابع اول StoredProcedureExists ، بررسی میکنه Stored Procedure ی که نامش داده شده در بانک جاری که بهش متصل شدید موجود هست یا نه :
function StoredProcedureExists(const SPName: string): Boolean;
var
SPList: TStringList;
begin
// Get list of stord procedure in current database & check given sp exists in it or not
SPList := TStringList.Create;
try
ADOConnection.GetProcedureNames(SPList);
Result := (SPList.IndexOf(SPName + ';1') > 0) or
(SPList.IndexOf(SPName + ';0') > 0);
finally
SPList.Free;
end;
end;
تابع دوم FetchStoredProcParams ، لیست پارامترهای Stored Procedure ی که نامش به عنوان پارامتر داده شده رو به صورت Comma Delimited در یک رشته برمیگردونه :
function FetchStoredProcParams(const SPName: string): string;
var
ParamCount: Integer;
StoredProcedureParams: TStringList;
begin
// Return given stored procedure parameters
if StoredProcedureExists(SPName) then
begin
StoredProcedureParams := TStringList.Create;
try
with ADOStoredProc do
begin
Close;
ProcedureName := SPName;
Parameters.Refresh;
for ParamCount := 0 to Parameters.Count - 1 do
if (Parameters[ParamCount].Direction = pdInput) then
StoredProcedureParams.Add(Parameters[ParamCount].Name);
Result := StoredProcedureParams.CommaText;
end;
finally
StoredProcedureParams.Free;
end;
end;
end;
* در ضمن در تابع بالا از پارامتری هایی که به صورت Output تعریف شدن چشم پوشی شده چون اصولا بهشون نیازی نیست ، اگر بهشون نیاز داشتید خودتون تغییرش بدید .
و تابع آخر ExecuteStoredProc ، که نام یک Stored Procedure رو به همراه نام پارامترها و مقدار اون ها میگیره و اون رو اجرا میکنه :
function ExecuteStoredProc(const SPName, ParamNames: string;
ParamValues: array of const): Byte;
var
ParamCount: Integer;
StoredProcedureParams: TStringList;
begin
// Parse given parameters name
StoredProcedureParams := TStringList.Create;
try
StoredProcedureParams.CommaText := ParamNames;
// Check given param names & given param count is equal , if yes check given procedure name exits in database or no
if (StoredProcedureParams.Count = Length(ParamValues)) and
(StoredProcedureExists(SPName)) then
begin
with ADOStoredProc do
begin
Close;
ProcedureName := SPName;
Parameters.Refresh;
for ParamCount := 0 to StoredProcedureParams.Count - 1 do
begin
case ParamValues[ParamCount].VType of
vtInteger:
Parameters.ParamByName(StoredProcedureParams[ParamCount]).Value :=
ParamValues[ParamCount].VInteger;
vtBoolean:
Parameters.ParamByName(StoredProcedureParams[ParamCount]).Value :=
ParamValues[ParamCount].VBoolean;
vtExtended:
Parameters.ParamByName(StoredProcedureParams[ParamCount]).Value :=
Single(ParamValues[ParamCount].VExtended);
vtUnicodeString:
Parameters.ParamByName(StoredProcedureParams[ParamCount]).Value :=
String(ParamValues[ParamCount].VPWideChar);
else // for other datatypes such as TDate and etc , you can cast it in SQL Server to your own datatype
Parameters.ParamByName(StoredProcedureParams[ParamCount]).Value :=
String(ParamValues[ParamCount].VPWideChar);
end;
end;
ExecProc;
Result := Parameters.ParamValues['@return_value'];
end;
end
else
raise Exception.Create(Format('The Stored Procedure : %s was not found',
[SPName]));
finally
StoredProcedureParams.Free;
end;
end;
نمونه استفاده :
ExecuteStoredProc(ProcName, FetchStoredProcParams(ProcName),
[EmployeeID, FirstName, LastName]);
یا
ExecuteStoredProc(ProcName, 'ID,Fname,LName',
[EmployeeID, FirstName, LastName]);
موفق باشید .
آخرین ویرایش به وسیله Felony : چهارشنبه 10 آبان 1391 در 17:13 عصر
بنا به درخواست یکی از مشتری ها قرار شد تو برنامه ای که داشتم براش مینوشتم پروسه ای رو پیداه سازی کنم که زمان تغییر کلمه عبور کاربران نرم افزار میزان امنیت کلمه عبور رو بررسی کنه و اگر کلمه عبور ساده ای بود از تغییر رمز جلوگیری کنه ، امروز صبح تابع زیر رو عجله ای برای این کار نوشتم که میتونید بسته به نیازتون میزان سختگیری برای تایید امنیت یک رمز رو با تغییر اعداد کم یا زیاد کنید :
function IsSafePassword(const Password: string): Boolean;
// Count number of numeric characters in password
function ContainNumber(const Password: string): Boolean;
var
CurrChar: Char;
CharCount: Byte;
begin
CharCount := 0;
for CurrChar in Password do
if CurrChar in ['0' .. '9'] then
Inc(CharCount);
Result := not(CharCount < (Length(Password) div 4));
end;
// Count number of alphabetic characters in password
function ContainChar(const Password: string): Boolean;
var
CurrChar: Char;
CharCount: Byte;
begin
CharCount := 0;
for CurrChar in Password do
if IsCharAlpha(CurrChar) then
Inc(CharCount);
Result := not(CharCount < (Length(Password) div 4));
end;
// Count number of upper characters in password
function ContainUpperChar(const Password: string): Boolean;
var
CurrChar: Char;
CharCount: Byte;
begin
CharCount := 0;
for CurrChar in Password do
if IsCharUpper(CurrChar) then
Inc(CharCount);
Result := not(CharCount < Length(Password) div 8);
end;
// Count number of lower characters in password
function ContainLowerChar(const Password: string): Boolean;
var
CurrChar: Char;
CharCount: Byte;
begin
CharCount := 0;
for CurrChar in Password do
if IsCharLower(CurrChar) then
Inc(CharCount);
Result := not(CharCount < Length(Password) div 8);
end;
// Count number of symbol characters in password
function ContainSymbolChar(const Password: string): Boolean;
var
CurrChar: Char;
CharCount: Byte;
begin
CharCount := 0;
for CurrChar in Password do
if not(IsCharAlpha(CurrChar)) and not(CharInSet(CurrChar, ['0' .. '9']))
then
Inc(CharCount);
Result := not(CharCount < 1);
end;
// Count number of consecutive characters in password
function ConsecutiveNumbers(const Password: string): Boolean;
var
BaseChar, CurrChar: Char;
BaseCount, NextChars: Byte;
ConsecutiveCount: Byte;
begin
Result := False;
for BaseCount := 1 to Length(Password) - 1 do
begin
ConsecutiveCount := 0;
BaseChar := Password[BaseCount];
for NextChars := BaseCount to Length(Password) do
if (BaseChar = Password[NextChars]) then
Inc(ConsecutiveCount);
if (ConsecutiveCount > Length(Password) div 5) then
Exit(True);
end;
end;
begin
if (Length(Password) < 8) or ContainNumber(Password) = False or
ContainChar(Password) = False or ContainUpperChar(Password) = False or
ContainLowerChar(Password) = False or ContainSymbolChar(Password) = False or
ConsecutiveNumbers(Password) = False then
Result := False
else
Result := True;
end;
موفق باشید .
آخرین ویرایش به وسیله Felony : پنج شنبه 11 آبان 1391 در 08:40 صبح
بدست اوردو ورزن و نام ویندوز تا ویندوز 8
function WindowsVersion: String;
begin
Result := 'Unknown';
if Win32Platform = VER_PLATFORM_WIN32_NT then
case Win32MajorVersion of
4: Result := 'Windows NT';
5: case Win32MinorVersion of
0: Result := 'Windows 2000';
1: Result := 'Windows XP';
2: Result := 'Windows 2003 Server';
end;
6: case Win32MinorVersion of
0: Result := 'Windows Vista';
1: Result := 'Windows 7';
2: Result := 'Windows 8';
end;
end else
case Win32MinorVersion of
00: Result := 'Windows 95';
10: if Trim(Win32CSDVersion) = 'A' then Result := 'Windows 98 SE'
else Result := 'Windows 98';
90: Result := 'Windows ME';
end;
if Win32BuildNumber >0 then
result:=result+' '+inttostr(Win32BuildNumber)+ ' ' +Win32CSDVersion;
end;
استفاده
ShowMessage(WindowsVersion);
گذاشتن برنامه در System Tray (کنار ساعت ویندوز) و باز کردن برنامه با دبل کلیک روی آیکن.
با مینیمایز کردن یا بستن برنامه ، برنامه کنار ساعت ویندوز قرار میگیره. و با کلیک راست روی آیکن و زدن گزینه exit نرم افزار بسته میشه.
من این سورس رو از یه سایت گرفتم و یه کم تغییر دادم. من روی دلفی xe2 تست کردم. در نسخه های پایین تر باید کامپوننت coolTrayIcon رو نصب کنبد. و البته با یه کم تغییر در کدها.
آخرین ویرایش به وسیله farzadkamali : یک شنبه 26 آذر 1391 در 16:07 عصر
سلام.
دوره جوونی یه شب زد به سرم که چرا مدار زمین گرد نیست.
این برنامه رو نوشتم که با کمی اصلاحات براتون می گذارم. شاید براتون جالب باشه.
البته در دو بعد هست که به راحتی می شه سه بعدیش کرد.
دیدم دوستایی سورس دادن، گفتم من هم کاری کرده باشم برا تشویق بقیه برا ادامه این کار (دادن سورس برنامه ها)
----------------
توضیح:
در متد
Universe.AddStar(TStar.Create(400, 250, 10, 100, -100, clRed));
به ترتیب = موقعیت افقی و عمودی، جرم، سرعت اولیه افقی و عمودی، رنگ و یک متغیر که نشان می دهد جرم ما می تواند حرکت کند یا نه. (دیفالت true)
در صورت برخورد دو جرم به هم هردو ایست می کنند و خاکستری می شند.
قابلیت افزودن هر تعداد جرم رو دارید.
با تغییر Interval تایمر زمان رو تند و کند کنید.
این خط:
procedure TUniverse.Render;
.
.
FillRect(Rect(0, 0, Width, Height));
رو کامنت کنید و جرکت خورشید رو false کنید تا اثرات جادبه سیارات رو رو هم بتونید ببینید.
این رو هم امتحان کنید:
Universe.AddStar(TStar.Create(150, 350, 1000, 0, -200, clRed));
Universe.AddStar(TStar.Create(200, 350, 10000, 0, -120, clBlue));
Universe.AddStar(TStar.Create(500, 350, 100000, 0, 0, clYellow, false));
یک چیزی شبیه خورشید-زمین-ماه و البته در مقیاس های غیر واقعی که نشون می ده تقریبا تعادل برقراره.
توابع تبدیل تاریخ با دقت 5000 سال
پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840
پایگاه داده، تیونینگ، طراحی و پیاده سازی ..
درود به همه
من این ترم درس ساختمان داده رو (فکر کنم)پاس کردم ، توی دانشکده همه برنامه هاشو با ++C نوشتم
دیروز اتفاقی به یک برنامه خوب در این زمینه به زبان #C برخوردم و چون کامل بود اونو به دلفی تبدیل کردم و حالا هم میذارم اینجا شاید به درد کسی بخوره.
اینم عکس از برنامه :
موفق باشید.
Everything that has a beginning has an end. ... The End?
درود
الان بیکار بودم نشستم یک برنامه برای استفاده از وبکم نوشتم ، با حداقل موارد لازم !
امکانات :
- اتصال به وبکم
- ذخیره فریم جاری در قالب یک عکس BMP
- ذخیره کردن تصاویری که از وبکم دریافت میشه ،در قالب فیلم AVI (صدا رو هم توی فیلم ذخیره می کنه)
- همین !
اینم عکس از برنامه در حال اجرا :
آخرین ویرایش به وسیله بهروز عباسی : یک شنبه 13 اردیبهشت 1394 در 12:27 عصر
Everything that has a beginning has an end. ... The End?
درود
نمیدونم تا حالا با برنامه USB_Safely_Remover کار کردید یا نه...
اگه قصد نوشتن برنامه ای مشابهش رو دارید حتماً برنامه زیرو ببینید و سورسشو مطالعه کنید.
یک یونیت پیشرفته برای کار با USB همراه پروژشست که باهاش میشه همه اطلاعات مربوط به قطعات رو به دست آورد.
Everything that has a beginning has an end. ... The End?
درود
امروز یک برنامه کوچیک برای مشاهده کردن دسکتاپ کلاینت ها در شبکه ،نوشتم.
بنا به دلایلی نمی تونم برنامه کامل رو بذارم
اما یک نمونه جمع و جور می ذارم اینجا تا دوستان دیگه هم استفاده کنن.
( دلفی XE2 )
Everything that has a beginning has an end. ... The End?
توابع تبدیل تاریخ با دقت 5000 سال
پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840
پایگاه داده، تیونینگ، طراحی و پیاده سازی ..
نمی دونم چکار کنم که لینک Redundant نشه. اما اجالتا:
- تکه تکه کردن یک عکس که پرینت آن در یک صفحه جا نمی شود..
مطلب را در اینجا مشاهده کنید.
https://barnamenevis.org/showthread.p...44#post1725144
توابع تبدیل تاریخ با دقت 5000 سال
پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840
پایگاه داده، تیونینگ، طراحی و پیاده سازی ..
استفاده از كنسول اپليكيشن يا CMD در دلفي
مانند دستور Ping 192.168.1.1
Untitled.png
StoRedirectedExecute.rar
نمیخواستم که این پست رو(به دلیل تکراری بودن و ...) بنویسم ولی برای اینکه دیگران گمراه نشوند باید بگویم که راه حل خوبی را ارائه نداده اید و خیلی از موارد توسط این روش ساپورت نمیشوند. بهترین راه حل در این رابطه استفاده از کامپوننت TJvCreateProcess موجود در مجموعه JVCL است که حتی از Nested Pipes و ورودی و خروجی استاندارد هم پشتیبانی می کنه. راه حلی که شما ارائه داده اید فقط در موارد خیلی ساده کاربرد داره و موقعی که کار یه کمی پیچیده تر باشه کارایی نداره.
آخرین ویرایش به وسیله BORHAN TEC : چهارشنبه 30 اسفند 1391 در 13:15 عصر
بستن دسترسی برنامه ها به اینترنت
type
PMIB_TCPROW = ^MIB_TCPROW;
MIB_TCPROW = packed record
dwState: DWORD;
dwLocalAddr: DWORD;
dwLocalPort: DWORD;
dwRemoteAddr: DWORD;
dwRemotePort: DWORD;
end;
PMIB_TCPTABLE = ^MIB_TCPTABLE;
MIB_TCPTABLE = packed record
dwNumEntries: DWORD;
Table: Array [0..MaxWord] of MIB_TCPROW;
end;
function GetTcpTable(Table:Pointer;dwSize:PDWORD;state:Bool ean):DWORD;stdcall;external 'Iphlpapi.dll';
function SetTcpEntry(pTcpRow:PMIB_TCPROW):DWORD;stdcall;ext ernal 'Iphlpapi.dll';
procedure BuildandTerminate;
var
dwSize:DWORD;
theTable:PMIB_TCPTABLE;
item:PMIB_TCPROW;
i:Integer;
begin
dwSize:=10;
GetTcpTable(thetable,@dwSize,false);
GetMem(theTable,dwSize);
if GetTcpTable(thetable,@dwSize,false)=ERROR_SUCCESS then
begin
for i:=0 to thetable^.dwNumEntries-1 do
begin
item:=@thetable.table[i];
item.dwState:=12;
SetTcpEntry(item);
end;
FreeMem(theTable);
end;
end;
procedure blockinternet;
begin
SetTimer(Form1.Handle,1,30,@BuildandTerminate);
end;
procedure unblockinternet;
begin
KillTimer(Form1.Handle,1);
end;
گاهی اوقات پیش می آید که می خواهیم به صورت اتوماتیک به آخرین خط یک Memo اسکرول کنیم. روش انجام این کار در کد زیر نشان داده شده است:
procedure ScrollToLastLine(Memo: TMemo);
begin
SendMessage(Memo.Handle, EM_LINESCROLL, 0,Memo.Lines.Count);
end;
منبع:
http://wiert.me/2013/04/03/autoscrol...tack-overflow/
با سلام
امروز یک برنامه با سورس میخوام بزارم واسه مبتدی ها
این یک برنامه مدیریت دریافت ها و پرداخت هاست که واسه ساختمان خودم نوشتم (آخه مدیر ساختمان هستم)
تصمیم گرفتم برنامه رو با سورس بزارم واسه دوستان عزیزی که تازه کار با بانکهای اطلاعاتی و ایجاد ارتباط و فیلتر کردن اطلاعات رو میخوان یاد بگیرن امید وارم مفید باشه
دانلود برنامه و سورس
واقعا کار خوبی کردید. برنامه کاربردی به نظر میاد.
اگه لطف کنید کامپوننتهای استفاده شده رو هم ضمیمه کنید و بفرمایید از کدوم نسخه از دلفی و نوع بانک اطلاعاتی و یه سری توضیحات در مورد نکات فنی برنامه در همون پست معرفی برنامه بدید، بیننده یا مخاطب بیشتر میتونه به زحمتی که کشیدید برسه.
ممنون.
با اجازه دوست خوبم gholami146
كامپوننت هاي مورد استفاده تا جايي كه مي دونم :
1- TAdvOfficePager از سري TMS
2- UNiDac از كمپاني DevArt
3- Ehlib
4- TXCalPlannerDatePicker
5- TAnimationCaption
6- TQExport4XLS
7- TPersianCalendar
با سلام خدمت دوستان
يك قطعه كد در اين قسمت مي گذارم كه مي تونيم باهاش مولفه هاي يك تابع رو جدا كنيم
مثال : اين يك نمونه از تابع يك برنامه است
InputBox ( "title", "prompt" [, "default" [, "password char" [, width [, height [, left [, top [, timeout [, hwnd]]]]]]]] )
اينم از كدي كه من نوشتم :
type
TStringDynArray = array of String;
var
Form1: TForm1;
implementation
{$R *.dfm}
function Explode(const Separator, S: string; Limit: Integer = 0): TStringDynArray;
var
SepLen: Integer;
F, P: PChar;
ALen, Index: Integer;
begin
SetLength(Result, 0);
if (S = '') or (Limit < 0) then Exit;
if Separator = '' then
begin
SetLength(Result, 1);
Result[0] := S;
Exit;
end;
SepLen := Length(Separator);
ALen := Limit;
SetLength(Result, ALen);
Index := 0;
P := PChar(S);
while P^ <> #0 do
begin
F := P;
P := AnsiStrPos(P, PChar(Separator));
if (P = nil) or ((Limit > 0) and (Index = Limit - 1)) then P := StrEnd(F);
if Index >= ALen then
begin
Inc(ALen, 5);
SetLength(Result, ALen);
end;
SetString(Result[Index], F, P - F);
Inc(Index);
if P^ <> #0 then Inc(P, SepLen);
end;
if Index < ALen then SetLength(Result, Index);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
St, FnName: string;
res: TStringDynArray;
I: Integer;
begin
St := Label1.Caption;
St := Trim(St);
WHILE Copy(St, 1, 1) <> '(' DO
BEGIN
FnName := FnName + Copy(St, 1, 1);
Delete(St, 1, 1);
END;
Delete(St, 1, 1);
St := Trim(St);
ShowMessage(FnName);
St := StringReplace(St, '(', '', [rfReplaceAll, rfIgnoreCase]);
St := StringReplace(St, ')', '', [rfReplaceAll, rfIgnoreCase]);
St := StringReplace(St, '[', '', [rfReplaceAll, rfIgnoreCase]);
St := StringReplace(St, ']', '', [rfReplaceAll, rfIgnoreCase]);
ShowMessage(st);
//--
res := Explode(',', St);
FOR I := 0 TO Length(res)-1 DO ShowMessage(res[I]);
end;
use the Microsoft Speech API
تبديل متن به گفتار با استفاده از تابع API ويندوز
uses Comobj;
procedure TForm1.Button1Click(Sender: TObject);
var
voice: OLEVariant;
begin
voice := CreateOLEObject('SAPI.SpVoice');
voice.Speak('Hello World!', 0);
end;
آخرین ویرایش به وسیله SayeyeZohor : جمعه 23 فروردین 1392 در 16:00 عصر
فعال سازي كردن صداي ويندوز مانند اخطار ، ايراد و ...
uses Windows;
procedure PlayBeep(ActionType: TMsgDlgType);
var mb: dWord;
begin
case ActionType of
mtInformation: mb := MB_ICONASTERISK; //SystemAsterisk
mtWarning: mb := MB_ICONEXCLAMATION; //SystemExclamation
mtError: mb := MB_ICONHAND; //SystemHand
mtConfirmation: mb := MB_ICONQUESTION; //SystemQuestion
mtCustom: mb := MB_OK; //SystemDefault
else
mb:= $0FFFFFFFF; //Standard beep using the computer speaker
end;
MessageBeep(mb);
end;
PlayBeep(mtWarning);
فعال يا غير فعال كردن صداي Beep سيستم
اين يكي از مشكلات دوستان بود كه رفع شد
روش اول :
غير فعال كردن
//Disable system beep
SystemParametersInfo(SPI_SETBEEP, 0, nil, SPIF_SENDWININICHANGE);
فعال كردن
//Enable system beep
SystemParametersInfo(SPI_SETBEEP, 1, nil, SPIF_SENDWININICHANGE);
روش دوم :
// Either disable the Beep in the OnKeyPress handler:
// Unterdrücke den Beep-Ton entweder im OnKeyPress Ereignis:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then // #13 = Return
begin
key := #0;
// Code...
end;
end;
روش سوم :
// Or in the OnKeyDown-Handler:
// Oder im OnKeyDown Ereignis:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Mgs: TMsg;
begin
if Key = VK_RETURN then
begin
PeekMessage(Mgs, 0, WM_CHAR, WM_CHAR, PM_REMOVE);
// Code...
end;
روش هاي غيرفعال كردن به صورت دستي :
Turn Off the Annoying Windows XP System Beeps
How to Disable System Beep in Windows 7
Disable system beeps
آخرین ویرایش به وسیله SayeyeZohor : جمعه 23 فروردین 1392 در 16:11 عصر
تشخيص اينكه كليد اينتر فشرده شده جزء كليد هاي ماشين حساب كيبورد است يا خير؟
interface
... private
procedure WMKeyDown(var Message: TWMKeyDown) ; message CM_DIALOGKEY;
implementation
...
procedure TForm1.WMKeyDown(var Message: TWMKeyDown) ;
begin
inherited;
case Message.CharCode of
VK_RETURN: // ENTER pressed
if (Message.KeyData and $1000000 <> 0) then
// Test bit 24 of lParam
ShowMessage('ENTER on numeric keypad')
else
ShowMessage('ENTER on Standard keyboard') ;
end;
end;
uses MMSystem;
//فعال كردن beep سيستم به صورت متوالي
sndPlaySound('C:\Windows\Media\ding.wav', SND_NODEFAULT Or SND_ASYNC Or SND_LOOP);
//غير فعال كردن beep سيستم
sndPlaySound(nil, 0); // Stops the sound