MathgeomGLS

1
unit OverlayImage;
2
(*      Base Component for Graphing
3
  TOverlayImage based on Renate Schaaf's code
4
  Specialty: Has methods for temporary flickerless speedy overlayed drawings
5
  like zoom rectangles or even sprites.
6
  Use the usual canvas routines with the prefix Overlay, like OverlayEllipse,
7
   OverlayRectangle, etc.
8
  Exceptions:
9
  The analog of Moveto/Lineto is as a command OverlayLine.
10
  The analog of Canvas.Draw(x,y,MyGraphic) is OvelayDraw(DestRect,MyGraphic).
11
  After finished with the overlayed (possibly compound) drawing,
12
  call ShowOverlay. The next overlayed drawing
13
  will start from scratch *)
14

15
interface
16

17
uses
18
  Winapi.Windows,
19
  Winapi.Messages,
20
  System.Types,
21
  System.UITypes,
22
  System.SysUtils,
23
  System.Classes,
24
  Vcl.Graphics,
25
  Vcl.Controls,
26
  Vcl.Forms,
27
  Vcl.Dialogs,
28
  Vcl.Clipbrd;
29

30
type
31
  TOverlayImage = class(TGraphicControl)
32
  private
33
    fBitmap: TBitmap;      //Bitmap for the persistant Drawing
34
    fDrawWidth, fDrawHeight: Integer;
35
    fScreenBitmap: TBitmap;  //Bitmap that gets blasted to screen
36
    fLockCount: Integer;
37
    fDrawing: Boolean;
38
    fTempDrawing: Boolean;
39
    fOverlayed: Boolean;
40
    fClipRect: TRect;      //ClipRect for fBitmap
41
    fTempRect: TRect;      //fTempRect is fClipRect translated to screen
42
    //coordinates
43
    fClipRgn: HRgn;           //corresponding region
44
    fOldRgn, fNewRgn: HRgn;   //regions to optimize overlaid drawing
45
    fxoff, fyoff: Integer;
46
    (* scaling data, bmp to screen, rsp. device
47
     regions have to be given in device coordinates.
48
     if the control is not located at top=left=0 in
49
     the parent, those will be offset from the control  coordinates *)
50
    fOrgFontChanged,
51
      fOrgPenChanged,
52
      fOrgBrushChanged,
53
      fOrgPaint,
54
      fOnMouseLeave,
55
      fOnMouseEnter: TNotifyEvent;
56
    fOnTempPaint: TNotifyEvent;  //Something that should always be added
57
    procedure fBitmapChanged(Sender: TObject);
58
    procedure fFontChanged(Sender: TObject);
59
    procedure fPenChanged(Sender: TObject);
60
    procedure fBrushChanged(Sender: TObject);
61
    function GetCanvas: TCanvas;
62
    function GetTempCanvas: TCanvas;
63
    function GetMetafileCanvas: TCanvas;
64
    function GetFont: TFont;
65
    function GetPen: TPen;
66
    function GetBrush: TBrush;
67
    function GetTempFont: TFont;
68
    function GetTempBrush: TBrush;
69
    function GetTempPen: TPen;
70
    procedure SetFont(Value: TFont);
71
    procedure SetPen(Value: TPen);
72
    procedure SetBrush(Value: TBrush);
73
    procedure SetTempFont(Value: TFont);
74
    procedure SetTempBrush(Value: TBrush);
75
    procedure SetTempPen(Value: TPen);
76
    procedure GetOffSet;
77
    procedure fTempCanvasChanging;
78
  protected
79
    fMetaFileCanvas: TMetaFileCanvas;
80
    fMetaFile: TMetaFile;
81
    procedure Paint; override;
82
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
83
    procedure CMMouseLeave(var msg: TMessage); message CM_MouseLeave;
84
    procedure CMMouseEnter(var msg: TMessage); message CM_MouseEnter;
85
    procedure WMWindowPosChanged(var msg: TMessage); message WM_WINDOWPOSCHANGED;
86
    procedure SizeChanged; virtual;
87
    procedure Loaded; override;
88
    (* Canvas for overlaid drawings like
89
    zoom rectangles, or helper shapes which aren't part of
90
    the actual drawings. Now protected, because it can't be
91
    used properly without some specific precautions *)
92
    property OverlayCanvas: TCanvas read GetTempCanvas;
93
  public
94
    constructor Create(AOwner: TComponent); override;
95
    destructor Destroy; override;
