dsnunit.pas

DELPHI编写的商场收银POS机源代码

    begin
      if Agent.AgentList = nil then
        Agent.AgentList:= TAgentList.Create;
      Agent.AgentList.Add(AHandle);
      BList:= TChildList.Create(nil,AHandle);
      for j:= 0 to BList.Count -1 do
        ProcB(BList[j].Handle, Agent);
      BList.Free;
    end;
  begin
    CanCover:= caAllAccept;
    if Assigned(FDsnStage.OnCoverQuery) then
      FDsnStage.OnCoverQuery(FDsnStage, AAParent, CanCover);

    if CanCover = caAllAccept then
    begin
      DsnCtrl:= CreateSubCtrl(AAParent);
      FDsnCtrlList.Add(DsnCtrl);
      DsnCtrl.FDsnRegister:= Self;
    end;

    if not (CanCover = caNoAccept) then
    begin
      List:= TChildList.Create(AAParent,AAParent.Handle);
      for i:= 0 to List.Count -1 do
      begin
        if List[i].Instance <> nil then
          if List[i].Instance.Owner <> FDsnStage.Owner then
            ProcB(List[i].Handle,DsnCtrl) // For Like Spinedit
          else
            ProcA(List[i].Instance);
        if List[i].Instance = nil then
          ProcB(List[i].Handle,DsnCtrl)  // For Like Combobox
      end;
      List.Free;
    end
  end;
begin
  ProcA(AParent);
end;

procedure TDsnRegister.CreateSubClass;
begin
  if FDsnCtrlList = nil then
    FDsnCtrlList:= CreateDsnList;

  SetSubClass(FDsnStage);
end;

procedure TDsnRegister.CreateContextMenu;
var
  i:integer;
  CoverMenu:TPopupMenu;
  Item:TMenuItem;
begin
  if not Assigned(FDsnStage) then
    Exit;

  if (not Assigned(FDsnStage.CoverMenu)) and (FDsnStage.SelfProps.Count = 0) then
    Exit;

  FContextMenu:= TPopupMenu.Create(Owner);
  FContextMenu.OnPopup:= FDsnStage.CoverMenu.OnPopup;

  // Copy from CoverMenu
  if Assigned(FDsnStage.CoverMenu) then
    if Assigned(FDsnStage.CoverMenu) then
    begin
      CoverMenu:= FDsnStage.CoverMenu;
      for i:= CoverMenu.Items.Count -1 downto 0 do
      begin
        {Item:= TMenuItem.Create(Owner);
        Item.Caption:= CoverMenu.Items[i].Caption;
        Item.OnClick:= CoverMenu.Items[i].OnClick;}
        Item:= CoverMenu.Items[i];
        CoverMenu.Items.Remove(Item);
        FContextMenu.Items.Insert(0,Item);
      end;
    end;

  //Input Fixed Items Count on Tag
  FContextMenu.Tag:= FContextMenu.Items.Count;
end;

procedure TDsnRegister.MenuMethod(Sender:TObject);
var
  Item:TDsnMenuItem;
  Targets:TSelectedComponents;
begin
  Item:= TDsnMenuItem(Sender);
  if Assigned(FDsnStage) then
    if Assigned(FDsnStage.OnMenuClick) then
    begin
      Targets:=TSelectedComponents.Create;
      Targets.AssignList(FTargetList.List);
      FDsnStage.OnMenuClick(FDsnStage,Targets,
                            Item.PropName,Item.Value);
      SetProp(FTargetList.List,Item.PropName,Item.Value);
      FTargetList.SetPosition;
      Targets.Free;
    end;
end;

function TDsnRegister.CreateSubCtrl(AParent:TWinControl):TDsnCtrl;
begin
  Result:= TDsnCtrl.CreateInstance(AParent);
end;

procedure TDsnRegister.DestroySubClass;
var
  i: integer;
begin
  if Assigned(FDsnCtrlList) then
    for i:= 0 to FDsnCtrlList.Count -1 do
      TDsnCtrl(FDsnCtrlList[i]).Free;

  FDsnCtrlList.Clear;
end;

procedure TDsnRegister.SelectByInspect(Control:TControl);
begin
  if not Assigned(FTargetList) then
    FTargetList:= CreateList;
  FTargetList.Clear;
  FTargetList.Add(Control);
  FTargetList.SetPosition;
end;

procedure TDsnRegister.MouseDown(Client:TWinControl; Target:TComponent; MousePoint:TPoint; Shift: TShiftState);
var
  Template:TControl;
begin
  Template:= nil;
  if Assigned(FDsnPanel) then
    Template:=  TControl(FDsnPanel.GetTemplate);

  if Assigned(Template) then
    MouseDownCreate(Client,Target,MousePoint,Shift)
  else
    MouseDownMove(Client,Target,MousePoint,Shift);
end;

procedure TDsnRegister.MouseDownMove(Client:TWinControl; Target:TComponent; MousePoint:TPoint; Shift: TShiftState);
var
  n,i: integer;
  CanSelect: TSelectAccept;
begin
  CanSelect:= [saCreate, saMove];

  if Assigned(FDsnStage) then
    if Assigned(FDsnStage.OnSelectQuery) then
      FDsnStage.OnSelectQuery(FDsnStage, Target, CanSelect);

  if saMove in CanSelect then
  begin
    if Client = Target then
      FParentCtrl:= Client.Parent
    else
      FParentCtrl:= Client;

    if FTargetList = nil then
      FTargetList:= CreateList;

    n:= FTargetList.Count;
    if n > 0 then
    begin
      n:= FTargetList.IndexOf(Target);
      if (n = -1) or not SameParent then
      begin
        FTargetList.Clear;
        FTargetList.Add(Target);
      end;
    end
    else
    begin
      FTargetList.Add(Target);
    end;

    if Assigned(Target) then
    begin
      if SameParent then
      begin
        //Application.ProcessMessages;
        CreateMoveShape;
        FShape.Color:= Color;
        FShape.PenWidth:= PenWidth;
        Cutting(MousePoint.x,MousePoint.y);
        FX:= MousePoint.x;
        FY:= MousePoint.y;
        MousePoint:= FParentCtrl.ClientToScreen(MousePoint);
        FShape.Point:= MousePoint;
        for i:= 0 to FTargetList.Count -1 do
          FShape.Add(FTargetList[i]);
        FShape.DrowOn(FParentCtrl);
      end;

    end;
  end;
end;

procedure TDsnRegister.MouseDownCreate(Client:TWinControl; Target:TComponent; MousePoint:TPoint; Shift: TShiftState);
var
  CanSelect: TSelectAccept;
begin
  CanSelect:= [saCreate, saMove];
  if Assigned(FDsnStage) then
    if Assigned(FDsnStage.OnSelectQuery) then
      FDsnStage.OnSelectQuery(FDsnStage, Target, CanSelect);

  if saCreate in CanSelect then
  begin
    if csAcceptsControls in Client.ControlStyle then
      FParentCtrl:= Client
    else
    begin
      FParentCtrl:= Client.Parent;
      Inc(MousePoint.x, Client.Left);
      Inc(MousePoint.y, Client.Top);
    end;

    CreateCopyShape;
    FShape.Color:= Color;
    FShape.PenWidth:= PenWidth;
    Cutting(MousePoint.x,MousePoint.y);
    FX:= MousePoint.x;
    FY:= MousePoint.y;
    FShape.Point:= MousePoint;
    FShape.AddNew;
    FShape.DrowOn(FParentCtrl);
  end;
end;

procedure TDsnRegister.MoseMove(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
var
  Template:TControl;
begin
  Template:= nil;
  if Assigned(FDsnPanel) then
    Template:=  TControl(FDsnPanel.GetTemplate);

  if Assigned(Template) then
    MouseMoveCreate(Client,MousePoint,Shift)
  else if ssLeft in Shift then
    MouseMoveMove(Client,MousePoint,Shift)
  else
  begin
    if Assigned(FShape) then
    begin
      FShape.DrowUp;
      FShape.Free;
      FShape:= nil;
    end;
  end;
end;

procedure TDsnRegister.MouseMoveMove(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
begin
  if Assigned(FShape) then
  begin
    Cutting(MousePoint.x,MousePoint.y);
    if SameParent then
    begin
      MousePoint:= FParentCtrl.ClientToScreen(MousePoint);
      FShape.Drow(MousePoint);
    end;
  end;
end;

procedure TDsnRegister.MouseMoveCreate(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
begin
  if Assigned(FShape) then
  begin
    Cutting(MousePoint.x,MousePoint.y);
    if not (csAcceptsControls in Client.ControlStyle) then
    begin
      Inc(MousePoint.x,Client.Left);
      Inc(MousePoint.y,Client.Top);
    end;
    FShape.SetWidth(MousePoint.x - FX);
    FShape.SetHeight(MousePoint.y - FY);
    MousePoint.x:= FX;
    MousePoint.y:= FY;
    MousePoint:= FParentCtrl.ClientToScreen(MousePoint);
    FShape.Drow(MousePoint);
  end;
end;

procedure TDsnRegister.MoseUp(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
var
  Template:TControl;
begin
  Template:= nil;
  if Assigned(FDsnPanel) then
    Template:=  TControl(FDsnPanel.GetTemplate);

  if Assigned(Template) then
      MouseUpCreate(Client,MousePoint,Shift)
  else
    MouseUpMove(Client,MousePoint,Shift);
end;

procedure TDsnRegister.MouseUpMove(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
var
  i,DX,DY:integer;
  CanMove: Boolean;
begin
  Cutting(MousePoint.x,MousePoint.y);
  if SameParent then
    if Assigned(FShape) then
    begin
      FShape.DrowUp;
      FShape.Free;
      FShape:= nil;
      if Assigned(FTargetList) then
        for i:= 0 to FTargetList.Count -1 do
        begin
          CanMove:= True;
          if Assigned(FDsnStage.OnMoveQuery) then
            FDsnStage.OnMoveQuery(FDsnStage,FTargetList[i],CanMove);
          if CanMove then
          begin
            TControl(FTargetList[i]).Left:= TControl(FTargetList[i]).Left + (MousePoint.x - FX);
            TControl(FTargetList[i]).Top:= TControl(FTargetList[i]).Top + (MousePoint.y - FY);
          end;
        end;
    end;

  DX:= FX- MousePoint.x;
  DY:= FY- MousePoint.y;
  if (DX <> 0) or (DY <> 0) then
    Moved(DX,DY);

  if Assigned(FTargetList) then
    FTargetList.SetPosition;
end;

procedure TDsnRegister.MouseUpCreate(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
var
  NewWidth, NewHeight: Integer;
begin
  Cutting(MousePoint.x, MousePoint.y);
  if Assigned(FShape) then
  begin
    if not (csAcceptsControls in Client.ControlStyle) then
    begin
      Inc(MousePoint.x, Client.Left);
      Inc(MousePoint.y, Client.Top);
    end;
    FShape.DrowUp;
    FShape.Free;
    FShape:= nil;
    NewWidth:= MousePoint.x - FX;
    NewHeight:= MousePoint.y - FY;
    try
      CopyPaste(TControl(FDsnPanel.GetTemplate),FParentCtrl);
    except
    end;
    if Assigned(FDsnControl) then
    begin
      GiveName(FDsnControl);
      if (NewWidth >=0) and (NewHeight >=0) then
        TControl(FDsnControl).SetBounds(FX, FY, NewWidth, NewHeight);
      if (NewWidth <0) and (NewHeight >=0) then
        TControl(FDsnControl).SetBounds(FX + NewWidth, FY, -NewWidth, NewHeight);
      if (NewWidth >=0) and (NewHeight <0) then
        TControl(FDsnControl).SetBounds(FX, FY + NewHeight, NewWidth, -NewHeight);
      if (NewWidth <0) and (NewHeight <0) then
        TControl(FDsnControl).SetBounds(FX + NewWidth, FY + NewHeight, -NewWidth, -NewHeight);

      if FTargetList = nil then
        FTargetList:= CreateList;

      if FDsnControl is TWinControl then
        SetSubClass(TWinControl(FDsnControl));

      FTargetList.Clear;
      FTargetList.Add(FDsnControl);
//      FLastTarget:= TControl(FDsnControl);
      FTargetList.SetPosition;

      {if Assigned(FDsnStage) then
        if Assigned(FDsnStage.OnControlCreate) then
          FDsnStage.OnControlCreate(FDsnStage, FDsnControl);}
    end;
  end;
  if Assigned(FDsnPanel) then
    FDsnPanel.EndCreating;
  FDsnPanel.SetTemplate(nil);
  FDsnControl:= nil;
end;

procedure TDsnRegister.Resized(Control:TControl;var Message: TResizeMessage);
begin
  if Assigned(FProps) then
  begin
    FProps.GetValues;
    FProps.SetPosition;
  end;
end;

procedure TDsnRegister.Moved(DeltaX,DeltaY: Integer);
begin
  if Assigned(FProps) then
    FProps.GetValues;
end;

procedure TDsnRegister.Selected(Control:TControl;var Message: TMessage);
begin
end;

procedure TDsnRegister.ClearSelect;
begin
  if Assigned(FTargetList) then
    FTargetList.Clear;
end;

procedure TDsnRegister.DbClick(Target:TControl; var Message: TWMMouse);
begin
  //ShowMessage(Target.Owner.Name);
  if Assigned(FDsnStage) then
    if Assigned(FDsnStage.OnCoverDblClick) then
      FDsnStage.OnCoverDblClick(FDsnStage, Target);
end;

procedure TDsnRegister.RButtonDown(Client:TWinControl; Target:TControl; XPos,YPos: Integer);
var
  n:integer;
  CanSelect: TSelectAccept;
begin
  CanSelect:= [saCreate, saMove];

  if Assigned(FDsnStage) then
    if Assigned(FDsnStage.OnSelectQuery) then
      FDsnStage.OnSelectQuery(FDsnStage, Target, CanSelect);

  if saMove in CanSelect then
  begin
    if Client = Target then
      FParentCtrl:= Client.Parent
    else
      FParentCtrl:= Client;

    if FTargetList = nil then
      FTargetList:= CreateList;

    n:= FTargetList.Count;
    if n > 0 then
    begin
      n:= FTargetList.IndexOf(Target);
      if (n = -1) or not SameParent then
      begin
        FTargetList.Clear;
        FTargetList.Add(Target);
      end;
    end
    else
    begin
      FTargetList.Add(Target);
    end;
    FTargetList.SetPosition;
  end;
end;

procedure TDsnRegister.CallPopupMenu(Client:TWinControl; Target:TControl; XPos,YPos: Integer);
var
  ContextProps:TContextProps;
  i:integer;
  Point:TPoint;
  DsnMenuItem: TDsnMenuItem;
begin
  RButtonDown(Client, Target, XPos,YPos);
  if not Assigned(FContextMenu) then
    Exit;

  if not Assigned(FTargetList) then
    Exit;

  ContextProps:= TContextProps.Create;
  ContextProps.CreateTable(FDsnStage.SelfProps,FDsnStage.OutProps,FTargetList.List);

  for i:= 0 to FContextMenu.Items.Count - FContextMenu.Tag -1 do
    FContextMenu.Items.Delete(FContextMenu.Tag);

  if FContextMenu.Items.Count > 0 then
  begin
    DsnMenuItem:= TDsnMenuItem.Create(Owner);
    DsnMenuItem.Caption:= '-';
    FContextMenu.Items.Add(DsnMenuItem);
  end;

  for i:= 0 to ContextProps.PropList.Count -1 do
  begin
    DsnMenuItem:= TDsnMenuItem.Create(Owner);
    DsnMenuItem.Caption:= ContextProps.Caption[i];
    FContextMenu.Items.Add(DsnMenuItem);
    DsnMenuItem.OnClick:= MenuMethod;
    DsnMenuItem.PropName:= ContextProps.PropList[i];
    DsnMenuItem.Value:= ContextProps.ValueList[i];
  end;

  if Assigned(FDsnStage.FOnPopup) then
    FDsnStage.FOnPopup(FContextMenu);

  Point.x:= Client.Left;
  Point.y:= Client.Top;
  Point:= Client.Parent.ClientToScreen(Point);
  FContextMenu.PopUp(XPos+Point.x,YPos+Point.y);

  ContextProps.Free;
end;

procedure TDsnRegister.GiveName(Component: TComponent);
var
  S1,S2: String;
  n:integer;
begin
  S1:= Component.ClassName;
  System.Delete(S1,1,1);
  n:=1;
  S2:=S1 + '1';
  while Owner.FindComponent(S2) <> nil do
  begin
    Inc(n);
    S2:=S1 + IntToStr(n);
  end;
  Component.Name:=S2;
end;

procedure TDsnRegister.CreateHandler;
begin
  FHandler:= TMultiHandler.Create;
end;

function TDsnRegister.CreateProps:TMultiProps;
begin
  Result:= TMultiProps.Create;
end;

procedure TDsnRegister.CreateCopyShape;
begin
  FShape:= TMultiShape.Create;
end;

procedure TDsnRegister.CreateMoveShape;
begin
  if Assigned(FShape) then
  begin
    FShape.DrowUp;
    FShape.Free;
  end;
  FShape:= TMultiShape.Create;
end;

function TDsnRegister.CreateDsnList:TDsnList;
begin
  Result:= TDsnList.Create;
end;

function TDsnRegister.CreateList:TTargetList;
var
  InspectList:TStringList;
  CaptionList:TStringList;