PDA

View Full Version : آموزش: آموزش تبدیل Bitmap به Cursor (نشانگر موس) در دلفی



صابر طهماسبی
چهارشنبه 08 اردیبهشت 1389, 13:32 عصر
نشانگر موس در دلفی با Cursors و Cursor که هردو از خواص شی Screen هستند کنترل می شود.
برای هر کنترل در دلفی(کنترل های قابل نمایش مانند TButton و Tedit) می توان نشانگر موس جداگانه ای تعریف کرد.
برنامه نویس می تواند با استفاده از نشانگرهای از قبل تعریف شده که توسط TScreen تولید شده اند نشانگر موس را تغییر دهد.

فرض کنید یک فایل BMP دارید و می خواهید آن را به عنوان نشانگر موس در برنامه مورد استفاده قرار دهید همانطور که می دانید پسوند فایل نشانگر باید ani یا cur باشد اما در دلفی می توان یک شی نشانگر سفارشی را با استفاده از فایل bmp ساخت روال این کار به شکل زیر است:
1. فراخوانی تابع API ویندوز به نام CreateIconIndirect برای افزودن به ویژگی Screen.Cursors
2. تابع CreateIconIndirect یک نشانگر یا یک آیکن را از یک رکورد به نام TIconInfo می سازد.
3 . TIconInfoبرای ساخت نشانگر نیاز به دو تصویر Bmp دارد، یک تصویر برای شکل نشانگر و دیگری برای ماسک mask کردن آن.
4. استفاده از کلاس TBitmap دلفی برای لود کردن فایل bmp (هردو یا یکی از آنها) و مقدار دهی رکورد TIconInfo
5. در پایان وقتی که نشانگر ساخته شده را به کار رفت با استفاده از تابع مخرب حافظه ی تخصیص یافته به آن را آزاد می کنیم.

مراحل عملی کار :
یک TButton روی فرم قرار دهید:
(توجه کنید Circle.BMP و CircleMask.BMP دو فایل Bitmap هستند که برای ساخت نشانگر به کار می روند)
(می توانید از اینجا این پروژه را به صورت کامل دانلود کنید (http://delphi.about.com/library/weekly/code/bmp2cur.zip))

کد پروژه :


interface

const
crMyCursor = 1;
var
iconInfo : TIconInfo;

implementation

procedure TForm1.Button1Click(Sender: TObject) ;
var
bmpMask : TBitmap;
bmpColor : TBitmap;
begin
bmpMask := TBitmap.Create;
bmpColor := TBitmap.Create;

bmpMask.LoadFromFile('CircleMask.bmp') ;
bmpColor.LoadFromFile('Circle.bmp') ;

with iconInfo do
begin
fIcon := false;
xHotspot := 15;
yHotspot := 15;
hbmMask := bmpMask.Handle;
hbmColor := bmpColor.Handle;
end;

Screen.Cursors[crMyCursor] := CreateIconIndirect(iconInfo) ;

Screen.Cursor := crMyCursor;

bmpMask.Free;
bmpColor.Free;
end;

procedure TForm1.FormDestroy(Sender: TObject) ;
begin
DestroyIcon(Screen.Cursors[crMyCursor]) ;
end;


منبع : delphi.about