96
    { Define a new rectangular clip region. The previous region
97
     is discarded.}
98
    procedure NewClipRegion(Value: TRect);
99
    { Add a rectangle to the current clip region }
100
    procedure AddClipRegion(Value: TRect);
101
    { Subtract a rectangular region from the current clip region }
102
    procedure SubtractClipRegion(Value: TRect);
103
    {Intersect the current clip region with the region given by Value}
104
    procedure IntersectClipRegion(Value: TRect);
105
    { Call when the component is inside a scrollbox to adjust to scroll. Since
106
    the usual scrollbox has no OnScroll event, there is a derived one
107
    (<See class=TScrollEventBox>) in this same unit }
108
    procedure AdjustToScroll;
109
    { Drawing surrounded by LockUpdate and UnlockUpdate is not
110
     updated to the screen immediately. Nested calls are OK,
111
     Screen will be updated on the last UnlockUpdate. This speeds up
112
     compound drawing}
113
    procedure LockUpdate;
114
    { Drawing surrounded by LockUpdate and UnlockUpdate is not
115
     updated to the screen immediately. Nested calls are OK,
116
     Screen will be updated on the last UnlockUpdate. This speeds up
117
     compound drawing}
118
    procedure UnlockUpdate;
119
    { A call to ShowOverlay puts the current drawing on the
120
    Overlaycanvas to screen. The next Overlaycanvas call, or a call of
121
    <See method=HideOverlay> clears the canvas }
122
    procedure ShowOverlay;
123
    { Clears the overlayed canvas. Call, if no overlayed drawing is needed anymore,
124
    as this speeds up normal drawing }
125
    procedure HideOverlay;
126
    { Clears the Canvas, sets background to AColor }
127
    procedure Clear(Acanvas: TCanvas; AColor: TColor); // overload; virtual;
128
    { Saves any drawing on the <See property=MetafileCanvas> to file }
129
    procedure SaveMetafile(const filename: string);
130
    { Releases memory for metafile support }
131
    procedure EraseMetafile;
132
    { For speed optimized drawings on the overlayed canvas use this
133
    analogon of the TCanvas method }
134
    procedure OverlayCopyRect(dest: TRect; Canvas: TCanvas; Source: TRect);
135
    { For speed optimized drawings on the overlayed canvas use this
136
    analogon of the TCanvas method }
137
    procedure OverlayDraw(dest: TRect; Graphic: TGraphic);
138
    { For speed optimized drawings on the overlayed canvas use this
139
    analogon of the TCanvas method }
140
    procedure OverlayFillRect(const Rect: TRect);
141
    { For speed optimized drawings on the overlayed canvas use this
142
    analogon of the TCanvas method }
143
    procedure OverlayFrameRect(const Rect: TRect);
144
    { For speed optimized drawings on the overlayed canvas use this
145
    analogon of the TCanvas method }
146
    procedure OverlayLine(x1, y1, x2, y2: Integer);
147
    { For speed optimized drawings on the overlayed canvas use this
148
    analogon of the TCanvas method }
149
    procedure OverlayPolygon(Points: array of TPoint);
150
    { For speed optimized drawings on the overlayed canvas use this
151
    analogon of the TCanvas method }
152
    procedure OverlayPolyline(Points: array of TPoint);
153
    { For speed optimized drawings on the overlayed canvas use this
154
    analogon of the TCanvas method }
155
    procedure OverlayEllipse(x1, y1, x2, y2: Integer);
156
    { For speed optimized drawings on the overlayed canvas use this
157
    analogon of the TCanvas method }
158
    procedure OverlayRectangle(x1, y1, x2, y2: Integer);
159
    { For speed optimized drawings on the overlayed canvas use this
160
    analogon of the TCanvas method }
161
    procedure OverlayRoundRect(x1, y1, x2, y2, X3, Y3: Integer);
162
    { For speed optimized drawings on the overlayed canvas use this
163
    analogon of the TCanvas method }
164
    procedure OverlayTextOut(x, y: Integer; const s: string);
165
    { Actually the canvas of the offscreen fbitmap }
166
    property Canvas: TCanvas read GetCanvas;
167
    { In case you'd like to draw a metafile, just use this property.
168
    It will be created, if needed }
169
    property MetafileCanvas: TCanvas read GetMetafileCanvas;
170
    { The metafile generated by drawing on <See property=MetafileCanvas> }
171
    property Metafile: TMetaFile read fMetaFile;
