DELPHI如何做像WORD的标尺,水平和垂直的都要,要有刻度.
发布网友
发布时间：2022-05-18 01:20
共2个回答
热心网友
时间：2023-11-21 13:55
热心网友
时间：2023-11-21 13:55
声明：
TfrxRulerUnits = (ruCM, ruInches, ruPixels, ruChars);
TfrxRuler = class(TPanel)
private
FOffset: Integer;
FScale: Extended;
FStart: Integer;
FUnits: TfrxRulerUnits;
FPosition: Extended;
FSize: Integer;
procere SetOffset(const Value: Integer);
procere SetScale(const Value: Extended);
procere SetStart(const Value: Integer);
procere SetUnits(const Value: TfrxRulerUnits);
procere SetPosition(const Value: Extended);
procere WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;
procere SetSize(const Value: Integer);
public
constructor Create(AOwner: TComponent); override;
procere Paint; override;
published
property Offset: Integer read FOffset write SetOffset;
property Scale: Extended read FScale write SetScale;
property Start: Integer read FStart write SetStart;
property Units: TfrxRulerUnits read FUnits write SetUnits default ruPixels;
property Position: Extended read FPosition write SetPosition;
property Size: Integer read FSize write SetSize;
end;
实现：
{ TfrxRuler }
constructor TfrxRuler.Create(AOwner: TComponent);
begin
inherited;
FScale := 1;
DoubleBuffered := True;
end;
procere TfrxRuler.WMEraseBackground(var Message: TMessage);
begin
//
end;
procere TfrxRuler.Paint;
var
fh, oldfh: HFont;
sz: Integer;
function CreateRotatedFont(Font: TFont): HFont;
var
F: TLogFont;
begin
GetObject(Font.Handle, SizeOf(TLogFont), @F);
F.lfEscapement := 90 * 10;
F.lfOrientation := 90 * 10;
Result := CreateFontIndirect(F);
end;
procere Line(x, y, dx, dy: Integer);
begin
Canvas.MoveTo(x, y);
Canvas.LineTo(x + dx, y + dy);
end;
procere DrawLines;
var
i, dx, maxi: Extended;
i1, h, w, w5, w10, maxw, ofs: Integer;
s: String;
begin
with Canvas do
begin
Pen.Color := clBlack;
Brush.Style := bsClear;
w5 := 5;
w10 := 10;
if FUnits = ruCM then
dx := fr01cm * FScale
else if FUnits = ruInches then
dx := fr01in * FScale
else if FUnits = ruChars then
begin
if Align = alLeft then
dx := fr1CharY * FScale / 10 else
dx := fr1CharX * FScale / 10
end
else
begin
dx := FScale;
w5 := 50;
w10 := 100;
end;
if FSize = 0 then
begin
if Align = alLeft then
maxi := Height + FStart else
maxi := Width + FStart;
end
else
maxi := FSize;
if FUnits = ruPixels then
s := IntToStr(FStart + Round(maxi / dx)) else
s := IntToStr((FStart + Round(maxi / dx)) div 10);
maxw := TextWidth(s);
ofs := FOffset - FStart;
if FUnits = ruChars then
begin
if Align = alLeft then
Inc(ofs, Round(fr1CharY * FScale / 2)) else
Inc(ofs, Round(fr1CharX * FScale / 2))
end;
i := 0;
i1 := 0;
while i < maxi do
begin
h := 0;
if i1 = 0 then
h := 0
else if i1 mod w10 = 0 then
h := 6
else if i1 mod w5 = 0 then
h := 4
else if FUnits <> ruPixels then
h := 2;
if (h = 2) and (dx * w10 < 41) then
h := 0;
if (h = 4) and (dx * w10 < 21) then
h := 0;
w := 0;
if h = 6 then
begin
if maxw > dx * w10 * 1.5 then
w := w10 * 4
else if maxw > dx * w10 * 0.7 then
w := w10 * 2
else
w := w10;
end;
if FUnits = ruPixels then
s := IntToStr(i1) else
s := IntToStr(i1 div 10);
if (w <> 0) and (i1 mod w = 0) and (ofs + i >= FOffset) then
if Align = alLeft then
TextOut(Width - TextHeight(s) - 6, ofs + Round(i) + TextWidth(s) div 2 + 1, s) else
TextOut(ofs + Round(i) - TextWidth(s) div 2 + 1, 4, s)
else if (h <> 0) and (ofs + i >= FOffset) then
if Align = alLeft then
Line(3 + (13 - h) div 2, ofs + Round(i), h, 0) else
Line(ofs + Round(i), 3 + (13 - h) div 2, 0, h);
i := i + dx;
Inc(i1);
end;
i := FPosition * dx;
if FUnits <> ruPixels then
i := i * 10;
if ofs + i >= FOffset then
if Align = alLeft then
Line(3, ofs + Round(i), 13, 0) else
Line(ofs + Round(i), 3, 0, 13);
end;
end;
begin
fh := 0; oldfh := 0;
with Canvas do
begin
Brush.Color := clBtnFace;
Brush.Style := bsSolid;
FillRect(Rect(0, 0, Width, Height));
Brush.Color := clWindow;
Font.Name := 'Arial';
Font.Size := 7;
if Align = alLeft then
begin
if FSize = 0 then
sz := Height
else
sz := FSize + FOffset;
FillRect(Rect(3, FOffset, Width - 5, sz));
fh := CreateRotatedFont(Font);
oldfh := SelectObject(Handle, fh);
end
else
begin
if FSize = 0 then
sz := Width
else
sz := FSize + FOffset;
FillRect(Rect(FOffset, 3, sz, Height - 5));
end;
end;
DrawLines;
if Align = alLeft then
begin
SelectObject(Canvas.Handle, oldfh);
DeleteObject(fh);
end;
end;
procere TfrxRuler.SetOffset(const Value: Integer);
begin
FOffset := Value;
Invalidate;
end;
procere TfrxRuler.SetPosition(const Value: Extended);
begin
FPosition := Value;
Invalidate;
end;
procere TfrxRuler.SetScale(const Value: Extended);
begin
FScale := Value;
Invalidate;
end;
procere TfrxRuler.SetStart(const Value: Integer);
begin
FStart := Value;
Invalidate;
end;
procere TfrxRuler.SetUnits(const Value: TfrxRulerUnits);
begin
FUnits := Value;
Invalidate;
end;
procere TfrxRuler.SetSize(const Value: Integer);
begin
FSize := Value;
Invalidate;
end;
