با استفاده از این تابع می توانید بین صفحه کلید فارسی و صفحه کلید پیش فرض یکی را با استفاده از کد انتخاب کنید
//Change to farsi
loadkeyboardlayout("00000429", KLF_Activate);
//Change to default(English)
loadkeyboardlayout("0000000", KLF_Activate
با استفاده از این تابع می توانید چک کنید که آیا به اینترنت متصل هستید یا خیر
const
INTERNET_CONNECTION_MODEM = 1;
INTERNET_CONNECTION_LAN = 2;
INTERNET_CONNECTION_PROXY = 4;
INTERNET_CONNECTION_MODEM_BUSY = 8;
function InternetGetConnectedState(lpdwFlags: LPDWORD;
dwReserved: DWORD): BOOL; stdcall; external "WININET.DLL";
function IsConnectedToInternet: Boolean;
var
dwConnectionTypes: Integer;
begin
try
dwConnectionTypes := INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
if InternetGetConnectedState(@dwConnectionTypes, 0) then
Result := true
else
Result := false;
except
Result := false;
end;
end;
به عنوان مثال
procedure TForm1.Button1Click(Sender: T);
begin
If IsConnectedToInternet Then
ShowMessage("Ok...You Connected To Internet") // do something, we are connected
Else
ShowMessage("No...You Not Connected To Internet") // No active connection
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
با استفاده از این تابع می توانید از این پس به راحتی اطلاعات را از بانک خود به نرم افزار اکسل انتقال دهید
نکته این که قبل از استفاده باید نرم افزار اکسل را نصب کرده باشید
procedure ExporttoExl(TheDataset:TDataSet;SheetExcelName:String);
var
XApp:Variant;
sheet:Variant;
r,c:Integer;
q:Integer;
row,col:Integer;
fildName:Integer;
begin
try
begin
XApp:=CreateOle("Excel.Application");
XApp.Visible:=true;
end;
except
showmessage("Unable to link with MS Excel, it seems as it is not installed on this system.");
exit;
end;
XApp.WorkBooks.Add(-4167); //open a new blank workbook
XApp.WorkBooks[1].WorkSheets[1].Name:="Sheet1";
//give any name required to ExcelSheet
sheet:=XApp.WorkBooks[1].WorkSheets["Sheet1"];
for fildName:=0 to TheDataset.FieldCount-1 do
//TheDataset refer to the any dataset holding data
begin
q:=fildName+1;
sheet.Cells[1,q]:=TheDataset.Fields[fildName].FieldName; // enter the column headings
end;
//now supply the data from table to excel sheet
TheDataset.First;
for r:=0 to TheDataset.RecordCount-1 do
begin
for c:=0 to TheDataset.FieldCount-1 do
begin
row:=r+2;
col:=c+1;
sheet.Cells[row,col]:=TheDataset.Fields[c].AsString;
end;
TheDataset.Next;
end;
//set font attributes of required range if required
XApp.WorkSheets["Sheet1"].Range["A1:AA1"].Font.Bold:=True;
XApp.WorkSheets["Sheet1"].Range["A1:AA1"].Font.Color := clblue;
XApp.WorkSheets["Sheet1"].Range["A1:AA1"].Font.Color := clblue;
XApp.WorkSheets["Sheet1"].Range["A1:K1"].Borders.LineStyle :=13;
// set other attributes as below
XApp.WorkSheets["Sheet1"].Range["A1:K11"].HorizontalAlignment := 3;
// .Borders.LineStyle :=13;
XApp.WorkSheets["Sheet1"].Columns[1].ColumnWidth:=10;
XApp.WorkSheets["Sheet1"].Columns[2].ColumnWidth:=10;
XApp.WorkSheets["Sheet1"].Columns[3].ColumnWidth:=15;
XApp.WorkSheets["Sheet1"].Columns[4].ColumnWidth:=6;
XApp.WorkSheets["Sheet1"].Columns[5].ColumnWidth:=18;
XApp.WorkSheets["Sheet1"].Columns[6].ColumnWidth:=9;
XApp.WorkSheets["Sheet1"].Columns[7].ColumnWidth:=23;
XApp.WorkSheets["Sheet1"].Columns[8].ColumnWidth:=23;
XApp.WorkSheets["Sheet1"].Columns[9].ColumnWidth:=23;
XApp.WorkSheets["Sheet1"].Columns[10].ColumnWidth:=10;
xapp.caption := "Exported from Demo programmed by SK Arora,the digitiger";
XApp.WorkSheets["Sheet1"].name := "Exported from " + SheetExcelName;
//assuming dataset is TTable based its tablename can be given as title of worksheet
//close;
end;
به عنوان مثال
procedure TForm1.Button1Click(Sender: T);
begin
ExporttoExl(ClientDataSet1,"Sabetee");
close;
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
از این تابع می توانید برای تبدیل فایل PDF به متن استفاده کنید
توجه:قبل از استفاده از این تابع باید برنامه Reader را نصب کرده باشد در غیر این صورت تابع کار نخواهد کرد
procedure Tform1.PDF2Text(APDFFileName, ATextFileName: TFileName);
var
App,AVDoc:Variant;
begin
//create an instance. if no running instance is found a new one is started
App:=CreateOle("AcroExch.App");
// App.Show; //only if you want to..
AVDoc:=App.GetActiveDoc;//doc handle
AVDoc.Open(APDFFileName,"");//see note below
//select all and copy to clipboard
App.MenuItemExecute("Edit");
App.MenuItemExecute("SelectAll");
App.MenuItemExecute("Edit");
App.MenuItemExecute("Copy");
// Memo1 CAN be set to invisible
// You need this in order to get it from
// the clipboard into a text file
Memo1.PasteFromClipboard;
// Save the text to a file
Memo1.Lines.SaveToFile(ATextFileName);
App.Exit; //unless you want to leave it running.
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
تبدیل یک فایل به فلش به یک فایل اجرایی ویندوز
function Swf2Exe(S, D, F: string): string;
//S = Source file (swf)
//D = Destionation file (exe)
//F = Flash Player
var
SourceStream, DestinyStream, LinkStream: TFileStream;
flag: Cardinal;
SwfFileSize: integer;
begin
result := "something error";
DestinyStream := TFileStream.Create(D, fmCreate);
try
LinkStream := TFileStream.Create(F, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(LinkStream, 0);
finally
LinkStream.Free;
end;
SourceStream := TFileStream.Create(S, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(SourceStream, 0);
flag := $FA123456;
DestinyStream.WriteBuffer(flag, sizeof(integer));
SwfFileSize := SourceStream.Size;
DestinyStream.WriteBuffer(SwfFileSize, sizeof(integer));
result := "";
finally
SourceStream.Free;
end;
finally
DestinyStream.Free;
end;
end;
به عنوان مثال:
procedure TForm1.Button1Click(Sender: T);
begin
Swf2Exe("c:somefile.swf", "c:somefile.exe", "c:Program FilesMacromediaFlash MXPlayersSAFlashPlayer.exe");
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
تبدیل عدد به حروف انگلیسی بسیار عالی
Function RealToTxt(Amount : Real) : String;
var
Num : LongInt;
Fracture : Integer;
function Num2Str(Num: LongInt): String;
Const hundred = 100;
thousand = 1000;
million = 1000000;
billion = 1000000000;
begin
if Num >= billion then
if (Num mod billion) = 0 then
Num2Str := Num2Str(Num div billion) + " Billion"
else
Num2Str := Num2Str(Num div billion) + " Billion " +
Num2Str(Num mod billion)
else
if Num >= million then
if (Num mod million) = 0 then
Num2Str := Num2Str(Num div million) + " Million"
else
Num2Str := Num2Str(Num div million) + " Million " +
Num2Str(Num mod million)
else
if Num >= thousand then
if (Num mod thousand) = 0 then
Num2Str := Num2Str(Num div thousand) + " Thousand"
else
Num2Str := Num2Str(Num div thousand) + " Thousand " +
Num2Str(Num mod thousand)
else
if Num >= hundred then
if (Num mod hundred) = 0 then
Num2Str := Num2Str(Num div hundred) + " Hundred"
else
Num2Str := Num2Str(Num div hundred) + " Hundred " +
Num2Str(Num mod hundred)
else
case (Num div 10) of
6,7,9: if (Num mod 10) = 0 then
Num2Str := Num2Str(Num div 10) + "ty"
else
Num2Str := Num2Str(Num div 10) + "ty-" +
Num2Str(Num mod 10);
8: if Num = 80 then
Num2Str := "Eighty"
else
Num2Str := "Eighty-" + Num2Str(Num mod 10);
5: if Num = 50 then
Num2Str := "Fifty"
else
Num2Str := "Fifty-" + Num2Str(Num mod 10);
4: if Num = 40 then
Num2Str := "Forty"
else
Num2Str := "Forty-" + Num2Str(Num mod 10);
3: if Num = 30 then
Num2Str := "Thirty"
else
Num2Str := "Thirty-" + Num2Str(Num mod 10);
2: if Num = 20 then
Num2Str := "Twenty"
else
Num2Str := "Twenty-" + Num2Str(Num mod 10);
0,1: case Num of
0: Num2Str := "Zero";
1: Num2Str := "One";
2: Num2Str := "Two";
3: Num2Str := "Three";
4: Num2Str := "Four";
5: Num2Str := "Five";
6: Num2Str := "Six";
7: Num2Str := "Seven";
8: Num2Str := "Eight";
9: Num2Str := "Nine";
10: Num2Str := "Ten";
11: Num2Str := "Eleven";
12: Num2Str := "Twelve";
13: Num2Str := "Thirteen";
14: Num2Str := "Fourteen";
15: Num2Str := "Fifteen";
16: Num2Str := "Sixteen";
17: Num2Str := "Seventeen";
18: Num2Str := "Eightteen";
19: Num2Str := "Nineteen"
end
end
end {Num2Str};
begin
Num:= Trunc(Amount);
Fracture:= Round(1000*Frac(Amount));
if Num > 0 then
Result := Num2Str(Num) + " and ";
if Fracture > 0 then
Result := Result + IntToStr(Fracture) + "/1000"
else
Result := Result + "000/1000";
end;
به عنوان مثال:
procedure TForm1.Button1Click(Sender: T);
begin
form1.Caption:=realtotxt(123);
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
از این تابع برای نمایش هینت محتوای هر خانه از استرینگ گرید خود استفاده کنید
procedure TForm1.ShowCellHint(X,Y:Integer);
const LastRow:integer=0;LastCol : Integer=0;
var
ACol, ARow : Integer;
begin
//ShowHint auf True setzen
If StringGrid.ShowHint = False Then
StringGrid.ShowHint := True;
//Col und Row Position lesen
StringGrid.MouseToCell(X, Y, ACol, ARow);
//wenn im gültigen Bereich zeige Zelleninhalt als Hint
If (ACol <> -1) And (ARow <> -1) Then
StringGrid.Hint:=StringGrid.Cells[ACol,ARow];
If (ACol<>LastCol) or (ARow<>LastRow) Then
begin
Application.CancelHint;
LastCol:=ACol;
LastRow:=ARow;
end;
end;
//Example, in MouseMove Event
procedure TForm1.StringGridMouseMove(Sender: T; Shift: TShiftState; X,
Y: Integer);
begin
ShowCellHint(X,Y);
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
نحوه دسترسی به کامپوننت ها بدون دانستن نام آنها این روش بسیار مفید است برای زمانی که می خواهید یک یا چند خاصیت کامپوننت ها را به صورت دسته جمعی در زمان اجرا تغییر دهید
var
i : integer;
...
for i := 0 to Form1.ComponentCount-1 do
begin
if (Form1.Components[i] is TEdit) then
if (TEdit(Form1.Components[i]).tag = 1) then
TEdit(Form1.Components[i]).Visible := false;
end;
or
for i := 0 to Form1.ComponentCount-1 do
begin
if (Form1.Components[i] is TEdit) then
if (TEdit(Form1.Components[i]).tag in [1..5,10..15]) then
TEdit(Form1.Components[i]).Visible := false;
end;
or
for i := 0 to Form1.ComponentCount-1 do
begin
if (Form1.Components[i] is TEdit) then
begin
case TEdit(Form1.Components[i]).tag of
1..14 : TEdit(Form1.Components[i]).Visible := false;
15..18 : TEdit(Form1.Components[i]).Visible := true;
19..25 : TEdit(Form1.Components[i]).Visible := false;
26..30 : TEdit(Form1.Components[i]).Visible := false;
end; { case }
end; {if TEdit)
end; {i loop }
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
به وسیله این تابع می توانید یک فایل فلش را از یک فایل اجرایی خارج کنید و به صورت یک فایل فلش ذخیره نمایید
procedure ExeToSWF(ExeFile,aSWF:string);
var
p:pointer;
f:file;
sz,
swfsize:integer;
const
SWF_FLAG:integer=$FA123456;
begin
if not fileexists(ExeFile) then begin
messagebox(Application.Handle,pchar("File not found"),pchar("Error"),MB_ICONERROR);
exit;
end;
assignfile(f,ExeFile);
reset(f,1);
seek(f,filesize(f)-(2*sizeof(integer)));
blockread(f,sz,sizeof(integer));
if sz<>swf_flag then begin
messagebox(Application.Handle,pchar("Not a valid Projector Exe"),pchar("Error"),MB_ICONERROR);
closefile(f);
exit;
end;
blockread(f,swfsize,sizeof(integer));
seek(f,filesize(f)-(2*sizeof(integer))-swfsize);
getmem(p,swfsize);
blockread(f,p^,swfsize);
closefile(f);
assignfile(f,aSWF);
rewrite(f,1);
blockwrite(f,p^,swfsize);
closefile(f);
freemem(p,swfsize);
messagebox(Application.Handle,pchar("SWF Extracted"),pchar("Succes"),MB_ICONINFORMATION);
end;
به عنوان مثال
procedure TForm1.Button1Click(Sender: T);
begin
ExeToSWF("C:Desktopflash.exe","C:Desktopf.swf");
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
فراخوانی فرم خاموش کردن کامپیوتر از طرق این تابع امکان پذیر است
uses ComObj;
{....}
procedure TForm1.Button1Click(Sender: T);
var
shell: Variant;
begin
shell := CreateOle("Shell.Application");
shell.ShutdownWindows;
end;
یک ساعت فوق العاده
اضافه کردن زبان فارسی به ویندوز XP
یک Message Dialog با امکان تغییر نوشته ی دکمه و تمام قسمتها
بستن پنجره
پاک کردن برنامه به وسیله ی خودش
دانلود کردن سورس یک سایت
بدست آوردن آدرس جاری IE
پاک کردن آدرسهای IE
آموزش کار با IntraWeb در دلفی
مبدل ها
تصویر به bmp2icon) Icon)
تشخیص اینکه HARD DISK ما چند درایو دارد.
اینم یک برنامه ای که ICON درایوها را تغییر می دهد.
درست کردن فیلتر زرد رنگ روی ایمیج
[همه عناوین(126)][عناوین آرشیوشده]
بازدید دیروز: 8
کل بازدید :87582
در این وبلاگ سعی میکنم مطالب مربوط به برنامه نویسی دلفی ، پاسکال و گرافیک رایانه ای 2 بعدی و 3 بعدی را به روز کنم منتظر سوالات شما نیز هستم
قویترین سایت دانلود رایگان نرم افزار [18]
دانلود رایگان نرم افزار [39]
دایره المعارف فارسی رایانه [22]
اخبار فناوری 2 [29]
فروش انواع نوت بوک [32]
کتابخانه مجازی ایران [25]
مقالات آماده کامپیوتری [33]
بزرگترین سایت دانلود3 [73]
اخبار فناوری 1 [18]
خفن ترین کدهای جاوا اسکریپت [29]
قیمت انواع سخت افزار2 [34]
آخرین قیمت سخت افزار ها [23]
دانلود کتاب های فارسی [49]
علم الکترونیک و کامپیوتر [28]
[آرشیو(20)]