⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ucontrolsviewf.pas

📁 一套功能非常丰富的图书管理系统
💻 PAS
字号:
unit uControlsViewF;

interface

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls, SysHook, Menus;

type
  TControlsViewF = class(TFrame)
    Button2: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    CheckBox1: TCheckBox;
    ListView1: TListView;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    StaticText5: TStaticText;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    S1: TStaticText;
    S2: TStaticText;
    S3: TStaticText;
    S4: TStaticText;
    S5: TStaticText;
    StaticText6: TStaticText;
    S6: TStaticText;
    TabSheet3: TTabSheet;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Button1: TButton;
    Button3: TButton;
    Button4: TButton;
    TabSheet4: TTabSheet;
    GroupBox2: TGroupBox;
    ListBox1: TListBox;
    GroupBox3: TGroupBox;
    StaticText7: TStaticText;
    StaticText8: TStaticText;
    StaticText9: TStaticText;
    GroupBox4: TGroupBox;
    StaticText10: TStaticText;
    Edit3: TEdit;
    Edit4: TEdit;
    StaticText11: TStaticText;
    StaticText12: TStaticText;
    Button5: TButton;
    Edit5: TEdit;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Edit6: TEdit;
    StaticText13: TStaticText;
    StaticText14: TStaticText;
    StaticText15: TStaticText;
    Edit9: TEdit;
    StaticText16: TStaticText;
    Edit10: TEdit;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    SysHook1: TSysHook;
    GroupBox5: TGroupBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    GroupBox6: TGroupBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    procedure Button2Click(Sender: TObject);
    procedure SysHook1MouseDown(Button: TMouseButton; WinHandle: HWND; X,
      Y: Integer);
    procedure CheckBox1Click(Sender: TObject);
    procedure SysHook1MouseUp(Button: TMouseButton; WinHandle: HWND; X,
      Y: Integer);
    procedure SysHook1KeyDown(Key: Word; Winhandle: HWND);
    procedure SysHook1KeyUp(Key: Word; Winhandle: HWND);
    procedure SysHook1MouseMove(X, Y: Integer);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
    GetMe : boolean;
    DrawType : integer;
    Drawing : boolean;
    pFrom , pTo , pTemp : TPoint;
    DC : HDC;
    DCMode : integer;
    WinHND : HWND;
    itsProID : DWORD;//本程序的进程号
    MsgList : TStringList;
    procedure TranslateMsgList(AMsgList : TStringList);
  public
    { Public declarations }
    constructor Create(AOwner :TComponent);override;
  end;

var
  ControlsViewF : TControlsViewF;

implementation

uses uMainF;

{$R *.dfm}

procedure TControlsViewF.Button2Click(Sender: TObject);
begin
  Parent := nil;
  MainF.Caption := '图书管理系统';
end;

procedure TControlsViewF.SysHook1MouseDown(Button: TMouseButton;
  WinHandle: HWND; X, Y: Integer);
var
  hIns , ProID : DWORD;
begin
  hIns := SysHook1.GetInstance(WinHandle);
  ProID := SysHook1.GetProcess(WinHandle);
  if not ((not GetMe)and(ProID=itsProID)) then
  begin
    if CheckBox2.Checked then
    begin
      with ListView1.Items.Add do
      begin
        Caption := IntToStr(WinHandle);
        SubItems.Add(SysHook1.GetWinClassName(WinHandle));
        SubItems.Add(IntToStr(ProID));
        SubItems.Add(SysHook1.GetProcessInfo(ProID).szExeFile);
        SubItems.Add(IntToStr(hIns));
        if Button = mbLeft then
          SubItems.Add('左键(按下)');
        if Button = mbRight then
          SubItems.Add('右键(按下)');
        if Button = mbMiddle then
          SubItems.Add('中键(按下)');
      end;
    end;
    if not Drawing then
    begin
      if Button = mbLeft then
      begin
        DC := GetWindowDC(WinHandle);
        WinHND := WinHandle;
        DCMode := GetROP2(DC);
        if DrawType<>0 then
        begin
          pFrom.X := X;
          pFrom.Y := Y;
          pTemp.X := X;
          pTemp.Y := Y;
          pTo.X := X;
          pTo.Y := Y;
          Windows.ScreenToClient(WinHND,pFrom);
          Windows.ScreenToClient(WinHND,pTemp);
          Windows.ScreenToClient(WinHND,pTo);
          MoveToEx(DC,pFrom.X,pFrom.Y,nil);
        end;
        if not((DrawType=3)or(DrawType=0)) then
          SetROP2(DC,R2_NOTXORPEN);
      end;
      Drawing := True;
    end;
  end;  
end;

procedure TControlsViewF.CheckBox1Click(Sender: TObject);
begin
  GetMe := CheckBox1.Checked;
end;

constructor TControlsViewF.Create(AOwner: TComponent);
begin
  inherited;
  GetMe := False;
  DrawType := 0;
  Drawing := False;
  itsProID := SysHook1.GetProcess(Application.MainForm.Handle);
  MsgList := TStringList.Create;
  try
    MsgList.LoadFromFile('MessageList\MsgList.txt');
    TranslateMsgList(MsgList);
  except
    MsgList.Clear;
  end;
end;

procedure TControlsViewF.SysHook1MouseUp(Button: TMouseButton;
  WinHandle: HWND; X, Y: Integer);
var
  hIns , ProID : DWORD;
begin
  hIns := SysHook1.GetInstance(WinHandle);
  ProID := SysHook1.GetProcess(WinHandle);
  if not ((not GetMe)and(ProID=itsProID)) then
  begin
    if CheckBox3.Checked then
    begin
      with ListView1.Items.Add do
      begin
        Caption := IntToStr(WinHandle);
        SubItems.Add(SysHook1.GetWinClassName(WinHandle));
        SubItems.Add(IntToStr(ProID));
        SubItems.Add(SysHook1.GetProcessInfo(ProID).szExeFile);
        SubItems.Add(IntToStr(hIns));
        if Button = mbLeft then
          SubItems.Add('左键(放开)');
        if Button = mbRight then
          SubItems.Add('右键(放开)');
        if Button = mbMiddle then
          SubItems.Add('中键(放开)');
      end;
    end;
    if Drawing then
    begin
      if Button = mbLeft then
      begin
        if DrawType=1 then
        begin
          pTo.X := X;
          pTo.Y := Y;
          Windows.ScreenToClient(WinHND,pTo);
          MoveToEx(DC,pFrom.X,pFrom.Y,nil);
          LineTo(DC,pTemp.X,pTemp.Y);
          MoveToEx(DC,pFrom.X,pFrom.Y,nil);
          SetROP2(DC,R2_COPYPEN	);
          LineTo(DC,pTo.X,pTo.Y);
          pTemp := pTo;
        end;
        if DrawType =2 then
        begin
          pTo.X := X;
          pTo.Y := Y;
          Windows.ScreenToClient(WinHND,pTo);
          MoveToEx(DC,pFrom.X,pFrom.Y,nil);
          Arc(DC,pFrom.X,pFrom.Y,pTemp.X,pTemp.Y,pFrom.X,pFrom.Y,pTemp.X,pTemp.Y);
          MoveToEx(DC,pFrom.X,pFrom.Y,nil);
          SetROP2(DC,R2_BLACK);
          Arc(DC,pFrom.X,pFrom.Y,pTemp.X,pTemp.Y,pFrom.X,pFrom.Y,pTemp.X,pTemp.Y);
          pTemp := pTo;
        end;
        if DrawType =3 then
        begin
          pTo.X := X;
          pTo.Y := Y;
          Windows.ScreenToClient(WinHND,pTo);
          LineTo(DC,pTo.X,pTo.Y);
        end;
        SetROP2(DC,DCMode);

      end;
      Drawing := False;
    end;
  end;  
end;

procedure TControlsViewF.SysHook1KeyDown(Key: Word; Winhandle: HWND);
var
  hIns , ProID : DWORD;
begin
  if CheckBox4.Checked then
  begin
    hIns := SysHook1.GetInstance(WinHandle);
    ProID := SysHook1.GetProcess(WinHandle);
    if not ((not GetMe)and(ProID=itsProID)) then
    begin
      S1.Caption := IntToStr(WinHandle);
      S2.Caption := IntToStr(ProID);
      S3.Caption := IntToStr(hIns);
      S4.Caption := SysHook1.GetWinClassName(WinHandle);
      S5.Caption := SysHook1.GetProcessInfo(ProID).szExeFile;
      S6.Caption := '按下';
      GroupBox1.Caption := 'AscII码为('+IntToStr(Key)+')字符内容';
      if Key = 13 then
        Memo1.Text := Memo1.Text+char(10)
      else Memo1.Text := Memo1.Text+char(Key);
    end;
  end;  
end;

procedure TControlsViewF.SysHook1KeyUp(Key: Word; Winhandle: HWND);
var
  hIns , ProID : DWORD;
begin
  if CheckBox5.Checked then
  begin
    hIns := SysHook1.GetInstance(WinHandle);
    ProID := SysHook1.GetProcess(WinHandle);
    if not ((not GetMe)and(ProID=itsProID)) then
    begin
      S1.Caption := IntToStr(WinHandle);
      S2.Caption := IntToStr(ProID);
      S3.Caption := IntToStr(hIns);
      S4.Caption := SysHook1.GetWinClassName(WinHandle);
      S5.Caption := SysHook1.GetProcessInfo(ProID).szExeFile;
      S6.Caption := '放开';
      GroupBox1.Caption := 'AscII码为('+IntToStr(Key)+')字符内容';
      if Key = 13 then
        Memo1.Text := Memo1.Text+char(10)
      else Memo1.Text := Memo1.Text+char(Key);
    end;
  end;
end;

procedure TControlsViewF.SysHook1MouseMove(X, Y: Integer);
begin
  if Drawing then
  begin
    if DrawType = 1 then
    begin
      pTo.X := X;
      pTo.Y := Y;
      Windows.ScreenToClient(WinHND,pTo);
      MoveToEx(DC,pFrom.X,pFrom.Y,nil);
      LineTo(DC,pTemp.X,pTemp.Y);
      MoveToEx(DC,pFrom.X,pFrom.Y,nil);
      LineTo(DC,pTo.X,pTo.Y);
      pTemp := pTo;
    end;
    if DrawType = 2 then
    begin
      pTo.X := X;
      pTo.Y := Y;
      Windows.ScreenToClient(WinHND,pTo);
      MoveToEx(DC,pFrom.X,pFrom.Y,nil);
      Ellipse(DC,pFrom.X,pFrom.Y,pTemp.X,pTemp.Y);
      MoveToEx(DC,pFrom.X,pFrom.Y,nil);
      Ellipse(DC,pFrom.X,pFrom.Y,pTo.X,pTo.Y);
      pTemp := pTo;
    end;
    if DrawType =3 then
    begin
      pTo.X := X;
      pTo.Y := Y;
      Windows.ScreenToClient(WinHND,pTo);
      LineTo(DC,pTo.X,pTo.Y);
    end;
  end;
end;

procedure TControlsViewF.RadioButton2Click(Sender: TObject);
begin
  DrawType := 1;
end;

procedure TControlsViewF.RadioButton3Click(Sender: TObject);
begin
  DrawType := 2;
end;

procedure TControlsViewF.RadioButton4Click(Sender: TObject);
begin
  DrawType := 3;
end;

procedure TControlsViewF.RadioButton1Click(Sender: TObject);
begin
  DrawType := 0;
end;

procedure TControlsViewF.Button1Click(Sender: TObject);
begin
  if SysHook1.Enabled then
  begin
    SysHook1.Enabled := False;
    Button1.Caption := '监听';
  end
  else begin
    SysHook1.Enabled := True;
    Button1.Caption := '暂停';
  end;
end;

procedure TControlsViewF.Button3Click(Sender: TObject);
begin
  ListView1.Items.Clear;
end;

procedure TControlsViewF.Button4Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

