رفتن به مطلب

(کدها ومثالها و ترفندهای دلفی)

امتیاز دادن به این موضوع:


king75
 اشتراک گذاری

براي جلوگیری از تکراری شدن تاپیک ها قبل از ارسال از قسمت جستجوی سایت استفاده کنید. تاپیک های تکراری حذف خواهند شد.

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

ارسال های توصیه شده

نوشتن یک لیبل بصورت مورب

procedure TForm1.Button1Click(Sender: TObject);

begin

AngleTextOut(Form1.Canvas,12,10,65,'Advanced Delphi Technicals !!');

end;

procedure AngleTextOut(ACanvas: TCanvas;Angle,X,Y: Integer;Str: string);

var

LogRec : TLogFont;

OldFontHandle,NewFontHandle :HFONT;

begin

GetObject(ACanvas.Font.Handle,SizeOf(LogRec),Addr( LogRec));

LogRec.lfEscapement := Angle * 10;

NewFontHandle := CreateFontIndirect(LogRec);

OldFontHandle := SelectObject(ACanvas.Handle,NewFontHandle);

ACanvas.TextOut(X,Y,str);

NewFontHandle := SelectObject(ACanvas.Handle,OldFontHandle);

DeleteObject(NewFontHandle);

end;

نوشتن کپشن یک دکمه در چند سطر

procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowLong(Button1.Handle,GWL_STYLE,GetWindowLo ng(Button1.Handle,GWL_STYLE) OR BS_MULTILINE);

end;

مخفی کردن و نمایش مجدد ساعت ویندوز

procedure TForm1.Button1Click(Sender: TObject);

var

hn : HWND;

begin

hn:= FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWn d',nil),0,

'TrayNotifyWnd',nil),0,'TrayClockWClass',nil);

if hn <> 0 then

ShowWindow(hn,SW_HIDE);

end;

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

ShowWindow(hn,SW_SHOW);

نمایش تمامی اطلاعات مربوط به حافظه اصلی کامپیوتر (RAM)

یک Memo و یک دکمه روی فرم قرار داده و کد زیر را برای دکمه بنویسید:

procedure TForm1.Button1Click(Sender: TObject);

var

MemorysStatus: TMemoryStatus;

begin

Memo1.Lines.Clear;

MemorysStatus.dwLength := SizeOf(MemorysStatus);

GlobalMemoryStatus(MemorysStatus);

with MemorysStatus do

begin

Memo1.Lines.Add(IntToStr(dwLength) + ' Size of Memory Status record');

Memo1.Lines.Add(IntToStr(dwMemoryLoad) + '% Memory in use');

Memo1.Lines.Add(IntToStr(dwTotalPhys) + ' Total Physical Memory in Bytes');

Memo1.Lines.Add(IntToStr(dwAvailPhys) + ' Available Physical Memory in Bytes');

Memo1.Lines.Add(IntToStr(dwTotalPageFile) + ' Total Bytes of Paging File');

Memo1.Lines.Add(IntToStr(dwAvailPageFile) + ' Available Bytes in Paging File');

Memo1.Lines.Add(IntToStr(dwTotalVirtual) + ' User Bytes of Address Space');

Memo1.Lines.Add(IntToStr(dwAvailVirtual) + ' Available User Bytes of Address Space');

end;

end;

غیرفعال کردن دکمه خروج فرم (Exit)

procedure TForm1.FormCreate(Sender: TObject);

var

hwndHandle : THANDLE;

hMenuHandle : HMENU;

iPos : Integer;

begin

hwndHandle := FindWindow(nil,PChar(Caption));

if (hwndHandle <> 0) then

begin

hMenuHandle := GetSystemMenu(hwndHandle,false);

if (hMenuHandle <> 0 ) then

begin

DeleteMenu(hMenuHandle,SC_CLOSE,MF_BYCOMMAND);

iPos := GetMenuItemCount(hMenuHandle);

Dec(iPos);

if iPos > -1 then

DeleteMenu(hwndHandle,iPos,MF_BYPOSITION);

end;

end;

End;

ساختن فرمی برای اتصال به اینترنت با نوشتن نام کاربری و کلمه عبور و شماره تلفن

procedure TForm1.Connect_ButtonClick(Sender: TObject);

var

cmd,par,fil,dir : PChar;

begin

cmd := 'Open';

fil := 'rasdial.exe';

par := PChar(EditEntry.Text + ' ' + EditUser.Text + ' ' +

EditPass.Text + ' /PHONE:' + EditPhone.Text + ' /PHONEBOOK:c:\test.pbk');

dir := 'C:';

ShellExecute(Self.Handle,cmd,fil,par,dir,SW_SHOWMI NNOACTIVE);

end;

procedure TForm1.DisConnect_ButtonClick(Sender: TObject);

var

cmd,par,fil,dir : PChar;

begin

cmd := 'Open';

fil := 'rasdial.exe';

par := PChar(EditEntry.Text + ' /DISCONNECT');

dir := 'C:';

ShellExecute(Self.Handle,cmd,fil,par,dir,SW_SHOWMI NNOACTIVE);

end;

تغییر رنگ سطرهای یک جدول (StringGrid)

