+- Parsi Coders (http://parsicoders.com)
+-- انجمن: Software Development Programming (http://parsicoders.com/forumdisplay.php?fid=37)
+--- انجمن: Pascal/Delphi (http://parsicoders.com/forumdisplay.php?fid=45)
+---- انجمن: Delphi (http://parsicoders.com/forumdisplay.php?fid=69)
+---- موضوع: (کدها ومثالها و ترفندهای دلفی) (/showthread.php?tid=407)
(کدها ومثالها و ترفندهای دلفی) - Amin_Mansouri - 06-18-2011
نوشتن یک لیبل بصورت مورب
![[عکس: 1448682-14c]](http://www.divshare.com/img/1448682-14c)
کد:
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;نوشتن کپشن یک دکمه در چند سطر
![[عکس: 1448800-516]](http://www.divshare.com/img/1448800-516)
کد:
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Button1.Handle,GWL_STYLE,GetWindowLong(Button1.Handle,GWL_STYLE) OR BS_MULTILINE);
end;کد:
procedure TForm1.Button1Click(Sender: TObject);
var
hn : HWND;
begin
hn:= FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd',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;![[عکس: 1448749-87e]](http://www.divshare.com/img/1448749-87e)
کد:
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;RE: (کدها ومثالها و ترفندهای دلفی) - Amin_Mansouri - 06-18-2011
ساختن فرمی برای اتصال به اینترنت با نوشتن نام کاربری و کلمه عبور و شماره تلفن
![[عکس: 1448753-9f0]](http://www.divshare.com/img/1448753-9f0)
کد:
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_SHOWMINNOACTIVE);
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_SHOWMINNOACTIVE);
end;تغییر رنگ سطرهای یک جدول (StringGrid)
![[عکس: 1448769-72e]](http://www.divshare.com/img/1448769-72e)
یک 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;برش یک فرم و تبدیل آن به دو فرم
![[عکس: 1448773-6d7]](http://www.divshare.com/img/1448773-6d7)
کد:
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;اگر مقدار ورودی تابع True باشد غیرفعال شده ولی اگر مقدار ورودی False باشد دوباره فعال خواهد شد.
کد:
Procedure DisableTaskManager(Const State:Boolean);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\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;