?? reportcontrol.pas
字號:
FLeftLineWidth := Cell.FLeftLineWidth;
FTopLine := Cell.FTopLine;
FTopLineWidth := Cell.FTopLineWidth;
FRightLine := Cell.FRightLine;
FRightLineWidth := Cell.FRightLineWidth;
FBottomLine := Cell.FBottomLine;
FBottomLineWidth := Cell.FBottomLineWidth;
// 斜線
FDiagonal := Cell.FDiagonal;
// color
FTextColor := Cell.FTextColor;
FBackGroundColor := Cell.FBackGroundColor;
// align
FHorzAlign := Cell.FHorzAlign;
FVertAlign := Cell.FVertAlign;
// string
// FCellText := Cell.FCellText;
// font
FLogFont := Cell.FLogFont;
if Cell.OwnerCell <> nil then
begin
if bInsert then
begin
Cell.OwnerCell.FCellsList.Insert(
Cell.OwnerCell.FCellsList.IndexOf(Cell),
Self);
FOwnerCell := Cell.OwnerCell;
end
else
Cell.OwnerCell.AddOwnedCell(Self);
end;
end;
// 一覺醒來,又是一個陽光燦爛的日子
///////////////////////////////////////////////////////////////////////////
// CReportLine
{ TReportLine }
procedure TReportCell.RemoveOwnedCell(Cell: TReportCell);
begin
FCellsList.Remove(Cell);
Cell.OwnerCell := nil;
end;
procedure TReportLine.CalcLineHeight;
var
I: Integer;
ThisCell: TReportCell;
begin
FMinHeight := 0;
for I := 0 to FCells.Count - 1 do
begin
ThisCell := TReportCell(FCells[I]);
if ThisCell.CellHeight > FMinHeight then
FMinHeight := ThisCell.CellHeight;
ThisCell.CellIndex := I;
if (I = 0) and (ReportControl <> nil) then
ThisCell.CellLeft := ReportControl.FLeftMargin;
if I > 0 then
ThisCell.CellLeft := TReportCell(FCells[I - 1]).CellLeft + TReportCell(FCells[I - 1]).CellWidth;
end;
end;
procedure TReportLine.CopyLine(Line: TReportLine; bInsert: Boolean);
var
I: Integer;
NewCell: TReportCell;
begin
if Line = nil then
Exit;
FDragHeight := 0;
FMinHeight := 20;
FReportControl := Line.FReportControl;
for I := 0 to Line.FCells.Count - 1 do
begin
NewCell := TReportCell.Create;
FCells.Add(NewCell);
NewCell.FOwnerLine := Self;
NewCell.CopyCell(Line.FCells[I], bInsert);
end;
end;
constructor TReportLine.Create;
begin
FReportControl := nil;
FCells := TList.Create;
FIndex := 0;
FMinHeight := 0;
FDragHeight := 0;
FLineTop := 0;
FLineRect.left := 0;
FLineRect.top := 0;
FLineRect.right := 0;
FLineRect.bottom := 0;
end;
destructor TReportLine.Destroy;
var
I: Integer;
ThisCell: TReportCell;
begin
for I := FCells.Count - 1 downto 0 do
begin
ThisCell := TReportCell(FCells[I]);
ThisCell.Free;
end;
FCells.Free;
FCells := nil;
inherited Destroy;
end;
procedure TReportLine.CreateLine(LineLeft, CellNumber, PageWidth: Integer);
var
I: Integer;
NewCell: TReportCell;
CellWidth: Integer;
begin
CellWidth := trunc(PageWidth / CellNumber + 0.5);
for I := 0 to CellNumber - 1 do
begin
NewCell := TReportCell.Create;
FCells.Add(NewCell);
NewCell.OwnerLine := Self;
NewCell.CellIndex := I;
NewCell.CellLeft := I * CellWidth + LineLeft;
NewCell.CellWidth := CellWidth;
end;
end;
function TReportLine.GetLineHeight: Integer;
begin
if FMinHeight > FDragHeight then
Result := FMinHeight
else Result := FDragHeight;
end;
function TReportLine.GetLineRect: TRect;
var
I: Integer;
begin
// 重新由各個CELL計算出該行的矩形來
// 由各個CELL計算出行的高度
// CalcLineHeight; // 移到UpdateLines中樂,呵呵。
// 通知每個CELL重新計算坐標
for I := 0 to FCells.Count - 1 do
begin
TReportCell(FCells[I]).CellIndex := I;
TReportCell(FCells[I]).CalcCellRect;
end;
if FCells.Count > 0 then
Result.Left := TReportCell(FCells.First).CellLeft;
Result.Top := FLineTop;
Result.Bottom := Result.Top + LineHeight;
Result.Right := Result.Left;
for I := 0 to FCells.Count - 1 do
Result.Right := Result.Right + TReportCell(FCells[I]).CellWidth;
FLineRect := Result;
end;
procedure TReportLine.SetDragHeight(const Value: Integer);
begin
FDragHeight := Value;
end;
procedure TReportLine.SetLineTop(const Value: Integer);
var
I: Integer;
begin
if FLineTop = Value then
Exit;
FLineTop := Value;
for I := 0 to FCells.Count - 1 do
begin
TReportCell(FCells[I]).CalcCellRect;
end;
end;
///////////////////////////////////////////////////////////////////////////
// TReportControl
{TReportControl}
procedure TReportControl.CreateWnd;
begin
inherited;
if Handle <> INVALID_HANDLE_VALUE then
SetClassLong(Handle, GCL_HCURSOR, 0);
end;
constructor TReportControl.Create(AOwner: TComponent);
var
hDesktopDC: HDC;
nPixelsPerInch: Integer;
begin
inherited Create(AOwner);
// 設定為無光標,防止光標閃爍。
// Cursor := crNone;
FPreviewStatus := False;
Color := clWhite;
FLineList := TList.Create;
FSelectCells := TList.Create;
Celldisp := nil;
cellline_d := nil;
FEditCell := nil;
FNewTable := True;
// FDataLine := 2147483647;
// FTablePerPage := 2147483647;
FDataLine := 57; //廖伯志 1999.1.16
FTablePerPage := 1; //
pgw := 0;
pgh := 0;
FReportScale := 100;
scale := FReportScale;
FPageWidth := 0;
FPageHeight := 0;
hDesktopDC := GetDC(0);
nPixelsPerInch := GetDeviceCaps(hDesktopDC, LOGPIXELSX);
FLeftMargin1 := 20;
FRightMargin1 := 20;
FTopMargin1 := 20;
FBottomMargin1 := 20;
FLeftMargin := trunc(nPixelsPerInch * FLeftMargin1 / 25 + 0.5);
FRightMargin := trunc(nPixelsPerInch * FRightMargin1 / 25 + 0.5);
FTopMargin := trunc(nPixelsPerInch * FTopMargin1 / 25 + 0.5);
FBottomMargin := trunc(nPixelsPerInch * FBottomMargin1 / 25 + 0.5);
ReleaseDC(0, hDesktopDC);
// 鼠標操作支持
FMousePoint.x := 0;
FMousePoint.y := 0;
// 編輯、顏色及字體
FEditWnd := INVALID_HANDLE_VALUE;
FEditBrush := INVALID_HANDLE_VALUE;
FEditFont := INVALID_HANDLE_VALUE;
CalcWndSize;
end;
destructor TReportControl.Destroy;
var
I: Integer;
ThisLine: TReportLine;
begin
FSelectCells.Free;
FSelectCells := nil;
for I := FLineList.Count - 1 downto 0 do
begin
ThisLine := TReportLine(FLineList[I]);
ThisLine.Free;
end;
FLineList.Free;
FLineList := nil;
inherited Destroy;
end;
procedure TReportControl.CalcWndSize;
var
hClientDC: HDC;
begin
isprint := 0;
if printer.Printers.Count <= 0 then
begin
isprint := 1; //未安裝打印機
if pgw <> 0 then
begin
FPageWidth := pgw;
FPageHeight := pgh;
end;
end;
// 根據用戶選擇的紙來確定報表窗口的大小并對該窗口進行設置。
hClientDC := GetDC(0);
if pgw = 0 then
begin
if isprint = 1 then
begin
FPageWidth := 768; //未安裝打印機時,設置默認紙寬
FPageHeight := 1058; //未安裝打印機時,設置默認紙高
end
else
begin
FPageWidth := trunc(Printer.PageWidth / GetDeviceCaps(Printer.Handle, LOGPIXELSX)
* GetDeviceCaps(hClientDC, LOGPIXELSX) + 0.5);
FPageHeight := trunc(Printer.PageHeight / GetDeviceCaps(Printer.Handle, LOGPIXELSY)
* GetDeviceCaps(hClientDC, LOGPIXELSY) + 0.5);
end;
end;
pgw := FPageWidth;
pgh := FPageHeight;
Width := trunc(FPageWidth * FReportScale / 100 + 0.5);
Height := trunc(FPageHeight * FReportScale / 100 + 0.5);
ReleaseDC(0, hClientDC);
end;
procedure TReportControl.WMPaint(var Message: TMessage);
var
hPaintDC: HDC;
ps: TPaintStruct;
I, J: Integer;
TempRect: TRect;
hGrayPen, hPrevPen: HPEN;
ThisLine: TReportLine;
ThisCell: TReportCell;
WndSize: TSize;
rectPaint: TRect;
begin
hPaintDC := BeginPaint(Handle, ps);
SetMapMode(hPaintDC, MM_ISOTROPIC);
WndSize.cx := Width;
WndSize.cy := Height;
SetWindowExtEx(hPaintDC, FPageWidth, FPageHeight, @WndSize);
SetViewPortExtEx(hPaintDC, Width, Height, @WndSize);
rectPaint := ps.rcPaint;
if FReportScale <> 100 then
begin
rectPaint.Left := trunc(rectPaint.Left * 100 / FReportScale + 0.5);
rectPaint.Top := trunc(rectPaint.Top * 100 / FReportScale + 0.5);
rectPaint.Right := trunc(rectPaint.Right * 100 / FReportScale + 0.5);
rectPaint.Bottom := trunc(rectPaint.Bottom * 100 / FReportScale + 0.5);
end;
Rectangle(hPaintDC, 0, 0, FPageWidth, FPageHeight);
hGrayPen := CreatePen(PS_SOLID, 1, RGB(128, 128, 128));
hPrevPen := SelectObject(hPaintDC, hGrayPen);
// 左上
MoveToEx(hPaintDC, FLeftMargin, FTopMargin, nil);
LineTo(hPaintDC, FLeftMargin, FTopMargin - 25);
MoveToEx(hPaintDC, FLeftMargin, FTopMargin, nil);
LineTo(hPaintDC, FLeftMargin - 25, FTopMargin);
// 右上
MoveToEx(hPaintDC, FPageWidth - FRightMargin, FTopMargin, nil);
MoveToEx(hPaintDC, FPageWidth - FRightMargin, FTopMargin, nil);
LineTo(hPaintDC, FPageWidth - FRightMargin + 25, FTopMargin);
// 左下
MoveToEx(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin, nil);
LineTo(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin + 25);
MoveToEx(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin, nil);
LineTo(hPaintDC, FLeftMargin - 25, FPageHeight - FBottomMargin);
// 右下
MoveToEx(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin, nil);
LineTo(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin + 25);
MoveToEx(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin, nil);
LineTo(hPaintDC, FPageWidth - FRightMargin + 25, FPageHeight - FBottomMargin);
SelectObject(hPaintDC, hPrevPen);
DeleteObject(hGrayPen);
///////////////////////////////////////////////////////////////////////////
// 繪制所有與失效區相交的矩形
for I := 0 to FLineList.Count - 1 do
begin
ThisLine := TReportLine(FLineList[I]);
{
if ThisLine.LineRect.Bottom < ps.rcPaint.top then
Continue;
if ThisLine.LineTop > ps.rcPaint.bottom then
Break;
}
for J := 0 to TReportLine(FLineList[i]).FCells.Count - 1 do
begin
ThisCell := TReportCell(ThisLine.FCells[J]);
if ThisCell.CellRect.Left > rectPaint.Right then
Break;
if ThisCell.CellRect.Right < rectPaint.Left then
Continue;
if ThisCell.CellRect.Top > rectPaint.Bottom then
Break;
if ThisCell.CellRect.Bottom < rectPaint.Top then
Continue;
if ThisCell.OwnerCell = nil then
ThisCell.PaintCell(hPaintDC, FPreviewStatus);
end;
end;
if not FPreviewStatus then
begin
for I := 0 to FSelectCells.Count - 1 do
begin
IntersectRect(TempRect, ps.rcPaint, TReportCell(FSelectCells[I]).CellRect);
if (TempRect.right >= TempRect.Left) and (TempRect.bottom >= TempRect.top) then
InvertRect(hPaintDC, TempRect);
end;
end;
// 劃線的算法目前還沒有想出來
// 各個CELL之間表線重疊的部分如何處理,如何存儲這些線的設置呢?顯然,現在的方法太土了。
// 改樂,如果右面的CELL或下面的CELL的左邊線或上邊線為0時,不畫不就得樂。(1998.9.9)
EndPaint(Handle, ps);
end;
procedure TReportControl.WMLButtonDBLClk(var Message: TMessage);
var
ThisCell: TReportCell;
TempPoint: TPoint;
dwStyle: DWORD;
begin
RemoveAllSelectedCell;
GetCursorPos(TempPoint);
Windows.ScreenToClient(Handle, TempPoint);
ThisCell := CellFromPoint(TempPoint);
if (ThisCell <> nil) and (ThisCell.CellWidth > 10) then
begin
FEditCell := ThisCell;
if FEditFont <> INVALID_HANDLE_VALUE then
DeleteObject(FEditFont);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -