userinfo close

,

تبلیغات

بستن

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


بستن

برنامه نویسی دلفی


delfi_programing

تاسیس: 7 دی 1383  پروفایل کلوب
مدیر کلوب: حمید م - معاونان
دلفی کارها یک خانواده اند!
 

لیست بحث ها

  عناوین بحث ها ارسال کننده پاسخها بازدید بروز رسانی اولویت
36
982
91/2/3 (23:16)
54
1238
91/2/3 (23:16)
8
288
88/6/7 (21:17)
7
62
90/10/13 (11:57)
3
98
87/10/23 (21:37)
0
1
90/12/2 (16:49)
1
6
90/9/5 (02:22)
0
2
90/8/8 (11:52)
2
6
90/7/18 (00:36)
4
9
90/2/18 (16:00)
1
5
89/12/21 (00:24)
0
19
89/12/16 (23:03)
0
10
89/12/7 (10:16)
3
17
89/11/21 (11:06)
5
13
89/11/21 (10:58)
4
33
88/10/27 (21:17)
3
31
88/10/16 (01:15)
6
47
88/9/15 (08:52)
3
16
88/9/1 (11:30)
1
27
88/8/30 (21:36)
بستن

عنوان بحث

پارسا ستوده نیا , psnsoni
پارسا ستوده نیا - 02:47 1386/02/14

آرشیو سورس و ترفند

سلام دوستان.

هرکی هر نکته، ترفند به درد بخوری داره تو این بحث مطرح کنه که به یه آرشیو خوب و مرجع تبدیل بشه.



با سپاس از پارسا عزیز، این ارسال توسط رضا در 19:08 شنبه 25 آبان ویرایش گردید.
  • ارسال پاسخ
بستن

پاسخ ها

ترتیب پاسخ ها : از اولین پاسخ
بهرام 0011 , bahram0011
بهرام 0011 - 23:16 1391/02/3
36
http://jozvesara.hamvar.ir/
رحیم کلاه ساز , rahimkolahsaz
رحیم کلاه ساز - 08:55 1387/09/18
35

ساعت عقربه ای

با تشكر از خانم سولماز كدی كه گذاشته بودن رو كمی تكمیل تر كردم

procedure TForm1.Timer1Timer(Sender: TObject);
var
  t1:TDateTime;
  t:string;
  s,m,h,x,y,j,dr,dr1,i:integer;
begin
  image1.Canvas.Brush.Color:=$00C9FCD0;
  image1.Canvas.FillRect(image1.Canvas.ClipRect);
  t1:=time;
  t:=timetostr(t1);
  h:=strtoint(Copy(t,1,2));
  m:=strtoint(Copy(t,4,2));
  s:=strtoint(Copy(t,7,2));
  with image1.Canvas do
    begin
    {Seconds}
    dr:=Image1.Height div 2;
    Dr1:=5;
    For i:=0 to 59 do begin
      if I mod 15 =0 then
         pen.Width:=6
      else
         if I mod 5 =0 then
            pen.Width:=4
         else
            pen.Width:=2;
      x:=(dr-1)+round((dr-dr1)*cos((2*pi*i/60)-(pi/2)));
      y:=(dr-1)+round((dr-dr1)*sin((2*pi*i/60)-(pi/2)));
      MoveTo(x,y);
      x:=dr+round((dr-dr1)*cos((2*pi*i/60)-(pi/2)));
      y:=dr+round((dr-dr1)*sin((2*pi*i/60)-(pi/2)));
      LineTo(x,y);
    end;


    pen.Width:=2;
    MoveTo(dr,dr);
    x:=dr+round((dr-dr1)*cos((2*pi*s/60)-(pi/2)));
    y:=dr+round((dr-dr1)*sin((2*pi*s/60)-(pi/2)));
    LineTo(x,y);

    {Minutes}
    pen.Width:=4;
    MoveTo(dr,dr);
    x:=dr+round(((dr-dr1)*3/4)*cos((2*pi*m/60)-(pi/2)));
    y:=dr+round(((dr-dr1)*3/4)*sin((2*pi*m/60)-(pi/2)));
    LineTo(x,y);


    {Hours}
    pen.Width:=6;
    MoveTo(dr,dr);
    x:=dr+round(((dr-dr1)*12/20)*cos((2*pi*(h*60+m)/720)-(pi/2)));
    y:=dr+round(((dr-dr1)*12/20)*sin((2*pi*(h*60+m)/720)-(pi/2)));
    LineTo(x,y);
  end;