procedure TControlsViewF.Button5Click(Sender: TObject);
begin
  if ComboBox1.Text = '' then
    if MessageBox(0,'消息名为空,是否继续?','警告',MB_YESNO or MB_ICONWARNING) = IDNO then
      Abort;
  try
    StrToInt(ComboBox2.Text);
  except
    MessageBox(0,'消息值输入错误','错误',MB_OK or MB_ICONERROR);
    Abort;
  end;
  if ComboBox1.Enabled then
  begin
    MsgList.Add(ComboBox1.Text+'/'+ComboBox2.Text+'/'+
              ComboBox3.Text+'/'+ComboBox4.Text);
    try
      MsgList.SaveToFile('MessageList\MsgList.txt');
      ListBox1.Items.Add(ComboBox1.Text);
      ComboBox1.Items.Add(ComboBox1.Text);
      ComboBox2.Items.Add(ComboBox2.Text);
      ComboBox3.Items.Add(ComboBox3.Text);
      ComboBox4.Items.Add(ComboBox4.Text);
      ComboBox1.Enabled := False;
      ComboBox1.Color := clBtnFace;
    except
      MessageBox(0,'保存数据失败','错误',MB_OK or MB_ICONERROR);
    end;
  end;
  if (not ComboBox1.Enabled)and(ListBox1.ItemIndex <> -1) then
  begin
    MsgList.Strings[ListBox1.ItemIndex] := ComboBox1.Text+'/'+ComboBox2.Text+'/'+
              ComboBox3.Text+'/'+ComboBox4.Text;
    try
      MsgList.SaveToFile('MessageList\MsgList.txt');
      ComboBox1.Items.Strings[ListBox1.ItemIndex]:=(ComboBox1.Text);
      ComboBox2.Items.Strings[ListBox1.ItemIndex]:=(ComboBox2.Text);
      ComboBox3.Items.Strings[ListBox1.ItemIndex]:=(ComboBox3.Text);
      ComboBox4.Items.Strings[ListBox1.ItemIndex]:=(ComboBox4.Text);
    except
      MessageBox(0,'保存数据失败','错误',MB_OK or MB_ICONERROR);
    end;
  end;
end;

procedure TControlsViewF.TranslateMsgList(AMsgList: TStringList);
var
  Index : integer;
  MsgName , MsgWord,MsgLParam,MsgWParam: string;
  Msg : string;
  Position, ParamCount : integer;
begin
  for Index := 0 to AMsgList.Count-1 do
  begin
    MsgName := '';
    MsgWord := '';
    MsglParam := '';
    MsgWParam := '';
    Msg := AMsgList.Strings[Index];
    ParamCount := 0;
    for Position := 1 to Length(Msg) do
    begin
      if Msg[Position]<>'/' then
      begin
        if ParamCount = 0 then
          MsgName := MsgName+Msg[Position];
        if ParamCount = 1 then
          MsgWord := MsgWord+Msg[Position];
        if ParamCount = 2 then
          MsgLParam := MsgLParam+Msg[Position];
        if ParamCount = 3 then
          MsgWParam := MsgWParam+Msg[Position];
      end
      else Inc(ParamCount);
    end;
    ListBox1.Items.Add(MsgName);
    ComboBox1.Items.Add(MsgName);
    ComboBox2.Items.Add(MsgWord);
    ComboBox3.Items.Add(MsgLParam);
    ComboBox4.Items.Add(MsgWParam);
  end;
end;

procedure TControlsViewF.ListBox1Click(Sender: TObject);
begin
  ComboBox1.ItemIndex := ListBox1.ItemIndex;
  ComboBox2.ItemIndex := ListBox1.ItemIndex;
  ComboBox3.ItemIndex := ListBox1.ItemIndex;
  ComboBox4.ItemIndex := ListBox1.ItemIndex;
  Edit3.Text := ComboBox1.Text;
  Edit6.Text := ComboBox2.Text;
  Edit9.Text := '0';
  Edit10.Text := '0';
end;

procedure TControlsViewF.Button8Click(Sender: TObject);
var
  lpResult : DWORD;
begin
  try
    StrToInt(Edit9.Text);
  except
    MessageBox(0,'lParam参数错误','错误',MB_ICONERROR or MB_OK);
    Abort;
  end;
  try
    StrToInt(Edit10.Text);
  except
    MessageBox(0,'wParam参数错误','错误',MB_ICONERROR or MB_OK);
    Abort;
  end;
  lpResult := SendMessage(StrToInt(Edit4.Text),StrToInt(Edit6.Text),
                          MAKELPARAM(100,100),MAKELPARAM(100,100)); //,StrToInt(Edit9.Text));
  Edit5.Text := IntToStr(lpResult);
end;

procedure TControlsViewF.Button6Click(Sender: TObject);
begin
  MsgList.Delete(ListBox1.ItemIndex);
  ListBox1.Items.Delete(ListBox1.ItemIndex);
  MsgList.SaveToFile('MessageList\MsgList.txt');
end;

procedure TControlsViewF.Button7Click(Sender: TObject);
begin
  ComboBox1.Text := '';
  ComboBox2.Text := '0';
  ComboBox3.Text := '';
  ComboBox4.Text := '';
  ComboBox1.Enabled := True;
  ComboBox1.Color := clWindow;
end;

end.

⌨️ 快捷键说明

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