Форум: "Основная";
Текущий архив: 2004.12.26;
Скачать: [xml.tar.bz2];

Вниз

Icon на WinApi   Найти похожие ветки 

← →
ORMADA ©   (2004-12-08 08:46) [0]

Всем Доб! день!
Есть маленькая процедурка которая создаёт иконку с текущим днём недели и датой сделана с помощью модуля Graphics
всё остальное на ВыньАпи
можно ли этот кусок как нить перевести в выньапи чтоб выкинуть Graphics ?

function CreateIcon: TIcon;

 function GetDayCountInMonth(const AValue: TDateTime): Word;
 var
   LYear, LMonth: Word;
 begin
   DecodeDate(AValue, LYear, LMonth, Result);
 end;

var
 IconSizeX: integer;
 IconSizeY: integer;
 AndMask: TBitmap;
 XOrMask: TBitmap;
 IconInfo: TIconInfo;
 Icon: TIcon;
 Day: string[2];
begin
 IconSizeX := 16;
 IconSizeY := 16;

 AndMask := TBitmap.Create;
 try

   AndMask.Monochrome := true;
   AndMask.Width := IconSizeX;
   AndMask.Height := IconSizeY;

   AndMask.Canvas.Brush.Color := clBlack;
   AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));

   XOrMask := TBitmap.Create;
   try

     XOrMask.Width := IconSizeX;
     XOrMask.Height := IconSizeY;

     XOrMask.Handle := LoadBitmap(HInstance, PAnsiChar("DOFW" + IntToStr(DayOfWeek(Now))));
     XOrMask.Canvas.Font.Name := "Arial";
     XOrMask.Canvas.Font.Color := clWhite;
     XOrMask.Canvas.Font.Style := [fsbold];
     XOrMask.Canvas.Font.Size := 8;

     XOrMask.Canvas.Brush.Style := bsClear;
     Day := IntToStr(GetDayCountInMonth(Now));
     if Length(Day) = 1 then Day := "0" + Day;

     XOrMask.Canvas.TextOut(2, -2, Day);

     Icon := TIcon.Create;
     try

       IconInfo.fIcon := True;
       IconInfo.xHotspot := 0;
       IconInfo.yHotspot := 0;

       IconInfo.hbmMask := AndMask.Handle;
       IconInfo.hbmColor := XOrMask.Handle;

       Icon.Handle := CreateIconIndirect(IconInfo);

       Result := TIcon.Create;
       Result.Assign(Icon);
     finally
       Icon.Free;
     end;

   finally
     XOrMask.Free;
   end;

 finally
   AndMask.Free;
 end;
end;


---

← →
ORMADA ©   (2004-12-08 08:52) [1]

звиняйте наверна не туда написал

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.12.26;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.037 c