AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Delphi How draw password on remote smartphone with mouse?
Thema durchsuchen
Ansicht
Themen-Optionen

How draw password on remote smartphone with mouse?

Ein Thema von flashcoder · begonnen am 28. Aug 2018 · letzter Beitrag vom 3. Sep 2018
 
Whookie

Registriert seit: 3. Mai 2006
Ort: Graz
446 Beiträge
 
Delphi 10.3 Rio
 
#4

AW: How draw password on remote smartphone with mouse?

  Alt 30. Aug 2018, 09:49
Hi, I'm no expert with mobile apps but as far as I can see you need to update the first position (PO) every time you move to another 'dot'. otherwise you are always drawing from the first spot (upper, left in your video) to where the mouse is.

In plain Delphi that could be implemented like this:

Delphi-Quellcode:
unit frmMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, acPNG;

const
  DOT_RADIUS = 8;
  maxXDots = 3;
  maxYDots = 3;
  MOUSE_SLACK = 16;

type
  TPointIdx = Record
    XIdx: Integer;
    YIdx: Integer;
  End;

  TDot = Record
    Pos: TPoint;
    Bounds: TRect;
    Selected: Boolean;
    LinkTo: TPointIdx;
  End;

  TForm1 = class(TForm)
    PB: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PBMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PBMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PBMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PBPaint(Sender: TObject);
  private
    fDots: Array[0..maxXDots-1,0..maxYDots-1] Of TDot;
    fDown: Boolean;
    fPO: TPointIdx;
    fCurPos: TPoint;
    procedure CalcDotPositions;
    procedure ResetDotSelection;
    function MouseNearDots(X,Y: Integer; Var DXIdx, DYIdx: Integer): Boolean;
    function HasLinkTo(ADot: TDot): Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function PointIdx(XIdx,YIdx: Integer): TPointIdx;
begin
  Result.XIdx := XIdx;
  Result.YIdx := YIdx;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CalcDotPositions;
end;

procedure TForm1.CalcDotPositions;
var
  LCntrHorz, LCntrVert: Integer;
  LLeftHorz, LTopVert: Integer;
  LRghtHorz, LBotVert: Integer;
  ix: Integer;
  iy: Integer;
begin
  LCntrHorz := PB.Width Div 2;
  LLeftHorz := DOT_RADIUS + Round(LCntrHorz*0.1);
  LRghtHorz := PB.Width - LLeftHorz;
  LCntrVert := PB.Height Div 2;
  LTopVert := LCntrVert - (LRghtHorz - LCntrHorz);
  LBotVert := LCntrVert + (LRghtHorz - LCntrHorz);

  fDots[0,0].Pos := Point(LLeftHorz, LTopVert);
  fDots[0,1].Pos := Point(LLeftHorz, LCntrVert);
  fDots[0,2].Pos := Point(LLeftHorz, LBotVert);

  fDots[1,0].Pos := Point(LCntrHorz, LTopVert);
  fDots[1,1].Pos := Point(LCntrHorz, LCntrVert);
  fDots[1,2].Pos := Point(LCntrHorz, LBotVert);

  fDots[2,0].Pos := Point(LRghtHorz, LTopVert);
  fDots[2,1].Pos := Point(LRghtHorz, LCntrVert);
  fDots[2,2].Pos := Point(LRghtHorz, LBotVert);

  for ix := 0 to maxXDots-1 do
  begin
    for iy := 0 to maxYDots-1 do
    begin
      fDots[ix,iy].Selected := FALSE;
      fDots[ix,iy].Bounds := Rect(
        fDots[ix,iy].Pos.X - DOT_RADIUS,
        fDots[ix,iy].Pos.Y - DOT_RADIUS,
        fDots[ix,iy].Pos.X + DOT_RADIUS,
        fDots[ix,iy].Pos.Y + DOT_RADIUS
      );
    end;
  end;
end;

procedure TForm1.ResetDotSelection;
var
  ix,iy: Integer;
begin
  for ix := 0 to maxXDots-1 do
  begin
    for iy := 0 to maxYDots-1 do
    begin
      fDots[ix,iy].Selected := FALSE;
    end;
  end;
end;

function TForm1.MouseNearDots(X,Y: Integer; Var DXIdx, DYIdx: Integer): Boolean;
var
  ix,iy: Integer;
  LRect: TRect;
begin
  Result := FALSE;
  for ix := 0 to maxXDots-1 do
  begin
    for iy := 0 to maxYDots-1 do
    begin
      LRect := fDots[ix, iy].Bounds;
      InflateRect(LRect, MOUSE_SLACK, MOUSE_SLACK);
      if PtInRect(LRect, Point(X,Y)) then
      begin
        DXIdx := ix;
        DYIdx := iy;
        Result := TRUE;
        Break;
      end;
    end;
  end;
end;

function TForm1.HasLinkTo(ADot: TDot): Boolean;
begin
  Result := (ADot.LinkTo.XIdx >= 0) And (ADot.LinkTo.YIdx >= 0);
end;

procedure TForm1.PBMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  dx, dy: Integer;
begin
  ResetDotSelection;
  if MouseNearDots(X,Y, dx,dy) then
  begin
    fDown := TRUE;
    fPO := PointIdx(dx,dy);
    fDots[dx, dy].Selected := TRUE;
    fDots[dx, dy].LinkTo := PointIdx(-1, -1);
  end;
end;

procedure TForm1.PBMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  dx: Integer;
  dy: Integer;
begin
  if fDown then
  begin
    if MouseNearDots(X,Y, dx, dy) and not fDots[dx, dy].Selected then
    begin
      fCurPos := fDots[dx,dy].Pos;
      fDots[dx, dy].Selected := TRUE;
      fDots[dx, dy].LinkTo := fPO;
      fPO := PointIdx(dx, dy);
    end
    else
      fCurPos := Point(X,Y);

    Invalidate;
  end;
end;

procedure TForm1.PBMouseUp(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X, Y: Integer);
begin
  fDown := FALSE;
  PB.Invalidate;
end;


procedure TForm1.PBPaint(Sender: TObject);
var
  ix,iy: Integer;
begin
  // paint dots
  PB.Canvas.Brush.Color := clSilver;
  PB.Canvas.Brush.Style := bsSolid;
  PB.Canvas.Pen.Color := clBlack;
  PB.Canvas.Pen.Style := psSolid;
  PB.Canvas.Pen.Width := 1;
  for iy := 0 to maxYDots-1 do
  begin
    for ix := 0 to maxXDots-1 do
    begin
      PB.Canvas.Ellipse(fDots[ix,iy].Bounds);
    end;
  end;

  // draw fixed segemts
  PB.Canvas.Pen.Color := clYellow;
  PB.Canvas.Pen.Width := 6;
  for iy := 0 to maxYDots-1 do
  begin
    for ix := 0 to maxXDots-1 do
    begin
      if fDots[ix,iy].Selected And HasLinkTo(fDots[ix,iy]) then
      begin
       PB.Canvas.MoveTo( fDots[ix, iy].Pos.X, fDots[ix, iy].Pos.Y );
       PB.Canvas.LineTo( fDots[fDots[ix, iy].LinkTo.XIdx, fDots[ix, iy].LinkTo.YIdx].Pos.X,
                         fDots[fDots[ix, iy].LinkTo.XIdx, fDots[ix, iy].LinkTo.YIdx].Pos.Y );
      end;
    end;
  end;


  // draw current segment
  if fDown then
  begin
    PB.Canvas.Pen.Color := clYellow;
    PB.Canvas.Pen.Width := 6;
    PB.Canvas.MoveTo( fDots[fPO.XIdx, fPO.YIdx].Pos.X, fDots[fPO.XIdx, fPO.YIdx].Pos.Y );
    PB.Canvas.LineTo( fCurPos.X, fCurPos.Y );
  end;
end;

end.
with a Form like this:
Delphi-Quellcode:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 450
  ClientWidth = 250
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object PB: TPaintBox
    Left = 8
    Top = 8
    Width = 233
    Height = 427
    OnMouseDown = PBMouseDown
    OnMouseMove = PBMouseMove
    OnMouseUp = PBMouseUp
    OnPaint = PBPaint
  end
end
Whookie

Software isn't released ... it is allowed to escape!
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:09 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz