صفحه 3 از 6 اولاول 12345 ... آخرآخر
نمایش نتایج 81 تا 120 از 214

نام تاپیک: سورسهاي نمونه آموزشي

  1. #81
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    بدست آوردن موقعيت دقيق موس با كشيدن دو خط افقي و عمودي



    دانلود سورس كد

  2. #82
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    اجراي افكت روي متن

    a
    b...
    d
    da
    db...
    de
    dea
    deb
    dec...
    del
    dela
    delb
    delc...
    delp
    ...
    delphi rulez

    دانلود سورس كد

  3. #83
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    به لرزه در آوردن فرم دلخواهتون

    دانلود سورس كد

  4. #84
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    يك خط كش توپ براي ويندوز
    خداييش خودمم ديدم شوك شدم

    دانلود سورس كد


  5. #85
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    اينم يك سورس كه باهاش ميشه هر برنامه اي كه مي خواند سريع اجرا كنيد تو اين نرم افزار Add كنيد و بعد با دابل كليك روي آن ها ، اجراشون كنيد

    دانلود سورس كد


  6. #86
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    یاده سازی الگوریتم کلونی مورچه ها با دلفی


    دانلود سورس كد
    آخرین ویرایش به وسیله SayeyeZohor : یک شنبه 11 تیر 1391 در 21:32 عصر

  7. #87
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    تا حالا با مكينتاش كار كردين؟
    من با گجت پايينش خيلي حال مي كنم


    دانلود سورس كد

  8. #88
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    يك launcher جديد

    دانلود سورس كد


  9. #89

    نقل قول: سورسهاي نمونه آموزشي

    نقل قول نوشته شده توسط SayeyeZohor مشاهده تاپیک
    ساعت باينري



    دانلود سورس كد
    کی این کد رو نوشته ؟ باید به صورت زیر تغییر پیدا کنه وگرنه در زمان های تک رقمی مشکل پیدا میکنه :

    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;


    نقل قول نوشته شده توسط SayeyeZohor مشاهده تاپیک
    اين يك بازي توپ با مورچه ها


    دانلود سورس كد
    این بازی نیست ؛ پیاده سازی الگوریتم کلونی مورچه ها با دلفی هست !

  10. #90
    کاربر دائمی آواتار tadeh2010
    تاریخ عضویت
    آذر 1389
    محل زندگی
    تهران
    پست
    109

    نقل قول: سورسهاي نمونه آموزشي

    سلام
    من یک برنامه درست کردم برای multi ping کردن که به صورت فرم MDI می باشد ولی بلد نیستم که از Thread ها استفاده بکنم کسی می تواند کمک بکند.
    اگر بشود از Thread استفاده کرد برای هر فرمی که ساخته می شود (هر IP یک نام که برای کپشن فرم می باشد می گیرد و یک form child ساخته میشود که داخلش یک timer می باشد که هر یک ثانیه یا هر زمانی که تنظیم کرده باشیم از طریق کامپوننت ایندی ICMP آی پی فرم مربوطه را پینگ می کند)،
    برنامه بسیار خوبی برای مدیران شبکه ها می شود.
    source کامل اش را گزاشته ام.
    http://s1.picofile.com/file/74361611..._ICMP.rar.html

  11. #91
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

    برنامه متن ساده رنگی!

    سلام علیکم
    درورد بر برنامه نویسای دلفی
    جستجوش و شکستن خط و ذخیره و نمایش نام فایل در نوار عنوان یه کم ایراد داشت یه کم درستش کردم!
    این یه برنامه کوچیک همراه با سورشه که متن رو رنگی نشون میده.
    تو محیط اصلی برنامه از لیست باکس استفاده کردم که با DrawItem متن و اشکال داخلش رو ترسیم می کنم و در محیط تایپ او یه ادیت با امکانات ساده داریم.استفاده اصلیش برای من تولید راهنمای رنگی برای برنامه است.

    قابلیتهایی هم داره:
    امکان ارسال تصویر متن به ClipBoard
    تنظیم فاصله سطرها
    تعیین رنگ پس زمینه
    چهار نوع بولت
    شش رنگ همزمان برای متن فارسی
    جستجوی متن رو به پایین و رو به بالا با کلیدهای F5-F6-F7
    (البته تو محیط اصلی کلمه رو مشخص نمی کنه!)
    تصحیح "ی" و "ي"!
    یه نکته :
    اصطلاح صفحه در لیست کلیدهای محیط اصلی رو برای محدوده ای از متن که به سطر خالی برسه به کار بردم (برای درک مساله فایل ترجمه سوره حمد و بقره در کنار برنامه رو ببینین)

    امیدوارم خوشتون بیاد و اگه حوصله کردین تکمیلش کنین.
    عکس های ضمیمه عکس های ضمیمه
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله mbshareat : چهارشنبه 26 مهر 1391 در 08:03 صبح

  12. #92
    کاربر تازه وارد
    تاریخ عضویت
    اسفند 1390
    محل زندگی
    تهران
    پست
    31

    نقل قول: سورسهاي نمونه آموزشي


  13. #93
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    ساخت Generate SQL Script با دلفي براي اسكيوال سرور 2000 با اين تفاوت كه انتقال اطلاعات هم داشته باشه

    دانلود فايل ساخت Generate SQL Script

  14. #94
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

    نقل قول: سورسهاي نمونه آموزشي

    سلام
    نیاز به یه برنامه برای تغییر نام فایلهای شاخه به دسته ای داشتم یه برنامه ساده نوشتم.تستش کردم ان شاء الله درست کار میکنه!!(مثل وقتی توی 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 در 10:46 صبح

  15. #95
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

    نقل قول: سورسهاي نمونه آموزشي

    سلام دوستان!
    یه برنامه کوچیک دارم برای بزرگ کردن و رنگی کردن نقطه های ریز متن.
    کامل و دقیق نیست اما بدک نیست!؟
    یه کم روش کار کردم زوائد نقطه ها رو برداشتم . حالا دیگه اعراب رو نقطه حساب نمی کنه و میشه محدوده برای رنگ کردن نقطه تعیین کرد!
    یه سوتی داده بودم: رنگها در بیت مپ به ترتیی BGR هستش و به دلیل بی توجهی به این مساله نقطه ها در جای مناسب ترسیم نمی شدند که حالا اصلاح شد!
    پروسیجر برای یکپارچه کردن نقاط واجد رنگ مشابه با رنگ داده شه هم بهش اضافه کردم.
    فرض کنید چند نقطه با RGB نزدیک به AA00FF$ داریم میخوایم همه این نقاط دقیقا RGB معادل AA00FF$ داشته باشند.شباهت کوچکی هم به MagicWand داره. (بیشتر وقتی بیت مپی که متنی توش هست به صورت HalfTone کوچک بشه کمک می کنه!)
    عکس های ضمیمه عکس های ضمیمه
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله mbshareat : دوشنبه 01 آبان 1391 در 23:30 عصر

  16. #96
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

    ساده ترین کد ترسیم خط و دایره با حالت ضد پلگی!

    سلام
    ترسیمات پیشفرض دایره و خط و .. دارای لبه سخت هستند.
    با کد زیر می تونین ترسیمات دایره و خط و غیره رو با خطوط خارجی که رنگش کم کم کمرنگ و با رنگ نقاط اطراف ترکیب میشه، انجام بدید. به این شکل که سایه ای از رنگ خطوط محیطی بین شکستگیهای Pixel ها ایجاد میشه.
    تصویر بزرگ شده زیر رو که با این پروسیجر ترسیم شده ملاحظه بفرمایید:
    SmoothDraw.gif
    نحوه استفاده:
    قبل از هر کار یک بیت مپ برای نگه داشتن تصویر پشت شکل تعریف می کنیم( بیشتر به خاطر استفاده در برنامه طراحی با ماوس به درد می خوره)
    پارامترها:
    0)بیت مپ برای ذخیره ناحیه پشت شکل!(برای طراحی برنامه هایی مثل Paint خوبه)
    1)کانواس مربوطه
    2)آرایه عددی شامل 4 یا 6 عدد مختصات و شعاع گوشه مستطیل گوشه دار که به عنوان پارامتر در دستورات ترسیم به کار می رود
    3)رشته معرف نوع شکل:
    L: خط R: مستطیل RR: مستطیل لبه گرد E:بیضی
    4)رشته معرف نحوه ترسیم:
    B: تنها خط محیطی F: تنها رنگ داخلی BF: ترکیب خط محیطی و رنگ داخلی
    5)رنگ خط محیطی
    6)رنگ داخل
    7)ضخامت خط
    در برنامه نمونه میتونید با درگ ماوس روی تصویر مستطیل با گوشه گرد بکشید.
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله mbshareat : یک شنبه 08 آبان 1401 در 19:00 عصر

  17. #97

    اجرای بدون دردسر Stored Procedure ها

    امروز داشتم یه خونه تکونی روی سورس های قدیمی شرکت میدادم و تصمیم گرفتم تمام 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 در 16:13 عصر

  18. #98

    بررسی امن بودن کلمه عبور

    بنا به درخواست یکی از مشتری ها قرار شد تو برنامه ای که داشتم براش مینوشتم پروسه ای رو پیداه سازی کنم که زمان تغییر کلمه عبور کاربران نرم افزار میزان امنیت کلمه عبور رو بررسی کنه و اگر کلمه عبور ساده ای بود از تغییر رمز جلوگیری کنه ، امروز صبح تابع زیر رو عجله ای برای این کار نوشتم که میتونید بسته به نیازتون میزان سختگیری برای تایید امنیت یک رمز رو با تغییر اعداد کم یا زیاد کنید :

    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 در 07:40 صبح

  19. #99

    نقل قول: سورسهاي نمونه آموزشي

    بدست اوردو ورزن و نام ویندوز تا ویندوز 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);

  20. #100
    کاربر دائمی
    تاریخ عضویت
    خرداد 1391
    محل زندگی
    اصفهان
    سن
    32
    پست
    181

    نقل قول: سورسهاي نمونه آموزشي

    گذاشتن برنامه در System Tray (کنار ساعت ویندوز) و باز کردن برنامه با دبل کلیک روی آیکن.

    با مینیمایز کردن یا بستن برنامه ، برنامه کنار ساعت ویندوز قرار میگیره. و با کلیک راست روی آیکن و زدن گزینه exit نرم افزار بسته میشه.

    من این سورس رو از یه سایت گرفتم و یه کم تغییر دادم. من روی دلفی xe2 تست کردم. در نسخه های پایین تر باید کامپوننت coolTrayIcon رو نصب کنبد. و البته با یه کم تغییر در کدها.
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله farzadkamali : یک شنبه 26 آذر 1391 در 15:07 عصر

  21. #101

    شبیه سازی Solar System منظومه خورشیدی

    سلام.
    دوره جوونی یه شب زد به سرم که چرا مدار زمین گرد نیست.
    این برنامه رو نوشتم که با کمی اصلاحات براتون می گذارم. شاید براتون جالب باشه.
    البته در دو بعد هست که به راحتی می شه سه بعدیش کرد.
    دیدم دوستایی سورس دادن، گفتم من هم کاری کرده باشم برا تشویق بقیه برا ادامه این کار (دادن سورس برنامه ها)
    ----------------
    توضیح:
    در متد

    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

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  22. #102

    برنامه FixProgram برای تبدیل عبارات (Prefix,Postfix,Infix) به هم

    درود به همه
    من این ترم درس ساختمان داده رو (فکر کنم)پاس کردم ، توی دانشکده همه برنامه هاشو با ++C نوشتم
    دیروز اتفاقی به یک برنامه خوب در این زمینه به زبان #C برخوردم و چون کامل بود اونو به دلفی تبدیل کردم و حالا هم میذارم اینجا شاید به درد کسی بخوره.

    اینم عکس از برنامه :
    موفق باشید.
    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  23. #103

    استفاده از WebCam در دلفی

    درود
    الان بیکار بودم نشستم یک برنامه برای استفاده از وبکم نوشتم ، با حداقل موارد لازم !

    امکانات :

    • اتصال به وبکم
    • ذخیره فریم جاری در قالب یک عکس BMP
    • ذخیره کردن تصاویری که از وبکم دریافت میشه ،در قالب فیلم AVI (صدا رو هم توی فیلم ذخیره می کنه)
    • همین !

    اینم عکس از برنامه در حال اجرا :
    ضمیمه 99297
    اینم پروژه (در نسخه XE2)
    موفق باشید.

    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله بهروز عباسی : یک شنبه 13 اردیبهشت 1394 در 11:27 صبح
    Everything that has a beginning has an end. ... The End?



  24. #104

    سورس برنامه USB_Safely_Remover

    درود
    نمیدونم تا حالا با برنامه USB_Safely_Remover کار کردید یا نه...
    اگه قصد نوشتن برنامه ای مشابهش رو دارید حتماً برنامه زیرو ببینید و سورسشو مطالعه کنید.
    یک یونیت پیشرفته برای کار با USB همراه پروژشست که باهاش میشه همه اطلاعات مربوط به قطعات رو به دست آورد.

    USBRemover.jpg

    موفق باشید.
    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  25. #105

    مشاهده دسکتاپ کلاینت ها در شبکه

    درود
    امروز یک برنامه کوچیک برای مشاهده کردن دسکتاپ کلاینت ها در شبکه ،نوشتم.
    بنا به دلایلی نمی تونم برنامه کامل رو بذارم
    اما یک نمونه جمع و جور می ذارم اینجا تا دوستان دیگه هم استفاده کنن.
    ( دلفی XE2 )

    Client Desktop.jpg
    اینم پروژه .
    موفق باشید
    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  26. #106

    نقل قول: سورسهاي نمونه آموزشي

    توابع تبدیل تاریخ با دقت 5000 سال
    پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  27. #107

    نقل قول: سورسهاي نمونه آموزشي

    نمی دونم چکار کنم که لینک Redundant نشه. اما اجالتا:

    - تکه تکه کردن یک عکس که پرینت آن در یک صفحه جا نمی شود..

    مطلب را در اینجا مشاهده کنید.
    https://barnamenevis.org/showthread.p...44#post1725144
    توابع تبدیل تاریخ با دقت 5000 سال
    پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  28. #108
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    استفاده از كنسول اپليكيشن يا CMD در دلفي
    مانند دستور Ping 192.168.1.1
    Untitled.png
    StoRedirectedExecute.rar

  29. #109

    نقل قول: سورسهاي نمونه آموزشي

    نقل قول نوشته شده توسط SayeyeZohor مشاهده تاپیک
    استفاده از كنسول اپليكيشن يا CMD در دلفي
    مانند دستور Ping 192.168.1.1
    Untitled.png
    StoRedirectedExecute.rar
    نمیخواستم که این پست رو(به دلیل تکراری بودن و ...) بنویسم ولی برای اینکه دیگران گمراه نشوند باید بگویم که راه حل خوبی را ارائه نداده اید و خیلی از موارد توسط این روش ساپورت نمیشوند. بهترین راه حل در این رابطه استفاده از کامپوننت TJvCreateProcess موجود در مجموعه JVCL است که حتی از Nested Pipes و ورودی و خروجی استاندارد هم پشتیبانی می کنه. راه حلی که شما ارائه داده اید فقط در موارد خیلی ساده کاربرد داره و موقعی که کار یه کمی پیچیده تر باشه کارایی نداره.
    آخرین ویرایش به وسیله BORHAN TEC : چهارشنبه 30 اسفند 1391 در 12:15 عصر

  30. #110

    نقل قول: سورسهاي نمونه آموزشي

    بستن دسترسی برنامه ها به اینترنت


    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;

  31. #111

    Auto Scroll کردن کنترل Memo

    گاهی اوقات پیش می آید که می خواهیم به صورت اتوماتیک به آخرین خط یک 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/

  32. #112
    کاربر دائمی آواتار gholami146
    تاریخ عضویت
    آبان 1388
    محل زندگی
    مشهد مقدس
    پست
    374

    نقل قول: سورسهاي نمونه آموزشي

    با سلام
    امروز یک برنامه با سورس میخوام بزارم واسه مبتدی ها
    این یک برنامه مدیریت دریافت ها و پرداخت هاست که واسه ساختمان خودم نوشتم (آخه مدیر ساختمان هستم)
    تصمیم گرفتم برنامه رو با سورس بزارم واسه دوستان عزیزی که تازه کار با بانکهای اطلاعاتی و ایجاد ارتباط و فیلتر کردن اطلاعات رو میخوان یاد بگیرن امید وارم مفید باشه

    دانلود برنامه و سورس
    عکس های ضمیمه عکس های ضمیمه

  33. #113

    نقل قول: سورسهاي نمونه آموزشي

    نقل قول نوشته شده توسط gholami146 مشاهده تاپیک
    با سلام
    امروز یک برنامه با سورس میخوام بزارم واسه مبتدی ها
    این یک برنامه مدیریت دریافت ها و پرداخت هاست که واسه ساختمان خودم نوشتم (آخه مدیر ساختمان هستم)
    تصمیم گرفتم برنامه رو با سورس بزارم واسه دوستان عزیزی که تازه کار با بانکهای اطلاعاتی و ایجاد ارتباط و فیلتر کردن اطلاعات رو میخوان یاد بگیرن امید وارم مفید باشه

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


  34. #114
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    با اجازه دوست خوبم gholami146
    كامپوننت هاي مورد استفاده تا جايي كه مي دونم :
    1- TAdvOfficePager از سري TMS
    2- UNiDac از كمپاني DevArt
    3- Ehlib
    4- TXCalPlannerDatePicker
    5- TAnimationCaption
    6- TQExport4XLS
    7- TPersianCalendar

  35. #115
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    با سلام خدمت دوستان
    يك قطعه كد در اين قسمت مي گذارم كه مي تونيم باهاش مولفه هاي يك تابع رو جدا كنيم
    مثال :‌ اين يك نمونه از تابع يك برنامه است
    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;


  36. #116
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    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 در 15:00 عصر

  37. #117
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    فعال سازي كردن صداي ويندوز مانند اخطار ، ايراد و ...


    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);

  38. #118
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    فعال يا غير فعال كردن صداي 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 در 15:11 عصر

  39. #119
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي

    تشخيص اينكه كليد اينتر فشرده شده جزء كليد هاي ماشين حساب كيبورد است يا خير؟


    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;

  40. #120
    کاربر دائمی آواتار SayeyeZohor
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ا-ص-ف-ه-ا-ن
    پست
    631

    نقل قول: سورسهاي نمونه آموزشي


    uses MMSystem;
    //فعال كردن beep سيستم به صورت متوالي
    sndPlaySound('C:\Windows\Media\ding.wav', SND_NODEFAULT Or SND_ASYNC Or SND_LOOP);

    //غير فعال كردن beep سيستم
    sndPlaySound(nil, 0); // Stops the sound

صفحه 3 از 6 اولاول 12345 ... آخرآخر

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •