I have a TPanel pnlMain, where several dynamic TPanels are created (and pnlMain is their Parent) according to user actions, data validations, etc. Every panel contains one colored grid full of strings. Apart from panels, there are some open source arrows components and a picture. Whole bunch of stuff.
Now I want user to be able to print this panel (I asked how to do it on this question), but before printing, user must be presented with a new form, containing copy of pnlMain. On this form user has to do some changes, add few components and then print his customized copy of pnlMain. After printing user will close this form and return to original form with original pnlMain. And – as you can guess – original pnlMain must remain intact.
So is there any clever way to copy whole TPanel and it’s contents? I know I can make it manually iterating through pnlMain.Controls list.
Code based as iterating on child controls, but not bad in anyway ;-)
procedure TForm1.btn1Click(Sender: TObject);
function CloneComponent(AAncestor: TComponent): TComponent;
var
XMemoryStream: TMemoryStream;
XTempName: string;
begin
Result:=nil;
if not Assigned(AAncestor) then
exit;
XMemoryStream:=TMemoryStream.Create;
try
XTempName:=AAncestor.Name;
AAncestor.Name:='clone_' + XTempName;
XMemoryStream.WriteComponent(AAncestor);
AAncestor.Name:=XTempName;
XMemoryStream.Position:=0;
Result:=TComponentClass(AAncestor.ClassType).Create(AAncestor.Owner);
if AAncestor is TControl then TControl(Result).Parent:=TControl(AAncestor).Parent;
XMemoryStream.ReadComponent(Result);
finally
XMemoryStream.Free;
end;
end;
var
aPanel: TPanel;
Ctrl, Ctrl_: TComponent;
i: integer;
begin
//handle the Control (here Panel1) itself first
TComponent(aPanel) := CloneComponent(pnl1);
with aPanel do
begin
Left := 400;
Top := 80;
end;
//now handle the childcontrols
for i:= 0 to pnl1.ControlCount-1 do begin
Ctrl := TComponent(pnl1.Controls[i]);
Ctrl_ := CloneComponent(Ctrl);
TControl(Ctrl_).Parent := aPanel;
TControl(Ctrl_).Left := TControl(Ctrl).Left;
TControl(Ctrl_).top := TControl(Ctrl).top;
end;
end;
code from Delphi3000 article
Too much code... ObjectBinaryToText and ObjectTextToBinary do the job nicely using streaming.
Delphi 7 have a code example, don't know 2009 (or 2006, never bothered to look) still have it.
See D5 help file for those functions (don't have d5 available here).
I'd do it by using RTTI to copy all the properties. You'd still have to iterate over all the controls, but when you need to set up the property values, RTTI can help automate the process. You can get an example towards the bottom of this article, where you'll find a link to some helper code, including a CopyObject routine.
Related
I cannot get the accelerator keys for a TActionToolBar to work.
This is what I am doing (reproducable in D2006, XE4):
Select New -> VCL Forms Application
Add ActionManager1 to the form
Add a new action Action1 in ActionManager1, set caption of action to &Test
Add ActionToolBar1 to the form
Add an item to ActionManager.ActionBars and set ActionManager.ActionBars[0].ActionBar to ActionToolBar1
Add an item to ActionManager.ActionBars[0].Items and set Action to Action1
Set the Action1.OnExecute event to show a message
Start program --> toolbar is displayed just fine and works via mouse
Press ALT+T --> nothing happens, but a Ding sound
What step am I missing?
As the existing answer points out, action toolbars do not support this functionality.
My personal opinion is that, this has been overlooked. Toolbar buttons often showing images instead of text might be one reason to do so (at least it was for me). However, evidently, toolbar buttons have the functionality when they show their captions, so could the action toolbar buttons.
#Silver points out in a comment that action bars have the capability to find accelerated items. In fact action menus use that functionality. Same functionality could easily be integrated into TCustomForm.IsShortCut for action toolbars, which already iterates action lists to find possible shortcut targets.
We can override the method and do it ourselves. Below example gives priority to default handling so assigned shortcuts will suppress keyboard accelerators with the same character, but this logic could easily be reversed.
function TForm1.IsShortCut(var Message: TWMKey): Boolean;
var
Item: TActionClientItem;
i: Integer;
begin
Result := inherited IsShortCut(Message);
if not Result and (KeyDataToShiftState(Message.KeyData) = [ssAlt]) then begin
for i := 0 to ActionManager1.ActionBars.Count - 1 do begin
if ActionManager1.ActionBars[i].ActionBar is TActionToolBar then begin
Item := TActionToolBar(ActionManager1.ActionBars[i].ActionBar)
.FindAccelItem(Message.CharCode);
if Assigned(Item) and Item.ShowCaption and Assigned(Item.Action)
and Item.Action.Execute then begin
Result := True;
Break;
end;
end;
end;
end;
end;
It seems that accelerator keys are not implemented for TActionToolBar - so no steps missing.
The following is not a real solution but a workaround that adds shortcuts by parsing the captions of the action (thanks to the suggestion of #KenWhite). A real solution for the question you will find in the accepted answer. I'll keep that answer for reference anyway:
uses System.Actions, System.UiTypes, Vcl.Menus, Vcl.ActnMan;
procedure AddShortCutsFromActionCaption(AActionMan: TActionManager);
var
Act: TContainedAction;
AccelKey: string;
I: Integer;
begin
for I := 0 to AActionMan.ActionCount - 1 do
begin
Act := AActionMan.Actions[I];
if Act.ShortCut = 0 then
begin
AccelKey := GetHotKey(Act.Caption);
if AccelKey <> '' then
Act.ShortCut := TextToShortCut('Alt+' + AccelKey);
end;
end;
end;
AddShortCutsFromActionCaption must be run once for ActionManager1 after the localization is run. That way the different accelerator keys for different languages remain functional.
If a shortcut already exists or if the caption of the action is modified, this workaround will not work - but for my purposes this is okay.
Overview
This question is a second attempt based on this one I recently asked: How can I make a TList property from my custom control streamable?
Although I accepted the answer in that question and it worked, I soon realized that TCollection is not the solution or requirement I was looking for.
Requirements
To keep my requirements as simple and clear to understand as possible, this is what I am attempting to:
Derive a new custom control based on TCustomListBox
Replace the Items property with my own Items type, eg a TList.
The TList (Items property) will hold objects, each containing a caption and a image index property etc.
Ownerdraw my listbox and draw its icons and text etc.
Create a property editor to edit the Items at design-time.
With that in mind, I know how to create the custom control, I know how to work with TList or even TObjectList for example, I know how to ownerdraw the control and I also know how to create the property editor.
Problem
What I don't know is how to replace the standard listbox Items type with my own? well I kind of do (publishing my own property that shares the same name), only I need to make sure it is fully streamable with the dfm.
I have searched extensively on this subject and have tried studying code where TListView and TTreeView etc publishes its Items type but I have found myself more confused than ever.
In fact I came across this very old question asked by someone else on a different website which asks very much what I want to do: Streaming a TList property of a component to a dfm. I have quoted it below in the event the link is lost:
I recently wrote a component that publishes a TList property. I then created a property editor for the TList to enable design-time editing. The problem is that the TList doesn't stream to the dfm file, so all changes are lost when the project is closed. I assume this is because TList inherits from TObject and not from TPersistant. I was hoping there was an easy work around for this situation (or that I have misunderstood the problem to begin with). Right now all I can come up with is to switch to a TCollection or override the DefineProperties method. Is there any other way to get the information in the TList streamed to and from the dfm?
I came across that whilst searching keywords such as DefineProperties() given that this was an alternative option Remy Lebeau briefly touched upon in the previous question linked at the top, it also seemed to be the answer to that question.
Question
I need to know how to replace the Items (TStrings) property of a TCustomListBox derived control with my own Items (TList) or Items (TObjectList) etc type but make it fully streamable with the dfm. I know from previous comments TList is not streamable but I cannot use TStrings like the standard TListBox control does, I need to use my own object based list that is streamable.
I don't want to use TCollection, DefineProperties sounds promising but I don't know how exactly I would implement this?
I would greatly appreciate some help with this please.
Thank you.
Override DefineProperties procedure in your TCustomListBox (let's name it TMyListBox here). In there it's possible to "register" as many fields as you wish, they will be stored in dfm in the same way as other fields, but you won't see them in object inspector. To be honest, I've never encountered having more then one property defined this way, called 'data' or 'strings'.
You can define 'normal' property or binary one. 'Normal' properties are quite handy for strings, integers, enumerations and so on. Here is how items with caption and ImageIndex can be implemented:
TMyListBox = class(TCustomListBox)
private
//other stuff
procedure ReadData(reader: TReader);
procedure WriteData(writer: TWriter);
protected
procedure DefineProperties(filer: TFiler); override;
//other stuff
public
//other stuff
property Items: TList read fItems; //not used for streaming, not shown in object inspector. Strictly for use in code itself. We can make it read-only to avoid memory leak.
published
//some properties
end;
that's DefineProperties implementation:
procedure TMyListBox.DefineProperties(filer: TFiler);
begin
filer.DefineProperty('data', ReadData, WriteData, items.Count>0);
end;
fourth argument, hasData is Boolean. When your component is saved to dfm, DefineProperties is called and it's possible to decide at that moment is there any data worth saving. If not, 'data' property is omitted. In this example, we won't have this property if there is no items present.
If we expect to ever use visual inheritance of this control (for example, create a frame with this listBox with predefined values and then eventually change them when put to form), there is a possibility to check, is value of this property any different than on our ancestor. Filer.Ancestor property is used for it. You can watch how it's done in TStrings:
procedure TStrings.DefineProperties(Filer: TFiler);
function DoWrite: Boolean;
begin
if Filer.Ancestor <> nil then
begin
Result := True;
if Filer.Ancestor is TStrings then
Result := not Equals(TStrings(Filer.Ancestor))
end
else Result := Count > 0;
end;
begin
Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
end;
This would save a little bit of space (or lots of space if image is stored within) and sure is elegant, but in first implementation it can well be omitted.
Now the code for WriteData and ReadData. Writing is much easier usually and we may begin with it:
procedure TMyListBox.WriteData(writer: TWriter);
var i: Integer;
begin
writer.WriteListBegin; //in text dfm it will be '(' and new line
for i:=0 to items.Count-1 do begin
writer.WriteString(TListBoxItem(items[I]).caption);
writer.WriteInteger(TListBoxItem(items[I]).ImageIndex);
end;
writer.WriteListEnd;
end;
In dfm it will look like this:
object MyListBox1: TMyListBox
data = (
'item1'
-1
'item2'
-1
'item3'
0
'item4'
1)
end
Output from TCollection seems more elegant to me (triangular brackets and then items, one after another), but what we have here would suffice.
Now reading it:
procedure TMyListBox.ReadData(reader: TReader);
var item: TListBoxItem;
begin
reader.ReadListBegin;
while not reader.EndOfList do begin
item:=TListBoxItem.Create;
item.Caption:=reader.ReadString;
item.ImageIndex:=reader.ReadInteger;
items.Add(item); //maybe some other registering needed
end;
reader.ReadListEnd;
end;
That's it. In such a way rather complex structures can be streamed with ease, for example, two-dimensional arrays, we WriteListBegin when writing new row and then when writing new element.
Beware of WriteStr / ReadStr - these are some archaic procedures which exist for backward compatibility, ALWAYS use WriteString / ReadString instead!
Other way to do is to define binary property. That's used mostly for saving images into dfm. Let's say, for example, that listBox has hundreds of items and we'd like to compress data in it to reduce size of executable. Then:
TMyListBox = class(TCustomListBox)
private
//other stuff
procedure LoadFromStream(stream: TStream);
procedure SaveToStream(stream: TStream);
protected
procedure DefineProperties(filer: TFiler); override;
//etc
end;
procedure TMyListBox.DefineProperties(filer: TFiler);
filer.DefineBinaryProperty('data',LoadFromStream,SaveToStream,items.Count>0);
end;
procedure TMyListBox.SaveToStream(stream: TStream);
var gz: TCompressionStream;
i: Integer;
value: Integer;
item: TListBoxItem;
begin
gz:=TCompressionStream.Create(stream);
try
value:=items.Count;
//write number of items at first
gz.Write(value, SizeOf(value));
//properties can't be passed here, only variables
for i:=0 to items.Count-1 do begin
item:=TListBoxItem(items[I]);
value:=Length(item.Caption);
//almost as in good ol' Pascal: length of string and then string itself
gz.Write(value,SizeOf(value));
gz.Write(item.Caption[1], SizeOf(Char)*value); //will work in old Delphi and new (Unicode) ones
value:=item.ImageIndex;
gz.Write(value,SizeOf(value));
end;
finally
gz.free;
end;
end;
procedure TMyListBox.LoadFromStream(stream: TStream);
var gz: TDecompressionStream;
i: Integer;
count: Integer;
value: Integer;
item: TListBoxItem;
begin
gz:=TDecompressionStream.Create(stream);
try
gz.Read(count,SizeOf(count)); //number of items
for i:=0 to count-1 do begin
item:=TListBoxItem.Create;
gz.Read(value, SizeOf(value)); //length of string
SetLength(item.caption,value);
gz.Read(item.caption[1],SizeOf(char)*value); //we got our string
gz.Read(value, SizeOf(value)); //imageIndex
item.ImageIndex:=value;
items.Add(item); //some other initialization may be needed
end;
finally
gz.free;
end;
end;
In dfm it would look like this:
object MyListBox1: TMyListBox1
data = {
789C636260606005E24C86128654865C064386FF40802C62C40002009C5607CA}
end
78 is sort of signature of ZLib, 9C means default compression, so it works (there are only 2 items actually, not hundreds). Of course, this is just one example, with BinaryProperties any possible format may be used, for example saving to JSON and putting it into stream, or XML or something custom. But I'd not recommend to use binary unless it's absolutely inevitable, because it's difficult to see from dfm, what happens in component.
It seems like good idea to me to actively use streaming when implementing component: we can have no designer at all and set all values by manually editing dfm and see if component behaves correctly. Reading/loading itself can be tested easily: if component is loaded, then saved and text is just the same, it's all right. It's so 'transparent' when streaming format is 'human-readable', self-explaining that it often overweighs drawbacks (like file size) if there are any.
I want to know how can I write a module to show something like clock or other thing on Borland Delphi 7 IDE status bar, because I know it's possible but I couldn't find how!
To insert a text in a StatusBar, you have to insert a panel first.
Just select your statusbar, find the property "Panels" (or perform double click over the statusbar) and click in "Add new".
After that, you can write what you want inside the panel in the property "Text" (you can insert one or more panels).
To do it programmatically, you can do something like this:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels[0].Text := 'Today is: ' + FormatDateTime('dd/mm/yyyy hh:nn:ss', Now);
end;
Since OP didn't replied with more details, I'm going to post a little demonstration how to reach a status bar of Delphi's edit window. I had no success with adding new distinct status panel w/o disturbing layout, so I'm just changing the text of INS/OVR indicator panel.
Disclaimer: I still do not have access to the machine with Delphi 7 installed, so I've done that in BDS ("Galileo") IDE. However, differences should be minor. I believe what main difference lies in the way how we locate edit window.
Key strings are: 'TEditWindow' for edit window class name and 'StatusBar' for TStatusBar control name owned by edit window. These strings are consistent across versions.
{ helper func, see below }
function FindForm(const ClassName: string): TForm;
var
I: Integer;
begin
Result := nil;
for I := 0 to Screen.FormCount - 1 do
begin
if Screen.Forms[I].ClassName = ClassName then
begin
Result := Screen.Forms[I];
Break;
end;
end;
end;
procedure Init;
var
EditWindow: TForm;
StatusBar: TStatusBar;
StatusPanel: TStatusPanel;
begin
EditWindow := FindForm('TEditWindow');
Assert(Assigned(EditWindow), 'no edit window');
StatusBar := EditWindow.FindComponent('StatusBar') as TStatusBar;
(BorlandIDEServices as IOTAMessageServices).AddTitleMessage(Format('StatusBar.Panels.Count = %d', [StatusBar.Panels.Count]));
//StatusPanel := StatusBar.Panels.Add;
StatusPanel := StatusBar.Panels[2];
StatusPanel.Text := 'HAI!';
end;
initialization
Init;
finalization
// nothing to clean up yet
Another note: As you see, I use Open Tools API to output debug messages only, to interact with IDE I do use Native VCL classes. Therefore, this code must be in package.
The code above is a relevant part of the unit which should be contained in package. Do not forget to add ToolsAPI to uses clause as well as other appropriate referenced units (up to you).
Package should require rtl, vcl and designide (important!).
Since I run the testcase directly from initialization section, installing the package is enough for testcase to run and produce some result.
Is there any way to disable selecting of text in a memo control because it's very anoying.
The memo is Read Only.
I think you should rethink. I realise that your control is used in read-only mode, but still, what if the end user wishes to copy a part of the text? Then he needs to be able to select the part in question.
Still, if you are certain that you need to disable every kind of selection, the easiest approach is to use a TRichEdit instead of the TMemo, and do simply
procedure TForm1.RichEdit1SelectionChange(Sender: TObject);
begin
RichEdit1.SelLength := 0;
end;
You could also use the onMouseUp event
procedure TForm1.Memo1MouseUp(Sender: TObject: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Memo1.SelLength > 0 then
Memo1.SelLength := 0;
end;
But, that doesn't stop selecting with the keyboard..
or you could also use the onEnter, and just change the focus to another control on your form.
procedure TForm1.Memo1Enter(Sender: TObject);
begin
Edit1.SetFocus;
end;
I played around with TRichEdit and TMemo until I was bored to tears. Yes, you can do a few tricks with event handling on the object, but it still is not the desired effect - and the cursor winds up blinking somewhere. So the best thing I could find was to use TLabel. I'm using Borland C++ Builder 6, and the \n is translated correctly with inline text strings for TLabel. So,
Label1->Caption = "this is a test of the emergency\n"
"broadcast station, this is only\n"
"a test. If this had been an\n"
"actual emergency, blah blah blah...\n";
Works just fine. I haven't tried to read in from a file, but I'm certain that if the stream were exactly as seen it would also work. Since you are going to have to enter or read in the text you want displayed anyway - this should work well instead of using a bunch of TLabels for each line. If you have a concern for word wrapping, you will have to process that portion separately. If it static, then just do it by hand like I did in the example. I sure hope this helps or at least gives an idea...
atomkey -
As i understand you would like to use memo as label actually (and sometimes it really have sense).
When i need to use TcxMemo (memo component from DeveloperExpress) as label i use such simple procedure:
procedure ShowMemoAsLabel(m: TcxMemo);
begin
m.Enabled := False;
m.Properties.ReadOnly := True;
// AH: Unfortunately it doesn't copy some important properties, maybe it will
// be fixed in future versions of DEX, but at moment we do some job ourselves.
m.StyleDisabled := m.Style;
m.StyleDisabled.BorderColor := m.Style.BorderColor;
m.StyleDisabled.BorderStyle := m.Style.BorderStyle;
m.StyleDisabled.Color := m.Style.Color;
m.StyleDisabled.Edges := m.Style.Edges;
m.StyleDisabled.Shadow := m.Style.Shadow;
m.StyleDisabled.TextColor := m.Style.TextColor;
m.StyleDisabled.TextStyle := m.Style.TextStyle;
m.StyleDisabled.TransparentBorder := m.Style.TransparentBorder;
end;
When the number of actions in DXE IDE grows, in a single actionlist, it quickly becomes hard to locate the action you want to inspect or change.
There is no search / filter box like there is for components, and actions are not automatically sorted. Sorting action declarations in code does not alter the order in which they are displayed in the actionlist editor.
Not even incremental search works: if you focus the actionlist pane and start typing, the keypresses go to the object inspector (and you inadvertently change some property or other). Major annoyance!
Is there perhaps a hidden setting, a registry hack (there are quite a few for Delphi), or maybe a third-party extension that would keep actions sorted?
Write a small IDE plugin that extends the context menu of a TActionList with a Sort option. For sorting the actionlist you can use this code:
procedure SortActions(ActionList: TActionList);
var
act: TContainedAction;
arr: TArray<TContainedAction>;
I: Integer;
begin
SetLength(arr, ActionList.ActionCount);
for I := 0 to ActionList.ActionCount - 1 do begin
arr[I] := ActionList[I];
end;
TArray.Sort<TContainedAction>(arr,
TDelegatedComparer<TContainedAction>.Create(
function(const Left, Right: TContainedAction): Integer
begin
result := CompareText(Left.Name, Right.Name);
end));
for I := 0 to High(arr) do
arr[I].Index := I;
end;
You could sort them in the dfm file. You would want to write a little utility script to do it.
Or a workaround would be to use categories to make the list of actions more manageable.