172
    { This Bitmap which holds the current main (not overlayed) drawing }
173
    property Bitmap: TBitmap read fBitmap;
174
    property OverlayBrush: TBrush read GetTempBrush write SetTempBrush;
175
    property OverlayPen: TPen read GetTempPen write SetTempPen;
176
    property OverlayFont: TFont read GetTempFont write SetTempFont;
177
  published
178
    property Align;
179
    { Pen, brush and font properties for the main drawing. To set the corresponding
180
    for the overlayed canvas use OverlayPen. For the Metafile canvas use MetafileCanvas.Pen,
181
    as usual }
182
    property Pen: TPen read GetPen write SetPen;
183
    { Pen, brush and font properties for the main drawing. To set the corresponding
184
    for the overlayed canvas use OverlayBrush. For the Metafile canvas use MetafileCanvas.Brush,
185
    as usual }
186
    property Brush: TBrush read GetBrush write SetBrush;
187
    { Pen, brush and font properties for the main drawing. To set the corresponding
188
    for the overlayed canvas use OverlayFont. For the Metafile canvas use MetafileCanvas.Font,
189
    as usual }
190
    property Font: TFont read GetFont write SetFont;
191
    { Events}
192
    property OnMouseDown;
193
    property OnMouseUp;
194
    property OnMouseMove;
195
    property OnResize;
196
    { If you want to see a persistent drawing on the overlayed canvas, use this
197
    event for the drawing commands }
198
    property OnOverlayPaint: TNotifyEvent read fOnTempPaint write fOnTempPaint;
199
    { Event which fires if the mouse leaves the control. Note: There must be space
200
    between the control and the boundary of the parent for this to work }
201
    property OnMouseLeave: TNotifyEvent read fOnMouseLeave write fOnMouseLeave;
202
    { Event which fires if the mouse enters the control }
203
    property OnMouseEnter: TNotifyEvent read fOnMouseEnter write fOnMouseEnter;
204
  end;
205

206
  (* Had to create an extra scrollbox, which fires scrollevents, because
207
  when the TOverlayImage is scrolled, the offsets for the device regions
208
  have to be recomputed. See procedure TOverlayImage.AdjustToScroll *)
209
  TScrollEventBox = class(TScrollbox)
210
  private
211
    fOnScroll: TNotifyEvent;
212
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
213
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
214
  published
215
    { Event fires on vertical or horizontal scroll }
216
    property OnScroll: TNotifyEvent read fOnScroll write fOnScroll;
217
  end;
218

219
procedure Register;
220

221
//==============================================================
222
implementation
223
//==============================================================
224

225
constructor TOverlayImage.Create;
226
begin
227
  inherited;
228
  if not (csDesigning in ComponentState) then
229
    ControlStyle := ControlStyle + [csOpaque];
230
  {avoids flicker}
231
  fDrawWidth := 0;
232
  fDrawHeight := 0;
233
  fScreenBitmap := TBitmap.Create;
234
  fBitmap := TBitmap.Create;
235
  fOrgPenChanged := fBitmap.Canvas.Pen.OnChange;
236
  fOrgFontChanged := fBitmap.Canvas.Font.OnChange;
237
  fOrgBrushChanged := fBitmap.Canvas.Brush.OnChange;
238
  fBitmap.OnChange := fBitmapChanged;
239
  fLockCount := 0;
240
  fOrgPaint := nil;
241
  fMetaFileCanvas := nil;
242
  fMetaFile := nil;
243
  fClipRgn := 0;
244
  fOldRgn := 0;
245
  fNewRgn := 0;
246
  if csDesigning in ComponentState then
247
  begin
248
    Width := 50;
249
    Height := 50;
250
  end;
251
  fClipRect := Rect(0, 0, Width, Height);
252
  fTempRect := Rect(0, 0, Width, Height);
253
  fTempDrawing := False;
254
end;
255

256
destructor TOverlayImage.Destroy;
257
begin
258
  if fBitmap <> nil then fBitmap.Free;
259
  if fBitmap <> nil then fScreenBitmap.Free;
260
  if fMetaFileCanvas <> nil then fMetaFileCanvas.Free;
261
  if fMetaFile <> nil then fMetaFile.Free;
262
  if fClipRgn <> 0 then DeleteObject(fClipRgn);
263
  if fOldRgn <> 0 then DeleteObject(fOldRgn);
264
  if fNewRgn <> 0 then DeleteObject(fNewRgn);
265
  inherited;
