How to create a TButton or other controls inside a THintWindow? - delphi

I am trying to create a THintWindow and place a TButton or a TFrame on it. here is my code:
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
HintWindow: THintWindow;
public
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HintWindow := THintWindow.Create(Self);
HintWindow.Color := clInfoBk;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
P: TPoint;
R: TRect;
Control: TControl;
begin
Control := Button1;
P := Control.ClientToScreen(Point(0, Control.Height));
R := Rect(P.X, P.Y, P.x + 100, P.Y + 100);
with TButton.Create(HintWindow) do
begin
Parent := HintWindow;
Caption := 'My Button';
end;
HintWindow.ActivateHint(R, 'My Hint');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
HintWindow.ReleaseHandle;
end;
The Hint window is shown but I don't see the TButton. it seems that there are no child windows inside the Hint window (I tested with Spy++ for "first child").
I also tried to subclass THintWindow with new CreateParams ie:
procedure TMyHintWindow.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_CLIPCHILDREN;
Params.ExStyle := Params.ExStyle or WS_EX_CONTROLPARENT;
end;
When I create a TFrame as child on the Hint window, Spy++ shows that there is a child on the hint window but I cant see it (even after I force it to be visible).
Any feed-backs on this?

Don't ask me why, but you can make this work in old versions of Delphi by setting the ParentWindow to Application.Handle immediately after you create the THintWindow instance:
HintWindow := THintWindow.Create(Self);
HintWindow.ParentWindow := Application.Handle;
This answer was inspired by the modern versions of the Delphi VCL source.

Related

delphi transparent background component

Quick question in regard to Delphi XE.
I'm trying to make a customized circle-shape component that has transparent background, so that when added on a form, the component can overlap other components. I've tried Brush.Style:=bsTransparent; or ellipse() and more on... but still couldn't find a way to make the edge area transparent.
Is there anyway I can make the edge area of the component transparent without using other lib or api?
Well here's a quick answer, that should get you going.
type
TEllipticPanel = class(Vcl.ExtCtrls.TPanel)
procedure CreateWnd; override;
procedure Paint; override;
procedure Resize; override;
procedure RecreateHRGN;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
panl: TEllipticPanel;
public
{ Public declarations }
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
panl := TEllipticPanel.Create(self);
panl.Left := 10;
panl.Top := 10;
panl.Width := 100;
panl.Height := 50;
panl.ParentBackground := False;
panl.ParentColor := False;
panl.Color := clYellow;
panl.Parent := self;
end;
{ TEllipticPanel }
procedure TEllipticPanel.RecreateHRGN;
var
hr: hRgn;
begin
inherited;
hr := CreateEllipticRgn(0,0,Width,Height);
SetWindowRgn(Handle, hr, True);
end;
procedure TEllipticPanel.CreateWnd;
begin
inherited;
RecreateHRGN;
end;
procedure TEllipticPanel.Paint;
begin
inherited;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := TPenStyle(psSolid);
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clGray;
Canvas.Ellipse(1,1,Width-2,Height-2);
end;
procedure TEllipticPanel.Resize;
begin
inherited;
RecreateHRGN;
end;
The key is the Windows CreateEllipticRgn and the GDI SetWindowRgn functions.
For more information about windows regions see Regions.

How to reflect the changes after I resize the non-client area?

