Не могу создать иконку с прозрачностью

← →
BOGDAN (2006-04-30 17:51) [0]

Помогите, плииз!!!

Не могу создать иконку с прозрачностью
С использованием модуля Graphics все тип-топ, но мы же не идем легкими путями, и я решил сделать все на винапи, и вот что полусилось:
То-ли монохромный витмап не удается сделать то ли монохромный витмап все же создается но рисовать на нем невозможно.
Помогите Мастера

//Mainform.pas
unit mainform;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Graphics;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CreateIconWithWinAPI: HICON;
var
BitmapDC,MaskDC: HDC;
IcoInfo : TIconInfo;
Bitmap, Mask: HBitmap;
Brush: HBrush;
Pen: HPen;
BitmapRect: TRect;
begin
BitmapDC := CreateCompatibleDC(GetDC(0));
MaskDC := CreateCompatibleDC(GetDC(0));
Bitmap := CreateCompatibleBitmap(GetDC(0),32,32);
Mask := CreateBitmap(32,32,1,1,0);
// Mask := CreateCompatibleBitmap(GetDC(0),32,32);
with BitmapRect do
begin
Left := 0;
Right := 32;
Top := 0;
Bottom := 32;
end;
SelectObject(MaskDC, Mask);
Brush := CreateSolidBrush(rgb(255,255,255));
FillRect(MaskDC, BitmapRect, Brush);
DeleteObject(Brush);
Brush := CreateSolidBrush(rgb(0,0,0));
Pen := CreatePen(PS_SOLID,1,rgb(0,0,0));
SelectObject(MaskDC, Pen);
SelectObject(MaskDC, Brush);
Ellipse(MaskDC,4,4,28,28);
DeleteObject(Brush);
DeleteObject(Pen);
// BitBLT(form1.Canvas.Handle,30,33,32,32,MaskDC,0,0,SRCCOPY);
SelectObject(BitmapDC, Bitmap);
Brush := CreateSolidBrush(rgb(0,0,0));
FillRect(BitmapDC, BitmapRect, Brush);
DeleteObject(Brush);
Brush := CreateSolidBrush(rgb(255,0,0));
Pen := CreatePen(PS_SOLID,1,rgb(255,0,0));
SelectObject(BitmapDC, Brush);
SelectObject(BitmapDC, Pen);
Ellipse(BitmapDC,4,4,28,28);
DeleteObject(Brush);
DeleteObject(Pen);
// BitBLT(form1.Canvas.Handle,30,0,32,32,BitmapDC,0,0,SRCCOPY);
ZeroMemory(@IcoInfo, SizeOf(TIconInfo));
IcoInfo.fIcon:=true;
IcoInfo.xHotspot := 0;
IcoInfo.yHotspot := 0;
IcoInfo.hbmMask := Mask;
IcoInfo.hbmColor := Bitmap;
Result := CreateIconIndirect(IcoInfo);
DeleteObject(Mask);
DeleteObject(Bitmap);
DeleteDC(BitmapDC);
DeleteDC(MaskDC);
end;

function CreateIconWithVCL: HICON;
var
IconSizeX: integer;
IconSizeY: integer;
AndMask: TBitmap;
XOrMask: TBitmap;
IconInfo: TIconInfo;
begin
IconSizeX := GetSystemMetrics(SM_CXICON);
IconSizeY := GetSystemMetrics(SM_CYICON);
AndMask := TBitmap.Create;
AndMask.Monochrome := true;
AndMask.Width := IconSizeX;
AndMask.Height := IconSizeY;
AndMask.Canvas.Brush.Color := clWhite;
AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
AndMask.Canvas.Brush.Color := clBlack;
AndMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);
XOrMask := TBitmap.Create;
XOrMask.Width := IconSizeX;
XOrMask.Height := IconSizeY;
XOrMask.Canvas.Brush.Color := ClBlack;
XOrMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
XOrMask.Canvas.Pen.Color := clRed;
XOrMask.Canvas.Brush.Color := clRed;
XOrMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);
IconInfo.fIcon := true;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := AndMask.Handle;
IconInfo.hbmColor := XOrMask.Handle;
Result :=CreateIconIndirect(IconInfo);
AndMask.Free;
XOrMask.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var icon:ticon;
bitmap,mask:tbitmap;
iinfo: TICONINFO;
begin
icon:=ticon.Create;
bitmap:=tbitmap.Create;
mask:=tbitmap.Create;
icon.Handle:=CreateIconWithWinAPI;
GetIconInfo(icon.Handle, iinfo);
bitmap.Handle:=iinfo.hbmColor;
mask.Handle:=iinfo.hbmMask;
form1.Canvas.Draw(30,0,bitmap);
form1.Canvas.Draw(30,33,mask);
form1.Canvas.Draw(30,66,icon);
icon.SaveToFile("CreateIconWithWinAPI.ico");
bitmap.SaveToFile("CreateIconWithWinAPI_bitmap.bmp");
mask.SaveToFile("CreateIconWithWinAPI_mask.bmp");
icon.Free;
bitmap.Free;
mask.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var icon:ticon;
bitmap,mask:tbitmap;
iinfo: TICONINFO;
begin
icon:=ticon.Create;
bitmap:=tbitmap.Create;
mask:=tbitmap.Create;
icon.Handle:=CreateIconWithVCL;
GetIconInfo(icon.Handle, iinfo);
bitmap.Handle:=iinfo.hbmColor;
mask.Handle:=iinfo.hbmMask;
form1.Canvas.Draw(110,0,bitmap);
form1.Canvas.Draw(110,33,mask);
form1.Canvas.Draw(110,66,icon);
icon.SaveToFile("CreateIconWithVCL.ico");
bitmap.SaveToFile("CreateIconWithVCL_bitmap.bmp");
mask.SaveToFile("CreateIconWithVCL_mask.bmp");
icon.Free;
bitmap.Free;
mask.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
form1.Canvas.TextOut(67,10,"-Bitmap-");
form1.Canvas.TextOut(69,43,"-Mask-");
form1.Canvas.TextOut(72,76,"-Icon-");
end;