266
end;
267

268
procedure TOverlayImage.Paint;
269
begin
270
 // inherited;
271
  if (csDesigning in ComponentState) then
272
    inherited Canvas.FrameRect(Rect(0, 0, Width, Height))
273
  else
274
  begin
275
    if not fDrawing then
276
    begin
277
      fDrawing := True;
278
      try
279
        if assigned(fOnTempPaint) then
280
        begin
281
          BitBlt(fScreenBitmap.Canvas.Handle, 0, 0, fDrawWidth, fDrawHeight,
282
            fBitmap.Canvas.Handle, 0, 0, SRCCopy);
283
          fTempDrawing := True;
284
          fOnTempPaint(self);
285
          fTempDrawing := False;
286
          BitBlt(inherited Canvas.Handle, 0, 0, fDrawWidth, fDrawHeight,
287
            fScreenBitmap.Canvas.Handle,
288
            0, 0, SRCCopy);
289
        end
290
        else
291
          if fOverlayed then
292
            BitBlt(inherited Canvas.Handle, 0, 0, fDrawWidth, fDrawHeight,
293
              fScreenBitmap.Canvas.Handle,
294
              0, 0, SRCCopy)
295
          else
296
            BitBlt(inherited Canvas.Handle, 0, 0, fDrawWidth, fDrawHeight,
297
              fBitmap.Canvas.Handle, 0, 0, SRCCopy);
298
      finally
299
        fDrawing := False;
300
      end;
301
    end;
302
  end;
303
end;
304

305
function TOverlayImage.GetCanvas;
306
begin
307
  SelectClipRgn(fBitmap.Canvas.Handle, fClipRgn);
308
  Result := fBitmap.Canvas;
309
end;
310

311

312
function TOverlayImage.GetTempCanvas;
313
begin
314
  SelectClipRgn(fScreenBitmap.Canvas.Handle, fNewRgn);
315
  Result := fScreenBitmap.Canvas;
316
end;
317

318
procedure TOverlayImage.fTempCanvasChanging;
319
begin
320
  if not fTempDrawing then
321
  begin
322
    fTempDrawing := True;
323
    SelectClipRgn(fScreenBitmap.Canvas.Handle, fOldRgn);
324
    BitBlt(fScreenBitmap.Canvas.Handle, 0, 0, fDrawWidth, fDrawHeight,
325
      fBitmap.Canvas.Handle,
326
      0, 0, SRCCopy);
327
    fOverlayed := False;
328
  end;
329
end;
330

331
procedure TOverlayImage.fBitmapChanged;
332
begin
333
  if not fDrawing then
334
  begin
335
    if fOldRgn <> 0 then
336
    begin
337
      DeleteObject(fOldRgn);
338
      fOldRgn := 0;
339
    end;
340
    fOverlayed := False;
341
    invalidate;
342
  end
343
  else update;
344
  {On each bitmap change the picture is invalidated, unless it's
345
   just being painted already and unless LockUpdate has been called}
346
end;
347

348
procedure TOverlayImage.fFontChanged(Sender: TObject);
349
begin
350
  fOrgFontChanged(Sender);
351
  if fMetaFileCanvas <> nil then
352
    fMetaFileCanvas.Font.assign(fBitmap.Canvas.Font);
353
end;
354

355
procedure TOverlayImage.fPenChanged(Sender: TObject);
356
begin
357
  fOrgPenChanged(Sender);
358
  if fMetaFileCanvas <> nil then
359
    fMetaFileCanvas.Pen.assign(fBitmap.Canvas.Pen);
360
end;
361

362
procedure TOverlayImage.fBrushChanged(Sender: TObject);
363
begin
364
  fOrgBrushChanged(Sender);
365
  if fMetaFileCanvas <> nil then
366
    fMetaFileCanvas.Brush.assign(fBitmap.Canvas.Brush);
367
end;
368

369

370
function TOverlayImage.GetMetafileCanvas: TCanvas;
371
begin
372
  if fMetaFileCanvas = nil then
373
  begin
374
    fMetaFile := TMetaFile.Create;
375
    fMetaFile.enhanced := True;
376
    fMetaFile.Height := fBitmap.Height;
377
    fMetaFile.Width := fBitmap.Width;
378
    fMetaFileCanvas := TMetaFileCanvas.Create(fMetaFile, 0);
379
    with fBitmap.Canvas do
380
    begin
381
      Font.OnChange := fFontChanged;
