unit uTemplateManagement;
interface
uses
// Windows, Borland VCL, Jedi
Windows, Messages, Classes, Controls, Forms, JvNavigationPane, ExtCtrls,
StdCtrls, AppEvnts, jpeg, SysUtils, Dialogs,
// Andere Units von uns
uGlobals;
type
TTemplateManagement =
class(TObject)
private
procedure CreateLabel(Sender: TObject;
LabelObject: TLabel; Top, Left, Height, Width: integer; SendToFront,
Transparent, AutoSize: boolean; LabelCaption:
string; Alignment: TAlignment;
Layout: TTextLayout; FontSize: integer; FontName:
string; ShowLabel: boolean;
Anchors: TAnchors; Cursor: TCursor);
public
procedure LoadTemplate(Sender: TObject; aButtons: TAvButtonsCount;
CoreForm: boolean);
end;
var
TemplateManagement: TTemplateManagement;
type
TButtonImageSubID =
class(TObject)
public
FPushed: integer;
FHover: integer;
FNormal: integer;
end;
type
TButtonImageID =
class(TObject)
public
FOK : TButtonImageSubID;
FCancel : TButtonImageSubID;
FExit : TButtonImageSubID;
FClose : TButtonImageSubID;
FApply : TButtonImageSubID;
end;
type
TBmsForm =
class(TForm)
public
// Designvariablen, hier werden alle Bilder hineingeladen die zur
// Laufzeit erstellt werden
FormImages:
array of TImage;
// ID der Images der Buttons
ButtonImageID: TButtonImageID;
// Die Labels ermöglichen den Zugriff / Hovern der Buttons
LblOK : TLabel;
LblCancel : TLabel;
LblExit : TLabel;
LblApply : TLabel;
LblClose : TLabel;
// Hovereffekte für die Buttons
procedure ButtonMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
end;
implementation
uses ufoBasicForm, ufoAdmin_ServerConfig, ufoAbout;
{-----------------------------------------------------------------------------
Author: Martin
Changes by:
Status: Not Finished
Hovereffekt für die Buttons
-----------------------------------------------------------------------------}
procedure TBmsForm.ButtonMouseMove(Sender: TObject; Shift: TShiftState;
X: Integer; Y: Integer);
var
Parent: TBmsForm;
ImageKind: ^TButtonImageSubID;
begin
// Hover Image anzeigen, anderes Image verbergen
Parent := ((sender
as TLabel).Parent
as TBmsForm);
ImageKind :=
nil;
// ImageKind festlegen
if Sender = LblOK
then
ImageKind := @Parent.ButtonImageID.FOK;
if Sender = LblCancel
then
ImageKind := @Parent.ButtonImageID.FCancel;
if Sender = LblExit
then
ImageKind := @Parent.ButtonImageID.FExit;
if Sender = LblApply
then
ImageKind := @Parent.ButtonImageID.FApply;
if Sender = LblClose
then
ImageKind := @Parent.ButtonImageID.FClose;
// Änderung durchführen
if ImageKind <>
nil then
begin
Parent.FormImages[ImageKind.FNormal].Visible := False;
Parent.FormImages[ImageKind.FHover].Visible := True;
Parent.FormImages[ImageKind.FPushed].Visible := False;
end;
end;
{-----------------------------------------------------------------------------
Author: Martin
Changes by:
Status: Not Finished
Diese Prozedur läd das Skin, also alle Bilder
-----------------------------------------------------------------------------}
procedure TTemplateManagement.LoadTemplate(Sender: TObject;
aButtons: TAvButtonsCount; CoreForm: boolean);
const
// Für den Errorreport, wenn die Anwendung eine Exception erzeugt
cProcName = '
ufoTemplate.TTemplateForm.LoadSkinOverload';
var
CurrentImageID : integer;
DesignResFile :
string;
begin
// Name der DLL, aus dem die Bilder geladen werden
DesignResFile := FileNameDirectories.AppDesignDir + AppCurrentDesignSourceFile;
// Footer Buttons einfügen (2x Image + 1x Label)
(Sender
as TBmsForm).ButtonImageID := TButtonImageID.Create;
case aButtons
of
avbOk:
begin
// OK Button erstellen
(Sender
as TBmsForm).ButtonImageID.FOK := TButtonImageSubID.Create;
// Normal Status
CurrentImageID := AddNewImage(Sender);
PrepareImage(Sender, DesignResFile, CurrentImageID,
(Sender
as TBmsForm).ClientHeight - 26,
(Sender
as TBmsForm).ClientWidth - 81, 21, 73, True, True, False,
[akBottom,akRight], '
ButtonNormal');
(Sender
as TBmsForm).ButtonImageID.FOK.FNormal := CurrentImageID;
// ButtonPress Status
CurrentImageID := AddNewImage(Sender);
PrepareImage(Sender, DesignResFile, CurrentImageID,
(Sender
as TBmsForm).ClientHeight - 26,
(Sender
as TBmsForm).ClientWidth - 81, 21, 73, True, False, False,
[akBottom,akRight], '
ButtonPress');
(Sender
as TBmsForm).ButtonImageID.FOK.FPushed := CurrentImageID;
// Gehoverter Status
CurrentImageID := AddNewImage(Sender);
PrepareImage(Sender, DesignResFile, CurrentImageID,
(Sender
as TBmsForm).ClientHeight - 26,
(Sender
as TBmsForm).ClientWidth - 81, 21, 73, True, False, False,
[akBottom,akRight], '
ButtonHover');
(Sender
as TBmsForm).ButtonImageID.FOK.FHover := CurrentImageID;
// ButtonLabel erstellen, für Hover / OnClick
CreateLabel(Sender, (Sender
as TBmsForm).LblOK,
(Sender
as TBmsForm).ClientHeight - 26,
(Sender
as TBmsForm).ClientWidth - 81, 21, 73, True,
True, False, '
OK', taCenter, tlCenter, 7, '
Tahoma',
True, [akBottom,akRight], crHandPoint);
end;
{ ... }
end;
end;
{-----------------------------------------------------------------------------
Author: Martin
Changes by:
Status: Not Finished
Bereitet ein Label für seine Benutzung vor
-----------------------------------------------------------------------------}
procedure TTemplateManagement.CreateLabel(Sender: TObject;
LabelObject: TLabel; Top, Left, Height, Width: integer; SendToFront,
Transparent, AutoSize: boolean; LabelCaption:
string; Alignment: TAlignment;
Layout: TTextLayout; FontSize: integer; FontName:
string; ShowLabel: boolean;
Anchors: TAnchors; Cursor: TCursor);
begin
LabelObject := TLabel.Create((Sender
as TBmsForm));
LabelObject.Parent := (Sender
as TBmsForm);
LabelObject.Top := Top;
{ ... }
LabelObject.Font.Size := FontSize;
LabelObject.Font.
Name := FontName;
LabelObject.OnMouseMove := (Sender
as TBmsForm).ButtonMouseMove;
if ShowLabel = True
then
begin
LabelObject.Show;
end
else
begin
LabelObject.Hide;
end;
end;