?? untactreport.~pas
字號:
AutoSize := False;
// fit the width to the maximum value
Size.Width := lstWidths[i] - dDetailMargin*2;
tmpSize := Size;
SetPosition(tmpSize, posx, lstWidths[i], dHeightDetail,
lstAlign[i], dDetailMargin);
Size := tmpSize;
Top := Top + nSegbarWidth;
Alignment := CustomToStandardAlign(lstAlign[i]);
Inc(idxSummary);
end;
posx := posx + lstWidths[i];
end;
// create the vertical frame lines here
// if 'not bHasFrameLine' then the lines are disabled
for i := -1 to upFields do begin
if i = -1 then
posx := 0
else
posx := posx + lstWidths[i];
with TQRShape.Create(bandHeader) do begin
Parent := bandHeader;
Enabled := bHasFrameLine;
Shape := qrsVertLine;
Size.Left := posx;
Top := 0;
Width := 1;
Height := bandHeader.Height;
end;
with TQRShape.Create(bandDetail) do begin
Parent := bandDetail;
Enabled := bHasFrameLine;
Shape := qrsVertLine;
Size.Left := posx;
Top := 0;
Width := 1;
Height := bandDetail.Height;
end;
if bHasSummary then
with TQRShape.Create(bandSummary) do begin
Parent := bandSummary;
Enabled := bHasFrameLine;
Shape := qrsVertLine;
Size.Left := posx;
Top := 0;
Width := 1;
Height := bandSummary.Height;
end;
end;
// create the horizental frame lines here
// if 'not bHasFrameLine' then the lines are disabled
with TQRShape.Create(bandHeader) do begin
Parent := bandHeader;
Enabled := bHasFrameLine;
Shape := qrsHorLine;
Left := 0;
Top := 0;
Size.Width := posx;
Height := 1;
end;
with TQRShape.Create(bandHeader) do begin
Parent := bandHeader;
Enabled := bHasFrameLine;
Shape := qrsRectangle;
Left := 0;
Top := bandHeader.Height - nSegbarWidth;
Size.Width := posx;
Height := nSegbarWidth;
Brush.Color := clBlack;
end;
with TQRShape.Create(bandDetail) do begin
Parent := bandDetail;
Enabled := bHasFrameLine;
Shape := qrsHorLine;
Left := 0;
Top := 0;
Size.Width := posx;
Height := 1;
end;
with TQRShape.Create(bandDetail) do begin
Parent := bandDetail;
Enabled := bHasFrameLine;
Shape := qrsHorLine;
Left := 0;
Top := bandDetail.Height;
Size.Width := posx;
Height := 1;
end;
if bHasSummary then begin
with TQRShape.Create(bandSummary) do begin
Parent := bandSummary;
Enabled := bHasFrameLine;
Shape := qrsRectangle;
Left := 0;
Top := 0;
Size.Width := posx;
Height := nSegbarWidth;
Brush.Color := clBlack;
end;
with TQRShape.Create(bandSummary) do begin
Parent := bandSummary;
Enabled := bHasFrameLine;
Shape := qrsHorLine;
Left := 0;
Top := bandSummary.Height;
Size.Width := posx;
Height := 1;
end;
end;
// adjust the position of the title
with TQRLabel(bandTitle.Controls[0]) do begin
AutoSize := False;
tmpSize := Size;
SetPosition(tmpSize, 0, posX, dHeightTitle,
a_center, dDetailMargin);
Size := tmpSize;
end;
// adjust the position of the report
with m_rptActive.Page do begin
case alnReport of
a_left: begin
LeftMargin := dPageHorMargin;
RightMargin := Max(0, Width - LeftMargin - posx);
end;
a_center: begin
LeftMargin := (Width - posx) / 2;
RightMargin := LeftMargin;
end;
a_right: begin
RightMargin := dPageHorMargin;
LeftMargin := Max(0, Width - RightMargin - posx);
end;
end;
TopMargin := dPageVertMargin;
BottomMargin := dPageVertMargin;
end;
Result := True;
end;
procedure TActReport.PrepareMemory(nAryLen: Integer);
begin
SetLength(m_blstDisplay, nAryLen);
m_strlstFieldNames := TStringList.Create;
SetLength(m_dlstFieldWidths, nAryLen);
m_strlstDispNames := TStringList.Create;
SetLength(m_alnlstFields, nAryLen);
SetLength(m_blstSummary, nAryLen);
end;
procedure TActReport.ReleaseMemory;
begin
SetLength(m_blstDisplay, 0);
m_strlstFieldNames.Free;
m_strlstFieldNames := nil;
SetLength(m_dlstFieldWidths, 0);
m_strlstDispNames.Free;
m_strlstDispNames := nil;
SetLength(m_alnlstFields, 0);
SetLength(m_blstSummary, 0);
end;
function TActReport.Initialize : Boolean;
begin
m_bInitialized := False;
m_bPrepared := False;
m_bReportReady := False;
Clear;
m_grpGlobalContainer := grpGlobalParaList;
m_grpFieldContainer := grpFieldParaList;
CreateRep;
m_bInitialized := True;
Result := m_bInitialized;
end;
function TActReport.BeginSession(dst: TDBDataSet;
strTitle: string = '';
strlstDispNames: TStringList = nil
) : Boolean;
var
i: Integer;
begin
m_bPrepared := False;
m_bReportReady := False;
m_dstActive := dst;
FillInCtrls;
m_nFieldCount := m_dstActive.FieldCount;
PrepareMemory(m_nFieldCount);
ParamsDefault;
if Length(strTitle) > 0 then
m_strTitle := strTitle;
if Assigned(strlstDispNames) then
for i := 0 to Min(dst.FieldCount, strlstDispNames.Count) - 1 do
m_strlstDispNames.Strings[i] := strlstDispNames.Strings[i];
m_bPrepared := True;
Result := True;
end;
function TActReport.BuildRep : Boolean;
var
i: Integer;
cntFields, idxFields: Integer;
lstIdxs: TIndexList;
lstDispNames: TStringList;
lstWidths: TCurrencyList;
lstAlign: TAlignList;
lstSummary: TBooleanList;
begin
m_bReportReady := False;
Result := False;
ResetRep;
if not m_bPrepared then
Exit;
cntFields := 0;
for i := 0 to High(m_blstDisplay) do
if m_blstDisplay[i] then
Inc(cntFields);
SetLength(lstIdxs, cntFields);
SetLength(lstWidths, cntFields);
SetLength(lstAlign, cntFields);
SetLength(lstSummary, cntFields);
idxFields := 0;
lstDispNames := TStringList.Create;
for i := 0 to High(m_blstDisplay) do
if m_blstDisplay[i] then begin
lstIdxs[idxFields] := i;
lstWidths[idxFields] := m_dlstFieldWidths[i];
lstDispNames.Add(m_strlstDispNames.Strings[i]);
lstAlign[idxFields] := m_alnlstFields[i];
lstSummary[idxFields] := m_blstSummary[i];
Inc(idxFields);
end;
BuildRep(m_strTitle, m_bHasFrameLine, m_bHasSummary,
m_nPageWidth, m_nPageHeight, m_oriPage, m_alnHeader,
m_dTitleHeight, m_dHeaderHeight, m_dDetailHeight,
m_dDetailMargin, c_segbar_width,
m_dPageHorMargin, m_dPageVertMargin,
m_fntTitle, m_fntHeader, m_fntDetail,
c_page_width, c_page_height,
c_band_width, c_band_height,
c_page_hor_margin, c_page_vert_margin,
c_band_margin, lstIdxs, lstDispNames,
lstWidths, lstAlign, lstSummary, m_alnReport);
lstDispNames.Free;
m_bReportReady := True;
Result := True;
end;
procedure TActReport.TerminateSession;
var
i: Integer;
begin
if Assigned(m_grpFieldContainer) then
for i := 0 to m_grpFieldContainer.ControlCount - 1 do begin
m_grpFieldContainer.Controls[0].Free;
end;
PrepareCtrls(0);
ReleaseMemory;
end;
procedure TActReport.Clear;
begin
TerminateSession;
ResetRep;
end;
//===== public functions/procedures go from here =====
//===== constructors/destructors =====
constructor TActReport.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
m_bInitialized := False;
m_bPrepared := False;
m_bReportReady := False;
m_rptActive := nil;
m_fntTitle := TFont.Create;
m_fntHeader := TFont.Create;
m_fntDetail := TFont.Create;
end;
procedure TActReport.Free;
begin
Clear;
m_fntTitle.Free;
m_fntHeader.Free;
m_fntDetail.Free;
inherited Free;
end;
//===== public interfaces =====
procedure TActReport.Initialize(dst: TDBDataSet;
strTitle: string = '';
strlstDispNames: TStringList = nil
);
begin
Initialize;
BeginSession(dst, strTitle, strlstDispNames);
ParamsToForm;
m_strFileName := m_strTitle;
if Length(m_strFileName) = 0 then
if m_dstActive is TTable then
m_strFileName := TTable(m_dstActive).TableName
else
m_strFileName := m_dstActive.Name;
if Length(m_strFileName) = 0 then
m_strFileName := c_file_name;
m_strFileName := GetCurrentDir + '\' + m_strFileName + c_file_ext;
end;
function TActReport.Make : Boolean;
begin
Result := False;
if not m_bPrepared then
Exit;
ParamsFromForm;
BuildRep;
ParamsFromReport;
Result := True;
end;
function TActReport.PreviewRep : Boolean;
begin
Result := False;
if not m_bReportReady then
Exit;
m_rptActive.OnPreview := nil;
m_rptActive.Preview;
Result := True;
end;
function TActReport.PreviewRep(prv: TQRPreview) : Boolean;
var
bShowError: Boolean;
begin
Result := False;
if not m_bReportReady then
Exit;
if Assigned(prv) then begin
m_prvActive := prv;
m_rptActive.OnPreview := OnPreview;
// QuickReport may cause error here,
// we have to keep previewing till succeed
bShowError := True;
while bShowError do begin
try
m_rptActive.PreviewModeless;
bShowError := False;
except
end;
end;
end
else
begin
m_rptActive.OnPreview := nil;
m_rptActive.Preview;
end;
Result := True;
end;
function TActReport.PrintRep(callback: TQRAfterPrintEvent = nil) : Boolean;
begin
Result := False;
if not m_bReportReady then
Exit;
m_rptActive.AfterPrint := callback;
m_rptActive.Print;
Result := True;
end;
function TActReport.LoadRep : Boolean;
begin
Result := False;
if not m_bInitialized then
Exit;
ParamsFromFile(m_strFileName);
BuildRep;
ParamsFromReport;
ParamsToForm;
Result := True;
end;
function TActReport.SaveRep : Boolean;
begin
Result := False;
if not m_bInitialized then
Exit;
ParamsToFile(m_strFileName);
Result := True;
end;
function TActReport.GetFileName : string;
begin
Result := m_strFileName;
end;
procedure TActReport.SetFileName(strFileName: string);
begin
m_strFileName := strFileName;
end;
function TActReport.ShowModal : Integer;
begin
Result := 0;
if m_bPrepared then
inherited ShowModal;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
增大字號
Ctrl + =
減小字號
Ctrl + -