?? reportcontrol.pas
字號:
ThisCell: TReportCell;
end;
function DeleteFiles(FilePath, FileMask: string): Boolean;
procedure Register;
var
pgw, pgh, scale: integer;
cellline_d: treportcell; //用于保存選中單元格的屬性 1999.1.25
isprint: byte; //用于是否已安裝打印機
celldisp: TReportCell; //用于顯示Mouse位置的單元格屬性
implementation
//{$R ReportControl.dcr}
//{{{{{{{$R ReportControl.dcr}}}}}}}}} //1999.11.20
uses Preview;
function DeleteFiles(FilePath, FileMask: string): Boolean;
var
Attributes: Word;
DeleteFilesSearchRec: TSearchRec;
begin
Result := true;
try
FindFirst(FilePath + '\' + FileMask, faAnyFile, DeleteFilesSearchRec);
if not (DeleteFilesSearchRec.Name = '') then
begin
Result := True;
Attributes := FileGetAttr(FilePath + '\' + DeleteFilesSearchRec.Name);
// Attributes := Attributes And Not (faReadonly Or faHidden Or fasysfile);
FileSetAttr(FilePath + '\' + DeleteFilesSearchRec.Name, Attributes);
DeleteFile(FilePath + '\' + DeleteFilesSearchRec.Name);
while FindNext(DeleteFilesSearchRec) = 0 do
begin
Attributes := FileGetAttr(FilePath + '\' + DeleteFilesSearchRec.Name);
// Attributes := Attributes And Not (faReadOnly Or faHidden Or fasysfile);
FileSetAttr(FilePath + '\' + DeleteFilesSearchRec.Name, Attributes);
DeleteFile(FilePath + '\' + DeleteFilesSearchRec.Name);
end;
end;
FindClose(DeleteFilesSearchRec);
except
Result := false;
Exit;
end;
end;
procedure Register;
begin
RegisterComponents('中國式報表', [TReportControl]);
RegisterComponents('中國式報表', [TReportRunTime]);
end;
///////////////////////////////////////////////////////////////////////////
// TReportCell
{TReportCell}
procedure TReportCell.SetLeftMargin(LeftMargin: Integer);
begin
// 修改左右預留的空白區(qū)域
// 呵呵,目前只能是5。
if (LeftMargin = FLeftMargin) or
(LeftMargin < 5) or (LeftMargin > 5) then
Exit;
FLeftMargin := LeftMargin;
CalcMinCellHeight;
end;
procedure TReportCell.SetOwnerLine(OwnerLine: TReportLine);
begin
if OwnerLine <> nil then
FOwnerLine := OwnerLine;
end;
procedure TReportCell.SetOwnerCell(Cell: TReportCell);
begin
FOwnerCell := Cell;
// CalcMinCellHeight;
end;
function TReportCell.GetOwnedCellCount: Integer;
begin
Result := FCellsList.Count;
end;
procedure TReportCell.AddOwnedCell(Cell: TReportCell);
var
I: Integer;
TempCellList: TList;
begin
if (Cell = nil) or (FCellsList.IndexOf(Cell) >= 0) then
Exit;
Cell.OwnerCell := Self;
FCellText := FCellText + Cell.CellText;
Cell.CellText := '';
FCellsList.Add(Cell);
TempCellList := TList.Create;
for I := 0 to Cell.FCellsList.Count - 1 do
TempCellList.Add(Cell.FCellsList[I]);
Cell.RemoveAllOwnedCell();
for I := 0 to TempCellList.Count - 1 do
begin
FCellsList.Add(TempCellList[I]);
TReportCell(TempCellList[I]).OwnerCell := Self;
end;
// CalcMinCellHeight;
end;
procedure TReportCell.RemoveAllOwnedCell;
var
I: Integer;
Cell: TReportCell;
begin
for I := 0 to FCellsList.Count - 1 do
begin
Cell := FCellsList[I];
Cell.SetOwnerCell(nil);
Cell.CalcMinCellHeight;
end;
FCellsList.Clear;
// CalcMinCellHeight;
end;
function TReportCell.IsCellOwned(Cell: TReportCell): Boolean;
begin
if FCellsList.IndexOf(Cell) >= 0 then
Result := True
else
Result := False;
end;
procedure TReportCell.SetCellLeft(CellLeft: Integer);
begin
if CellLeft = FCellLeft then
Exit;
FCellLeft := CellLeft;
CalcCellRect;
end;
procedure TReportCell.SetCellWidth(CellWidth: Integer);
begin
if CellWidth = FCellWidth then
Exit;
if CellWidth > 10 then
begin
FCellWidth := CellWidth;
CalcMinCellHeight;
CalcCellRect;
end
else
begin
FCellWidth := 10;
CalcMinCellHeight;
CalcCellRect;
end;
end;
function TReportCell.GetCellHeight: Integer;
begin
if FOwnerLine = nil then
Result := 0
else
begin
if FDragCellHeight > FMinCellHeight then
Result := FDragCellHeight
else
Result := FMinCellHeight;
end;
end;
function TReportCell.GetCellTop: Integer;
begin
if FOwnerLine = nil then
Result := 0
else
Result := FOwnerLine.LineTop;
end;
procedure TReportCell.SetLeftLine(LeftLine: Boolean);
begin
if LeftLine = FLeftLine then
Exit;
FLeftLine := LeftLine;
CalcMinCellHeight;
CalcCellRect;
// InvalidateRect here because Cell;s Rect no change
end;
procedure TReportCell.SetLeftLineWidth(LeftLineWidth: Integer);
begin
if LeftLineWidth = FLeftLineWidth then
Exit;
FLeftLineWidth := LeftLineWidth;
CalcMinCellHeight;
CalcCellRect;
end;
procedure TReportCell.SetTopLine(TopLine: Boolean);
begin
if TopLine = FTopLine then
Exit;
FTopLine := TopLine;
CalcMinCellHeight;
CalcCellRect;
end;
procedure TReportCell.SetTopLineWidth(TopLineWidth: Integer);
begin
if TopLineWidth = FTopLineWidth then
Exit;
FTopLineWidth := TopLineWidth;
CalcMinCellHeight;
CalcCellRect;
end;
procedure TReportCell.SetRightLine(RightLine: Boolean);
begin
if RightLine = FRightLine then
Exit;
FRightLine := RightLine;
CalcMinCellHeight;
CalcCellRect;
end;
procedure TReportCell.SetRightLineWidth(RightLineWidth: Integer);
begin
if RightLineWidth = FRightLineWidth then
Exit;
FRightLineWidth := RightLineWidth;
CalcMinCellHeight;
CalcCellRect;
end;
procedure TReportCell.SetBottomLine(BottomLine: Boolean);
begin
if BottomLine = FBottomLine then
Exit;
FBottomLine := BottomLine;
CalcMinCellHeight;
CalcCellRect;
end;
procedure TReportCell.SetBottomLineWidth(BottomLineWidth: Integer);
begin
if BottomLineWidth = FBottomLineWidth then
Exit;
FBottomLineWidth := BottomLineWidth;
CalcMinCellHeight;
CalcCellRect;
end;
procedure TReportCell.SetCellText(CellText: string);
begin
if CellText = FCellText then
Exit;
FCellText := CellText;
CalcMinCellHeight;
end;
procedure TReportCell.SetLogFont(NewFont: TLOGFONT);
begin
FLogFont := NewFont;
CalcMinCellHeight;
end;
procedure TReportCell.SetBackGroundColor(BkColor: COLORREF);
begin
if BkColor = FBackGroundColor then
Exit;
FBackGroundColor := BkColor;
// InvalidateRect
end;
procedure TReportCell.SetTextColor(TextColor: COLORREF);
begin
if TextColor = FTextColor then
Exit;
FTextColor := TextColor;
// InvalidateRect
end;
// 開始噩夢,噩夢中我把屏幕上的象素點一個一個干掉
procedure TReportCell.CalcMinCellHeight;
var
hTempFont, hPrevFont: HFONT;
hTempDC: HDC;
TempString: string;
TempRect: TRect;
Format: UINT;
I: Integer;
BottomCell, ThisCell: TReportCell;
TotalHeight, Height, Top: Integer;
TempSize: TSize;
begin
// 計算CELL的最小高度
if FCellWidth <= FLeftMargin * 2 then
begin
FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
Exit;
end;
// 隸屬與某CELL時
if FOwnerCell <> nil then
begin
// 取得最下的單元格
FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
BottomCell := nil;
Height := 0;
Top := 0;
for I := 0 to FOwnerCell.FCellsList.Count - 1 do
begin
ThisCell := FOwnerCell.FCellsList[i];
ThisCell.FMinCellHeight := 16 + 2 + ThisCell.TopLineWidth + ThisCell.BottomLineWidth;
ThisCell.OwnerLine.CalcLineHeight;
Height := Height + ThisCell.OwnerLineHeight;
if ThisCell.CellTop > Top then
begin
BottomCell := ThisCell;
Top := ThisCell.CellTop;
end;
end;
if BottomCell <> Self then
begin
FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
Exit;
end
else
begin
TotalHeight := Height + FOwnerCell.OwnerLineHeight;
if FOwnerCell.RequiredCellHeight > TotalHeight then
FMinCellHeight := FOwnerCell.RequiredCellHeight - TotalHeight + OwnerLineHeight
else
FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
Exit;
end;
end;
hTempFont := CreateFontIndirect(FLogFont);
// 此處取得窗口的指針用于計算大小
if (Length(FCellText) <= 0) then
TempString := '漢'
else
TempString := FCellText;
hTempDC := GetDC(0);
hPrevFont := SelectObject(hTempDC, hTempFont);
SetRect(TempRect, 0, 0, 0, 0);
TempRect.left := FCellLeft + FLeftMargin;
TempRect.top := GetCellTop + 2;
;
TempRect.right := FCellLeft + FCellWidth - FLeftMargin;
TempRect.bottom := 65535;
Format := DT_EDITCONTROL or DT_WORDBREAK;
case FHorzAlign of
0:
Format := Format or DT_LEFT;
1:
Format := Format or DT_CENTER;
2:
Format := Format or DT_RIGHT;
else
Format := Format or DT_LEFT;
end;
Format := Format or DT_CALCRECT;
DrawText(hTempDC, PChar(TempString), Length(TempString), TempRect, Format);
// DrawText(hTempDC, PChar(TempString), -1, TempRect, Format);
// 補償文字最后的回車帶來的誤差
if Length(TempString) >= 2 then
begin
if (TempString[Length(TempString)] = Chr(10)) and
(TempString[Length(TempString) - 1] = Chr(13)) then
begin
GetTextExtentPoint(hTempDC, 'A', 1, TempSize);
TempRect.Bottom := TempRect.Bottom + TempSize.cy;
end;
end;
SelectObject(hTempDc, hPrevFont);
DeleteObject(hTempFont);
ReleaseDC(0, hTempDC);
if (FCellsList.Count > 0) then
begin
if TempRect.Bottom - TempRect.Top <= 0 then
FRequiredCellHeight := 16
else
FRequiredCellHeight := TempRect.Bottom - TempRect.Top;
FRequiredCellHeight := FRequiredCellHeight + 2;
FRequiredCellHeight := FRequiredCellHeight + FTopLineWidth + FBottomLineWidth;
FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
OwnerLine.CalcLineHeight;
for I := 0 to FCellsList.Count - 1 do
TReportCell(FCellsList[I]).CalcMinCellHeight;
end
else
begin
if TempRect.Bottom - TempRect.Top <= 0 then
FMinCellHeight := 16
else
FMinCellHeight := TempRect.Bottom - TempRect.Top;
FMinCellHeight := FMinCellHeight + 2;
FMinCellHeight := FMinCellHeight + FTopLineWidth + FBottomLineWidth;
end;
end;
procedure TReportCell.CalcCellRect;
var
TempRect: TRect;
TotalHeight: Integer;
I: Integer;
begin
// Calc CellRect & TextRect here
// 如果CELL的大小或者文本框的大小改變,自動的置窗口的失效區(qū)
if FCellsList.Count <= 0 then
begin
// 計算CELL的矩形
FCellRect.left := FCellLeft;
FCellRect.top := CellTop;
FCellRect.right := FCellRect.left + FCellWidth;
FCellRect.bottom := FCellRect.top + OwnerLineHeight;
{ if scale <> 100 then //1999.1.23
begin
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -