📄 dsnunit.pas

📁 DELPHI编写的商场收银POS机源代码
💻 PAS
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34
  end;

  inherited ;

end;

function TDsnStage.GetCanCopy:Boolean;
begin
  Result:= False;
  if Assigned(FDsnRegister) then
    Result:= FDsnRegister.CanCopy;
end;

function TDsnStage.GetCanPaste:Boolean;
begin
  Result:= False;
  if Assigned(FDsnRegister) then
    Result:= FDsnRegister.CanPaste;
end;

procedure TDsnStage.Delete;
begin
  if Assigned(FDsnRegister) then
    FDsnRegister.Delete;
end;

procedure TDsnStage.Cut;
begin
  if Assigned(FDsnRegister) then
    FDsnRegister.Cut;
end;

procedure TDsnStage.Copy;
begin
  if Assigned(FDsnRegister) then
    FDsnRegister.Copy;
end;

procedure TDsnStage.Paste;
begin
  if Assigned(FDsnRegister) then
    FDsnRegister.Paste;
end;

procedure TDsnStage.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = FCoverMenu then
      FCoverMenu := nil;
end;

procedure TDsnStage.SaveToFile(FileName:String);
var
  FS:TStream;
  WR:TWriter;
  i:integer;
begin
  if Assigned(FDsnRegister) then
    FDsnRegister.ClearSelect;

  FS:=TFileStream.Create(FileName, fmCreate);
  try
    WR:=TWriter.Create(FS,4096);
    try
      for i:=0 to ControlCount-1 do
      begin
        WriteComponents(FS,Controls[i]);
        WR.WriteListEnd;
      end;
    finally
      WR.Free;
    end;
  finally
    FS.Free;
  end;
end;

procedure TDsnStage.SaveToStream(Stream:TStream);
var
  WR:TWriter;
  i:integer;
begin
  if Assigned(FDsnRegister) then
    FDsnRegister.ClearSelect;

  WR:=TWriter.Create(Stream,4096);
  try
    for i:=0 to ControlCount-1 do
      WriteComponents(Stream,Controls[i]);

    WR.WriteListEnd;

  finally
    WR.Free;
  end;
end;

procedure TDsnStage.LoadFromFile(FileName:String);
var
  FS:TStream;
  Flag: Boolean;
begin
  {if Designing then
    Raise Exception.Create(STG_ERRORREAD); }

  Flag:= False;
  if Assigned(FDsnRegister) then
  begin
    if FDsnRegister.Designing then
      Flag:= True;
    FDsnRegister.SetDesigning(False);
  end;

  try
    FS:=TFileStream.Create(FileName, fmOpenRead);
    try
      ReadComponents(FS);
    finally
      FS.Free;
    end;
  except
    Raise Exception.Create(FileName+ STG_ERRORREADFILE);
  end;

  if Flag then
    FDsnRegister.SetDesigning(True);
end;

procedure TDsnStage.LoadFromStream(Stream:TStream);
var
  Flag: Boolean;
begin
 { if Designing then
    Raise Exception.Create(STG_ERRORREAD);}

  Flag:= False;
  if Assigned(FDsnRegister) then
  begin
    if FDsnRegister.Designing then
      Flag:= True;
    FDsnRegister.SetDesigning(False);
  end;

  ReadComponents(Stream);

  if Flag then
    FDsnRegister.SetDesigning(True);
end;

procedure TDsnStage.ComponentsProc(Component:TComponent);
begin
end;

procedure TDsnStage.WriteComponents(Stream:TStream;Control:TControl);
var
  WR:TWriter;
begin
  WR:=TWriter.Create(Stream,4096);
  try
    WR.RootAncestor := nil;
    WR.Ancestor := nil;
    WR.Root := Owner;
    WR.WriteSignature;
    WR.WriteComponent(Control);
  finally
    WR.Free;
  end;
end;

procedure TDsnStage.ReadComponents(Stream:TStream);
var
  RD:TReader;
  i:integer;
begin
  for i:=ControlCount-1 downto 0 do begin
    Controls[i].Free;
  end;
  RD:=TReader.Create(Stream,4096);
  try
    RD.OnError:=ReadError;
    RD.OnFindMethod:=FindMethod;
    RD.OnSetName:=CheckName;
    RD.Position:=0;
    RD.ReadComponents(Owner,Self,ComponentsProc);
  finally
    RD.Free;
  end;
end;

procedure TDsnStage.CheckName(Reader:TReader; Component:TComponent; var Name:String);
begin
  DsnCheckName(Owner,Reader,Component,Name);
  if Assigned(FOnControlLoading) then
    FOnControlLoading(Self, Component);
  PostMessage(Handle, DS_LOADED, Integer(Component),0)
end;

procedure TDsnStage.ReadError(Reader: TReader; const Message: string; var Handled: Boolean);
begin
  Handled:=True;
end;

procedure TDsnStage.FindMethod(Reader: TReader; const MethodName: string;
               var Address: Pointer; var Error: Boolean);
begin
  if Error then
  begin
    Address:=nil;
    Error:=False;
  end;   
end;

procedure TDsnStage.ControlCreated(var Message: TMessage);
var
  Component:TComponent;
begin
  Component:= TComponent(Message.WParam);
  if Assigned(OnControlCreate) then
    OnControlCreate(Self, Component);
end;

procedure TDsnStage.ControlLoaded(var Message: TMessage);
var
  Component:TComponent;
begin
  Component:= TComponent(Message.WParam);
  if Assigned(OnControlLoaded) then
    OnControlLoaded(Self, Component);
end;

{TDsnCtrl}
constructor TDsnCtrl.CreateInstance(AClient: TWinControl);
begin
  inherited CreateInstance(AClient);
  ClientDeath:= False;
end;

procedure TDsnCtrl.TakeInstance;
begin
  if Assigned(Client) then
  begin
    Client.Cursor:= crArrow;
    Client.Invalidate;
  end;
end;

procedure TDsnCtrl.ReleaseInstance;
begin
  if (Assigned(Client)) and (not ClientDeath) then
  begin
    Client.Cursor:= crDefault;
    Client.Invalidate;
  end;
end;

procedure TDsnCtrl.ClientMouseDown(var Message: TWMMouse);
var
  Shift: TShiftState;
begin
  FMousePoint := Point(Message.XPos, Message.YPos);
  FTarget := nil;
  FTarget := Client.ControlAtPos(FMousePoint, TRUE);
  if FTarget = nil then
    FTarget := Client;

  if FTarget.Owner <> Client.Owner then
    FTarget := Client;  // For Like DBNavigator

  Shift:= KeysToShiftState(Message.Keys);

  SetCapture(Client.Handle);
  FDsnRegister.MouseDown(Client, FTarget, FMousePoint, Shift);
  FDsnRegister.FDsnStage.SetFocus;
end;

procedure TDsnCtrl.ClientMouseMove(var Message: TWMMouse);
var
  Shift: TShiftState;
begin
  FMousePoint := Point(Message.XPos, Message.YPos);
  Shift:= KeysToShiftState(Message.Keys);

  if Assigned(FTarget)then
    FDsnRegister.MoseMove(Client, FMousePoint, Shift);
end;

procedure TDsnCtrl.ClientMouseUp(var Message: TWMMouse);
var
  Shift: TShiftState;
begin
  FMousePoint := Point(Message.XPos, Message.YPos);
  Shift:= KeysToShiftState(Message.Keys);

  if Assigned(FTarget)then
    FDsnRegister.MoseUp(Client, FMousePoint, Shift);
  ReleaseCapture;
end;

procedure TDsnCtrl.ClientCaptureChanged(var Message: TMessage);
begin
  //FTarget := nil;
end;

procedure TDsnCtrl.ClientPaint(var Message: TWMPaint);
begin
  with TMessage(Message) do Client.Perform(Msg, wParam, lParam);
