Maks150988
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
delover
Дык я на чистом Апи делаю прогамму, мне эти ТБитмап не нужны. Мне б только знать как перевести некоторый код с этого дурацкого VCL. Вот например самое простое - Image.Width это можно через GetObject у загруженной картинки узнать, а Image.Canvas.Pixels[0, 0] я подумал что это в Апи GetPixel(MskBmpDC,0, y) куда предварительно поместил битмап через SelectObject. так вроде смотрю считай одно и тоже.
ShIvADeSt
Так я вызываю через ТрекПопапМеню. 
Код: hSysMenu := GetSystemMenu(hApp, FALSE);
//
WM_CONTEXTMENU:
begin
GetCursorPos(lpPoint);
GetWindowRect(hApp, lpRect);
lpRect.Bottom := lpRect.Top + 18;
//ClientToScreen(hApp, lpPoint);
if PtInRect(lpRect, lpPoint) then
begin
SetForegroundWindow(hApp);
TrackPopupMenu(hSysMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON, lpPoint.X, lpPoint.Y, 0, hApp, nil);
PostMessage(hApp, WM_NULL, 0, 0);
//Result := 1;
end;
Result := 1;
end; |
Не работает код.
Ну и переделал ваш код:
Код: procedure BitmapToRegion(hButton: Thandle; szPathFile: WideString);
var
x,y,StartLineX :integer;
FullRegion,LineRegion :HRGN;
TransparentColor :COLORREF;
InFirstRegion,_InLine :Boolean;
PicWidth,PicHeight :integer;
DC:HDC;
Bitmap:HBITMAP;
BmpInfo : TBitmapInfo;
begin
Bitmap := LoadImageW(hInstance, PWideChar(szPathFile), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
GetObject(Bitmap, SizeOf(BmpInfo), @BmpInfo);
DC := CreateCompatibleDC(0);
SelectObject(DC, Bitmap);
PicWidth:=BmpInfo.bmiHeader.biWidth;
PicHeight:=BmpInfo.bmiHeader.biHeight;
InFirstRegion:=True;
_InLine:=False;
StartLineX:=0;
TransparentColor:=GetPixel(DC,0,0);
for Y:=0 to PicHeight-1 do
for X:=0 to PicWidth-1 do
if (GetPixel(DC, X, Y)=TransparentColor)then begin
if _InLine then begin
_InLine:=False;
LineRegion:=CreateRectRgn(StartLineX,Y,X,Y+1);
if InFirstRegion then begin
FullRegion:=LineRegion;
InFirstRegion:=False;
end
else begin
CombineRgn(FullRegion, FullRegion, LineRegion, RGN_OR);
DeleteObject(LineRegion);
end;
end
end
else
If NOT _InLine then begin
_InLine:=True;
StartLineX:=X;
end;
SetWindowRgn(hButton, FullRegion, TRUE);
DeleteObject(FullRegion);
DeleteObject(Bitmap);
DeleteDC(DC);
end; |
Вроде бы работает. Ммм, все ли потом корректно удаляется после создания? Немного смущает как-то что Делфи пишет что FullRegion не инициализирован будет. |
типовые задачи по паскалю (а тут голимый паскаль) вверху в прибитую тему
Я плохо разбираюсь в некоторых конструкциях кода - всякие TBitmap и подобные Image.Canvas.Pixels[0, y] смущают. Остальное впринципе не проблема под Апи переделать. 