29-03-2010, 04:28 PM
إضافة إلى الكود رقم 28
55- كود تحويل Ico إلى Bmp
56- كود تحويل أو استخراج ICO من BMP
57- التحكم بحج الصورة :
* للإستدعاء :
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;