| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Icon на WinApi

ORMADA ©   (2004-12-08 08:46:00) 

Всем Доб! день!
Есть маленькая процедурка которая создаёт иконку с текущим днём недели и датой сделана с помощью модуля 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:00) [1]

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

---

Наверх