I want to make a custom control with a selectable border size. See the code below. The border is drawn in the non-client area and his width can be 0, 1 or 2 pixels. I've successfully done the border drawings in the WM_NCPAINT. The problem is that after I change the property that control the border size I don't know how to tell the system to recalculate the new dimensions of client and non-client areas. I've noticed that when I resize the window (with the mouse) the changes are applied, but I donn't know how to do that immediately after I change the border size.
SuperList.pas
unit SuperList;
interface
uses Windows, Controls, Graphics, Classes, Messages, SysUtils, StdCtrls, UxTheme;
type
TBorderType = (btNone, btSingle, btDouble);
TSuperList = class(TCustomControl)
private
HHig,HMidH,HMidL,HLow:TColor;
BCanvas: TCanvas;
FBorderSize: TBorderType;
procedure SetBorderSize(const Value:TBorderType);
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
protected
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner:TComponent); override;
published
property BorderType:TBorderType read FBorderSize write SetBorderSize default btDouble;
end;
implementation
constructor TSuperList.Create(AOwner:TComponent);
begin
inherited;
BCanvas:=TCanvas.Create;
FBorderSize:=btDouble;
HHig:=clWhite; HMidH:=clBtnFace; HMidL:=clGray; HLow:=cl3DDkShadow;
end;
procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_VSCROLL or WS_HSCROLL;
end;
procedure TSuperList.SetBorderSize(const Value:TBorderType);
begin
if Value<>FBorderSize then begin
FBorderSize:=Value;
// .... ?????? I think here must be done something...
Perform(WM_NCPAINT,1,0); // repainting the non-client area (I do not know how can I invalidate the non-client area differently)
Invalidate; // repainting the client area
// I've tried even with the... RedrawWindow(Handle,nil,0,RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW or RDW_INTERNALPAINT);
end;
end;
procedure TSuperList.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result:=1;
end;
procedure TSuperList.WMSize(var Message: TWMSize);
begin
inherited;
Perform(WM_NCPAINT,1,0);
end;
procedure TSuperList.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
inherited;
if FBorderSize>btNone then
InflateRect(Message.CalcSize_Params^.rgrc0,-Integer(FBorderSize),-Integer(FBorderSize));
end;
procedure TSuperList.Paint;
begin
Canvas.Brush.Color:=clWhite;
Canvas.FillRect(ClientRect);
end;
procedure TSuperList.WMNCPaint(var Message: TWMNCPaint);
var DC: HDC;
R: TRect;
HS_Size,VS_Size:Integer;
HS_Vis,VS_Vis:Boolean;
begin
inherited;
Message.Result:=0;
if FBorderSize>btNone then
begin
DC:=GetWindowDC(Handle); if DC=0 then Exit;
BCanvas.Handle:=DC;
BCanvas.Pen.Color:=clNone;
BCanvas.Brush.Color:=clNone;
try
VS_Size:=GetSystemMetrics(SM_CXVSCROLL);
HS_Size:=GetSystemMetrics(SM_CYHSCROLL);
VS_Vis:=GetWindowLong(Handle,GWL_STYLE) and WS_VSCROLL <> 0;
HS_Vis:=GetWindowLong(Handle,GWL_STYLE) and WS_HSCROLL <> 0;
R:=ClientRect;
OffsetRect(R,Integer(FBorderSize),Integer(FBorderSize));
if VS_Vis and HS_Vis then begin
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom+HS_Size);
ExcludeClipRect(DC, R.Left, R.Top, R.Right+VS_Size, R.Bottom);
BCanvas.Brush.Color:=HMidH;
R.Right:=Width-Integer(FBorderSize); R.Left:=R.Right-VS_Size;
R.Bottom:=Height-Integer(FBorderSize); R.Top:=R.Bottom-HS_Size;
BCanvas.FillRect(R);
end else begin
if VS_Vis then Inc(R.Right,VS_Size);
if HS_Vis then Inc(R.Bottom,HS_Size);
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
end;
BCanvas.MoveTo(0,Height-1);
BCanvas.Pen.Color:=HMidL; BCanvas.LineTo(0,0); BCanvas.LineTo(Width-1,0);
if IsThemeActive then begin
BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(Width-1,Height-1);
BCanvas.LineTo(-1,Height-1);
end else begin
if FBorderSize=btDouble then begin
BCanvas.Pen.Color:=HHig;
BCanvas.LineTo(Width-1,Height-1);
BCanvas.LineTo(-1,Height-1);
end else begin
if VS_Vis then BCanvas.Pen.Color:=HHig else BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(Width-1,Height-1);
if HS_Vis then BCanvas.Pen.Color:=HHig else BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(-1,Height-1);
end;
end;
if FBorderSize=btDouble then begin
BCanvas.MoveTo(1,Height-2);
BCanvas.Pen.Color:=HLow; BCanvas.LineTo(1,1); BCanvas.LineTo(Width-2,1);
BCanvas.Pen.Color:=HMidH; BCanvas.LineTo(Width-2,Height-2); BCanvas.LineTo(0,Height-2);
end;
finally
ReleaseDC(Handle,DC);
end;
end;
end;
end.
Unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SuperList, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
public
List: TSuperList;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
List:=TSuperList.Create(self);
List.Parent:=Form1;
List.Margins.Left:=20; List.Margins.Right:=20;
List.Margins.Top:=50; List.Margins.Bottom:=20;
List.AlignWithMargins:=true;
List.Align:=alClient;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
List.BorderType:=btNone;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
List.BorderType:=btSingle;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
List.BorderType:=btDouble;
end;
end.
Send a CM_BORDERCHANGED message:
Perform(CM_BORDERCHANGED, 0, 0);
This will fire the handler in TWinControl:
procedure TWinControl.CMBorderChanged(var Message: TMessage);
begin
inherited;
if HandleAllocated then
begin
SetWindowPos(Handle, 0, 0,0,0,0, SWP_NOACTIVATE or
SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_FRAMECHANGED);
if Visible then
Invalidate;
end;
end;
And from the documentation on SetWindowPos:
SWP_FRAMECHANGED: Applies new frame styles set using the SetWindowLong function. Sends a WM_NCCALCSIZE message to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZE is sent only when the window's size is being changed.

