📄 main.pas
字号:
{******************************************}
{ }
{ FastReport v3.0 }
{ FastReport Server demo }
{ Copyright (c) 1998-2005 }
{ by Alexander Fediachov, }
{ Fast Reports Inc. }
{ }
{******************************************}
unit Main;
{$I frx.inc}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, Db, DBTables, frxDesgn, frxClass, frxDCtrl,
frxChart, frxRich, frxBarcode, ImgList, ComCtrls, ExtCtrls, frxOLE,
frxCross, frxServer, frxGradient, frxChBox, Menus, ShellApi, config_form,
frxADOComponents, ADODB, frxGZip, Dialogs, frxMD5, frxServerUtils, IniFiles;
type
TMainForm = class(TForm)
frBarCodeObject1: TfrxBarCodeObject;
frRichObject1: TfrxRichObject;
frChartObject1: TfrxChartObject;
frDialogControls1: TfrxDialogControls;
ImageList1: TImageList;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
frOLEObject1: TfrxOLEObject;
frCrossObject1: TfrxCrossObject;
frxCheckBoxObject1: TfrxCheckBoxObject;
PopupMenu1: TPopupMenu;
Close1: TMenuItem;
ShowWin: TMenuItem;
N1: TMenuItem;
MinimizeBtn: TButton;
CloseBtn: TButton;
GroupBox1: TGroupBox;
Label4: TLabel;
LBActive: TLabel;
LBInactive: TLabel;
GroupBox2: TGroupBox;
Label5: TLabel;
ETotalSessions: TEdit;
Label6: TLabel;
ETotalReports: TEdit;
Timer1: TTimer;
Label7: TLabel;
Label8: TLabel;
EMaxReports: TEdit;
EMaxSessions: TEdit;
Label9: TLabel;
Label10: TLabel;
ECurrentReports: TEdit;
ECurrentSessions: TEdit;
Label11: TLabel;
EErrors: TEdit;
N2: TMenuItem;
Start1: TMenuItem;
Stop1: TMenuItem;
StartBtn: TButton;
StopBtn: TButton;
ConfigBtn: TButton;
DesignBtn: TButton;
frxDesigner1: TfrxDesigner;
OpenDialog1: TOpenDialog;
Label12: TLabel;
Uptime: TLabel;
frxADOComponents1: TfrxADOComponents;
Serv: TfrxReportServer;
Label13: TLabel;
DemoDatabase: TADOConnection;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure MinimizeBtnClick(Sender: TObject);
procedure ShutBtnClick(Sender: TObject);
procedure ShowWinClick(Sender: TObject);
procedure StartBtnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ConfigBtnClick(Sender: TObject);
procedure DesignBtnClick(Sender: TObject);
procedure Label3Click(Sender: TObject);
protected
procedure ControlWindow(var Msg:TMessage); message WM_SYSCOMMAND;
procedure IconMouse(var Msg : TMessage); message WM_USER + 1;
private
Icon: TIcon;
AppPath: String;
ConfFile: String;
AllowFile: String;
DenyFile: String;
frReport1: TfrxReport;
procedure TrayIcon(n: Integer; Icon: TIcon);
end;
var
MainForm: TMainForm;
dbMd: String;
const
CONFIG_FILE = 'server.conf';
ALLOW_FILE = 'allow.conf';
DENY_FILE = 'deny.conf';
implementation
{$R *.DFM}
var
DATABASE_FILE: String;
DBConnStr: String = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=';
procedure TMainForm.TrayIcon(n:Integer;Icon:TIcon);
var
Nim: TNotifyIconData;
begin
with Nim do
begin
cbSize:=SizeOf(Nim);
Wnd:=Self.Handle;
uID:=1;
uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
hicon:=Icon.Handle;
uCallbackMessage:=WM_USER + 1;
szTip:='FastReport Server';
end;
case n of
1: Shell_NotifyIcon(Nim_Add,@Nim);
2: Shell_NotifyIcon(Nim_Delete,@Nim);
3: Shell_NotifyIcon(Nim_Modify,@Nim);
end;
end;
procedure TMainForm.ControlWindow(var Msg: TMessage);
begin
if Msg.WParam = SC_MINIMIZE then
begin
TrayIcon(1, Icon);
ShowWindow(Application.Handle, SW_HIDE);
ShowWindow(Handle, SW_HIDE);
end else
inherited;
end;
procedure TMainForm.IconMouse(var Msg: TMessage);
var
p:tpoint;
begin
GetCursorPos(p);
case Msg.LParam of
WM_LBUTTONUP, WM_LBUTTONDBLCLK:
ShowWinClick(nil);
WM_RBUTTONUP:
begin
SetForegroundWindow(Handle);
PopupMenu1.Popup(p.X, p.Y);
PostMessage(Handle,WM_NULL,0,0)
end;
End;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
ini: TIniFile;
begin
Label13.Caption := #174;
Icon := TIcon.Create;
ImageList1.GetIcon(0, Icon);
AppPath := ExtractFilePath(Application.ExeName);
ConfFile := AppPath + CONFIG_FILE;
AllowFile := AppPath + ALLOW_FILE;
DenyFile := AppPath + DENY_FILE;
ini := TIniFile.Create(ConfFile);
try
DATABASE_FILE := AppPath + ini.ReadString('Database', 'Connection', 'database\server.mdb');
finally
ini.Free;
end;
DemoDatabase.ConnectionString := DBConnStr + DATABASE_FILE;
try
DemoDatabase.Open;
except
ShowMessage('Error database connection!');
end;
StartBtnClick(Sender);
MinimizeBtnClick(Sender);
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Serv <> nil then
StopBtnClick(Sender);
TrayIcon(2, Icon);
Icon.Free;
if DemoDatabase.Connected then
DemoDatabase.Close;
end;
procedure TMainForm.MinimizeBtnClick(Sender: TObject);
begin
PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
procedure TMainForm.ShutBtnClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.ShowWinClick(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_SHOWNORMAL);
ShowWindow(Handle, SW_SHOWNORMAL);
end;
procedure TMainForm.StartBtnClick(Sender: TObject);
begin
if DemoDatabase.Connected then
begin
Screen.Cursor := crHourGlass;
try
if FileExists(ConfFile) then
Serv.Configuration.LoadFromFile(ConfFile);
if FileExists(AllowFile) then
begin
Serv.AllowIP.Clear;
Serv.AllowIP.LoadFromFile(AllowFile);
end;
if FileExists(DenyFile) then
begin
Serv.DenyIP.Clear;
Serv.DenyIP.LoadFromFile(DenyFile);
end;
Serv.Open;
if Serv.Active then
begin
StartBtn.Enabled := False;
StopBtn.Enabled := True;
LBActive.Visible := True;
LBInactive.Visible := False;
Timer1.Enabled := True;
ImageList1.GetIcon(0, Icon);
TrayIcon(3, Icon);
Start1.Enabled := False;
Stop1.Enabled := True;
end;
finally
Screen.Cursor := crDefault;
end;
end;
end;
procedure TMainForm.StopBtnClick(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
try
Timer1.Enabled := False;
Serv.Close;
StartBtn.Enabled := True;
StopBtn.Enabled := False;
LBActive.Visible := False;
LBInactive.Visible := True;
ImageList1.GetIcon(1, Icon);
TrayIcon(3, Icon);
Start1.Enabled := True;
Stop1.Enabled := False;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
ETotalSessions.Text := IntToStr(Serv.Statistic.TotalSessionsCount);
ETotalReports.Text := IntToStr(Serv.Statistic.TotalReportsCount);
EMaxSessions.Text := IntToStr(Serv.Statistic.MaxSessionsCount);
EMaxReports.Text := IntToStr(Serv.Statistic.MaxReportsCount);
EErrors.Text := IntToStr(Serv.Statistic.TotalErrors);
ECurrentSessions.Text := IntToStr(Serv.Statistic.CurrentSessionsCount);
ECurrentReports.Text := IntToStr(Serv.Statistic.CurrentReportsCount);
Uptime.Caption := IntToStr(Serv.Statistic.UpTimeDays) + ' days ' +
IntToStr(Serv.Statistic.UpTimeHours) + ' hours ' +
IntToStr(Serv.Statistic.UpTimeMins) + ' minutes ' +
IntToStr(Serv.Statistic.UpTimeSecs) + ' seconds';
Label2.Caption := 'Version: ' + Serv.Variables.GetValue('SERVER_SOFTWARE') + ' from ' + Serv.Variables.GetValue('SERVER_LAST_UPDATE');
end;
procedure TMainForm.ConfigBtnClick(Sender: TObject);
begin
Config := TConfig.Create(nil);
Config.fsSyntaxMemo1.Lines.LoadFromFile(ConfFile);
if Config.ShowModal = mrOk then
Config.fsSyntaxMemo1.Lines.SaveToFile(ConfFile);
Config.Free;
end;
procedure TMainForm.DesignBtnClick(Sender: TObject);
begin
OpenDialog1.InitialDir := Serv.Configuration.ReportPath;
if OpenDialog1.Execute then
begin
frReport1 := TfrxReport.Create(nil);
frReport1.LoadFromFile(OpenDialog1.FileName);
frReport1.Variables['PathToDataBase'] := '''' + DATABASE_FILE + '''';
frReport1.DesignReport;
frReport1.Free;
end;
end;
procedure TMainForm.Label3Click(Sender: TObject);
begin
ShellExecute(GetDesktopWindow, 'open', PChar(Label3.Caption), nil, nil, SW_SHOW);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -