利用點陣圖創建不規則多邊形區域物件 |
|
|
|
wameng
版主   發表：31 回覆：1336 積分：1188 註冊：2004-09-16 發送簡訊給我 |
可用於任何 Twincontrol 所繼承的物件。如 Panel,Form 等 { 自動將 TwinControl 利用圖形產生不規則物件 }
Procedure AutoRglon(ControlHandle:Thandle;PICBMP:TBITMAP;TransColor:Tcolor);
{ 自動利用圖形產生不規則 Hrgn 曲線 }
Function BitmapToRgn(Bitmap:TBitmap;
Const TransColor:Tcolor = Clwhite;
Const Inverted :Boolean = false):HRgn; Function BitmapToRgn(Bitmap:TBitmap;
Const TransColor:Tcolor = Clwhite;
Const Inverted :Boolean = false):HRgn;
const
AllocUnit=100;
var
BMP:TBitmap;
MaxRects:Integer;
HData:HGlobal;
PData:PRgnData;
CB,CR,CG,LR,LG,LB:Byte;
P32:Pointer;
X,X0,Y:Integer;
P:PLongInt;
PR:PRect;
H:Hrgn;
begin
Result :=0;
BMP :=TBitmap.Create;
BMP.Assign(Bitmap);
BMP.HandleType :=bmDIB;
BMP.PixelFormat :=pf32bit;
MaxRects :=AllocUnit;
HData := GlobalAlloc(GMem_Moveable,SizeOf(TRgnDataHeader) SizeOf(TRect)*MaxRects);
PData := GlobalLock(HData);
PData^.RDH.dwSize :=SizeOf(TRgnDataHeader);
PData^.RDH.iType :=RDH_Rectangles;
PData^.RDH.nCount :=0;
PData^.RDH.nRgnSize :=0;
SetRect(PData^.RDH.rcBound,MaxInt,MaxInt,0,0);
LR:=GetRValue(ColorToRGB(TransColor));
LG:=GetGValue(ColorToRGB(TransColor));
LB:=GetBValue(ColorToRGB(TransColor));
for Y:=0 to Bitmap.Height-1 do
begin
X:=-1;
P32:=BMP.ScanLine[Y];
while X 1 begin
Inc(X);
X0:=X;
P:=PLongInt(P32);
Inc(PChar(P),X*SizeOf(LongInt));
while X begin
CR :=GetBValue(P^);
CG :=GetGValue(P^);
CB :=GetRValue(P^);
if ((CR=LR) and (CG=LG) and (CB=LB)) xor Inverted then Break;
Inc(PChar(P),SizeOf(LongInt));
Inc(X)
end;
if X>X0 then
begin
if PData^.RDH.nCount>=MaxRects then
begin
GlobalUnlock(HData);
Inc(MaxRects,AllocUnit);
HData:=GlobalReAlloc(HData,SizeOf(TRgnDataHeader) SizeOf(TRect)*MaxRects,GMem_Moveable);
PData:=GlobalLock(HData)
end;
PR:=@PData^.Buffer[PData^.RDH.nCount*SizeOf(TRect)];
SetRect(PR^,X0,Y,X,Y 1);
if X0 if Y if X>PData^.RDH.rcBound.Right then PData^.RDH.rcBound.Left:=X;
if Y 1>PData^.RDH.rcBound.Bottom then PData^.RDH.rcBound.Bottom:=Y 1;
Inc(PData^.RDH.nCount);
if PData^.RDH.nCount=2000 then
begin
H:=ExtCreateRegion(nil,SizeOf(TRgnDataHeader) (SizeOf(TRect)*MaxRects),PData^);
if Result<>0 then
begin
CombineRgn(Result,Result,H,RGN_OR);
DeleteObject(H);
end else Result:=H;
PData^.RDH.nCount:=0;
SetRect(PData^.RDH.rcBound,MaxInt,MaxInt,0,0)
end;
end;
end;
end;
H:=ExtCreateRegion(nil,SizeOf(TRgnDataHeader) (SizeOf(TRect)*MaxRects),PData^);
if Result<>0 then
begin
CombineRgn(Result,Result,H,RGN_OR);
DeleteObject(H);
end else Result:=H;
GlobalFree(HData);
BMP.Free;
end; Procedure AutoRglon(ControlHandle:Thandle;PICBMP:TBITMAP;TransColor:Tcolor);
var
Hrg : HRGN;
begin
Hrg := BitmapToRgn(PicBMP,TransColor);
Try
SetWindowRgn(ControlHandle,Hrg,True);
finally
DeleteObject(Hrg);
end;
end; 發表人 - wameng 於 2004/09/22 10:48:06
|
|
mchakuna
一般會員  發表：41 回覆：45 積分：17 註冊：2004-01-07 發送簡訊給我 |
發表時間：2004-09-22 10:26:14
IP:61.222.xxx.xxx 未訂閱
系統時間：2024-05-09 9:13:19
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |