Текущий архив: 2005.01.02;
Скачать: CL | DM;

Вниз

Быстрый ввод некоторых символов   Найти похожие ветки 

← →
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;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.025 c