Текущий архив: 2006.04.02;
Скачать: CL | DM;
Вниз
Как на Winapi программно нарисовать иконку и получить ее в виде hicon Найти похожие ветки
← →
Alexx2000 (2006-01-13 01:34) [0]А если точнее необходимо 2 символа перевести в иконку.
← →
Rouse_ © (2006-01-13 10:18) [1]Отрисовать что нужно на HBITMAP и сделать CreateIconIndirect
← →
Alexx2000 (2006-01-13 20:22) [2]Как раз это у меня не получаеться, уже замучался. Пожалуйста, если можешь приведи пример кода.
← →
Fay © (2006-01-13 20:30) [3]2 Alexx2000 (13.01.06 20:22) [2]
Напиши, как не получается
← →
Alexx2000 (2006-01-14 18:31) [4]Скажу сразу я не специалист по программированию на WinApi, вот нашел на каком - то форуме пример и немного изменил под себя. Одноко он выводит иконку залитую белым цветом.
function DrawIcon(width, height: integer): HICON;
var
ii: ICONINFO;
hScreenDC,
hIconDC,
hMaskDC: HDC;
hOldIconDC,
hOldMaskDC: HGDIOBJ;
r: TRECT;
hIconX: HICON;
begin
ii.fIcon:= TRUE;
hScreenDC:= GetDC(0);
hIconDC:= CreateCompatibleDC(hScreenDC);
hMaskDC:= CreateCompatibleDC(hScreenDC);
ii.xHotspot:= 0;
ii.yHotspot:= 0;
ii.hbmColor:= CreateCompatibleBitmap(hScreenDC,width,height);
ii.hbmMask:= CreateCompatibleBitmap(hMaskDC,width,height);
ReleaseDC(0,hScreenDC);
hOldIconDC:= SelectObject(hIconDC,ii.hbmColor);
hOldMaskDC:= SelectObject(hMaskDC,ii.hbmMask);
BitBlt(hIconDC,0,0,width,height,0,0,0,WHITENESS);
BitBlt(hMaskDC,0,0,width,height,0,0,0,BLACKNESS);
//НАЧАЛО РИСОВАНИЯ
r.Left:= 1;
r.Right:= 1;
r.Top:= 1;
r.Bottom:= 1;
SetTextColor(hIconDC,$0000FF00);
DrawText(hIconDC,"R1",2,r,0);
//КОНЕЦ РИСОВАНИЯ
SelectObject(hIconDC,hOldIconDC);
SelectObject(hMaskDC,hOldMaskDC);
hIconX:= CreateIconIndirect(ii);
//Cleanup
DeleteObject(ii.hbmColor);
DeleteObject(ii.hbmMask);
DeleteDC(hMaskDC);
DeleteDC(hIconDC);
Result:= hIconX;
end;
← →
Eraser © (2006-01-14 19:36) [5]
> Alexx2000 (14.01.06 18:31) [4]
читай [1].
← →
Alexx2000 (2006-01-15 18:01) [6]Иконку создать получилось. Но почему она черно - белая?
← →
Zeqfreed © (2006-01-15 18:05) [7]Alexx2000 (15.01.06 18:01) [6]
Замени единичку на нулик в семнадцатой строке.
← →
Eraser © (2006-01-15 18:45) [8]
> Alexx2000 (15.01.06 18:01) [6]
>
> Иконку создать получилось. Но почему она черно - белая?
Прорисовывать на битмапе надо!
← →
Rouse_ © (2006-01-15 18:54) [9]Мдя... заставил таки ты меня сесть в выходные за Дельфю :) Лови...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TDoubleChar = String[2];
function CreateIconFromChar(const Value: TDoubleChar): HICON;
var
DC: HDC;
IcoInfo : TIconInfo;
Bitmap, BitMask: HBitmap;
Brush: HBrush;
BitCount: Integer;
BitmapRect: TRect;
begin
Result := 0;
DC := CreateCompatibleDC(0);
if DC = 0 then RaiseLastOSError;
try
BitCount := GetDeviceCaps(DC, BITSPIXEL);
Bitmap := CreateBitmap(16, 16, 2, BitCount div 2, nil);
if Bitmap = 0 then RaiseLastOSError;
try
BitMask := CreateBitmap(16, 16, 1, 1, nil);
if BitMask = 0 then RaiseLastOSError;
try
SelectObject(DC, Bitmap);
Brush := CreateSolidBrush($FFFFFF);
if Brush = 0 then RaiseLastOSError;
try
with BitmapRect do
begin
Left := 0;
Right := 16;
Top := 0;
Bottom := 16;
end;
FillRect(DC, BitmapRect, Brush);
finally
DeleteObject(Brush);
end;
TextOut(DC, 0, 0, PChar(String(Value)), Length(Value));
ZeroMemory(@IcoInfo, SizeOf(TIconInfo));
IcoInfo.hbmMask := BitMask;
IcoInfo.hbmColor := Bitmap;
Result := CreateIconIndirect(IcoInfo);
finally
DeleteObject(BitMask);
end;
finally
DeleteObject(Bitmap);
end;
finally
DeleteDC(DC);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Icon.Handle := CreateIconFromChar("AB");
end;
end.
← →
Alexx2000 (2006-01-15 19:54) [10]Все заработало. Всем спасибо, особо благодарен Rouse_
за его пример (Надеюсь тебя это не сильно затруднило).
← →
Rouse_ © (2006-01-15 20:44) [11]
> Надеюсь тебя это не сильно затруднило
Да все пучком, пришлось просто за пивом сбегать :) Шутка :)
← →
ss2 (2006-01-16 22:09) [12]procedure TForm1.Timer1Timer(Sender: TObject);
var
bi:TBitmap;
ic:TIcon;
iml:TImageList;
s:String;
begin
Caption:=FormatDateTime("c",Now);
s:=Caption[18]+Caption[19];
bi:=TBitmap.Create;
ic:=TIcon.Create;
bi.Height:=16;
bi.Width:=16;
bi.Canvas.Brush.Color:=clFuchsia;
bi.Canvas.FillRect(Rect(0,0,16,16));
bi.Canvas.Font.Style:=[fsBold];
bi.Canvas.Font.Name:="MS Sans Serif";
bi.Canvas.Font.Color:=clWhite;
bi.Canvas.TextOut(-1,2,s);
iml:=TImageList.Create(Self);
iml.AddMasked(bi,clFuchsia);
iml.GetIcon(0,ic);
Icon.Handle :=Ic.Handle;
bi.Free;
iml.Free;
ic.Free;
end;
Попробуй вот это.
Страницы: 1 вся ветка
Текущий архив: 2006.04.02;
Скачать: CL | DM;
Память: 0.48 MB
Время: 0.039 c
