Solved

Question regarding a bitmap, as the form background, which is transparant but not smooth

Posted on 2006-07-21
3
302 Views
Last Modified: 2010-04-05
Hi all

I have been searching through the answers here, and did not get what i wanted, i am using code i found here, to show a form that is rounded, and has transparant regions, see thew code below, but I think it cannot be antialiased, or simply said, smoothed edges?

I can live with it, if it cannot be done, so a simple "no" is an answer as well, then i can stop trying, but if it can be done pls help me out, i have enough knolwedge to create any sort of graphic in paint shop pro, that is not the point, but i cannot make delphi use just it as i created it.

unit unittr;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtDlgs, OleCtrls;

type
  TForm1 = class(TForm)
    Btn1: TButton;
    dlgOpenPicOpenPicDialog1: TOpenPictureDialog;
    btn2: TButton;
    procedure Btn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Btn2Click(Sender: TObject);
    private
    { Private declarations }
    Region1: HRgn;
    RgnStart: Boolean;
    PixStart, RgnX, RgnY: Integer;
    Adj: Byte;
    SkinBmp: TBitmap;
    function ReturnRgn(ThisRgn: HRgn): Hrgn;
    function MakeRegion: Integer;
    procedure SetRegion;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
 implementation

{$R *.DFM}

function TForm1.ReturnRgn(ThisRgn: HRgn): Hrgn;
var
TempRgn2 : HRgn;
begin
{in Win 98 there is unusual problems when combining Regions,
if you Combine a region more than about 400 times, Win 98 does
strange things, this is my solution. This combines the region but
the pointer references to this function, ThisRgn, and TempRgn2 are
gone when the function is done}
TempRgn2 := 0;
if RgnStart then
     begin
     ThisRgn :=CreateRectRgn(PixStart,RgnY,RgnX+Adj,RgnY+1);
     RgnStart := False;
     Adj := 0;
     PixStart := 0;
     end
  else
     begin
     TempRgn2 := CreateRectRgn(PixStart,RgnY,RgnX+Adj,RgnY+1);
     CombineRgn(ThisRgn, ThisRgn, TempRgn2, RGN_OR);
     Adj := 0;
     PixStart := 0;
     end;

Result := ThisRgn;
if TempRgn2 <> 0 then
DeleteObject(TempRgn2);
end;

function TForm1.MakeRegion: Integer;
{DoMask sets the bitmap used to the Mask or Image}
Type
  PRGBArray = ^TRGBArray;
  TRGBArray = Array[0..16383] of TRGBTriple;
{I use TRGBArray to make the ScanLine output (array of byte) have color references
I have limited it to 16384 so your Bitmaps have to be less
than 16384 wide}

var
TempBmp: TBitmap;
TempRgn: HRgn;
x, y, Error1: Integer;
PixRgn: Boolean;
Prgb: PRGBArray;
xColor: TColor;
Variation, RLoVar, RHiVar, GLoVar, GHiVar, BLoVar, BHiVar: Byte;

function LimitToByte(Value: Integer): Byte;
begin
if Value < 0 then
Result := 0 else
If Value > 255 then
Result := 255 else
Result := Value;
end;

begin
{this makes a region by doing a scanline on an Image (MaskBmp or ImageBmp)
and then making a region for that line segment and then combining the
segment regions into the final region
the DoMask is used by me, because I do alot of graphics editing and Masks are
the easist way for me to deal with creating a region from an Image, often photo
images will have spots of the Transparent color, I can get rid of spots in the mask}
Result := 0;
RgnStart := True;
PixRgn := False;
PixStart := 0;
Adj := 0;
TempRgn := CreateRectRgn(0,0,0,0);
TempBmp := TBitmap.Create;

  TempBmp.Assign(SkinBmp);
  xColor := SkinBmp.Canvas.Pixels[0,SkinBmp.Height -1];
  {the amount of color variation
  allowed for the Transparent Color, I call it Variation}
  Variation := 18;
  {RLoWob and RHiWob are the Hi and Low limits of the Color allowed}
  RLoVar := LimitToByte(GetRValue(xColor) - Variation);
  RHiVar := LimitToByte(GetRValue(xColor) + Variation);
  GLoVar := LimitToByte(GetGValue(xColor) - Variation);
  GHiVar := LimitToByte(GetGValue(xColor) + Variation);
  BLoVar := LimitToByte(GetBValue(xColor) - Variation);
  BHiVar := LimitToByte(GetBValue(xColor) + Variation);
  //end;

TempBmp.PixelFormat := pf24bit;
{for this Scanline the Image MUST be in pf24Bit}
Application.ProcessMessages;

{This is the scanline, which may take a several seconds on large Images
I can not begin to explain using scanline here}
for y := 0 to TempBmp.Height -1 do
      begin
      RgnY := y;
      Prgb := TempBmp.ScanLine[y];
      for x := 0 to TempBmp.Width -1 do
        begin
        RgnX := x;
        with Prgb[x] do
        if (rgbtRed >= RLoVar) and (rgbtRed <= RHiVar) and (rgbtGreen >= GLoVar) and (rgbtGreen <= GHiVar) and (rgbtBlue >= BLoVar) and (rgbtBlue <= BHiVar) then
          begin
          if PixRgn then TempRgn := ReturnRgn(TempRgn);
          PixRgn := False;
          end
        else
        begin
        if not PixRgn then PixStart := x;
        if x = TempBmp.Width -1 then
          begin
          Adj := 1;
          TempRgn := ReturnRgn(TempRgn);
          end;
          PixRgn := True;
        end;
      end;
      end;
Result := CreateRectRgn(0,0,0,0);
Error1 := CombineRgn(Result, TempRgn, Result, RGN_COPY);
if (Error1 = NULLREGION) or (Error1 = ERROR) then
Result := 0;
DeleteObject(TempRgn);
FreeAndNil(TempBmp);
end;

procedure TForm1.Btn1Click(Sender: TObject);
begin
{this is the EXit button click}
Close;
end;

procedure TForm1.SetRegion;
var
Rgn2: HRGN;
begin
if not SkinBmp.Empty then
  begin
  Width := SkinBmp.Width;
  Height := SkinBmp.Height;
  {Button1.Left := Width-Button1.Width;
  Button1.Top := 5;}
  Btn1.Left := (Width div 2) - (Btn1.Width div 2);
  Btn1.Top := ((Height div 2) - (Btn1.Height div 2))-16;
  Btn2.Left := (Width div 2) - (Btn2.Width div 2);
  Btn2.Top := (Height div 2) - (Btn2.Height div 2)+16;
  end else Exit;

Region1 := MakeRegion;
if Region1 = 0 then
  begin
  SetWindowRgn(Handle, 0, TRUE);
  ShowMessage('ERROR, Failed to make Shape Region');
  Exit;
  end;
{you can Not tell if your Buttons will be in the visible region
so I create 2 additional regions, one for each button and add them to
the visible region so you can use the buttons}
Rgn2 := CreateRectRgn(Btn1.Left, Btn1.Top, Btn1.Left+Btn1.Width,Btn1.Top+Btn1.Height);
CombineRgn(Region1, Rgn2, Region1, RGN_OR);
DeleteObject(Rgn2);
Rgn2 := CreateRectRgn(Btn2.Left, Btn2.Top, Btn2.Left+Btn2.Width,Btn2.Top+Btn2.Height);
CombineRgn(Region1, Rgn2, Region1, RGN_OR);
DeleteObject(Rgn2);
SetWindowRgn(Handle, Region1, TRUE);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SkinBmp := TBitmap.Create;
SkinBmp.LoadFromFile(ExtractFilePath(Application.ExeName)+'masked2.bmp');
BorderStyle := bsNone;
SetRegion;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(0,0, SkinBmp);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SkinBmp.Free;
DeleteObject(Region1);
end;

procedure TForm1.Btn2Click(Sender: TObject);
var
Bmp2: TBitmap;
begin
{this is the Open Bitmap click}
dlgOpenPicOpenPicDialog1.InitialDir := 'C:\';
dlgOpenPicOpenPicDialog1.Filter := 'Bitmap|*.bmp';
dlgOpenPicOpenPicDialog1.FilterIndex := 0;
if dlgOpenPicOpenPicDialog1.Execute then
begin
Bmp2 := TBitmap.Create;
try
Bmp2.LoadFromFile(dlgOpenPicOpenPicDialog1.FileName);
if (Bmp2.Height < Btn1.Height+ Btn2.Height+16) or
  (Bmp2.Width < Btn2.Width+8) then
  begin
  ShowMessage('ERROR, This Bitmap Image is TOO SMALL');
  Exit;
  end;
SkinBmp.Assign(Bmp2);
  finally
  Bmp2.Free;
  end;
SetRegion;
FormPaint(self);
end;
end;


initialization
  form1 := Tform1.Create(nil);
  Form1.Show;
  form1.Update;
  end;
  end;
end.
0
Comment
Question by:fdehell
  • 2
3 Comments
 
LVL 26

Accepted Solution

by:
Russell Libby earned 500 total points
ID: 17155873

Frank,

Unfortunately, there is no anti-aliasing built into the primitive drawing functions in the GDI library. So that leaves you with a couple of options:

