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

[مهران موسوی]

بدست اوردن حجم یک فایل

function Get_File_Size1(sFileToExamine: string; bInKBytes: Boolean): string;

var

  FileHandle: THandle;

  FileSize: LongWord;

  d1: Double;

  i1: Int64;

begin

  //a- Get file size

  FileHandle := CreateFile(PChar(sFileToExamine),

    GENERIC_READ,

    0, {exclusive}

    nil, {security}

    OPEN_EXISTING,

    FILE_ATTRIBUTE_NORMAL,

    0);

  FileSize   := GetFileSize(FileHandle, nil);

  Result     := IntToStr(FileSize);

  CloseHandle(FileHandle);

  //a- optionally report back in Kbytes

  if bInKbytes = True then

  begin

    if Length(Result) > 3 then

    begin

      Insert('.', Result, Length(Result) - 2);

      d1     := StrToFloat(Result);

      Result := IntToStr(round(d1)) + 'KB';

    end

    else

      Result := '1KB';

  end;

end;

[مهران موسوی]

کپی کردن یک پوشه

uses

  ShellApi;



function CopyDir(const fromDir, toDir: string): Boolean;

var

  fos: TSHFileOpStruct;

begin

  ZeroMemory(@fos, SizeOf(fos));

  with fos do

  begin

    wFunc  := FO_COPY;

    fFlags := FOF_FILESONLY;

    pFrom  := PChar(fromDir + #0);

    pTo    := PChar(toDir)

  end;

  Result := (0 = ShFileOperation(fos));

end;

[مهران موسوی]

جا به جا کردن یک پوشه

function MoveDir(const fromDir, toDir: string): Boolean;

var

  fos: TSHFileOpStruct;

begin

  ZeroMemory(@fos, SizeOf(fos));

  with fos do

  begin

    wFunc  := FO_MOVE;

    fFlags := FOF_FILESONLY;

    pFrom  := PChar(fromDir + #0);

    pTo    := PChar(toDir)

  end;

  Result := (0 = ShFileOperation(fos));

end;

[مهران موسوی]

حذف یک پوشه

function DelDir(dir: string): Boolean;

var

  fos: TSHFileOpStruct;

begin

  ZeroMemory(@fos, SizeOf(fos));

  with fos do

  begin

    wFunc  := FO_DELETE;

    fFlags := FOF_SILENT or FOF_NOCONFIRMATION;

    pFrom  := PChar(dir + #0);

  end;

  Result := (0 = ShFileOperation(fos));

end;

[مهران موسوی]

گرفتن مسیر جاری

label1.Caption := GetCurrentDir;

تغییر مسیر جاری

SetCurrentDir('c:\windows');

[مهران موسوی]

کپی کردن فایل

var

  fileSource, fileDest: string;

begin

  fileSource := 'C:\SourceFile.txt';

  fileDest := 'G:\DestFile.txt';

  CopyFile(PChar(fileSource), PChar(fileDest), False);

end;

[مهران موسوی]

خواندن Version Info یک فایل

function GetVersion: string;

var

  VerInfoSize: DWORD;

  VerInfo: Pointer;

  VerValueSize: DWORD;

  VerValue: PVSFixedFileInfo;

  Dummy: DWORD;

begin

  Result := '';

  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);

  if VerInfoSize = 0 then Exit;

  GetMem(VerInfo, VerInfoSize);

  GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);

  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);

  with VerValue^ do

  begin

    Result := IntToStr(dwFileVersionMS shr 16);

    Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF);

    Result := Result + '.' + IntToStr(dwFileVersionLS shr 16);

    Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF);

  end;

  FreeMem(VerInfo, VerInfoSize);

end;

[مهران موسوی]

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

uses ShellAPI; 



function DeleteFileWithUndo(sFileName: string): Boolean;

var 

  fos: TSHFileOpStruct; 

begin 

  FillChar(fos, SizeOf(fos), 0); 

  with fos do 

  begin 

    wFunc  := FO_DELETE; 

    pFrom  := PChar(sFileName); 

    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT; 

  end; 

  Result := (0 = ShFileOperation(fos)); 

end; 

[babak_delphi]

نحوه تبدیل Date به عدد
البته فرمت ورودی باید string باشه مثلا (29/01/1387)
خروجی هم یک string با فرمت عددی است مثل : "13870129"

Function DATE_TO_INT(Str : string) : String;

var

temp,con : string;

p : ^String;

begin

  if str <> '    /  /  ' then

    begin

    p := @temp;

    temp := Trim(PChar(Str));

    con := p^[1] + p^[2] + p^[3] + p^[4] + p^[6] + p^[7] + p^[9] + p^[10];

    DATE_TO_INT := con;

    end

  else

    DATE_TO_INT := '0';

end;

[babak_delphi]

نحوه تبدیل عدد به Date
البته فرمت ورودی باید string باشه مثلا "13870129"
خروجی هم یک string به شکل تاریخ است مثل : "29/01/1387"

Function INT_TO_DATE(Str : string) : String;

var

temp,con : string;

p : ^String;

begin

  if (str <> '0') AND (str <> '') AND (str <> NULL)then

    begin

    p := @temp;

    temp := Trim(PChar(Str));

    con := p^[1] + p^[2] + p^[3] + p^[4] +'/' + p^[5] + p^[6] + '/' +p^[7] + p^[8];

    INT_TO_DATE := con;

    end

  else

    INT_TO_DATE := '';

end;

[babak_delphi]

نحوه تبدیل Time به عدد
البته فرمت ورودی باید string باشه مثلا (12:04)
خروجی هم یک string با فرمت عددی است مثل : "12:04"

Function TIME_TO_INT(Str : string) : String;

var

temp,con : string;

p : ^String;

begin

  if str <> '  :  ' then

    begin

    p := @temp;

    temp := Trim(PChar(Str));

    con := p^[1] + p^[2] + p^[4] + p^[5];

    TIME_TO_INT := con;

    end

  else

    TIME_TO_INT := '0';

end;

[babak_delphi]

نحوه تبدیل عدد به Time
البته فرمت ورودی باید string باشه مثلا "12:04"
خروجی هم یک string به شکل ساعت است است مثل : "12:04"

Function INT_TO_TIME(Str : string) : String;

var

temp,con : string;

p : ^String;

begin

  if (str <> '0') AND (str <> '') AND (str <> NULL)then

    begin

    p := @temp;

    temp := Trim(PChar(Str));

    con := p^[1] + p^[2] + ':' + p^[3] + p^[4];

    INT_TO_TIME := con;

    end

  else

    INT_TO_TIME := '';

end;

[babak_delphi]

شما می تونید این 4 تابع رو برای ذخیره سازی اطلاعات در پایگاه داده و بازیابی اوو استفاده کنید
به این صورت که برای ذخیره تاریخ می تونید یک فیلد integer داشته باشید و تاریخ رو بصورت عددی (با حذف /)در اون قرار بدید و بعد از بازیابی با توابع مربوطه / ها رو اضافه کنید و نمایش بدید
علت ذخیره در Database بصورت Integer اینه که سرعت عملیات روی Integer زیاده
بعد برای مشاهده می تونید اون رو به فرمت string (چون control هایی مثل Edit و Label که معمولا از اونها برای نمایش استفاده می شود string می گیرند) تبدیل کنید
برای ذخیره هم می تونید این توابع رو تغییر بدید که مثلا برای تاریخ علاوه بر حذف / ها ، اون رو به Integer تبدیل کنه و هم اینکه می تونید با StrToInt این کار رو انجام بدید.

[babak_delphi]

لازم به توضیح است که توابعی را که من معرفی می کنم را بهتر است که به این صورت استفاده کنید
همه آنها را در یک Unit ذخیره کنید
در فرم هایی که می خواهید آن توابع را استفاده کنید Unit مذبور را در فرم Use کنید و توابع را فراخوانی کنید
من توابع را معمولا طوری می نویسم که عمومی باشد و به این صورت بتوان استفاده کرد
برای توابع دیگر را نیز می توان همین کار را انجام داد

[babak_delphi]

در فرم هایی که برای ورود اطلاعات استفاده می شوند می تونید این تابع را در OnClick دکمه ذخیره سازی و قبل از ذخیره اطلاعات استفاده کنید
این تابع تمام Edit های روی فرم را شناسایی کرده و آنها را Trim می کند

procedure Trim_Edit;

var

cnt : integer;

begin

  for cnt := 0 to Screen.ActiveForm.ComponentCount - 1 do

    if (Screen.ActiveForm.Components[cnt].ClassName = 'TEdit') then

      TEdit(Screen.ActiveForm.Components[cnt]).Text := 

      Trim(TEdit(Screen.ActiveForm.Component[cnt]).Text);

end;

[babak_delphi]

این هم مشابه تابع قبلی است با این تفاوت که بجای Edit برای DBEdit مورد استفاده قرار می گیرد
شما می توانید این 2 تابع را ادغام کنید و طوری تغییر بدید که یک تابع داشته باشید که برای هر 2 حالت جواب دهد.

procedure Trim_DBEdit;

var

cnt : integer;

begin

  for cnt := 0 to Screen.ActiveForm.ComponentCount - 1 do

    if (Screen.ActiveForm.Components[cnt].ClassName = 'TDBEdit') then

      TDBEdit(Screen.ActiveForm.Components[cnt]).Text :=

      Trim(TDBEdit(Screen.ActiveForm.Components[cnt]).Text);

end;

[babak_delphi]

یک فایل هست که شامل چند تابع از جمله تبدیل عدد به حروف ، سه رقم سه رقم جدا کردن اعداد و ... است
این فایل رو hadisalahi2 در قسمت دلفی Upload کرده بود

[babak_delphi]

Function MiladiToHejri(GregorianDate : String;DateType : Integer) : String;

var

jmm, jdd : string;

g_days_in_month, j_days_in_month : array[0..11] of Integer;

HijriMonths : array[1..12] of String;

g_day_no, j_day_no, jy, jm, gy, gm : Longint;

j_np, i, jd, GD : Integer;

flag : Boolean;

begin

  Try

  flag                := true;

  g_days_in_month[0]  :=  31;

  g_days_in_month[1]  :=  28;

  g_days_in_month[2]  :=  31;

  g_days_in_month[3]  :=  30;

  g_days_in_month[4]  :=  31;

  g_days_in_month[5]  :=  30;

  g_days_in_month[6]  :=  31;

  g_days_in_month[7]  :=  31;

  g_days_in_month[8]  :=  30;

  g_days_in_month[9]  :=  31;

  g_days_in_month[10] :=  30;

  g_days_in_month[11] :=  31;

  j_days_in_month[0]  := 31;

  j_days_in_month[1]  := 31;

  j_days_in_month[2]  := 31;

  j_days_in_month[3]  := 31;

  j_days_in_month[4]  := 31;

  j_days_in_month[5]  := 31;

  j_days_in_month[6]  := 30;

  j_days_in_month[7]  := 30;

  j_days_in_month[8]  := 30;

  j_days_in_month[9]  := 30;

  j_days_in_month[10] := 30;

  j_days_in_month[11] := 29;

  If GregorianDate = Null Then Exit;

  gy := (StrToInt(FormatDateTime('yyyy', StrToDate(GregorianDate)))) - 1600 ;

  gm := (StrToInt(FormatDateTime('mm', StrToDate(GregorianDate))))   - 1    ;

  GD := (StrToInt(FormatDateTime('dd', StrToDate(GregorianDate))))   - 1    ;

  g_day_no := 365 * gy + (gy + 3) div 4 - (gy + 99) div 100 + ( gy + 399) div 400;

  i := 0;

  While i < gm do

  begin

    g_day_no := g_day_no + g_days_in_month[i];

    i := i + 1;

  end;

  If (gm > 1) And (((gy Mod 4 = 0) And (gy Mod 100 <> 0)) Or (gy Mod 400 = 0)) Then

    g_day_no := g_day_no + 1;

  g_day_no := g_day_no + GD;

  j_day_no := g_day_no - 79;

  j_np     := j_day_no div 12053;

  j_day_no := j_day_no Mod 12053;

  jy       := 979 + 33 * j_np + 4 * (j_day_no div 1461);

  j_day_no := j_day_no Mod 1461;

  If (j_day_no >= 366) Then

  begin

    jy := jy + (j_day_no - 1) div 365;

    j_day_no := (j_day_no - 1) Mod 365;

  End;

  i := 0;

  While (j_day_no >= j_days_in_month[i]) and flag do

  begin

    j_day_no := j_day_no - j_days_in_month[i];

    i        := i + 1;

    If i > 12 Then

    begin

      i        := 11;

      j_day_no := 29;

      flag := False;

    End;

  end;

  jm  := i + 1;

  jd  := j_day_no + 1;

  jmm := IntToStr(jm);

  jdd := IntToStr(jd);

  If (Length(jmm) = 1) then

    jmm := '0' + jmm

  else

    jmm := jmm;

  if (Length(jdd) = 1) then

    jdd := '0' + jdd

  else

    jdd := jdd;

  HijriMonths[1]  := 'فروردین';

  HijriMonths[2]  := 'اردیبهشت';

  HijriMonths[3]  := 'خرداد';

  HijriMonths[4]  := 'تیر';

  HijriMonths[5]  := 'مرداد';

  HijriMonths[6]  := 'شهریور';

  HijriMonths[7]  := 'مهر';

  HijriMonths[8]  := 'آبان';

  HijriMonths[9]  := 'آذر';

  HijriMonths[10] := 'دی';

  HijriMonths[11] := 'بهمن';

  HijriMonths[12] := 'اسفند';

  if jmm = '13' then

   begin

     jmm := '12';

     jdd := '30';

   end;

  Case DateType of

    0:

      MiladiToHejri := IntToStr(jy) + '/' + jmm + '/' + jdd;

    1:

      MiladiToHejri := IntToStr(strtoint(jdd)) + ' ' + HijriMonths[StrToInt(jmm)] + ' ' + IntToStr(jy);

  End;

  except

    MiladiToHejri := 'تاریخ وارد شده، اشتباه می باشد .';

  end;

