|
ساعت گویا |
|
|
برای اینکه از آپدیت وبلاگ باخبر شوید عضو شوید(مخصوصاً دلفی کارا)
|
|
تاریخ ایجاد وبلاگ :
26/4/1384
كاربران حاضر در وبلاگ :
نفر
تعداد بازدید از وبلاگ :
|
|
|
|
 kasoft
|
|
به آدرس زیر هم سری بزنید
KASoft.qsh.in
ارسال شده توسط قادر امیری فرد در مورخه دوشنبه ششم آبان 1387 ساعت 15:16
[+]
|
|
|
messagebox فارسی
|
|
شاید دوست داشته باشید که در برنامه های خود وقتی پیغامی را به کاربر نمایش میدهید از پیغامهای فارسی استفاده کنید.
در حالت عادی حتماً متوجه شده اید که این پیغامها از چپ به راست نوشته میشوند و زیبایی کار را از بین میبرند با استفاده از کد زیر میتوانیدیک messagebox فارسی ایجاد کنید .مطمئنم که خیلی به دردتون میخوره.
ازش لذت ببرید.
برای دیدن کد ادامه مطلب را کلیک کنید.
ارسال شده توسط قادر امیری فرد در مورخه چهارشنبه بیست و چهارم خرداد 1385 ساعت 23:31
ادامه مطلب
[+]
|
|
|
عکس گرفتن از فرم
|
|
این کد،کد بسیار جالبی است.
با یک کد کلیدی از فرم خود عکس بگیرید.
GetFormImage.SaveToFile('c:\Form.bmp');
ارسال شده توسط قادر امیری فرد در مورخه شنبه ششم خرداد 1385 ساعت 23:35
[+]
|
|
|
چگونه بفهمیم دلفی در حال اجراست؟
|
|
با استفاده از کد زیر میتوانید بفهمید که آیا دلفی در حال اجراست یا نه؟
کامپوننت هایی هستند که فقط وقتی دلفی در حال اجراست کار میکنند و وقتی دلفی در اجرا نباشد کار نمی کنند این کامپوننتها از کد زیر برای فهمیدن این مطلب استفاده میکنند.
function DelphiRunning: Boolean;
var
H1, H2, H3, H4: HWnd;
const
A1: array[0..12] of char = \ 'TApplication\'#0;
A2: array[0..15] of char = \ 'TAlignPalette\'#0;
A3: array[0..18] of char = \ 'TPropertyInspector\'#0;
A4: array[0..11] of char = \ 'TAppBuilder\'#0;
T1: array[0..6] of char = \ 'Delphi\'#0;
begin
H2 := FindWindow(A2, nil);
H3 := FindWindow(A3, nil);
H4 := FindWindow(A4, nil);
Result := (H2 <> 0) and (H3 <> 0) and (H4 <> 0);
end;
ارسال شده توسط قادر امیری فرد در مورخه شنبه ششم خرداد 1385 ساعت 23:34
[+]
|
|
|
Allways on top
|
|
اگر میخواهید فرم شما همیشه در بالای فرمهای دیگر باقی بماند و با باز کردن پنجره های جدید در بالای آنها قرار گیرد از کد زیر استفاده کنید.
SetWindowPos(MyFormHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE + SWP_NOACTIVATE)
ارسال شده توسط قادر امیری فرد در مورخه شنبه ششم خرداد 1385 ساعت 23:29
[+]
|
|
|
با این کد شما یک گزینه به منوی کلیک راست ویندوز در قسمت Caption فرم خود اضافه میکنید
|
|
unit sysmenu;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes,
Graphics, Controls, Forms, Dialogs, Menus;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
procedure WinMsgHandler(var Msg : TMsg; var Handled : Boolean);
end;
var
Form1: TForm1;
const
MyItem = 100;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := WinMsgHandler;
AppendMenu(GetSystemMenu(Self.Handle, False),
MF_SEPARATOR, 0, '');
AppendMenu(GetSystemMenu(Self.Handle, False),
MF_BYPOSITION, MyItem, ''گزینه شما');
end;
procedure TForm1.WinMsgHandler(var Msg : TMsg;
var Handled : Boolean);
begin
if Msg.Message=WM_SYSCOMMAND then
if Msg.wParam = MyItem then
اینجا باید کد خود را وارد نمایید که من اینجا یک پیغام را نمایش میدهم.
ShowMessage('شما گزینه جدید را انتخاب کرده اید.');
end;
end.
ارسال شده توسط قادر امیری فرد در مورخه پنجشنبه دهم فروردین 1385 ساعت 0:22
[+]
|
|
|
ایجاد منوی راست کلیک هر زمان که شما بخواهید(نه فقط زمانی که کلیک راست اتفاق بیفتد)
|
|
procedure TForm1.Button1Click(Sender: TObject);
var
hMenuHandle: hMENU;
hMenuItem: dWord;
p: TPoint;
begin
{recalculate button coordinates to screen coordinates}
p.X := Button1.Left;
p.Y := Button1.Top;
p := Button1.ClientToScreen(p);
hMenuHandle := GetSystemMenu(Handle, False);
hMenuItem := LongWord(Windows.TrackPopupMenu(hMenuHandle, TPM_LEFTBUTTON
or TPM_RIGHTBUTTON or TPM_RETURNCMD, p.X, p.Y, 0, Handle, nil));
if hMenuItem > 0 then
SendMessage(Handle, WM_SYSCOMMAND, hMenuItem, 0);
end;
ارسال شده توسط قادر امیری فرد در مورخه پنجشنبه دهم فروردین 1385 ساعت 0:21
[+]
|
|
|
تبدیل تاریخ میلادی به شمسی
|
|
برای تبدیل تاریخ میلادی به شمسی میتوانید از تابع زیر استفاده کنید.
function changedate():string;
const
shamsi:array[0..11] of Integer=(0,31,62,93,124,155,186,216,246,276,306,336);
miladi:array[0..11] of integer=(0,31,59,90,120,151,181,212,243,273,304,334);
miladicab:array[0..11] of integer=(0,31,60,91,121,152,182,213,244,274,305,335);
var
cabise:array[0..19] of integer;
ezafe,baghi,res,i,sals,salm,mahm,mahs,roozm,roozs,majrooz:integer;
boolcabisemi,boolcabisesh:boolean;
s,s1,s2:string;
begin
cabise[0]:=2000;
cabise[1]:=2004;
cabise[2]:=2008;
S:=DateToStr(date);
while Pos('/', S) > 0 do
S[Pos('/', S)] := '0';
salm:=(StrToInt64(s) div 1000000);
baghi:=strtoint64(s) mod 100000;
mahm:=baghi div 1000;
roozm:=(baghi mod 100);
ezafe:=0;
boolcabisemi:=false;
boolcabisesh:=false;
for i:=0 to 19 do
if salm=cabise[i] then
begin
boolcabisemi:=true;
break;
end;
if boolcabisemi then
begin
majrooz:=miladicab[mahm-1]+roozm;
res:=80-majrooz;
if res<=0 then
res:=-(res)
else res:=365-res;
for i:=11 downto 0 do
if res>=shamsi[i] then
begin
mahs:=i+1;
roozs:=res-shamsi[i];
break;
end;
end
else
begin
majrooz:=miladi[mahm-1]+roozm;
res:=80-majr ooz
if res<=0 then
res:=-(res)
else res:=365-res;
for i:=11 downto 0 do
if res>=shamsi[i] then
begin
mahs:=i+1;
roozs:=res-shamsi[i];
Break;
end;
end;
if 80-majrooz>=1 then
sals:=salm-622
else
sals:=salm-621;
i:=sals-1383;
if (i mod 4)=0 then
boolcabisesh:=true;
if (boolcabisemi) and (boolcabisesh) then
ezafe:=0
else
ezafe:=1;
if (boolcabisesh) then
ezafe:=ezafe+1;
if (boolcabisesh) and not(boolcabisemi) then
if roozs=29 then
begin
roozs:=-1;
mahs:=mahs+1;
end;
roozs:=roozs+ezafe;
if roozs<10 then
s1:='0'+IntToStr(roozs)
else
s1:=IntToStr(roozs);
if mahs<10 then
s2:='0'+IntToStr(mahs)
else
s2:=IntToStr(mahs);
s:=IntToStr(sals)+'/'+s2+'/'+s1;
changedate:=s;
end;
ارسال شده توسط قادر امیری فرد در مورخه چهارشنبه نهم آذر 1384 ساعت 23:27
[+]
|
|
|
وارد کردن فایلهای Wav. در فایلهای اجرایی(.EXE)
|
|
ابتدا یک فایل ساده FileName.RC با یک ویرایشگر متن مثل Notepad بسازید و این خط را به آن اضافه کنید:
۱ WAVE "MyWave.wav"
از RESOURCE COMPILER شرکت بورلند (BRCC۳۲.EXE) برای کامپایل کردن این فایل به یک فایل .RES استفاده کنید . برای این منظور در حط فرمان داس خط زیر را اجرا کنید :
BRCC۳۲ MyWav.rc
بدین ترتیب یک فایل با نام MyWav.rec ساخته خواهد شد.حال به کد برنامه خود این دستورات را اضافه کنید :
{$R *.DFM}
{$R MyWav.res}
وبا استفاده از روال زیر از آن در جای مورد نظر استفاده نمایید
procedure TForm۱.Button۱Click(Sender: TObject);
begin
PlaySound(pchar(۱),HInstance,SND_ASYNC or SND_MEMORY or SND_RESOURCE);
end;
توجه داشته باشید که برای استفاده از تابع بالا باید در قسنت uses برنامه خود mmsystem را اضافه کرده باشید.
ارسال شده توسط قادر امیری فرد در مورخه چهارشنبه نهم آذر 1384 ساعت 23:25
[+]
|
|
|
وارد نمودن یک فونت در فایل exe
|
|
از آنجایی که من در نوشتن برنامه های فارسی با مشکل فونت بسیار مواجه شدم تصمیم گرفتم که این کد برنامه را در اختیار شما هم قرار بدهم قبل از این مجبور بودیم که یا از فونت tahoma استفاده نماییم و یا اینکه فونتهای برنامه را همراه فایل exe در اختیار کاربر قرار بدهیم تا در پوشه fonts در محل فونتهای ویندوز کپی نماییم اما با کمک این روش میتوان فونت و یا فونتهای دلخواه را وارد خود برنامه exe نمود تا بدون اینکه نیاز به کپی کردن فونتها در سیستم کاربرباشد اجراگردد.
واما روش کار :
برای این کار باید ابتدا یک فایل با پسوند rc.* ایجاد نمایید این کار را میتوانید در محیط داس انجام دهید(نام و مسیر فایل run->cmd->copy con )
و آنرا با نام دلخواه ذخیره نمایید.(My File.rc)
سپس باید انرا باز کرده وخط زیر را در ان تایپ نمایید.
MY_FONT ANYOL۱ "Baush۹۳.ttf"
. نام فونت شما میباشد baush.ttf که
وبعد در محیط داس با استفاده از خط فرمان زیر فایل مزبور را کامپایل کنید:
brcc۳۲ My File.rc
فایل My File.res ایجاد خواهد شد.حال در برنامه خود خط زیر را اضافه نمایید:
{$R *.DFM}
{$R My File.res}
برای استفاده از فونت نیز باید کد زیر را به برنامه خود اضافه نمایید
procedure TForm1.FormCreate(Sender: TObject);
var
Res:TResourceStream;
begin
Res:=TResourceStream.Create(HInstance,'MY_FONT',pchar('ANYOL۱'));
Res.SaveToFile('Baush۹۳.ttf');
Res.Free;
AddFontResource(pchar('baush۹۳.ttf'));
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,۰,۰);
end;
برای استفاده از فونت مذبور نیز باید اینچنین عمل نمایید
Begin
Button۱.Font.Name:='Roya';
end;
توجه داشته باشید که نام فونت نام همان فونتی است که در resource برنامه وارد کرده اید.
فونت جدید نصب شده را با دستور زیر میتوانید حذف کنید:
procedure TForm۱.FormDestroy(Sender: TObject);
begin
RemoveFontResource(pchar('baush۹۳.ttf'));
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,۰,۰);
end;
ارسال شده توسط قادر امیری فرد در مورخه چهارشنبه نهم آذر 1384 ساعت 23:23
[+]
|
|
|
اهداف
|
|
با سلام این اولین جلسه آموزش نکاتی در مورد برنامه نویسی در دلفی میباشد.از آنجایی که من سایت و یا منبع کاملی برای دلفی ندیدم تصمیم گرفتم که این قسمت را در وبلاگ قرار دهم تا کسانی که با دلفی کار میکنند بتوانند از برنامه ها ونکات انشاا... مفیدی که ارائه خواهد شد استفاده نمایند و بتوانند با کمک این مقالات برنامه های کابردی بهتری بنویسند.اما این نوید را نیز به شما بدهم که فایلهای به درد بخور وجالبی را نیز برای دانلود در این قسمت قرار خواهم داد که به فرمهای شما جلوه های بسیار زیبایی میدهند وفرمهای شما را حرفی ای تر از قبل جلوه خواهند داد پس امیدوارم با ما همراه باشید
ارسال شده توسط قادر امیری فرد در مورخه سه شنبه هشتم آذر 1384 ساعت 23:8
[+]
|
|
|
