/Source/FR_SHAPE.PAS

  1
  2{*****************************************}
  3{                                         }
  4{             FastReport v2.3             }
  5{         Checkbox Add-In Object          }
  6{                                         }
  7{  Copyright (c) 1998-99 by Tzyganenko A. }
  8{                                         }
  9{*****************************************}
 10
 11unit FR_Shape;
 12
 13interface
 14
 15{$I FR.inc}
 16
 17uses
 18  Windows, Messages, SysUtils, Classes, Graphics, FR_Class, StdCtrls,
 19  Controls, ExtCtrls, Menus;
 20
 21
 22const
 23  skRectangle = 0;
 24  skRoundRectangle = 1;
 25  skEllipse = 2;
 26  skTriangle = 3;
 27
 28type
 29  TfrShapeObject = class(TComponent)  // fake component
 30  end;
 31
 32  TfrShapeView = class(TfrView)
 33  private
 34    procedure DrawShape;
 35  public
 36    ShapeType: Byte;
 37    constructor Create; override;
 38    procedure Assign(From: TfrView); override;
 39    procedure Draw(Canvas: TCanvas); override;
 40    procedure LoadFromStream(Stream: TStream); override;
 41    procedure SaveToStream(Stream: TStream); override;
 42    procedure SaveToFR3Stream(Stream: TStream); override;    
 43    procedure DefinePopupMenu(Popup: TPopupMenu); override;
 44  end;
 45
 46  TfrShapeForm = class(TfrObjEditorForm)
 47    GroupBox1: TGroupBox;
 48    CB1: TComboBox;
 49    Button1: TButton;
 50    Button2: TButton;
 51    Image1: TImage;
 52    procedure FormCreate(Sender: TObject);
 53  private
 54    { Private declarations }
 55  public
 56    { Public declarations }
 57    procedure ShowEditor(t: TfrView); override;
 58  end;
 59
 60
 61implementation
 62
 63uses FR_Utils, FR_Const;
 64
 65{$R *.DFM}
 66
 67var
 68  ShapeForm: TfrShapeForm;
 69
 70constructor TfrShapeView.Create;
 71begin
 72  inherited Create;
 73  Typ := gtAddIn;
 74  ShapeType := skRectangle;
 75  BaseName := 'Shape';
 76end;
 77
 78procedure TfrShapeView.Assign(From: TfrView);
 79begin
 80  inherited Assign(From);
 81  ShapeType := TfrShapeView(From).ShapeType;
 82end;
 83
 84procedure TfrShapeView.DrawShape;
 85var
 86  x1, y1, min: Integer;
 87begin
 88  x1 := Round((SaveX + SaveDX) * ScaleX + OffsX);
 89  y1 := Round((SaveY + SaveDY) * ScaleY + OffsY);
 90  min := dx;
 91  if dy < dx then
 92    min := dy;
 93  with Canvas do
 94  begin
 95    Pen.Width := Round(FrameWidth);
 96    Pen.Color := FrameColor;
 97    Pen.Style := psSolid;
 98    Brush.Style := bsClear;
 99    Brush.Color := FillColor;
100    case ShapeType of
101      skRectangle:
102        Rectangle(x, y, x1 + 1, y1 + 1);
103      skRoundRectangle:
104        RoundRect(x, y, x1 + 1, y1 + 1, min div 4, min div 4);
105      skEllipse:
106        Ellipse(x, y, x1 + 1, y1 + 1);
107      skTriangle:
108        begin
109          MoveTo(x1, y1);
110          LineTo(x, y1);
111          LineTo(x + (x1 - x) div 2, y);
112          LineTo(x1, y1);
113          FloodFill(x + (x1 - x) div 2, y + (y1 - y) div 2, clNone, fsSurface);
114        end;
115    end;
116  end;
117end;
118
119procedure TfrShapeView.Draw(Canvas: TCanvas);
120var
121  FillC: Integer;
122begin
123  BeginDraw(Canvas);
124  Memo1.Assign(Memo);
125  CalcGaps;
126  FillC := FillColor;
127  FillColor := clNone;
128  FrameTyp := 0;
129  ShowBackground;
130  FillColor := FillC;
131  DrawShape;
132  RestoreCoord;
133end;
134
135procedure TfrShapeView.LoadFromStream(Stream: TStream);
136begin
137  inherited LoadFromStream(Stream);
138  Stream.Read(ShapeType, 1);
139end;
140
141procedure TfrShapeView.SaveToStream(Stream: TStream);
142begin
143  inherited SaveToStream(Stream);
144  Stream.Write(ShapeType, 1);
145end;
146
147procedure TfrShapeView.DefinePopupMenu(Popup: TPopupMenu);
148begin
149  // no specific items in popup menu
150end;
151
152
153{------------------------------------------------------------------------}
154procedure TfrShapeForm.ShowEditor(t: TfrView);
155var
156  i: Integer;
157begin
158  CB1.Items.Clear;
159  for i := 0 to 3 do
160    CB1.Items.Add(LoadStr(SShape1 + i));
161  with TfrShapeView(t) do
162  begin
163    CB1.ItemIndex := ShapeType;
164    if ShowModal = mrOk then
165      ShapeType := CB1.ItemIndex;
166  end;
167end;
168
169procedure TfrShapeForm.FormCreate(Sender: TObject);
170begin
171  Caption := LoadStr(frRes + 620);
172  GroupBox1.Caption := LoadStr(frRes + 621);
173  Button1.Caption := LoadStr(SOk);
174  Button2.Caption := LoadStr(SCancel);
175end;
176
177procedure TfrShapeView.SaveToFR3Stream(Stream: TStream);
178
179  procedure WriteStr(const s: String);
180  begin
181    Stream.Write(s[1], Length(s));
182  end;
183
184begin
185  inherited;
186
187  WriteStr(' Shape="' + IntToStr(ShapeType) + '"');
188end;
189
190initialization
191  ShapeForm := TfrShapeForm.Create(nil);
192  frRegisterObject(TfrShapeView, ShapeForm.Image1.Picture.Bitmap,
193    LoadStr(SInsShape), ShapeForm);
194
195finalization
196  ShapeForm.Free;
197  ShapeForm := nil;
198
199end.
200