نمونه کد - ترفند - کامپوننت برای ^ Delphi ^

شروع موضوع توسط MnavidM ‏7 جولای 2005 در انجمن منطق و الگوریتم برنامه‌نویسی

  1. MnavidM

    MnavidM Active Member

    ارسال‌ها:
    2,962
    تشکر شده:
    507
    امتیاز دستاورد:
    36
    سلام.

    این تاپیک رو به این منظور ایجاد کردم که هر کدام از دوستان خواستند که "نمونه کد - ترفند - کامپوننت برای ^ Delphi ^ " قرار بدند از اینجا استفاده کنند .

    و لطفا در این تاپیک از زدن پست های بی استفاده خودداری کنید .

    :1: - اگر خواستید تشکر کنید , می تونید از دکمه تشکر پایین هر پست استفاده کنید.
    :2: - اگر در مورد کد ها و ... سوال داشتید در تاپیکی جدا سوال خود رو با موضوعی مناسب مطرح کنید.
    :3: - هر پستی که در اینجا می زنید , موضوعش را مشخص کنید.
    :4: - تا جایی که امکان داره , توضیح مختصری از هر خط کد آموزشی بنویسید(اگر هم نباشه مشکلی نیست).
    :5: - از ساختار زیر برای آموزش استفاده کنید .


    موضوع : ---
    تست شده در دلفی: ---
    کد :

    کد (Text):


    code ro inja benevisid

     
    توضیحاتی در مورد کد : ------
    ---------------
    -----------

    :6: - البته بسته به نیاز می تونید ساختار رو تغییر بدید و موارد دیگری رو هم اضافه کنید , اما موارد بالا از یادتان نرود.

    :7: - اگر هم سوال , نظر و یا پیشنهادی در این مورد داشتید توسط پیغام خصوصی با من تماس بگیرید.
    :8: - موفق باشید.

    نوید مردوخ روحانی - 16-04-1384
     
    نوشته شده توسط MnavidM در ‏7 جولای 2005
    lvlahsa.، m.p.a، یاسردرا و 5 نفر دیگر از این ارسال تشکر کرده اند.
  2. MnavidM

    MnavidM Active Member

    ارسال‌ها:
    2,962
    تشکر شده:
    507
    امتیاز دستاورد:
    36
    بازکردن پنجره ی Task manager

    موضوع : بازکردن پنجره ی Task manager در برنامه های دلفی .

    تست شده در دلفی : 5 - 6 - 7

    تست شده در ویندوز : Xp , 2003 Server

    کد :

    در قسمت uses این unit رو اضافه کنید .

    کد (Text):
    ShellApi
    حالا هر کجا خواستید مثلا توی OnClick یه Button این کد رو بزارید .

    کد (Text):
    ShellExecute (HWND(nil), 'open', 'taskmgr','', '', SW_SHOWNORMAL);
    توضیح :

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

    و در اینجا با استفاده از این دستور , از دل ویندوز این برنامه(Task manager) رو اجرا کردیم . از این روش برای کارهای دیگه هم چون نمایش پنحره ScreenSaver و ... استفاده می شود.
    موفق باشید.
    نوید.
     
    نوشته شده توسط MnavidM در ‏7 جولای 2005
    lvlahsa.، m.p.a، Silver PC و 2 نفر دیگر از این ارسال تشکر کرده اند.
  3. Mikhak

    Mikhak Active Member

    ارسال‌ها:
    1,166
    تشکر شده:
    120
    امتیاز دستاورد:
    36
    تغيير روزوليشن صفحه ويندوز در هنگام اجراي برنامه

    موضوع : تغيير روزوليشن صفحه ويندوز
    شايد بعضي از برنامه نويس ها برنامه اي بنويسن كه به يه رزولوشين خاص باشه و دوست داشته باشن كه كاربر هم برنامه رو تو اين روزوليشن ببينه در اين مورد ميتونين از برنامه زير استفاده كنين

    كد هاش خيلي راحته فكر نكنم احتياجي به توضيح باشه
    کد (Text):

    function SetDisplay1024x768: Boolean;

    var

    DevMode: TDeviceMode;

    begin

    EnumDisplaySettings(nil, 0, DevMode);

    DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;

    DevMode.dmPelsWidth := 1024;

    DevMode.dmPelsHeight := 768;

    Result := ChangeDisplaySettings(DevMode, CDS_UPDATEREGISTRY)

    = DISP_CHANGE_SUCCESSFUL;

    end;

     

    procedure TForm1.Button1Click(Sender: TObject);

    begin

    SetDisplay1024x768;

    end;
     
    اين برنامه روزوليشن صفحه شما رو به 1024x768 تبديل ميكنه
    --------------------
    سينا
     
    نوشته شده توسط Mikhak در ‏11 جولای 2005
    ansoft، Silver PC و larilarilari از این ارسال تشکر کرده اند.
  4. MnavidM

    MnavidM Active Member

    ارسال‌ها:
    2,962
    تشکر شده:
    507
    امتیاز دستاورد:
    36
    Ntfs یا Fat32

    موضوع : فهمیدن نوع FAT درایو

    تست شده در دلفی : 5 - 6 - 7

    توسط این تابع :

    کد (Text):


    function GetHardDiskPartitionType(const DriveLetter: Char): string;
      // FAT
      // NTFS
    var
      NotUsed: DWORD;
      VolumeFlags: DWORD;
      VolumeInfo: array[0..MAX_PATH] of Char;
      VolumeSerialNumber: DWORD;
      PartitionType: array[0..32] of Char;
    begin
      GetVolumeInformation(PChar(DriveLetter + ':\'),
        nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
        VolumeFlags, PartitionType, 32);
      Result := PartitionType;
    end;

     
    نحوه استفاده :

    خروجش رشته هست و شما به روش های مختلف می تونید ازش استفاده کنید.

    کد (Text):
    ShowMessage(GetHardDiskPartitionType('c'));
    یا

    کد (Text):
    ShowMessage(GetHardDiskPartitionType('a'));
    موفق باشید.
    نوید.
     
    نوشته شده توسط MnavidM در ‏11 جولای 2005
    ansoft، Silver PC و larilarilari از این ارسال تشکر کرده اند.
  5. MnavidM

    MnavidM Active Member

    ارسال‌ها:
    2,962
    تشکر شده:
    507
    امتیاز دستاورد:
    36
    میزان بیکاری سیستم

    موضوع : میزان بیکاری سیستم در هر ثانیه

    تست شده در دلفی : 5 - 6 - 7

    توسط این تابع :

    کد (Text):


    function LastInput: DWord;
    var
      LInput: TLastInputInfo;
    begin
      LInput.cbSize := SizeOf(TLastInputInfo);
      GetLastInputInfo(LInput);
      Result := GetTickCount - LInput.dwTime;
    end;

     
    نحوه استفاده :

    یک Timer و یک Lable1 روی فرمتون قرار بدید .

    در رویداد OnTimer ساعت این کد رو قرار بدید :

    کد (Text):
    Label1.Caption := Format('System Idle since %d ms', [LastInput]);
    موفق باشید.
    نوید.
     
    نوشته شده توسط MnavidM در ‏11 جولای 2005
    ansoft، Silver PC، winer3549 و یک نفر دیگر از این ارسال تشکر کرده اند.
  6. MnavidM

    MnavidM Active Member

    ارسال‌ها:
    2,962
    تشکر شده:
    507
    امتیاز دستاورد:
    36
    یک سری از مشخصات Cpu

    موضوع : یک سری از مشخصات CPU

    تست شده در دلفی : 5 - 6 - 7

    در دلفی :

    اول یک Application (یه برنامه تازه) باز کنید و بعد اون رو Save کنید . به صورت پیش فرض ما در اینجا اسم Unit برنامه رو Main گذاشتم (شما هم هنگام Save همین کار رو بکنید)

    حالا یک عنصر Image روی فرمتون قرار بدید .

    و اسم فرمتون رو frm_main بزارید.

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

    کد (Text):



    unit main;

    interface

    uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls, ExtCtrls;

    type
      Tfrm_main = class(TForm)
        img_info: TImage;
        procedure FormShow(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
        procedure info(s1, s2: string);
      end;

    var
      frm_main: Tfrm_main;
      gn_speed_y: Integer;
      gn_text_y: Integer;
    const
      gn_speed_x: Integer = 8;
      gn_text_x: Integer  = 15;
      gl_start: Boolean   = True;

    implementation

    {$R *.DFM}

    procedure Tfrm_main.FormShow(Sender: TObject);
    var
      _eax, _ebx, _ecx, _edx: Longword;
      i: Integer;
      b: Byte;
      b1: Word;
      s, s1, s2, s3, s_all: string;
    begin
      //Set the startup colour of the image
      img_info.Canvas.Brush.Color := clblue;
      img_info.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));


      gn_text_y := 5; //position of the 1st text

      asm                //asm call to the CPUID inst.
        mov eax,0         //sub. func call
        db $0F,$A2         //db $0F,$A2 = CPUID instruction
        mov _ebx,ebx
        mov _ecx,ecx
        mov _edx,edx
      end;

      for i := 0 to 3 do   //extract vendor id
      begin
        b := lo(_ebx);
        s := s + chr(b);
        b := lo(_ecx);
        s1:= s1 + chr(b);
        b := lo(_edx);
        s2:= s2 + chr(b);
        _ebx := _ebx shr 8;
        _ecx := _ecx shr 8;
        _edx := _edx shr 8;
      end;
      info('CPU', '');
      info('   - ' + 'Vendor ID: ', s + s2 + s1);

      asm
        mov eax,1
        db $0F,$A2
        mov _eax,eax
        mov _ebx,ebx
        mov _ecx,ecx
        mov _edx,edx
      end;
      //06B1
      //|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|
      b := lo(_eax) and 15;
      info('   - ' + 'Stepping ID: ', IntToStr(b));
      b := lo(_eax) shr 4;
      info('   - ' + 'Model Number: ', IntToHex(b, 1));
      b := hi(_eax) and 15;
      info('   - ' + 'Family Code: ', IntToStr(b));
      b := hi(_eax) shr 4;
      info('   - ' + 'Processor Type: ', IntToStr(b));
      //31.   28. 27.   24. 23.   20. 19.   16.
      //  0 0 0 0   0 0 0 0   0 0 0 0   0 0 0 0
      b := lo((_eax shr 16)) and 15;
      info('   - ' + 'Extended Model: ', IntToStr(b));

      b := lo((_eax shr 20));
      info('   - ' + 'Extended Family: ', IntToStr(b));

      b := lo(_ebx);
      info('   - ' + 'Brand ID: ', IntToStr(b));
      b := hi(_ebx);
      info('   - ' + 'Chunks: ', IntToStr(b));
      b := lo(_ebx shr 16);
      info('   - ' + 'Count: ', IntToStr(b));
      b := hi(_ebx shr 16);
      info('   - ' + 'APIC ID: ', IntToStr(b));

      //Bit 18 =? 1     //is serial number enabled?
      if (_edx and $40000) = $40000 then
        info('   - ' + 'Serial Number ', 'Enabled')
      else
        info('   - ' + 'Serial Number ', 'Disabled');

      s := IntToHex(_eax, 8);
      asm                  //determine the serial number
        mov eax,3
        db $0F,$A2
        mov _ecx,ecx
        mov _edx,edx
      end;
      s1 := IntToHex(_edx, 8);
      s2 := IntToHex(_ecx, 8);
      Insert('-', s, 5);
      Insert('-', s1, 5);
      Insert('-', s2, 5);
      info('   - ' + 'Serial Number: ', s + '-' + s1 + '-' + s2);

      asm
        mov eax,1
        db $0F,$A2
        mov _edx,edx
      end;
      info('', '');
      //Bit 23 =? 1
      if (_edx and $800000) = $800000 then
        info('MMX ', 'Supported')
      else
        info('MMX ', 'Not Supported');

      //Bit 24 =? 1
      if (_edx and $01000000) = $01000000 then
        info('FXSAVE & FXRSTOR Instructions ', 'Supported')
      else
        info('FXSAVE & FXRSTOR Instructions Not ', 'Supported');

      //Bit 25 =? 1
      if (_edx and $02000000) = $02000000 then
        info('SSE ', 'Supported')
      else
        info('SSE ', 'Not Supported');

      //Bit 26 =? 1
      if (_edx and $04000000) = $04000000 then
        info('SSE2 ', 'Supported')
      else
        info('SSE2 ', 'Not Supported');

      info('', '');

      asm     //execute the extended CPUID inst.
        mov eax,$80000000   //sub. func call
        db $0F,$A2
        mov _eax,eax
      end;

      if _eax > $80000000 then  //any other sub. funct avail. ?
      begin
        info('Extended CPUID: ', 'Supported');
        info('   - Largest Function Supported: ', IntToStr(_eax - $80000000));
        asm     //get brand ID
          mov eax,$80000002
          db $0F
          db $A2
          mov _eax,eax
          mov _ebx,ebx
          mov _ecx,ecx
          mov _edx,edx
        end;
        s  := '';
        s1 := '';
        s2 := '';
        s3 := '';
        for i := 0 to 3 do
        begin
          b := lo(_eax);
          s3:= s3 + chr(b);
          b := lo(_ebx);
          s := s + chr(b);
          b := lo(_ecx);
          s1 := s1 + chr(b);
          b := lo(_edx);
          s2 := s2 + chr(b);
          _eax := _eax shr 8;
          _ebx := _ebx shr 8;
          _ecx := _ecx shr 8;
          _edx := _edx shr 8;
        end;

        s_all := s3 + s + s1 + s2;

        asm
          mov eax,$80000003
          db $0F
          db $A2
          mov _eax,eax
          mov _ebx,ebx
          mov _ecx,ecx
        mov _edx,edx
        end;
        s  := '';
        s1 := '';
        s2 := '';
        s3 := '';
        for i := 0 to 3 do
        begin
          b := lo(_eax);
          s3 := s3 + chr(b);
          b := lo(_ebx);
          s := s + chr(b);
          b := lo(_ecx);
          s1 := s1 + chr(b);
          b := lo(_edx);
          s2 := s2 + chr(b);
          _eax := _eax shr 8;
          _ebx := _ebx shr 8;
          _ecx := _ecx shr 8;
          _edx := _edx shr 8;
        end;
        s_all := s_all + s3 + s + s1 + s2;

        asm
          mov eax,$80000004
          db $0F
          db $A2
          mov _eax,eax
          mov _ebx,ebx
          mov _ecx,ecx
          mov _edx,edx
        end;
        s  := '';
        s1 := '';
        s2 := '';
        s3 := '';
        for i := 0 to 3 do
        begin
          b  := lo(_eax);
          s3 := s3 + chr(b);
          b := lo(_ebx);
          s := s + chr(b);
          b := lo(_ecx);
          s1 := s1 + chr(b);
          b  := lo(_edx);
          s2 := s2 + chr(b);
          _eax := _eax shr 8;
          _ebx := _ebx shr 8;
          _ecx := _ecx shr 8;
          _edx := _edx shr 8;
        end;
        info('Brand String: ', '');
        if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
        info('', '   - ' + s_all + s3 + s + s1 + s2);
      end
      else
        info('   - Extended CPUID ', 'Not Supported.');
    end;

    procedure Tfrm_main.info(s1, s2: string);
    begin
      if s1 <> '' then
      begin
        img_info.Canvas.Brush.Color := clblue;
        img_info.Canvas.Font.Color  := clyellow;
        img_info.Canvas.TextOut(gn_text_x, gn_text_y, s1);
      end;
      if s2 <> '' then
      begin
        img_info.Canvas.Brush.Color := clblue;
        img_info.Canvas.Font.Color  := clWhite;
        img_info.Canvas.TextOut(gn_text_x + img_info.Canvas.TextWidth(s1), gn_text_y, s2);
      end;
      Inc(gn_text_y, 13);
    end;

    end.


     
    اینم یه عکس از نحوه نمایش مشخصات :
     

    پیوست ها:

    • Cpu.GIF
      Cpu.GIF
      اندازه فایل:
      کیلوبایت 17.9
      نمایش ها:
      49
    نوشته شده توسط MnavidM در ‏11 جولای 2005
    ansoft، Silver PC، winer3549 و یک نفر دیگر از این ارسال تشکر کرده اند.
  7. Mikhak

    Mikhak Active Member

    ارسال‌ها:
    1,166
    تشکر شده:
    120
    امتیاز دستاورد:
    36
    نمايش فايلهاي داخل يک folder همراه با Icon آنها و اعلام نوع فايل

    موضوع : نمايش فايلهاي داخل يک folder همراه با Icon آنها و اعلام نوع فايل
    ابزار لازم : يک ListView، يک ImageList و يک Button
    تست شده : روي دلفي 7 و ويندوز هاي xp , 98
    بعد از اينكه ابزار رو رو فرمتون درست كردين اين كدها رو به برنامه اضافه كنين
    کد (Text):

    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, ImgList, ShellAPI;

    type
    TForm1 = class(TForm)
    ImageList1: TImageList;
    Button1: TButton;
    ListView1: TListView;
    procedure Button1Click(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure InsertFilesInList( strPath: String; ListView: TListView; ImageList: TImageList);
    var
    pFile: Integer;
    Icon: TIcon;
    SearchRec: TSearchRec;
    ListItem: TListItem;
    FileInfo: SHFILEINFO;
    begin
    // Create a temporary TIcon
    Icon := TIcon.Create;
    ListView.Items.BeginUpdate;
    try
    // search for the first file
    pFile := FindFirst(strPath + '*.*', faAnyFile, SearchRec);
    while pFile = 0 do
    begin
    with ListView do
    begin
    // On directories and volumes
    if ((SearchRec.Attr and FaDirectory <> FaDirectory) and
    (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then
    begin
    ListItem := ListView.Items.Add;
    //Get The DisplayName
    SHGetFileInfo(PChar(strPath + SearchRec.Name), 0, FileInfo,
    SizeOf(FileInfo), SHGFI_DISPLAYNAME);
    Listitem.Caption := FileInfo.szDisplayName;
    // Get The TypeName
    SHGetFileInfo(PChar(strPath + SearchRec.Name), 0, FileInfo,
    SizeOf(FileInfo), SHGFI_TYPENAME);
    ListItem.SubItems.Add(FileInfo.szTypeName);
    //Get The Icon That Represents The File
    SHGetFileInfo(PChar(strPath + SearchRec.Name), 0, FileInfo,
    SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON);
    Icon.Handle := FileInfo.hIcon;
    ListItem.ImageIndex := ImageList.AddIcon(Icon);
    // Destroy the Icon
    DestroyIcon(FileInfo.hIcon);
    end;
    end;
    pFile := FindNext(SearchRec);
    end;
    finally
    Icon.Free;
    ListView.Items.EndUpdate;
    end;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    // Assign a Imagelist to the ListView
    ListView1.SmallImages := ImageList1;
    // Show Listview in Report Style and add 2 Columns
    ListView1.ViewStyle := vsReport;
    ListView1.Columns.Add;
    ListView1.Columns.Add;
    InsertFilesInList('C:\', ListView1, ImageList1);
    end;

    end.
     
    -----------------------------
    سينا
     
    نوشته شده توسط Mikhak در ‏12 جولای 2005
    mohsenhtc، ansoft، Silver PC و 2 نفر دیگر از این ارسال تشکر کرده اند.
  8. Mikhak

    Mikhak Active Member

    ارسال‌ها:
    1,166
    تشکر شده:
    120
    امتیاز دستاورد:
    36
    مشخص كردن اندازه فايل انتخاب شده

    موضوع : مشخص كردن اندازه فايل انتخاب شده

    ابزار لازم : يک Button، يک Label، يک OpenDialog
    بعد كد زير رو درون تابع كليك button بزارين
    کد (Text):

    procedure TForm1.Button1Click(Sender: TObject);
    var
    SearchRec: TSearchRec;
    begin
    if OpenDialog1.Execute then
    if FindFirst(OpenDialog1.FileName, faAnyFile, SearchRec) = 0 then
    Label1.Caption := FloatToStrF(SearchRec.Size/1048576, ffFixed, 7, 2)+' MB';
    FindClose(SearchRec);
    end;
     
    ------------------------
    سينا
     
    نوشته شده توسط Mikhak در ‏12 جولای 2005
    ansoft، Silver PC، winer3549 و یک نفر دیگر از این ارسال تشکر کرده اند.
  9. freefard

    freefard New Member

    ارسال‌ها:
    4
    تشکر شده:
    11
    امتیاز دستاورد:
    1
    اجرای ماشین حساب ویندوز در دلفی
    ShellExecute (HWND(nil), 'open', 'calc','', '', SW_SHOWNORMAL);
     
    نوشته شده توسط freefard در ‏12 ژانویه 2006
    Silver PC و larilarilari از این پست تشکر کرده اند.
  10. freefard

    freefard New Member

    ارسال‌ها:
    4
    تشکر شده:
    11
    امتیاز دستاورد:
    1
    کد تغییر عنوان روز و شب در کنار ساعت ویندوز

    procedure TForm1.Button2Click(Sender: TObject);
    var
    Reg: TRegistry;
    begin
    Reg := TRegistry.Create;
    try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Control Panel\International\', True) then
    begin
    Reg.WriteString('s1159',edit1.Text );
    Reg.WriteString('s2359',edit2.Text );
    Reg.CloseKey;
    end;
    finally
    Reg.Free;
    inherited;
    end;
    Showmessage('Saved Your Changed!... Refresh Your System ')
    end;


    اگر سوالی دارید به وبلاگ من سر بزنید
     
    نوشته شده توسط freefard در ‏12 ژانویه 2006
    ansoft، Silver PC، javad3d و یک نفر دیگر از این ارسال تشکر کرده اند.
  11. freefard

    freefard New Member

    ارسال‌ها:
    4
    تشکر شده:
    11
    امتیاز دستاورد:
    1
    استفاده از کلیداینتر به جای تب

    می خواهیم به جای استفاده از کلید تب از کلید ایــــــنتر استفاده کنیم


    procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
    begin
    if Key = #13 then { if it's an enter key }
    Key := #0; { eat enter key }
    Perform(WM_NEXTDLGCTL, 0, 0); { move to next control }

    end;
     
    نوشته شده توسط freefard در ‏12 ژانویه 2006
    ansoft، Silver PC و winer3549 از این ارسال تشکر کرده اند.
  12. freefard

    freefard New Member

    ارسال‌ها:
    4
    تشکر شده:
    11
    امتیاز دستاورد:
    1
    برای جابجا کردن اشیا روی فرم

    مثلا یک دکمه داریم
    برروی رخداد on mouse move کد زیر را تایپ کنید
    begin
    realesecapture;
    button1.perform(wm_syscommand,$f016,0);
    end;

    راستی اینم وبلاگم :freefard.blogfa.com
     
    نوشته شده توسط freefard در ‏12 ژانویه 2006
    Silver PC و flashdes از این پست تشکر کرده اند.
  13. Mordorado

    Mordorado New Member

    ارسال‌ها:
    13
    تشکر شده:
    1
    امتیاز دستاورد:
    1
    نوشته شده توسط Mordorado در ‏12 سپتامبر 2006
  14. 1Program

    1Program Member

    ارسال‌ها:
    136
    تشکر شده:
    31
    امتیاز دستاورد:
    16
    استفاده از نمایش Help Dialog ویندوز :
    تست شده در دلفی6, 7 و WinXP,Win9x , Win2k
    uses shellapi;
    .
    .
    .
    .
    .
    .

    ShellAbout(Handle,pchar('نام برنامه') ,pchar('Ahmady'),Application.Icon.Handle);
     
    نوشته شده توسط 1Program در ‏25 اکتبر 2006
    Silver PC از این پست تشکر کرده است.
  15. 1Program

    1Program Member

    ارسال‌ها:
    136
    تشکر شده:
    31
    امتیاز دستاورد:
    16
    یک Edit برای ورود اعداد

    تست شده در دلفی 7 و WinXp
     

    پیوست ها:

    • NumberEdit.zip
      اندازه فایل:
      کیلوبایت 1.5
      نمایش ها:
      93
    نوشته شده توسط 1Program در ‏25 اکتبر 2006
    Silver PC از این پست تشکر کرده است.
  16. 1Program

    1Program Member

    ارسال‌ها:
    136
    تشکر شده:
    31
    امتیاز دستاورد:
    16
    ClientDataSet

    این کمپوننت در دلفی بسیار کرار می باشد .

    - برای برنامه MultiTheird

    - برای استفاده از فایلها به عنوان بانک اطلاعاتی (فایلهایی با پسوند XML , CDS)

    - , ....

    استفاده ی فایلی :

    زین پس : CDS=ClientDataset

    بر روی فرم خود یک CDS بیندازید .

    مقدار FileName آنرا به (مثلاً) Data.cds تغییر دهید .

    یک Table روی فرم انداخته و مقدار Dataset -> CDS را با نام جدول Set کنید .

    در Form.Create کد زیر را اضافه کنید :

    if not fileexists('data.cds') then

    cds.creatdatabase;

    cds.open

    .

    .

    .

    برای ذخیره در فایل متد post درست کار نمی کند پس از این متد استفده کنید :

    cds.savetofile('data.cds') 0

    امیدوارم که مطلب خوبی باشد .
     
    نوشته شده توسط 1Program در ‏26 اکتبر 2006
    Silver PC و winer3549 از این پست تشکر کرده اند.
  17. 1Program

    1Program Member

    ارسال‌ها:
    136
    تشکر شده:
    31
    امتیاز دستاورد:
    16
    یک کد برای اینکه فرم به صورت Blind (کم رنگ تا پررنگ) ظاهر شود .

    procedure TForm1.FormCreate(Sender: TObject) ;
    var
    FullRgn, ClientRgn, ButtonRgn: THandle;
    Margin, X, Y: Integer;
    begin
    Margin := (Width - ClientWidth) div 2;
    FullRgn := CreateRectRgn(0, 0, Width, Height) ;
    X := Margin;
    Y := Height - ClientHeight - Margin;
    ClientRgn := CreateRectRgn
    (X, Y, X + ClientWidth, Y + ClientHeight) ;
    CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF) ;
    X := X + Button1.Left;
    Y := Y + Button1.Top;
    ButtonRgn := CreateRectRgn
    (X, Y, X + Button1.Width, Y + Button1.Height) ;
    CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR) ;
    SetWindowRgn(Handle, FullRgn, True) ;
    end;


    منبع :http://delphi.about.com/cs/adptips1999/a/bltip0899_5.htm
     
    نوشته شده توسط 1Program در ‏26 اکتبر 2006
    Silver PC و winer3549 از این پست تشکر کرده اند.
  18. babak869

    babak869 Member

    ارسال‌ها:
    60
    تشکر شده:
    20
    امتیاز دستاورد:
    6
    نوشته شده توسط babak869 در ‏18 نوامبر 2006
  19. ehsan640

    ehsan640 New Member

    ارسال‌ها:
    1
    تشکر شده:
    0
    امتیاز دستاورد:
    1
    دمت گرم
     
    نوشته شده توسط ehsan640 در ‏16 دسامبر 2006
  20. Sampro

    Sampro Member

    ارسال‌ها:
    254
    تشکر شده:
    201
    امتیاز دستاورد:
    16
    تشخيص دهيم برنامه ي ما در حال اجراست يا نه

    فكر كنم با تمام ورژن ها كار كنه .
    با ويندوز XP امتحان كردم
    با اين كد از بيش از يك بار اجرا نشدن برنامه تان اطمينان حاصل كنيد

    کد (Text):

    [B]uses [/B]window;
        [B]var[/B]
        Hmutex:THandle;
        [B]begin[/B]
        Hmutex:=CreateMutex([B]Nil[/B],false,'OneCopyMutex');
        [B]if[/B] WaitForSingleObject(Hmutex,0)<> WAIT_TIMEOUT [B]then[/B]
        [B]begin[/B]
          Application.Initialize;
          Application.CreateForm(TForm1,Form1);
          Application.Run;
        [B]end[/B];
      [B]end[/B];
     
     
    نوشته شده توسط Sampro در ‏3 مارس 2008
    Silver PC و winer3549 از این پست تشکر کرده اند.

به اشتراک بگذارید