- Use the GDI+ library, more info can be obtained here:
http://www.vclcomponents.com/Delphi/Image_Processing/GDIPLUS-info.html

- Create an image that is either 2x or 4x the region size you want the output to be, and use the HALFTONE mode for the StretchBlt, eg (does not work on Win95/98 systems):

var  lpPoint:       TPoint;
begin
  SetStretchBltMode(Canvas.Handle, HALFTONE);
  SetBrushOrgEx(Canvas.Handle, 0, 0, @lpPoint);
  StretchBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, SkinBmp.Canvas.Handle, 0, 0, SkinBmp.Width, SkinBmp.Height, SRCCOPY);
end;

- Manually antialias your image. An example can be found in the Jedi code library (JclGraphics), quick link:
http://www.koders.com/kv.aspx?fid=1DF4D91A23AF9688471FA339A4E276A44C33099A

Put to your code, it would look like (the routine is not mine, its the Jedi groups, I take no credit for it)

procedure TForm1.ProcessImage;
type
  TByteArray = array [0..MaxLongint - 1] of Byte;
  PByteArray = ^TByteArray;
var
  Antialias: TBitmap;
  X, Y: Integer;
  Line1, Line2, Line: PByteArray;
begin

  if (SkinBmp.PixelFormat <> pf24bit) then SkinBmp.PixelFormat := pf24bit;

  Antialias:=TBitmap.Create;
  try
     with SkinBmp do
     begin
        Antialias.PixelFormat := pf24bit;
        Antialias.Width := Width div 2;
        Antialias.Height := Height div 2;
        for Y := 0 to Antialias.Height - 1 do
        begin
           Line1:= ScanLine[Y * 2];
           Line2:= ScanLine[Y * 2 + 1];
           Line:=Antialias.ScanLine[Y];
           for X:=0 to Antialias.Width-1 do
           begin
              Line[X * 3] := (Integer(Line1[X * 6]) + Integer(Line2[X * 6]) +
                 Integer(Line1[X * 6 + 3]) + Integer(Line2[X * 6 + 3])) div 4;
              Line[X * 3 + 1] := (Integer(Line1[X * 6 + 1]) + Integer(Line2[X * 6 + 1]) +
                 Integer(Line1[X * 6 + 3 + 1]) + Integer(Line2[X * 6 + 3 + 1])) div 4;
              Line[X * 3 + 2] := (Integer(Line1[X * 6 + 2]) + Integer(Line2[X * 6 + 2]) +
              Integer(Line1[X * 6 + 3 + 2]) + Integer(Line2[X * 6 + 3 + 2])) div 4;
           end;
        end;
     end;
     SkinBmp.Assign(Antialias);
  finally
     AntiAlias.Free;
  end;

end;

-----

Regards,
Russell




0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 17156376
Almost forget alpha blending, which can "smoothen" things out visually as well. But again, its one of those things that is not available on the older Win9x systems.

procedure TForm1.ProcessImage;
var  Antialias:  TBitmap;
     lpBlend:    _BLENDFUNCTION;
begin

  // Fill in blend function
  lpBlend.BlendOp:=AC_SRC_OVER;
  lpBlend.BlendFlags:=0;
  lpBlend.SourceConstantAlpha:=128; // Adjust for different blending levels
  lpBlend.AlphaFormat:=0;
  if (SkinBmp.PixelFormat <> pf24bit) then SkinBmp.PixelFormat := pf24bit;
  Antialias:=TBitmap.Create;
  try
     Antialias.PixelFormat := pf24bit;
     Antialias.Width:=SkinBmp.Width;
     Antialias.Height:=SkinBmp.Height;
     AlphaBlend(Antialias.Canvas.Handle, 0, 0, Antialias.Width, Antialias.Height, SkinBmp.Canvas.Handle, 0, 0, SkinBmp.Width, SkinBmp.Height, lpBlend);
     SkinBmp.Assign(Antialias);
  finally
     AntiAlias.Free;
  end;

end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, SkinBmp);
end;
0
 
LVL 1

Author Comment

by:fdehell
ID: 17165709
Thank you Russel, I have been busy with all the suggestions you made, and came to the same conclusion, i will have to do with a less rounded window haha

Frank
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
proper way to parse text with delphi 7 101
delphi exception 7 63
error 1.1 400 Bad request idhttp delphi 18 55
Can Viruses spread while transferring Binary data with Winsock 2 66
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Windows 10 is mostly good. However the one thing that annoys me is how many clicks you have to do to dial a VPN connection. You have to go to settings from the start menu, (2 clicks), Network and Internet (1 click), Click VPN (another click) then fi…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

920 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

13 Experts available now in Live!

Get 1:1 Help Now