All Products are reserved for me !!!

http://delphilover.50megs.com

کدهای مخصوص دلفی

خاموش کردن مانيتور:

 SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0)

روشن کردن مانيتور:

 SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, - 1)

مخفی کردن ماوس در فرم

 procedure TForm1.Button1Click(Sender: TObject);

 begin

  ShowCursor(False);  // Hide mouse

 end;

 procedure TForm1.Button2Click(Sender: TObject);

 begin

  ShowCursor(True);  // Show mouse

 end;

به دست آوردن مختصات ماوس در صفحه نمایش:

 Label1.caption:=Mouse.cursorpos.x +' - ' + Mouse.cursorpos.y ;

تغییر مختصات ماوس:

 SetCursorPos(600,200) ;

جابجا کردن فرم با Drag&Drop  ماوس :

 type

  procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);

 :

 :

 procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
  Const

  SC_DragMove = $f016;

 begin

 ReleaseCapture;

 Name.Perform(WM_SysCommand , SC_DragMove,0);

 end;

 باز کردن فایل اجرایی از برنامه :

 uses: shellapi


 shellexecute(handle,'open','d:\myproject.exe',nil,nil,sw_show);

با استفاده از اين تابع شما مي توانيد كه آيكون هاي برنامه ها را استخراج كنيد در ضمن عدد آخر شماره آن آيكون مي باشد .

 Uses Shellapi;

 Form1.Icon.Handle:=ExtractIcon(0,'C:\winxpexplorer.exe',0);

خروج سي دي رام:

 Uses MMSystem;

 mcisendstring('Set cdaudio door open wait',nil,0,handle);

 براي ورود :

 mcisendstring('Set cdaudio door closed wait',nil,0,handle);

 دایره ای کردن فرم :

 var
 H : Thandle;
 Begin
 H := CreateEllipticRgn(50, 50, 500, 200);
 SetWindowRgn(Handle,H,True);

 سایه دار کردن فرم   

private
Procedure CreateParams(Var Params: TCreateParams); override;



procedure Tform1.CreateParams(var Params: TCreateParams);
begin
inherited;
if CheckWin32Version(5, 1) then
Params.WindowClass.Style := Params.WindowClass.style or CS_DROPSHADOW;
end;

چرخاندن تصویر

Const PixelMax = 32768;
Type
pPixelArray = ^TPixelArray;
TPixelArray = Array[0..PixelMax-1] Of TRGBTriple;

Procedure RotateBitmap_ads(
SourceBitmap : TBitmap;
out DestBitmap : TBitmap;
Center : TPoint;
Angle : Double) ;
Var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
Radians : Double;
RotatedRow : pPixelArray;
sinRadians : Double;
begin
DestBitmap.Width := SourceBitmap.Width;
DestBitmap.Height := SourceBitmap.Height;
DestBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
sinRadians := Sin(Radians) ;
cosRadians := Cos(Radians) ;
For inX := DestBitmap.Height-1 Downto 0 Do
Begin
RotatedRow := DestBitmap.Scanline[inX];
inXPrime := 2*(inX - Center.y) + 1;
For inY := DestBitmap.Width-1 Downto 0 Do
Begin
inYPrime := 2*(inY - Center.x) + 1;
inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians) ;
inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians) ;
inYOriginal := (inYPrimeRotated - 1) Div 2 + Center.x;
inXOriginal := (inXPrimeRotated - 1) Div 2 + Center.y;
If
(inYOriginal >= 0) And
(inYOriginal <= SourceBitmap.Width-1) And
(inXOriginal >= 0) And
(inXOriginal <= SourceBitmap.Height-1)
Then
Begin
OriginalRow := SourceBitmap.Scanline[inXOriginal];
RotatedRow[inY] := OriginalRow[inYOriginal]
End
Else
Begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
End;
End;
End;
End;

{Usage:}
procedure TForm1.Button1Click(Sender: TObject) ;
Var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
Try
Center.y := (Image.Height div 2)+20;
Center.x := (Image.Width div 2)+0;
RotateBitmap_ads(
Image.Picture.Bitmap,
Bitmap,
Center,
Angle) ;
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap) ;
Finally
Bitmap.Free;
End;
end;

نقاشی روی دسک تاپ

type
TDesktopCanvas = class(TCanvas)
private
DC : hDC;
function GetWidth:Integer;
function GetHeight:Integer;
public
constructor Create;
destructor Destroy; override;
published
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
end;

{ TDesktopCanvas object }
function TDesktopCanvas.GetWidth:Integer;
begin
Result:=GetDeviceCaps(Handle,HORZRES) ;
end;

function TDesktopCanvas.GetHeight:Integer;
begin
Result:=GetDeviceCaps(Handle,VERTRES) ;
end;

constructor TDesktopCanvas.Create;
begin
inherited Create;
DC := GetDC(0) ;
Handle := DC;
end;

destructor TDesktopCanvas.Destroy;
begin
Handle := 0;
ReleaseDC(0, DC) ;
inherited Destroy;
end;

شمار این ترفندها روز به روز افزایش می یابد .