سورسهاي نمونه آموزشي

دانلود کنید
ضمیمه 58996

یک یونیت برای کار با FaceBook مثل login و ....

این سورس کامل درخت فیثاغورث که برای یکی از کاربران تازه وارد قرار داده بودم مثل اینکه ایشون زرنگ تشریف داشتن پس از برداشتن سورس تاپیک رو پاک کردن. توضیحات بیشتر در این تاپیک قرار دارد.http://www.barnamenevis.org/sh...=106906&page=2

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ComCtrls;



type

  TPoints = Array of TPoint;

  Tline = record

   p1,p2 : TPoint;

  end;

  TForm1 = class(TForm)

    Button2: TButton;

    procedure Button2Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

  private

    { Private declarations }

  public

    p1,p2 : TPoint;

    function NormDegre(Degre : integer):integer;

    procedure DrawPoint(Pnts : TPoints);

    procedure FillTringle(Pnts : TPoints);

    function LineLen(p1,p2 : TPoint) : Integer;

    function GetDegre(P1,p2 : TPoint):integer;

    function InterSection(P1, p2: TPoint; Deg1, Deg2: Real): TPoint;

    procedure DrawTree(p1,p2 : TPoint;counter : integer);

    function Square1(p1,p2 : TPoint):TPoints;

    function Tringle1(p1,p2 : TPoint):TPoints;

  end;



var

  Form1: TForm1;



implementation



uses Math, Types;



{$R *.dfm}





procedure TForm1.Button2Click(Sender: TObject);

var p1,p2 : TPoint;



begin

  p1 := Point(400,400);

  p2 := Point(450,400);

  DrawTree(p1,p2,1);

end;



function TForm1.InterSection(P1, p2: TPoint; Deg1, Deg2: Real): TPoint;

begin

  Deg1 := Tan( DegToRad(Deg1));

  Deg2 := Tan(DegToRad(Deg2));



  Result.X := round( ((P1.Y - P2.Y)+(Deg2*p2.X- Deg1*P1.X))/(-Deg1+Deg2)) ;

  Result.Y :=round( Deg2*(Result.X - P2.X)+P2.Y);

{

  Result.X := round((-p1.Y+p2.Y+p1.X*Deg1-p2.X*Deg2)/(Deg1-Deg2));

  Result.Y :=round( Deg1*(Result.X - P1.X)+P1.Y);

  }

end;



function TForm1.GetDegre(P1, p2: TPoint): Integer;

begin

  Result := round( RadToDeg( ArcTan2(p2.Y-p1.Y,p2.X-p1.X)));

  if Result <0 then Result := 360 + Result;

end;



function TForm1.LineLen(p1, p2: TPoint):Integer ;

begin

 if p2.X = p1.X then Result := abs(p2.Y-p1.Y)

 else if p2.Y = p1.Y then Result := abs(p2.x-p1.x)

 else  Result := trunc( sqrt( sqr(p2.Y-p1.Y)+sqr(p2.X-p1.X)));

end;









procedure TForm1.DrawPoint(Pnts: TPoints);

var i , j : integer;

    colors:array[0..2] of byte;

begin

 Canvas.Pen.Color := clBlack;

 Canvas.MoveTo(Pnts[0].x,Pnts[0].y);

 for i := 1 to Length(Pnts)-1 do

   Canvas.LineTo(Pnts[i].X,Pnts[i].Y);



 Canvas.LineTo(Pnts[0].X,Pnts[0].Y);



 if Length(Pnts)=3 then

  begin

  end;

  

end;



procedure TForm1.DrawTree(p1,p2 : TPoint;counter : integer);

var SqrPnts ,TringPnts : TPoints;

begin

  if counter> 16 then Exit;

  counter := counter+1;

  SqrPnts := Square1(p1,p2);

  DrawPoint(SqrPnts);

  TringPnts := Tringle1(SqrPnts[3],SqrPnts[2]);

  DrawPoint(TringPnts);

  FillTringle(TringPnts);

  DrawTree(TringPnts[2],TringPnts[1],counter+1);

  DrawTree(TringPnts[0],TringPnts[2],counter+1);

  

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

   Randomize;

   p1 := Point(-1,-1);

   p2 := Point(-1,-1);   

end;



function TForm1.NormDegre(Degre: Integer): integer;

begin

  Result := Degre;

  if Degre< 0 then Result := 360 + Degre

  else if Degre> 360 then Result := Degre mod 360;

  

end;



function TForm1.Square1(p1, p2: TPoint):TPoints;

var G1,G2 : integer;

    r : integer;

    p3,p4  : TPoint;

begin

  G1 := GetDegre(p1,p2);

  G2 := GetDegre(p2,p1);



  r :=  LineLen(p1,p2);

  SetLength(Result,4);



  Result[0] := p1;

  Result[1] := p2;



  Result[2].X := p2.X+ round( r*cos(DegToRad(NormDegre( g2+90 ))));

  Result[2].Y := p2.Y+ round(r*sin(DegToRad(NormDegre( g2+90))));



  Result[3].X :=p1.X+  round(  r*cos(DegToRad(NormDegre( g1-90) )));

  Result[3].Y := p1.Y+ round(r*sin(DegToRad(NormDegre( g1-90) )));





end;



function TForm1.Tringle1(p1, p2: TPoint): TPoints;

var g : Integer;

    r , l ,r2 : Real;

begin

  SetLength(Result,3);

  Result[0] := p1;

  Result[1] := p2;

  g := GetDegre(p1,p2);

  r := LineLen(p1,p2);

  r2 := r /2;



  l := r2/ sin(DegToRad(45)) ;



  Result[2].X := round(p1.X +l*cos(DegToRad(NormDegre( g-45 ))));

  Result[2].Y := round(p1.Y +l*sin(DegToRad(NormDegre( g-45 ))));

    

end;



procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  if p1.X=-1 then p1 := Point(x,y)

  else   if p2.X=-1 then p2 := Point(x,y);



  if (p1.X<>-1) and (p2.X<>-1) then

   begin

     Refresh;

     DrawTree(p1,p2,1);

     p1 := Point(-1,-1);

     p2 := Point(-1,-1);     

   end;

end;



procedure TForm1.FillTringle(Pnts: TPoints);

var

    g ,r : integer;

    p ,q: TPoint;

    tempB : TBrush;

begin

   g := GetDegre(Pnts[0],Pnts[1]);

   r := LineLen(Pnts[0],Pnts[1]) div 2;

   p.X := Pnts[0].X+ round( r*cos(DegToRad(NormDegre( g ))));

   p.Y := Pnts[0].Y+ round(r*sin(DegToRad(NormDegre( g))));



   g := GetDegre(P,Pnts[2]);

   r := LineLen(P,Pnts[2]) div 2;

   q.X := P.X+ round( r*cos(DegToRad(NormDegre( g ))));

   q.Y := P.Y+ round(r*sin(DegToRad(NormDegre( g))));



//   tempB := Canvas.Brush;

//   Canvas.Brush.Style := bsSolid;

   Canvas.Brush.Color := clBlack;



   Canvas.FloodFill(q.X,q.Y,clBlack,fsBorder);

//   Canvas.Brush := tempB;



end;



end.

این برنامه فیلد های جدول اول رو میخونه و در جدول دوم درج میکنه فقط باید دو جدول بسازید به اسم person1 و person2 و در جدول اول فیلد های id,fname,lname و در جدول دوم فیلد های fname و lname را قرار بدید و بعد پروژه رو اجرا کنید:


ضمیمه 60321

سلام
با استفاده از این برنامه ای که ساخته ام شما می توانید فایل های مورد نظر خود را به صورتی از رایانه حذف کنید که دیگر با هیچ نرم افزار بازیابی اطلاعاتی قابل بازگشت نباشد. یادش بخیر این یکی از هفت برنامه ای بود که برای پروژه نهایی کاردانی نوشته بودم. :لبخندساده:
روش کار با این برنامه بسیار ساده است. فقط باید فایلهای مورد نظر را به روی ListView درگ کرده و برای حذف آن ها چک باکس موجود در کنار فایل های مورد نظر را به صورت انتخاب شده در آورید و سپس بر روی دکمه Erase کلیک کنید. در اصطلاح کلی به این گونه برنامه ها File Shredder گفته می شود. در ضمن توجه کنید که برای ساخت این برنامه از دلفی 2010 استفاده کرده ام. بنابرین برای کامپایل و اجرای برنامه به دلفی 2010 نیاز دارید.

نقل قول:

---

نوشته شده توسط شاهین عشایری

سلام
با استفاده از این برنامه ای که ساخته ام شما می توانید فایل های مورد نظر خود را به صورتی از رایانه حذف کنید که دیگر با هیچ نرم افزار بازیابی اطلاعاتی قابل بازگشت نباشد. یادش بخیر این یکی از هفت برنامه ای بود که برای پروژه نهایی کاردانی نوشته بودم. :لبخندساده:
روش کار با این برنامه بسیار ساده است. فقط باید فایلهای مورد نظر را به روی ListView درگ کرده و برای حذف آن ها چک باکس موجود در کنار فایل های مورد نظر را به صورت انتخاب شده در آورید و سپس بر روی دکمه Erase کلیک کنید. در اصطلاح کلی به این گونه برنامه ها File Shredder گفته می شود. در ضمن توجه کنید که برای ساخت این برنامه از دلفی 2010 استفاده کرده ام. بنابرین برای کامپایل و اجرای برنامه به دلفی 2010 نیاز دارید.

---

اعلان تابع IsTextFile با تعریفی که تو برنامه کردید متفاوت هست ، اعلان رو به صورت زیر تغییر بدید :

function IsTextFile(const sFileName: string): Boolean;

امروز یکی از کاربران تاپیکی زده بود و درخواست کدی کرده بود که بتونه یک فایل رو تو آدرس مورد نظر کپی و روند پیشرفت عملیات رو داخل یک ProgressBar نمایش بده ، بدین منظور کتابخانه ای با نام PBCopy نوشتم که یک فایل رو به آدرس مورد نظر کپی میکنه و روند پیشرفت عملیات کپی رو داخل یک ProgressBar نمایش میده که کتابخانه و نمونه برنامه رو میتونید از فایل ضمیمه دریافت کنید .

با استفاده از کد زیر شما می توانید نام نسخه سیستم عامل ویندوز را بدست آورید: (این کد در Delphi XE تست شده است)

uses ActiveX, OleAuto;



function GetWin32_OSNameVersion: string;

var

  objWMIService: OLEVariant;

  colItems: OLEVariant;

  colItem: OLEVariant;

  oEnum: IEnumvariant;

  iValue: LongWord;



  function GetWMIObject(const objectName: String): IDispatch;

  var

    chEaten: Integer;

    BindCtx: IBindCtx;

    Moniker: IMoniker;

  begin

    OleCheck(CreateBindCtx(0, BindCtx));

    OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten,

      Moniker));

    OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));

  end;



begin

  try

    objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');

    colItems := objWMIService.ExecQuery('SELECT * FROM Win32_OperatingSystem',

      'WQL', 0);

    oEnum := IUnknown(colItems._NewEnum) as IEnumvariant;

    if oEnum.Next(1, colItem, iValue) = 0 then

      Result := Format('%s %s', [colItem.Caption, colItem.Version]);

  except

    Result := '?'

  end;

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage(GetWin32_OSNameVersion);

end;

Overload کردن تابع ShowMessage برای پذیرفتن مقادیر اعشاری، صحیح و بولی:

unit common;

 

 interface

 

 uses dialogs, sysutils;

 

 procedure ShowMessage(const value : string) ; overload;

 procedure ShowMessage(const value : integer) ; overload;

 procedure ShowMessage(const value : extended) ; overload;

 procedure ShowMessage(const value : boolean) ; overload;

 

 implementation

 

 //displays a string in a dialog box

 procedure ShowMessage(const value : string) ;

 begin

   Dialogs.ShowMessage(value) ;

 end;

 

 //displays an integer in a dialog box

 procedure ShowMessage(const value : integer) ;

 begin

   ShowMessage(IntToStr(value)) ;

 end;

 

 //displays a float in a dialog box

 procedure ShowMessage(const value : extended) ;

 begin

   ShowMessage(FloatToStr(value)) ;

 end;

 

 //displays a boolean in a dialog box

 procedure ShowMessage(const value : boolean) ;

 begin

   ShowMessage(BoolToStr(value, true)) ;

 end;

 

 end.

چند روز پیش یکی از دوستان از فضای کم میز کارش و اینکه مانیتورش کوچیک هست گله میکرد و به ذهنم رسید تا برنامه ای بنویسم تا چند تا میز کار مختلف در اختیار کابر بزاره تا بتونه تو هر کدومش کار متفاوتی انجام بده و ...

برنامه رو تا جایی که بشه ازش استفاده کرد نوشتم ولی بازم روش میشه کار کرد ، میتونید ازش برای یادگیری نحوه استفاده از تابع SetThreadDesktop , CretaeDesktop ، SwitchToDesktop , CreateProcess استفاده کنید ، چون منبع جامعی برای استفاده از این توابع Desktop در دلفی پیدا نمیشه ، من هم با خوندن MSDN برنامه رو نوشتم .

برنامه بهتون علاوه بر میزکار پیش فرض ، 2 میز کار اضافی هم میده و میتونید از هر میز کاری که هستید یک برنامه رو تو میزکار دیگه اجرا کنید یا بهش سوئیچ کنید .

برای زیبائی برنامه از کامپوننت های Alpha Control استفاده شده .
سورس برنامه هم ضمیمه شده .
موفق باشید .

undocument messagebox
این تابع از توابع استاندارد ویندوز درون User32.dll هست که یک messagebox با قابلیت زماندهی برای بسته شدن میباشد

function MessageBoxTimeOut( 

      hWnd: HWND; lpText: PChar; lpCaption: PChar; 

      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;

function MessageBoxTimeOutA( 

      hWnd: HWND; lpText: PChar; lpCaption: PChar; 

      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;



function MessageBoxTimeOutW( 

      hWnd: HWND; lpText: PWideChar; lpCaption: PWideChar; 

      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;



implementation 



// this const is not defined in Windows.pas 

const 

  MB_TIMEDOUT = 32000; 



function MessageBoxTimeOut; externaluser32 name 'MessageBoxTimeoutA'; 

function MessageBoxTimeOutA; external user32 name 'MessageBoxTimeoutA'; 

function MessageBoxTimeOutW; external user32 name 'MessageBoxTimeoutW'; 

نمونه مثال:

var 

  iResult: Integer; 

  iFlags: Integer; 

begin 

  // Define a MessagBox  with an OK button and a timeout of 2 seconds 

  iFlags  := MB_OK or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION;

  iResult := MessageBoxTimeout( 

   Application.Handle, 

   'Test a timeout of 2 seconds.', 

   'MessageBoxTimeout Test', iFlags, 0, 2000); 



  // iResult will = 1 (IDOK) 

  ShowMessage(IntToStr(iRet)); 



  // Define a MessageBox with a Yes and No button and a timeout of 5 seconds 

  iFlags  := MB_YESNO or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION; 



  iResult := MessageBoxTimeout( 

    Application.Handle, 

    'Test a timeout of 5 seconds.', 

    'MessageBoxTimeout Test', iFlags, 0, 5000); 



  // iResult = MB_TIMEDOUT if no buttons clicked, otherwise 

  // iResult will return the value of the button clicked 



  case iResult of 

  IDYES:  // Pressed Yes button 

    ShowMessage('Yes'); 



  IDNO:  // Pressed the No button 

    ShowMessage('No'); 



  MB_TIMEDOUT: // MessageBox timed out 

    ShowMessage('TimedOut'); 

  end; 

end; 

سلام ،

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

این نمونه برای یادگیری Callback Function ها منجمله EnumChildWindow بسیار مناسب هست .

با سلام.
توسط برنامه زیر اگه یه پیکسل مشکی انتخاب کنید . برنامه میگرده و بقیشو پیدا میکنه.
http://up.iranblog.com/images/dd1ygpnrrpw4624sfwwf.rar

استخراج تمامی ایمیل های موجود در یک رشته طولانی :

procedure TForm1.ExtractEmails(StrContent: string);

var

  i, r, P1, P2, DContinue: integer;

  Email, StrPre, StrPos: string;

begin

  StrContent := StringReplace(StrContent, #13#10, ' ', [rfReplaceAll]);

  StrContent := StrContent + #13#10;

  i := 1;

  ListBox1.Items.Clear;

  while (i <= length(StrContent)) do

  begin

    r := PosEx('@', StrContent, i);

    if r > 0 then

    begin

      StrPre := copy(StrContent, 1, r - 1);

      P1 := r + 1;

      StrPos := copy(StrContent, P1, length(StrContent));

      P2 := pos(' ', StrPos) - 1;

      //

      StrPre := ReverseString(StrPre);

      StrPre := ReverseString(copy(StrPre, 1, pos(' ', StrPre) - 1));

      StrPos := copy(StrPos, 1, P2);

      // Catch the email

      Email := StrPre + '@' + StrPos;

      if pos('.', Email) > 0 then

        ListBox1.Items.Add(Email);

      DContinue := P1 + P2;

    end

    else

    begin

      Break;

    end;

    // Continue searching

    i := DContinue + 1;

  end;

end;

نقل قول:

---

استخراج تمامی ایمیل های موجود در یک رشته طولانی

---

البته این تاپیک جای بحث نیست، ولی این کار رو میشه با Regular Expression با دقت و سرعت بالاتر، به راحتی انجام داد.

با سلام و خدا قوت خدمت سروران گرانقدر
چند روز پیش تاپیکی ایجاد کردم و در مورد چگونگی ضبط صوت سوال پرسیدم.
با راهنمایی جناب SAASTN برنامه کوچکی تهیه کردم.:خجالت:
گفتم شاید به درد دوستان بخوره.فایدش اینه که اگه مثلا در کار تقلید از قاریان قرآن باشیم یا بخواهیم صدای بازی ضبط کنیم، می تونیم ازش استفاده کنیم.(من خودم برای ضبط قسمتی از صوت تبلیغات لینا لوله ای ازش استفاده کردم:بامزه:)
گرچه برنامه Sound Recorder هم در خود ویندوز هست ولی من می خواستم قسمتی از صوت پخش شده از یک برنامه رو ضبط کنم فقط کمی از اول صوت رو ذخیره می کرد و بقیه فایل بدون صدا ضبط می شد ولی با این برنامه این مشکل رو نداشتم!!:گیج:
برای شروع و خاتمه ضبط باین برنامه ترکیب Ctrl+Space زا فشار دهید::تشویق:

ارتباط و کنترل avi برای ساخت لوگوهای آموزشی و تصویری

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

کدی جهت بدست آوردن تقاطع 2 خط بر حسب angle.
ابتدا با دو کلیک نقاط خط اول و سپس با دو کلیک دیگر نقاط خط دوم را وارد نمایید سپس تقاطع دو خط نمایش داده می شود.

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Button1: TButton;

    procedure FormCreate(Sender: TObject);

    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

  private

    { Private declarations }

  public

     index : Integer;

     p :Array[0..3] of TPoint;

  end;



var

  Form1: TForm1;



implementation



uses Math;



{$R *.dfm}

function GetDegree(p1,p2 : TPoint): Double;

begin

  Result :=  ArcTan2(p2.Y-p1.Y,p2.X -p1.X);

end;



function GetConflictPoint(p1,p2 : TPoint;deg1 ,deg2 : Double):TPoint;

var m1,m2 : Double;

    x ,y : Double;

begin

  m1 := tan( deg1);

  m2 := tan( deg2);



  X :=  (m1*p1.X - m2*p2.X + p2.Y - p1.Y) /(m1-m2);

  Y := m1 *(x- p1.X)+p1.Y;

  Result := point(round(x),round(y));

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

   index := 0;

end;



procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

 var resPoint : TPoint;

begin

  if index > 3 then

   begin

     index := 0;

     Canvas.FillRect(ClientRect);

   end;

  p[index] := point(x,y);

  if index mod 2 = 1 then

    begin

      Canvas.Ellipse(p[index-1].X-2,p[index-1].Y-2,p[index-1].X+2,p[index-1].Y+2);

      Canvas.Ellipse(p[index].X-2,p[index].Y-2,p[index].X+2,p[index].Y+2);

      Canvas.MoveTo(p[index-1].X,p[index-1].Y);

      Canvas.LineTo(p[index].X,p[index].Y);

      Caption := FloatToStr(GetDegree(p[index-1],p[index]));

    end;

  if index = 3 then

    begin

      resPoint := GetConflictPoint(p[0],p[2],GetDegree(p[0],p[1]),GetDegree(p[2],p[3]));

      Canvas.Ellipse(resPoint.X-2,resPoint.Y-2,resPoint.X+2,resPoint.Y+2);

    end;

  inc(index);

end;



end.

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

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

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

برای نوشتن کتابخانه از روش آرایه استفاده شده ، با خوندن سورس کتابخانه روند کار دستتون میاد و میتونید خودتون توسعش بدید .

تو یکی از تاپیک ها یکی از کاربران ازم درخواست کرد تا نمونه کدی برای Split کردن یک فایل به چند فایل و سپس Merge کردن فایل های Split شده به یک فایل قرار بدم .

الان کمی بیکار بودم و یک نمونه برنامه نوشتم ، سعی کردم Comment ها واضح و گویا باشه .

موفق باشید .

امروز تو یکی از برنامه ها که داشتم مینوشتم نیاز به تولید اعداد تصادفی ( Random ) غیر تکراری داشتم و تابع زیر رو برای این کار نوشتم :

procedure GenerateRandomList(var NumberList: TStringList; const NumberOfRandomGenerated, RandomRange: Integer);

begin

  if RandomRange < NumberOfRandomGenerated then

    raise Exception.Create('Random range must be equal or greater than number of random generated !');



  NumberList.Duplicates := dupIgnore;

  NumberList.Sorted := True;

  RandSeed := MilliSecondOf(Now);

  repeat

    NumberList.Add(IntToStr(Random(RandomRange)));

  until (NumberList.Count = NumberOfRandomGenerated);

end;

این هم نمونه استفاده :

var

  RandomList: TStringList;

begin

  RandomList := TStringList.Create;

  try

    GenerateRandomList(RandomList, 10000, 20000);

    ListBox1.Items.Assign(RandomList);

  finally

    RandomList.Free;

  end;

end;

نقل قول:

---

MySQL Backup Maker

---

در مورد این برنامه به دو نکته جدید برخوردم :

1. یک قسمت برای بررسی اینکه جدول وجود دارد یا نه باید در نظر گرفته بشه تا در زمان فراخوانی پشتیبان، در صورتیکه جدول از بانک حذف شده بود به صورت خودکار ایجاد بشه.
2. بین خطوط 116 و 117 باید کد زیر اضافه بشه :

Qry.SQL.Text := 'DELETE FROM `' + TableName + '`';

      Qry.ExecSQL;

اینکار باعث میشه عملیات Replace روی رکورد ها انجام بشه.

با سلام
چند وقتی بود که دنبال یک برنامه کوچیک و جمع و جور می گشتم که باهاش بتونم رو سیستمی که SQL Server Express یا MSDE نصب شده، لیست دیتابیس ها رو ببینم و بتونم باهاش Attach و Detach دیتابیس هم انجام بدم.
چون برنامه جالبی پیدا نکردم خودم دست به کار شدم و این برنامه رو نوشتم.
امیدوارم به درد شما هم بخوره:

در اکثر برنامه هایی که با دلفی نوشته شده اند متاسفانه دیده می شود که منوها فونت خوبی ندارند. این موضوع در ویندوز های ویستا و سون به شکل بهتری قابل درک است. با استفاده از تکنیکی که در زیر به توضیح آن می پردازم به راحتی می توانید این مشکل را برطرف نمایید و برای همیشه از دست این مشکل رها شوید.
1- ابتدا یک کنترل TMainMenu بر روی فرم قرار دهید و گزینه های مورد نظر خود را به آن اضافه کنید.
2- خاصیت OwnerDraw مربوط به کنترل TMainMenu را به True تغییر دهید.
3- به رویداد OnCreate مرربوط به فرم رفته و کد های زیر را در آن بنویسید:

Screen.MenuFont.Name := 'tahoma';

حال می بینید که این مشکل برطرف شده است.

چک کردن جنیون بودن ویندوز

function IsWindowsGenuine() : Boolean;

const

  app_guid : TGUID = '{55C92734-D682-4D71-983E-D6EC3F16059F}';

  module   : string = 'Slwga.dll';

  api      : string = 'SLIsGenuineLocal';

var

  app_id : TGUID;

  state  : Byte;

  ret    : HRESULT;

  CheckGenuine : function (var appID : TGUID ; var result : Byte ; uReserved : Pointer): HRESULT;stdcall;

begin

  CheckGenuine := GetProcAddress(LoadLibrary(PChar(module)),PChar(ap  i));

  if @CheckGenuine <> nil then

  begin

     app_id := app_guid;

     ret := CheckGenuine(app_id,state,nil);

     if Succeeded(ret) then

     begin

       Result := (state = 0);

       SetLastError(ERROR_SUCCESS);

     end

     else

     begin

       Result := False;

       SetLastError(ERROR_ACCESS_DENIED);

     end;

  end

  else

  begin

    Result := False;

    SetLastError(ERROR_INVALID_FUNCTION);

  end;

end;



procedure TForm2.Button1Click(Sender: TObject);

begin

if (IsWindowsGenuine()) and (GetLastError() = ERROR_SUCCESS) then

ShowMessage('windows is genuine')

else

ShowMessage('window is not genuine');

end;

نقل قول:

---

نوشته شده توسط مجتبی تاجیک

امروز تو یکی از برنامه ها که داشتم مینوشتم نیاز به تولید اعداد تصادفی ( Random ) غیر تکراری داشتم و تابع زیر رو برای این کار نوشتم :

procedure GenerateRandomList(var NumberList: TStringList; const NumberOfRandomGenerated, RandomRange: Integer);

begin

  if RandomRange < NumberOfRandomGenerated then

    raise Exception.Create('Random range must be equal or greater than number of random generated !');



  NumberList.Duplicates := dupIgnore;

  NumberList.Sorted := True;

  RandSeed := MilliSecondOf(Now);

  repeat

    NumberList.Add(IntToStr(Random(RandomRange)));

  until (NumberList.Count = NumberOfRandomGenerated);

end;

این هم نمونه استفاده :

var

  RandomList: TStringList;

begin

  RandomList := TStringList.Create;

  try

    GenerateRandomList(RandomList, 10000, 20000);

    ListBox1.Items.Assign(RandomList);

  finally

    RandomList.Free;

  end;

end;

---

با تشكر از مجتبي جان
فكر كنم بايد يونيت DateUtils هم Use بشه
ممنون

سلام به همگی
من یه دکمه ساده طراحی کردم.چند تا حالت از جمله دکمه بدون لبه داره.
برای حالتهای MouseUp ,Mouse Down ,MouseOver می تونین رنگ دکمه رو تعیین کنین.
اگه دوست داشتین بردارین::گیج:
ضمیمه 85827ضمیمه 85826

با سلام:قلب:
این هم یه برنامه ساده و دلچسب جستجو و نمایش کل متن قرآن کریم نوشته خودم!؟
لطفاً بزرگوارانی که قبلا برداشتن دوباره بردارند؛ چون هم اصلاحش کردم هم تکمیل..
(با قلم رایگان QuranTaha1 به همراه فایل متن کل قرآن کریم):
--
حالا آیه ای که با کلیک وسط آیات انتخاب کردیم کپی میشه نه آیه اول!
-------
یکی از دوستان سایت تقاضای سورس برنامه رو فرمودند. این برنامه در واقع قسمتی از یه برنامه حجیم دیگه نوشته خودمه که متن قرآن عثمان طه رو به همراه ترجمه استاد فولادوند نمایش میده. اما چون دسترسی به اینترنت پر سرعت ندارم فعلا نذاشتم.(ممکنه بعدا آپلود کنم و برای دانلود لینک بدم)
لطفا اگه کسی از رفقا روی رابط کاربری یا قسمت دیگه ای کار کرد نسخه اصلاح شده رو برای دانلود بذاره.
به طور مثال یکی از ایرادات برنامه اینه که وقتی از پنجره اصلی وارد پنجره متن کامل قرآن میشیم پنجره متن قرآن پرش داره. همچنین رابط گرافیکی اون رئال نیست و رنگهای خیلی شاد داره که ممکنه یکی بخواد از پوسته (Skin) یا تصویر قشنگتری برای رابط گرافیکی استفاده کنه.
اون رفیق عزیز فرمودند که ممکنه کسی بخواد ترتیل بهش اضافه کنه.
فکر نکنم کسی بتونه ترتیل آیه به آیه از اینترنت یا نرم افزاری گیر بیاره؛ اما ترتیل صفحه ای در آدرس http://haji-shohada.persianblog.ir/page/12 هست. برنامه پارس قرآن هم که منبع ترجمه برنامم بوده و برنامه قشنگیه. یه برنامه جستجو هست به نام AlMobin که جستجوی قرآن هست اما نتیجه قابل قبولی نداره مثلا اگه کلمه 'موسی' رو جستجو بدید متوجه میشید.
این هم سورس برنامه+یونیت ClrCtrls(خیلی پیش میخواستم روش کار کنم تکمیلش کنم.فعلا تو جزئیات همه کامپوننتهاش خورد نشین!):

سلام
یونیت پنجره پیغام و سوال و InputBox رنگی(جالبه بدونین که حرف ی- ي رو هم درست می کنه):
ضمیمه 85905
ضمیمه 85907
البته پروسیجرهای آقای شاهین عشایری رو هم تو یونیت ریختم. می تونین از راه InstallComponent یونیت رو نصب کنین و هر دفعه فقط MSGs رو به لیست Uses اضافه کنین.
یک کم توسعش دادم .اینها رو هم اضافه کردم:
ضمیمه 85906

برای کپی من با خطای Can not open file در کد های زیر در یونیت PBCopy مواجه شدم

procedure TCopyThread.CopyFile;

var

  S_FileStream, D_FileStream: TFileStream;

  Pos, Buff: Cardinal;

begin

  S_FileStream:= TFileStream.Create(SFile, fmOpenRead);

  D_FileStream:= TFileStream.Create(DFile, fmCreate + fmOpenWrite);

  Buff:= (S_FileStream.Size div 100);

  Pos:= 0;

  // Send max size of progress bar

  PostMessage(HWND, WM_UpdatePB, 0, (S_FileStream.Size div 100));

  try

    S_FileStream.Seek(0, soFromBeginning);

    D_FileStream.Seek(0, soFromBeginning);

    while Pos < S_FileStream.Size do

    begin

      if Pos+ Buff > S_FileStream.Size then

        Buff:= (S_FileStream.Size - Pos);

      D_FileStream.CopyFrom(S_FileStream, Buff);

      Inc(Pos, Buff);

      // Send current position of progress bar

      PostMessage(HWND, WM_UpdatePB, (Pos div 100), 0);

      S_FileStream.Position:= Pos;

      D_FileStream.Position:= Pos;

      Application.ProcessMessages;

    end;

  finally

    S_FileStream.Free;

    D_FileStream.Free;

  end;

end;

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

ضمیمه 86266
من محتوای یونیت Messages رو تو یه فایل txt ریختم و تو برنامه پیغامها رو جدا می کنم و در یک ListBox می ریزم. دلفی من قدیمیه اگر دوست داشتین محتوای یونیت Messages دلفی خودتون رو رو توی فایل Messages.txt کنار برنامه بریزین تا کامل تر بشه.وقتی در لیست باکس مربوط به نام پیغام هستین می تونین کارکتر اول نام پیغام (بدون پیشوند!) رو فشار بدین تا یکراست (چیزی مثل AutoComplete) به اون پیغام منتقل بشین!
اگه نمی دونستین کدوم پیغام به دردتون میخوره می تونین دکمه View Messages Text File رو فشار بدین و در فایل جستجو بدینتا پیغام مربوطه رو پیدا کنین.البته بعضی پیغامها تو یونیت Windows هستند که البته اگه خواستین می تونین پیغامهاش رو تو فایل Messages.txt بریزین و توی برنامه استفاده کنین.
برای تولید کد یا ارسال پیام روی کامپوننت یا فرم مورد نظر برین و Ctrl+Space رو فشار بدین و بعد دکمه مربوطه رو در برنامه فشار بدین تا برنامه با استفاده از اطلاعات کادرهای بالای فرم کد رو تولید کنه یا پیغام رو بفرسته.Ctrl+L هم باعث میشه برنامه چیزی گزارش نکنه!
توی کادر پارامترها هم می تونین عدد یا رشته وارد کنین. دکمه Send Message هم پیغام می فرسته هم کد ایجاد می کنه.
یک تجربه:
من هندل یک کامپوننت رو نداشتم با ;(متن کامپوننت,نام کلاس کامپوننت)FindWindow نتونستم هندش رو بدست بیارم!
ولی اگه هندل کامپوننت رو دارین با کد جناب MohsenB می تونین هندل فرم رو بدست بیارین:

function GetFormHandle(ObjHandle: THandle): THandle;

begin

  if GetParent(ObjHandle) = 0 then

    Result := ObjHandle

  else

    Result := GetFormHandle(GetParent(ObjHandle));

end;

سلام دوستان!



این هم یک برنامه ماشین حساب :



که چهار عمل اصلی + توان را حساب می کند و شما با فهمیدن این برنامه تاحد خوبی برنامه نویسی در دلفی را خواهید آموخت.



دانلود کنید.

سلام.
کنترل TUpDown برای تغییر عدد تو کادر TEdit استفاده میشه که من یه تغییر کوچیکی توش دادم که موقع کلیک کردن رو دکمه هاش میتونید کلید موس رو نگه دارید و به بالا و پایین درگ کنید و با حرکت موس عدد رو تنظیم کنید. کامپوننتش :

unit SpinnerUpDown;



interface



uses

  SysUtils, Classes, Controls, ComCtrls, Types, Windows;



type

  TSpinnerUpDown = class(TUpDown)

  private

    _Scale : Single;

    procedure MyOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

  protected

  public

    constructor Create(AOwner : TComponent);override;

  published

    property Scale : Single read _Scale write _Scale;

    property AlignButton;

    property Anchors;

    property Associate;

    property ArrowKeys;

    property DoubleBuffered;

    property Enabled;

    property Hint;

    property Min;

    property Max;

    property Increment;

    property Constraints;

    property Orientation;

    property ParentDoubleBuffered;

    property ParentShowHint;

    property PopupMenu;

    property Position;

    property ShowHint;

    property TabOrder;

    property TabStop;

    property Thousands;

    property Visible;

    property Wrap;

    property OnChanging;

    property OnChangingEx;

    property OnContextPopup;

    property OnClick;

    property OnEnter;

    property OnExit;

    property OnMouseActivate;

    property OnMouseDown;

    property OnMouseEnter;

    property OnMouseLeave;

    property OnMouseMove;

    property OnMouseUp;

  end;



procedure Register;



implementation



procedure TSpinnerUpDown.MyOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

{$J+}

const

  MouseLastPos : TPoint = (X : 0; Y : 0);

  currVal : Integer = 0;

  r : TRect = ();

{$J-}

var

  p : TPoint;

begin

  if (GetAsyncKeyState(VK_LBUTTON) and $8000 = 0) then

  begin

    GetCursorPos(MouseLastPos);

    GetWindowRect((Sender as TWinControl).Handle, r);

  end else begin

    GetCursorPos(p);

    SetFocus;



    if (MouseLastPos.X <> p.X) or (MouseLastPos.Y <> p.Y) then

    begin

      currVal := currVal + p.Y - MouseLastPos.Y;//Point(X - MouseLastPos.X, Y - MouseLastPos.Y);

      if (Abs(currVal * _Scale) > 1.0) then

      begin

        (Sender as TUpDown).Position := (Sender as TUpDown).Position - Trunc(currVal * _Scale);

        if Assigned(Associate) then

          Associate.Update;

        currVal := 0;

      end;

      GetWindowRect((Sender as TWinControl).Handle, r);

      MouseLastPos := Point(r.Left - 5, (r.Top + r.Bottom) div 2);

      SetCursorPos(MouseLastPos.X, MouseLastPos.Y);

    end;

  end;

end;



constructor TSpinnerUpDown.Create(AOwner : TComponent);

begin

  inherited Create(AOwner);

  _Scale := 0.1;

  Self.OnMouseMove := MyOnMouseMove;

end;



procedure Register;

begin

  RegisterComponents('MHD', [TSpinnerUpDown]);

end;



end.

نقل قول:

---

نوشته شده توسط مهران رسا

در طول انجام یه پروژه نیاز شد تا از بانک Mysql به صورت داخلی پشتیبان بگیرم. یه نمونه کد نوشتم که البته بیشتر وقتم صرف قسمت پردازش رشته ای و ذخیره و بازیابی اطلاعات شد.

نکات قابل توجه مورد استفاده در این برنامه :

• استفاده از کلاس ini برای ذخیره سازی اطلاعات جداول در فایل
• استفاده از توابع String Encoder برای حفظ امنیت اطلاعات جداول
• استفاده از کامپوننت DbExpress برای تعامل با MySQL

ضمیمه 74846

procedure TForm1.CreateBackup;

var

  i, j: integer;

  IniFile: TIniFile;

  TableName, FieldName, FieldValue, TmpValues, CodedStr: string;

var

  StrEnc: TStrEncoder;

begin

  if LST.Items.Count < 1 then

  begin

    LbSt.Caption := 'Status : Canceled';

    exit;

  end;

  SaveDlg.FileName := '';

  SaveDlg.Filter := 'M8B Files|*.m8b';

  SaveDlg.DefaultExt := 'm8b';

  SaveDlg.Execute();

  if SaveDlg.FileName = '' then

  begin

    LbSt.Caption := 'Status : Canceled';

    exit;

  end;

  if FileExists(SaveDlg.FileName) then

    DeleteFile(SaveDlg.FileName);



  StrEnc := TStrEncoder.Create(nil);

  IniFile := TIniFile.Create(SaveDlg.FileName);

  Pr.Position := 0;

  Pr.Max := LST.Items.Count - 1;

  try

    for i := 0 to LST.Items.Count - 1 do

    begin

      Pr.Position := i;

      TableName := LST.Items[i].Caption;

      if LST.Items[i].Checked then

      begin

        // Get list of fileds

        Qry.SQL.Text := 'SHOW COLUMNS FROM ' + TableName;

        Qry.Open;

        while not(Qry.Eof) do

        begin

          FieldName := Qry.Fields[0].AsString;

          if FieldName <> '' then

          begin

            Qry2.SQL.Text := 'SELECT ALL `' + FieldName + '` FROM `' +

              TableName + '`';

            Qry2.Open;

            if Qry2.RecordCount > 0 then

            begin

              TmpValues := '';

              Pr2.Position := 0;

              Pr2.Max := Qry2.RecordCount;

              for j := 0 to Qry2.RecordCount - 1 do

              begin

                Pr2.Position := j;

                FieldValue := Qry2.FieldByName(FieldName).AsString;

                if FieldValue = '' then

                begin

                  FieldValue := SEmpty;

                  CodedStr := FieldValue;

                end

                else

                begin

                  CodedStr := StrEnc.StringCoder(FieldValue);

                end;

                TmpValues := TmpValues + ',' + CodedStr;

                Qry2.Next;

              end; // for j

              IniFile.WriteString(TableName, FieldName, TmpValues);

            end; // if Qry2.RecordCount

          end; // if FieldName <> ''

          Qry.Next;

        end; // while not(Qry.Eof)

      end; // if LST.Items[i].Checked

    end;

  finally

    IniFile.free;

    StrEnc.free;

  end; // try

  Pr.Max := 1;

  Pr.Position := Pr.Max;

  Pr2.Max := 1;

  Pr2.Position := Pr2.Max;

  LbSt.Caption := 'Status : Done';

end;



procedure TForm1.RestoreBackup;

var

  StrEnc: TStrEncoder;

var

  IniFile: TIniFile;

  Tstr, TstrSectionValues, TstrValues: TStringList;

  i, j, k, m, Cl: integer;

  TableName, FieldName, GroupValue: string;

  Tmp, Tmp2, Tmp3, SqlSmnt: string;

  VArray: array of array of string;

begin

  OpenDlg.FileName := '';

  OpenDlg.Filter := 'M8B Files|*.m8b';

  OpenDlg.DefaultExt := 'm8b';

  OpenDlg.Execute();

  if OpenDlg.FileName = '' then

    exit;

  LST2.Items.Clear;

  StrEnc := TStrEncoder.Create(nil);

  IniFile := TIniFile.Create(OpenDlg.FileName);

  Tstr := TStringList.Create;

  TstrSectionValues := TStringList.Create;

  TstrValues := TStringList.Create;

  try

    IniFile.ReadSections(Tstr);

    Pr.Position := 0;

    Pr.Max := Tstr.Count - 1;

    for i := 0 to Tstr.Count - 1 do

    begin

      TableName := Tstr[i];

      SqlSmnt := 'INSERT INTO `' + TableName + '` (';

      Pr.Position := i;

      IniFile.ReadSection(TableName, TstrSectionValues);

      Tmp := '';

      Tmp2 := '';

      TstrValues.Clear;

      for j := 0 to TstrSectionValues.Count - 1 do

      begin

        FieldName := TstrSectionValues[j];

        Tmp := Tmp + '`' + FieldName + '`,';

        GroupValue := IniFile.ReadString(TableName, FieldName, '');

        StrEnc.split(',', GroupValue, TstrValues);

      end;

      Cl := (TstrValues.Count) div (TstrSectionValues.Count);

      Pr2.Position := 0;

      Pr2.Max := Cl - 1;

      for k := 0 to Cl - 1 do

      begin

        Pr2.Position := k;

        m := k;

        Tmp3 := '';

        while (m < (TstrValues.Count)) do

        begin

          if UpperCase(TstrValues[m]) = SEmpty then

            Tmp2 := ''

          else

            Tmp2 := StrEnc.StringDecoder(TstrValues[m]);

          Tmp3 := Tmp3 + '"' + Tmp2 + '",';

          m := m + Cl;

        end;

        SqlSmnt := SqlSmnt + copy(Tmp, 1, length(Tmp) - 1) + ') VALUES(' + copy

          (Tmp3, 1, length(Tmp3) - 1) + ')';

        Qry.SQL.Text := SqlSmnt;

        try

          Qry.ExecSQL;

        except

          on e: exception do

          begin

            LST2.Items.Add('Table ' + TableName + ' : ' + e.Message);

          end;

        end;

        SqlSmnt := 'INSERT INTO `' + TableName + '` (';

      end;

    end;

  finally

    StrEnc.free;

    IniFile.free;

    Tstr.free;

    TstrSectionValues.free;

    TstrValues.free;

  end;

  Pr.Max := 1;

  Pr.Position := Pr.Max;

  Pr2.Max := 1;

  Pr2.Position := Pr2.Max;

end;

نکته 1 : برای ارتباط DbExpress با Mysql به درایور های مربوطه (dbxmys.dll و libmySQL.dll) نیاز دارید.
نکته 2 : پیشنهاد میشه به صورت دلخواه از توابع Optimize کننده هم استفاده کنید.

---

من نمي توانم پروژه را اجرا کنم راجع به اين سه فايل پيغام ميدهد؟
WideStrings, DBXMySql

[Fatal Error] Unit1.pas(11): File not found: 'WideStrings.dcu'
ممنون مي شوم کمک کنيد
ضمنا درایور های مربوطه (dbxmys.dll و libmySQL.dll) را از کجا بياورم؟؟

نقل قول:

---

من نمي توانم پروژه را اجرا کنم راجع به اين سه فايل پيغام ميدهد؟
WideStrings, DBXMySql

---

این فایل ها به همراه دلفی وجود دارند. احتمالاً بنا به دلایلی فایل dcu مربوط به آنها از سیستم شما حذف شده است. اگر این مشکل رو با یونیت های دیگر هم دارید به نظر من بهتره که دلفی رو دوباره نصب کنید.

نقل قول:

---

ضمنا درایور های مربوطه (dbxmys.dll و libmySQL.dll) را از کجا بياورم؟؟

---

فایلهایی که اول نامشون dbx هست با نصب دلفی به سیستم کپی می شوند و فایل دیگر هم با نصب آن DBMS خاص (در اینجا MySQL) به سیستم کپی می شوند.

_

برنامه ی تبدیل یک فایل به فایل های کوچک تر.
احتمالا شما هم به فایل هایی برخوردید که خیلی حجمشون زیاده و بخواید اونا رو تو فلش و یا dvd بریزید ولی به دلیل حجم بالا نتونید این کارو بکنید و بخواید اون فایل رو تیکه تیکه کنید و بعد با فلش یا dvd جابجا کنید و رو سیستم مقصد اونا رو بچسبونید. من برنامشو نوشتم. البته حتما برنامه هایی ازین قبیل نوشته شدن و استفاده میشن ولی من دوست داشتم خودم برنامه رو بنویسم. این برنامه فایل ها رو به قطعات 64 مگابایتی تقسیم میکنه. از روشی استفاده کردم که کل فایل لازم نباشه یکجا بیاد روی رم و مثلا تو سیستم من که 4 گیگ رم داره می شه فایل 20 گیگابایتی رو تیکه تیکه کرد چون برای تیکه کردن فایل لازم نیست اون رو روی رم بارگذاری کنیم و 64 مگابایت، 64 مگابایت پیش میره که رو اکثر سیستما جواب بده.
فقط فرصت نکردم دکمه ی Cancel براش بگذارم اگه دیدید کارش طولانی شد و خواستید cancel اش کنید از روش Alt + Ctrl + Delete استفاده کنید.
http://uplod.ir/von20v52jvvy/FileCutter.zip.htm

عكس گرفتن از Desktop يا از پنجره فعال

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

ساعت باينري

http://www.planet-source-code.com/Up...0235376278.JPG

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