<TfrxReport Version="4.7.79" DotMatrixReport="False" IniFile="\Software\Fast Reports" OldStyleProgress="True" PreviewOptions.Buttons="4095" PreviewOptions.Zoom="1" PrintOptions.Printer="Default" PrintOptions.PrintOnSheet="0" ReportOptions.CreateDate="39885,6563492824" ReportOptions.Description.Text="" ReportOptions.LastChange="39900,3746713657" ScriptLanguage="PascalScript" ScriptText.Text="Const hght=46;
wdth=56;
var
CalendarStartDate: TDateTime;
DayWidth,DayLeft,AllDayTop,TimeTop,NotTimeTop,NotTimeBottom: Extended;
TimeBand1Count: Integer;
function StartOfTheMonth(const AValue: TDateTime): TDateTime;
var
LYear, LMonth, LDay: Word;
begin
DecodeDate(AValue, LYear, LMonth, LDay);
Result := EncodeDate(LYear, LMonth, 1);
end;
procedure CalendarOnBeforePrint(Sender: TfrxComponent);
begin
CalendarStartDate := 0;
end;
procedure CalHeaderOnBeforePrint(Sender: TfrxComponent);
begin
if CalendarStartDate = 0 then
CalendarStartDate := <Days."Day">
else
CalendarStartDate := CalendarStartDate + 42;
CalendarStartDate := StartOfTheMonth(CalendarStartDate) - DayOfWeek(StartOfTheMonth(CalendarStartDate) -
<FirstDayOfWeek> + 5) mod 7;
end;
procedure CalDayOnAfterData(Sender: TfrxComponent);
var
D: TDateTime;
begin
D := CalendarStartDate + <Line> - 1;
with TfrxMemoView(Sender) do
begin
if MonthOf(D) <> MonthOf(CalendarStartDate + 7) then
Text := ''
else
begin
Text := IntToStr(DayOf(D));
if 1 shl ((DayOfWeek(D) + 5) mod 7) and <WorkDays> = 0 then
Font.Color := clRed
else
Font.Color := clWindowText;
end;
if (Text <> '') and (TaskCount(D) > 0) then
Color := $D0D0D0
else
Color := clNone;
end;
end;
procedure OnAfterPrint(Sender: TfrxComponent);
begin
DayLeft := wdth;
DayWidth := (Engine.PageWidth - wdth) / <TasksWeekViewDays>;
AllDayTop := Engine.CurY;
TimeTop := AllDayTop + <AllDayTasks."RecordCount"> * 24;
end;
procedure AllDaysOnBeforePrint(Sender: TfrxComponent);
begin
DayLeft := wdth + (<Line> - 1) * DayWidth;
Engine.CurY := AllDayTop;
end;
procedure DaysOnBeforePrint(Sender: TfrxComponent);
begin
DayLeft := wdth + (<Line> - 1) * DayWidth;
end;
procedure TableCellOnBeforePrint(Sender: TfrxComponent);
begin
with TfrxMemoView(Sender) do
begin
Left := DayLeft;
Width := DayWidth;
if (Font.Style <> 0) and (1 shl ((DayOfWeek(<Days."Day">) + 5) mod 7) and <WorkDays> = 0) then
Font.Color := clRed
else
Font.Color := clWindowText;
end;
end;
procedure AllDayOnBeforePrint(Sender: TfrxComponent);
begin
TableCellOnBeforePrint(Sender);
with TfrxMemoView(Sender) do
if <AllDayTasks."idTask"> = 0 then
Color := clNone
else
begin
Color := <AllDayTasks."BackgroundColor">;
if <AllDayTasks."Subject"> <> '' then
Memo.Text := '<b>[AllDayTasks."Subject"]</b>'#13#10'[AllDayTasks."Text"]'
else
Memo.Text := '[AllDayTasks."Text"]';
end;
end;
procedure NotTimeOnBeforePrint(Sender: TfrxComponent);
begin
if <Line> = 1 then
Engine.CurY := NotTimeTop;
TableCellOnBeforePrint(Sender);
if <NotTimeTasks."idTask"> = 0 then
TfrxMemoView(Sender).Color := clNone
else
TfrxMemoView(Sender).Color := <NotTimeTasks."BackgroundColor">;
end;
procedure TimeBand1BeforePrint(Sender: TfrxComponent);
begin
if <Line> = 1 then
TimeBand1Count := Trunc(Engine.FreeSpace / hght);
TfrxView(Sender).Visible := <Line> <= TimeBand1Count;
end;
procedure TimeBand2BeforePrint(Sender: TfrxComponent);
begin
TfrxView(Sender).Visible := <Line> > TimeBand1Count;
end;
procedure TimeLineOnAfterData(Sender: TfrxComponent);
begin
TfrxView(Sender).Left := wdth + TfrxView(Sender).Tag * DayWidth;
end;
procedure TimeOnBeforePrint(Sender: TfrxComponent);
var
H: Integer;
S: String;
begin
H := <Line> + 6;
S := FormatDateTime('AMPM', H / 24);
if (S = '') or ((H <> 7) and (H <> 12)) then
TfrxMemoView(Sender).Text := '00'
else
TfrxMemoView(Sender).Text := S;
end;
procedure HourOnBeforePrint(Sender: TfrxComponent);
var
H: Integer;
begin
H := <Line> + 6;
if Pos('AM', <ShortTimeFormat>) <> 0 then
if H = 0 then H := 12 else
if H > 12 then Dec(H, 12);
if (Pos('hh', <ShortTimeFormat>) <> 0) and (H < 10) then
TfrxMemoView(Sender).Text := '0' + IntToStr(H)
else
TfrxMemoView(Sender).Text := IntToStr(H);
end;
procedure OnBeforePrint(Sender: TfrxComponent);
begin
if TimeBand1Count < 12 then
begin
Engine.NewPage;
TimeTop := Engine.CurY;
NotTimeTop := TimeTop + (12 - TimeBand1Count) * hght;
end
else
if <TasksWeekViewDays> = 1 then
NotTimeTop := TimeTop + hght * 12
else
NotTimeTop := TimeTop + hght * 12 + 20;
end;
procedure SetTaskText(MemoView: TfrxMemoView);
var
S: String;
begin
if <DayTasks."TimeStr"> = '' then S := ''
else S := '[DayTasks."TimeStr"] ';
with MemoView.Memo do
begin
if <DayTasks."Subject"> <> '' then
Text := '<b>' + S + '[DayTasks."Subject"]</b>'#13#10
else
Text := S;
if <DayTasks."Location"> <> '' then
Text := Text + '([DayTasks."Location"])'#13#10;
Text := Text + '[DayTasks."Text"]';
end;
end;
procedure Task1OnBeforePrint(Sender: TfrxComponent);
begin
with TfrxMemoView(Sender) do
begin
if Tag = 0 then
begin
Engine.CurY := TimeTop;
Left := wdth + 1 + (Engine.PageWidth - wdth) * (<DayTasks."Level"> - 1) / <DayTasks."MaxLevel">;
Width := (Engine.PageWidth - wdth) / <DayTasks."MaxLevel"> - 2;
end
else
begin
Engine.CurY := TimeTop + hght / 2;
Left := wdth + 1 + DetailData4.DataSet.RecNo * DayWidth + DayWidth * (<DayTasks."Level"> - 1) / <DayTasks."MaxLevel">;
Width := DayWidth / <DayTasks."MaxLevel"> - 2;
end;
Top := <DayTasks."StartLine"> * hght / 2 + 1;
if <DayTasks."StartLine"> >= TimeBand1Count * 2 then
begin
Height := 0;
Frame.Typ := 0;
end
else
if <DayTasks."EndLine"> > TimeBand1Count * 2 then
begin
Height := (TimeBand1Count * 2 - <DayTasks."StartLine">) * hght / 2;
Frame.Typ := <ftLeft> + <ftRight> + <ftTop>;
end
else
begin
Height := (<DayTasks."EndLine"> - <DayTasks."StartLine">) * hght / 2 - 2;
Frame.Typ := <ftLeft> + <ftRight> + <ftTop> + <ftBottom>;
end;
Color := <DayTasks."BackgroundColor">;
end;
SetTaskText(TfrxMemoView(Sender));
end;
procedure Task2OnBeforePrint(Sender: TfrxComponent);
begin
Engine.CurY := TimeTop;
with TfrxMemoView(Sender) do
begin
if Tag = 0 then
begin
Left := wdth + 1 + (Engine.PageWidth - wdth) * (<DayTasks."Level"> - 1) / <DayTasks."MaxLevel">;
Width := (Engine.PageWidth - wdth) / <DayTasks."MaxLevel"> - 2;
end
else
begin
Left := wdth + 1 + DetailData4.DataSet.RecNo * DayWidth + DayWidth * (<DayTasks."Level"> - 1) / <DayTasks."MaxLevel">;
Width := DayWidth / <DayTasks."MaxLevel"> - 2;
end;
if <DayTasks."EndLine"> <= TimeBand1Count * 2 then
begin
Height := 0;
Frame.Typ := 0;
end
else
if <DayTasks."StartLine"> < TimeBand1Count * 2 then
begin
Top := -1;
Height := (<DayTasks."EndLine"> - TimeBand1Count * 2) * hght / 2;
Frame.Typ := <ftLeft> + <ftRight> + <ftBottom>;
Font.Color := clWindow;
end
else
begin
Top := (<DayTasks."StartLine"> - TimeBand1Count * 2) * hght / 2 + 1;
Height := (<DayTasks."EndLine"> - <DayTasks."StartLine">) * hght / 2 - 2;
Frame.Typ := <ftLeft> + <ftRight> + <ftTop> + <ftBottom>;
Font.Color := clWindowText;
end;
Color := <DayTasks."BackgroundColor">;
end;
SetTaskText(TfrxMemoView(Sender));
end;
procedure OnAfterData(Sender: TfrxComponent);
function GetParamName(const Params: String; var Pos: Integer; var ParamName: Char): Boolean;
var
I: Integer;
S: String;
begin
I := Pos;
while (I <= Length(Params)) and (Params[I] <> '=') do Inc(I);
S := Copy(Params, Pos, I - Pos);
Pos := I + 1;
Result := (S <> '') and (S[1] in['A'..'Z']);
if Result then
ParamName := S[1];
end;
function GetParamValue(const Params: String; var Pos: Integer; var ParamValue: Integer): Boolean;
var
I: Integer;
S: String;
begin
I := Pos;
while (I <= Length(Params)) and (Params[I] in['0'..'9']) do Inc(I);
S := Copy(Params, Pos, I - Pos);
Pos := I;
Result := S <> '';
if Result then
ParamValue := StrToInt(S);
end;
var
Params: String;
Pos,ParamValue: Integer;
ParamName,ParamSign: Char;
E: Extended;
begin
Pos := 1;
with TfrxView(Sender) do
begin
Params := TagStr;
while GetParamName(Params, Pos, ParamName) do
if GetParamValue(Params, Pos, ParamValue) then
begin
if (Pos <= Length(Params)) and (Params[Pos] = '%') then
begin
if ParamName in['L', 'R', 'W'] then
E := Engine.PageWidth * ParamValue / 100
else
E := Engine.PageHeight * ParamValue / 100;
Inc(Pos);
end
else
E := ParamValue;
if (Pos <= Length(Params)) and (Params[Pos] in['+', '-']) then
begin
ParamSign := Params[Pos];
Inc(Pos);
if GetParamValue(Params, Pos, ParamValue) then
if ParamSign = '+' then
E := E + ParamValue
else
E := E - ParamValue;
end;
case ParamName of
'L': Left := E;
'T': Top := E;
'R': Left := E - Width;
'B': Top := E - Height;
'W': Width := E;
'H': Height := E;
end;
Inc(Pos);
end;
end;
end;
begin
end." PropData="044C65667403940003546F70027408446174617365747301010C1300000020446174615365744E616D653D22446179732200010C1700000020446174615365744E616D653D224461795461736B732200010C1A00000020446174615365744E616D653D22416C6C4461795461736B732200010C1B00000020446174615365744E616D653D224E6F7454696D655461736B73220000095661726961626C65730100055374796C650100">
