Ruler.pas
上传用户:dgeyuang
上传日期:2007-01-11
资源大小:65k
文件大小:8k
源码类别:

传真(Fax)编程

开发平台:

Delphi

  1. unit Ruler;
  2. interface
  3. uses
  4.   Classes, Controls, ExtCtrls, Forms, Graphics, SysUtils, FDUtils;
  5. type
  6.   TRuler = class(TPanel)
  7.   private
  8.     FSizePixels     : Integer;
  9.     FSizeInches     : Double;
  10.     FIsMetric       : Boolean;
  11.     FIsHorizontal   : Boolean;
  12.     FStartPosition  : Integer;
  13.     FLoMarkPosition : Integer;
  14.     FHiMarkPosition : Integer;
  15.     rPixelsPerInch  : Double;
  16.     rPixelsPerCM    : Double;  //每厘米的点数
  17.     procedure SetSizePixels(ASizePixels : Integer);
  18.     procedure SetSizeInches(ASizeInches : Double);
  19.     procedure SetIsMetric(AIsMetric : Boolean);
  20.     procedure SetIsHorizontal(AIsHorizontal : Boolean);
  21.     procedure SetStartPosition(APosition : Integer);
  22.     procedure SetLoMarkPosition(APosition : Integer);
  23.     procedure SetHiMarkPosition(APosition : Integer);
  24.   protected
  25.     procedure Paint; override;
  26.     property Canvas;
  27.   public
  28.     constructor Create(AOwner : TComponent); override;
  29.     procedure SetMarkPositions(LoPosition, HiPosition : Integer);
  30.     property SizePixels : Integer read FSizePixels write SetSizePixels;
  31.     property SizeInches : Double read FSizeInches write SetSizeInches;
  32.     property IsMetric : Boolean read FIsMetric write SetIsMetric;
  33.     property IsHorizontal : Boolean read FIsHorizontal write SetIsHorizontal;
  34.     property StartPosition : Integer read FStartPosition write SetStartPosition;
  35.     property LoMarkPosition : Integer read FLoMarkPosition write SetLoMarkPosition;
  36.     property HiMarkPosition : Integer read FHiMarkPosition write SetHiMarkPosition;
  37.   end;
  38. implementation
  39. const
  40.   ctDefaultWidth        = 16;
  41.   ctDefaultHeight       = 16;
  42.   ctDefaultWidthPixels  = 600;
  43.   ctDefaultHeightPixels = 900;
  44.   ctDefaultWidthInches  = 8.5;
  45.   ctDefaultHeightInches = 11.0;
  46. constructor TRuler.Create(AOwner : TComponent);
  47. begin
  48.   inherited Create(AOwner);
  49.   BevelInner      := bvNone;
  50.   BevelOuter      := bvRaised;
  51.   BorderStyle     := bsNone;
  52.   Color           := clWindow;
  53.   FLoMarkPosition := -1;
  54.   FHiMarkPosition := -1;
  55.   SetIsHorizontal(True);  {Default to a horizontal ruler}
  56. end;  { Create }
  57. procedure TRuler.Paint;
  58. var
  59.   I       : Integer;
  60.   BasePos : Integer;
  61.   Offset  : Integer;
  62.   MarkPos : Integer;
  63.   SizeCMs : Double; //厘米
  64.   NumStr  : string[4];
  65. begin
  66.   inherited Paint;
  67.   Canvas.Font.Color := clWindowText;
  68.   if FIsHorizontal then begin
  69.     if FIsMetric then begin
  70.       SizeCMs := InchesToMillimeters(FSizeInches) / 10.0;
  71.       for I := 1 to Trunc(SizeCMs * 4) do begin
  72.         BasePos := Round(I * rPixelsPerCM / 4) - FStartPosition;
  73.         if BasePos > 0 then begin
  74.           if I mod 4 = 0 then begin
  75.             NumStr := IntToStr(I div 4);
  76.             if Length(NumStr) = 1 then
  77.               Offset := 2
  78.             else
  79.               Offset := 5;
  80.             Canvas.TextOut(BasePos - Offset, 1, IntToStr(I div 4))
  81.           end else if I mod 2 = 0 then
  82.             Canvas.TextOut(BasePos - 2, 1, '+')
  83.           else
  84.             Canvas.Pixels[BasePos, 8] := clBlack;
  85.         end;
  86.       end;  { for }
  87.     end else begin
  88.       for I := 1 to Trunc(FSizeInches * 10) do begin
  89.         BasePos := Round(I * rPixelsPerInch / 10) - FStartPosition;
  90.         if BasePos > 0 then begin
  91.           if I mod 10 = 0 then begin
  92.             NumStr := IntToStr(I div 10);
  93.             if Length(NumStr) = 1 then
  94.               Offset := 3
  95.             else
  96.               Offset := 7;
  97.             Canvas.TextOut(BasePos - Offset, 1, IntToStr(I div 10))
  98.           end else if I mod 5 = 0 then
  99.             Canvas.TextOut(BasePos - 3, 1, '+')
  100.           else
  101.             Canvas.Pixels[BasePos, 8] := clBlack;
  102.         end;
  103.       end;  
  104.     end;
  105.     Canvas.Pen.Color := clHighlight;
  106.     Canvas.Pen.Width := 2;
  107.     MarkPos := FLoMarkPosition - FStartPosition;
  108.     if MarkPos >= 0 then
  109.       with Canvas do begin
  110.         MoveTo(MarkPos, 0);
  111.         LineTo(MarkPos, Height);
  112.       end;
  113.     MarkPos := FHiMarkPosition - FStartPosition;
  114.     if MarkPos >= 0 then
  115.       with Canvas do begin
  116.         MoveTo(MarkPos, 0);
  117.         LineTo(MarkPos, Height);
  118.       end;
  119.   end else begin
  120.     if FIsMetric then begin
  121.       SizeCMs := InchesToMillimeters(FSizeInches) / 10.0;
  122.       for I := 1 to Trunc(SizeCMs * 4) do begin
  123.         BasePos := Round(I * rPixelsPerCM / 4) - FStartPosition;
  124.         if BasePos > 0 then begin
  125.           if I mod 4 = 0 then begin
  126.             NumStr := IntToStr(I div 4);
  127.             if Length(NumStr) = 1 then
  128.               Offset := 4                        
  129.             else
  130.               Offset := 1;
  131.             Canvas.TextOut(Offset, BasePos - 6, IntToStr(I div 4))
  132.           end else if I mod 2 = 0 then
  133.             Canvas.TextOut(4, BasePos - 7, '+')
  134.           else
  135.             Canvas.Pixels[7, BasePos] := clBlack;
  136.         end;
  137.       end;  { for }
  138.     end else begin
  139.       for I := 1 to Trunc(FSizeInches * 10) do begin
  140.         BasePos := Round(I * rPixelsPerInch / 10) - FStartPosition;
  141.         if BasePos > 0 then begin
  142.           if I mod 10 = 0 then begin
  143.             NumStr := IntToStr(I div 10);
  144.             if Length(NumStr) = 1 then
  145.               Offset := 4
  146.             else
  147.               Offset := 1;
  148.             Canvas.TextOut(Offset, BasePos - 6, IntToStr(I div 10))
  149.           end else if I mod 5 = 0 then
  150.             Canvas.TextOut(4, BasePos - 7, '+')
  151.           else
  152.             Canvas.Pixels[7, BasePos] := clBlack;
  153.         end;
  154.       end;
  155.     end;
  156.     Canvas.Pen.Color := clHighlight;
  157.     Canvas.Pen.Width := 2;
  158.     MarkPos := FLoMarkPosition - FStartPosition;
  159.     if MarkPos >= 0 then
  160.       with Canvas do begin
  161.         MoveTo(0, MarkPos);
  162.         LineTo(Width, MarkPos);
  163.       end;
  164.     MarkPos := FHiMarkPosition - FStartPosition;
  165.     if MarkPos >= 0 then
  166.       with Canvas do begin
  167.         MoveTo(0, MarkPos);
  168.         LineTo(Width, MarkPos);
  169.       end;
  170.   end;
  171. end;  { Paint }
  172. procedure TRuler.SetSizePixels(ASizePixels : Integer);
  173. var
  174.   SizeCMs : Double;
  175. begin
  176.   if (ASizePixels <> FSizePixels) and (ASizePixels <> 0) then begin
  177.     FSizePixels := ASizePixels;
  178.     if FSizeInches = 0.0 then begin
  179.       rPixelsPerInch := 0.0;
  180.       rPixelsPerCM   := 0.0;
  181.     end else begin
  182.       SizeCMs := InchesToMillimeters(FSizeInches) / 10.0;
  183.       rPixelsPerInch := FSizePixels / FSizeInches;
  184.       rPixelsPerCM   := FSizePixels / SizeCMs;
  185.     end;
  186.     Invalidate;
  187.   end;
  188. end;
  189. procedure TRuler.SetSizeInches(ASizeInches : Double);
  190. var
  191.   SizeCMs : Double;
  192. begin
  193.   if (ASizeInches <> FSizeInches) and (ASizeInches <> 0.0) then begin
  194.     FSizeInches    := ASizeInches;
  195.     SizeCMs        := InchesToMillimeters(FSizeInches) / 10.0;
  196.     rPixelsPerInch := FSizePixels / FSizeInches;
  197.     rPixelsPerCM   := FSizePixels / SizeCMs;
  198.     Invalidate;
  199.   end;
  200. end;
  201. procedure TRuler.SetIsMetric(AIsMetric : Boolean);
  202. begin
  203.   if AIsMetric <> FIsMetric then begin
  204.     FIsMetric := AIsMetric;
  205.     Invalidate;
  206.   end;
  207. end;
  208. procedure TRuler.SetIsHorizontal(AIsHorizontal : Boolean);
  209. begin
  210.   if AIsHorizontal <> FIsHorizontal then begin
  211.     FIsHorizontal := AIsHorizontal;
  212.     Align := alNone;
  213.     if FIsHorizontal then begin
  214.       SizePixels := ctDefaultWidthPixels;
  215.       SizeInches := ctDefaultWidthInches;
  216.       Height     := ctDefaultHeight;
  217.     end else begin
  218.       SizePixels := ctDefaultHeightPixels;
  219.       SizeInches := ctDefaultHeightInches;
  220.       Width      := ctDefaultWidth;
  221.     end;
  222.   end;
  223. end;
  224. procedure TRuler.SetStartPosition(APosition : Integer);
  225. begin
  226.   if APosition <> FStartPosition then begin
  227.     FStartPosition := APosition;
  228.     Invalidate;
  229.   end;
  230. end;
  231. procedure TRuler.SetLoMarkPosition(APosition : Integer);
  232. begin
  233.   if APosition <> FLoMarkPosition then begin
  234.    FLoMarkPosition := APosition;
  235.    Invalidate;
  236.   end;
  237. end;
  238. procedure TRuler.SetHiMarkPosition(APosition : Integer);
  239. begin
  240.   if APosition <> FHiMarkPosition then begin
  241.    FHiMarkPosition := APosition;
  242.    Invalidate;
  243.   end;
  244. end;
  245. procedure TRuler.SetMarkPositions(LoPosition, HiPosition : Integer);
  246. begin
  247.   if LoPosition < -1 then
  248.     LoPosition := -1;
  249.   if HiPosition < -1 then
  250.     HiPosition := -1;
  251.   if (LoPosition <> FLoMarkPosition) or (HiPosition <> FHiMarkPosition) then begin
  252.     FLoMarkPosition := LoPosition;
  253.     FHiMarkPosition := HiPosition;
  254.     Invalidate;
  255.   end;
  256. end;
  257. end.