end.

//Mainform.dfm
object Form1: TForm1
Left = 401
Top = 239
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = "CoolIcons"
ClientHeight = 133
ClientWidth = 169
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnPaint = FormPaint
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 8
Top = 104
Width = 75
Height = 25
Caption = "WinAPI"
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 88
Top = 104
Width = 75
Height = 25
Caption = "VCL"
TabOrder = 1
OnClick = Button2Click
end
end

← →
easy © (2006-05-01 12:39) [1]

The SelectObject function selects an object into the specified device context.
This function returns the previously selected object of the specified type. An application should always replace a new object with the original, default object after it has finished drawing with the new object.

function CreateIconWithWinAPI: HICON; var BitmapDC, MaskDC: HDC; IcoInfo: TIconInfo; Bitmap, Mask,OldBitmap: HBitmap; Brush,Oldbrush: HBrush; Pen,Oldpen: HPen; BitmapRect: TRect; begin BitmapDC := CreateCompatibleDC(GetDC(0)); MaskDC := CreateCompatibleDC(GetDC(0)); Bitmap := CreateCompatibleBitmap(GetDC(0), 32, 32); Mask := CreateBitmap(32, 32, 1, 1, 0); // Mask := CreateCompatibleBitmap(GetDC(0),32,32); with BitmapRect do begin Left := 0; Right := 32; Top := 0; Bottom := 32; end; OldBitmap:=SelectObject(MaskDC, Mask); Brush := CreateSolidBrush(rgb(255, 255, 255)); FillRect(MaskDC, BitmapRect, Brush); DeleteObject(Brush); Brush := CreateSolidBrush(rgb(0, 0, 0)); Pen := CreatePen(PS_SOLID, 1, rgb(0, 0, 0)); OldPen:=SelectObject(MaskDC, Pen); OldBrush:=SelectObject(MaskDC, Brush); Ellipse(MaskDC, 4, 4, 28, 28); SelectObject(MaskDC, OldPen); SelectObject(MaskDC, OldBrush); DeleteObject(Brush); DeleteObject(Pen); // BitBLT(form1.Canvas.Handle,30,33,32,32,MaskDC,0,0,SRCCOPY); SelectObject(MaskDC, OldBitmap); OldBitmap:=SelectObject(BitmapDC, Bitmap); Brush := CreateSolidBrush(rgb(0, 0, 0)); FillRect(BitmapDC, BitmapRect, Brush); DeleteObject(Brush); Brush := CreateSolidBrush(rgb(255, 0, 0)); Pen := CreatePen(PS_SOLID, 1, rgb(255, 0, 0)); OldBrush:=SelectObject(BitmapDC, Brush); OldPen:=SelectObject(BitmapDC, Pen); Ellipse(BitmapDC, 4, 4, 28, 28); SelectObject(BitmapDC, OldBrush); SelectObject(BitmapDC, OldPen); DeleteObject(Brush); DeleteObject(Pen); SelectObject(BitmapDC, OldBitmap); // BitBLT(form1.Canvas.Handle,30,0,32,32,BitmapDC,0,0,SRCCOPY); ZeroMemory(@IcoInfo, SizeOf(TIconInfo)); IcoInfo.fIcon := true; IcoInfo.xHotspot := 0; IcoInfo.yHotspot := 0; IcoInfo.hbmMask := Mask; IcoInfo.hbmColor := Bitmap; Result := CreateIconIndirect(IcoInfo); DeleteObject(Mask); DeleteObject(Bitmap); DeleteDC(BitmapDC); DeleteDC(MaskDC); end;

← →
BOGDAN (2006-05-01 12:58) [2]

Большое спасибо!!!
Я сам то не допер:))
Вопрос закрыт!

Не могу создать иконку с прозрачностью Найти похожие ветки