Steema Central

Steema Software - Customer Support Forums
http://216.92.101.67/support/

Change cursor in MouseDown Event ?

http://216.92.101.67/support/viewtopic.php?f=3&t=7480

Page 1 of 1

Change cursor in MouseDown Event ?

Posted: Tue Mar 11, 2008 7:58 am
by 9349911
Hi !

I try to change the cursor if the user press and hold one mouse button:

Code: Select all

procedure TForm1.MainChartMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var STRG_Pressed, SHIFT_Pressed : Boolean;
begin
  STRG_Pressed  := (ssCtrl  in Shift);
  SHIFT_Pressed := (ssShift in Shift);

  if Button in [mbLeft] then MainChart.OriginalCursor := crUpArrow;
......
But this won´t work. It seems to me that the cursor can´t change if the mousebutton is pressed!?

I want to change the cursor for zooming and panning. Hiw can I do this?

Posted: Wed Mar 12, 2008 10:09 am
by 9349911
No idea? :cry:

Posted: Mon Mar 17, 2008 9:31 am
by 9349911
Hi support,

I think this is a common problem, isn´t it?

There is no solution for this?

Posted: Mon Mar 17, 2008 9:51 am
by 9349911
I found a solution:

Code: Select all

procedure TForm16.chtUMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crCross;
end;

procedure TForm16.chtUMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crDefault;
end;
I know this will set the cursor for the complete application, but that´s ok.

If anyone has a solution with chart.originalcursor ... Please let me know.

Posted: Mon Mar 17, 2008 10:48 am
by yeray
Hi Dominik,

Then you found a good solution for this. I tested it and looks nice!
However, if we find another solution, we'll tell you.

Posted: Sun Mar 23, 2008 5:05 pm
by 9047589
9348257 wrote:if we find another solution
I'd like to present two working examples I derived from a working project of mine. Sorry if I didn't understand requirements of Dominik, but it seems to me they show a way to rather a simple alternative solution.
Note: I had to use Abort procedure because CancelMouse procedure didn't work in that situaition as I expected.
Example 1

Code: Select all

unit frmForm22;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TeEngine, TeeProcs, Chart, ExtCtrls;

type
  TForm22 = class(TForm)
    chtU: TChart;
    procedure chtUAfterDraw(Sender: TObject);
    procedure chtUMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure chtUMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure chtUMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    LeftLeft,RightRight: double;
    OldLeft, OldRight,
    LeftMin,RightMax,
    SavedX : integer;
    DraggingLine, DragRightNotLeft:Boolean;
  public
    { Public declarations }
  end;

var Form22:TForm22;
implementation
{$R *.DFM}
procedure TForm22.chtUAfterDraw(Sender: TObject);
var
  X: integer;
  procedure plotBound(_Color:TColor);
  begin
    With chtU,Canvas do
    begin
      Pen.Color:=_Color;
      Pen.Width:=2;
      Pen.Style:=psSolid;
      MoveTo3D(X,ChartRect.Top,0);
      LineTo3D(X,ChartRect.Bottom,0);
    end;
  end;
begin
  X:=chtU.BottomAxis.CalcXPosValue(LeftLeft);
  with chtU.ChartRect do
  if (X>=Left) and (X<=Right) then begin
    plotBound(clBlue);
    OldLeft:=X;
  end else
    OldLeft:=-1;
  X:=chtU.BottomAxis.CalcXPosValue(RightRight);
  with chtU.ChartRect do
  if (X>=Left) and (X<=Right) then begin
    plotBound(clNavy);
    OldRight:=X;
  end else
    OldRight:=-1;
end;

procedure TForm22.chtUMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //if chtU.Cursor<>crDefault
  if SSShift in Shift
  then begin
    DraggingLine:=True;
    DragRightNotLeft:=Abs(X-OldRight)<=Abs(X-OldLeft);
    RightMax:=chtU.BottomAxis.CalcXPosValue(1000);
    LeftMin:=chtU.BottomAxis.CalcXPosValue(0);
    SavedX:=-1;
  end;
  chtU.CancelMouse:=DraggingLine;
end;

procedure TForm22.chtUMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  procedure Drawhair;
  begin
    With chtU,Canvas do
    begin
      Pen.Color:=clRed;
      Pen.Mode:=pmXor;
      Pen.Width:=1;
      MoveTo3D(SavedX,ChartRect.Top,0);
      LineTo3D(SavedX,ChartRect.Bottom,0);
    end;
  end;
begin
  if DraggingLine then begin
    if PtInRect(chtU.ChartRect, Point(X,Y)) then
    begin
      if (X<LeftMin)or(X>RightMax) then Exit
    end else
      Exit;
    if SavedX<>-1 then
      DrawHair;
    SavedX:=X;
    DrawHair;
    //if DragRightNotLeft then
  end else begin
    Exit;
    if (Abs(X-OldLeft)<4) or (Abs(X-OldRight)<4) then
    if Abs(X-OldRight)<=Abs(X-OldLeft) then
      chtU.Cursor:=crSizeNESW
    else
      chtU.Cursor:=crSizeNWSE
    else
      chtU.Cursor:=crDefault;
    chtU.OriginalCursor:=chtU.Cursor;
  end;

end;

procedure TForm22.chtUMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Xx: double;
begin
  if DraggingLine then begin
    if SavedX<>-1 then begin
      Xx:=chtU.BottomAxis.CalcPosPoint(SavedX);
      if DragRightNotLeft then
        RightRight:=Xx
      else
        LeftLeft:=Xx;
    end;
    DraggingLine:=False;
    chtU.Repaint;
    chtU.CancelMouse:=False;
  end;
end;

procedure TForm22.FormCreate(Sender: TObject);
begin
  LeftLeft:=300;
  RightRight:=800;
  chtU.BottomAxis.SetMinMax(0,1000);
end;

end.

Code: Select all

object Form22: TForm22
  Left = 264
  Top = 106
  Width = 695
  Height = 451
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  ShowHint = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object chtU: TChart
    Left = 0
    Top = 0
    Width = 681
    Height = 417
    BackWall.Brush.Color = clWhite
    BackWall.Color = clWhite
    Legend.Alignment = laTop
    Legend.ColorWidth = 55
    Legend.LegendStyle = lsSeries
    Legend.Symbol.Width = 55
    Legend.Visible = False
    Title.Text.Strings = (
      '')
    Title.Visible = False
    BottomAxis.MinorTicks.Visible = False
    LeftAxis.Automatic = False
    LeftAxis.AutomaticMaximum = False
    LeftAxis.AutomaticMinimum = False
    LeftAxis.LabelsFont.Charset = ANSI_CHARSET
    LeftAxis.LabelsFont.Color = clGreen
    LeftAxis.Maximum = 105
    LeftAxis.Minimum = -5
    LeftAxis.MinorTicks.Visible = False
    LeftAxis.Title.Font.Charset = ANSI_CHARSET
    LeftAxis.Title.Font.Color = clGreen
    LeftAxis.TitleSize = 1
    RightAxis.LabelsFont.Charset = ANSI_CHARSET
    RightAxis.LabelsFont.Color = clRed
    RightAxis.Title.Angle = 90
    RightAxis.Title.Font.Color = clRed
    RightAxis.TitleSize = 1
    View3D = False
    OnAfterDraw = chtUAfterDraw
    BevelOuter = bvNone
    BevelWidth = 0
    Color = clSilver
    TabOrder = 0
    Anchors = [akLeft, akTop, akRight, akBottom]
    OnMouseDown = chtUMouseDown
    OnMouseMove = chtUMouseMove
    OnMouseUp = chtUMouseUp
  end
