unit1.pas

delphi写的大小写转换程序

unit Unit1;

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ShellAPI,Clipbrd, StdCtrls, Buttons, Menus, ExtCtrls;

Const
  WM_BARICON=WM_USER+200;
  sc_idabout=wm_user+55;
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    btnClose: TButton;
    rbUpper: TRadioButton;
    rbLower: TRadioButton;
    cbStart: TCheckBox;
    PopupMenu1: TPopupMenu;
    O1: TMenuItem;
    X1: TMenuItem;
    N1: TMenuItem;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure OnCheckChange(Sender: TObject);
    procedure cbStartClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure O1Click(Sender: TObject);
    procedure X1Click(Sender: TObject);
  private
    { Private declarations }
     procedure WMBarIcon(var Message:TMessage);message WM_BARICON;
  public
    { Public declarations }
    public
    NextClipHwnd:HWND;//观察链中下一个窗口句柄
    procedure WMDrawClipboard(var AMessage:TMessage);message WM_DRAWCLIPBOARD;
    //剪贴板变化消息
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{***************************************************************
 *
 * Project  : 剪切板大小写转换
 * Unit Name: 主窗口
 * Purpose  : 实现剪切板大小写转换
 * Version  : 1.0
 * Date     : 2002-11-15
 * Author   : [e-mail]
 * History  :
 * Tested   :
 *
 ****************************************************************}
procedure TForm1.WMBarIcon(var Message:TMessage);
var
   lpData:PNotifyIconData;
   p:TPoint;
begin
  if (Message.LParam=WM_RBUTTONDOWN) then
  begin
    GetCursorPos(p);
    PopupMenu1.Popup(p.x ,p.y );;
  end ;
  if (Message.LParam = WM_LBUTTONDBLCLK) then
  begin
     self.Visible := true;
  end;
  if (Message.LParam = WM_LBUTTONDOWN) then
  begin
     self.Visible := False;
  end;
end;
procedure TForm1.WMDrawClipBoard(var AMessage: TMessage);
var
        i:integer;
begin
  if cbStart.Checked then
  begin
  //将WM_DRAWCLIPBOARD消息传递到下一个观察链中的窗口
  SendMessage(NextClipHwnd,AMessage.Msg,AMessage.WParam,AMessage.LParam);
  //查询剪贴板中特定格式的数据内容
  if Clipboard.HasFormat(CF_TEXT) then
  begin
    //处理剪贴板中内容
    if rbLower.Checked then
        Memo1.Lines.Text:=AnsiLowerCase(Clipboard.asText)
    else if rbUpper.Checked then
        Memo1.Lines.Text:=AnsiUpperCase(Clipboard.asText);
  end else
  if  Clipboard.HasFormat(CF_OEMTEXT) then
  begin
    Memo1.Lines.Text:=Clipboard.asText;
    for i:=0 to Memo1.Lines.Count-1 do
    begin
        Memo1.Lines[i]:=AnsiUpperCase(Memo1.Lines[i]);
        if rbLower.Checked then
            Memo1.Lines[i]:=AnsiLowerCase(Memo1.Lines[i])
        else if rbUpper.Checked then
            Memo1.Lines[i]:=AnsiUpperCase(Memo1.Lines[i]);
    end;
  end;
  //将转换过的内容重新复制到剪切板

    Memo1.SelectAll;
    Memo1.CopyToClipboard;
  end;

end;


procedure TForm1.FormCreate(Sender: TObject);
begin

//获得观察链中下一个窗口句柄
    NextClipHwnd:=SetClipBoardViewer(Handle);
    if (Clipboard.HasFormat(CF_TEXT) or Clipboard.HasFormat(CF_OEMTEXT))
    then
        Caption:='Yes!'
    else
        Caption:='Null';

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    //+++++++++++++++可有可无++++++++++++++++
    //从观察链中删除本观察窗口
    ChangeClipboardChain(Handle,NextClipHwnd);
    //将WM_DRAWCLIPBOARD消息传递到下一个观察链中的窗口
    SendMessage(NextClipHwnd,WM_CHANGECBCHAIN,Handle,NextClipHwnd);
end;



procedure TForm1.btnCloseClick(Sender: TObject);
begin
        Close();
end;

procedure TForm1.OnCheckChange(Sender: TObject);
begin
    Clipboard.Clear;
    Memo1.SelectAll;
    Memo1.CopyToClipboard;
end;

procedure TForm1.cbStartClick(Sender: TObject);
begin
    rbUpper.Enabled:= not rbUpper.Enabled;
    rbLower.Enabled:=not rbLower.Enabled;
end;

procedure TForm1.FormShow(Sender: TObject);
Var
  r : TRect;
begin
    SystemParametersInfo
      (SPI_GETWORKAREA,0,@r,0);
    self.Left:=r.Right-self.Width;
    self.Top:=r.Bottom- self.Height;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    MSG:TMessage;
begin
    Msg.LParam := WM_LBUTTONDOWN;
    self.WMBarIcon(Msg);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
   lpData:PNotifyIconData;
begin
      lpData := new(PNotifyIconDataA);
      lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
      lpData.Wnd := Form1.Handle;
      lpData.hIcon :=Form1.Icon.Handle;
      lpData.uCallbackMessage := WM_BARICON;
      lpData.uID :=0;
      lpData.szTip := '大小写转换程序';
      lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
      Shell_NotifyIcon(NIM_DELETE,lpData);
      dispose(lpData);
end;

procedure TForm1.O1Click(Sender: TObject);
begin
    self.Show;
end;

procedure TForm1.X1Click(Sender: TObject);
begin
    close();
end;

end.