Creating Objects Dynamically on a frame - delphi

I have two scenarios. One works, one does not. The first (the one that works) invloves a scrollbox sitting directly on a form that when a button is pushed it executes this code:
procedure TForm1.Button2Click(Sender: TObject);
begin
DrawPanel;
end;
procedure TForm1.DrawPanel;
begin
BuildPanel; //Resides on a seperate unit code pasted below
TestPanel.Height := 40;
TestPanel.Width := 100;
TestPanel.Left := Trunc(ScrollBox1.Width / 2) - Trunc(TestPanel.Width / 2);
TestPanel.Top := Trunc(ScrollBox1.Height / 2) - Trunc(TestPanel.Height / 2);
TestPanel.Visible := True;
TestPanel.Parent := ScrollBox1;
end;
unit Unit3;
interface
uses ExtCtrls;
Var
TestPanel : Tpanel;
Procedure BuildPanel;
implementation
procedure BuildPanel;
begin
TestPanel := TPanel.Create(Nil);
end;
end.
The code is identical except for a small difference in the second scenario. The scrollbox sits on a frame that is added to the Templates palette and then dropped down on the form. The button click calls:
procedure TForm1.Button1Click(Sender: TObject);
begin
TestFrame.DrawPanel;
end;
procedure TTestFrame.DrawPanel;
begin
BuildPanel; //Still points to the unit3 code above
TestPanel.Height := 40;
TestPanel.Width := 100;
TestPanel.Left := Trunc(ScrollBox1.Width / 2) - Trunc(TestPanel.Width / 2);
TestPanel.Top := Trunc(ScrollBox1.Height / 2) - Trunc(TestPanel.Height / 2);
TestPanel.Visible := True;
TestPanel.Parent := ScrollBox1;
end;
However the panel will not display in the scrollbox that sits on the frame, when triggered at runtime. I'm not really sure why, can anybody help out? I hope I was specific enough in my question, let me know if anything is unclear. Thanks in advance.
Here's all the code in order.....Hopefully it make it more clear:
//This is the form
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Unit2, Unit3;
type
TForm1 = class(TForm)
Button1: TButton;
TTestFrame1: TTestFrame;
ScrollBox1: TScrollBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
TestFrame: TTestFrame;
Procedure DrawPanel;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
TestFrame.DrawPanel;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DrawPanel;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TestFrame.Free;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
TestFrame := TTestFrame.Create(Form1);
end;
procedure TForm1.DrawPanel;
begin
BuildPanel;
TestPanel.Height := 40;
TestPanel.Width := 100;
TestPanel.Left := Trunc(ScrollBox1.Width / 2) - Trunc(TestPanel.Width / 2);
TestPanel.Top := Trunc(ScrollBox1.Height / 2) - Trunc(TestPanel.Height / 2);
TestPanel.Visible := True;
TestPanel.Parent := ScrollBox1;
end;
end.
//This is the frame
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Unit3;
type
TTestFrame = class(TFrame)
ScrollBox1: TScrollBox;
private
{ Private declarations }
public
{ Public declarations }
Procedure DrawPanel;
end;
implementation
{$R *.dfm}
{ TTestFrame }
procedure TTestFrame.DrawPanel;
begin
BuildPanel;
TestPanel.Height := 40;
TestPanel.Width := 100;
TestPanel.Left := Trunc(ScrollBox1.Width / 2) - Trunc(TestPanel.Width / 2);
TestPanel.Top := Trunc(ScrollBox1.Height / 2) - Trunc(TestPanel.Height / 2);
TestPanel.Visible := True;
TestPanel.Parent := ScrollBox1;
end;
end.
//This is the unit that mocks my data structure
//In reality it creates an Array of Tpanel that is part of a class.
unit Unit3;
interface
uses ExtCtrls;
Var
TestPanel : Tpanel;
Procedure BuildPanel;
implementation
procedure BuildPanel;
begin
TestPanel := TPanel.Create(Nil);
end;
end.

You just forgot to assign a parent to your dynamic created TestFrame.

Related

How to make use of a dynamic button

Changing properties on a component is in my Delphi vocabulary. I created a button by writing code and it appears on the Form as its Parent, but I do not know how to execute anything with it.
Sample - create runtime TButton and set him event OnClick...
unit Unit1;
interface
uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FButton : TButton;
procedure OnButtonClickTest(Sender: TObject);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FButton := TButton.Create(nil);
FButton.Parent := self;
FButton.Left := 10;
FButton.Top := 10;
FButton.Width := 75;
FButton.Height := 25;
FButton.Caption := 'Click';
FButton.OnClick := OnButtonClickTest;
end;
procedure TForm1.OnButtonClickTest(Sender: TObject);
begin
FButton.Caption := 'Test OK';
end;
end.
I create a dynamic button FButton. Place it on the main form (Parent: Self) and set the event handler to click on it (method: OnButtonClickTest). When you click on button, on her caption change text to "Test OK"

How create a "shadow effect" similar to " shutting down Windows"? [duplicate]

I am looking to create an effect similar to the lightbox effect seen on many website where the background of the screen fades out and the content you want to emphasize does not. What would be the best way to go about creating such an effect in delphi ?
The content I want to emphasize in this case is a movable panel located on my form and basically all I want to do is to fade out any area of the screen that is not directly under that panel.
Thanks.
Oscar
Create a new form and add this code to the FormCreate method. You could also change the properties using the properties inspector, but I'm choosing to show you the relevant properties using code:
unit Unit1;
// This is a full screen partially transparent black form.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
Self.WindowState := wsMaximized;
AlphaBlend := true;
Alphablendvalue := 127;
Color := clBlack;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.FormClick(Sender: TObject);
begin
Close;
end;
end.
Here's a second form which has no border, which I am showing over top. It does not have alpha blending turned on, and the form style should be fsStayOnTop, or else you should use the ParentWindow property (on versions of Delphi that support that).
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
procedure FormDeactivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FAutoDeactivate: Boolean;
FCounter: Integer;
procedure WMUser1(var Message:TMessage); message WM_USER+1;
public
property AutoDeactivate:Boolean read FAutoDeactivate write FAutoDeactivate;
end;
var
Form2: TForm2;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm2.FormDeactivate(Sender: TObject);
begin
if Self.Visible and FAutoDeactivate then
begin
FAutoDeactivate := false;
Form1.Close;
end;
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form1.Close;
end;
procedure TForm2.FormActivate(Sender: TObject);
begin
PostMessage(Self.Handle, WM_USER+1, 0, 0);
end;
procedure TForm2.WMUser1(var Message: TMessage);
begin
FAutoDeactivate := true;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
Color := clWhite;
FormStyle := fsStayOnTop; // or set parent
end;
end.
That addresses how to make the whole screen "go dim", and then show something on top of that "dimmed area", but what you describe as "showing a panel in your main form" would require you to move that content out of your main form, or else clip a region out of form1, or use a combination of alpha blend plus transparency, but I don't have any code for those to show you.
If I was doing it, I would just float the thing I want not to be dimmed, above the full screen borderless 50% alpha form, as shown below.
But as you see, the screen isn't dimmed (screen brightness is not reduced), it's merely that we've done a 50% transparent layer of black which has blended in and darkened the overall screen appearance.
I have the same need as Oscar. After some search on the net, I found what is shown here.
It has helped me to do this, since it works. You can move what is emphasized in a Form instead of a Panel.
I use two forms. The first is use as "fader" and the second as dialogbox.
First
unit uFormFaded;
interface
uses
...
type
TFormFaded = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormFaded: TFormFaded;
implementation
{$R *.dfm}
procedure TFormFaded.FormCreate(Sender: TObject);
begin
Align := alClient;
AlphaBlend := true;
AlphaBlendValue := 100;
BorderStyle := bsNone;
Color := clBlack;
Enabled := false;
FormStyle := fsStayOnTop;
end;
end.
Second
unit UFormDlgBox;
interface
uses
...
type
TFormDlgBox = class(TForm)
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormDlgBox: TFormDlgBox;
implementation
{$R *.dfm}
uses uFormFaded;
procedure TFormDlgBox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FormFaded.Close;
end;
procedure TFormDlgBox.FormShow(Sender: TObject);
begin
FormFaded.Show;
end;
end.
The use
FormDlgBox.ShowModal;
I tried to reproduce this schema creating the forms in run-time an make the TFormDlgBox Owns and create the TFormFaded but it doesn't work. It seems it works only with forms created in design-time.

Component that hold controls in a tabular style?

I'm looking for a component that can hold another components (Like buttons) and show them in a tabular style. GridPanel is a such a component but does not show those grids runtime.
Something like this:
You can use TGridpanel and implement your own logic for painting by overriding the Paint method.
The appended image shows what it would look like, to reach your expected result, some code needs to be added.
unit Unit6;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TGridPanel = Class(ExtCtrls.TGridPanel)
protected
procedure Paint; override;
end;
TCellItem = Class(ExtCtrls.TCellItem)
Property Size; // make protected Size accessable
End;
TForm6 = class(TForm)
GridPanel1: TGridPanel;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button10: TButton;
Button11: TButton;
Button12: TButton;
Button14: TButton;
Button15: TButton;
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form6: TForm6;
implementation
{$R *.dfm}
uses TypInfo, Rtti;
Function GetSize(B: TComponent): Integer;
var
c: TRttiContext;
t: TRttiInstanceType;
begin
c := TRttiContext.Create;
try
t := c.GetType(B.ClassInfo) as TRttiInstanceType;
Result := t.GetProperty('Width').GetValue(B).AsInteger;
finally
c.Free;
end;
end;
procedure TGridPanel.Paint;
var
I: Integer;
LinePos, Size: Integer;
ClientRect: TRect;
begin
inherited;
begin
LinePos := 0;
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := clBlack;
ClientRect := GetClientRect;
Canvas.Rectangle(ClientRect);
for I := 0 to ColumnCollection.Count - 2 do
begin // cast to "own" TCellItem to access size
Size := TCellItem(ColumnCollection[I]).Size;
if I = 0 then
Canvas.MoveTo(LinePos + Size, ClientRect.Top)
else // "keep cells together"
Canvas.MoveTo(LinePos + Size, ClientRect.Top + TCellItem(RowCollection[0]).Size);
Canvas.LineTo(LinePos + Size, ClientRect.Bottom);
Inc(LinePos, Size);
end;
Canvas.Font.Size := 12;
Canvas.TextOut(TCellItem(ColumnCollection[0]).Size + 20,
(TCellItem(RowCollection[0]).Size - Canvas.TextHeight('X')) div 2,
'a longer caption text to be displayed');
LinePos := 0;
for I := 0 to RowCollection.Count - 2 do
begin
Size := TCellItem(RowCollection[I]).Size;
Canvas.MoveTo(ClientRect.Left, LinePos + Size);
Canvas.LineTo(ClientRect.Right, LinePos + Size);
Inc(LinePos, Size);
end;
end;
end;
end.

Authentification on HTTP proxy in Delphi XE