End;

[babak_delphi]

Function HijriToMiladi(HijriDate : String;DateType : Integer) : String;

var

  jy, jm, jd, Hd, Gd,y ,m, tmp, jmmm, jddd, jyyy : string;

  c : Integer;

  MiladiMonths : array[1..12] of String;

{    If HijriDate = NULL Then Exit;

    If Len(HijriDate) < 10 Then

        MsgBox "تاریخ وارد شده، اشتباه می باشد

        Exit Function

    End If}

               //1382/02/03

 begin

    jy := Copy(HijriDate,1,4);

    

    jm := copy(HijriDate, 6, 2);

     If (Length(jm) = 1) then

       jm := '0' + jm

     else

      jm := jm;

    jd := copy(HijriDate,9,2);

    if (copy(jd,1,1) = '/' ) then

       jd := '0' + copy(jd,2,1)

     else

       jd := jd;

  //   'jd = IIf(Len(jd) = 1, "0" & jd, jd)



    HD := jy + '/' + jm + '/' + jd;

    Case StrToInt(jm) of

    1, 2, 3, 4, 5, 6, 7, 8, 9, 10 :

       begin

        m := IntToStr(StrToInt(jm) + 2);

        Y := IntToStr(StrToInt(jy) + 621);

       end;

    11, 12 :

       begin

        m := '0' + copy(jm,2,1);

        Y := IntToStr(StrToInt(jy) + 622);

       end

    End;//case

    GD := Y + '/' + m + '/01';

//'    GD = Y & "/01/01"

    c := 0;

    While True do

      begin

        tmp := GD;

        If HD = MiladiToHejri(GD,0) Then

          break;

       // GD := DateAdd('d', 1, GD);

          GD := DateToStr(strtoDate(tmp)+ 1);

        c := c + 1;

        If c > 1000 Then

           begin

  //         ' MsgBox "Date conversion error. Please check entered date.", vbCritical, "Error"

            HijriToMiladi := '. تاریخ وارد شده، اشتباه می باشد ';

            Exit;

           end;

    end;//while

  MiladiMonths[1]  := 'January';

  MiladiMonths[2]  := 'February';

  MiladiMonths[3]  := 'March';

  MiladiMonths[4]  := 'April';

  MiladiMonths[5]  := 'May';

  MiladiMonths[6]  := 'June';

  MiladiMonths[7]  := 'July';

  MiladiMonths[8]  := 'August';

  MiladiMonths[9]  := 'September';

  MiladiMonths[10] := 'October';

  MiladiMonths[11] := 'November';

  MiladiMonths[12] := 'December';

  Case DateType of

    0:

      HijriToMiladi := GD;

    1:

      begin

      jyyy := copy(GD,1,4);

      jmmm := copy(GD,6,2);

      if (copy(jmmm,2,1) = '/' ) then

       jmmm := '0' + copy(jmmm,1,1)

     else

      jmmm := jmmm;

      jddd := copy(GD,Length(GD)-1,2);

      if (copy(jddd,1,1) = '/' ) then

       jddd := '0' + copy(jddd,2,1)

     else

      jddd := jddd;

      HijriToMiladi := IntToStr(strtoint(jddd))+'th of' + ' ' + MiladiMonths[StrToInt(jmmm)] + ' '+jyyy;

      end;

  End;

End;

[babak_delphi]

این کد در حقیقت برای رفتن به تب بعدی روی فرم است.

procedure Go_Next_Tab(Key : Char);

begin

  Try

    if (Key = #13) then

    begin

      PostMessage(Screen.ActiveForm.Handle, WM_NEXTDLGCTL, 0, 0);

      Key := #0;

    end;

  Except

    Application.MessageBox(' !!! یک اشکال ناشناخته در روند انجام کار پیش آمده است  ','ERROR',MB_OK + MB_ICONERROR);

  end;

end;

[delphiprog3000]

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

اشیا مورد استفاده از تب Dialog

Open Dialog -1


Save Dialog -2

ور در ادامه کدها :

باز کردن فایل:

procedure TForm1.Button1Click(Sender: TObject);

var

 i:integer;

 temp:byte;

begin

 if opendialog1.Execute then

   begin

   assignfile(f,opendialog1.FileName);

   reset(F);

  showmessage(inttostr(filesize(f)));

  size:=FileSize(f);

for i :=0  to filesize(f)-1 do

 read(f,datafile[i]);

for I := 0 to FileSize(f) do

 begin

    datafile2[i]:=datafile[i];

end;

تبدیل یا Encode فایل:

procedure TForm1.Button3Click(Sender: TObject);

var i:integer;

begin

  for I := 0 to size-1  do

   datafile[i]:=datafile2[i+3];

end;

بازگردان فایل یا Decode :

procedure TForm1.Button4Click(Sender: TObject);

var i:integer;

begin

 for I := 0 to size-1  do

 datafile[i]:=datafile2[i-3];

end;

ذخیره فایل :

procedure TForm1.Button2Click(Sender: TObject);

var

 f1:file of byte;

 i:integer;

begin

  if savedialog1.Execute then begin

    assignfile(f1,savedialog1.FileName);

   rewrite(f1);

   for I := 0 to size - 1 do  write(f1,datafile[i]);

   closefile(f1);

 end;

بازهم اگر دوستان روشهای بهتری داشتن ارائه کنند.

با تشکر.موفق باشید....................

[babak_delphi]

این توضیحات مربوط به یکی از پستهای hassan razavi است که در جواب نحوه ذخیره فایل فلش در پایگاه داده ، نوشته بودند
من اون را در اینجا قرار دادم تا در دسترس عموم باشد



نحوه ذخیره فایل در بانک :

یک جدول بنام TFile در SQL Server 2000 ایجاد کنید. من در بانک Master اینکار رو کردم.
2 تا فیلد با مشخصات زیر ایجاد کنید:
1- name nvarchar key
2-swf image allow null

حالا این کد برای ذخیره در بانک (برای هر فایلی میتونید استفاده کنید) برای مثال از آدرس C:\\1.swf استفاده کردم

FileStream fs = new FileStream("d:\\1.swf",FileMode.Open);

FileInfo fi = new FileInfo("d:\\1.swf");

byte[] swf = new byte[(int)fi.Length];

fs.Read(swf, 0, (int)fi.Length);



 SqlConnection con = new SqlConnection("Data Source=.;Initial Catalog=master;Persist Security Info=True;Password=1;User ID=sa");

con.Open();

SqlCommand com = new SqlCommand("Insert into TFile (name,swf) Values (@name,@swf)", con);

com.Parameters.Add("name", SqlDbType.NVarChar).Value = "1.swf";

com.Parameters.Add("swf", SqlDbType.Image).Value = swf;

com.ExecuteNonQuery();

con.Close();

اینم کد برای بازیابی از بانک (برای مثال در مسیر d:\\222.swf استفاده کردم)

SqlConnection con = new SqlConnection("Data Source=.;Initial Catalog=master;Persist Security Info=True;Password=1;User ID=sa");

con.Open();

SqlDataReader dr;

SqlCommand com = new SqlCommand("select * from TFile", con);

dr = com.ExecuteReader();            

dr.Read();

byte[] swf = (byte[])dr.GetValue(1);

FileStream fs = new FileStream("d:\\222.swf", FileMode.Create);

fs.Write(swf, 0, swf.Length);

fs.Close();

con.Close();

آدرس اون تاپیک هم اینه

[babak_delphi]

کدی جهت اضافه کردن یک آیتم جدید به منویی که هنگام کلیک راست روی برنامه تان روی نوار فرمان ظاهر می شود

unit Unit1;

interface

uses

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

  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

procedure OnAppMessage(Var Msg:TMsg;Var Handled:Boolean);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

const

SC_MyMenuItem= WM_User + 1;

var

R:TRect;

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

Application.OnMessage := OnAppMessage;

AppendMenu(GetSystemMenu(Application.Handle,False)  ,MF_SEPARATOR,0,'');

AppendMenu(GetSystemMenu(Application.Handle,False)  ,

MF_STRING, SC_myMenuItem,'Menu Created...');

SystemParametersInfo(SPI_GETWORKAREA , 0 , @r , 0);

end;

procedure TForm1.OnAppMessage(Var Msg:TMsg;Var Handled:Boolean);

begin

if (Msg.message = WM_SYSCOMMAND)and(Msg.wParam = SC_MyMenuItem )then

begin

  ShowMessage('Menu Event Occured...');

  Handled := True;

end;

end;



end.

[babak_delphi]

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

هیچ کس از اول بلد نبود

begin

  winexec(pchar('calc'),SW_shownormal);

end;

[babak_delphi]

برای نصب فایلهای ocx و dll رو در شاخه system32 ویندوز کپی کنید و در run تایپ کنید اسم فایل regsvr32
regsvr32 GSM_MODEM.OCX
بعد فایل pas یا همون gsmmodem_tlb.pas رو تو شاخه Lib دلفی کپی کنید
در آخر از منوی install component تو دلفی فایل pas رو انتخاب کنید
فکر کنم کامپوننت اضافه شده تو پالت activex دلفی اضافه میشه یا تو پالت system

[babak_delphi]

procedure TForm1.Button1Click(Sender: TObject);

var

  h,m,s,ms:word;

begin

  DecodeTime(Time,h,m,s,ms) ;

  Label1.Caption := 'Time = ' + TimeToStr(Time) + Chr(13) +

                    'Hour=' + IntToStr(h) + Chr(13) +

                    'Min=' + IntToStr(m) + Chr(13) +

                    'Sec=' + IntToStr(s) + Chr(13) +

                    'MS=' + IntToStr(ms) ;

end;

[babak_delphi]

procedure TForm1.Button1Click(Sender: TObject);

begin

  Label1.Caption := Format('Num1 = %d , Num2 = %d',[30,54]); //The argument must be an integer value.

  Label2.Caption := Format('Copy %s to %s?', ['10','11']);   //The argument must be a character, a string, or a PChar value.

  Label3.Caption := Format('%.4d/%.2d/%.2d', [1385, 3, 4]) ; //Format 0 In The Date

  Label4.Caption := Format('%.4d%.2d%.2d', [1385, 3, 4]) ; //Format 0 In The Date Without Slash/

  Label5.Caption := Format('%.4d', [2]);

end;

 

[babak_delphi]

یک کامپوننت به همراه نمونه کد قرار میدم
از روی نمونه کد ، خودتون می تونید برنامه مورد نظرتون رو بنویسید

[babak_delphi]

جایی یک نمونه برنامه خیلی ساده دیدم که به فرم ، یک افکت ساده داده بود
آپلود می کنم
شاید مفید واقع بشه

[babak_delphi]

مورد توجه کسانی که می خواهند با کد نویسی با پورت com ارتباط برقرار کنند

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

این کد باز کردن پورت

procedure TMainForm.OpenPort(i:Integer);

{}

  Procedure InitSerial;

  Var

     DCB: TDCB;

     Config : String;

     CommTimeouts : TCommTimeouts;

  begin

     if not SetupComm(hCom, RxBufferSize, TxBufferSize) then

       showMessage('CanNot Setup Com Port');

     if not GetCommState(hCom, DCB) then

        showmessage('can not read com state')

     Else

     Begin

        Config :=Pchar('baud=19200 parity=n data=8 stop=1'+#0);

        if not BuildCommDCB(@Config[1], DCB) then

           ShowMessage('Can Not build com dcb')

        else

           if not SetCommState(hCom, DCB) then

             ShowMessage('Can Not set com state');

     End;

     with CommTimeouts do

     begin

       ReadIntervalTimeout := 0;

       ReadTotalTimeoutMultiplier := 0;

       ReadTotalTimeoutConstant := 1000;

       WriteTotalTimeoutMultiplier := 0;

       WriteTotalTimeoutConstant := 1000;

     end;

     if not SetCommTimeouts(hCom, CommTimeouts) then

            showMessage('Can not set com timeout');

  End;

begin

   CPN:=i;  //initialize serial Port to Boud=9600 Parity=none startbit=1

   hCom := CreateFile(PChar(ComPort),

                                Generic_Read,// Or GENERIC_WRITE,

                                0,

                                nil,

                                OPEN_EXISTING,

                                FILE_ATTRIBUTE_NORMAL,

                                0);

  if hCom = INVALID_HANDLE_VALUE then

     showMessage('Error Opening File')

  else

  Begin

     InitSerial;

  End;

end;

اینهم کد خواندن

function TMainForm.read1byteFromPort:byte;

Var

   d: array[1..1] of byte;

   s: String;

   BytesRead, i: cardinal;

Begin

     if not ReadFile (hCom, d, sizeof(d), BytesRead, Nil) then

        read1byteFromPort:=0

     Else

        read1byteFromPort:=d[1];

end;

موفق باشید.

[babak_delphi]

نحوه انجام این کار را بصورت یک مقاله کوچک در بخش مقالات دلفی قرار دادم


چون به این تاپیک هم مربوط میشد دوباره در اینجا نمی نویسم اما لینکش را در اینجا قرار میدهم

https://barnamenevis.org/showthread.php?t=103358

امیدوارم مفید واقع شود

[Vahid_moghaddam]

وقتی از یک DBGrid برای نمایش اطلاعات یک DataSet مثل query یا table استفاده می کنیم، بعد از Refresh شدن dataset مثلا بسته و باز شدنش، موقعیت جاری سطر روی صفر یعنی اولین رکورد تنظیم می شود. تصور کنید کاربر جایی در انتهای DBGrid باشد!
در کد زیر، Refresh در dataset با حفظ موقعیت سطر انجام می شود. در این کد کلاسی به نام THACKDBGrid تعریف شده است. با این کلاس می توان به خاصیتهای protected کلاس TDBGrid دسترسی داشت (نکته جالب!).

//THackDBGrid = class(TDBGrid)
 

procedure Refresh_PreservePosition;

var

 rowDelta: Integer;

 row: integer;

 recNo: integer;

 ds : TDataSet;

begin

 ds := THackDBGrid(DBGrid1).DataSource.DataSet;
 

 rowDelta := -1 + THackDBGrid(DBGrid1).Row;

 row := ds.RecNo;
 

 ds.Refresh;
 

 with ds do

 begin

   DisableControls;

   RecNo := row;

   MoveBy(-rowDelta) ;

   MoveBy(rowDelta) ;

   EnableControls;

 end;

end;
 

[سعید صابری]

سلام چگونه ميشه شماره سريال سي دي را بدست آورد
خود سي دي نه سي دي رام

[hector2000]

ایا دلفی 2007 پروژه هاش را unicode می تواند ذخیره کند که مشکل فارسی نداشته باشیم؟

[babak_delphi]

 

var

pt:tpoint

begin

getcursorpos(pt);

label1.caption:= 'X : '+inttostr(pt.x)+' , Y :'+inttostr(pt.y);

end

[babak_delphi]

 

function SetFileReadOnly (FileName: String; ReadOnly: Boolean = True): Boolean;

begin

if not FileExists (FileName) then

   Result := False

else

begin

   if ReadOnly then

     Result := SetFileAttributes (PChar (FileName), GetFileAttributes (PChar (FileName)) or FILE_ATTRIBUTE_READONLY)

   else

     Result := SetFileAttributes (PChar (FileName), FILE_ATTRIBUTE_NORMAL);

end;

end; 

[babak_delphi]

فرض کنید میخواهیم در پروژه خود کاربر بتواند بدون تغییر صفحه کلید (Alt + Shift)در برخی Edit ها امکان تایپ فارسی را داشته باشد

برای این کار دو عمل ساده را باید انجام داد :

۱) معرفی زبان فارسی به پروژه

ابتدا کد اصلی پروژه را باز کنید واین خط رابعد از خط Application.Initialize اضافه کنید یا در OnShow فرم اصلی این کد را بنویسید.

Application.BiDiKeyboard:='00000429';

۲) تنظیم خاصیت BiDimode به حالت bdRightToLeft برای هر Edit مورد نظر

حال پروژه را اجرا کنید.

البته بجای Application.BiDiKeyboard:='00000429' میتوانید از کد زیر هم استفاده کنید :
LoadKeyboardLayout(PChar('00000429'), KLF_ACTIVATE)

[AlirezaBahredar]

سلام چگونه ميشه شماره سريال سي دي را بدست آورد
خود سي دي نه سي دي رام

یک روشی که من استفاده کردم برای این موضوع به اینصورت بود که در CMD دستور زیر را اجرا می کنم
: Dir F با این روش سطر دوم شماره سریال CD رو بدست میاری....
موفق باش.....

[saleh_fartash]

برای شما آموزش ساخت سرویس رو می ذارم ( سرویس توسط ویندوز چک میشه و حتی در وضعیت
log of هم به شما خبر می ده)
ساخت سرویسی که ServiceApplication يسازم که هر 10 ثانيه يه پيغام رو نشون بدهد:

براي نوشتن يک Service Application که بتواند هر 10 ثانيه يک پيغام نشان دهد:
ابتدا از منوي file گزينه New را انتخاب کرده و سپس روي گزينه Other کليک کنيد بعد در پنجره باز شده از سربرگ New گزينه ServiceApplication را انتخاب کنيد. با انجام اين کار يک کلاس با نام TService1 ايجاد مي شود که مي توانيد با قرار دادن هر شيء مورد دلخواه بر روي فرم آن برنامه خود را بنويسيد. براي برنامه ما از سربرگ System يک Timer بر روي سرويس گذاشته و خاصيت Interval آن را 10000 بگذاريد. حال در رويداد OnTimer کد زير را بنويسيد:
Showmessage('My Service is worked currently');
خاصيت DisplayName مربوط به Service1 را به MyTstSrv تغيير دهيد. اين نام بعد از اجراي سرويس در ليست سرويسها ظاهر مي شود.
خاصيت Interactive مربوط به Service1 را به True تغيير دهيد.
در رويداد OnExecute مربوط به Service1 کد زير را بنويسيد:
while not Terminated do
ServiceThread.ProcessRequests(True);// wait for termination
حال موقع نصب سرويس بر روي ويندوز رسيده است. براي اينکار بايد برنامه را با پارامتر/install اجرا کنيد. پس در دلفي به منوي Run رفته و روي گزينه Parameters کليک کنيد. در اين پنجره در کادر مربوط به Parameters عبارت /install را تايپ کنيد و روي Ok کليک کنيد. حال برنامه را اجرا کنيد. اگر همه مراحل را بدرستي انجام داده باشيد پيغام Service installed successfully ظاهر مي شود.
حال بايد به ليست سرويسهاي ويندوز برويد و سرويس خود را Start کنيد. (اين سرويس مي تواند با restart شدن ويندوز نيز Start شود) براي اين کار به Control Panel رفته و پنجره Administrative Tools را باز کنيد. در اين پنجره روي گزينه Services دابل کليک کنيد. با انجام اين کار يک پنجره باز مي شود که نام تمامي سريسهاي نصب شده برروي ويندوز وجود دارند. نام MyTstSrv را پيدا کرده و روي آن کليک راست کنيد و سپس گزينه Start را انتخاب کنيد. با انجام اين کار سرويس شما Start شده و بايد هر 10 ثانيه يکبار پيام شمار را نمايش دهد.
براي حذف کردن سرويس از روي ويندوز بايد برنامه را با پارامتر /Uninstall اجرا کنيد. با انجام اين کار پيام Service Uninstalled Successfully ظاهر مي شود.

( باید بگم که"/" قبل از install , uninstall است)

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

winexec(Service_address.exe+' /install',sw_Show);

همچنین برای حذف سرویس از دستور زیر

winexec(Service_address.exe+' /uninstall',sw_Show);

یا میتونی از توی cmd این دو کد را برای نصب و حذف سرویس بنویسی

service_address.exe /install
service_address.exe /uninstall

[babak_delphi]

کدی برای پاک کردن Edit ها , DBEdit ها MaskEdit ها و Memo های یک فرم :

 

procedure clear_all;

var

cnt : integer;

begin

  Try

    for cnt := 0 to Screen.ActiveForm.ComponentCount - 1 do

      begin

      if (Screen.ActiveForm.Components[cnt].ClassName = 'TEdit')

          AND (TEdit(Screen.ActiveForm.Components[cnt]).Tag = 0 ) then

        TEdit(Screen.ActiveForm.Components[cnt]).Clear

      else if (Screen.ActiveForm.Components[cnt].ClassName = 'TMaskEdit')  then

        TMaskEdit(Screen.ActiveForm.Components[cnt]).Clear

      else if (Screen.ActiveForm.Components[cnt].ClassName = 'TDBEdit')

          AND (TDBEdit(Screen.ActiveForm.Components[cnt]).Tag = 0 ) then

         TDBEdit(Screen.ActiveForm.Components[cnt]).Clear

      else if (Screen.ActiveForm.Components[cnt].ClassName = 'TDBMemo')  then

        TDBMemo(Screen.ActiveForm.Components[cnt]).Clear;

      end;

  Except

    //  show error message

  end;

end;

از این تابع میتوان در دکمۀ "پاک کردن فرم" استفاده کرد