Solved

Forms - Circelshapes - Transparent

Posted on 2000-03-06
18
274 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
18 Comments
 
LVL 27

Expert Comment

by:kretzschmar
Comment Utility
hi,

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

meikl
0
 
LVL 27

Accepted Solution

by:
kretzschmar earned 500 total points
Comment Utility
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
Comment Utility
Just said! 1stClass components work but you should pay for it. :)
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
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
Comment Utility
Look Library component FormRGN:
http://delphi.vitpc.com/library/index.htm
0
 
LVL 1

Expert Comment

by:umulig
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
It's a goldmine of URL's !!
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 5

Expert Comment

by:TheNeil
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Listening
0
 

Author Comment

by:SHJ_LUX
Comment Utility
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
Comment Utility
see below..
0
 

Author Comment

by:SHJ_LUX
Comment Utility
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
Comment Utility
wow,

glad to helped you
good luck again

meikl
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Simple Delphi Question 9 77
Printing problem 2 72
Delphi XE10 Round Image 2 48
Dev Express grid collapse 2 33
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

763 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now