mainpas.pas

特别方便的工具程序

begin
  S := TStringList.Create;
  MyGetImeList(S);
  ListView1.Clear;
  for i := 0 to S.Count - 1 do
    with ListView1.Items.Add do Caption := S[I];
  ListView1.Show;
end;

procedure TA00Form.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
//var iRow, iCol: integer;
begin
{  iRow := SendMessage(Memo1.Handle,
    EM_LINEFROMCHAR, Memo1.SelStart, 0);
  iCol := Memo1.SelStart -
    SendMessage(Memo1.Handle, EM_LINEINDEX, iRow, 0);
  Caption := '行：' + IntToStr(iRow + 1)
    + ' ，列' + IntToStr(iCol + 1);
  Memo1.SetFocus;
  exit;
  Memo1.Lines.Add('123xxxxxxxxxxxxxdddddddddddd');
  Memo1.SelStart := length(Memo1.text);
//   滚动到可以见的位置
  SendMessage(Memo1.Handle, EM_SCROLLCARET, 0, 0);
}
end;

procedure TA00Form.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CanMove := True;
  if button = mbLeft then begin
    ReleaseCapture;
    Perform(wm_SYSCommand, SC_MOVE + 1, 0);
  end;
  CanMove := False;
//   SC_CLOSE; SC_MOVE;
end;

procedure TA00Form.SetMouse(Sender: TObject);
var
  R: TRect;
begin
  if Sender = LimitMouse then begin
    R := Rect(0, 0, 100, 100);
    MapWindowPoints(Handle, 0, R, 2); // 座标换算
  end else if Sender = RelaxMouse then
    R := Rect(0, 0, Screen.Width, Screen.Height);
  ClipCursor(@R); // 设置鼠标移动区域
end;

procedure TA00Form.N15Click(Sender: TObject);
var
  hWindow: HWnd;
  szText: array[0..255] of char;
  CName: array[0..255] of char;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  hWindow := GetWindow(Handle, GW_HWNDFIRST);
  while hWindow <> 0 do begin
    if GetWindowText(hWindow, szText, 255) > 0 then
      with ListView1.Items.Add do begin
        GetClassName(hWindow, @CName, 254);
        Caption := CName;
        SubItems.Add(szText);
        SubItems.Add(IntToStr(hWindow));
      end;
    hWindow := GetWindow(hWindow, GW_HWNDNEXT);
  end;
  ListView1.Items.EndUpdate;
  ListView1.Show;
end;

function ENumWind(AHWnd: HWnd; LPARAM: lParam): boolean; stdcall;
{var
  WndCaption: array[0..254] of char;
  WndClassName: array[0..254] of char;
  S: string;}
begin
{  Result := False;
  GetWindowText(AHWnd, @WndCaption, 254);
  GetClassName(AHWnd, @WndClassName, 254);
  if ENumChildWindows(AHwnd, @ENumWind, 0) then
    with ListView1.Items do
    begin
      if WndCaption = '' then WndCaption := '[ 无标题 ]';
      S := format('类：%-20s，窗口标题：%20s，类编号：%d',
        [StrPas(WndClassName), StrPas(WndCaption), AHwnd]);
      if IndexOf(S) = -1 then Add(S);
    end;
  Result := True;}
end;

procedure TA00Form.N16Click(Sender: TObject);
begin
  EnumWindows(@ENumWind, 0);
end;

procedure TA00Form.N17Click(Sender: TObject);
var
  i, j: Word;
begin
  for i := 1 to 255 do
    for j := 1 to 255 do
end;

procedure TA00Form.N18Click(Sender: TObject);
begin
  Brush.Style := bsSolid;
  Brush.Color := clSilver;
//  Repaint; 两种方法
//  Perform(CM_INVALIDATE, 0, 0);
  invalidate;
  UpdateWindow(Handle);
end;

procedure TA00Form.SetWinRgn(Sender: TObject);
var
  R: HRgn;
begin
  R := CreateEllipticRgn(1, 1, 200, 200);
  SetWindowRgn(Handle, R, False);
end;