382
      Brush.OnChange := fBrushChanged;
383
      Pen.OnChange := fPenChanged;
384
    end;
385
    fFontChanged(nil); fPenChanged(nil); fBrushChanged(nil);
386
  end;
387
  SelectClipRgn(fMetaFileCanvas.Handle, fClipRgn);
388
  Result := fMetaFileCanvas;
389
end;
390

391
procedure TOverlayImage.SaveMetafile(const filename: string);
392
begin
393
  if fMetaFileCanvas <> nil then
394
  begin
395
    fMetaFileCanvas.Free;
396
    fMetaFile.SaveToFile(filename);
397
    fMetaFileCanvas := TMetaFileCanvas.Create(fMetaFile, 0);
398
    fMetaFileCanvas.draw(0, 0, Metafile);
399
  end;
400
end;
401

402
function TOverlayImage.GetFont: TFont;
403
begin
404
  Result := fBitmap.Canvas.Font;
405
end;
406

407
function TOverlayImage.GetPen: TPen;
408
begin
409
  Result := fBitmap.Canvas.Pen;
410
end;
411

412
function TOverlayImage.GetBrush: TBrush;
413
begin
414
  Result := fBitmap.Canvas.Brush;
415
end;
416

417
procedure TOverlayImage.SetFont(Value: TFont);
418
begin
419
  fBitmap.Canvas.Font.assign(Value);
420
end;
421

422
procedure TOverlayImage.SetPen(Value: TPen);
423
begin
424
  fBitmap.Canvas.Pen.assign(Value);
425
end;
426

427
procedure TOverlayImage.SetBrush(Value: TBrush);
428
begin
429
  fBitmap.Canvas.Brush.assign(Value);
430
end;
431

432
procedure TOverlayImage.NewClipRegion(Value: TRect);
433
begin
434
  if fClipRgn <> 0 then DeleteObject(fClipRgn);
435
  fClipRgn := 0;
436
  fClipRgn := CreateRectRgnIndirect(Value);
437
end;
438

439
procedure TOverlayImage.AddClipRegion(Value: TRect);
440
var
441
  rgn: HRgn;
442
begin
443
  rgn := CreateRectRgnIndirect(Value);
444
  CombineRgn(fClipRgn, fClipRgn, rgn, RGN_OR);
445
  DeleteObject(rgn);
446
end;
447

448
procedure TOverlayImage.SubtractClipRegion(Value: TRect);
449
var
450
  rgn: HRgn;
451
begin
452
  rgn := CreateRectRgnIndirect(Value);
453
  CombineRgn(fClipRgn, fClipRgn, rgn, RGN_DIFF);
454
  DeleteObject(rgn);
455
end;
456

457
procedure TOverlayImage.IntersectClipRegion(Value: TRect);
458
var
459
  rgn: HRgn;
460
begin
461
  rgn := CreateRectRgnIndirect(Value);
462
  CombineRgn(fClipRgn, fClipRgn, rgn, RGN_And);
463
  DeleteObject(rgn);
464
end;
465

466
//------------------------------------------------------------------------
467

468
procedure TOverlayImage.WMWindowPosChanged;
469
begin
470
  inherited;
471
  if not (csDesigning in ComponentState) then  if assigned(Parent) then
472
    begin
473
      if (Width <> fDrawWidth) or (Height <> fDrawHeight) then
474
      begin
475
        fDrawWidth := Width;
476
        fDrawHeight := Height;
477
        SizeChanged;
478
        if fOldRgn <> 0 then
479
          DeleteObject(fOldRgn);
480
        fOldRgn := 0;
481
        fTempDrawing := False;
482
        fOverlayed := False;
483
      end;
484
     GetOffSet;                   //// ????
485
    end;
486
end;
487

488
procedure TOverlayImage.SizeChanged;
489
begin
490
  fScreenBitmap.Width := 0;
491
  fScreenBitmap.Width := fDrawWidth;
492
  fScreenBitmap.Height := fDrawHeight;
493
 // fBitmap.Width:=0;
494
  fBitmap.Width := fDrawWidth;
495
  fBitmap.Height := fDrawHeight;
496
  if fMetaFile <> nil then
497
  begin
498
    fMetaFileCanvas.Free;
499
    fMetaFile.Width := Width;
500
    fMetaFile.Height := Height;
501
    fMetaFileCanvas := TMetaFileCanvas.Create(fMetaFile, 0);
502
    fMetaFileCanvas.draw(0, 0, fMetaFile);
