I am trying to create transparent child window.
procedure TForm1.BtnGoClick(Sender: TObject);
var
bmp:TBitmap;
BitmapPos: TPoint;
BitmapSize: TSIZE;
BlendFunction: _BLENDFUNCTION;
exStyle: Cardinal;
begin
bmp := TBitmap.Create;
bmp.LoadFromFile('my32bitbitmap.bmp');
exStyle := GetWindowLongA(Form2.Handle, GWL_EXSTYLE);
if (exStyle and WS_EX_LAYERED = 0) then
SetWindowLong(Form2.Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);
BitmapPos := Point(0, 0);
BitmapSize.cx := bmp.Width;
BitmapSize.cy := bmp.Height;
BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := 200;
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
UpdateLayeredWindow(Form2.Handle, 0, nil, #BitmapSize, bmp.Canvas.Handle, #BitmapPos, 0, #BlendFunction, ULW_ALPHA);
Windows.SetParent(Form2.Handle, Form1.Handle);
bmp.Free;
end;
It almost works: Form2 become nice transparent window inside Form1. But it looks like Form2 does not move with Form1. When i move Form1, Form2-Window moves, but on screen i see it when it was. When Form1 is moved i cant click on Form2, clicks goes through, so i know window was moved.
So question is how to make child transparent window without these features? (just normal window that moves with it's parrent)
You need to call UpdateLayeredWindow after each move or resize of your Form2. Or you can replace it with TCustomTransparentControl descendant.
Related
First and foremost if more information is required please just ask i'm willing to add more information. (Won't be able to answer earlier until tomorrow 09:00 GMT+1)
Working on an application in delphi with rounded comboboxes and rounded buttons (TCustomControls)
The problems that arise are mainly problems with components that are in some way layered over each other
as can be seen in image one (below)
The background of the form still shines through around the corners while the components are drawn on top of each other.
For every custom control I am painting the component myself. But I can't seem to get a grasp on how to get this to work as it should.
I've tried the following
- Params.exStyle := Params.exStyle + WS_EX_TRANSPARENT;
- ScanLine and set the pixels equal to the background (which doesn't work as one
would suspect)
- WSEraseBackground procedure empty
But nothing seems to fix my problem (WS_EX_TRANSPARENT did but when clicking on a component it seems to flip the Z-order)
I override the paint event and just draw rounded rectangles (shouldn't be a biggy imo)
procedure TRoundedComboBox.Paint;
var
Rect : TRect;
procedure DrawFirst();
begin
{first}
Canvas.Pen.Color := FColorArray[0];
Canvas.Brush.Color := FColorArray[0];
Canvas.RoundRect(0,
0,
width,
FDefaultComboBoxHeight,
20,
20);
end;
procedure DrawFirstInner();
begin
{first inner}
Canvas.Pen.Color := FColorArray[1];
Canvas.Brush.Color := FColorArray[1];
Canvas.RoundRect(0,
1,
width,
FDefaultComboBoxHeight,
20,
20);
end;
procedure DrawSecondInner();
begin
{second inner}
Canvas.Pen.Color := FColorArray[2];
Canvas.Brush.Color := FColorArray[2] ;
Canvas.RoundRect(0,
round(FDefaultComboBoxHeight /2),
width,
FDefaultComboBoxHeight,
20,
20);
end;
procedure DrawText();
begin
{Text}
Canvas.Font := FFont;
Canvas.Font.Color := FColorArray[3];
Canvas.Brush.Style := bsClear;
FTextRect := TRect.Create(4, 0, width -20, FDefaultComboBoxHeight);
Canvas.TextRect(FTextRect,
12,
round(FTextRect.Height /2) - round(Canvas.TextExtent(FText).Height /2),
FText);
end;
procedure DrawTriangle();
begin
{Triangle}
Canvas.MoveTo(FPoints[0].x, FPoints[0].y);
Canvas.Pen.Color := FColorArray[4];
Canvas.Brush.Color := FColorArray[4];
Canvas.Polygon(FPoints);
end;
begin
//inherited;
FListBox.Invalidate;
FListBox.Visible := FEnabledBtnDown;
if (FEnabledBtnDown) then
begin
FlistBOx.SetFocus;
end;
Height := IfThen (FEnabledBtnDown, FMaxmimumComboBoxHeight, FDefaultComboBoxHeight);
DrawFirst;
DrawFirstInner;
DrawSecondInner;
DrawTriangle;
DrawText;
end;
You could derive from TCustomTransparentControl (unit Controls.pas). If that is not an option, take a look at how TCustomTransparentControl works.
I want to put a label inside progress bar. And this label caption is dynamic.
How can I get the label position ALWAYS on center inside the ProgressBar?
What I've tried ;
Label1.Parent := progressBar1;
Label1Top := progressBar1.Height div 2;
Label1.Left := progressBar1.Width div 2
It shows ugly, and not in center like I want.
If I set Label1.Left := progresBar1.Width div 2 - xxx it will be on center only for certain caption. I want to have any caption be placed on center.
Edited
Answer from #KenWhite is working good.
Solution from #DavidHeffernan just great.
Set the label's AutoSize property to False. Change the Alignment property to taCenter and Layout to tlCenter. Size the label to the progressbar's ClientWidth and ClientHeight, and set its Left to 0.
Label1.Parent := progressBar1;
Label1.AutoSize := False;
Label1.Transparent := True;
Label1.Top := 0;
Label1.Left := 0;
Label1.Width := progressBar1.ClientWidth;
Label1.Height := progressBar1.ClientHeight;
Label1.Alignment := taCenter;
Label1.Layout := tlCenter;
Here's an example of the appearance:
You might decide to derive a progress bar control that paints the text itself rather than relying on a separate label. Some sample code to demonstrate:
type
TProgressBarWithText = class(TProgressBar)
private
FProgressText: string;
protected
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
published
property ProgressText: string read FProgressText write FProgressText;
end;
procedure TProgressBarWithText.WMPaint(var Message: TWMPaint);
var
DC: HDC;
prevfont: HGDIOBJ;
prevbkmode: Integer;
R: TRect;
begin
inherited;
if ProgressText <> '' then
begin
R := ClientRect;
DC := GetWindowDC(Handle);
prevbkmode := SetBkMode(DC, TRANSPARENT);
prevfont := SelectObject(DC, Font.Handle);
DrawText(DC, PChar(ProgressText), Length(ProgressText),
R, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
SelectObject(DC, prevfont);
SetBkMode(DC, prevbkmode);
ReleaseDC(Handle, DC);
end;
end;
The advantage of this approach is that your progress bar and text display are self-contained. There's no need for two separate controls that you have to coordinate.
The code below should be creating a bitmap that is a 48x48 rectangle, of blue background color and a Text (actually just a letter) centered horizontally and vertically of white color.
However nothing happens.
procedure MakeCustomIcon(AText: string; AWidth: Integer; AHeight: Integer; AColor: TAlphaColor; var ABlob: TBlob);
var
Bitmap: TBitmap;
Rect: TRectF;
InStream: TMemoryStream;
begin
Bitmap := TBitmap.Create;
InStream := TMemoryStream.Create;
try
Bitmap.SetSize(AWidth, AHeight);
Bitmap.Canvas.Clear(AColor);
Bitmap.Canvas.Stroke.Kind := TBrushKind.bkSolid;
Bitmap.Canvas.StrokeThickness := 1;
Bitmap.Canvas.Fill.Color := TAlphaColorRec.White;
Bitmap.Canvas.BeginScene;
Rect.Create(0, 0, AWidth, AHeight);
Bitmap.Canvas.FillText(Rect, AText, true, 100, [TFillTextFlag.ftRightToLeft], TTextAlign.taCenter, TTextAlign.taCenter);
Bitmap.Canvas.EndScene;
Bitmap.SaveToStream(InStream);
InStream.Position := 0;
ABlob.Clear;
ABlob.LoadFromStream(InStream);
finally
Bitmap.Free;
InStream.Free;
end;
I have tested the rest of my program to make sure the image (that Blob) is actually transporting and getting displayed, and it is doing so. The problem is fully contained on the way it is drawn the bitmap on the method above.
This TBlob is an array of byte.
I am looking to do rectangles like this below, to be used in TListView:
I have prepared a project.
1-) Write Text on TImage
2-) Draw on TImage
3-) Effect to TImage
I Try on XE5
Samples:
procedure ReDraw(Image: TImage);
var
MyRect: TRectF;
begin
if Image.Bitmap.IsEmpty then Exit;
MyRect := TRectF.Create(0, Ozellik.SeritTop, Image.Bitmap.Width, Ozellik.SeritBot);
with Image.Bitmap.Canvas do
begin
BeginScene;
if not Seffaf.IsChecked then
Fill.Color := Ozellik.SeritRenk
else
Fill.Color := TAlphaColorRec.Null;
FillRect(MyRect, 0, 0, [], 1);
Fill.Color := Ozellik.YaziRenk;
if FontCombo.ItemIndex <> -1 then
Font.Family := FontCombo.Items[FontCombo.ItemIndex];
Font.Size := Ozellik.YaziBoyut;
FillText(MyRect,FonYazi.Text.Trim,True,1,[],TTextAlign.taCenter,TTextAlign.taCenter);
EndScene;
end;
Image.Repaint;
end;
http://www.dosya.tc/server32/vHsbaC/CapsYapMasa_st_.rar.html
All canvas drawings must be grouped into a BeginScene/EndScene block. Also, it is recommended to draw within a try-finally block.
So, instead of
Bitmap.Canvas.Clear(AColor);
...
Bitmap.Canvas.BeginScene;
...
Bitmap.Canvas.EndScene;
you should do:
Bitmap.Canvas.BeginScene;
try
Bitmap.Canvas.Clear(AColor);
...
finally
Bitmap.Canvas.EndScene;
end;
-- Regards
The only dock style in JVCL that I know that has the auto hide function (to pin the dock clients) is JvDockVSNetStyle. I'm using it but I can't set the size of the inactive pinned panes' tabs. When hidden, the tabs don't show the title of the pane, only the name of the active pane is shown. Sorry, I can't post an example image because that's my first question.
In the object inpector there is an option called ChannelOption with the ActivePaneSize property. Is there a way to set the inactive pane size so it can show its name? Or maybe there is another dock style that I'm missing that has the same functions?
I'm using C++Builder and JVCL 3.45.
i did it by commenting out these code parts:
procedure TJvDockVSChannel.GetBlockRect(Block: TJvDockVSBlock; Index: Integer;
var ARect: TRect);
var
BlockWidth: Integer;
begin
// HERE
// if Block.VSPane[Index] <> Block.ActivePane then
// BlockWidth := Block.InactiveBlockWidth
// else
BlockWidth := Block.ActiveBlockWidth;
<snip>
procedure TJvDockVSChannel.Paint;
var
I: Integer;
<snip>
begin
VisiblePaneCount := 0;
for I := 0 to Block.VSPaneCount - 1 do
begin
if not Block.VSPane[I].FVisible then
Continue;
GetBlockRect(Block, I, DrawRect);
Canvas.Brush.Color := TabColor;
Canvas.FillRect(DrawRect);
Canvas.Brush.Color := clGray;
Canvas.FrameRect(DrawRect);
AdjustImagePos;
Block.FImageList.Draw(Canvas, DrawRect.Left, DrawRect.Top, I, dsTransparent, itImage);
// HERE
// if Block.ActivePane = Block.VSPane[I] then
begin
if Align in [alTop, alBottom] then
Inc(DrawRect.Left, Block.InactiveBlockWidth)
else
if Align in [alLeft, alRight] then
begin
Inc(DrawRect.Top, Block.InactiveBlockWidth);
if Align = alLeft then
DrawRect.Left := 15
else
DrawRect.Left := 20;
DrawRect.Right := DrawRect.Left + (DrawRect.Bottom - DrawRect.Top);
end;
Canvas.Brush.Color := TabColor;
Canvas.Pen.Color := clBlack;
Dec(DrawRect.Right, 3);
OldGraphicsMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
Canvas.Brush.Style := bsClear;
// HERE (changed options)
DrawText(Canvas.Handle, PChar(Block.VSPane[I].FDockForm.Caption), -1, DrawRect, {DT_END_ELLIPSIS or} DT_NOCLIP);
There is an event in TJvDockServer called DoFinishSetDockPanelSize.
Within the function you create for that event you can access the size of a form using Dockpanel. There may be a way from here to set the size of the tabs.
I need to capture an image of panel.
The problem I am running into is that if the Panel contains a TCombobox the Text does not appear.
procedure AssignPanelImageToPicture(Panel : TPanel;Image : TImage);
var
B : TBitmap;
begin
B := TBitmap.Create;
try
B.Width := Panel.Width;
B.Height := Panel.Height;
B.Canvas.Lock;
Panel.PaintTo(B.Canvas.Handle,0,0);
B.Canvas.Unlock;
Image1.Picture.Assign(B);
finally
B.Free;
end;
end;
Using this code, I drop a panel with a TCombobox on it. Then Enter a value into the Text Property. I also drop a TImage Next two it. Then I add a button to call the above
code.
Here is the result:
Is there a better way to capture a true image of the panel.
What about using the GetDC and BitBlt functions?
procedure AssignPanelImageToPicture(Panel : TPanel;Image : TImage);
var
B : TBitmap;
SrcDC: HDC;
begin
B := TBitmap.Create;
try
B.Width := Panel.Width;
B.Height := Panel.Height;
SrcDC := GetDC(Panel.Handle);
try
BitBlt(B.Canvas.Handle, 0, 0, Panel.ClientWidth, Panel.ClientHeight, SrcDC, 0, 0, SRCCOPY);
finally
ReleaseDC(Panel.Handle, SrcDC);
end;
Image.Picture.Assign(B);
finally
B.Free;
end;
end;