How do I pass an event as a function parameter?

I have a form that has a list of useful procedures that I have created, that I often use in every project. I am adding a procedure that makes it simple to add a click-able image over where would be the TAccessory of a TListBoxItem. The procedure intakes the ListBox currently, but I would also need it to intake which procedure to call for the OnClick Event for the image.. Here is my existing code:
function ListBoxAddClick(ListBox:TListBox{assuming I need to add another parameter here!! but what????}):TListBox;
var
i : Integer;
Box : TListBox;
BoxItem : TListBoxItem;
Click : TImage;
begin
i := 0;
Box := ListBox;
while i <> Box.Items.Count do begin
BoxItem := Box.ListItems[0];
BoxItem.Selectable := False;
Click := Timage.Create(nil);
Click.Parent := BoxItem;
Click.Height := BoxItem.Height;
Click.Width := 50;
Click.Align := TAlignLayout.alRight;
Click.TouchTargetExpansion.Left := -5;
Click.TouchTargetExpansion.Bottom := -5;
Click.TouchTargetExpansion.Right := -5;
Click.TouchTargetExpansion.Top := -5;
Click.OnClick := // this is where I need help
i := +1;
end;
Result := Box;
end;
The desired procedure would be defined in the form that is calling this function.
Since the OnClick event is of type TNotifyEvent you should define a parameter of that type. Look at this (I hope self-explaining) example:
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
procedure TheClickEvent(Sender: TObject);
end;
implementation
procedure ListBoxAddClick(ListBox: TListBox; OnClickMethod: TNotifyEvent);
var
Image: TImage;
begin
Image := TImage.Create(nil);
// here is assigned the passed event method to the OnClick event
Image.OnClick := OnClickMethod;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// here the TheClickEvent event method is passed
ListBoxAddClick(ListBox1, TheClickEvent);
end;
procedure TForm1.TheClickEvent(Sender: TObject);
begin
// do something here
end;

Minimize Delphi Form to System Tray