503
  end;
504
end;
505

506
procedure TOverlayImage.Loaded;
507
begin
508
  inherited;
509
  fDrawWidth := Width;
510
  fDrawHeight := Height;
511
  Clear(Canvas, Brush.Color);
512
end;
513

514
procedure TOverlayImage.GetOffSet;
515
var
516
  p, q: TPoint;
517
begin
518
  if assigned(Parent) then
519
  begin
520
    with Parent do
521
      p := ClienttoScreen(Point(0, 0));
522
    q := ClienttoScreen(Point(0, 0));
523
    fxoff := q.x - p.x;
524
    fyoff := q.y - p.y;
525
  end;
526
end;
527

528

529

530
procedure TOverlayImage.CMMouseLeave;
531
begin
532
  inherited;
533
  if assigned(fOnMouseLeave) then
534
    fOnMouseLeave(self);
535
  {use to get rid of stray drawing on the TempCanvas}
536
end;
537

538
procedure TOverlayImage.CMMouseEnter;
539
begin
540
  inherited;
541
  if assigned(fOnMouseEnter) then
542
    fOnMouseEnter(self);
543
end;
544

545

546
procedure TOverlayImage.ShowOverlay;
547
var
548
  DC: HDC;
549
begin
550
  fTempDrawing := True;
551
  DC := inherited Canvas.Handle;
552
  if assigned(fOnTempPaint) then fOnTempPaint(self);
553
  if fOldRgn <> 0 then
554
  begin
555
    if fNewRgn <> 0 then
556
    begin
557
      CombineRgn(fOldRgn, fOldRgn, fNewRgn, RGN_OR);
558
      OffsetRgn(fOldRgn, fxoff, fyoff);
559
      SelectClipRgn(DC, fOldRgn);
560
    end
561
    else
562
      SelectClipRgn(DC, 0);
563
    DeleteObject(fOldRgn);
564
  end
565
  else
566
    SelectClipRgn(DC, 0);
567
  BitBlt(DC, 0, 0, fDrawWidth, fDrawHeight,
568
    fScreenBitmap.Canvas.Handle,
569
    0, 0, SRCCopy);
570
  fOldRgn := fNewRgn;
571
  fNewRgn := 0;
572
  fTempDrawing := False;
573
  fOverlayed := True;
574
end;
575

576
procedure TOverlayImage.LockUpdate;
577
begin
578
  fBitmap.OnChange := nil;