procedure TA00Form.PrintTable(Sender: TObject);
begin
  Application.CreateForm(TPrintTBForm, PrintTBForm);
  PrintTBForm.Showmodal;
  PrintTBForm.Free;
end;

procedure TA00Form.F1Book1Click(Sender: TObject);
begin
  Application.CreateForm(TBookForm, BookForm);
  BookForm.Showmodal;
  BookForm.Free;
end;

procedure TA00Form.N19Click(Sender: TObject);
var
  I, M, N: THandle;
  Buffer: array[0..79] of Char;
  P: MenuItemInfo;
begin
  M := GetSystemMenu(Handle, False);

  P.cbSize := 44; // Required for Windows 95
  P.fMask := MIIM_TYPE;
  P.dwTypeData := Buffer;
  P.cch := SizeOf(Buffer);
  if not GetMenuItemInfo(M, 4, True, P) then Showmessage('没有正确读取菜单');
  if P.dwTypeData = '移动(&M)' then DeleteMenu(M, 1, MF_BYPOSITION);

  N := GetMenuItemCount(M) - 2; //清除系统菜单
  for I := N downto 0 do DeleteMenu(M, I, MF_BYPOSITION);
  Appendmenu(M, MF_Separator, 0, nil);
  Appendmenu(M, MF_String, 100, '用户添加的菜单');
  SetMenu(Handle, MMenu1.Handle);
end;

procedure TA00Form.MyMenu(var msg: twmmenuselect);
begin
  if msg.IDItem = 100 then
    showmessage('这就是刚添加的菜单') else
    inherited;
end;

procedure TA00Form.CDROM1Click(Sender: TObject);
begin
  mciSendString('set Cdaudio door open wait', nil, 0, handle);
  mciSendString('set cdaudio door closed Wait', nil, 0, handle);
end;

procedure TA00Form.N20Click(Sender: TObject);
begin
  Application.CreateForm(TImmForm, ImmForm);
  ImmForm.Showmodal;
  ImmForm.Free;
end;

procedure TA00Form.DrawCaptButton;
var
  XF, YF, XS, YS: integer;
  R: TRect;
begin
  exit;
  XF := GetSystemMetrics(SM_CXFRAME);
  YF := GetSystemMetrics(SM_CYFRAME);
  XS := GetSystemMetrics(SM_CXSIZE);
  YS := GetSystemMetrics(SM_CYSIZE);
  CaptionBtn := Bounds(Width - XF - 5 * XS + 2, YF + 2, XS + 2, YS - 4);
  Canvas.Handle := GetWindowDC(Handle);
  Canvas.Font.Name := '宋体';
  Canvas.Font.Size := 11;
  Canvas.Font.Color := clWhite;
  Canvas.Pen.Color := clYellow;
  Canvas.Brush.Color := clBlue;
  try
//     DrawButtonFace(Canvas,CaptionBtn,1,bsAutoDetect,False,False,False);
    R := Bounds(80, 2, 200, 20);
    with CaptionBtn do
      Canvas.TextRect(R, R.Left + 2, R.Top + 2, '你好你好你好');
  finally
    ReleaseDC(Self.Handle, Canvas.Handle);
    Canvas.Handle := 0;
  end;
end;

procedure TA00Form.N21Click(Sender: TObject);
begin
  DrawCaptButton;
end;

procedure TA00Form.N23Click(Sender: TObject);
begin
  Application.CreateForm(TGetFldForm, GetFldForm);
  GetFldForm.Showmodal;
  GetFldForm.Free;
end;

procedure TA00Form.DllForm1Click(Sender: TObject);
begin
  Showmessage('See DllForm.PAS');
end;

procedure TA00Form.N24Click(Sender: TObject);
type
  LogPal = record
    lpal: TLogpalette;
    dummy: array[1..255] of TPaletteEntry;
  end;

var
  sysPal: LogPal;
  image: TImage;
  hpal: HPalette;
  imageDC: HDC;
  imageCanvas: TCanvas;
  imageRect: TREct;
