Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 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
4-1100755769
NetDigger
2004-11-18 08:29
2005.01.02
FileMon&amp;RegMon-Clones


3-1102231000
Alex Y
2004-12-05 10:16
2005.01.02
Программный выбор строк в DBGrid


1-1103117204
AbramovVi
2004-12-15 16:26
2005.01.02
TreeView


4-1100296579
Dot
2004-11-13 00:56
2005.01.02
работа с реестром


1-1103531740
Рафик
2004-12-20 11:35
2005.01.02
QuickRep





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский