{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvgRuler.PAS, released on 2003-01-15. The Initial Developer of the Original Code is Andrey V. Chudin, [chudin att yandex dott ru] Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin. All Rights Reserved. Contributor(s): Michael Beck [mbeck att bigfoot dott com]. You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.delphi-jedi.org Known Issues: -----------------------------------------------------------------------------} // $Id$ unit JvRuler; {$mode objfpc}{$H+} interface uses LCLIntf, LCLType, LCLVersion, Types, Classes, SysUtils, Graphics, Controls, JvComponent; const DEFAULT_JVR_MAJOR_TICKLENGTH = 8; DEFAULT_JVR_MINOR_TICKLENGTH = 3; DEFAULT_JVR_MARKER_SIZE = 6; type TJvRulerUnit = (ruCentimeters, ruInches, ruPixels); TJvRulerOrientation = (roHorizontal, roVertical); TJvRuler = class(TJvGraphicControl) private FUseUnit: TJvRulerUnit; FOrientation: TJvRulerOrientation; FPosition: Double; FTickColor: TColor; FMarkerColor: TColor; FMarkerFilled: Boolean; FMarkerSize: Integer; FMajorTickLength: Integer; FMinorTickCount: Integer; FMinorTickLength: Integer; FShowBaseline: Boolean; FShowPositionMarker: Boolean; procedure SetMarkerColor(const Value: TColor); procedure SetMarkerFilled(const Value: Boolean); procedure SetMarkerSize(const Value: Integer); procedure SetMajorTickLength(const Value: Integer); procedure SetMinorTickCount(const Value: Integer); procedure SetMinorTickLength(const Value: Integer); procedure SetOrientation(const Value: TJvRulerOrientation); procedure SetPosition(const Value: Double); procedure SetShowBaseline(const Value: Boolean); procedure SetShowPositionMarker(const Value: Boolean); procedure SetTickColor(const Value: TColor); procedure SetUseUnit(const Value: TJvRulerUnit); protected procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; class function GetControlClassDefaultSize: TSize; override; procedure Paint; override; public constructor Create(AOwner: TComponent); override; published property Align; property BorderSpacing; property Font; property MarkerColor: TColor read FMarkerColor write SetMarkerColor default clBlack; property MarkerFilled: Boolean read FMarkerFilled write SetMarkerFilled default true; property MarkerSize: Integer read FMarkerSize write SetMarkerSize default DEFAULT_JVR_MARKER_SIZE; property MajorTickLength: Integer read FMajorTickLength write SetMajorTickLength default DEFAULT_JVR_MAJOR_TICKLENGTH; property MinorTickCount: Integer read FMinorTickCount write SetMinorTickCount default 1; property MinorTickLength: Integer read FMinorTickLength write SetMinorTicklength default DEFAULT_JVR_MINOR_TICKLENGTH; property Orientation: TJvRulerOrientation read FOrientation write SetOrientation default roHorizontal; property Position: Double read FPosition write SetPosition; property ShowBaseline: Boolean read FShowBaseline write SetShowBaseLine default false; property ShowPositionMarker: Boolean read FShowPositionMarker write SetShowPositionMarker default false; property TickColor: TColor read FTickColor write SetTickColor default clBlack; property UseUnit: TJvRulerUnit read FUseUnit write SetUseUnit default ruCentimeters; end; implementation uses Math; const LogPixels: array [Boolean] of Integer = (LOGPIXELSY, LOGPIXELSX); function InchesToPixels(DC: HDC; Value: Double; IsHorizontal: Boolean): Integer; begin Result := Round(Value * GetDeviceCaps(DC, LogPixels[IsHorizontal])); end; function CentimetersToPixels(DC: HDC; Value: Double; IsHorizontal: Boolean): Integer; begin Result := Round(Value * GetDeviceCaps(DC, LogPixels[IsHorizontal]) / 2.54); end; function IsMultipleOf(a, b: Double): Boolean; var c: Double; begin c := a / b; Result := SameValue(c, round(c)); end; //=== { TJvRuler } =========================================================== constructor TJvRuler.Create(AOwner: TComponent); begin inherited Create(AOwner); FOrientation := roHorizontal; FTickColor := clBlack; FUseUnit := ruCentimeters; FMarkerFilled := true; FMarkerSize := DEFAULT_JVR_MARKER_SIZE; FMajorTickLength := DEFAULT_JVR_MAJOR_TICKLENGTH; FMinorTickLength := DEFAULT_JVR_MINOR_TICKLENGTH; FMinorTickCount := 1; with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); end; procedure TJvRuler.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); var proportion: Double; begin inherited; if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin case FOrientation of roHorizontal: proportion := AYProportion; roVertical: proportion := AXProportion; end; FMarkerSize := round(FMarkerSize * proportion); FMajorTickLength := round(FMajorTickLength * proportion); FMinorTicklength := round(FMinorTickLength * proportion); end; end; class function TJvRuler.GetControlClassDefaultSize: TSize; begin Result.CX := 380; Result.CY := 25; end; procedure TJvRuler.Paint; const MAJOR_DIST: array[TJvRulerUnit] of Double = (1.0, 1.0, 100.0); var X, Y: Double; PX, PY, Pos: Integer; S: string; R: TRect; ts: TTextStyle; h, w: Integer; delta: Double; isLabeledTick: Boolean; isLongTick: Boolean; tickLength: Integer; baselineOffset: Integer; markerSizeL, markerSizeS: Integer; Pts: array[0..2] of TPoint; begin w := inherited Width; h := inherited Height; ts := Canvas.TextStyle; ts.SingleLine := true; Canvas.Font := Font; Canvas.Pen.Style := psSolid; Canvas.Pen.Color := FTickColor; X := 0; Y := 0; delta := MAJOR_DIST[FUseUnit] / (FMinorTickCount + 1); case FUseUnit of ruInches: Pos := InchesToPixels(Canvas.Handle, Position, Orientation = roHorizontal); ruCentimeters: Pos := CentimetersToPixels(Canvas.Handle, Position, Orientation = roHorizontal); ruPixels: Pos := Round(Position); end; // Draw baseline baseLineOffset := 0; if FShowBaseLine then begin case FOrientation of roHorizontal: Canvas.Line(0, h-1, w, h-1); roVertical: Canvas.Line(w-1, 0, w-1, h); end; baseLineOffset := 1; end; // Draw labels and ticks while true do begin case FUseUnit of ruInches: begin PX := InchesToPixels(Canvas.Handle, X, True); PY := InchesToPixels(Canvas.Handle, Y, False); end; ruCentimeters: begin PX := CentimetersToPixels(Canvas.Handle, X, True); PY := CentimetersToPixels(Canvas.Handle, Y, False); end; ruPixels: begin PX := Round(X); PY := Round(Y); Pos := Round(Position); end; else raise Exception.Create('Units not supported.'); end; case Orientation of roHorizontal: if PX > w then break; roVertical: if PY > h then break; end; //SetBkMode(Canvas.Handle, TRANSPARENT); with Canvas do begin if Orientation = roHorizontal then begin isLabeledTick := IsMultipleOf(X, MAJOR_DIST[FUseUnit]) and (X <> 0); if isLabeledTick then begin //R := Rect(PX - 10, 0, PX + 10, h); if UseUnit = ruPixels then S := IntToStr(PX) else S := IntToStr(Round(X)); R := Rect(PX - TextWidth(S), 0, PX + TextWidth(S), h); ts.Alignment := taCenter; TextRect(R, R.Left, R.Top, S, ts); //Windows.DrawText(Handle, PChar(S), Length(S), R, DT_SINGLELINE or DT_CENTER); end; isLongTick := isLabeledTick or (IsMultipleOf(2*X, MAJOR_DIST[FUseUnit]) and (FMinorTickCount > 1)); tickLength := IfThen(isLongTick, FMajorTickLength, FMinorTickLength); MoveTo(PX, h - baselineOffset - tickLength); LineTo(PX, h - baselineOffset); end else begin isLabeledTick := IsMultipleOf(Y, MAJOR_DIST[FUseUnit]) and (Y <> 0); if isLabeledTick then begin if UseUnit = ruPixels then S := IntToStr(PY) else S := IntToStr(Round(Y)); R := Rect(0, PY - TextHeight(S), w, PY + TextHeight(S)); ts.Layout := tlCenter; TextRect(R, R.Left, R.Top, S, ts); //Windows.DrawText(Handle, PChar(S), Length(S), R, DT_SINGLELINE or DT_VCENTER); end; isLongTick := isLabeledTick or (IsMultipleOf(2*Y, MAJOR_DIST[FUseUnit]) and (FMinorTickCount > 1)); tickLength := IfThen(isLongTick, FMajorTickLength, FMinorTickLength); MoveTo(w - baselineOffset - tickLength, PY); LineTo(w - baselineOffset, PY); end; X := X + delta; Y := Y + delta; end; end; // Draw Position marker if FShowPositionMarker and (Position > 0.0) then begin markerSizeL := FMarkerSize; markerSizeS := FMarkerSize div 2; case Orientation of roHorizontal: begin Pts[0] := Point(Pos - markerSizeS, h - markerSizeL - baseLineOffset); Pts[1] := Point(Pos + markerSizeS, h - markerSizeL - baseLineOffset); Pts[2] := Point(Pos, h - baselineOffset); end; roVertical: begin Pts[0] := Point(w - markerSizeL - baselineOffset, Pos - markerSizeS); Pts[1] := Point(w - markerSizeL - baselineOffset, Pos + markerSizeS); Pts[2] := Point(w - baselineOffset, Pos); end; end; with Canvas do begin Pen.Color := FMarkerColor; Brush.Color := FMarkerColor; if FMarkerFilled then Brush.Style := bsSolid else Brush.Style := bsClear; Polygon(Pts); end; { if Orientation = roHorizontal then begin MoveTo(Pos - markerSizeS, h - markerSizeL - baselineOffset); LineTo(Pos + markerSizeS, h - markerSizeL - baselineOffset); LineTo(Pos, h - baselineOffset); LineTo(Pos - markerSizeS, h - markerSizeL - baselineOffset); end else begin MoveTo(w - markerSizeL - baselineOffset, Pos - markerSizeS); LineTo(w - markerSizeL - baselineOffset, Pos + markerSizeS); LineTo(w - baselineOffset, Pos); LineTo(w - markerSizeL - baselineOffset, Pos - markersizeS); end; } end; end; procedure TJvRuler.SetMarkerColor(const Value: TColor); begin if FMarkerColor <> Value then begin FMarkerColor := Value; Invalidate; end; end; procedure TJvRuler.SetMarkerFilled(const Value: Boolean); begin if FMarkerFilled <> Value then begin FMarkerFilled := Value; Invalidate; end; end; procedure TJvRuler.SetMarkerSize(const Value: Integer); begin if FMarkerSize <> Value then begin FMarkerSize := abs(Value); Invalidate; end; end; procedure TJvRuler.SetMajorTickLength(const Value: Integer); begin if FMajorTickLength <> Value then begin FMajorTickLength := abs(Value); Invalidate; end; end; procedure TJvRuler.SetMinorTickCount(const Value: Integer); begin if FMinorTickCount <> Value then begin FMinorTickCount := abs(Value); Invalidate; end; end; procedure TJvRuler.SetMinorTickLength(const Value: Integer); begin if FMinorTickLength <> Value then begin FMinorTickLength := abs(Value); Invalidate; end; end; procedure TJvRuler.SetOrientation(const Value: TJvRulerOrientation); begin if FOrientation <> Value then begin FOrientation := Value; if ([csDesigning, csLoading] * ComponentState = [csDesigning]) then SetBounds(Left, Top, Height, Width); Invalidate; end; end; procedure TJvRuler.SetPosition(const Value: Double); begin if FPosition <> Value then begin FPosition := Value; Invalidate; end; end; procedure TJvRuler.SetShowBaseline(const Value: Boolean); begin if FShowBaseLine <> Value then begin FShowBaseLine := Value; Invalidate; end; end; procedure TJvRuler.SetShowPositionMarker(const Value: Boolean); begin if FShowPositionMarker <> Value then begin FShowPositionMarker := Value; Invalidate; end; end; procedure TJvRuler.SetTickColor(const Value: TColor); begin if FTickColor <> Value then begin FTickColor := Value; Invalidate; end; end; procedure TJvRuler.SetUseUnit(const Value: TJvRulerUnit); begin if FUseUnit <> Value then begin FUseUnit := Value; Invalidate; end; end; end.