Ruler.pas
上传用户:dgeyuang
上传日期:2007-01-11
资源大小:65k
文件大小:8k
- unit Ruler;
- interface
- uses
- Classes, Controls, ExtCtrls, Forms, Graphics, SysUtils, FDUtils;
- type
- TRuler = class(TPanel)
- private
- FSizePixels : Integer;
- FSizeInches : Double;
- FIsMetric : Boolean;
- FIsHorizontal : Boolean;
- FStartPosition : Integer;
- FLoMarkPosition : Integer;
- FHiMarkPosition : Integer;
- rPixelsPerInch : Double;
- rPixelsPerCM : Double; //每厘米的点数
- procedure SetSizePixels(ASizePixels : Integer);
- procedure SetSizeInches(ASizeInches : Double);
- procedure SetIsMetric(AIsMetric : Boolean);
- procedure SetIsHorizontal(AIsHorizontal : Boolean);
- procedure SetStartPosition(APosition : Integer);
- procedure SetLoMarkPosition(APosition : Integer);
- procedure SetHiMarkPosition(APosition : Integer);
- protected
- procedure Paint; override;
- property Canvas;
- public
- constructor Create(AOwner : TComponent); override;
- procedure SetMarkPositions(LoPosition, HiPosition : Integer);
- property SizePixels : Integer read FSizePixels write SetSizePixels;
- property SizeInches : Double read FSizeInches write SetSizeInches;
- property IsMetric : Boolean read FIsMetric write SetIsMetric;
- property IsHorizontal : Boolean read FIsHorizontal write SetIsHorizontal;
- property StartPosition : Integer read FStartPosition write SetStartPosition;
- property LoMarkPosition : Integer read FLoMarkPosition write SetLoMarkPosition;
- property HiMarkPosition : Integer read FHiMarkPosition write SetHiMarkPosition;
- end;
- implementation
- const
- ctDefaultWidth = 16;
- ctDefaultHeight = 16;
- ctDefaultWidthPixels = 600;
- ctDefaultHeightPixels = 900;
- ctDefaultWidthInches = 8.5;
- ctDefaultHeightInches = 11.0;
- constructor TRuler.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- BevelInner := bvNone;
- BevelOuter := bvRaised;
- BorderStyle := bsNone;
- Color := clWindow;
- FLoMarkPosition := -1;
- FHiMarkPosition := -1;
- SetIsHorizontal(True); {Default to a horizontal ruler}
- end; { Create }
- procedure TRuler.Paint;
- var
- I : Integer;
- BasePos : Integer;
- Offset : Integer;
- MarkPos : Integer;
- SizeCMs : Double; //厘米
- NumStr : string[4];
- begin
- inherited Paint;
- Canvas.Font.Color := clWindowText;
- if FIsHorizontal then begin
- if FIsMetric then begin
- SizeCMs := InchesToMillimeters(FSizeInches) / 10.0;
- for I := 1 to Trunc(SizeCMs * 4) do begin
- BasePos := Round(I * rPixelsPerCM / 4) - FStartPosition;
- if BasePos > 0 then begin
- if I mod 4 = 0 then begin
- NumStr := IntToStr(I div 4);
- if Length(NumStr) = 1 then
- Offset := 2
- else
- Offset := 5;
- Canvas.TextOut(BasePos - Offset, 1, IntToStr(I div 4))
- end else if I mod 2 = 0 then
- Canvas.TextOut(BasePos - 2, 1, '+')
- else
- Canvas.Pixels[BasePos, 8] := clBlack;
- end;
- end; { for }
- end else begin
- for I := 1 to Trunc(FSizeInches * 10) do begin
- BasePos := Round(I * rPixelsPerInch / 10) - FStartPosition;
- if BasePos > 0 then begin
- if I mod 10 = 0 then begin
- NumStr := IntToStr(I div 10);
- if Length(NumStr) = 1 then
- Offset := 3
- else
- Offset := 7;
- Canvas.TextOut(BasePos - Offset, 1, IntToStr(I div 10))
- end else if I mod 5 = 0 then
- Canvas.TextOut(BasePos - 3, 1, '+')
- else
- Canvas.Pixels[BasePos, 8] := clBlack;
- end;
- end;
- end;
- Canvas.Pen.Color := clHighlight;
- Canvas.Pen.Width := 2;
- MarkPos := FLoMarkPosition - FStartPosition;
- if MarkPos >= 0 then
- with Canvas do begin
- MoveTo(MarkPos, 0);
- LineTo(MarkPos, Height);
- end;
- MarkPos := FHiMarkPosition - FStartPosition;
- if MarkPos >= 0 then
- with Canvas do begin
- MoveTo(MarkPos, 0);
- LineTo(MarkPos, Height);
- end;
- end else begin
- if FIsMetric then begin
- SizeCMs := InchesToMillimeters(FSizeInches) / 10.0;
- for I := 1 to Trunc(SizeCMs * 4) do begin
- BasePos := Round(I * rPixelsPerCM / 4) - FStartPosition;
- if BasePos > 0 then begin
- if I mod 4 = 0 then begin
- NumStr := IntToStr(I div 4);
- if Length(NumStr) = 1 then
- Offset := 4
- else
- Offset := 1;
- Canvas.TextOut(Offset, BasePos - 6, IntToStr(I div 4))
- end else if I mod 2 = 0 then
- Canvas.TextOut(4, BasePos - 7, '+')
- else
- Canvas.Pixels[7, BasePos] := clBlack;
- end;
- end; { for }
- end else begin
- for I := 1 to Trunc(FSizeInches * 10) do begin
- BasePos := Round(I * rPixelsPerInch / 10) - FStartPosition;
- if BasePos > 0 then begin
- if I mod 10 = 0 then begin
- NumStr := IntToStr(I div 10);
- if Length(NumStr) = 1 then
- Offset := 4
- else
- Offset := 1;
- Canvas.TextOut(Offset, BasePos - 6, IntToStr(I div 10))
- end else if I mod 5 = 0 then
- Canvas.TextOut(4, BasePos - 7, '+')
- else
- Canvas.Pixels[7, BasePos] := clBlack;
- end;
- end;
- end;
- Canvas.Pen.Color := clHighlight;
- Canvas.Pen.Width := 2;
- MarkPos := FLoMarkPosition - FStartPosition;
- if MarkPos >= 0 then
- with Canvas do begin
- MoveTo(0, MarkPos);
- LineTo(Width, MarkPos);
- end;
- MarkPos := FHiMarkPosition - FStartPosition;
- if MarkPos >= 0 then
- with Canvas do begin
- MoveTo(0, MarkPos);
- LineTo(Width, MarkPos);
- end;
- end;
- end; { Paint }
- procedure TRuler.SetSizePixels(ASizePixels : Integer);
- var
- SizeCMs : Double;
- begin
- if (ASizePixels <> FSizePixels) and (ASizePixels <> 0) then begin
- FSizePixels := ASizePixels;
- if FSizeInches = 0.0 then begin
- rPixelsPerInch := 0.0;
- rPixelsPerCM := 0.0;
- end else begin
- SizeCMs := InchesToMillimeters(FSizeInches) / 10.0;
- rPixelsPerInch := FSizePixels / FSizeInches;
- rPixelsPerCM := FSizePixels / SizeCMs;
- end;
- Invalidate;
- end;
- end;
- procedure TRuler.SetSizeInches(ASizeInches : Double);
- var
- SizeCMs : Double;
- begin
- if (ASizeInches <> FSizeInches) and (ASizeInches <> 0.0) then begin
- FSizeInches := ASizeInches;
- SizeCMs := InchesToMillimeters(FSizeInches) / 10.0;
- rPixelsPerInch := FSizePixels / FSizeInches;
- rPixelsPerCM := FSizePixels / SizeCMs;
- Invalidate;
- end;
- end;
- procedure TRuler.SetIsMetric(AIsMetric : Boolean);
- begin
- if AIsMetric <> FIsMetric then begin
- FIsMetric := AIsMetric;
- Invalidate;
- end;
- end;
- procedure TRuler.SetIsHorizontal(AIsHorizontal : Boolean);
- begin
- if AIsHorizontal <> FIsHorizontal then begin
- FIsHorizontal := AIsHorizontal;
- Align := alNone;
- if FIsHorizontal then begin
- SizePixels := ctDefaultWidthPixels;
- SizeInches := ctDefaultWidthInches;
- Height := ctDefaultHeight;
- end else begin
- SizePixels := ctDefaultHeightPixels;
- SizeInches := ctDefaultHeightInches;
- Width := ctDefaultWidth;
- end;
- end;
- end;
- procedure TRuler.SetStartPosition(APosition : Integer);
- begin
- if APosition <> FStartPosition then begin
- FStartPosition := APosition;
- Invalidate;
- end;
- end;
- procedure TRuler.SetLoMarkPosition(APosition : Integer);
- begin
- if APosition <> FLoMarkPosition then begin
- FLoMarkPosition := APosition;
- Invalidate;
- end;
- end;
- procedure TRuler.SetHiMarkPosition(APosition : Integer);
- begin
- if APosition <> FHiMarkPosition then begin
- FHiMarkPosition := APosition;
- Invalidate;
- end;
- end;
- procedure TRuler.SetMarkPositions(LoPosition, HiPosition : Integer);
- begin
- if LoPosition < -1 then
- LoPosition := -1;
- if HiPosition < -1 then
- HiPosition := -1;
- if (LoPosition <> FLoMarkPosition) or (HiPosition <> FHiMarkPosition) then begin
- FLoMarkPosition := LoPosition;
- FHiMarkPosition := HiPosition;
- Invalidate;
- end;
- end;
- end.