صفحه 6 از 6 اولاول ... 456
نمایش نتایج 201 تا 214 از 214

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

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

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

    برنامه ای برای کپی سورس برنامه ها به فلش مموری
    این برنامه فقط برخی فایلهای پوشه رو کپی می کنه :(dcu.dfm.dpr.ddp.pas.exe.ico)
    CopyFoldersToFlash.rar

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

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

    سلام دوستان
    کدهایی که دوست داشتم به صورت فایل متن کوچک دسته بندی کردم.
    مثلا مباحثی مثل تصویر ،صفحه کلید،هندل،کار با فایل و شاخه،صوت و... که بیشتر به صورت یک پروسیجر در یک فایل هست.
    برای مبتدیها ممکنه جالب باشه:
    نمونه کدهای آموزشی.rar

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

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

    سلام
    میخواستم ببینم کجای یونیت تغییر کرده.دو نسخه یونیت رو به روش ساده مقایسه کردم.دو متن رو ریختم در دو ممو و سطرهای تکراری رو از دو متن حذف کردم.(البته این روش ساده به ترتیب حساس نیست!)
    گفتم ممکنه به درد کسی بخوره.تا اونجا که یادم میاد قبلا با یه روش دیگه سطر به سطر مقایسه کرده بودم که به جابجایی کد هم حساس میشد.اما پیچیدگیهایی داه مثل نادیده گرفتن سطرهای غیر تکراری و...
    این هم از سورس برنامه:
    Compare2Pas.rar

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

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

    سلام
    یه برنامه بازی ساختم گفتم به کسی نشون داده باشم.
    ترکیب دو بازی در یه صفحه هست یکی حدس کلمه و دیگری پیدا کردن تصاویر مشابه.
    دو نفر میتونند همزمان بازی کنند یکی با کلید و دیگری با ماوس.
    برای مبتدی سر در آوردن از برنامه سخته.
    برای کار ساده با تصویر و صوت و اعداد تصاوفی کمی آموزشیه.
    من برای پیدا کردن عدد تصادفی در یک محدوده 16 تایی(شماره تصویر در جدول تصاویر بدون تکرار برنامه) یه رشته به طول همون محدوده تعریف کردم که از کارکتر یک تا مثلا شانزده رو به ترتیب داره.یک کارکتر رو از گردونه خارج کردم و برای به دست آوردن عدد دوم که جای تصویر مشابه دوم هست،بین بقیه رشته یک کارکتر رو از گردونه خارج کردم و..
    برای حدس کلمه یه کم کار متفاوته.
    برنامه کد خیلی پیچیده ای نداره(یعنی مثل کدهایی که از نت میگیرم نیست) اما سورس برنامه پر از تصویره که همه شون به جز یکی رو خودم طراحی کردم.
    تصاویر حدس زدنی رو هم از بازی فلش خودم که نا تموم مونده و تا مرحله 24 ساختم استخراج کردم.
    اگر از برنامه سر در نیوردید هم باکی نیست..بالاخره بازی خوبیه(ضد آلزایمر)!!!

    Untitled-1.jpg

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

    بازی فکری دو نفره

    سورس برنامه بازی نوشته شده در محیط XE2
    یادم رفت: Panel2.Left:=Panel1.Left; رو کامنت کنید و یه کم panel2 رو بیارید سمت راست.
    (پیکوفایل سرعت پایینی داره.حوصله ندارم از اول، سورس رو بذارم!ایتا بی شوخی ده برابر سرعت داره)
    آخرین ویرایش به وسیله mbshareat : شنبه 09 فروردین 1399 در 09:07 صبح

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

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

    سلام
    کمتر از دو ماهه گوشی هوشمند گرفتم.
    چند تا بازی پیدا کردن اختلاف دو تصویر دانلود کردم.مثل کارآگاه ريز بین و اختلاف تصویر سینا و اختلاف تصویر ثنا و ثمین.
    معمولا آخرین اختلافها رو نمیتونستم پیدا کنم. پس براش برنامه نوشتم.
    a.jpg
    اولش از یه روش سخت استفاده می کردم.تصویر صفحه گوشی رو میریختم پیکوفایل.
    بعد در کامپیوتر دو تکه از یک jpeg (که هر کدوم یکی از دوتصویر مشابه بود) رو به تناوب نمایش میدادم که اختلاف معلوم شه.(وقتی تصویر Jpeg باشه نمیشه روی رنگ حساس شد!)
    جدیدا شبیه ساز اندروید LDPlayer.3.79.3 نصب کردم.بازی کارآگاه ریزبین رو هم در اون نصب کردم.
    یه برنامه نوشتم که به رنگها حساسه و رنگهای دو ناحیه از یه تصویر رو مقایسه می کنه و قسمتهایی که نقاط رنگی متفاوت داره قرمز می کنه.
    در برنامه میشه مختصات دو محدوده تصویر (که همون دو تصویر مشابه هست) رو در تصویر گرفته شده از صفحه بازی هست، تعیین کرد.
    این روش خیلی به دقیق بودن مختصات، حساس هست و میشه با فشار Alt+Q (وقتی ماوس روی پنجره شبیه ساز هست) تصویر ورودی رو برای برنامه تعیین کرد یا از یه فایل کنار برنامه .
    مقادیر پیشفرض برنامه هم مربوط به بازی کارآگاه ریزبین با پایینترین رزولوشن شبیه ساز LDPlayer هست که قابل تغییره.

    نکته:
    وقتی با Alt+Q تصویر رو میگیریم میتونیم با الصاق محتوای کلیپ برد در برنامه msPaint، مختصات دو محدوده تصویرهای مشابه رو بررسی کنیم.
    سورس برنامه نسخه جدید
    مختصات سینا.jpg
    تصويري از نسخه کمی قدیمی تر:
    untitled.jpg

    یه توضیح کوچولو:
    بازی بالاتر، اختلاف تصویر سینا هست که رنگ آمیزی دو ناحیه تصوی مشابه اونقدر دقیق نیست که بشه اختلاف رنگ رو بررسی کرد و باید از دکمه تصوی اول/دوم استفاده کرد.
    بازی پایین کارآگاه ریز بین هست که رنگهای دو محدوده تصویر، دقیق و قابل انطباق بر هم هست.در این بازی میشه از قرمز کردن نقاط رنگی که در دو تصویر متفاوتند، استفاده کرد.
    آخرین ویرایش به وسیله mbshareat : یک شنبه 03 فروردین 1399 در 02:43 صبح

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

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

    اجرای برنامه در پس زمینه
    //FormCreate
    WindowState:=wsMinimized;
    Left:=-100;
    Width:=0;
    Height:=0;
    SetWindowLong(Application.Handle, GWL_EXSTYLE,WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);



    //FormPaint
    Application.MainForm.Hide;


    آخرین ویرایش به وسیله mbshareat : سه شنبه 12 فروردین 1399 در 09:58 صبح

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

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

    تبدیل تصویر عمودی و افقی به مربع با اضافه کردن حاشیه سفید
    میخواستم تصویر برای اینستاگرام بفرستم کناره هاش رو حذف می کرد.در مورد اندازه تصویر تحقیق کردم به کارم نیومد.میخواستم در یک پست چند تصویر بذارم پس تنظیم تمام تصویر اینستاگرام هم به کارم نیومد.NoCrop نصب کردم به نظرم اومد خوب کار می کنه بعد دیدم اندازه تصویر رو بی منطق 2080 در 2080 می کنه.منوی تنظیماتش رو هم می زدم خیلی عجیب نرم افزار کمی قفل می کرد میرفت پس زمینه و بالا می آوردیمش از اول میشد.
    بگذریم.خودم یه برنامه نوشتم که فضای خالی به تصویر اضافه می کنه که تصویر مربع بشه.متاسفانه اینترنت گوشیم تموم شد.(مثل اینکه *1000*27# هم لغو شده!)
    نتونستم ببینم مربع کردن با هر اندازه ای جواب میده یا نه.البته من تصاویر حد اکثر 1000*1000 کافیم بود.
    برنامه رو میذارم چون کوچیکه میشه بهش از جنبه آموزشی هم نگاه کرد.تبدیل Jpg و Bmp به هم و حذف خاکستری برای تصویر تک رنگ(من میخواستم تصویر کتاب انگلیسی پست کنم!) در برنامه هست.
    نمی دونم چرا در سایت آپلود کردم لینک درست نمیده.مجبورم نسخه دوم رو در پیکو فایل بذارم.
    عکس های ضمیمه عکس های ضمیمه
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله mbshareat : سه شنبه 19 فروردین 1399 در 03:02 صبح

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

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

    ایجاد فایل متن برای دانلود سریال توسط IDM
    ابتدا لینک یک قسمت سریال رو به برنامه می دیم و شماره اولین و آخرین قسمتی که میخوایم IDM دانلود کنه تعیین می کنیم.
    برنامه فایل متن میسازه که لینک قسمتها در اون هست و از قسمت امور>وارد کردن<از فایل تکست فایل متن رو به IDM معرفی می کنیم که لینکها رو استفاده کنه
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله mbshareat : سه شنبه 24 آبان 1401 در 12:24 عصر

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

    Smile گرفتن یک تصویر کوچک(شکلک یا طراحی ساده یا آیکن) از فایل تصویر مجموعه ای.

    سلام علیکم
    چند وقت پیش رفتم سایت Pinterest .
    تصاویر بامزه و آیکنهای مفید برای برنامه نویسی داره که به صورت مجموعه ای هستند
    من دوست داشتم برنامه ای باشه که بتونم با کلیک یکی از تصاویر کوچک فایل تصویری رو بگیرم.
    از کد MagicWand برای گرفتن ناحیه و GraphicEx برای تنظیم اندازه با کیفیت استفاده کردم.
    میتونید با درگ هم تصویر رو روی پنجره برنامه بکشید!
    امیدوارم به درد کسی بخوره و اگر دعا کنیدهم ممنون میشم.
    Untitled-1.jpg
    این هم سورس برنامه و تصویر:
    MultiDrawing.Prg.rar

    این هم نسخه بهبود يافته با جعبه ابزار که به علت استفاده از کامپوننت دکمه بدقلق خودم فقط فایل اجرایی میذارم:
    س.JPG
    MultiDrawing.exe.rar
    آخرین ویرایش به وسیله mbshareat : جمعه 27 آبان 1401 در 16:20 عصر

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

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

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

    procedure EditAction(E:TEdit;Key:Word;Shift: TShiftState);
    Var
    N:Byte;
    begin
    SetWindowLong(E.Handle, GWL_STYLE, GetWindowLong(E.Handle, GWL_STYLE) or ES_NUMBER);
    If ssCtrl in Shift then
    N:=10
    Else
    N:=1;
    If Key=vk_UP then
    E.Text:=IntToStr(StrToInt(E.Text)+N);
    If Key=VK_DOWN then
    E.Text:=IntToStr(StrToInt(E.Text)-N);
    end;

    سطر اول پروسیجر رو میتونید در FormCreate بذارید و فقط یک بار اجرا کنید که ادیت فقط عدد قبول کنه.
    نحوه استفاده:
    یک TEdit روی فرم میذاریم و چنین کدی استفاده می کنیم:
    procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
    Shift: TShiftState);
    begin
    EditAction(TEdit(Sender),Key,Shift);
    end;


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

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

    سریع ترین کد برای قرینه کردن بیت مپ:
    procedure FlipBmp(B:TBitmap;Mode:Byte);
    Var
    R,R2:TRect;
    begin
    R:=B.Canvas.ClipRect;
    If Mode=1 then
    R2:=Rect(R.Right,R.Top,R.Left,R.Bottom)
    Else
    R2:=Rect(R.Left,R.Bottom,R.Right,R.Top);
    B.Canvas.CopyRect(R2,B.Canvas,R);
    end;


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

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

    کد برای تغییر رنگ پس زمینه سطر جاری در لیست باکس(حوصله توضیح اضافه ندارم)
    ListBox1.Style-> lbOwnerDrawFixed

    Var
    LastItem:Integer=-1;
    ..

    implementation
    ...

    procedure TReplaceTextForm.ListBox1DrawItem(Control: TWinControl;
    Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure DrawItem(Idx:Integer;R:TRect);
    Var
    S:String;
    W:Word;
    begin
    If Idx=ListBox1.ItemIndex Then
    ListBox1.Canvas.Brush.Color:=clAqua
    Else
    ListBox1.Canvas.Brush.Color:=ListBox1.Color;
    //SetBkMode(ListBox1.Canvas.Handle,Transparent);
    ListBox1.Canvas.FillRect(R);
    ListBox1.Canvas.Font.Color:=clBlack;//ضروري
    ListBox1.Canvas.TextOut(R.Left,R.Top,ListBox1.Item s[Idx]);
    end;
    begin
    If (LastItem<>-1) And (LastItem<>ListBox1.ItemIndex)
    And (LastItem<ListBox1.Items.Count) then
    DrawItem(LastItem,ListBox1.ItemRect(LastItem));
    DrawItem(Index,Rect);
    LastItem:=Index;
    end;

    آخرین ویرایش به وسیله mbshareat : پنج شنبه 08 دی 1401 در 08:33 صبح

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

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

    سلام دوستان
    یه کد نسبتا ساده گذاشتم برای وقتیکه خواستید یه پیغام فارسی با شکلک نمایش بدید.میتونید تعیین کنیدچند ثانیه نمایش داده بشه یا تعیین نکنید.
    نکته: شکلک نمایش داده شده، تصادفی است و احساس رو با رنگ نمایش میدیدم
    All.JPG
    a.JPG
    نحوه استفاده:
    بعد از اضافه کردن یونیت موجود در فایل فشرده به برنامه ، در فرم مد نظر چنین کدی میذاریم(حوصله توضیح بیشتر نداشتم):
      FaceMsgForm.Msg('اين يک پيغام نمايشي است.',clYellow,1);
    FaceMasgForm.rar

    یه تابع هم نوشتم که اگر تصویر بیت مپ شکلکها رو با نام AllFacesImg در یک فرم بذاریم، میتونیم یه پنجره پیغام مثل شکل داشته باشم(بدون اضافه کردن فرم پیغام به برنامه!)
    فرق این کد با کد بالا اینه که تایمر نداره و اگر متن پیام کوتاه باشه، پهنای پنجره پیغام هم تنظیم میشه.
    FaceMsg Function.rar
    آخرین ویرایش به وسیله mbshareat : دوشنبه 29 خرداد 1402 در 09:53 صبح

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

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

    سلام
    احوال؟
    چند تابع ساده نوشتم برای اینکه تعداد کارکترهای کد کمتر بشه. گفتم شاید به درد کسی خورد:
    function TForm1.TrimFirst(S:String;N:Integer):String;begin
    If S='' then
    Exit;
    Result:=Copy(S,N+1,Length(S)-N);
    end;
    function TForm1.TrimLast(S:String;N:Integer):String;
    begin
    If S='' then
    Exit;
    Result:=Copy(S,1,Length(S)-N);
    end;
    function TForm1.BeforeStr(S,S2:String):String;
    begin
    If S='' then
    Exit;
    Result:=Copy(S,1,Pos(S2,S)-1);
    end;
    function TForm1.AfterStr(S,S2:String):String;
    begin
    If S='' then
    Exit;
    Result:=Copy(S,Pos(S2,S)+1,Length(S)-Pos(S2,S));
    end;
    function TForm1.BetweenStr(S,S2,S3:String):String;
    begin
    If S='' then
    Exit;
    Result:=Copy(S,Pos(S2,S)+Length(S2),PosEx(S3,S,Pos (S2,S))-Pos(S2,S)-Length(S2));
    end;
    function TForm1.LastChar(S:String):String;
    begin
    If S='' then
    Exit;
    Result:=S[Length(S)];
    end;
    procedure TForm1.GetNums(S:String;Var A:Array of Word;Reverse:Boolean=False;ExitChar:Char=#0);
    Var
    I,N:Word;
    Tmp:String;
    begin
    For I:=A[0] To High(A) Do
    A[I]:=0;
    S:=S+'.';
    N:=0;
    For I:=1 to Length(S) Do
    Begin
    If pos(S[I],'0123456789')>0 then
    Begin
    If Reverse=True then
    Tmp:=S[I]+Tmp
    Else
    Tmp:=Tmp+S[I];
    End
    else If Tmp<>'' then
    Begin
    A[N]:=StrToInt(Tmp);
    if S[I]=ExitChar then
    Break;
    Tmp:='';
    Inc(N);
    End;
    End;
    End;
    Function TForm1.IntRev(S:String):Integer;
    begin
    Result:=StrToInt(ReverseString(S));
    end;
    Function TForm1.Rev(S:String):String;
    begin
    Result:=ReverseString(S);
    end;
    Function TForm1.AppDir:String;
    begin
    Result:=ExtractFileDir(Application.ExeName);
    end;
    Function TForm1.TopDir(S:String;LC:Boolean=False):String;
    begin
    If LC=True then
    Result:=LowerCAse(ExtractFileDir(S))
    Else
    Result:=ExtractFileDir(S);
    end;
    Function TForm1.FN(S:String;LC:Boolean=False):String;
    begin
    If LC=True then
    Result:=LowerCAse(ExtractFileName(S))
    Else
    Result:=ExtractFileName(S);
    end;
    Function TForm1.Ext(S:String;LC:Boolean=False):String;
    begin
    If LC=True then
    Result:=LowerCAse(ExtractFileExt(S))
    Else
    Result:=ExtractFileExt(S);
    end;
    function TForm1.MatchPos(S,S2:String;N:Word):Integer;
    Var
    P,M:Integer;
    begin
    Result:=0;
    P:=0;
    M:=0;
    While True Do
    Begin
    P:=PosEx(S2,S,P+1);
    If P=0 then
    Exit
    Else
    Begin
    Inc(M);
    If N=M then
    Begin
    Result:=P;
    Exit;
    End;
    End;
    End;
    end;
    function TForm1.FirstMatchPos(S:String;A:Array of String):Integer;
    Var
    I,P,P2:Integer;
    begin
    P:=0;
    For I:=0 To High(A) Do
    Begin
    P2:=Pos(A[I],S);
    If (P=0) or (P2<P) then
    P:=P2;
    End;
    Result:=P;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    Var
    A:Array [1..3]Of Word;
    begin
    GetNums('}12\3-4{65',A,False,'{');
    ShowMessage(IntToStr(A[3]));
    ShowMessage(LastChar('bagher'));
    ShowMessage(IntToStr(MatchPos('Papa','a',2)));
    ShowMessage(IntToStr(FirstMatchPos('I am a Good Student!',['Go','!','a'])));
    end;





    دو نکته:
    1. اگر اسم فرم شما TForm1 نیست میتونید با Ctrl+R تغییرش بدید و اگر صلاح دونستید .Tform1 رو حذف کنید.
    2.من چون از بیسیک سراغ دلفی اومدم ترجیح میدم جای زیر رشته رو بعد از رشته اول بنویسم. اگر دلتون خواست جای پارامترها رو در MatchPos عوض کنید.
    آخرین ویرایش به وسیله mbshareat : شنبه 23 دی 1402 در 11:23 صبح

صفحه 6 از 6 اولاول ... 456

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

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

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