Cursor einfangen

[wendelin]

Hallo Kodezwerg,

ich habe es gelöst. Ohne TTimer.
Allerdings anders als zunächst gedacht, aber genauso wie ich es wollte.
Stichwort: Trennung des vert. und horiz. Cursors.
Hier der vollständige Code.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Math;


type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Panel1: TPanel;
    SpeedButton2: TSpeedButton;
    CheckBox1: TCheckBox;           
    Label1: TLabel;
    Label2: TLabel;
    procedure SpeedButton2Click(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure MouseStart(x : Integer);
    procedure vertLinieZeichnen(X_Neu : integer);
    procedure vertLinieLoeschen(X_Alt : Integer);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Var
    xa,ya :integer; 
    multi :integer;
    X_Koordinaten : Array of integer;
    diff          : Array of Integer;
    X_Neu : Integer;
    X_ALT : Integer;
    aMin  : integer;
    aMax  : Integer;
    zz    : Word = 0;

       (* EINE vert. Linie zeichnen *)

procedure TForm1.vertLinieZeichnen(X_Neu : integer);
begin
   with Form1.PaintBox1.Canvas do
   begin
     pen.Color := clblack;
     pen.Mode := pmnotxor;
     moveto(X_Neu,0);
     LineTo(X_NEU,Form1.PaintBox1.ClientHeight);           //  vertical
   end;
   Form1.Label2.Caption := 'X_NEU : ' + intToStr(X_Neu);   // ausgabe X-Koord. Lineal
   X_Alt := X_Neu;
end;



procedure TForm1.vertLinieLoeschen(X_Alt : Integer);
begin
  If ZZ > 1 then                       // nur das 1. Mal wird NICHT gelöscht
  begin                                // es gibt nichts zu löschen !!
    with Form1.PaintBox1.Canvas do
    begin
      pen.Color := clblack;
      pen.Mode := pmnotxor;
      moveto(X_Alt,0);
      LineTo(X_Alt,Form1.PaintBox1.ClientHeight);          //  vertical
    end;
  end;
end;

procedure TForm1.MouseStart(x : Integer);
var ii , M_1: Integer;
begin
  For ii := 0 To 12 do  diff[ii] := ABS(x - X_Koordinaten[ii]);
  M_1   := MinIntValue(Diff);            // geringste Entfernung bestimmen
  For ii := 0 to 12 do  if diff[ii] = M_1 then X_NEU := X_Koordinaten[ii];
                                         // gibt es bei D7 wirklich KEINE Funktion dafür ??
  aMin := X_NEU - (multi DIV 2);
  aMax := X_NEU + (multi DIV 2);
  form1.vertLinieLoeschen(X_Alt);
  form1.vertLinieZeichnen(X_Neu);
end;

    (* mehrere vert. Linien zeichnen (12) *)

procedure TForm1.SpeedButton2Click(Sender: TObject);
var i: Integer;
begin
  with form1.PaintBox1 do
  begin
    For i := 0 to 12 do
    begin
      canvas.Pen.Style := psSolid;
      canvas.Pen.Color := clRed;
      canvas.MoveTo(i*multi,10);
      canvas.LineTo(i*multi,450);
      X_Koordinaten[i] := (i*multi);   //x-Koordinaten in dyn.Array ==> Lineal
    end;
  end;
end;
           (* horizont. Linie zeichnen und koordinaten ausgeben *)

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
 
begin
  if Form1.CheckBox1.Checked then
  begin
    form1.Label1.Caption := 'Koordinaten :' + IntToStr(X) + ' ***** ' + IntToStr(Y);
    with PaintBox1.Canvas do
    begin
      pen.Color := clblack;
      pen.Mode := pmnotxor;
      MoveTo(0,ya);                            // horizont.
      LineTo(ClientWidth,ya);                  // horizont.
      MoveTo(0,y);                             // horizont.
      LineTo(ClientWidth,y);                   // horizont.
      xa := x;
      ya := y;
      pen.Mode := pmcopy;
    end;
  end;
  if InRange(X,aMin,aMax) = False then
  begin
    inc(zz);                                   // oder boolean
    Form1.MouseStart(x);
  end;  
end;

 (* Dyn. Array's und Var's initialisieren *)

procedure TForm1.FormCreate(Sender: TObject);
begin
  aMin := 1; aMax := 2;
  multi := 50;
  SetLength(X_Koordinaten,13);                  // Array beginnt bei '0' !!
  SetLength(Diff,13);
end;

end.

Falls Du es nachprogrammieren willst:
eine Form.
ein Label(Top)
Auf dem Label ein Panel. Darauf Speedbutton(Linienzeichnen), zwei Labels(für Koordinatenausgabe) und eine Checkbox.
Ferner noch eine Paintbox.
Ich habe noch ein Schönheitproblem.Vielleicht kennst Du ja ein Lösung.
Beim Zeichnen des vert. Cursors gibt es eine unschöne Farbveränderung,
welche nach dem Löschen der ALTEN Cursorpos. wieder verschwindet.
Noch eine Frage: Siehe TForm1.MouseStart !!

Wendelin (Wolfgang)