rm_shape.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{           Report Machine v2.0           }
{           Shape Add-In Object           }
{                                         }
{*****************************************}

unit RM_shape;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, RM_Class, StdCtrls,
  Controls, ExtCtrls, Menus
{$IFDEF Delphi6}, Variants{$ENDIF};

const
  skRectangle = 0;
  skRoundRectangle = 1;
  skEllipse = 2;
  skTriangle = 3;
  skDiagonal1 = 4;
  skDiagonal2 = 5;

	skSquare = 100;
  skRoundSquare = 101;
  skCircle = 102;

type
  TRMShapeObject = class(TComponent)  // fake component
  end;

  TRMShapeView = class(TRMView)
  private
    procedure DrawShape;
	protected
  	function GetViewCommon: string; override;
    procedure SetPropValue(Index: String; Value: Variant); override;
    function GetPropValue(Index: String): Variant; override;
  public
    ShapeType: Byte;
    PenMode: TPenMode;
    constructor Create; override;
    procedure Draw(Canvas: TCanvas); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure DefineProperties; override;
  end;

implementation

uses RM_CmpReg, RM_Utils, RM_Const;

{===========================================================================}
{===========================================================================}
{ TRMShapeView }
constructor TRMShapeView.Create;
begin
  inherited Create;
  ShapeType := skRectangle;
  PenMode := pmCopy;
  BaseName := 'Shape';

  RMConsts['skRectangle'] := skRectangle;
  RMConsts['skRoundRectangle'] := skRoundRectangle;
  RMConsts['skEllipse'] := skEllipse;
  RMConsts['skTriangle'] := skTriangle;
  RMConsts['skDiagonal1'] := skDiagonal1;
  RMConsts['skDiagonal2'] := skDiagonal2;
  RMConsts['skSquare'] := skSquare;
  RMConsts['skRoundSquare'] := skRoundSquare;

  RMConsts['pmBlack'] := pmBlack;
  RMConsts['pmWhite'] := pmWhite;
  RMConsts['pmNop'] := pmNop;
  RMConsts['pmNot'] := pmNot;
  RMConsts['pmCopy'] := pmCopy;
  RMConsts['pmNotCopy'] := pmNotCopy;
  RMConsts['pmMergePenNot'] := pmMergePenNot;
  RMConsts['pmMaskPenNot'] := pmMaskPenNot;
  RMConsts['pmMergeNotPen'] := pmMergeNotPen;
  RMConsts['pmMaskNotPen'] := pmMaskNotPen;
  RMConsts['pmNotMerge'] := pmNotMerge;
  RMConsts['pmMask'] := pmMask;
  RMConsts['pmNotMask'] := pmNotMask;
  RMConsts['pmXor'] := pmXor;
  RMConsts['pmNotXor'] := pmNotXor;
end;

procedure TRMShapeView.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('Shape',
    'skRectangle;skRoundRectangle;skEllipse;skTriangle;skDiagonal1;skDiagonal2;skSquare;skRoundSquare',
    [skRectangle,skRoundRectangle,skEllipse,skTriangle,skDiagonal1,skDiagonal2,skSquare,skRoundSquare]);
  AddEnumProperty('PenMode',
    'pmBlack;pmWhite;pmNop;pmNot;pmCopy;pmNotCopy;pmMergePenNot;pmMaskPenNot;' +
    'pmMergeNotPen;pmMaskNotPenpmMerge;pmNotMerge;pmMask;pmNotMask;pmXor;pmNotXor',
    [pmBlack,pmWhite,pmNop,pmNot,pmCopy,pmNotCopy,pmMergePenNot,pmMaskPenNot,
    pmMergeNotPen,pmMaskNotPen,pmNotMerge,pmMask,pmNotMask,pmXor,pmNotXor]);

  AddProperty('OnBeforePrint', [RMdtHasEditor, RMdtOneObject], RMScript_BeforePrintEditor);
  AddProperty('OnAfterPrint', [RMdtHasEditor, RMdtOneObject], RMScript_AfterPrintEditor);
end;

procedure TRMShapeView.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'SHAPE' then
    ShapeType := Value
  else if Index = 'PENMODE' then
  	PenMode := Value
end;

function TRMShapeView.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'SHAPE' then
    Result := ShapeType
  else if Index = 'PENMODE' then
  	Result := PenMode;
end;

procedure TRMShapeView.DrawShape;
var
  x1, y1, min: Integer;
begin
  x1 := Round((SaveX + SaveDX) * ScaleX + OffsX);
  y1 := Round((SaveY + SaveDY) * ScaleY + OffsY);
  min := dx;
  if dy < dx then
    min := dy;
  with Canvas do
  begin
    Pen.Width := Round(Prop['FrameWidth']);
    Pen.Color := Prop['FrameColor'];
    Pen.Style := TPenStyle(Prop['FrameStyle']);  //    Pen.Style := psSolid;
    SetBkMode(Handle, Opaque);
    Brush.Style := bsClear;
    if FillColor <> clNone then
      Brush.Color := FillColor;
    case ShapeType of
      skRectangle:
      	Rectangle(x, y, x1 + 1, y1 + 1);
      skRoundRectangle:
      	RoundRect(x, y, x1 + 1, y1 + 1, min div 4, min div 4);
      skEllipse:
      	Ellipse(x, y, x1 + 1, y1 + 1);
      skTriangle:
        begin
          MoveTo(x1, y1);
          LineTo(x, y1);
          LineTo(x + (x1 - x) div 2, y);
          LineTo(x1, y1);
          FloodFill(x + (x1 - x) div 2, y + (y1 - y) div 2, clNone, fsSurface);
        end;
      skDiagonal1:
        begin
          MoveTo(x, y1);
          LineTo(x1, y);
        end;
      skDiagonal2:
        begin
          MoveTo(x, y);
          LineTo(x1, y1);
        end;
			skSquare:
      	begin
	        Rectangle(x, y, x + min, y + min);
        end;
		  skRoundSquare:
      	begin
        RoundRect(x, y, x + min, y + min, min div 4, min div 4);
        end;
		  skCircle:
	      begin
	        Ellipse(X, Y, X + min, Y + min);
  	    end;
    end;
  end;
end;

procedure TRMShapeView.Draw(Canvas: TCanvas);
var
  FillC: Integer;
begin
	LeftFrame.Visible := False;
  RightFrame.Visible := False;
  TopFrame.Visible := False;
  BottomFrame.Visible := False;
  BeginDraw(Canvas);
  Memo1.Assign(Memo);
  CalcGaps;
  FillC := FillColor;
  FillColor := clNone;
  ShowBackground;
  FillColor := FillC;
  DrawShape;
  RestoreCoord;
end;

procedure TRMShapeView.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  Stream.Read(ShapeType, 1);
  Stream.Read(PenMode, 1);
end;

procedure TRMShapeView.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
  Stream.Write(ShapeType, 1);
  Stream.Write(PenMode, 1);
end;

procedure TRMShapeView.DefinePopupMenu(Popup: TPopupMenu);
begin
  // no specific items in popup menu
end;

function TRMShapeView.GetViewCommon: string;
begin
	Result := '[Shape]';
end;

initialization
  RMRegisterObjectByRes(TRMShapeView, 'RM_ShapeObject', RMLoadStr(SInsShape), nil);

finalization

end.