end
Example 2 (on my opinion, it's better)

Code: Select all

unit frmForm23;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TeEngine, TeeProcs, Chart, ExtCtrls, Series;

type
  TForm22 = class(TForm)
    Chart1: TChart;
    Series1: TFastLineSeries;
    procedure Chart1AfterDraw(Sender: TObject);
    procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Chart1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    LeftLeft,RightRight: double;
    OldLeft, OldRight,
    LeftMin,RightMax,
    SavedX : integer;
    DraggingLine, DragRightNotLeft:Boolean;
  public
    { Public declarations }
  end;

var Form22:TForm22;
implementation
{$R *.DFM}
procedure TForm22.Chart1AfterDraw(Sender: TObject);
var
  X: integer;
  procedure plotBound(_Color:TColor);
  begin
    With Chart1,Canvas do
    begin
      Pen.Color:=_Color;
      Pen.Width:=2;
      Pen.Style:=psSolid;
      MoveTo3D(X,ChartRect.Top,0);
      LineTo3D(X,ChartRect.Bottom,0);
    end;
  end;
begin
  X:=Chart1.BottomAxis.CalcXPosValue(LeftLeft);
  with Chart1.ChartRect do
  if (X>=Left) and (X<=Right) then begin
    plotBound(clBlue);
    OldLeft:=X;
  end else
    OldLeft:=-1;
  X:=Chart1.BottomAxis.CalcXPosValue(RightRight);
  with Chart1.ChartRect do
  if (X>=Left) and (X<=Right) then begin
    plotBound(clNavy);
    OldRight:=X;
  end else
    OldRight:=-1;
end;

procedure TForm22.Chart1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if ssShift in Shift then
  begin
    Chart1.BottomAxis.SetMinMax(0,1000);
    RightMax:=Chart1.BottomAxis.CalcXPosValue(1000);
    LeftMin:=Chart1.BottomAxis.CalcXPosValue(0);
    if Abs(X-OldRight)<=Abs(X-OldLeft) then
      Chart1.Cursor:=crSizeNESW
    else
      Chart1.Cursor:=crSizeNWSE;
    Chart1.OriginalCursor:=Chart1.Cursor;
    DraggingLine:=True;
    DragRightNotLeft:=Abs(X-OldRight)<=Abs(X-OldLeft);
    SavedX:=-1;
    Abort;
  end;
end;

procedure TForm22.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  procedure Drawhair;
  begin
    With Chart1,Canvas do
    begin
      Pen.Color:=clRed;
      Pen.Mode:=pmXor;
      Pen.Width:=1;
      MoveTo3D(SavedX,ChartRect.Top,0);
      LineTo3D(SavedX,ChartRect.Bottom,0);
    end;
  end;
begin
  if DraggingLine then begin
    if PtInRect(Chart1.ChartRect, Point(X,Y)) then
    begin
      if (X<LeftMin)or(X>RightMax) then Exit
    end else
      Exit;
    if SavedX<>-1 then
      DrawHair;
    SavedX:=X;
    DrawHair;
  end;
end;

procedure TForm22.Chart1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Xx: double;
begin
  if DraggingLine then begin
    if SavedX<>-1 then begin
      Xx:=Chart1.BottomAxis.CalcPosPoint(SavedX);
      if DragRightNotLeft then
        RightRight:=Xx
      else
        LeftLeft:=Xx;
    end;
    DraggingLine:=False;
    Chart1.Cursor:=crDefault;
    Chart1.OriginalCursor:=crDefault;
    Chart1.Repaint;
    Chart1.CancelMouse:=False;
  end;
end;

procedure TForm22.FormCreate(Sender: TObject);
begin
  LeftLeft:=300;
  RightRight:=800;
  Chart1.BottomAxis.SetMinMax(0,1000);
end;

end.

Code: Select all

object Form22: TForm22
  Left = 264
  Top = 106
  Width = 695
  Height = 451
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  ShowHint = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Chart1: TChart
    Left = 0
    Top = 0
    Width = 681
    Height = 417
    BackWall.Brush.Color = clWhite
    BackWall.Color = clWhite
    Legend.Alignment = laTop
    Legend.ColorWidth = 55
    Legend.LegendStyle = lsSeries
    Legend.Symbol.Width = 55
    Legend.Visible = False
    Title.Text.Strings = (
      '')
    Title.Visible = False
    BottomAxis.MinorTicks.Visible = False
    LeftAxis.Automatic = False
    LeftAxis.AutomaticMaximum = False
    LeftAxis.AutomaticMinimum = False
    LeftAxis.LabelsFont.Charset = ANSI_CHARSET
    LeftAxis.LabelsFont.Color = clGreen
    LeftAxis.Maximum = 1000
    LeftAxis.MinorTicks.Visible = False
    LeftAxis.Title.Caption = 'X'
    LeftAxis.Title.Font.Charset = ANSI_CHARSET
    LeftAxis.Title.Font.Color = clGreen
    LeftAxis.TitleSize = 1
    RightAxis.LabelsFont.Charset = ANSI_CHARSET
    RightAxis.LabelsFont.Color = clRed
    RightAxis.Title.Angle = 90
    RightAxis.Title.Font.Color = clRed
    RightAxis.TitleSize = 1
    View3D = False
    OnAfterDraw = Chart1AfterDraw
    BevelOuter = bvNone
    BevelWidth = 0
    Color = clSilver
    TabOrder = 0
    Anchors = [akLeft, akTop, akRight, akBottom]
    OnMouseDown = Chart1MouseDown
    OnMouseMove = Chart1MouseMove
    OnMouseUp = Chart1MouseUp
    object Series1: TFastLineSeries
      Marks.Arrow.Visible = True
      Marks.Callout.Brush.Color = clBlack
      Marks.Callout.Arrow.Visible = True
      Marks.Visible = False
      LinePen.Color = clRed
      XValues.Name = 'X'
      XValues.Order = loAscending
      YValues.Name = 'Y'
      YValues.Order = loNone
    end
  end
end
All times are UTC
Page 1 of 1
Powered by phpBB® Forum Software © phpBB Limited
https://www.phpbb.com/