jvqsimlogic.pas

East make Tray Icon in delphi

  P := ClientToScreen(Point(X, Y));
  P := Parent.ScreenToClient(P);
  if ssLeft in Shift then
  begin
    if FDoMove then
    begin
      FNewLeft := P.X - FMdp.X;
      FNewTop := P.Y - FMdp.Y;
      MoveConnectors;
      Left := FNewLeft;
      Top := FNewTop;
    end
  end;
end;

procedure TJvLogic.AnchorConnectors;
var
  Wc: TWinControl;
  I: Integer;
  Con: TJvSIMConnector;
  R, Rc: TRect;
  P: TPoint;
begin
  Wc := Parent;
  FConnectors.Clear;
  R := BoundsRect;
  InflateRect(R, 8, 0);
  P := Point(Left, Top);
  for I := 0 to Wc.ControlCount - 1 do
    if Wc.Controls[I] is TJvSIMConnector then
    begin
      Con := TJvSIMConnector(Wc.Controls[I]);
      // check for corners in bounds
      Rc := Con.BoundsRect;
      // TL
      if PtInRect(R, Point(Rc.Left, Rc.Top)) then
      begin
        FConnectors.Add(Con);
        Con.AnchorCorner(P, jcmTL);
      end
      // TR
      else
      if PtInRect(R, Point(Rc.Right, Rc.Top)) then
      begin
        FConnectors.Add(Con);
        Con.AnchorCorner(P, jcmTR);
      end
      // BR
      else
      if PtInRect(R, Point(Rc.Right, Rc.Bottom)) then
      begin
        FConnectors.Add(Con);
        Con.AnchorCorner(P, jcmBR);
      end
      // BL
      else
      if PtInRect(R, Point(Rc.Left, Rc.Bottom)) then
      begin
        FConnectors.Add(Con);
        Con.AnchorCorner(P, jcmBL);
      end
    end;
end;

procedure TJvLogic.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FStyleDown := False;
  if FDoStyle then
  begin
    FDoStyle := False;
    case FLogicFunc of
      jlfAND:
        LogicFunc := jlfOR;
      jlfOR:
        LogicFunc := jlfNOT;
      jlfNOT:
        LogicFunc := jlfAND;
    end;
  end;
  BinCheck(Self);
end;

procedure TJvLogic.PaintLed(Index: Integer);
var
  SurfCol, LitCol: TColor;
  P: TPoint;
  X, Y: Integer;
  Lit: Boolean;
begin
  if not Gates[Index].Active then
    Exit;
  P := Gates[Index].Pos;
  X := P.X;
  Y := P.Y;
  if Index = 0 then
    Lit := FInput1
  else
  if Index = 1 then
    Lit := FInput2
  else
  if Index = 2 then
    Lit := FInput3
  else
  if Index = 3 then
    Lit := FOutput1
  else
  if Index = 4 then
    Lit := FOutput2
  else
  if Index = 5 then
    Lit := FOutput3
  else
    Lit := False;
  if Lit then
  begin
    if Gates[Index].Style = jgsDI then
      SurfCol := clLime
    else
      SurfCol := clRed;
    LitCol := clWhite;
  end
  else
  begin
    if Gates[Index].Style = jgsDI then
    begin
      SurfCol := clGreen;
      LitCol := clLime;
    end
    else
    begin
      SurfCol := clMaroon;
      LitCol := clRed;
    end;
  end;
  with Canvas do
  begin
    Brush.Color := clSilver;
    FillRect(Rect(X, Y, X + 12, Y + 13));
    Brush.Style := bsClear;
    Pen.Color := clGray;
    Ellipse(X, Y, X + 12, Y + 13);
    Pen.Color := clBlack;
    Brush.Color := SurfCol;
    Ellipse(X + 1, Y + 1, X + 11, Y + 12);
    Pen.Color := clWhite;
    Arc(X + 1, Y + 1, X + 11, Y + 12, X + 0, Y + 12, X + 12, Y + 0);
    Pen.Color := LitCol;
    Arc(X + 3, Y + 3, X + 8, Y + 9, X + 5, Y + 0, X + 0, Y + 8);
  end;
end;

procedure TJvLogic.Paint;
var
  I: Integer;
  R: TRect;
  S: string;
begin
  with Canvas do
  begin
    Brush.Color := clSilver;
    R := ClientRect;
    FillRect(R);
    Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
    //     Frame3D(Canvas,R,clBtnShadow,clBtnHighlight,1);
    Brush.Color := clRed;
    for I := 0 to 5 do
      PaintLed(I);
    R := ClientRect;
    InflateRect(R, -15, -15);
    if FStyleDown then
      Frame3D(Canvas, R, clBtnShadow, clBtnHighlight, 1)
    else
      Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
    // Draw caption
    case FLogicFunc of
      jlfAND:
        S := 'AND'; // do not localize
      jlfOR:
        S := 'OR'; // do not localize
      jlfNOT:
        S := 'NOT'; // do not localize
    end;
    Brush.Style := bsClear;  
    DrawText(Canvas, S, -1, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
  end;
end;

procedure TJvLogic.Resize;
begin
  Width := 65;
  Height := 65;
end;

procedure TJvLogic.MoveConnectors;
var
  I: Integer;
  Con: TJvSIMConnector;
begin
  for I := 0 to FConnectors.Count - 1 do
  begin
    Con := TJvSIMConnector(FConnectors[I]);
    Con.MoveConnector(Point(FNewLeft, FNewTop));
  end;
end;

procedure TJvLogic.OutCalc;
begin
  case FLogicFunc of
    jlfAND:
      Output2 := Input1 and Input3;
    jlfOR:
      Output2 := Input1 or Input3;
    jlfNOT:
      Output2 := not Input2;
  end;

end;

procedure TJvLogic.SetInput1(const Value: Boolean);
begin
  if Value <> FInput1 then
  begin
    FInput1 := Value;
    Invalidate;
    OutCalc;
  end;
end;

procedure TJvLogic.SetInput2(const Value: Boolean);
begin
  if Value <> FInput2 then
  begin
    FInput2 := Value;
    Invalidate;
    OutCalc;
  end;
end;

procedure TJvLogic.SetInput3(const Value: Boolean);
begin
  if Value <> FInput3 then
  begin
    FInput3 := Value;
    Invalidate;
    OutCalc;
  end;
end;

procedure TJvLogic.SetOutput1(const Value: Boolean);
begin
  if Value <> FOutput1 then
  begin
    FOutput1 := Value;
    Invalidate;
  end;
end;

procedure TJvLogic.SetOutput2(const Value: Boolean);
begin
  if Value <> FOutput2 then
  begin
    FOutput2 := Value;
    Invalidate;
  end;
end;

procedure TJvLogic.SetOutput3(const Value: Boolean);
begin
  if Value <> FOutput3 then
  begin
    FOutput3 := Value;
    Invalidate;
  end;
end;

procedure TJvLogic.SetLogicFunc(const Value: TJvLogicFunc);
begin
  if Value <> FLogicFunc then
  begin
    FLogicFunc := Value;
    case FLogicFunc of
      jlfAND:
        begin
          FGates[0].Active := True;
          FGates[1].Active := False;
          FGates[2].Active := True;
          FGates[3].Active := False;
          FGates[4].Active := True;
          FGates[5].Active := False;
        end;
      jlfOR:
        begin
          FGates[0].Active := True;
          FGates[1].Active := False;
          FGates[2].Active := True;
          FGates[3].Active := False;
          FGates[4].Active := True;
          FGates[5].Active := False;
        end;
      jlfNOT:
        begin
          FGates[0].Active := False;
          FGates[1].Active := True;
          FGates[2].Active := False;
          FGates[3].Active := False;
          FGates[4].Active := True;
          FGates[5].Active := False;
        end;
    end;
    Invalidate;
    OutCalc;
  end;
end;

//=== { TJvSimButton } =======================================================

constructor TJvSimButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDown := False;
  Width := 65;
  Height := 65;
  FConnectors := TList.Create;
end;

destructor TJvSimButton.Destroy;
begin
  FConnectors.Free;
  inherited Destroy;
end;

procedure TJvSimButton.AnchorConnectors;
var
  Wc: TWinControl;
  I: Integer;
  Con: TJvSIMConnector;
  R, Rc: TRect;
  P: TPoint;
begin
  Wc := Parent;
  FConnectors.Clear;
  R := BoundsRect;
  InflateRect(R, 8, 8);
  P := Point(Left, Top);
  for I := 0 to Wc.ControlCount - 1 do
    if Wc.Controls[I] is TJvSIMConnector then
    begin
      Con := TJvSIMConnector(Wc.Controls[I]);
      // check for corners in bounds
      Rc := Con.BoundsRect;
      // TL
      if PtInRect(R, Point(Rc.Left, Rc.Top)) then
      begin
        FConnectors.Add(Con);
        Con.AnchorCorner(P, jcmTL);
      end
      // TR
      else
      if PtInRect(R, Point(Rc.Right, Rc.Top)) then
      begin
        FConnectors.Add(Con);
        Con.AnchorCorner(P, jcmTR);
      end
      // BR
      else
      if PtInRect(R, Point(Rc.Right, Rc.Bottom)) then
      begin
        FConnectors.Add(Con);
        Con.AnchorCorner(P, jcmBR);
      end
      // BL
      else
      if PtInRect(R, Point(Rc.Left, Rc.Bottom)) then
      begin
        FConnectors.Add(Con);
        Con.AnchorCorner(P, jcmBL);
      end
    end;
end;

procedure TJvSimButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  R: TRect;
begin
  FMdp := Point(X, Y);
  R := ClientRect;
  InflateRect(R, -15, -15);
  FDoMove := not PtInRect(R, FMdp);
  FDepressed := not FDoMove;
  FOldp := Point(X, Y);
  if FDoMove then
    AnchorConnectors
  else
    Invalidate;
end;

procedure TJvSimButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if FDepressed then
    Exit;
  P := ClientToScreen(Point(X, Y));
  P := Parent.ScreenToClient(P);
  if ssLeft in Shift then
  begin
    if FDoMove then
    begin
      FNewLeft := P.X - FMdp.X;
      FNewTop := P.Y - FMdp.Y;
      MoveConnectors;
      Left := FNewLeft;
      Top := FNewTop;
    end
  end;
end;

procedure TJvSimButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  R: TRect;
  P: TPoint;
begin
  FDepressed := False;
  P := Point(X, Y);
  R := ClientRect;
  InflateRect(R, -15, -15);
  if PtInRect(R, P) then
  begin
    Down := not FDown;
  end
  else
    BinCheck(Self);
end;

procedure TJvSimButton.MoveConnectors;
var
  I: Integer;
  Con: TJvSIMConnector;
begin
  for I := 0 to FConnectors.Count - 1 do
  begin
    Con := TJvSIMConnector(FConnectors[I]);
    Con.MoveConnector(Point(FNewLeft, FNewTop));
  end;
end;

procedure TJvSimButton.Paint;
var
  P: TPoint;
  R: TRect;
begin
  with Canvas do
  begin
    Brush.Color := clSilver;
    R := ClientRect;
    FillRect(R);
    Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
    InflateRect(R, -15, -15);
    if FDepressed or FDown then
      Frame3D(Canvas, R, clBtnShadow, clBtnHighlight, 1)
    else
      Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
    P := Point((Width div 2) - 6, (Height div 2) - 6);
    PaintLed(P, FDown);
  end;
end;

procedure TJvSimButton.PaintLed(Pt: TPoint; Lit: Boolean);
var
  SurfCol, LitCol: TColor;
  X, Y: Integer;
begin
  X := Pt.X;
  Y := Pt.Y;
  if Lit then
  begin
    SurfCol := clRed;
    LitCol := clWhite
  end
  else
  begin
    SurfCol := clMaroon;
    LitCol := clRed;
  end;
  with Canvas do
  begin
    Brush.Color := clSilver;
    FillRect(Rect(X, Y, X + 12, Y + 13));
    Brush.Style := bsClear;
    Pen.Color := clGray;
    Ellipse(X, Y, X + 12, Y + 13);
    Pen.Color := clBlack;
    Brush.Color := SurfCol;
    Ellipse(X + 1, Y + 1, X + 11, Y + 12);
    Pen.Color := clWhite;
    Arc(X + 1, Y + 1, X + 11, Y + 12, X + 0, Y + 12, X + 12, Y + 0);
    Pen.Color := LitCol;
    Arc(X + 3, Y + 3, X + 8, Y + 9, X + 5, Y + 0, X + 0, Y + 8);
  end;
end;

procedure TJvSimButton.Resize;
begin
  Width := 65;
  Height := 65;
end;

procedure TJvSimButton.SetDown(const Value: Boolean);
begin
  if Value <> FDown then
  begin
    FDown := Value;
    FDepressed := Value;
    Invalidate;
  end;