I need a little help:
uses wininet, urlmon;
....
var proxy_info : PInternetProxyInfo;
....
begin
user:='mycooluser';
pass:='mycoolpass';
UserAgent:='MSIE';
New (proxy_info);
proxy_info^.dwAccessType := INTERNET_OPEN_TYPE_PROXY;
proxy_info^.lpszProxy := PAnsiChar('XXX.XXX.XXX.XXX:ZZZZ');
proxy_info^.lpszProxyBypass := PAnsiChar('');
UrlMkSetSessionOption(INTERNET_OPTION_PROXY_USERNAME, PAnsichar(user), Length(user)+1, 0);
UrlMkSetSessionOption(INTERNET_OPTION_PROXY_PASSWORD, PAnsichar(pass), Length(pass)+1, 0);
UrlMkSetSessionOption(URLMON_OPTION_USERAGENT, PChar(UserAgent), Length(UserAgent)+1, 0);
UrlMkSetSessionOption(INTERNET_OPTION_PROXY, proxy_info, SizeOf(Internet_Proxy_Info), 0);
Dispose(proxy_info);
EmbeddedWB1.Navigate('http://2ip.ru');
end;
But it's doesn't work, although this proxy 100% working if its just specify in the IE settings.
unit Unit1;
// Code By Alireza Talebi , asiapardaz.blogfa.com , alireza.talebi90#yahoo.com
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, urlmon, wininet, StdCtrls, OleCtrls, SHDocVw, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit; // Proxy Address
Edit2: TEdit; // Port
Edit3: TEdit; // Web Address
WebBrowser1: TWebBrowser;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
i:Integer;
implementation
{$R *.dfm}
procedure proxy(text:string);
var PIInfo: PInternetProxyInfo;
begin
New(PIInfo);
PIInfo^.dwAccessType := INTERNET_OPEN_TYPE_PROXY;
PIInfo^.lpszProxy:=(PAnsiChar(text));
PIInfo^.lpszProxyBypass := PChar('');
UrlMkSetSessionOption(INTERNET_OPTION_PROXY, piinfo, SizeOf(Internet_Proxy_Info), 0);
Dispose(PIInfo);
end;
procedure DeleteIECache;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
begin
repeat
DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
FreeMem(lpEntryInfo, dwEntrySize);
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
end;
FreeMem(lpEntryInfo, dwEntrySize);
FindCloseUrlCache(hCacheDir);
end;
procedure EndBrowserSession;
begin
InternetSetOption(nil, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteIECache;
EndBrowserSession;
proxy(Trim(Edit1.Text)+':'+Trim(Edit2.Text)); // Proxy:Port
WebBrowser1.Navigate(Trim(Edit3.Text));
end;
end.

Simulate a webpage feedback button

I like to place a feedback button on may main (MDIParent) form that simulates those in webpages.
Like it to grow when the mouse goes over it. Just like the web.
The form with questions and the send of the data, I really don't need it, just the visual stuff.
Is there any such component ?.
I don't think it's difficult to do, but if it already exist it will same me some time.
Thanks
To make an animated slide panel you can use a code like follows:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FFeedbackBtn: TPanel;
FFeedbackPanel: TPanel;
procedure OnFeedbackBtnMouseEnter(Sender: TObject);
procedure OnFeedbackPanelMouseLeave(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FFeedbackBtn := TPanel.Create(Self);
FFeedbackBtn.Parent := Self;
FFeedbackBtn.Anchors := [akLeft, akTop, akBottom];
FFeedbackBtn.Caption := '';
FFeedbackBtn.SetBounds(0, 0, 40, ClientHeight);
FFeedbackBtn.OnMouseEnter := OnFeedbackBtnMouseEnter;
FFeedbackPanel := TPanel.Create(Self);
FFeedbackPanel.Parent := Self;
FFeedbackPanel.Anchors := [akLeft, akTop, akBottom];
FFeedbackPanel.Caption := 'Feedback panel';
FFeedbackPanel.Visible := False;
FFeedbackPanel.SetBounds(0, 0, 250, ClientHeight);
FFeedbackPanel.OnMouseLeave := OnFeedbackPanelMouseLeave;
end;
procedure TForm1.OnFeedbackBtnMouseEnter(Sender: TObject);
begin
AnimateWindow(FFeedbackPanel.Handle, 150, AW_ACTIVATE or AW_SLIDE or
AW_HOR_POSITIVE);
end;
procedure TForm1.OnFeedbackPanelMouseLeave(Sender: TObject);
begin
AnimateWindow(FFeedbackPanel.Handle, 150, AW_HIDE or AW_SLIDE or
AW_HOR_NEGATIVE);
end;
end.
Update:
Here's another version of the above, now with a vertical text like a typical feedback button has, rendered on a paint box stretched on the button panel:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FFeedbackBtn: TPanel;
FFeedbackBtnOverlay: TPaintBox;
FFeedbackPanel: TPanel;
procedure OnFeedbackBtnMouseEnter(Sender: TObject);
procedure OnFeedbackPanelMouseLeave(Sender: TObject);
procedure OnFeedbackBtnOverlayPaint(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FFeedbackBtn := TPanel.Create(Self);
FFeedbackBtn.Parent := Self;
FFeedbackBtn.Anchors := [akLeft, akTop, akBottom];
FFeedbackBtn.Caption := '';
FFeedbackBtn.Color := $0000B3FF;
FFeedbackBtn.ParentBackground := False;
FFeedbackBtn.SetBounds(0, 0, 40, ClientHeight);
FFeedbackBtnOverlay := TPaintBox.Create(Self);
FFeedbackBtnOverlay.Parent := FFeedbackBtn;
FFeedbackBtnOverlay.Align := alClient;
FFeedbackBtnOverlay.OnPaint := OnFeedbackBtnOverlayPaint;
FFeedbackBtnOverlay.OnMouseEnter := OnFeedbackBtnMouseEnter;
FFeedbackPanel := TPanel.Create(Self);
FFeedbackPanel.Parent := Self;
FFeedbackPanel.Anchors := [akLeft, akTop, akBottom];
FFeedbackPanel.Caption := 'Feedback panel';
FFeedbackPanel.Color := $0000F9FF;
FFeedbackPanel.ParentBackground := False;
FFeedbackPanel.Visible := False;
FFeedbackPanel.SetBounds(0, 0, 250, ClientHeight);
FFeedbackPanel.OnMouseLeave := OnFeedbackPanelMouseLeave;
end;
procedure TForm1.OnFeedbackBtnMouseEnter(Sender: TObject);
begin
AnimateWindow(FFeedbackPanel.Handle, 150, AW_ACTIVATE or AW_SLIDE or
AW_HOR_POSITIVE);
end;
procedure TForm1.OnFeedbackPanelMouseLeave(Sender: TObject);
begin
AnimateWindow(FFeedbackPanel.Handle, 150, AW_HIDE or AW_SLIDE or
AW_HOR_NEGATIVE);
end;
procedure TForm1.OnFeedbackBtnOverlayPaint(Sender: TObject);
var
S: string;
X, Y: Integer;
begin
S := 'Feedback...';
with FFeedbackBtnOverlay do
begin
Canvas.Brush.Color := $0000B3FF;
Canvas.FillRect(ClientRect);
Canvas.Font.Orientation := 900;
X := (ClientWidth - Canvas.TextHeight(S)) div 2;
Y := ClientHeight - (ClientHeight - Canvas.TextWidth(S)) div 2;
Canvas.TextOut(X, Y, S);
end;
end;
end.
And the result:
You should also implement some logic to prevent user to hide the feedback panel when will actually filling the fields, but it's a natural weakness of such kind of a feedback form.

Resources