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

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

Hybrid View

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

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

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

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

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

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

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

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

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

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

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

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

    سلام علیکم
    گاهی لازمه در یک 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;


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

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

    سریع ترین کد برای قرینه کردن بیت مپ:
    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;


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

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

    کد برای تغییر رنگ پس زمینه سطر جاری در لیست باکس(حوصله توضیح اضافه ندارم)
    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 صبح

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

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

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

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

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

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

    سلام
    احوال؟
    چند تابع ساده نوشتم برای اینکه تعداد کارکترهای کد کمتر بشه. گفتم شاید به درد کسی خورد:
    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 صبح

  9. #9

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

    با کد زیر می توانید یک فایل اکسس موقع اجرا بسازید

    با دلفی7 تست و کامپایل شده
    فایل های ضمیمه فایل های ضمیمه

  10. #10

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

    با این کد می توانید تمام Event های یک کامپوننت رو بدست بیارید
    به Sender نام کلاس کامپوننت مورد نظرتون رو بزارید
    فایل های ضمیمه فایل های ضمیمه

  11. #11
    کاربر دائمی آواتار zidane
    تاریخ عضویت
    آذر 1385
    محل زندگی
    مشهد - خيابان دلفي - پلاک XE5
    سن
    38
    پست
    141

    Lightbulb SQL Server Database Manager

    با سلام
    چند وقتی بود که دنبال یک برنامه کوچیک و جمع و جور می گشتم که باهاش بتونم رو سیستمی که SQL Server Express یا MSDE نصب شده، لیست دیتابیس ها رو ببینم و بتونم باهاش Attach و Detach دیتابیس هم انجام بدم.
    چون برنامه جالبی پیدا نکردم خودم دست به کار شدم و این برنامه رو نوشتم.
    امیدوارم به درد شما هم بخوره:
    عکس های ضمیمه عکس های ضمیمه
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله zidane : پنج شنبه 12 آبان 1390 در 11:46 صبح دلیل: سازگاری با SQL Server 2000

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

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

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

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