I am applying the code to change the menu. In delphi 7 it works fine in lazarus nothing happens. What can I do with this.
procedure TForm1.FormCreate(Sender: TObject);
begin
ImageList1.Width := 5;
ImageList1.Height := 5;
MainMenu1.Images := ImageList1; // component
Screen.MenuFont.Name := 'Courier New';
Screen.MenuFont.Size := 5;
end;
I compiled the code in lazarus and nothing changes the menu.
Related
I have overcome some strange behavior when working with TabSheets on a PageControl and controling their visibility. For a simple example, add a PageControl on a Form, add two TabSheets to that PageControl, add a Label to each TabSheet and assign the Forms OnCreate event.
The Code for OnCreate is like:
procedure TForm1.FormCreate(Sender: TObject);
function Cond1: Boolean;
begin
result := 1=1;
end;
function Cond2: Boolean;
begin
result := 2=2;
end;
begin
TabSheet1.Visible := Cond1;
TabSheet1.TabVisible := Cond1;
if not (Cond1) then
if PageControl1.ActivePage = TabSheet1 then
PageControl1.ActivePage := TabSheet2;
TabSheet2.Visible := Cond2;
TabSheet2.TabVisible := Cond2;
if not(Cond2) then
if PageControl1.ActivePage = TabSheet2 then
PageControl1.ActivePage := nil;
ShowMessage(IntToStr(PageControl1.ActivePageIndex));
//PageControl1.ActivePage.BringToFront; //uncomment to work properly
end;
As you can see, the Active page is still TabSheet1, but the content of TabSheet2 is displayed.
Using the BringToFront, everything works as expected, but this seems quite odd to me.
Is there a better way to control these visibilities, maybe using the PageControl for this?
PS: I'm using VCL, not Firemonkey
Remove assignments to TabSheet1.Visible and TabSheet2.Visible, those assignments mess up tabs visibility.
begin
// TabSheet1.Visible := Cond1;
TabSheet1.TabVisible := Cond1;
if not (Cond1) then
if PageControl1.ActivePage = TabSheet1 then
PageControl1.ActivePage := TabSheet2;
// TabSheet2.Visible := Cond2;
TabSheet2.TabVisible := Cond2;
if not(Cond2) then
if PageControl1.ActivePage = TabSheet2 then
PageControl1.ActivePage := nil;
ShowMessage(IntToStr(PageControl1.ActivePageIndex));
end;
[Delphi XE5 Up2]
I am trying to use TPopUp to inherit and create a component, following the same idea as exposed on the Flyouts demo for the CalendarFlyout. I will be not using the Calendar, but I want that space free so that I can place any other FMX component that I want.
I have made the component using the new component wizard and added some controls:
unit PopupTest;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Controls,
FMX.Layouts, FMX.StdCtrls;
type
TPopupTest = class(TPopup)
private
FPanel : TPanel;
FLayoutButton : TLayout;
FCloseButton : TButton;
FSaveButton : TButton;
FClientArea : TLayout;
protected
procedure OnClose(Sender: TObject);
procedure OnSave(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TPopupTest]);
end;
{ TPopupTest }
constructor TPopupTest.Create(AOwner: TComponent);
begin
inherited;
FPanel := TPanel.Create(self);
FPanel.Position.X := 0;
FPanel.Position.Y := 0;
FPanel.Margins.Left := 10;
FPanel.Margins.Right := 10;
FPanel.Margins.Top := 10;
FPanel.Margins.Bottom := 10;
FPanel.StyleLookup := 'flyoutpanel';
FPanel.Align := TAlignLayout.alClient;
FPanel.Visible := True;
FLayoutButton := TLayout.Create(FPanel);
FLayoutButton.Align := TAlignLayout.alBottom;
FLayoutButton.Height := 22;
FCloseButton := TButton.Create(FLayoutButton);
FCloseButton.Align := TAlignLayout.alLeft;
FCloseButton.StyleLookup := 'flyoutbutton';
FCloseButton.Text := 'Fechar';
FCloseButton.OnClick := OnClose;
FSaveButton := TButton.Create(FLayoutButton);
FSaveButton.Align := TAlignLayout.alLeft;
FSaveButton.StyleLookup := 'flyoutbutton';
FSaveButton.Text := 'Salvar';
FSaveButton.OnClick := OnSave;
FClientArea := TLayout.Create(FPanel);
FClientArea.Align := TAlignLayout.alClient;
Width := 100;
Height := 100;
end;
destructor TPopupTest.Destroy;
begin
FClientArea.Free;
FCloseButton.Free;
FSaveButton.Free;
FLayoutButton.Free;
FPanel.Free;
inherited;
end;
procedure TPopupTest.OnClose(Sender: TObject);
begin
end;
procedure TPopupTest.OnSave(Sender: TObject);
begin
end;
end.
I have made several tests and nothing appears, just the popup itself, nothing inside. I am using the MetropoliUI style and the Styles on the component for the inner controls are based on that style.
For simplicity I have remove everything else and compiled and tested.
I am using the TPopUp for several reasons, but the main one is that my "dialog" will be inserted on the form, and I will add to it some TEdits that will be connected by LiveBinding to the same DataSet etc on the form. So no need to create another form with everything else, and preserve all the context (at least I believe this is the right thing to do)
What I am looking for:
What is missing to make all the internal controls appear
How to make sure that the FClientArea, that is a TLayout will be available for the user to add other controls on it?
The final result would like this:
Where in the middle area is a TLayout where I could drop other controls like TEdit.
When you create the TPopupTest in your form you have to set the creator's owner to your Form, as well as the Parent.
Changing the Unit to something like this will make it appear but it's not exactly as you picture it, you will have to refine it a bit. Also my solution might not be the best but at least you will get to see something now.
constructor TPopupTest.Create(AOwner: TComponent);
var
PopPanel: TPanel;
PopLayout: TLayout;
PopClose: TButton;
PopSave: TButton;
PopClientArea: TLayout;
begin
inherited;
PopPanel := TPanel.Create(Owner);
PopPanel.Position.X := 0;
PopPanel.Position.Y := 0;
PopPanel.Margins.Left := 10;
PopPanel.Margins.Right := 10;
PopPanel.Margins.Top := 10;
PopPanel.Margins.Bottom := 10;
PopPanel.StyleLookup := 'flyoutpanel';
PopPanel.Parent := Owner as TFmxObject;
PopPanel.Align := TAlignLayout.alClient;
PopPanel.Visible := True;
PopLayout := TLayout.Create(Owner);
PopLayout.Parent := PopPanel;
PopLayout.Align := TAlignLayout.alBottom;
PopLayout.Height := 22;
PopClose := TButton.Create(Owner);
PopClose.Parent := PopLayout;
PopClose.Align := TAlignLayout.alLeft;
PopClose.StyleLookup := 'flyoutbutton';
PopClose.Text := 'Fechar';
PopClose.OnClick := OnClose;
PopSave := TButton.Create(Owner);
PopSave.Parent := PopLayout;
PopSave.Align := TAlignLayout.alLeft;
PopSave.StyleLookup := 'flyoutbutton';
PopSave.Text := 'Salvar';
PopSave.OnClick := OnSave;
PopClientArea := TLayout.Create(Owner);
PopClientArea.Parent := PopPanel;
PopClientArea.Align := TAlignLayout.alClient;
FPanel:= PopPanel;
FLayoutButton:= PopLayout;
FSaveButton:= PopSave;
FCloseButton:= PopClose;
FClientArea:= PopClientArea;
Width := 100;
Height := 100;
end;
I have a little problem. I'm trying to create a TPaintBox on a TPanel like this:
procedure TForm1.mkPaint(S: string);
var PB: TPaintBox;
begin
PB := TPaintBox.Create(Self);
with PB do
begin
Parent := Panel1;
Visible := True;
Name := S;
Height := 100;
Width := 100;
Left := 8;
Top := 8;
// ParentColor := False;
Brush.Style := bsSolid;
Brush.Color := $00000000;
end;
Application.ProcessMessages;
end;
Now, if i change the PaintBox's Parent to Form1, i can see the brush.
But, with parent changed to Panel1, nothing happens. Any idea of how can i fix this?
Thanks in advance!
Is the TPanel visible to begin with?
Also, TPaintBox does not have a public Brush property (perhaps you are thinking of TShape?). TWinControl does, but TPaintBox is not a TWinControl descendant. It is a TGraphicControl descendant.
Yeah that was a mistake of mine. I changed the code to:
pb := TPaintBox.Create(self);
with pb do begin
Parent := Form1;
Visible := true;
Top := 1;
Left := 1;
Width := 250;
Height := 100;
ParentColor := false;
Canvas.Brush.Color := clBlack;
Canvas.Font.Size := 12;
Canvas.Font.Color := clWhite;
Canvas.FillRect(ClientRect);
Canvas.TextOut(1, 1, 'test');
end;
but without success.. i mean, if i drop a PaintBox component to the form then the code is taking effect as it should do, but dynamically creating a TPaintBox.... dunno.
I asked a question about this some years back when Vista was first released, but never resolved the problem and shelved it as something to consider later.
I have a splash screen that I went to great effort to make look great. It's a 32bpp alpha-blended PNG. I have some code (which I can dig up if required!) that works great under Windows XP or under Vista+ when desktop composition is turned off. However, under Vista+ all the transparent parts are black, destroying everything that looks great about it!
So, my question is this: as anyone been able to display a 32bpp alpha-blended PNG as a splash screen in a way that works both with and without desktop composition activated? I'm not adverse to using third-party components if required, free or otherwise.
Ideally, this would work in Delphi 7.
Update: Besides the answers below, which work very well, I found that the TMS TAdvSmoothSplashScreen component also handles this task very well, if somewhat more complex.
Tim, I just tried this on Vista/D2007 with 'Windows Classic' theme selected:
Alpha Blended Splash Screen in Delphi - Part 2
http://melander.dk/articles/alphasplash2/2/
no black background that I could see... it still looks great.
The article Bob S links to gives the correct answer. Since that article contains quite a bit extra information that you actually need, here is the form/unit I create through it (Note that you'll need the GraphicEx library from here:
unit Splash2Form;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, GraphicEx;
type
TSplash2 = class(TForm)
private
{ Private declarations }
procedure PreMultiplyBitmap(Bitmap: TBitmap);
public
constructor Create(Owner: TComponent);override;
{ Public declarations }
procedure CreateParams(var Params: TCreateParams);override;
procedure Execute;
end;
var
Splash2: TSplash2;
implementation
{$R *.dfm}
{ TSplash2 }
constructor TSplash2.Create(Owner: TComponent);
begin
inherited;
Brush.Style := bsClear;
end;
procedure TSplash2.CreateParams(var Params: TCreateParams);
begin
inherited;
end;
procedure TSplash2.Execute;
var exStyle: DWORD;
BitmapPos: TPoint;
BitmapSize: TSize;
BlendFunction: TBlendFunction;
PNG: TPNGGraphic;
Stream: TResourceStream;
begin
// Enable window layering
exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
if (exStyle and WS_EX_LAYERED = 0) then
SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);
PNG := TPNGGraphic.Create;
try
Stream := TResourceStream.Create(HInstance, 'SPLASH', RT_RCDATA);
try
PNG.LoadFromStream(Stream);
finally
Stream.Free;
end;
PreMultiplyBitmap(PNG);
ClientWidth := PNG.Width;
ClientHeight := PNG.Height;
BitmapPos := Point(0, 0);
BitmapSize.cx := ClientWidth;
BitmapSize.cy := ClientHeight;
// Setup alpha blending parameters
BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := 255;
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
// ... and action!
UpdateLayeredWindow(Handle, 0, nil, #BitmapSize, PNG.Canvas.Handle,
#BitmapPos, 0, #BlendFunction, ULW_ALPHA);
Show;
finally
PNG.Free;
end;
end;
procedure TSplash2.PreMultiplyBitmap(Bitmap: TBitmap);
var
Row, Col: integer;
p: PRGBQuad;
PreMult: array[byte, byte] of byte;
begin
// precalculate all possible values of a*b
for Row := 0 to 255 do
for Col := Row to 255 do
begin
PreMult[Row, Col] := Row*Col div 255;
if (Row <> Col) then
PreMult[Col, Row] := PreMult[Row, Col]; // a*b = b*a
end;
for Row := 0 to Bitmap.Height-1 do
begin
Col := Bitmap.Width;
p := Bitmap.ScanLine[Row];
while (Col > 0) do
begin
p.rgbBlue := PreMult[p.rgbReserved, p.rgbBlue];
p.rgbGreen := PreMult[p.rgbReserved, p.rgbGreen];
p.rgbRed := PreMult[p.rgbReserved, p.rgbRed];
inc(p);
dec(Col);
end;
end;
end;
end.
How to dim / fade all other windows of an application in Delphi 2009.
Form has an AlphaBlend property, but it controls only transparency level. But it would be nice if we can have something like this
(Concentrated window) . Even stackoverflow.com does that, when we try to insert a link/ image etc in the post.
How can we achieve this in a delphi application?
Here is a unit I just knocked together for you.
To use this unit drop a TApplication component on your main form and in the OnModalBegin call _GrayForms and then in the OnModalEnd call the _NormalForms method.
This is a very simple example and could be made to be more complex very easily. Checking for multiple call levels etc....
For things like system (open, save, etc) dialogs you can wrap the dialog execute method in a try...finally block calling the appropriate functions to get a similar reaction.
This unit should work on Win2k, WinXP, Vista and should even work on Win7.
Ryan.
unit GrayOut;
interface
procedure _GrayForms;
procedure _GrayDesktop;
procedure _NormalForms;
implementation
uses windows, classes, forms, Contnrs, Types, Graphics, sysutils;
var
gGrayForms : TComponentList;
procedure _GrayDesktop;
var
loop : integer;
wScrnFrm : TForm;
wForm : TForm;
wPoint : TPoint;
begin
if not assigned(gGrayForms) then
begin
gGrayForms := TComponentList.Create;
gGrayForms.OwnsObjects := true;
for loop := 0 to Screen.MonitorCount - 1 do
begin
wForm := TForm.Create(nil);
gGrayForms.Add(wForm);
wForm.Position := poDesigned;
wForm.AlphaBlend := true;
wForm.AlphaBlendValue := 64;
wForm.Color := clBlack;
wForm.BorderStyle := bsNone;
wForm.Enabled := false;
wForm.BoundsRect := Screen.Monitors[loop].BoundsRect;
SetWindowPos(wForm.handle, HWND_TOP, 0,0,0,0, SWP_NOSIZE or SWP_NOMOVE);
wForm.Visible := true;
end;
end;
end;
procedure _GrayForms;
var
loop : integer;
wScrnFrm : TForm;
wForm : TForm;
wPoint : TPoint;
wScreens : TList;
begin
if not assigned(gGrayForms) then
begin
gGrayForms := TComponentList.Create;
gGrayForms.OwnsObjects := true;
wScreens := TList.create;
try
for loop := 0 to Screen.FormCount - 1 do
wScreens.Add(Screen.Forms[loop]);
for loop := 0 to wScreens.Count - 1 do
begin
wScrnFrm := wScreens[loop];
if wScrnFrm.Visible then
begin
wForm := TForm.Create(wScrnFrm);
gGrayForms.Add(wForm);
wForm.Position := poOwnerFormCenter;
wForm.AlphaBlend := true;
wForm.AlphaBlendValue := 64;
wForm.Color := clBlack;
wForm.BorderStyle := bsNone;
wForm.Enabled := false;
wForm.BoundsRect := wScrnFrm.BoundsRect;
SetWindowLong(wForm.Handle, GWL_HWNDPARENT, wScrnFrm.Handle);
SetWindowPos(wForm.handle, wScrnFrm.handle, 0,0,0,0, SWP_NOSIZE or SWP_NOMOVE);
wForm.Visible := true;
end;
end;
finally
wScreens.free;
end;
end;
end;
procedure _NormalForms;
begin
FreeAndNil(gGrayForms);
end;
initialization
gGrayForms := nil;
end.
I have done something similar for showing a modal form trying to keep the implementation as simple as possible. I don't know if this will fit your needs, but here it is:
function ShowModalDimmed(Form: TForm; Centered: Boolean = true): TModalResult;
var
Back: TForm;
begin
Back := TForm.Create(nil);
try
Back.Position := poDesigned;
Back.BorderStyle := bsNone;
Back.AlphaBlend := true;
Back.AlphaBlendValue := 192;
Back.Color := clBlack;
Back.SetBounds(0, 0, Screen.Width, Screen.Height);
Back.Show;
if Centered then begin
Form.Left := (Back.ClientWidth - Form.Width) div 2;
Form.Top := (Back.ClientHeight - Form.Height) div 2;
end;
result := Form.ShowModal;
finally
Back.Free;
end;
end;
I'm not sure about the "right" way to do it, but in order to "fade-to-white", what you can do is place your form in another completely white form (white background color, no controls).
So when your form is in 0% transparency, it will show as a regular form, but when it's in 50% transparency it will be faded to white. You can obviously choose other colors as your background.
I'm looking forward to seeing other answers...
EDIT: after seeing your "Jedi Concentrate" link, it seems that a dark-gray background will mimic the Expose effect better.
One way to do this is to place another form behind your dialog, this form would have no borders, and would contain a single image. This image would be a capture of the entire desktop from just before the dialog popped up, then run through a transform to lower the luminosity of each pixel by 50%. One trick that works quite well here is to use a black form, and to only include ever other pixel. If you know for certain that you will have theme support, you can optionally use a completely black form and use the alphablend and alphablendvalue properties..this will allow the OS to perform the luminosity transformation for you. An alphablendvalue of 128 is = 50%.
EDIT
As mghie pointed out, there is the possibility of a user pressing alt-tab to switch to another application. One way to handle this scenario would be to hide the "overlay" window in the application.OnDeactivate event, and to show it on the application.OnActivate event. Just remember to set the zorder of the overlay window lower than your modal dialog.
I created a similar effect to the Jedi Concentrate with a Form sized to the Screen.WorkArea with Color := clBlack and BorderStyle := bsNone
I found setting the AlphaBlendValue was too slow to animate nicely, so I use SetLayeredWindowAttributes()
The unit's code:
unit frmConcentrate;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TFadeThread = class(TThread)
private
fForm: TForm;
public
constructor Create(frm: TForm);
procedure Execute; override;
end;
TConcentrateFrm = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
fThread: TFadeThread;
public
{ Public declarations }
end;
procedure StartConcentrate(aForm: TForm = nil);
var
ConcentrateFrm: TConcentrateFrm;
implementation
{$R *.dfm}
procedure StartConcentrate(aForm: TForm = nil);
var
Hnd: HWND;
begin
try
if not Assigned(ConcentrateFrm) then
ConcentrateFrm := TConcentrateFrm.Create(nil)
else
Exit;
ConcentrateFrm.Top := Screen.WorkAreaTop;
ConcentrateFrm.Left := Screen.WorkAreaLeft;
ConcentrateFrm.Width := Screen.WorkAreaWidth;
ConcentrateFrm.Height := Screen.WorkAreaHeight;
Hnd := GetForegroundWindow;
SetWindowLong(ConcentrateFrm.Handle, GWL_EXSTYLE,
GetWindowLong(ConcentrateFrm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED
);
SetLayeredWindowAttributes(
ConcentrateFrm.Handle,
ColorToRGB(clBlack),
0,
LWA_ALPHA
);
ConcentrateFrm.Show;
if Assigned(aForm) then
aForm.BringToFront
else
SetForegroundWindow(Hnd);
ConcentrateFrm.fThread := TFadeThread.Create(ConcentrateFrm);
Application.ProcessMessages;
ConcentrateFrm.fThread.Resume;
except
FreeAndNil(ConcentrateFrm);
end;
end;
procedure TConcentrateFrm.FormClick(Sender: TObject);
var
p: TPoint;
hnd: HWND;
begin
GetCursorPos(p);
ConcentrateFrm.Hide;
hnd := WindowFromPoint(p);
while GetParent(hnd) 0 do
hnd := GetParent(hnd);
SetForegroundWindow(hnd);
Release;
end;
procedure TConcentrateFrm.FormDestroy(Sender: TObject);
begin
ConcentrateFrm := nil;
end;
{ TFadeThread }
constructor TFadeThread.Create(frm: TForm);
begin
inherited Create(true);
FreeOnTerminate := true;
Priority := tpIdle;
fForm := frm;
end;
procedure TFadeThread.Execute;
var
i: Integer;
begin
try
// let the main form open before doing this intensive process.
Sleep(300);
i := 0;
while i < 180 do
begin
if not Win32Check(
SetLayeredWindowAttributes(
fForm.Handle,
ColorToRGB(clBlack),
i,
LWA_ALPHA
)
) then
begin
RaiseLastOSError;
end;
Sleep(10);
Inc(i, 4);
end;
except
end;
end;
end.