← Back to branch summary

~ccrdude/heathcliff/trunk

« back to all changes in this revision

Viewing changes to source/FormUnitPick.pas

  • Committer: CCRDude
  • Date: 2009-06-24 07:29:26 UTC
  • Revision ID: codemonkey@ccrdu.de-20090624072926-dn889udbv95tlw8b
Initial import

Show diffs side-by-side

added added

removed removed

Lines of Context:
source/FormUnitPick.pas
 
1
unit FormUnitPick;
 
2
 
 
3
interface
 
4
 
 
5
uses
 
6
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 
7
  ExtCtrls, ComCtrls;
 
8
 
 
9
type
 
10
  TFormPickImage = class(TForm)
 
11
    sbar: TStatusBar;
 
12
    img: TImage;
 
13
    procedure FormCreate(Sender: TObject);
 
14
    procedure imgMouseDown(Sender: TObject; Button: TMouseButton;
 
15
      Shift: TShiftState; X, Y: Integer);
 
16
    procedure FormActivate(Sender: TObject);
 
17
  private
 
18
    { Private-Deklarationen }
 
19
  public
 
20
    { Public-Deklarationen }
 
21
    myrect: TRect;
 
22
    myimg: TBitmap;
 
23
    procedure Redraw;
 
24
  end;
 
25
 
 
26
var
 
27
  FormPickImage: TFormPickImage;
 
28
 
 
29
implementation
 
30
 
 
31
{$R *.DFM}
 
32
 
 
33
procedure TFormPickImage.Redraw;
 
34
var mycopyrect: TRect;
 
35
begin
 
36
   if (myrect.Left>-1) and (myrect.Right>-1) then begin
 
37
      with img.canvas do begin
 
38
         Brush.Color := clRed;
 
39
         mycopyrect := Rect(0,0,myimg.Width,myimg.Height);
 
40
         CopyRect(mycopyrect,myimg.Canvas,mycopyrect);
 
41
         //FrameRect(myrect);
 
42
         DrawFocusRect(myrect);
 
43
      end;
 
44
   end;
 
45
end;
 
46
 
 
47
procedure TFormPickImage.FormCreate(Sender: TObject);
 
48
begin
 
49
   myrect.left := -1; myrect.right := -1;
 
50
end;
 
51
 
 
52
procedure TFormPickImage.imgMouseDown(Sender: TObject; Button: TMouseButton;
 
53
  Shift: TShiftState; X, Y: Integer);
 
54
begin
 
55
   if Button = mbLeft then begin
 
56
      myrect.left := x;
 
57
      myrect.top := y;
 
58
   end else if mbRight = Button then begin
 
59
      myrect.right := x;
 
60
      myrect.bottom := y;
 
61
   end;
 
62
   ReDraw;
 
63
end;
 
64
 
 
65
procedure TFormPickImage.FormActivate(Sender: TObject);
 
66
begin
 
67
   Redraw;
 
68
end;
 
69
 
 
70
end.