I am a Delphi learner. I am looking for solutions so that Delphi MainForm should be minimized to the System Tray instead of Taskbar. On Right Click on the System Tray Icon there should be some menus like "Restore" and "About" and "Help" etc. System Tray Icons will be loaded from Imagelis1 and it will animate. On Clicking on "Restore" the MainForm will be restored, on clicking on "About" "Form2" will be restored and on clicking on "Help" "Foprm3" will be restored. I have found so many solutions on internet like :
Solution 01
Solution 02
but every solutions have some drawbacks. Some can be done once ony. Some have blurred icon in Windows7. Someone may tell that there is no one to write codes for me and I have to show my codes. Plaese forgive me for this regards. Please give me concrete solution sot that it can be implemented universely without version dependency of windows. It will help every one. Please help me.
This should get you going. Drop a TTrayIcon and a TApplicationEvents on your form. THe following code is from the TTrayIcon - Delphi Example from the docwiki. Use the IDE main menu, and choose Project->View Source, and the line that reads Application.ShowMainFormOnTaskbar := True; to `Application.ShowMainFormOnTaskbar := False;' to keep the application's button from appearing on the Windows Taskbar.
This example uses a tray icon and an application events component on a form. When the application runs, it loads the tray icon, the icons displayed when it is animated, and it also sets up a hint balloon. When you minimize the window, the form is hidden, a hint balloon shows up, and the tray icon is displayed and animated. Double-clicking the system tray icon restores the window.
// Add this to the `TApplicationEvents.OnMinimize` event handler
procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
{ Hide the window and set its state variable to wsMinimized. }
Hide();
WindowState := wsMinimized;
{ Show the animated tray icon and also a hint balloon. }
TrayIcon1.Visible := True;
TrayIcon1.Animate := True;
TrayIcon1.ShowBalloonHint;
end;
// Add this to the `TForm.OnCreate` event handler
procedure TForm1.FormCreate(Sender: TObject);
var
MyIcon : TIcon;
begin
{ Load the tray icons. }
TrayIcon1.Icons := TImageList.Create(Self);
MyIcon := TIcon.Create;
MyIcon.LoadFromFile('icons/earth1.ico');
TrayIcon1.Icon.Assign(MyIcon);
TrayIcon1.Icons.AddIcon(MyIcon);
MyIcon.LoadFromFile('icons/earth2.ico');
TrayIcon1.Icons.AddIcon(MyIcon);
MyIcon.LoadFromFile('icons/earth3.ico');
TrayIcon1.Icons.AddIcon(MyIcon);
MyIcon.LoadFromFile('icons/earth4.ico');
TrayIcon1.Icons.AddIcon(MyIcon);
{ Set up a hint message and the animation interval. }
TrayIcon1.Hint := 'Hello World!';
TrayIcon1.AnimateInterval := 200;
{ Set up a hint balloon. }
TrayIcon1.BalloonTitle := 'Restoring the window.';
TrayIcon1.BalloonHint :=
'Double click the system tray icon to restore the window.';
TrayIcon1.BalloonFlags := bfInfo;
end;
// Add this to the `TTrayIcon.OnDoubleClick` event handler
procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
{ Hide the tray icon and show the window,
setting its state property to wsNormal. }
TrayIcon1.Visible := False;
Show();
WindowState := wsNormal;
Application.BringToFront();
end;
For the menu you get on right-click, add a TPopupMenu to your form, add the items you want on it, write the event handlers for those items as usual, and then assign the PopupMenu to the TrayIcon.PopupMenu property.
The "blurred icons" are caused by you not using the proper icon sizes and Windows being forced to scale (stretch) them. Use an icon editor to create multiple size images for each icon (there can be multiple sizes in one icon file).
I drop a TrayIcon onto myForm, then i add this simple code:
type
TmyForm = class(TForm)
...
TrayIcon: TTrayIcon;
procedure FormCreate(Sender: TObject);
...
procedure TrayIconClick(Sender: TObject);
...
private
{ Private declarations }
procedure OnMinimize(Sender:TObject);
public
{ Public declarations }
end;
procedure TmyForm.FormCreate(Sender: TObject);
begin // When form is created
Application.OnMinimize:=OnMinimize; // Set the event handler for application minimize
end;
procedure TmyForm.OnMinimize(Sender:TObject);
begin // When application is minimized by user and/or by code
Hide; // This is to hide it from taskbar
end;
procedure TmyForm.TrayIconClick(Sender: TObject);
begin // When clicking on TrayIcon
if Visible
then begin // Application is visible, so minimize it to TrayIcon
Application.Minimize; // This is to minimize the whole application
end
else begin // Application is not visible, so show it
Show; // This is to show it from taskbar
Application.Restore; // This is to restore the whole application
end;
end;
This creates a TrayIcon allways visible, and when you click on it:
If the application is Visible, it will be Hidden form taskbar and from screen
If the application is Hidden, it will be Shown form taskbar and from screen
In other words, clicking on TrayIcon the application will change its visibility; just as minimizing it to TrayIcon bar.
...And in Delphi 6, where no TTrayIcon exists, you can use this simple code:
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellAPI, StdCtrls, Menus;
const WM_ICONTRAY = WM_USER+1;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
ShowForm1: TMenuItem;
HideForm1: TMenuItem;
Exit1: TMenuItem;
procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ShowForm1Click(Sender: TObject);
procedure HideForm1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
TrayIconData: TNotifyIconData;
end;
var
Form1: TForm1;
MustExit:boolean;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
MustExit:=false;
TrayIconData.cbSize:=SizeOf(TrayIconData);
TrayIconData.Wnd:=Handle;
TrayIconData.uID:=0;
TrayIconData.uFlags:=NIF_MESSAGE + NIF_ICON + NIF_TIP;
TrayIconData.uCallbackMessage:=WM_ICONTRAY;
TrayIconData.hIcon:=Application.Icon.Handle;
StrPCopy(TrayIconData.szTip,Application.Title);
Shell_NotifyIcon(NIM_ADD, #TrayIconData);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, #TrayIconData);
end;
procedure TForm1.TrayMessage(var Msg: TMessage);
var p:TPoint;
begin
case Msg.lParam of
WM_LBUTTONDOWN: begin
Form1.Show;
Application.Restore;
end;
WM_RBUTTONDOWN: begin
GetCursorPos(p);
PopUpMenu1.Popup(p.x,p.y);
end;
end;
end;
// Popup "Form Show" menu item OnClick
procedure TForm1.ShowForm1Click(Sender: TObject);
begin
Form1.Show;
end;
// Popup "Form Hide" menu item OnClick
procedure TForm1.HideForm1Click(Sender: TObject);
begin
Form1.Hide;
end;
// Popup "Exit" menu item OnClick
procedure TForm1.Exit1Click(Sender: TObject);
begin
MustExit:=true;
Close;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if MustExit then exit;
Form1.Hide;
Action:=caNone;
end;
end.
I have implemented the following codes. Here everything is fine except one. After minimizing the Form, it goes to "SystemTray" but also available in "TaskBar. For my application, the "AlphaBlend" property of "Form001" is true and "AlphaBlendValue" is "0".
unit KoushikHalder001;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls, Vcl.Imaging.pngimage,
Vcl.AppEvnts, Vcl.ImgList, Vcl.Menus;
type
TForm001 = class(TForm)
Edit001: TEdit;
Background: TImage;
BitBtn001: TBitBtn;
BitBtn002: TBitBtn;
FadeInTimer: TTimer;
FadeOutTimer: TTimer;
FormMinimizeTimer: TTimer;
FormRestoreTimer: TTimer;
TrayIcon: TTrayIcon;
PopupMenu: TPopupMenu;
ImageList: TImageList;
ApplicationEvents: TApplicationEvents;
Form001Close: TMenuItem;
Form001Hide: TMenuItem;
Form001Show: TMenuItem;
Form002Close: TMenuItem;
Form002Hide: TMenuItem;
Form002Show: TMenuItem;
N01: TMenuItem;
N02: TMenuItem;
N03: TMenuItem;
N04: TMenuItem;
N05: TMenuItem;
N06: TMenuItem;
N07: TMenuItem;
N08: TMenuItem;
N09: TMenuItem;
N10: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure BitBtn001Click(Sender: TObject);
procedure BitBtn002Click(Sender: TObject);
procedure FadeInTimerTimer(Sender: TObject);
procedure FadeOutTimerTimer(Sender: TObject);
procedure FormMinimizeTimerTimer(Sender: TObject);
procedure FormRestoreTimerTimer(Sender: TObject);
procedure ApplicationEventsMinimize(Sender: TObject);
procedure TrayIconDblClick(Sender: TObject);
procedure Form001CloseClick(Sender: TObject);
procedure Form001HideClick(Sender: TObject);
procedure Form001ShowClick(Sender: TObject);
procedure Form002CloseClick(Sender: TObject);
procedure Form002HideClick(Sender: TObject);
procedure Form002ShowClick(Sender: TObject);
private
{ Private declarations }
CrossButtonClick: Boolean;
procedure WMNCHitTest(var Msg: TWMNCHitTest) ; message WM_NCHitTest;
procedure WMSysCommand(var Msg: TWMSysCommand) ; message WM_SysCommand;
public
{ Public declarations }
end;
var
Form001: TForm001;
implementation
{$R *.dfm}
uses KoushikHalder002;
procedure TForm001.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
if ControlAtPos(ScreenToClient(Msg.Pos), True, True, True)= nil
then
begin
if Msg.Result=htClient then Msg.Result := htCaption;
end;
end;
procedure TForm001.WMSysCommand(var Msg: TWMSysCommand);
begin
case Msg.CmdType of
SC_MINIMIZE:
begin
if Form001.AlphaBlendValue > 0 then
begin
Form001.FormMinimizeTimer.Enabled := true;
Exit;
end;
end;
SC_RESTORE:
begin
if Form001.AlphaBlendValue < 220 then
begin
Form001.FormRestoreTimer.Enabled := True;
end;
end;
end;
inherited;
end;
procedure TForm001.ApplicationEventsMinimize(Sender: TObject);
begin
Form001.FormMinimizeTimer.Enabled := true;
TrayIcon.Visible := True;
TrayIcon.Animate := True;
TrayIcon.ShowBalloonHint;
end;
procedure TForm001.BitBtn001Click(Sender: TObject);
begin
if Form002.WindowState = wsMinimized then
begin
Form002.Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
end
else
Form002.show;
end;
procedure TForm001.BitBtn002Click(Sender: TObject);
begin
Form002.FadeOutTimer.Enabled := true;
Form001.FadeOutTimer.Enabled := true;
end;
procedure TForm001.Form001CloseClick(Sender: TObject);
begin
Form002.FadeOutTimer.Enabled := true;
Form001.FadeOutTimer.Enabled := true;
end;
procedure TForm001.Form001HideClick(Sender: TObject);
begin
Form001.FormMinimizeTimer.Enabled := true;
end;
procedure TForm001.Form001ShowClick(Sender: TObject);
begin
if Form001.WindowState = wsMinimized then
begin
Form001.Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
end
else
Form001.show;
end;
procedure TForm001.Form002CloseClick(Sender: TObject);
begin
Form002.FadeOutTimer.Enabled := true;
end;
procedure TForm001.Form002HideClick(Sender: TObject);
begin
Form002.FormMinimizeTimer.Enabled := true;
end;
procedure TForm001.Form002ShowClick(Sender: TObject);
begin
if Form002.WindowState = wsMinimized then
begin
Form002.Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
end
else
Form002.show;
end;
procedure TForm001.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form001.FadeOutTimer.Enabled := true;
end;
procedure TForm001.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if CrossButtonClick = true
then
begin
CanClose := true;
Exit;
end;
CanClose := false;
Form001.FadeOutTimer.Enabled := true;
end;
procedure TForm001.FormCreate(Sender: TObject);
begin
Form001.FadeInTimer.Enabled := true;
end;
procedure TForm001.FormHide(Sender: TObject);
begin
Form001.FadeOutTimer.Enabled := true;
end;
procedure TForm001.FormShow(Sender: TObject);
begin
Form001.FadeInTimer.Enabled := true;
end;
procedure TForm001.TrayIconDblClick(Sender: TObject);
begin
Form001.FormRestoreTimer.Enabled := true;
TrayIcon.Visible := False;
WindowState := wsNormal;
Application.BringToFront();
end;
procedure TForm001.FadeInTimerTimer(Sender: TObject);
begin
if Form001.AlphaBlendValue >= 220
then
begin
Form001.FadeInTimer.Enabled := false;
end
else
begin
Form001.AlphaBlendValue := Form001.AlphaBlendValue + 10;
CrossButtonClick := false;
end;
end;
procedure TForm001.FadeOutTimerTimer(Sender: TObject);
begin
if Form001.AlphaBlendValue <= 0
then
begin
Form001.FadeOutTimer.Enabled := false;
CrossButtonClick := true;
Self.Close;
end
else
begin
Form001.AlphaBlendValue := Form001.AlphaBlendValue - 10;
CrossButtonClick := true;
end;
end;
procedure TForm001.FormMinimizeTimerTimer(Sender: TObject);
begin
if Form001.AlphaBlendValue > 0 then
begin
Form001.AlphaBlendValue := Form001.AlphaBlendValue - 10;
end
else
begin
Form001.FormMinimizeTimer.Enabled := false;
Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
end;
procedure TForm001.FormRestoreTimerTimer(Sender: TObject);
begin
if Form001.AlphaBlendValue < 220 then
begin
Form001.AlphaBlendValue := Form001.AlphaBlendValue + 10;
end
else
begin
Form001.FormRestoreTimer.Enabled := false;
end;
end;
end.
If I do the following
Application.MainFormOnTaskbar := false;
the form is totally invissible. I think there should be one bug. But I am unable to find it.

Delphi: show assigned Frame to Node of Tree View

I have no experience with frames.
How to use a Tree View with frames?
I need to switch among nods of the Tree View and show assigned Frame to the selected node.
Big big thank for help!!!
It doesn't really make any difference if the Data of nodes hold a pointer to a frame or any other kind of object, typecast the pointer to the type of object it holds.
Below code adds two frames ('Frame2' and 'Frame3', created by the IDE - much like a new form), as nodes of a TreeView, and sets the visibility of the selected node's frame to true and the deselected one's to false.
type
TForm1 = class(TForm)
TreeView1: TTreeView;
procedure FormCreate(Sender: TObject);
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
procedure TreeView1Changing(Sender: TObject; Node: TTreeNode;
var AllowChange: Boolean);
procedure FormDestroy(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses Unit2, Unit3;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
TreeView1.Align := alLeft;
with TFrame(TreeView1.Items.AddObject(nil, 'Frame2', TFrame2.Create(nil)).Data) do begin
Visible := False;
Parent := Self;
Align := alClient;
end;
with TFrame(TreeView1.Items.AddObject(nil, 'Frame3', TFrame3.Create(nil)).Data) do begin
Visible := False;
Parent := Self;
Align := alClient;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i: Integer;
begin
for i := 0 to TreeView1.Items.Count - 1 do
TFrame(TreeView1.Items[i].Data).Free;
end;
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
TFrame(Node.Data).Visible := True;
end;
procedure TForm1.TreeView1Changing(Sender: TObject; Node: TTreeNode;
var AllowChange: Boolean);
begin
if Assigned((Sender as TTreeView).Selected) then
TFrame(TTreeView(Sender).Selected.Data).Visible := False;
end;

Resources