Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Динамическое создание меню по XML-файлу
{
The following procedure allows you to build a menu from an XML file.
Special feature: You only need to specify the Name of the procedure which then
will be attached to a OnClick handler.
Note that the procedure must be declared as public.
}
{
Mit folgender Prozedur kann man aus einem XML-File ein Menu
erstellen lassen (einfach im OnCreate aufrufen).
Besonderes Feature: Im XML-File gebt ihr nur den Namen der Prozedur an,
die dem OnClick-Ereignis zugewiesen werden soll.
Die einzige Einschrankung besteht darin, dass diese Prozedur
published sein muss.
Bindet einfach diese Prozedur in euer Hauptformular ein:
}
procedure TMainForm.CreateMenuFromXMLFile;
function
Get_Int(S: string
): Integer;
begin
Result := 0;
try
Result := StrToInt(S);
except
end
;
end
;
procedure
AddRecursive(Parent: TMenuItem; Item: IXMLNode);
var
I: Integer;
Node: TMenuItem;
Child: IXMLNode;
Address: TMethod;
begin
Node := TMenuItem.Create(Parent);
if
(Uppercase(Item.Attributes['CAPTION']) <> 'SEPERATOR') then
begin
Node.Caption := Item.Attributes['CAPTION'];
if
(Uppercase(Item.Attributes['ID']) <> 'NONE') then
begin
Address.Code := MethodAddress(Item.Attributes['ID']);
Address.Data := Self;
if
(Item.ChildNodes.Count - 1 < 0) then
Node.OnClick := TNotifyEvent(Address);
end
;
if
(Uppercase(Item.Attributes['SHORTCUT']) <> 'NONE') then
Node.ShortCut := TextToShortCut(Item.Attributes['SHORTCUT']);
Node.Checked := (Item.Attributes['CHECKED'] = '1');
end
else
Node.Caption := '-';
Node.Visible := (Item.Attributes['VISIBLE'] = '1');
if
Parent <> nil
then
Parent.Add(Node)
else
MainMenu.Items.Add(Node);
for
I := 0 to
Item.ChildNodes.Count - 1 do
begin
Child := item.ChildNodes[i];
if
(Child.NodeName = 'ENTRY') then
AddRecursive(Node, Child);
end
;
end
;
var
Root: IXMLMENUType;
Parent: TMenuItem;
I: Integer;
Child: IXMLNode;
begin
XMLDocument.FileName := ExtractFilePath(Application.ExeName) + XMLFile;
if
not
FileExists(XMLDocument.FileName) then
begin
MessageDlg('Menu-XML-Document nicht gefunden!', mtError, [mbOK], 0);
Halt;
end
;
XMLDocument.Active := True;
Screen.Cursor := crHourglass;
try
Root := GetXMLMenu(XMLDocument);
Parent := nil
;
for
I := 0 to
Root.ChildNodes.Count - 1 do
begin
Child := Root.ChildNodes[i];
if
(Child.NodeName = 'ENTRY') then
AddRecursive(Parent, Child);
end
;
finally
Screen.Cursor := crDefault;
end
;
end
;
{----------------------------------------------------------
You also need the encapsulation of the XML-File.
( Save it as unit and add it to your program.
Created with Delphi6 -> New -> XML Data Binding Wizard )
-----------------------------------------------------------}
{----------------------------------------------------------
Naturlich braucht man auch die Kapselung des XML-Files
(Als Unit speichern und ins Programm einbinden.
Die Datei wurde mit Delphi 6 -> Neu -> XML-Datenbindung erstellt):
-----------------------------------------------------------}
{***************************************************}
{ }
{ Delphi XML-Datenbindung }
{ }
{ Erzeugt am: 27.06.2002 13:25:01 }
{ }
{***************************************************}
unit
XMLMenuTranslation;
interface
uses
xmldom, XMLDoc, XMLIntf;
type
{ Forward-Deklarationen }
IXMLMENUType = interface
;
IXMLENTRYType = interface
;
{ IXMLMENUType }
IXMLMENUType = interface
(IXMLNode)
['{8F36F5E2-834F-41D9-918F-9B1A441C9074}']
{ Zugriff auf Eigenschaften }
function
Get_ENTRY: IXMLENTRYType;
{ Methoden & Eigenschaften }
property
ENTRY: IXMLENTRYType read
Get_ENTRY;
end
;
{ IXMLENTRYType }
IXMLENTRYType = interface
(IXMLNode)
['{AD85CD05-725E-40F8-A8D7-D6EC05FD4360}']
{ Zugriff auf Eigenschaften }
function
Get_CAPTION: WideString;
function
Get_VISIBLE: Integer;
function
Get_ID: Integer;
function
Get_ENTRY: IXMLENTRYType;
procedure
Set_CAPTION(Value: WideString);
procedure
Set_VISIBLE(Value: Integer);
procedure
Set_ID(Value: Integer);
{ Methoden & Eigenschaften }
property
Caption: WideString read
Get_CAPTION write
Set_CAPTION;
property
Visible: Integer read
Get_VISIBLE write
Set_VISIBLE;
property
ID: Integer read
Get_ID write
Set_ID;
property
ENTRY: IXMLENTRYType read
Get_ENTRY;
end
;
{ Forward-Deklarationen }
TXMLMENUType = class
;
TXMLENTRYType = class
;
{ TXMLMENUType }
TXMLMENUType = class
(TXMLNode, IXMLMENUType)
protected
{ IXMLMENUType }
function
Get_ENTRY: IXMLENTRYType;
public
procedure
AfterConstruction; override
;
end
;
{ TXMLENTRYType }
TXMLENTRYType = class
(TXMLNode, IXMLENTRYType)
protected
{ IXMLENTRYType }
function
Get_CAPTION: WideString;
function
Get_VISIBLE: Integer;
function
Get_ID: Integer;
function
Get_ENTRY: IXMLENTRYType;
procedure
Set_CAPTION(Value: WideString);
procedure
Set_VISIBLE(Value: Integer);
procedure
Set_ID(Value: Integer);
public
procedure
AfterConstruction; override
;
end
;
{ Globale Funktionen }
function
GetXMLMENU(Doc: IXMLDocument): IXMLMENUType;
function
LoadMENU(const
FileName: WideString): IXMLMENUType;
function
NewMENU: IXMLMENUType;
implementation
{ Globale Funktionen }
function
GetXMLMENU(Doc: IXMLDocument): IXMLMENUType;
begin
Result := Doc.GetDocBinding('MENU', TXMLMENUType) as
IXMLMENUType;
end
;
function
LoadMENU(const
FileName: WideString): IXMLMENUType;
begin
Result := LoadXMLDocument(FileName).GetDocBinding('MENU', TXMLMENUType) as
IXMLMENUType;
end
;
function
NewMENU: IXMLMENUType;
begin
Result := NewXMLDocument.GetDocBinding('MENU', TXMLMENUType) as
IXMLMENUType;
end
;
{ TXMLMENUType }
procedure
TXMLMENUType.AfterConstruction;
begin
RegisterChildNode('ENTRY', TXMLENTRYType);
inherited
;
end
;
function
TXMLMENUType.Get_ENTRY: IXMLENTRYType;
begin
Result := ChildNodes['ENTRY'] as
IXMLENTRYType;
end
;
{ TXMLENTRYType }
procedure
TXMLENTRYType.AfterConstruction;
begin
RegisterChildNode('ENTRY', TXMLENTRYType);
inherited
;
end
;
function
TXMLENTRYType.Get_CAPTION: WideString;
begin
Result := ChildNodes['CAPTION'].Text;
end
;
procedure
TXMLENTRYType.Set_CAPTION(Value: WideString);
begin
ChildNodes['CAPTION'].NodeValue := Value;
end
;
function
TXMLENTRYType.Get_VISIBLE: Integer;
begin
Result := ChildNodes['VISIBLE'].NodeValue;
end
;
procedure
TXMLENTRYType.Set_VISIBLE(Value: Integer);
begin
ChildNodes['VISIBLE'].NodeValue := Value;
end
;
function
TXMLENTRYType.Get_ID: Integer;
begin
Result := ChildNodes['ID'].NodeValue;
end
;
procedure
TXMLENTRYType.Set_ID(Value: Integer);
begin
ChildNodes['ID'].NodeValue := Value;
end
;
function
TXMLENTRYType.Get_ENTRY: IXMLENTRYType;
begin
Result := ChildNodes['ENTRY'] as
IXMLENTRYType;
end
;
end
.
{---------------------------------------------------------------------
Finally, I'll show you an example for the XML-File.
The Procedure Name is assigned to the ID which then will be called.
---------------------------------------------------------------------}
{---------------------------------------------------------------------
Als Beispiel fur das XML-File hier noch eines aus
einem meiner Programme.
In
ID steht der Name der Prozedur, die man als OnClick aufrufen will
- denkt auch daran, dass diese Prozedur unbedingt als published
deklariert sein muss, sonst liefert MethodAddress() Nil
zuruck.
----------------------------------------------------------------------}
{
<?xml version="1.0" encoding="ISO-8859-1"?>
<MENU>
<ENTRY CAPTION="Datei" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="Beenden" VISIBLE="1" ID="CloseProgram" SHORTCUT="Strg+X" CHECKED="0"></ENTRY>
</ENTRY>
<ENTRY CAPTION="Anzeige" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="Toolbar" VISIBLE="1" ID="ShowToolbar" SHORTCUT="None" CHECKED="1"></ENTRY>
<ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
<ENTRY CAPTION="Optionen" VISIBLE="1" ID="ShowOptionen" SHORTCUT="Strg+O" CHECKED="0"></ENTRY>
</ENTRY>
<ENTRY CAPTION="News" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="Refresh" VISIBLE="1" ID="RefreshAll" SHORTCUT="F5" CHECKED="0"></ENTRY>
<ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
<ENTRY CAPTION="Administration" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="neue Nachricht hinzufugen" VISIBLE="1" ID="NewMarkedNews" SHORTCUT="Strg+N" CHECKED="0"></ENTRY>
<ENTRY CAPTION="markierte Nachricht bearbeiten" VISIBLE="1" ID="EditMarkedNews" SHORTCUT="Strg+E" CHECKED="0"></ENTRY>
<ENTRY CAPTION="markierte Nachricht loschen" VISIBLE="1" ID="DeleteMarkedNews" SHORTCUT="None" CHECKED="0"></ENTRY>
<ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
<ENTRY CAPTION="Film hinzufugen" VISIBLE="1" ID="AddMPG" SHORTCUT="None" CHECKED="0"></ENTRY>
<ENTRY CAPTION="markierten Film loschen" VISIBLE="1" ID="DeleteMPG" SHORTCUT="None" CHECKED="0"></ENTRY>
</ENTRY>
</ENTRY>
<ENTRY CAPTION="Hilfe" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="LogView" VISIBLE="1" ID="ShowLog" SHORTCUT="Strg+L" CHECKED="0"></ENTRY>
<ENTRY CAPTION="eMail schreiben" VISIBLE="1" ID="WriteEMail" SHORTCUT="None" CHECKED="0"></ENTRY>
<ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
<ENTRY CAPTION="Uber" VISIBLE="1" ID="About" SHORTCUT="None" CHECKED="0"></ENTRY>
</ENTRY>
</MENU>
}