Текущий архив: 2005.01.30;
Скачать: CL | DM;

Вниз

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

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


---

← →
DVM ©   (2004-12-08 12:18) [1]

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

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

---

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

Текущий архив: 2005.01.30;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.043 c