موضوع: نکات برنامه نویسی در دلفی ‏

پیدا کردن و بارگذاری Icon داخل فایل

کد:



uses
shellApi;

{...}

procedure TForm1.Button1Click(Sender: TObject);
const
ExtrFileName = 'C:\WINNT\system32\moricons.dll';
var
icon: TIcon;
NumberOfIcons, i: Integer;
begin
icon := TIcon.Create;
try
// Get the number of Icons
NumberOfIcons := ExtractIcon(Handle, PChar(ExtrFileName), UINT(-1));
ShowMessage(Format('%d Icons', [NumberOfIcons]));
// Extract the first 5 icons
for i := 1 to 5 do
begin
// Extract an icon
icon.Handle := ExtractIcon(Handle, PChar(ExtrFileName), i);
// Draw the icon on your form
DrawIcon(Form1.Canvas.Handle, 10, i * 40, icon.Handle);
end;
finally
icon.Free;
end;
end;

تابعی جهت بدست آوردن ولوم سریالِ دیسک
با این تابع می توانید ولوم سریالِ دیسک را بدست آوردید

کد:
Function GetDiscVolSerialID(cDriveName : char) WORD;
var
dwtemp1,dwtemp2 : DWORD;
begin
GetVolumeInformation(PChar(cDriveName + ':\'),Nil,0,@Result , dwtemp1 ,dwtemp2,Nil, 0);
end;

چگونه Edit فقط عدد بگیرد
تابعی که میشه اون رو در رویدادهای کیبورد برای Edit قرار داد تا فقط عدد بگیره

کد:
Function IsNum(ch : char) : char;
begin
if Pos(ch,#8#13'1234567890') = 0 then
ch := #0;
Result := ch;
end;

چگونه برنامه مان فقط یک نسخه اجرا شود
برای اینکه بعد از اجرای برنامه اگر کاربر روی آیکن برنامه کلیک کرد ، همزمان چند نسخه از اون اجرا نشه می تونیم فایل DPR پروژه رو بصورت زیر تغییر بدیم

کد:
uses
windows;
var
hmutex : THandle;
begin
hmutex := CreateMutex(nil,false,'OneCopyMutex');
if waitforsingleobject(hmutex, 0) <> wait_timeout then
begin
Application.Initialize;
.
.
.
Application.Run;
end;
end.

تغییر رزولوشن مانیتور


کد:
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;
این رو از وبلاگی برداشتم ولی چون قدیمی هست منبعش رو متاسفانه یادم نیست

در اکثر فرمهایی که برای دریافت اطلاعات از کاربر هستند ، معمولا دکمه ای داریم که برای پاک کردن فرم یا در حقیقت پاک کردن محتوای Edit ها بکار میره
میتونید کد زیر رو برای این دکمه قرار بدین تا لازم نباشه که برای هر فرم تک تک edit ها رو بنویسید
این کد به این صورت کار میکنه که روی فرم تمام Edit ها رو پیدا میکنه و اونها رو Clear می کنه
کد:
procedure clear_Edits;
var
cnt : integer;
begin
for cnt := 0 to ComponentCount - 1 do
begin
if Components[cnt].ClassName = 'TEdit' then
TEdit(Components[cnt]).Clear
end;
end;
حالا اگه توابعتون رو در یک کتابخونه نگهداری می کنید و اون Unit رو در فرمتون Use می کنید ، می تونید این تابع رو به شکل زیر تغییر بدین تا با فراخوانی از یک Unit دیگه هم بدرستی کار کنه

کد:
procedure clear_Edits;
var
cnt : integer;
begin
for cnt := 0 to Screen.ActiveForm.ComponentCount - 1 do
begin
if (Screen.ActiveForm.Components[cnt].ClassName = 'TEdit') then
TEdit(Screen.ActiveForm.Components[cnt]).Clear
end;
end

چک کردن خالی بودن یک مسیر

کد:
function DirectoryIsEmpty(Directory: string): Boolean;
var
SR: TSearchRec;
i: Integer;
begin
Result := False;
FindFirst(IncludeTrailingPathDelimiter(Directory) + '*', faAnyFile, SR);
for i := 1 to 2 do
if (SR.Name = '.') or (SR.Name = '..') then
Result := FindNext(SR) <> 0;
FindClose(SR);
end;

فایل مورد نظر باینری است یا نوشتاری ؟؟

کد:
function IsTextFile(const sFile: TFileName): boolean;
var
oIn: TFileStream;
iRead: Integer;
iMaxRead: Integer;
iData: Byte;
dummy:string;
begin
result:=true;
dummy :='';
oIn := TFileStream.Create(sFile, fmOpenRead or fmShareDenyNone);
try
iMaxRead := 1000; //only text the first 1000 bytes
if iMaxRead > oIn.Size then
iMaxRead := oIn.Size;
for iRead := 1 to iMaxRead do
begin
oIn.Read(iData, 1);
if (idata) > 127 then result:=false;
end;
finally
FreeAndNil(oIn);
end;
end;

چگونه فایلهای INI را نصب کنیم ؟

کد:
uses
ShellAPI;

function InstallINF(const PathName: string; hParent: HWND): Boolean;
var
instance: HINST;
begin
instance := ShellExecute(hParent,
PChar('open'),
PChar('rundll32.exe'),
PChar('setupapi,InstallHinfSection DefaultInstall 132 ' + PathName),
nil,
SW_HIDE);

Result := instance > 32;
end;

چگونه تعداد ایتمها ی ListBox را با API بدست اوریم ؟


کد:
function LB_GetItemCount(hListBox: THandle): Integer;
begin
Result := SendMessage(hListBox, LB_GETCOUNT, 0, 0);
end;

چگونه یک ایتم ListBox را با API حذف کنیم ؟

کد:
procedure LB_DeleteItem(hListBox: THandle; Index: Integer);
begin
SendMessage(hListBox, LB_DELETESTRING, Index, 0);
end;

چگونه ایتم انتخاب شده ی ListBox را توسط API بدست اوریم ؟

کد:
function LB_GetSelectedItem(hListBox: THandle): string;
var
Index, len: Integer;
s: string;
buffer: PChar;
begin
Index := SendMessage(hListBox, LB_GETCURSEL, 0, 0);
len := SendMessage(hListBox, LB_GETTEXTLEN, wParam(Index), 0);
GetMem(buffer, len + 1);
SendMessage(hListBox, LB_GETTEXT, wParam(Index), lParam(buffer));
SetString(s, buffer, len);
FreeMem(buffer);
Result := IntToStr(Index) + ' : ' + s;
end;

گرفتن ایتم یک ایتم ListBox توسط API

کد:
function LB_GetListBoxItem(hWnd: Hwnd; LbItem: Integer): string;
var
l: Integer;
buffer: PChar;
begin
l := SendMessage(hWnd, LB_GETTEXTLEN, LbItem, 0);
GetMem(buffer, l + 1);
SendMessage(hWnd, LB_GETTEXT, LbItem, Integer(buffer));
Result := StrPas(buffer);
FreeMem(buffer);
end;

بدست اوردن تمامی ایتم های یک ListBox توسط API

کد:
function LB_GetAllItems(hWnd: Hwnd; sl: TStrings): string;
var
RetBuffer: string;
i, x, y: Integer;
begin
x := SendMessage(hWnd, LB_GETCOUNT, 0, 0);
for i := 0 to x - 1 do
begin
y := SendMessage(hWnd, LB_GETTEXTLEN, i, 0);
SetLength(RetBuffer, y);
SendMessage(hWnd, LB_GETTEXT, i, lParam(PChar(RetBuffer)));
sl.Add(RetBuffer);
end;
end;

باز کردن یک پوشه توسط Windows Explorer

کد:
procedure ShowFolder(strFolder: string);
begin
ShellExecute(Application.Handle,
PChar('explore'),
PChar(strFolder),
nil,
nil,
SW_SHOWNORMAL);
end;

تغییر نام یک پوشه ....

کد:
uses
ShellApi;

procedure RenameDir(DirFrom, DirTo: string);
var
shellinfo: TSHFileOpStruct;
begin
with shellinfo do
begin
Wnd := 0;
wFunc := FO_RENAME;
pFrom := PChar(DirFrom);
pTo := PChar(DirTo);
fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or
FOF_SILENT or FOF_NOCONFIRMATION;
end;
SHFileOperation(shellinfo);
end;