end;

procedure TDsnCtrl.ClientWndProc(var Message: TMessage);
var
  r:integer;
begin
  case(Message.Msg)of
    WM_LBUTTONDOWN: 
    begin 
     r:= SendMessage(Client.Handle,CM_DESIGNHITTEST,
              TMessage(Message).WParam,TMessage(Message).LParam);
     if r = 1 then
        with Message do  // for PageControl's Tab
          Result := CallWindowProc(DefClientProc, Client.Handle,
                                 Msg, WParam, LParam)
     else;
       ClientMouseDown(TWMMouse(Message));
    end;
    WM_LBUTTONUP: ClientMouseUp(TWMMouse(Message));
    WM_MOUSEMOVE: ClientMouseMove(TWMMouse(Message));
    WM_RBUTTONDOWN: ClientContextMenu(TWMMouse(Message));
    WM_CAPTURECHANGED: ClientCaptureChanged(Message);
    WM_PAINT: ClientPaint(TWMPaint(Message));
    RM_START: ClientPreResize(TMessage(Message));
    RM_FINISH: ClientResize(TResizeMessage(Message));
    MH_SELECT: ClientSelect(TMessage(Message));
    CI_SELECT: ClientSelectByInspect(TMessage(Message));
    WM_SETFOCUS:ClientSetFocus(TMessage(Message));
    WM_DESTROY:ClientHandleChange(TMessage(Message));
    WM_LBUTTONDBLCLK:ClientDbClick(TWMMouse(Message));
    WM_NCHITTEST:Message.Result:= HTCLIENT;
    else
      with Message do
        Result := CallWindowProc(DefClientProc, Client.Handle,
                                 Msg, WParam, LParam); 
  end;
end;

procedure TDsnCtrl.ClientDbClick(var Message: TWMMouse);
begin
  FDsnRegister.DbClick(FTarget,TWMMouse(Message));
end;

procedure TDsnCtrl.ClientContextMenu(var Message: TWMMouse);
begin
  TMessage(Message).WParam:= 0;
  FMousePoint := Point(Message.XPos, Message.YPos);
  FTarget := nil;
  FTarget := Client.ControlAtPos(FMousePoint, TRUE);
  if FTarget = nil then
    FTarget := Client;

  if FTarget.Owner <> Client.Owner then
    FTarget := Client;  // For Like DBNavigator

  SetCapture(Client.Handle);
  FDsnRegister.CallPopupMenu(Client, FTarget, Message.XPos, Message.YPos);
  FDsnRegister.FDsnStage.SetFocus;
end;

procedure TDsnCtrl.ClientHandleChange(var Message: TMessage);
begin
  EndSubClassing;

  with Message do
    Result := CallWindowProc(DefClientProc, Client.Handle,
                           Msg, WParam, LParam);
  PostMessage(FDsnRegister.FDsnStage.Handle, AG_DESTROY, Integer(Self),0);
end;

procedure TDsnCtrl.ClientPreResize(var Message: TMessage);
begin
  FTarget:= TControl(Message.WParam);
end;

procedure TDsnCtrl.ClientResize(var Message: TResizeMessage);
begin
  FDsnRegister.Resized(FTarget,Message);
end;

procedure TDsnCtrl.ClientSelect(var Message: TMessage);
begin
  FDsnRegister.Selected(FTarget,Message);
end;

procedure TDsnCtrl.ClientSelectByInspect(var Message: TMessage);
begin
  FDsnRegister.SelectByInspect(TControl(Message.WParam));
end;

procedure TDsnCtrl.ClientSetFocus(var Message: TMessage);
begin
  if not (Client is TDsnStage) then
    FDsnRegister.FDsnStage.SetFocus
  else
    with Message do
      Result := CallWindowProc(DefClientProc, Client.Handle,
                                 Msg, WParam, LParam);
end;

