PDA

View Full Version : چند تابع پر کاربرد برای برنامه نویسان



babak_delphi
دوشنبه 17 بهمن 1384, 03:03 صبح
با سلام خدمت دوستان
با توجه به اینکه برنامه نویسای زیادی در مورد نحوه تبدیل تاریخ میلادی به شمسی سوال می پرسند من ، این تابع رو به همراه 2 تابع دیگه که یکی برای نمایش عدد بصورت فرمت شده (3 رقم 3رقم از راست) و یکی واسه اینکه 1 edit فقط عدد بگیره ، توی یک unit قرار دادم و کدش رو اینجا گذاشتم.
نحوه استفاده اونها رو هم با 1 مثال توضیح دادم :







unit Util;

interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Tlhelp32;
type
function NumberToCurrency(Num: string):string;
Function IsNum(ch : char) : char;
Function MiladiToHejri(GregorianDate : String;DateType : Integer) : String;
implementation

Function IsNum(ch : char) : char;
begin
Try
if Pos(ch,#8#13'1234567890') = 0 then
ch := #0;
Result := ch;
Except
Application.MessageBox(' !!! یک اشکال ناشناخته در روند انجام کار پیش آمده است ','ERROR',MB_OK + MB_ICONERROR);
end;
end;

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;
function NumberToCurrency(Num: string):string;
var
s1,res : string;
int1 : integer;
begin
s1 := Copy(str,1,1);
int1 := StrToInt(s1);
res := ar3[int1 - 1];
Result := res;
end;

end.




برای استفاده کافیست این unit رو هر جا که خواستید uses کنید و توابع رو بصورت زیر استفاده کنید:

Label1.Caption := NumberToCurrency(Edit1.Text);
برای اینکه Edit فقط عدد بگیره این کد رو در OnKeyPress ادیت بنویسید :

Key := IsNum(Key);

Edit1.Text := MiladiToHejri(DateToStr(Now),0)
م.فق باشید.

ramin_mash
دوشنبه 17 بهمن 1384, 10:22 صبح
مرسی از برنامه های قشنگتون
ولی در تابع NumberToCurrency گفتیدar3
یعنی چه؟

pouyaa
سه شنبه 18 بهمن 1384, 08:43 صبح
agha in moshkel bala chie
lotf kon javab bede

babak_delphi
پنج شنبه 27 بهمن 1384, 22:50 عصر
ببخشید
من اشتباهی کد تابع دیگه ای رو کپی کردم
اصلاح می کنم



function NumberToCurrency(Num: string):string;
var
str,buff: string;
begin
str := num;
while Length(str) > 3 do
begin
buff := buff + Copy(str,Length(str)-2,3)+'ر';
Delete(str,Length(str)-2,3);
end;
buff := buff+str;
Result := buff;
end

babak_delphi
جمعه 28 بهمن 1384, 05:18 صبح
function CopyDirectory(const SourceDir, DestDir: string):Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(SourceDir + #0);
pTo := PChar(DestDir)
end;
Result := (0 = ShFileOperation(fos));
end;
این تابع برای کپی کردن یک دایرکتوریه

matinebi
دوشنبه 02 دی 1387, 22:02 عصر
Label1.Caption := NumberToCurrency(Edit1.Text);

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

matinebi
سه شنبه 03 دی 1387, 22:23 عصر
حالا چطور باید کاما رو حذف کرد تا وقتی میخوایم منتقل کنیم به بانک به صورت عددی ذخیره شود