jvqsimlogic.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvSimLogic.PAS, released on 2002-06-15.

The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
All Rights Reserved.

Contributor(s): Robert Love [rlove att slcdug dott org].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  This unit includes several visual logic blocks that can be used without any programming.
  It is the start of a whole series of simulation blocks.

  There is a string seperation between the visual part and functionality.

  The user creates and removes blocks; joins and moves them.

  The functionality is created every 50 msec in the onTimer event of TJvSimLogicBox.

  No programming is required, just drop a TJvLogicBox in the corner of a form and Build the program.

  All the rest is up to the user.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQSimLogic.pas,v 1.19 2005/02/04 08:09:26 marquardt Exp $

unit JvQSimLogic;

{$I jvcl.inc}

interface

uses
  QWindows, QMessages, QGraphics, QControls, QForms, QDialogs, QExtCtrls,
  SysUtils, Classes,
  JvQTypes;

type
  TJvLogic = class;

  TJvGateStyle = (jgsDI, jgsDO);
  TJvLogicFunc = (jlfAND, jlfOR, jlfNOT);
  TJvGate = record
    Style: TJvGateStyle;
    State: Boolean;
    Active: Boolean;
    Pos: TPoint;
  end;

  TJvPointX = class(TPersistent)
  private
    FX: Integer;
    FY: Integer;
  public
    function Point: TPoint;
    procedure SetPoint(const Pt: TPoint);
    procedure Assign(Source: TPersistent); override;
  published
    property X: Integer read FX write FX;
    property Y: Integer read FY write FY;
  end;

  TJvConMode = (jcmTL, jcmTR, jcmBR, jcmBL);
  TJvConPos = (jcpTL, jcpTR, jcpBR, jcpBL);
  TJvConShape = (jcsTLBR, jcsTRBL);

  TJvSIMConnector = class(TGraphicControl)
  private
    FMdp: TPoint;
    FOldp: TPoint;
    FConAnchor: TPoint;
    FConOffset: TPoint;
    FConMode: TJvConMode;
    FConHot: TJvConPos;
    FDoMove: Boolean;
    FDoEdge: Boolean;
    FDisCon: TControl;
    FDisConI: Integer;
    FMode: TJvConMode;
    FShape: TJvConShape;
    FConSize: Integer;
    FConPos: TJvConPos;
    FEdge: Extended;

    FFromLogic: TJvLogic;
    FToLogic: TJvLogic;
    FFromGate: Integer;
    FToGate: Integer;
    FFromPoint: TJvPointX;
    FToPoint: TJvPointX;
    procedure SetFromLogic(const Value: TJvLogic);
    procedure SetToLogic(const Value: TJvLogic);
    procedure SetFromGate(const Value: Integer);
    procedure SetToGate(const Value: Integer);
    procedure SetFromPoint(const Value: TJvPointX);
    procedure SetToPoint(const Value: TJvPointX);
    procedure DisconnectFinal;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoMouseDown(X, Y: Integer);
    procedure DoMouseMove(dx, dy: Integer);
    procedure AnchorCorner(LogTL: TPoint; ACorner: TJvConMode);
    procedure MoveConnector(LogTL: TPoint);
    procedure Connect;
    procedure Disconnect;
  published
    property FromLogic: TJvLogic read FFromLogic write SetFromLogic;
    property FromGate: Integer read FFromGate write SetFromGate;
    property FromPoint: TJvPointX read FFromPoint write SetFromPoint;
    property ToLogic: TJvLogic read FToLogic write SetToLogic;
    property ToGate: Integer read FToGate write SetToGate;
    property ToPoint: TJvPointX read FToPoint write SetToPoint;
  end;

  TJvLogic = class(TGraphicControl)
  private
    FDoMove: Boolean;
    FDoStyle: Boolean;
    FStyleDown: Boolean;
    FMdp: TPoint;
    FOldp: TPoint;
    FGates: array [0..5] of TJvGate;
    FConnectors: TList;
    FNewLeft: Integer;
    FNewTop: Integer;
    FInput1: Boolean;
    FInput2: Boolean;
    FInput3: Boolean;
    FOutput1: Boolean;
    FOutput2: Boolean;
    FOutput3: Boolean;
    FLogicFunc: TJvLogicFunc;
    function GetGate(Index: Integer): TJvGate;
    procedure AnchorConnectors;
    procedure MoveConnectors;
    procedure PaintLed(Index: Integer);
    procedure SetInput1(const Value: Boolean);
    procedure SetInput2(const Value: Boolean);
    procedure SetInput3(const Value: Boolean);
    procedure SetOutput1(const Value: Boolean);
    procedure SetOutput2(const Value: Boolean);
    procedure SetOutput3(const Value: Boolean);
    procedure SetLogicFunc(const Value: TJvLogicFunc);
    procedure OutCalc;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    property Gates[Index: Integer]: TJvGate read GetGate;
  published
    property Input1: Boolean read FInput1 write SetInput1;
    property Input2: Boolean read FInput2 write SetInput2;
    property Input3: Boolean read FInput3 write SetInput3;
    property Output1: Boolean read FOutput1 write SetOutput1;
    property Output2: Boolean read FOutput2 write SetOutput2;
    property Output3: Boolean read FOutput3 write SetOutput3;
    property LogicFunc: TJvLogicFunc read FLogicFunc write SetLogicFunc;
  end;

  TJvSimReverse = class(TGraphicControl)
  private
    FDoMove: Boolean;
    FMdp: TPoint;
    FOldp: TPoint;
    FGates: array [0..3] of TJvGate;
    FConnectors: TList;
    FNewLeft: Integer;
    FNewTop: Integer;
    FInput1: Boolean;
    FOutput1: Boolean;
    FOutput2: Boolean;
    FOutput3: Boolean;
    function GetGate(Index: Integer): TJvGate;
    procedure AnchorConnectors;
    procedure MoveConnectors;
    procedure PaintLed(Index: Integer);
    procedure SetInput1(const Value: Boolean);
    procedure SetOutput1(const Value: Boolean);
    procedure OutCalc;
    procedure SetOutput2(const Value: Boolean);
    procedure SetOutput3(const Value: Boolean);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    property Gates[Index: Integer]: TJvGate read GetGate;
  published
    property Input1: Boolean read FInput1 write SetInput1;
    property Output1: Boolean read FOutput1 write SetOutput1;
    property Output2: Boolean read FOutput2 write SetOutput2;
    property Output3: Boolean read FOutput3 write SetOutput3;
  end;

  TJvSimButton = class(TGraphicControl)
  private
    FDoMove: Boolean;
    FMdp: TPoint;
    FOldp: TPoint;
    FConnectors: TList;
    FDown: Boolean;
    FDepressed: Boolean;
    FNewLeft: Integer;
    FNewTop: Integer;
    procedure AnchorConnectors;
    procedure MoveConnectors;
    procedure PaintLed(Pt: TPoint; Lit: Boolean);
    procedure SetDown(const Value: Boolean);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property Down: Boolean read FDown write SetDown;
  end;

  TJvSimLight = class(TGraphicControl)
  private
    FDoMove: Boolean;
    FMdp: TPoint;
    FOldp: TPoint;
    FConnectors: TList;
    FLit: Boolean;
    FColorOn: TColor;
    FColorOff: TColor;
    FNewLeft: Integer;
    FNewTop: Integer;
    procedure AnchorConnectors;
    procedure MoveConnectors;
    procedure SetLit(const Value: Boolean);
    procedure SetColorOff(const Value: TColor);
    procedure SetColorOn(const Value: TColor);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property Lit: Boolean read FLit write SetLit;
    property ColorOn: TColor read FColorOn write SetColorOn;
    property ColorOff: TColor read FColorOff write SetColorOff;
  end;

  TJvSimBin = class(TGraphicControl)
  private
    FBmpBin: TBitmap;
  protected
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
  end;

  TJvSimLogicBox = class(TGraphicControl)
  private
    FCpu: TTimer;
    FBmpCon: TBitmap;
    FRCon: TRect;
    FDCon: Boolean;
    FBmpLogic: TBitmap;
    FRLogic: TRect;
    FDLogic: Boolean;
    FBmpButton: TBitmap;
    FRButton: TRect;
    FDButton: Boolean;
    FBmpLight: TBitmap;
    FRLight: TRect;
    FDLight: Boolean;
    FBmpRev: TBitmap;
    FRRev: TRect;
    FDRev: Boolean;
    FBmpBin: TBitmap;
    procedure CpuOnTimer(Sender: TObject);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
  end;

implementation

{$IFDEF UNITVERSIONING}
uses
  JclUnitVersioning;
{$ENDIF UNITVERSIONING}

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvSimImages.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvSimImages.res}
{$ENDIF UNIX}

// general bin procedure

procedure BinCheck(AControl: TControl);
var
  Wc: TWinControl;
  I: Integer;
  R, Rb: TRect;
  Keep: Boolean;
begin
  // check for TJvSimLogicBox
  Wc := AControl.Parent;
  R := AControl.BoundsRect;
  Keep := False;
  for I := 0 to Wc.ControlCount - 1 do
    if Wc.Controls[I] is TJvSimLogicBox then
    begin
      Rb := Wc.Controls[I].BoundsRect;
      Rb.Left := Rb.Right - 32;
      if PtInRect(Rb, Point(R.Left, R.Top)) then
        Break
      else
      if PtInRect(Rb, Point(R.Right, R.Top)) then
        Break
      else
      if PtInRect(Rb, Point(R.Right, R.Bottom)) then
        Break
      else
      if PtInRect(Rb, Point(R.Left, R.Bottom)) then
        Break
      else
        Keep := True;
    end;
  if not Keep then
    AControl.Free;
end;

//=== { TJvPointX } ==========================================================

procedure TJvPointX.Assign(Source: TPersistent);
begin
  if Source is TJvPointX then
  begin
    FX := TJvPointX(Source).X;
    FY := TJvPointX(Source).Y;
  end
  else
    inherited Assign(Source);
end;

function TJvPointX.Point: TPoint;
begin
  Result.X := FX;
  Result.Y := FY;
end;

procedure TJvPointX.SetPoint(const Pt: TPoint);
begin
  FX := Pt.X;
  FY := Pt.Y;
end;

//=== { TJvSIMConnector } ====================================================

constructor TJvSIMConnector.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 100;
  Height := 50;
  FMode := jcmTL;
  FShape := jcsTLBR;
  FConSize := 8;
  FConPos := jcpTL;
  FEdge := 0.5;
  FFromPoint := TJvPointX.Create;
  FToPoint := TJvPointX.Create;
end;

destructor TJvSIMConnector.Destroy;
begin
  FFromPoint.Free;
  FToPoint.Free;
  inherited Destroy;
end;

procedure TJvSIMConnector.DoMouseDown(X, Y: Integer);
var
  P: TPoint;
  Rtl, Rbr, Rtr, Rbl: TRect;
  D: Integer;
begin
  FDoMove := False;
  FDoEdge := False;
  D := FConSize;
  FOldp := Point(X, Y);
  Rtl := Rect(0, 0, D, D);
  Rbr := Rect(Width - 1 - D, Height - 1 - D, Width - 1, Height - 1);
  Rtr := Rect(Width - 1 - D, 0, Width - 1, D);
  Rbl := Rect(0, Height - 1 - D, D, Height - 1);
  P := Point(X, Y);
  if PtInRect(Rtl, P) and (FShape = jcsTLBR) then
  begin
    FMode := jcmTL;
    FMdp := Point(X, Y);
  end
  else
  if PtInRect(Rtr, P) and (FShape = jcsTRBL) then
  begin
    FMode := jcmTR;
    FMdp := Point(Width - X, Y);
  end
  else
  if PtInRect(Rbr, P) and (FShape = jcsTLBR) then
  begin
    FMode := jcmBR;
    FMdp := Point(Width - X, Height - Y);
  end
  else
  if PtInRect(Rbl, P) and (FShape = jcsTRBL) then
  begin
    FMode := jcmBL;
    FMdp := Point(X, Height - Y);
  end
  else
  if Abs(X - Round(FEdge * Width)) < 10 then
    FDoEdge := True
  else
  begin
    FDoMove := True;
    FMdp := Point(X, Y);
    SetFromLogic(nil);
    SetToLogic(nil);
  end;
  if not FDoEdge then
    Disconnect;
end;

procedure TJvSIMConnector.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  DoMouseDown(X, Y);
end;

procedure TJvSIMConnector.DoMouseMove(dx, dy: Integer);
var
  P: TPoint;
  D, d2, nw, nh: Integer;
  X, Y: Integer;
begin
  X := dx + FOldp.X;
  Y := dy + FOldp.Y;
  FOldp := Point(X, Y);
  P := ClientToScreen(Point(X, Y));
  P := Parent.ScreenToClient(P);
  D := FConSize;
  d2 := D div 2;
  if FDoEdge then
  begin
    FEdge := X / Width;
    Invalidate;
  end
  else
  if FDoMove then
  begin
    Left := P.X - FMdp.X;
    Top := P.Y - FMdp.Y;
  end
  else
  begin
    case FMode of
      jcmTL:
        begin
          Left := P.X - FMdp.X;
          Top := P.Y - FMdp.Y;
          nw := Width + (FMdp.X - X);