begin
  ShowWindow(Handle, sw_Hide);
  Sleep(100);
  ImageDC := GetDC(Handle);
  syspal.lpal.palVersion := $300;
  syspal.lpal.palNumEntries := 256;
  GetSystemPaletteEntries(ImageDC, 0, 256, Syspal.lpal.PalpalEntry);
  hPal := CreatePalette(Syspal.lpal);
  imageCanvas := TCanvas.Create;
  imageCanvas.Handle := ImageDC;
  imageRect := Rect(0, 0, 800, 600);
  Image := TImage.Create(Self);
  with image do begin
    Height := Self.Height;
    Width := Self.Width;
    Canvas.CopyRect(ImageRect, imageCanvas, imageRect);
    ReleaseDC(GetDesktopWindow, imageDC);
    Picture.Bitmap.Palette := hpal;
  end;
  if SaveDialog1.execute then
    image.picture.savetofile(SaveDialog1.Filename);
  image.free;
  ReleaseDC(GetDesktopWindow, imageDC);
  ShowWindow(Handle, sw_show);
end;

{var     //变量声明
  Bitmap1: Tbitmap;
  Canvas1: TCanvas;
  DC: HDC;
begin
  Form1.Left := 0;
  Form1.Top := 0;
  Form1.Width := screen.Width;
  Form1.Height := screen.Height;

  Bitmap1 := TBitmap.Create;      //创建一个BITMAP来存放图象
  Bitmap1.Width := Width;
  Bitmap1.Height := Height;

  //------------------------------------------------------------
  DC := GetDC(0);          //取得屏幕的 DC，参数0指的是屏幕
  Canvas1 := TCanvas.Create;     //创建一个CANVAS对象
  Canvas1.Handle := DC;          //将屏幕的DC赋给HANDLE
  Bitmap1.Canvas.CopyRect(Rect(0, 0, Width, Height),
          Canvas1,        Rect(0, 0, Width, Height));
                                 //把整个屏幕复制到BITMAP中
  Canvas1.Free;                  //释放CANVAS对象
  ReleaseDC(0, DC);              //释放DC

  image1.picture.Bitmap := Bitmap1;//拷贝下的图象赋给IMAGE对象
  image1.Width := Width;
  image1.Height := Height;
  Bitmap1.free;
  Image1.Picture.SaveToFile('C:\AAAA.BMP');
End;
}

procedure Working; // Stdcall;
var
  X, Y, i: integer;
  S: string;
begin
  X := 80 + random(400);
  Y := 80 + random(400);
  A00Form.Caption := Format('X:%d   Y:%d', [X, Y]);
  for i := 0 to 1000 do begin
    S := Format('%6d', [Random(i)]);
    A00Form.Canvas.Font.Color := clWhite;
    A00Form.Canvas.Brush.Color := clBlue;
    A00Form.Canvas.TextOut(X, Y, S);
    Sleep(100);
  end;
end;

procedure TA00Form.N25Click(Sender: TObject);
var
  hThread: Thandle; //定义一个句柄
  ThreadID: DWord;
begin //创建线程，同时线程函数被调用
  hthread := CreateThread(nil, 0, @Working, nil, 0, ThreadID);
  if hThread = 0 then
    messagebox(Handle, '无法建立线程！', nil, MB_OK);
end;

procedure TA00Form.N28Click(Sender: TObject);
begin
  Application.CreateForm(TAboutForm, AboutForm);
  AboutForm.Showmodal;
  AboutForm.Free;
end;

procedure TA00Form.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Shell_NotifyIcon(NIM_DELETE, @NTIcon);
  SaveSite(Self, 'Xed Tools');
  Application.Terminate;
end;

procedure TA00Form.ProceedSysKey(Sender: TObject);
begin
  SystemParametersInfo(97, Byte(Sender = LimitSysKey), nil, 0);
  //屏蔽系统按键
end;

procedure TA00Form.Timer1Timer(Sender: TObject);
var
  H: THandle;
begin
  SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
  SystemParametersInfo(97, 0, nil, 0);
  H := FindWindow('Shell_TrayWnd', '');
  ShowWindow(H, 1);
  //Application.BringToFront;
  Exit;
  inc(Curs);
  if Curs > 12 then
  begin
    Curs := 1;
  end;
  screen.cursor := Curs;
end;

procedure TA00Form.FormActivate(Sender: TObject);
begin
//  Application.Restore;
end;

procedure TA00Form.N3Click(Sender: TObject);
begin
  Application.HelpCommand(HELP_FINDER, 0);
end;

procedure TA00Form.N38Click(Sender: TObject);
begin
  Application.CreateForm(TFindForm, FindForm);
  FindForm.Showmodal;
  FindForm.Free;
end;

procedure TA00Form.SetDispMode(Sender: TObject);
begin
  Hide;
  Application.CreateForm(TDispForm, DispForm);
  DispForm.Showmodal;
  DispForm.Free;
  Show;
end;

procedure TA00Form.N42Click(Sender: TObject);
begin
  Application.CreateForm(TSpeed, Speed);
  Speed.Showmodal;
  Speed.Free;
end;

procedure TA00Form.cccc1Click(Sender: TObject);
begin
  Close;
end;

procedure TA00Form.N44Click(Sender: TObject);
begin
  if not Dialog1.Execute then exit;
  Image1.Picture.LoadFromFile(Dialog1.FileName);
  RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;

procedure TA00Form.N45Click(Sender: TObject);
begin
  ListView1.Visible := not ListView1.Visible;
end;

procedure TA00Form.FormPaint(Sender: TObject);
var
  SetWay, X, Y: Word;
  DC: HDC;
  PC: TPicture;
begin
  Exit;
  DC := GetDC(ClientHandle);
  Canvas.Handle := DC;
  PC := Image1.Picture;
  SetWay := 2;
  if PC.Width < 500 then SetWay := 0;
  if PC.Width < 50 then SetWay := 1;
  case SetWay of
    1: begin
        for X := 0 to ClientHeight div PC.Height do
          for Y := 0 to ClientWIDTH div PC.Width do
            Canvas.Draw(Y * PC.Width, X * PC.Height, PC.Graphic);
      end;
    0: begin
        X := PC.Width;
        Y := PC.Height;
        Canvas.Draw(
          (ClientWidth - 48 - X) div 2,
          (ClientHeight - 48 - Y) div 2, PC.Graphic);
      end;
    2: Canvas.StretchDraw(ClientRect, PC.Graphic);
  end;
  ReleaseDC(ClientHandle, DC);
end;

procedure TA00Form.ShowThisWindow(Sender: TObject);
var
  N: integer;
  V: Boolean;
  S: DWord;
begin
  N := ListView1.ItemIndex;
  N := StrToInt(ListView1.Items[N].SubItems[1]);
  if N = Application.Handle then Exit;
  V := IsWindowVisible(N);
  if V then S := SW_HIDE else S := SW_SHOWNOACTIVATE;
  ShowWindow(N, S);
end;

procedure TA00Form.N49Click(Sender: TObject);
begin
  Application.CreateForm(TAttrForm, AttrForm);
  AttrForm.ShowModal;
  AttrForm.Free;
end;

procedure TA00Form.N1Click(Sender: TObject);
begin
  Application.CreateForm(TCleanForm, CleanForm);
  CleanForm.Showmodal;
  CleanForm.Free;
end;

procedure TA00Form.FileCheck(Sender: TObject);
begin
  Application.CreateForm(TFileForm, FileForm);
  FileForm.Showmodal;
  FileForm.Free;
end;

procedure TA00Form.ShutMonitor(Sender: TObject);
begin
  SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
end;

procedure TA00Form.Button3Click(Sender: TObject);
begin
  SetSystemPowerState(False, True);
end;

procedure TA00Form.Html1Click(Sender: TObject);
begin
  Application.CreateForm(THtmlForm, HtmlForm);
  HtmlForm.ShowModal;
  HtmlForm.Free;
end;

procedure TA00Form.N55Click(Sender: TObject);
begin
  Application.CreateForm(TIconForm3, IconForm3);
  IconForm3.ShowModal;
  IconForm3.Free;
end;

end.