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

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

Icon на WinApi [D7, Win2k]

ORMADA ©   (2004-12-08 08:52: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;


---

DVM   (2004-12-08 12:18:00) [1]

> можно ли этот кусок как нить перевести в выньапи чтоб выкинуть
> Graphics ?

Можно. Ответ смотри в модуле Graphics.

---

Наверх