?
Solved

Forms - Circelshapes - Transparent

Posted on 2000-03-06
18
Medium Priority
?
284 Views
Last Modified: 2010-04-04
Hi All you experts,

For a CD-menu, I want to make a form shaped as a CD (with a white label), so I need a form with a circelshape where the corners of the original square/rectangeled form are transparent, AND where the hole in the middle is transparent.

I general I want the program to show the resemblence of a CD on the screen.

I need only the form with the shape so it is the Pas and Dfm file. I use D5.

Regards
Soren
0
Comment
Question by:SHJ_LUX
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
18 Comments
 
LVL 27

Expert Comment

by:kretzschmar
ID: 2590463
hi,

look at the coolform-component at
www.torry.ru

meikl
0
 
LVL 27

Accepted Solution

by:
kretzschmar earned 2000 total points
ID: 2590479
back again

torry is testing its new layout
and works not properly at the moment

get it from the author at

http://www.lawrenz.com/coolform/

meikl
0
 
LVL 1

Expert Comment

by:yk030299
ID: 2590495
Just said! 1stClass components work but you should pay for it. :)
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 17

Expert Comment

by:inthe
ID: 2590514
Hi
there a article here about creating different form shapes:

http://www.borland.com/delphi/news/zd/1998/dec98/

Regards Barry
0
 

Expert Comment

by:doncov
ID: 2590566
Look Library component FormRGN:
http://delphi.vitpc.com/library/index.htm
0
 
LVL 1

Expert Comment

by:umulig
ID: 2590589
http://www.DelphiZine.com/features/2000/03/di200003pm_f/di200003pm_d.asp

here is another article and free comp.

Regards
Umulig
0
 
LVL 1

Expert Comment

by:wmckie
ID: 2590654
Did you get a companion CD with your Delphi5, if it is the same as that distributed here in the UK there were several free component suites. On the the one I have there are two sets of components from DevExpress one of them has a component that does what you want.

Cheers - Walter McKie
0
 
LVL 9

Expert Comment

by:ITugay
ID: 2590700
You can find out the sample of transparent form, just search in experts-exchange database by current topic. There are good and working example how to create transparent form. You can place on form all what you want, even circle;)

Best regards,
Igor

0
 
LVL 2

Expert Comment

by:PeterLarsen
ID: 2590792
It's a goldmine of URL's !!
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2590826
Try this

PROCEDURE TForm1.Elliptical_Window;
VAR
  Region : hRgn;
begin
  Region := CreateEllipticRgn(0, 0, Form1.ClientWidth,
                              Form1.ClientHeight);
  SetWindowRgn(Form1.Handle, Region, TRUE);
END;

What this will do is create an elliptical region based on the client area of your form. In your case just make sure that your form is square to start with

The Neil
0
 

Expert Comment

by:Iliad
ID: 2591133
This code sets the form to be the same shape as a bitmap...

This code is either from DIL or Internet


unit sp;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Jpeg, Menus;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
  end;

  procedure OldBitmapToRegion(Image: TImage; TransColor: TColor);
  function BitmapToRegion( hBmp: TBitmap; TransColor: TColor;
                           Tolerance: Integer): HRGN;
var
  Form1: TForm1;
  FRegion1, FRegion2 : HRgn;
  P : TPoint;
  i, j, left, top, right, bottom : Integer;
  TransColor : TColor;
  Diff1, Diff2: TDateTime;
  BMPToRgn: Boolean;

implementation

{$R *.DFM}

{
  This is a Delphi port of a C function found at www.codegurus.com
  It takes a bitmap and creates a region based upon the pixels in the
  bitmap matching a color that corresponds to Transcolor with a
  Color Tolerance level of Tolerance.
  It does this by scanning each line in the BITMAP structure for
  pixels that match TransColor then adds them to the region with a
  call to CombineRgn.
}

function BitmapToRegion( hBmp: TBitmap; TransColor: TColor;
                         Tolerance: Integer): HRGN;

  function MinByte(B1, B2: byte): byte;
  begin
    if B1 < B2 then
      Result := B1
    else
      Result := B2;
  end;

const
  ALLOC_UNIT = 100;
