+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : دروس دلفي للمبتدئين (https://delphi4arab.net/forum/forumdisplay.php?fid=13)
+--- الموضوع : مرجع المبتدإ (مجموعة من الأكواد) (/showthread.php?tid=1192)
الصفحات:
1
2
مرجع المبتدإ (مجموعة من الأكواد) - nabilkeb - 29-03-2010
إضافة إلى الكود رقم 28
55- كود تحويل Ico إلى Bmp
كود :
procedure TForm1.Button1Click(Sender: TObject);
var Icon : TIcon;
Bitmap : TBitmap;
begin
if OpenDialog1.Execute then begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile(OpenDialog1.FileName);
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon);
Bitmap.SaveToFile('c:\picture.bmp');
Icon.Free;
Bitmap.Free;
end;
end;كود :
procedure TForm1.Button1Click(Sender: TObject);
var
IconSizeX: integer;
IconSizeY: integer;
XOrMask: TBitmap;
IconInfo: TIconInfo;
Icon: TIcon;
begin
IconSizeX := GetSystemMetrics(SM_CXICON);
IconSizeY := GetSystemMetrics(SM_CYICON);
XOrMask := TBitmap.Create;
XOrMask.Width := IconSizeX;
XOrMask.Height := IconSizeY;
XOrMask.LoadFromFile('C:\picture.bmp');{}
Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask);
{Create a icon}
Icon := TIcon.Create;
IconInfo.fIcon := true;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := XOrMask.Handle;
IconInfo.hbmColor := XOrMask.Handle;
Icon.Handle := CreateIconIndirect(IconInfo);
{Destroy the temporary bitmaps}
// AndMask.Free;
XOrMask.Free;
{Draw as a test}
Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon);
{Assign the application icon}
Application.Icon := Icon;
{Force a repaint}
InvalidateRect(Application.Handle, nil, true);
{Free the icon}
Icon.Free;
end;كود :
function ResizeBmp(bitmp: TBitmap; wid, hei: Integer): Boolean;
var
TmpBmp: TBitmap;
ARect: TRect;
begin
Result := False;
try
TmpBmp := TBitmap.Create;
try
TmpBmp.Width := wid;
TmpBmp.Height := hei;
ARect := Rect(0,0, wid, hei);
TmpBmp.Canvas.StretchDraw(ARect, Bitmp);
bitmp.Assign(TmpBmp);
finally
TmpBmp.Free;
end;
Result := True;
except
Result := False;
end;
end;كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
ResizeBmp(Image1.Picture.Bitmap,70,70)
end;مرجع المبتدإ (مجموعة من الأكواد) - izd2010 - 22-05-2010
والله انك تستحق كل شكر
مرجع المبتدإ (مجموعة من الأكواد) - nt-SS - 10-01-2011
عندي ملاحظة:
في الكود 30 (إخفاء سطح المكتب)
1-نسيت الإعلان عن المتغير DID من نوع HWND
كود :
var DID:HWND;كود :
end;مشكور nabilkeb مرجع رائع جداً, تحياتي لك
مرجع المبتدإ (مجموعة من الأكواد) - nabilkeb - 02-03-2011
العفو إخواني
بالتوفيق للجميع
RE: مرجع المبتدإ (مجموعة من الأكواد) - YouDel - 16-03-2025
جازاك الله خير.