Непрямоугольная форма

← →
Кирилл (2004-08-25 12:36) [0]

Как создать непрямоугольную форму (желательно ещё с "дырками" внутри)?

← →
Андрей Сенченко © (2004-08-25 12:39) [1]

в FAQ уже искал ?

← →
Rem (2004-08-25 12:42) [2]

var HRgn1: THandle; HRgn2: THandle; begin HRgn1 := CreateEllipticRgn(0, 0, 100, 100); HRgn2 := CreateEllipticRgn(50, 20, 130, 150); CombineRgn(HRgn1, HRgn1, HRgn2, RGN_XOR); SetWindowRgn(Form1.Handle, HRgn1, true); end;

← →
Rem (2004-08-25 13:02) [3]

Сорри...

var HRgn1: THandle; HRgn2: THandle; begin HRgn2 := CreateEllipticRgn(50, 20, 130, 150); try HRgn1 := CreateEllipticRgn(0, 0, 100, 100); try CombineRgn(HRgn1, HRgn1, HRgn2, RGN_XOR); SetWindowRgn(Form1.Handle, HRgn1, true); except DeleteObject(HRgn1); raise; end; finally DeleteObject(HRgn2); end; end;

← →
Кирилл (2004-08-25 14:35) [4]

Большое спасибо, Rem, очень помог. Но не мог бы ты ещё научить меня строить форму из многоугольников?

← →
TUser © (2004-08-25 14:39) [5]

Это делается точно так же. Для этого надо взять много прямоугольников высотой (или шириной) в 1 пиксель и применить CombineRgn. Так можно сделать регион произвольно сложной формы.

← →
Profi © (2004-08-25 15:07) [6]

Кирилл (25.08.04 12:36)
А еще лучше, рисуешь форму в paint, а потом по ней создаешь регион. Хочешь, кину модуль посмотрешь, там легко!

← →
TUser © (2004-08-25 15:24) [7]

Можно в jedi посмотреть - там есть компонент, который такое делает. С сырцами.

← →
Кирилл (2004-08-25 15:26) [8]

(К Profi): да, очень хочу, мой адрес k@netman.ru

← →
Rem (2004-08-25 15:36) [9]

Можно разместить на форме (Form) рисунок (Image), а затем:

begin Image.Transparent := true; Form.BorderStyle := bsNone; Form.TransparentColorValue := GetSysColor(COLOR_BTNFACE); Form.TransparentColor := true; end;

← →
TUser © (2004-08-25 17:01) [10]

Transparent и сабж - это несколько разные штуки.

← →
Rem (2004-08-25 17:15) [11]

[10]
А Вы попробуйте...
Только, для наглядности, возьмите такой рисунок, чтобы у него прозрачный цвет (за основу в TImage берется левый нижний пиксел растра) занимал до половины поверхности...

← →
antonn © (2004-08-25 17:30) [12]

Ловите коллега:

function BitmapToRgn(Image: TBitmap): HRGN;
var
TmpRgn: HRGN;
x, y: integer;
ConsecutivePixels: integer;
CurrentPixel: TColor;
CreatedRgns: integer;
CurrentColor: TColor;
begin
CreatedRgns := 0;
Result := CreateRectRgn(0, 0, Image.Width, Image.Height);
inc(CreatedRgns);

if (Image.Width = 0) or (Image.Height = 0) then
exit;

for y := 0 to Image.Height - 1 do
begin
CurrentColor := Image.Canvas.Pixels[0,y];
ConsecutivePixels := 1;
for x := 0 to Image.Width - 1 do
begin
CurrentPixel := Image.Canvas.Pixels[x,y];

if CurrentColor = CurrentPixel then
inc(ConsecutivePixels)
else
begin
// ?????? ? ????? ????
if CurrentColor = clWhite then
begin
TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
inc(CreatedRgns);
DeleteObject(TmpRgn);
end;
CurrentColor := CurrentPixel;
ConsecutivePixels := 1;
end;
end;

if (CurrentColor = clWhite) and (ConsecutivePixels > 0) then
begin
TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
inc(CreatedRgns);
DeleteObject(TmpRgn);
end;
end;
end;

Функция создает регион:
SetWindowRgn(Handle,BitmapToRgn( MainFormImageRegion.Picture.Bitmap ) , true);

Вырезает белое в изображении