var
  MemDC, DC: HDC;
  BitmapInfo: TBitmapInfo;
  hbm32, holdBmp, holdMemBmp: HBitmap;
  pbits32 : Pointer;
  bm32 : BITMAP;
  maxRects: DWORD;
  hData: HGLOBAL;
  pData: PRgnData;
  b, LR, LG, LB, HR, HG, HB: Byte;
  p32: pByte;
  x, x0, y: integer;
  p: pLongInt;
  pr: PRect;
  h: HRGN;
begin
  Result := 0;
  if hBmp <> nil then
  begin
    { Create a memory DC inside which we will scan the bitmap contents }
    MemDC := CreateCompatibleDC(0);
    if MemDC <> 0 then
    begin
     { Create a 32 bits depth bitmap and select it into the memory DC }
      with BitmapInfo.bmiHeader do
      begin
        biSize          := sizeof(TBitmapInfoHeader);
        biWidth         := hBmp.Width;
        biHeight        := hBmp.Height;
        biPlanes        := 1;
        biBitCount      := 32;
        biCompression   := BI_RGB; { (0) uncompressed format }
        biSizeImage     := 0;
        biXPelsPerMeter := 0;
        biYPelsPerMeter := 0;
        biClrUsed       := 0;
        biClrImportant  := 0;
      end;
      hbm32 := CreateDIBSection(MemDC, BitmapInfo, DIB_RGB_COLORS, pbits32,0, 0);
      if hbm32 <> 0 then
      begin
        holdMemBmp := SelectObject(MemDC, hbm32);
        {
          Get how many bytes per row we have for the bitmap bits
          (rounded up to 32 bits)
        }
        GetObject(hbm32, SizeOf(bm32), @bm32);
        while (bm32.bmWidthBytes mod 4) > 0 do
          inc(bm32.bmWidthBytes);
        DC := CreateCompatibleDC(MemDC);
        { Copy the bitmap into the memory DC }
        holdBmp := SelectObject(DC, hBmp.Handle);
        BitBlt(MemDC, 0, 0, hBmp.Width, hBmp.Height, DC, 0, 0, SRCCOPY);
        {
          For better performances, 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 := ALLOC_UNIT;
        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);
        { Keep on hand highest and lowest values for the "transparent" pixel }
        LR := GetRValue(ColorToRGB(TransColor));
        LG := GetGValue(ColorToRGB(TransColor));
        LB := GetBValue(ColorToRGB(TransColor));
        { Add the value of the tolerance to the "transparent" pixel value }
        HR := MinByte($FF, LR + Tolerance);
        HG := MinByte($FF, LG + Tolerance);
        HB := MinByte($FF, LB + Tolerance);
        {
          Scan each bitmap row from bottom to top,
          the bitmap is inverted vertically
        }
        p32 := bm32.bmBits;
        inc(PChar(p32), (bm32.bmHeight - 1) * bm32.bmWidthBytes);
        for y := 0 to hBmp.Height-1 do
        begin
          { Scan each bitmap pixel from left to right }
          x := -1;
          while x+1 < hBmp.Width do
          begin
            inc(x);
            { Search for a continuous range of "non transparent pixels" }
            x0 := x;
            p := PLongInt(p32);
            inc(PChar(p), x * SizeOf(LongInt));
            while x < hBmp.Width do
            begin
              b := GetBValue(p^);                 // Changed from GetRValue(p^)
              if (b >= LR) and (b <= HR) then
              begin
                b := GetGValue(p^);               // Left alone
                if (b >= LG) and (b <= HG) then
                begin
                  b := GetRValue(p^);             // Changed from GetBValue(p^)
                  if (b >= LB) and (b <= hb) then
                    { This pixel is "transparent" }
                    break;
                end;
              end;
              inc(PChar(p), SizeOf(LongInt));
              inc(x);
            end;
            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, ALLOC_UNIT);
                hData := GlobalReAlloc(hData, SizeOf(TRgnDataHeader) +
                   SizeOf(TRect) * maxRects, GMEM_MOVEABLE);
                pData := GlobalLock(hData);
                Assert(pData <> NIL);
              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);
              {
               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(TRgnDataHeader) +
                   (SizeOf(TRect) * maxRects), pData^);
                Assert(h <> 0);
                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;
          {
            Go to next row (remember, the bitmap is inverted vertically)
            that is why we use DEC!
          }
          Dec(PChar(p32), bm32.bmWidthBytes);
        end;
        { Create or extend the region with the remaining rectangle }
        h := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) +
           (SizeOf(TRect) * maxRects), pData^);
        Assert(h <> 0);
        if Result <> 0 then
        begin
          CombineRgn(Result, Result, h, RGN_OR);
          DeleteObject(h);
        end else
          Result := h;
        { Clean up }
        GlobalFree(hData);
        SelectObject(DC, holdBmp);
        DeleteDC(DC);
        DeleteObject(SelectObject(MemDC, holdMemBmp));
      end;
    end;
    DeleteDC(MemDC);
  end;
end;

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
  {
    Overriding WM_NCHITTEST will allow the form to be moved
    around the screen even if it doesn't have a captionbar
  }
  inherited;                    { call the inherited message handler }
  if  M.Result = htClient then  { is the click in the client area?   }
    M.Result := htCaption;      { if so, make Windows think it's     }
                                { on the caption bar.                }
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {  Set this to False to compare loading time }
  BMPToRgn := True;
  Diff1 := Now;
  { Set the Color you want to be transparent}
  TransColor := Image1.Canvas.Pixels[0,0];
  if BMPToRgn then
  begin
    { Create the Region with a call to the BitmapToRegion function }
    FRegion1 := BitmapToRegion(Image1.Picture.Bitmap,TransColor,0);
    { Set the Window region to the shape of the region }
    SetWindowRgn(Handle, FRegion1,True);
  end
  else
    OldBitmapToRegion(Image1, Image1.Canvas.Pixels[0,0]);;
  { Make sure we clean up }
  // We need to remove this line...
  //
  // From the Win32 Help File:
  //   After a successful call to SetWindowRgn, the operating system owns the
  // region specified by the region handle hRgn. The operating system does not
  // make a copy of the region. Thus, you should not make any further function
  // calls with this region handle. In particular, do not close this region
  // handle.
  //
  //DeleteObject(FRegion1);
  Diff2 := Now;
  Diff1 := Diff2-Diff1;
  Button1.Caption := FormatDateTime('nn:ss',Diff1);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure OldBitmapToRegion(Image: TImage; TransColor: TColor);
var
  i, j : Integer;
begin
  FRegion1:=CreateRectRgn(0,0,0,0);
  P.x:=0;
  P.y:=0;
  for i := 0 to Image.Height-1 do
  begin
    for j := 0 to Image.Width-1 do
    begin
      if Image.Canvas.Pixels[j,i] = TransColor then
      begin
        FRegion2:=CreateRectRgn(j-P.x,i-P.y,succ(j-P.x),succ(i-p.Y));
        CombineRgn(FRegion1,FRegion1,FRegion2,RGN_OR);
        DeleteObject(FRegion2);
      end;
    end;
  end;
  FRegion2:=CreateRectRgn(0,0,Form1.Width,Form1.Height);
  CombineRgn(FRegion1,FRegion1,FRegion2,RGN_XOR);
  // OK to delete this region
  { Make sure we clean up }
  DeleteObject(FRegion2);
  SetWindowRgn(Form1.Handle, FRegion1,True);
  // We need to remove this line...
  //
  // From the Win32 Help File:
  //   After a successful call to SetWindowRgn, the operating system owns the
  // region specified by the region handle hRgn. The operating system does not
  // make a copy of the region. Thus, you should not make any further function
  // calls with this region handle. In particular, do not close this region
  // handle.
  //
  //DeleteObject(FRegion1);
end;

end.

0
 
LVL 12

Expert Comment

by:Faruk Onder Yerli
ID: 2591141
this is a component...
{
 Faruk Onder Yerli
 SOS Computer
}
unit Fform;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TTip = (FSekizGen, FDaire,FDefault,FRoundKare,FSinCos);
  FatihForm = class(TGraphicControl)
  private
    { Private declarations }
    X,Y,
    H,W:Integer;
    FTip        :TTip;                          // Form Tipleri
    FShow       :Boolean;                       // Mesaj için degiþken
    F           :TForm;                         // Aktif Olan Formu kullanmak için
    R           :HRgn;                          // Formun Seklini belirtmek için
    procedure SetStyle(Value: Ttip);            // Form Seklini Seçmek
    procedure SetShow(Value: Boolean);          // Mesajý Aktif Hale Getir
  protected
    { Protected declarations }
  public

  Procedure SetForm;                            // Programdan Çalýþtýrmak için
    { Public declarations }
  published
    { Published declarations }
    Property Show         : Boolean read FShow write SetShow;
    property FormStyle    : Ttip    read FTip  write SetStyle default FSekizGen;
    property Visible;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Facom', [FatihForm]);
end;
Procedure FatihForm.SetForm;
var
    Dizi:Array[0..50] of TPoint;
    I                 :Integer;
    I_                :LongInt;
begin
//F.Handle :=GetActiveWindow;
   F:=TForm(Self.PArent);                             // Aktif Form Bulunuyor
X:=F.Width;
Y:=F.Height;
case ftip of
     FDefault:
              begin
                   R:=CreateRectRgn(0,0,X,Y);           // Çerçeve
                   SetWindowRgn(F.Handle,R,True);       // Ýþi yapan Apý
              end;
     FDaire:
              begin
                   R:=CreateEllipticRgn(0,0,X,Y);       // Elips
                   SetWindowRgn(F.Handle,R,True);
              end;
     FRoundKare:
                begin
                R:=CreateRoundRectRgn(0,0,X,Y,45,45);   // Köþeleri Oval
                SetWindowRgn(F.Handle,R,True);
                end;
     FSinCos:
              begin
              Randomize;
                   for I:=0 to 49 do
                       begin
                           I_:=I;
                           Dizi[I].Y:=Trunc((Sin(I_)+Cos(I_))*random(x));
                           Dizi[I].X:=Round((Sin(I_)-Cos(I_))*random(y));
                       end;
                   R:=CreatePolygonRgn(Dizi,50,Winding); // Polyon
                   SetWindowRgn(F.Handle,R,True);
              end;
     FSekizGen:
              begin
                   Dizi[0].X:=X div 3;                     Dizi[0].Y:=0;
                   Dizi[1].X:=0;                           Dizi[1].Y:=y div 3;
                   Dizi[2].X:=0;                           Dizi[2].Y:=2 * y div 3;
                   Dizi[3].X:=X div 3;                     Dizi[3].Y:=y;
                   Dizi[4].X:=2 *x div 3;                  Dizi[4].Y:=y;
                   Dizi[5].X:=x;                           Dizi[5].Y:=2*y div 3;
                   Dizi[6].X:=x;                           Dizi[6].Y:=y div 3;
                   Dizi[7].X:=2*x div 3;                   Dizi[7].Y:=0;
                   R:=CreatePolygonRgn(Dizi,8,Winding);
                   SetWindowRgn(F.Handle,R,True);
              end;
     end;
     F.Update;
end;
procedure FatihForm.SetShow(Value: Boolean);
begin
FShow:=Value;
       if FShow then
          ShowMEssage('Facom SoftWare '#13+'Fatih BADUR'+#13+'+90 (212) 592 97 80 PBX');
end;

procedure FatihForm.SetStyle(Value: Ttip);
begin
    FTip := Value;
    SetForm;
end;

end.
0
 

Expert Comment

by:hatecapletters
ID: 2593125
hmm, if i have understood the question right you want two circles on the form, an inner and an outer circle, right ?
and you want only the area BETWEEN the inner and the outer cirlce to be visible, leaving the entire rest of the form transparent, right ?
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 2593484
Listening
0
 

Author Comment

by:SHJ_LUX
ID: 2593822
Hi,

Thanks to all so far. I'll look at the proposed solutions (answer and comments, and get back soon)

And Hatecapletters: Yes, you have got it right. I want a circelshape with a hole in the middle AND everything else, including the hole, transparent. As I said, a form looking just like a CD.
0
 

Author Comment

by:SHJ_LUX
ID: 2595932
see below..
0
 

Author Comment

by:SHJ_LUX
ID: 2595948
just what I needed, thanks.

And thanks to everybody else who contributed with comments and answers, I'm sure your entries were just as good, but I found what I was looking for with the help of Kretzschmar.
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 2599446
wow,

glad to helped you
good luck again

meikl
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Michael from AdRem Software outlines event notifications and Automatic Corrective Actions in network monitoring. Automatic Corrective Actions are scripts, which can automatically run upon discovery of a certain undesirable condition in your network.…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses
Course of the Month14 days, 14 hours left to enroll

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question