{TDsnSwitch}
procedure TDsnSwitch.SetDsnRegister(Value:TDsnRegister);
begin
  if Assigned(Value) then
    FDsnRegister:= Value
  else
    FDsnRegister:= nil;
end;

procedure TDsnSwitch.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = FDsnRegister then FDsnRegister := nil;
end;

constructor TDsnSwitch.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DsnMessageFlg:=False;
  DsnMessage:= DSNMES_START;
end;

procedure TDsnSwitch.Loaded;
begin
  inherited;
  GroupIndex:=DsnSwc_GrpIdx;
  AllowAllUp:=True;
end;

procedure TDsnSwitch.Click;
begin
  if Down and DsnMessageFlg then
    ShowMessage(DsnMessage);

  if FDsnRegister <> nil then
    FDsnRegister.SetDesigning(Down);

  inherited;
end;

procedure TDsnSwitch.DesignOn;
begin
  if not Down then
  begin
    Down:= True;
    Click;
  end;

end;

procedure TDsnSwitch.DesignOff;
begin
  if Down then
  begin
    Down:= False;
    Click;
  end;

end;


{ TDsnPartner }

function TDsnPartner.CheckCanSelect(Control: TControl): Boolean;
begin
  if FDsnRegister <> nil then
    Result:= FDsnRegister.CheckCanSelect(Control)
  else
    Result:= False;
end;

constructor TDsnPartner.Create(AOwner: TComponent);
begin
  inherited;
  FDesigning:= False;
end;

procedure TDsnPartner.CreateMoveShape;
var
  i: integer;
begin
  if FDsnRegister <> nil then
  begin
    FDsnRegister.CreateMoveShape;
    FDsnRegister.FShape.Color:= FDsnRegister.Color;
    FDsnRegister.FShape.PenWidth:= FDsnRegister.PenWidth;
    for i:= 0 to FDsnRegister.FTargetList.Count -1 do
      FDsnRegister.FShape.Add(FDsnRegister.FTargetList[i]);
  end;
end;

procedure TDsnPartner.CreateTargetList;
begin
  if FDsnRegister <> nil then
    FDsnRegister.FTargetList:= FDsnRegister.CreateList;
end;

function TDsnPartner.GetDsnList: TDsnList;
begin
  if FDsnRegister <> nil then
    Result:= FDsnRegister.FDsnCtrlList
  else
    Result:= nil;
end;

function TDsnPartner.GetTargetList: TTargetList;
begin
  if FDsnRegister <> nil then
    Result:= FDsnRegister.FTargetList
  else
    Result:= nil;
end;

procedure TDsnPartner.SetDesigning(Value: Boolean);
begin
  if Value <> FDesigning then
    FDesigning:= Value;
end;

procedure TDsnPartner.SetDsnRegister(Value: TDsnRegister);
begin
  if Assigned(Value) then
  begin
    FDsnRegister:=Value;
    FDsnRegister.FreeNotification(Self);
    FDsnRegister.AddPartners(Self);
  end
  else
    FDsnRegister:=nil;
end;



procedure Register;
begin
  RegisterComponents('DsnSys', [TDsnSwitch]);
  RegisterComponents('DsnSys', [TDsnStage]);
  RegisterComponents('DsnSys', [TDsnPanel]);
  RegisterComponents('DsnSys', [TDsnInspector]);
  RegisterComponents('DsnSys', [TDsnRegister]);
  RegisterComponents('DsnSys', [TDsnDpRegister]);
  RegisterComponents('DsnSys', [TDsnRSRegister]);
  RegisterComponents('DsnSys', [TDsnClRegister]);
  RegisterComponents('DsnSys', [TDsnSelect]);
end;
initialization
  RegisterClass(TDsnButton);
  RegisterClass(TArrowButton);
 
end.
上一页 1 2 34
💿 文件大小 6972 K
👤 上传用户 hudun2006
📂 所属分类 SQL Server
🏷️ 相关标签

#DELPHI #POS #编写 #商
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -