چگونه مي توان يك فرم به شكلي غير از شكل عادي خود داشت؟

SalarSoftwares logo

خوش آمدید. در این سایت می توانید ابزارهای دلفی و نرم افزارها را دریافت کنید.

function BitmapToRegion(Bitmap:TBitmap;TransColor:TColor;FInverted: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<Bitmap.Width do
begin
Inc(X);
X0:=X;
P:=PLongInt(P32);
Inc(PChar(P),X*SizeOf(LongInt));
while X<Bitmap.Width do
begin
CR:=GetBValue(P^);
CG:=GetGValue(P^);
CB:=GetRValue(P^);
if ((CR=LR) and (CG=LG) and (CB=LB)) xor FInverted 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<PData^.RDH.rcBound.Left then
PData^.RDH.rcBound.Left:=X0;
if Y<PData^.RDH.rcBound.Top then
PData^.RDH.rcBound.Top:=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;