یک StringGrid بر روی فرم گذاشته و در DrawCell آن کد زیر را بنویسید:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

var

dx : Integer;

begin

with (Sender as TStringGrid) do

begin

if(ACol = 0) or (ARow = 0) then

Canvas.Brush.Color := clBtnFace

else

begin

case ARow of

1: Canvas.Font.Color := clGreen;

2: Canvas.Font.Color := clRed;

end;

if ARow mod 2 = 0 then

Canvas.Brush.Color := $00E1FFF9

else

Canvas.Brush.Color := $00FFEBDF;

Canvas.TextRect(Rect,Rect.Left + 2,Rect.Top + 2,Cells[ACol,ARow]);

Canvas.FrameRect(Rect);

end;

end;

end;

برش یک فرم و تبدیل آن به دو فرم

var

Pts: array [1..9] of TPoint;

procedure TForm1.Button2Click(Sender: TObject);

var

I: integer;

hRegion: THandle;

begin

InitSize := Width;

Pts [1] := Point (0, 0);

Pts [2] := Point (Width div 2, 0);

Pts [3] := Point (Width div 2, Height);

Pts [8] := Point (0, Height);

Pts [9] := Point (0, 0);

for i := 0 to 100 do

begin

Left := Left - 1;

Width := Width + 2;

Pts [4] := Point (Width - InitSize div 2, Height);

Pts [5] := Point (Width - InitSize div 2, 0);

Pts [6] := Point (Width, 0);

pts [7] := Point (Width, Height);

HRegion := CreatePolygonRgn (Pts, 9, alternate);

SetWindowRgn (Handle, HRegion, True);

Application.ProcessMessages;

end;

end;

غیر فعال کردن TaskManager

اگر مقدار ورودی تابع True باشد غیرفعال شده ولی اگر مقدار ورودی False باشد دوباره فعال خواهد شد.

Procedure DisableTaskManager(ConstState:Boolean);

var

Reg: TRegistry;

begin

Reg := TRegistry.Create;

try

Reg.RootKey := HKEY_CURRENT_USER;

if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVe rsion\Policies\System',

True)

then Reg.WriteInteger('DisableTaskMgr',Integer(State)); //typecast the boolean to convert it to 1 or 0

finally

Reg.CloseKey;

Reg.Free;

end;

end;

ایجاد اشیا به شکلهای دلخواه

Procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowRgn(Edit1.Handle,CreateRoundRectRgn(2,2,E dit1.Width - 2,

Edit1.Height - 2,15,15),True);

SetWindowRgn(Button1.Handle,CreateRoundRectRgn(2,2 ,Button1.Width - 2,

Button1.Height - 2,15,15),True);

SetWindowRgn(Panel1.Handle,CreateRoundRectRgn(2,2, Panel1.Width - 2,

Panel1.Height - 2,15,15),True);

SetWindowRgn(ComboBox1.Handle,CreateRoundRectRgn(2 ,2,ComboBox1.Width - 2,

ComboBox1.Height - 2,15,15),True);

SetWindowRgn(Memo1.Handle,CreateRoundRectRgn(2,2,M emo1.Width - 2,

Memo1.Height - 2,15,15),True);

SetWindowRgn(ProgressBar1.Handle,CreateRoundRectRg n(2,2,ProgressBar1.Width - 2,

ProgressBar1.Height - 2,15,15),True);

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;

لینک به دیدگاه
به اشتراک گذاری در سایت های دیگر

  • پاسخ 0
  • ایجاد شد
  • آخرین پاسخ

بهترین ارسال کنندگان این موضوع

روزهای محبوب

بهترین ارسال کنندگان این موضوع

در تاپیک ها، اگر سوال يا نظر خاصي نداريد لطفا فقط از دکمه می پسندم و ... استفاده کنيد. نظراتي مانند مرسی، خوب بود، ممنون و ... شامل اسپم هستند و باعث کاهش کيفيت پست ها مي شوند.

بالا آوردن تاپیک ها و پست ها قبل از 48 ساعت ممنوع است و موجب حذف آنها خواهد شد.

این موضوع کاملا قدیمی است. لطفا به جای بروز کردن این موضوع در نظر شروع یک موضوع جدید باشید مگر این که لازم به بروز رسانی این موضوع باشید.

به گفتگو بپیوندید

هم اکنون می توانید مطلب خود را ارسال نمایید و بعداً ثبت نام کنید. اگر حساب کاربری دارید، برای ارسال با حساب کاربری خود اکنون وارد شوید .

مهمان
ارسال پاسخ به این موضوع ...

×   شما در حال چسباندن محتوایی با قالب بندی هستید.   حذف قالب بندی

  تنها استفاده از 75 اموجی مجاز می باشد.

×   لینک شما به صورت اتوماتیک جای گذاری شد.   نمایش به صورت لینک

×   محتوای قبلی شما بازگردانی شد.   پاک کردن محتوای ویرایشگر

×   شما مستقیما نمی توانید تصویر خود را قرار دهید. یا آن را اینجا بارگذاری کنید یا از یک URL قرار دهید.

 اشتراک گذاری

×
×
  • اضافه کردن...