← →
Zhekson (2004-08-25 17:44) [13]

Profi © (25.08.04 15:07) [6]
Кирилл (25.08.04 12:36)
А еще лучше, рисуешь форму в paint, а потом по ней создаешь регион. Хочешь, кину модуль посмотрешь, там легко!

Классика.

> CurrentPixel := Image.Canvas.Pixels[x,y];

а вот за это аффтора стрелять надо... :(

ЗЫ почему тормозные исходники плодятся по нету как тараканы?...

насчет региона из битмапа - вот исходник, возможно рабочий, работающий в разы быстрее... скажу сразу, что его сишный аналог (лежал там же для reference purpose) рабочий...
исходник в следующем постинге...

{---
BitmapToRegion - The code below is a translation from the original C
language version by Jean-Edouard Lachand-Robert

hBmp : Source bitmap
cTransparentColor: Color base for the "transparent" pixels(default black)
cTolerance : Color tolerance for the "transparent" pixels.

A pixel is assumed to be transparent if the value of each of its 3 components (blue, green and red) is greater or equal to the corresponding value in cTransparentColor and is lower or equal to the corresponding value in cTransparentColor + cTolerance.
--- }

function BitmapToRegion(hBmp: HBITMAP; cTransparentColor: COLORREF=0;
cTolerance: COLORREF=$101010): HRGN;
const
AllocUnit = 100;
MaxRects: DWORD = AllocUnit;
type
TRectArray = Array[0..0] of TRect;
LONG = LongInt;
PLONG = ^LONG;
var
h, Rgn: HRGN;
hMemDC, h_DC: HDC;
hBmp32, HoldBmp: HBITMAP;
bm, bm32: BITMAP;
RGB32BITSBITMAPINFO: BITMAPINFOHEADER;
BITMAP_INFO: ^BITMAPINFO;
pbBits32: pointer;
hData: THandle;
pData: PRgnData;
lr, lg, lb, hr, hg, hb: Byte;
b: Byte;
p32: PByte;
p: PLONG;
x,y, x0: Integer;
pr: ^TRectArray;
begin
Rgn := 0;

{ Create a memory DC inside which we will scan the bitmap content }
hMemDC := CreateCompatibleDC(0);
if hMemDC > 0 then
begin
{ get Bitmap size }
GetObject(hBmp, SizeOf(bm), @bm);

{ Create a 32-bit depth bitmap and select it into the memory DC }
with RGB32BITSBITMAPINFO do
begin
biSize := sizeof(BITMAPINFOHEADER); // biSize
biWidth := bm.bmWidth; // biWidth;
biHeight := bm.bmHeight; // biHeight;
biPlanes := 1; // biPlanes;
biBitCount := 32; // biBitCount
biCompression := BI_RGB; // biCompression;
biSizeImage := 0; // biSizeImage;
biXPelsPerMeter := 0; // biXPelsPerMeter;
biYPelsPerMeter := 0; // biYPelsPerMeter;
biClrUsed := 0; // biClrUsed;
biClrImportant := 0; // biClrImportant;
end;
BITMAP_INFO := @RGB32BITSBITMAPINFO; // points to the previous structure

hBmp32 := CreateDIBSection(hMemDC, BITMAP_INFO^, DIB_RGB_COLORS,
pbBits32, 0, 0);
if hBmp32 > 0 then
begin
HoldBmp := SelectObject(hMemDC, hBmp32);

{ Create DC just to copy bitmap into the memory DC }
h_DC := CreateCompatibleDC(hMemDC);
if h_DC > 0 then
begin
{ Get how many bytes per row we have for the bitmap bits (rounded up
to 32 bits) }
GetObject(hBmp32, SizeOf(bm32), @bm32);
while (bm32.bmWidthBytes mod 4 <> 0) do
Inc(bm32.bmWidthBytes);

{ Copy the bitmap into the memory DC }
HoldBmp := SelectObject(h_DC, hBmp);
BitBlt(hMemDC, 0, 0, bm.bmWidth, bm.bmHeight, h_DC, 0, 0, SRCCOPY);

{ For better performance, we will use the ExtCreateRegion() function
to create the region. This function take a RGNDATA structure on
entry. We will add rectangles by amount of ALLOC_UNIT number in this
structure. }
MaxRects := AllocUnit;
hData := GlobalAlloc(GMEM_MOVEABLE, SizeOf(RGNDATAHEADER) +
(SizeOf(TRect) * maxRects));
pData := GlobalLock(hData);
with pData^.rdh do
begin
dwSize := SizeOf(RGNDATAHEADER);
iType := RDH_RECTANGLES;
nCount := 0;
nRgnSize := 0;
SetRect(rcBound, MAXLONG, MAXLONG, 0, 0);
end;

{ Keep on hand highest and lowest values for the "transparent"
pixels }
lr := GetRValue(cTransparentColor);
lg := GetGValue(cTransparentColor);
lb := GetBValue(cTransparentColor);
hr := Min($ff, lr + GetRValue(cTolerance));
hg := Min($ff, lg + GetGValue(cTolerance));
hb := Min($ff, lb + GetBValue(cTolerance));

{ Scan each bitmap row from bottom to top (the bitmap is inverted
vertically) }
p32 := PByte(Integer(bm32.bmBits) + (bm32.bmHeight - 1) *
bm32.bmWidthBytes);
for y := 0 to bm.bmHeight - 1 do
begin
{ Scan each bitmap pixel from left to right }
// for x := 0 to bm.bmWidth - 1 do
x := 0;
while x < bm.bmWidth do
begin
{ Search for a continuos range of "non transparent pixels" }
x0 := x;
p := PLONG(Integer(p32)+x*SizeOf(LONG));
while x < bm.bmWidth do
begin
b := GetRValue(p^);
if (b >= lr) and (b <= hr) then
begin
b := GetGValue(p^);
if (b >= lg) and (b <= hg) then
begin
b := GetBValue(p^);
if (b >= lb) and (b <= hb) then
begin
Break; // this pixel is transparent
end;
end;
end;
inc(p);
inc(x);
end; // while x < bm.bmWidth

-- продолжение в следующем постинге --

-- продолжение --

if x > x0 then
begin
{ Add the pixels (x0, y) to (x, y+1) as a new rectangle in
the region }
if pData^.rdh.nCount >= maxRects then
begin
GlobalUnlock(hData);
Inc(maxRects,AllocUnit);
hData := GlobalReAlloc(hData, SizeOf(RGNDATAHEADER) +
(SizeOf(TRect) * MaxRects), GMEM_MOVEABLE);
pData := GlobalLock(hData);
end;

pr := @pData^.Buffer;
SetRect(pr^[pData^.rdh.nCount], x0, y, x, y+1);
with pData^.rdh do
begin
if x0 < rcBound.Left then rcBound.Left := x0;
if y < rcBound.Top then rcBound.Top := y;
if x > rcBound.Right then rcBound.Right := x;
if y+1 > rcBound.Bottom then rcBound.Bottom := y+1;
Inc(nCount);
end;
end;

{ On Windows98, ExtCreateRegion() may fail if the number of
rectangles is too large (ie: > 4000). Therefore, we have to
create the region by multiple steps. }
if pData^.rdh.nCount = 2000 then
begin
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) +
(SizeOf(TRect) * maxRects), pData^);
if Rgn > 0 then
begin
CombineRgn(Rgn, Rgn, h, RGN_OR);
DeleteObject(h);
end
else
Rgn := h;
pData^.rdh.nCount := 0;
SetRect(pData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
end;

Inc(x);
end; { for x := 0 to bm.Width - 1 (used a While loop to be able
to make Inc(x);) }
{ Go to next row (remember, the bitmap is inverted vertically) }
Dec(p32, bm32.bmWidthBytes);
end; // for y := 0 to bm.Height - 1

{ Create or extend the region with the remaining rectangles }
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) *
MaxRects), pData^);
if Rgn > 0 then
begin
CombineRgn(Rgn, Rgn, h, RGN_OR);
DeleteObject(h);
end
else
Rgn := h;

GlobalFree(hData);
SelectObject(h_DC, holdBmp);
DeleteDC(h_DC);
end; // if h_DC > 0
DeleteObject(SelectObject(hMemDC, holdBmp));
end; // if hBmp32 > 0
DeleteObject(hMemDC);
end; // if hMemDC > 0
Result := Rgn;
end;
-- конец исходника --

← →
Кирилл (2004-08-26 18:24) [18]

Большое спасибо!

Непрямоугольная форма Найти похожие ветки