Форум: "Потрепаться";
Текущий архив: 2005.01.02;
Скачать: [xml.tar.bz2];
ВнизБыстрый ввод некоторых символов Найти похожие ветки
← →
Gero © (2004-12-09 21:13) [0]Какие есть программы(или, может, другие способы) быстрого введения с клавиатуры символов, почему-то посчитавшихся ненужными, под которые отвести клавиши никто не удосужился?
Например, такие как тире или копирайт.
Если набирать текст в ворде, то в принципе, приемлимо - поставил хоткей и жми на здоровье.
А вот что делать, если мне блокнот по душе?
Каждый раз вводить Alt+код, мягко говоря, неудобно.
← →
GuAV © (2004-12-09 21:57) [1]
program Project1;
uses
SysUtils,
Windows,
Messages,
ShellAPI;
{$R *.res}
const
WM_MYTRAY = WM_USER;
function CheckGetMessage(Value: BOOL): BOOL;
begin
if ord(Value)=-1 then Result:=False else Result:=Value;
end;
procedure WinMain;
var
Msg: TMsg;
begin
while CheckGetMessage(GetMessage(Msg, 0, 0, 0)) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
procedure SetIcon(hWnd: HWND; Create: Boolean);
const Msg: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
var Icon: TNotifyIconData;
begin
if Create then
begin
Icon.hIcon:=LoadImage(hInstance, "MAINICON",
IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR);
Icon.uCallbackMessage:=WM_MYTRAY;
Icon.uFlags:=NIF_MESSAGE or NIF_ICON;
end
else Icon.uFlags:=0;
Icon.uID:=0;
Icon.cbSize:=SizeOf(Icon);
Icon.Wnd:=hWnd;
Shell_NotifyIcon(Msg[Create], @Icon);
end;
function WinInit(ClassName: PChar; Parent: hWnd; WndProc: TFNWndProc): HWND;
var
WndClassEx: TWndClassEx;
begin
Result:=0;
ZeroMemory(@WndClassEx, SizeOf(WndClassEx));
with WndClassEx do
begin
cbSize:=sizeOf(TWndClassEx);
lpszClassName:=ClassName;
hInstance:=SysInit.HInstance;
lpfnWndProc:=WndProc;
end;
if RegisterClassEx(WndClassEx)<>0 then
begin
Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClassEx.lpszClassName, nil,
WS_POPUP, 0, 0, 0, 0, Parent, 0, SysInit.HInstance, nil);
end;
end;
var
WM_TRAYCREATE: UINT;
function WindowProc(hWnd: HWND; Msg: UINT;
wParam: WPARAM; lParam: LPARAM): LRESULT; export; stdcall;
var h: THandle; I: BOOL;
begin
case Msg of
WM_CREATE:
begin
SetIcon(hWnd, True);
RegisterHotKey(hWnd, 1, MOD_CONTROL or MOD_SHIFT, ord("C"));
end;
WM_HOTKEY:
begin
h := GetForegroundWindow;
if AttachThreadInput(GetCurrentThreadId, GetWindowThreadProcessId(h, nil), True) then
Beep(0,0);
PostMessage(GetFocus, WM_CHAR, ord("©"), 0);
AttachThreadInput(GetCurrentThreadId, GetWindowThreadProcessId(h, nil), False);
Result := 0;
Exit;
end;
WM_MYTRAY:
case LPARAM of
WM_RBUTTONUP: DestroyWindow(hWnd);
end;
WM_DESTROY:
begin
SetIcon(hWnd, False);
PostQuitMessage(0);
end;
else
if Msg = WM_TRAYCREATE then
SetIcon(hWnd, True);
end;
Result:=DefWindowProc(hWnd, Msg, wParam, lParam);
end;
begin
WM_TRAYCREATE := RegisterWindowMessage("TaskbarCreated");
WinInit("ProgramForGeroWnd", 0, @WindowProc);
WinMain;
end.
← →
Gero © (2004-12-09 22:04) [2]
> GuAV © (09.12.04 21:57)
Чисто программерский подход :)
Спасибо. Вероятно, переделав код под себя, буду юзать.
← →
dr Tr0jan (2004-12-10 02:02) [3]Хех, а я привык Alt+0169 набирать.
← →
GuAV © (2004-12-10 03:15) [4]Мне кстати тоже идея понравилась, дописал
program Project1;
uses
Windows,
Messages,
ShellAPI;
{$R *.res}
const
WM_MYTRAY = WM_USER;
function CheckGetMessage(Value: BOOL): BOOL;
begin
if ord(Value) = -1 then Result := False else Result := Value;
end;
procedure WinMain;
var
Msg: TMsg;
begin
while CheckGetMessage(GetMessage(Msg, 0, 0, 0)) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
procedure SetIcon(hWnd: HWND; Create: Boolean);
const Msg: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
var Icon: TNotifyIconData;
begin
if Create then
begin
Icon.hIcon := LoadImage(hInstance, "MAINICON",
IMAGE_ICON, 16, 16, LR_DEFAULTCOLOR);
Icon.uCallbackMessage := WM_MYTRAY;
Icon.uFlags := NIF_MESSAGE or NIF_ICON;
end
else Icon.uFlags := 0;
Icon.uID := 0;
Icon.cbSize := SizeOf(Icon);
Icon.Wnd := hWnd;
Shell_NotifyIcon(Msg[Create], @Icon);
end;
function WinInit(ClassName: PChar; Parent: hWnd; WndProc: TFNWndProc): HWND;
var
WndClassEx: TWndClassEx;
begin
Result:=0;
ZeroMemory(@WndClassEx, SizeOf(WndClassEx));
with WndClassEx do
begin
cbSize := sizeOf(TWndClassEx);
lpszClassName := ClassName;
hInstance := SysInit.HInstance;
lpfnWndProc := WndProc;
end;
if RegisterClassEx(WndClassEx)<>0 then
begin
Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClassEx.lpszClassName, nil,
WS_POPUP, 0, 0, 0, 0, Parent, 0, SysInit.HInstance, nil);
end;
end;
var
WM_TRAYCREATE: UINT;
procedure SendChar(wParam: WPARAM);
var h: THandle; i1, i2: DWORD;
begin
h := GetForegroundWindow;
i1 := GetCurrentThreadId;
i2 := GetWindowThreadProcessId(h, nil);
if not AttachThreadInput(i1, i2, True) then Exit;
h := GetFocus;
if h <> 0 then
PostMessage(h, WM_CHAR, wParam, 0);
AttachThreadInput(i1, i2, False);
end;
type
TShortCutRec = record
modifiers, vk: UINT;
end;
procedure RegKeys(hWnd: HWND);
var Ch: Char; R: TShortCutRec; F: File of TShortCutRec;
begin
AssignFile(F, "hot.bin");
Reset(F);
try
for Ch := #0 to #255 do
begin
Read(F, R);
RegisterHotKey(hWnd, ord(Ch), R.modifiers, R.vk);
end;
finally
CloseFile(F);
end;
end;
function WindowProc(hWnd: HWND; Msg: UINT;
wParam: WPARAM; lParam: LPARAM): LRESULT; export; stdcall;
begin
case Msg of
WM_CREATE:
begin
SetIcon(hWnd, True);
RegKeys(hWnd);
end;
WM_HOTKEY:
begin
SendChar(wParam);
Result := 0;
Exit;
end;
WM_MYTRAY:
case LPARAM of
WM_RBUTTONUP: DestroyWindow(hWnd);
end;
WM_DESTROY:
begin
SetIcon(hWnd, False);
PostQuitMessage(0);
end;
else
if Msg = WM_TRAYCREATE then
SetIcon(hWnd, True);
end;
Result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;
begin
WM_TRAYCREATE := RegisterWindowMessage("TaskbarCreated");
WinInit("ProgramForGeroWnd", HWND_DESKTOP, @WindowProc);
WinMain;
end.
...и редактор к этой штукеunit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Grids; //menus
type
TShortCutRec = record
modifiers, vk: UINT;
end;
TForm1 = class(TForm)
StringGrid: TStringGrid;
HotKey1: THotKey;
Label1: TLabel;
btnCancel: TButton;
btnOK: TButton;
procedure FormCreate(Sender: TObject);
procedure StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure HotKey1Change(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
private
function GetHotKey(I, J: Integer): TShortCut;
procedure SetHotKey(I, J: Integer; const Value: TShortCut);
private
FHotKeys: array[1..16, 1..16] of TShortCutRec;
property HotKeys[I, J:Integer]: TShortCut read GetHotKey write SetHotKey;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const fn = "hot.bin";
procedure TForm1.FormCreate(Sender: TObject);
const dig: array [0..15] of Char = "0123456789ABCDEF";
var I, J: Integer;
begin
for I:=0 to 255 do
StringGrid.Cells[I and $F + 1, I shr 4 + 1] := Chr(I);
for I:=0 to 16 do
begin
StringGrid.Cells[I, 0] := dig[I];
StringGrid.Cells[0, I] := dig[I];
end;
if FileExists(fn) then
with TFileStream.Create(fn, fmOpenRead) do
try
ReadBuffer(FHotKeys, SizeOf(FHotKeys));
finally
Free;
end;
end;
function TForm1.GetHotKey(I, J: Integer): TShortCut;
begin
with FHotKeys[I, J] do
begin
Result := vk;
if modifiers and MOD_SHIFT <> 0 then
Result := Result or scShift;
if modifiers and MOD_CONTROL <> 0 then
Result := Result or scCtrl;
if modifiers and MOD_ALT <> 0 then
Result := Result or scAlt;
end;
end;
procedure TForm1.SetHotKey(I, J: Integer; const Value: TShortCut);
begin
with FHotKeys[I, J] do
begin
vk := Value and $FF;
modifiers := 0;
if Value and scShift <> 0 then
modifiers := modifiers or MOD_SHIFT;
if Value and scCtrl <> 0 then
modifiers := modifiers or MOD_CONTROL;
if Value and scAlt <> 0 then
modifiers := modifiers or MOD_ALT;
end;
end;
procedure TForm1.StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
begin
HotKey1.HotKey := HotKeys[ARow, ACol];
HotKey1.SetFocus;
end;
procedure TForm1.HotKey1Change(Sender: TObject);
begin
with StringGrid do
if (Col <> -1) and (Row <> -1) then
HotKeys[Row, Col] := Hotkey1.HotKey;
end;
procedure TForm1.btnOKClick(Sender: TObject);
begin
with TFileStream.Create(fn, fmCreate) do
try
WriteBuffer(FHotKeys, SizeOf(FHotKeys));
finally
Free;
end;
Close;
end;
procedure TForm1.btnCancelClick(Sender: TObject);
begin
← →
GuAV © (2004-12-10 03:15) [5]
Close;
end;object Form1: TForm1
Left = 192
Top = 107
Width = 452
Height = 509
Caption = "Form1"
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 424
Width = 32
Height = 13
Caption = "Label1"
end
object StringGrid: TStringGrid
Left = 8
Top = 8
Width = 430
Height = 430
ColCount = 17
DefaultColWidth = 24
RowCount = 17
Font.Charset = RUSSIAN_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "Fixedsys"
Font.Style = []
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine]
ParentFont = False
ScrollBars = ssNone
TabOrder = 0
OnSelectCell = StringGridSelectCell
end
object HotKey1: THotKey
Left = 8
Top = 448
Width = 121
Height = 19
HotKey = 0
Modifiers = []
TabOrder = 1
OnChange = HotKey1Change
end
object btnCancel: TButton
Left = 352
Top = 448
Width = 75
Height = 25
Caption = "Cancel"
TabOrder = 2
OnClick = btnCancelClick
end
object btnOK: TButton
Left = 256
Top = 448
Width = 75
Height = 25
Caption = "OK"
TabOrder = 3
OnClick = btnOKClick
end
end
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2005.01.02;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.036 c