579
  {Don't update bitmap to screen}
580
  inc(fLockCount);
581
end;
582

583
procedure TOverlayImage.UnlockUpdate;
584
begin
585
  dec(fLockCount);
586
  if fLockCount <= 0 then
587
  begin
588
    fLockCount := 0;
589
    {safety}
590
    fBitmap.OnChange := fBitmapChanged;
591
    fBitmapChanged(nil);
592
  end;
593
end;
594

595

596

597
procedure TOverlayImage.Clear(Acanvas: TCanvas; AColor: TColor);
598
begin
599
  Acanvas.Brush.Color := AColor;
600
  Acanvas.FillRect(Rect(0, 0, Width, Height));
601
end;
602

603
procedure TOverlayImage.EraseMetafile;
604
begin
605
  if fMetaFileCanvas <> nil then
606
    fMetaFileCanvas.Free;
607
  if fMetaFile <> nil then
608
    fMetaFile.Free;
609
  fMetaFileCanvas := nil;
610
  fMetaFile := nil;
611
  with fBitmap.Canvas do
612
  begin
613
    Font.OnChange := fOrgFontChanged;
614
    Brush.OnChange := fOrgBrushChanged;
615
    Pen.OnChange := fOrgPenChanged;
616
  end;
617
end;
618

619
procedure TScrollEventBox.WMHScroll(var Message: TWMHScroll);
620
begin
621
  inherited;
622
  if assigned(fOnScroll) then fOnScroll(self);
623
end;
624

625
procedure TScrollEventBox.WMVScroll(var Message: TWMVScroll);
626
begin
627
  inherited;
628
  if assigned(fOnScroll) then fOnScroll(self);
629
end;
630

631

632

633

634
procedure TOverlayImage.AdjustToScroll;
635
begin
636
  GetOffSet;
637
end;
638

639

640
procedure TOverlayImage.OverlayCopyRect(dest: TRect; Canvas: TCanvas;
641
  Source: TRect);
642
var
643
  rgn: HRgn;
644
begin
645
  rgn := CreateRectRgnIndirect(dest);
646
  if fNewRgn <> 0 then
647
  begin
648
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
649
    DeleteObject(rgn);
650
  end
651
  else
652
    if not fTempDrawing then
653
      fNewRgn := rgn;
654
  fTempCanvasChanging;
655
  OverlayCanvas.CopyRect(dest, Canvas, Source);
656
end;
657

658
procedure TOverlayImage.OverlayDraw(dest: TRect; Graphic: TGraphic);
659
var
660
  rgn: HRgn;
661
begin
662
  rgn := CreateRectRgnIndirect(dest);
663
  if fNewRgn <> 0 then
664
  begin
665
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
666
    DeleteObject(rgn);
667
  end
668
  else
669
    if not fTempDrawing then
670
      fNewRgn := rgn
671
    else
672
      DeleteObject(rgn);
673
  fTempCanvasChanging;
674
  OverlayCanvas.draw(dest.Left, dest.Top, Graphic);
675
end;
676

677
procedure TOverlayImage.OverlayEllipse(x1, y1, x2, y2: Integer);
678
var
679
  rgn: HRgn;
680
begin
681
  rgn := CreateEllipticRgnIndirect(Rect(x1 - 1, y1 - 1, x2 + 2, y2 + 2));
682
  if fNewRgn <> 0 then
683
  begin
684
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
685
    DeleteObject(rgn);
686
  end
687
  else
688
    if not fTempDrawing then
689
      fNewRgn := rgn
690
    else
691
      DeleteObject(rgn);
692
  fTempCanvasChanging;
693
  OverlayCanvas.Ellipse(x1, y1, x2, y2);
694
end;
695

696
procedure TOverlayImage.OverlayFillRect(const Rect: TRect);
697
var
698
  rgn: HRgn;
699
begin
700
  rgn := CreateRectRgnIndirect(Rect);
701
  if fNewRgn <> 0 then
702
  begin
703
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
704
    DeleteObject(rgn);
705
  end
706
  else
707
    if not fTempDrawing then
708
      fNewRgn := rgn
709
    else
710
      DeleteObject(rgn);
711
  fTempCanvasChanging;
712
  OverlayCanvas.FillRect(Rect);
713
end;
714

715
procedure TOverlayImage.OverlayFrameRect(const Rect: TRect);
716
var
717
  rgn: HRgn;
718
begin
719
  rgn := CreateRectRgnIndirect(Rect);
720
  if fNewRgn <> 0 then
721
  begin
722
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
723
    DeleteObject(rgn);
724
  end
725
  else
726
    if not fTempDrawing then
727
      fNewRgn := rgn
728
    else
729
      DeleteObject(rgn);
730
  fTempCanvasChanging;
731
  OverlayCanvas.FrameRect(Rect);
732
end;
733

734
procedure TOverlayImage.OverlayLine(x1, y1, x2, y2: Integer);
735
var
736
  rgn: HRgn;
737
  xmin, ymin, xmax, ymax: Integer;
738
  points: array[0..2] of TPoint;
739
begin
740
  if x1 < x2 then
741
  begin
742
    xmin := x1;
743
    xmax := x2;
744
  end
745
  else
746
  begin
747
    xmin := x2;
748
    xmax := x1;
749
  end;
750
  if y1 < y2 then
751
  begin
752
    ymin := y1;
753
    ymax := y2;
754
  end
755
  else
756
  begin
757
    ymin := y2;
758
    ymax := y1;
759
  end;
760
  rgn := CreateRectRgnIndirect(Rect(xmin - 1, ymin - 1, xmax + 1, ymax + 1));
761
  if fNewRgn <> 0 then
762
  begin
763
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
764
    DeleteObject(rgn);
765
  end
766
  else
767
    if not fTempDrawing then
768
      fNewRgn := rgn
769
    else
770
      DeleteObject(rgn);
771
  fTempCanvasChanging;
772
  Points[0]:=Point(x1,y1);
773
  Points[1]:=Point(x2,y2);
774
  Points[2]:=Points[0];
775
  OverlayCanvas.Polyline(Points);
776
end;
777

778
procedure TOverlayImage.OverlayPolygon(Points: array of TPoint);
779
var
780
  rgn: HRgn;
781
begin
782
  rgn := CreatePolygonRgn(Points, High(Points) + 1, WINDING);
783
  if fNewRgn <> 0 then
784
  begin
785
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
786
    DeleteObject(rgn);
787
  end
788
  else
789
    if not fTempDrawing then
790
      fNewRgn := rgn
791
    else
792
      DeleteObject(rgn);
793
  fTempCanvasChanging;
794
  OverlayCanvas.Polygon(Points);
795
end;
796

797
procedure TOverlayImage.OverlayPolyline(Points: array of TPoint);
798
var
799
  rgn: HRgn;
800
begin
801
  rgn := CreatePolygonRgn(Points, High(Points) + 1, WINDING);
802
  if fNewRgn <> 0 then
803
  begin
804
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
805
    DeleteObject(rgn);
806
  end
807
  else
808
    if not fTempDrawing then
809
      fNewRgn := rgn
810
    else
811
      DeleteObject(rgn);
812
  fTempCanvasChanging;
813
  OverlayCanvas.Polyline(Points);
814
end;
815

816
procedure TOverlayImage.OverlayRectangle(x1, y1, x2, y2: Integer);
817
var
818
  rgn: HRgn;
819
begin
820
  rgn := CreateRectRgn(x1, y1, x2, y2);
821
  if fNewRgn <> 0 then
822
  begin
823
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
824
    DeleteObject(rgn);
825
  end
826
  else
827
    if not fTempDrawing then
828
      fNewRgn := rgn
829
    else
830
      DeleteObject(rgn);
831
  fTempCanvasChanging;
832
  OverlayCanvas.Rectangle(x1, y1, x2, y2);
833
end;
834

835
procedure TOverlayImage.OverlayRoundRect(x1, y1, x2, y2, X3, Y3: Integer);
836
var
837
  rgn: HRgn;
838
begin
839
  rgn := CreateRoundRectRgn(x1, y1, x2 + 3, y2 + 3, X3, Y3);
840
  if fNewRgn <> 0 then
841
  begin
842
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
843
    DeleteObject(rgn);
844
  end
845
  else
846
    if not fTempDrawing then
847
      fNewRgn := rgn
848
    else
849
      DeleteObject(rgn);
850
  fTempCanvasChanging;
851
  OverlayCanvas.RoundRect(x1, y1, x2, y2, X3, Y3);
852
end;
853

854
procedure TOverlayImage.Notification;
855
begin
856
  //doesn't do any good tho
857
  inherited;
858
  if csDesigning in ComponentState then
859
    repaint;
860
end;
861

862
procedure TOverlayImage.HideOverlay;
863
begin
864
  fOverlayed := False;
865
  invalidate;
866
end;
867

868
procedure TOverlayImage.OverlayTextOut(x, y: Integer; const s: string);
869
var
870
  rgn: HRgn;
871
  w, h: Integer;
872
begin
873
  with OverlayCanvas do
874
  begin
875
    w := TextWIdth(s);
876
    h := TextHeight(s);
877
  end;
878
  rgn := CreateRectRgn(x, y, x + w, y + h);
879
  if fNewRgn <> 0 then
880
  begin
881
    CombineRgn(fNewRgn, fNewRgn, rgn, RGN_OR);
882
    DeleteObject(rgn);
883
  end
884
  else
885
    if not fTempDrawing then
886
      fNewRgn := rgn
887
    else
888
      DeleteObject(rgn);
889
  OverlayCanvas.TextOut(x, y, s);
890
end;
891

892
function TOverlayImage.GetTempBrush: TBrush;
893
begin
894
  Result := fScreenBitmap.Canvas.Brush;
895
end;
896

897
function TOverlayImage.GetTempFont: TFont;
898
begin
899
  Result := fScreenBitmap.Canvas.Font;
900
end;
901

902
function TOverlayImage.GetTempPen: TPen;
903
begin
904
  Result := fScreenBitmap.Canvas.Pen;
905
end;
906

907
procedure TOverlayImage.SetTempBrush(Value: TBrush);
908
begin
909
  fScreenBitmap.Canvas.Brush.assign(Value);
910
end;
911

912
procedure TOverlayImage.SetTempFont(Value: TFont);
913
begin
914
  fScreenBitmap.Canvas.Font.assign(Value);
915
end;
916

917
procedure TOverlayImage.SetTempPen(Value: TPen);
918
begin
919
  fScreenBitmap.Canvas.Pen.assign(Value);
920
end;
921

922
procedure Register;
923
begin
924
  RegisterComponents('MathStuff', [TOverlayImage, TScrollEventBox]);
925
end;
926

927

928
end.
929

930