How to make transparent form in lazarus? - pascal

I want to make my form transparent. Then when i make AlphaBlend is true, all of component is transparent. How to make the form is transparent except for the component?
Form in lazarus

Windows solution:
uses Windows;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
Color:=clRed;
SetWindowLongPtr(Self.Handle, GWL_EXSTYLE,GetWindowLongPtr(Self.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
SetLayeredWindowAttributes(Self.Handle, clRed, 0, LWA_COLORKEY);
end;
Filling the form in red color and creation him transparent.

Related

Assign a picture to a TImage and define the background color of transparent pixels

Problem:
I have a TImage on a Delphi VCL form and want to assign a TGraphic.
The picture has transparent pixels.
When displaying the picture inside the TImage I want to display all transparent pixels in the color clBlue.
Unfortunately TImage does not have a property for a background color.
What I have already tried:
Fill the TImage with blue and afterwards to assign the picture:
MyImage.Canvas.Brush.Style := bsSolid;
MyImage.Canvas.Brush.Color := clBlue;
MyImage.Canvas.FillRect(Rect(0, 0, MyImage.Width, MyImage.Height));
MyImage.Picture.Assign(MyGraphic);
Set the TransparentColor of the bitmap:
MyImage.Picture.Bitmap.TransparentColor := clBlue;
MyImage.Picture.Assign(MyGraphic);
Nothing worked :-(
Create a new TBitmap of the desired size, and fill it completely with a solid clBlue color.
Then, draw the source image transparently onto this TBitmap, so that the blue color shows through the transparent areas.
Then, assign this TBitmap to the TImage.
Alternatively, place the TImage onto a TPanel, set the panel's color to clBlue, and then assign the transparent image as-is to the TImage.
Alternatively, use a TPaintBox instead of a TImage. In the TPaintBox.OnPaint event, draw a clBlue background onto the TPaintBox.Canvas, then draw the source image transparently onto the Canvas.
procedure DrawPictureWithBackgroundColor(Image: TImage; Graphic: TGraphic; BackgroundColor: TColor);
begin
Image.Canvas.Brush.Style := bsSolid;
Image.Canvas.Brush.Color := BackgroundColor;
Image.Canvas.FillRect(Rect(0, 0, Image.Width, Image.Height));
Image.Canvas.StretchDraw(Rect(0, 0, Image.Width, Image.Height), Graphic);
end;
Usage:
DrawPictureWithBackgroundColor(MyImage, MyGraphic, clBlue);
MyGraphic contains the picture data itself.
MyImage is the control/container which makes the picture visible on the form.

Draw a vertically centered multi-line string using WinAPI's "DrawText" function

I am trying to draw a word-wrapped string within centered both vertically and horizontally within a bitmap using WinAPI's DrawText function.
The problem is that if text is longer than the available space and "END ELLIPSIS" (...) is added to a cropped string, the reported drawing coordinates returned when using the "DT_CALCRECT" report the uncropped number of lines which messes with the vertical centering calculations.
I read many posts on this, and thought that "Delphi - Draw text multiline in the centre of a rect" may hold the answer, but it didn't (screenshot of the code output using the sample in the linked question http://zoomplayer.com/pix/font_vcenter.jpg). The author of the accepted answer suggested I create a new question so here it is.
For quick-reference, here is a slightly simplified (removing unrelated code) text rendering code from the linked accepted answer:
procedure DrawTextCentered(Canvas: TCanvas; const R: TRect; S: String);
var
DrawRect: TRect;
DrawFlags: Cardinal;
begin
DrawRect := R;
DrawFlags := DT_END_ELLIPSIS or DT_NOPREFIX or DT_WORDBREAK or
DT_EDITCONTROL or DT_CENTER;
DrawText(Canvas.Handle, PChar(S), -1, DrawRect, DrawFlags or DT_CALCRECT);
DrawRect.Right := R.Right;
if DrawRect.Bottom < R.Bottom then
OffsetRect(DrawRect, 0, (R.Bottom - DrawRect.Bottom) div 2)
else
DrawRect.Bottom := R.Bottom;
DrawTextEx(Canvas.Handle, PChar(S), -1, DrawRect, DrawFlags, nil);
end;
As you can see from the screenshot, the problem is after the initial call to DrawText with the "DT_CALCRECT" flag to measure the output height for later vertical centering, rendering the string "Trending in: Worldwide" returns a DrawRect.Bottom value representing 3 lines of text even though only 2 lines are drawn, breaking the vertical centering code.

Load Gif with animation in lazarus

I used this code to load an image (gif)
image:TGIFImage;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
image:=TGIFImage.Create;
image.LoadFromFile('F:\ltdk\pic\bom.gif');
image3.Picture.Assign(image);
end;
but it doesn't work , so I need know how to load gif with animation in lazarus ?
thanks
Creating a TGIFImage and loading the GIF in it will only show a frame of the file, not animate it. In order to animate a GIF file you need some code.
You can check out these resources:
(The last message on this page:)
http://forum.lazarus.freepascal.org/index.php/topic,14884.msg80387.html#msg80387
http://forum.lazarus.freepascal.org/index.php?topic=7818.0

delete font created by CreateFont

If I use CreateFont() to create a font (as non-static variable) and use SelectObject to use itin a function, then before exit that function, I have to select the previous object and use DeleteObject to delete the font.
But if I declare a global variable HFONT gFont = CreateFont(...), then in the WM_DESTROY message, should I call DeleteObject to delete the font?
Also in this case, if I use hOldFont = SelectObject(memDC, gFont); in a function, should I call SelectObject(memDC, hOldFont);before exit that function? It seems to me that, for Bitmap, we should do this clean up, but I don't know if this is true for other GDI objects.
Think of each DeviceContext (DC) as a canvas. Each of these canvases can only have one active GDI object for each type at a time. So, you can have one Brush, Pen, Font, etc selected for that canvas as the active one.
When you call SelectObject() you are setting the active object of that type. Think of it as "picking up the red pen to draw, then picking up the blue pen to draw." If a GDI function takes a Pen (such as Rectangle), it will use the last selected pen via SelectObject. This is why SelectObject returns the previous value so you can store it for restoring state when you are done.
You should always use DestroyObject on any created GDI object that you no longer need. In addition, you should always use DeleteDC for every CreateDC call and ReleaseDC for every GetDC call (when you no longer need the DC).
It is best practice to restore the DeviceContext (DC) to the way you found it. So if you set the Font or Brush, you should restore it to the original value before returning. The only time where restoring is not important is when you are about to dispose of the DC anyways, perhaps in the case of a temporary Bitmap.
If you you use GetStockObject, you do not need to call DeleteObject.
A Delphi (Pascal) example:
Procedure AngleTextOut(hDC: THandle; const sTxt: string; iX, iY, iH, iAngle: integer);
var
aryC: array[0..255] of Char;
hFont, hFontOld: THandle;
begin
StrPCopy(aryC, sTxt);
hFont:= CreateFont(-iH, 0, iAngle *10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 'arial');
hFontOld:= SelectObject(hDC, hFont);
TextOut(hDC, iX, iY, aryC, StrLen(aryC));
SelectObject(hDC, hFontOld);
DeleteObject(hFont);
end;// AngleTextOut

How to render RichEdit Text to a canvas by keeping font smoothness

i am trying to render RichEdit to a bitmap. I want to make backgrond tranparent.
I could achieve that by the code above. The problem is that when i set bitmap as tranparent
only the transparent color becomes transparent. Is there any way to handle the pixels on the edge
which are diffrent from background color and also different from font color. i mean making the pixels
semi-tranparent on the edge which makes a smooth view.
Graphics::TBitmap *bitmap = new Graphics::TBitmap();
bitmap->Width = RichEdit1->Width ;
bitmap->Height = RichEdit1->Height ;
TRect BoundingBox(0,0,RichEdit1->Width, RichEdit1->Height) ;
// Render RichEdit to bitmap
TFormatRange formatRange;
int twipsPerPixel = 1440 / Screen->PixelsPerInch;
formatRange.hdc = bitmap->Canvas->Handle;
formatRange.hdcTarget = bitmap->Canvas->Handle;
formatRange.chrg.cpMin = 0;
formatRange.chrg.cpMax = -1;
formatRange.rc.top = 2 * twipsPerPixel;
formatRange.rc.bottom = (BoundingBox.Height() - 4) * twipsPerPixel + formatRange.rc.top;
formatRange.rc.left = 2 * twipsPerPixel;
formatRange.rc.right = (BoundingBox.Width() - 4) * twipsPerPixel;
// Measure text's height.
RichEdit1->Perform(EM_FORMATRANGE, 0, 0);
RichEdit1->Perform(EM_FORMATRANGE, 0, (LPARAM) &formatRange);
formatRange.rc.bottom = (BoundingBox.Height() - 4) * twipsPerPixel + formatRange.rc.top;
formatRange.rc.left = 2 * twipsPerPixel;
formatRange.rc.right = (BoundingBox.Width() - 4) * twipsPerPixel;
formatRange.rcPage = formatRange.rc;
/**
* Draw..
**************************************************************************/
RichEdit1->Perform(EM_FORMATRANGE, 1, (LPARAM) &formatRange);
RichEdit1->Perform(EM_FORMATRANGE, 0, 0);
// Draw background
// Use different background color to see the trasparency problem
this->Canvas->Brush->Color = clRed ;
this->Canvas->Rectangle(0,0,RichEdit1->Width , RichEdit1->Height );
// Draw the transparent bitmap
bitmap->Transparent = true ;
bitmap->TransparentColor = RichEdit1->Color ;
this->Canvas->Draw(0,0,bitmap);
Thanx.
Font smoothing works with partial transparency using an alpha channel. The Transparent and TransparentColor properties of TBitmap are therefore not applicable.
You haven't said which version of the C++ Builder/VCL you are using, but more modern versions have better support for partial transparency than some of the older ones.
To get this to work you will need to set the PixelFormat of your bitmap to be pf32bit. You may also need to set AlphaFormat to afDefined.
If you can't get TBitmap to do what you need then you'll have to revert to GDI commands to create a suitable HBITMAP. You can at least assign that to the Handle property of a TBitmap and usually from there everything behaves.
Note that I am not a user of C++ Builder but do know the VCL from Delphi.
UPDATE
I tried this out in Delphi and the following worked fine for me:
procedure TForm4.Button1ClickBMP(Sender: TObject);
var
BMP: TBitmap;
fmtRange: TFormatRange;
intPPI, Flags: Integer;
begin
BMP := TBitmap.Create;
Try
BMP.PixelFormat := pf32bit;
BMP.SetSize(RichEdit1.Width, RichEdit1.Height);
FillChar(fmtRange, SizeOf(fmtRange), 0);
with fmtRange do begin
hDC := BMP.Canvas.Handle;
hdcTarget := hDC;
intPPI := Screen.PixelsPerInch;
rc := Rect(
0,
0,
RichEdit1.Width*1440 div intPPI,
RichEdit1.Height*1440 div intPPI
);
rcPage := rc;
chrg.cpMin := 0;
chrg.cpMax := -1;
end;
Flags := 1;
RichEdit1.Perform(EM_FORMATRANGE, Flags, Longint(#fmtRange));
RichEdit1.Perform(EM_FORMATRANGE, 0, 0);
BMP.SaveToFile('c:\desktop\test.bmp');
Finally
FreeAndNil(BMP);
End;
end;
The output looks like this, blown up somewhat to see the anti-aliasing:
I hope this helps, because it looks like you are very nearly there!
As David has answered already, sub-pixel antialiasing requires knowledge of the background colour. This is explained in more detailed in this answer. In essence, when you do sub-pixel anti-aliasing you treat the three colour channels as having different spatial offsets (which is where the apparent increase in resolution comes from). This means they need different alpha values, but of course there is only one alpha channel.
You can of course do regular full-pixel grayscale antialiasing over a transparent background. Perhaps this would be good enough? Some of the other answers in the question linked above suggest ways to achieve this. Have a look at ANTIALIASED_QUALITY (vs. CLEARTYPE_QUALITY) in the LOGFONT structure. (I haven't tried this.)

Resources