end;
end.

رضا خارائی , pr0grammer
رضا خارائی - 13:32 1387/08/27
34
ایجاد پایگاه داده با کد نویسی  در SQL :

 procedure CreateDatabase(WindowsSecurity: Boolean; Username, Password: String);
var
  ConnectionString: String;
  CommandText: String;
begin
  if WindowsSecurity then
    ConnectionString := 'Provider=SQLOLEDB.1;' +
                        'Integrated Security=SSPI;' +
                        'Persist Security Info=False;' +
                        'Initial Catalog=master'
  else
    ConnectionString := 'Provider=SQLOLEDB.1;' +
                        'Password=' + Password + ';' +
                        'Persist Security Info=True;' +
                        'User ID=' + Username + ';' +
                        'Initial Catalog=master';

  try

    try
      ADOConnection.ConnectionString := ConnectionString;
      ADOConnection.LoginPrompt := False;
      ADOConnection.Connected := True;


      CommandText := 'CREATE DATABASE test ON ' +
                     '( NAME = test_dat,    ' +
                     'FILENAME = ''c:\program files\microsoft sql server\mssql\data\test.mdf'', ' +
                     'SIZE = 4, ' +
                     'MAXSIZE = 10, ' +
                     'FILEGROWTH = 1 )';

      ADOCommand.CommandText := CommandText;
      ADOCommand.Connection := ADOConnection;
      ADOCommand.Execute;
      MessageDlg('Database succesfully created.', mtInformation, [mbOK], 0);

    except
      on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], 0);
    end;

  finally
    ADOConnection.Connected := False;
    ADOCommand.Connection := nil;
  end;

end;
رضا خارائی , pr0grammer
رضا خارائی - 13:28 1387/08/27
33
ایجاد Table با کد نویسی در SQL :


procedure TLocal.CreateTables(WindowsSecurity: Boolean; Username, Password: String);
var
  ConnectionString: String;
begin
  if WindowsSecurity then
    ConnectionString := 'Provider=SQLOLEDB.1;' +
                        'Integrated Security=SSPI;' +
                        'Persist Security Info=False;' +
                        'Initial Catalog=test'
  else
    ConnectionString := 'Provider=SQLOLEDB.1;' +
                        'Password=' + Password + ';' +
                        'Persist Security Info=True;' +
                        'User ID=' + Username + ';' +
                        'Initial Catalog=test';
  try

    try
      ADOConnection.ConnectionString := ConnectionString;
      ADOConnection.LoginPrompt := False;
      ADOConnection.Connected := True;

      ADOQuery.Connection := ADOConnection;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Klijent(');
        Add('JMBG     char(13) not null,');
        Add('Ime      char(30) not null,');
        Add('Adresa   char(30) not null,');
        Add('Telefon  char(15) not null,');
        Add('Primanja numeric(6,2) not null,');
        Add('primary key (JMBG))');
      end;
      ADOQuery.ExecSQL;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Kredit(');
        Add('Sifra    numeric not null,');
        Add('Tip      char(15) unique not null,');
        Add('Kamata   numeric not null,');
        Add('primary key (Sifra))');
      end;
      ADOQuery.ExecSQL;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Operator(');
        Add('JMBG     char(13) unique not null,');
        Add('Ime      char(30) not null,');
        Add('Sifra    char(30) not null,');
        Add('Adresa   char(30) not null,');
        Add('Telefon  char(15) not null,');
        Add('Prioritet smallint not null check (Prioritet>0),');
        Add('primary key (JMBG))');
      end;
      ADOQuery.ExecSQL;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Kreditiranja (');
        Add('Sifra          numeric not null,');
        Add('Sifra_kredita  numeric not null,');
        Add('Datum          datetime,');
        Add('Iznos_kredita  numeric(10,2) check (Iznos_kredita>0),');
        Add('Broj_rata      numeric,');
        Add('JMBG_klijenta  char(13),');
        Add('JMBG_operatora char(13),');
        Add('primary key(Sifra),');
        Add('foreign key(Sifra_kredita) references Kredit(Sifra) on delete cascade on update cascade,');
        Add('foreign key(JMBG_klijenta) references Klijent(JMBG) on delete cascade on update cascade,');
        Add('foreign key(JMBG_operatora) references Operator(JMBG) on delete cascade on update cascade)');
      end;
      ADOQuery.ExecSQL;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Rata (');
        Add('Broj_rate    numeric not null,');
        Add('Broj_sifre   numeric not null,');
        Add('Datum        datetime,');
        Add('Iznos_rate   numeric(10,2) check (Iznos_rate>0),');
        Add('primary key (Broj_rate),');
        Add('foreign key (Broj_sifre) references Kreditiranja(Sifra) on delete cascade on update cascade)');
      end;
      ADOQuery.ExecSQL;

      MessageDlg('Tabele su uspjesno kreirane.', mtInformation, [mbOK], 0);
    except
      on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], 0);
    end;

  finally
    ADOConnection.Connected := False;
  end;
end;
رضا خارائی , pr0grammer
رضا خارائی - 12:23 1387/08/26
32
فرم دایره ای :

Procedure TForm1.FormPaint(Sender: TObject);
Var
 Wnd:HWnd;
 R1,R2:HRGN;
 R:TRect;
Begin
  Wnd:=Application.MainForm.Handle;
  GetWindowRect(Wnd,R);
  R1:=CreateRectRgn(0,0,R.Right-R.Left,R.Bottom-R.Top);                             
  R2:=CreateEllipticRgn(10,30,150,120);
  CombineRgn(R1,R1,R2,RGN_DIFF);
  SetWindowRgn(Wnd,R1,true);
End;
رضا خارائی , pr0grammer
رضا خارائی - 12:22 1387/08/26
31
اضافه کردن زبان به ویندوز :

procedure TForm1.Button1Click(Sender: TObject);
var
  LangIdentifier: String;
begin
  LangIdentifier := '00000408'; //'0000408' is the Language Identifier for Greek
  LoadKeyboardLayout(PChar(LangIdentifier), KLF_ACTIVATE);
end;
عبداله نوری , anouri
عبداله نوری - 11:44 1387/06/4
30
مخفی كردن taskbar ویندوز

procedure TTaskBar_h.settaskstate(Value:Boolean);
var
   hTaskBar:HWND;
begin
   hTaskBar := FindWindow('Shell_TrayWnd',nil);
   if Value then
     ShowWindow (hTaskBar,SW_HIDE)
   else
      ShowWindow (hTaskBar,SW_SHOW);
end;

عبداله نوری , anouri
عبداله نوری - 11:26 1387/06/4
29
نوشتن در انتخای یك فایل متنی ( در صورتی كه فایل وجود نداشت ایجاد میشه )

function TTxtFile.txtfilewrite(writestr:String;fFilename:string):Integer;
var
  ff:TFileStream;
begin
  if fFileName = '' then
    raise Exception.Create('file name !!!');    
  if not FileExists(fFileName) then
    ff := TFileStream.Create(fFileName,fmcreate)
  else
    ff := TFileStream.Create(fFileName,fmopenwrite);
  try
    ff.Seek(0,sofromend);
    ff.WriteBuffer (pchar(writestr)^,length(writestr));
    Result := ff.Size;
  finally
    ff.Free;
  end;
end;

عبداله نوری , anouri
عبداله نوری - 11:23 1387/06/4
28
نوشتن متنی در clipboard

procedure TTxtFile.set_clipboard(txt: String);
var
  cl: TClipboard;
begin
  cl := TClipboard.Create;
  try
    cl.AsText := txt;
  finally
    cl.free;
  end;
end;

عبداله نوری , anouri
عبداله نوری - 11:21 1387/06/4
27
باز و بسته كردن در cd rom

procedure TCd_Open.SetCd_Open_close(Value:Boolean);
var
  handle:integer;
begin
   if Value then
      mciSendstring('Set cdaudio door open wait',nil,0,handle)
   else
      mciSendstring('Set cdaudio door closed wait',nil,0,handle);
end;

آرش آذرمیر , arash_azarmir
آرش آذرمیر - 21:24 1387/03/4
26
روش دیگری برای تبدیل ارقام به حروف
function intostring(num:integer):string;
const
     yekan:array[0..19]of string=('','یک','دو','سه','چهار','پنج','شش','هفت','هشت','نه','ده','یازده','دوازده','سیزده','چهارده','پانزده','شانزده','هیفده','هیجده','نوزده');
     dahgan:array[0..9]of string=('','','بیست','سی','چهل','پنجاه','شست','هفتاد','هشتاد','نود');
     sadgan:array[0..9]of string=('','یکصد','دویست','سیصد','چهارصد','پانصد','ششصد','هفتصد','هشتصد','نهصد');
     zarayeb:array[0..3]of string=('',' هزار ',' میلیون ',' میلیارد ');
function adstr(s1,s2:string):string;
begin
     s1:=trim(s1);
     s2:=trim(s2);
     if (s1<>'')and(s2<>'')
     then
         adstr:=s1+' و '+s2
     else
         adstr:=s1+s2;
end;
function under1000(num1:integer):string;
var
   i:integer;
   s:string;
begin
     s:='';
     i:=num1 div 100;
     s:=sadgan[i];
     num1:=num1 mod 100;
     if num1<20
     then
         s:=adstr(s,yekan[num1])
     else
     begin
          i:=num1 div 10;
          s:=adstr(s,dahgan[i]);
          i:=num1 mod 10;
          s:=adstr(s,yekan[i]);
     end;
     under1000:=s;
end;


var
   i,j,k:integer;
   s,s1:string;
begin
    i:=1000000000;
    s:='';
    s1:='';
    for j:=3 downto 0 do
    begin
         k:=num div i;
         s:=under1000(k);
         if s<>''
         then
             s:=s+zarayeb[j];
         s1:=adstr(s1,s);
         num :=num mod i;
         i := i div 1000;
         if i=0
         then
             i:=1;

    end;
    intostring:=s1;
end;

سولماز م , abc_ramak
سولماز م - 19:58 1386/05/17
25

ساعت عقربه ای:

در تایمر interval رو 1000 کنین و در onTimer اینا رو بنویسین:

var
 t1:TDateTime;
 t:string;
 s,m,h,x,y,j:integer;
begin
 image1.Canvas.Brush.Color:=$00C9FCD0;
 image1.Canvas.FillRect(image1.Canvas.ClipRect);
  t1:=time;
 t:=timetostr(t1);
 h:=strtoint(t[1]);
 j:=2;
 while (t[j]='0') do
  begin
   h:=strtoint(inttostr(h) t[j]);
   j:=j 1;
  end;

 j:=j 1;
 m:=strtoint(t[j]);
 j:=j 1;
 while (t[j]='0') do
  begin
   m:=strtoint(inttostr(m) t[j]);
   j:=j 1;
  end;

 j:=j 1;
 s:=strtoint(t[j]);
 j:=j 1;
 while (t[j]='0') do
  begin
   s:=strtoint(inttostr(s) t[j]);
   j:=j 1;
  end;

with image1.Canvas do
 begin
  {Seconds}
  pen.Width:=2;

  MoveTo(100,100);
  x:=100 round(dr*cos((2*pi*s/60)-(pi/2)));
  y:=100 round(dr*sin((2*pi*s/60)-(pi/2)));
  LineTo(x,y);


  {Minutes}
  pen.Width:=4;
  MoveTo(100,100);
  x:=100 round((dr*3/4)*cos((2*pi*m/60)-(pi/2)));
  y:=100 round((dr*3/4)*sin((2*pi*m/60)-(pi/2)));
  LineTo(x,y);


  {Hours}
  pen.Width:=6;
  MoveTo(100,100);
  x:=100 round((dr*9/20)*cos((2*pi*h/12)-(pi/2)));
  y:=100 round((dr*9/20)*sin((2*pi*h/12)-(pi/2)));
  LineTo(x,y);

end;

سعید زایری , info_tagarg
سعید زایری - 07:54 1386/04/23
24

روتینی برای نمایش یک متن بر روی صفحه دسکتاپ:
این نکته را در نظر داشته باشید که این متن با refresh شدن صفحه از بین میرود.

// Fenglish Comments //
procedure WriteText(TheText: string); //oOo
var //oOo
  MyHand: HWND; //oOo
  MyDc: HDC; //oOo
  MyCanvas: TCanvas; //oOo
begin
  MyHand := GetDesktopWindow; // daryaft handele desktap
  MyDc := GetWindowDC(MyHand); // ijade ertebat ba poshtzamineye desktap
  MyCanvas := TCanvas.Create; //oOo
  MyCanvas.Handle := MyDC; // ijade yek objecte Canvas va etesale an be desktap
  MyCanvas.Font.Color := clRed; // range neveshte
  MyCanvas.Font.Name  := 'Aial'; // name fonte neveshte
  MyCanvas.Font.Size  := 60; // andazeye fonte neveshte
  SetBkMode(MyCanvas.Handle, TRANSPARENT); // tayeene shafaf boudane poshtzamineye neveshte
  MyCanvas.TextOut(0, 0, TheText); // namayeshe matn
 ReleaseDC(MyHand,MyDc); // HATMAN dar akhare kare namayeshe matn in dastour ra ejra konid
  MyCanvas.Free; // in khat ham hafezeye marbout be Canvas ra azad mikonad
end; //oOo

ملیکا ملکی , melika_m
ملیکا ملکی - 11:02 1386/03/26
23

اقا امیر فكر میكنم كه كد encode و Decode  شما یه مشكلی داشته باشه

مثلا اگه موقع encode یه عدد بالای 255 ایجاد بشه اونو تبدیل به 33  میكنید

موقع decode كردن وقتی به عدد 33  میرسید از كجا میفهمید كه واقعا چند بوده چون شما تمام اعداد بالای 255 رو به 33 تبدیل كردین

عبداله نوری , anouri
عبداله نوری - 18:16 1386/02/24
22
یك encode و decode‌ساده :
function TStoM.Encode(inp:string):string;
var
  i:Integer;
  l_n:Integer;
  out1:String;
  asc:Integer;
begin
 l_n := length(inp);
 out1 := '';
 for i:=1 to l_n do
 begin
   asc := ord(inp[i]) i;
   if asc > 255 then
      asc := 33;
   out1 := out1 chr(asc);
 end;
 result := out1;
end;

//My decode method
function TStoM.Decode(inp:string):string;
var
  i:Integer;
  l_n:Integer;
  out1:String;
  asc:Integer;
begin
 l_n := length(inp);
 out1 := '';
 for i:=1 to l_n do
 begin
   asc := ord(inp[i]) - i;
   if asc = 33 then
      asc := 255;
   out1 := out1 chr(asc);
 end;
 result := out1;
end;
بستن
امکانات کلوب
کارت شارژفروشگاه هانیازمندی هابانک رزومه100 درجهبازی هااینترنت هوشمند کلوبصدای سلامت
عمومی
پلیس کلوبدرباره مالاگ توسعه نرم افزارتماس با ماقوانینتبلیغاتوبلاگ تیم مدیریت
شبکه ما
میهن بلاگآپارات (سرویس اشتراک ویدیو) تجارت الکترونیک صبا
کلوب دات کام
کلیه محتوای این سایت توسط کاربران درج شده است و کلوب دات کام هیچ مسئولیتی نسبت به آن ها ندارد.