Smilie program til en blind ven ? lost ?

Det er faktisk ikke så svært det du skal til.

1) find sendkeys.pas. Den indeholder funktioner til at simulere tastetryk / sende tekst til fx aktive vindue.

2) Brug funktionen RegisterHotKey til at registrerer systemwide hotkeys med.

Done.

Gode funktioner du måske får brug for er:
TextToShortCut()
&
ShortCutToText()
Som befinder sig i menus.pas

Håber det gav en ide om hvad der skal til.

mange tak :) men hvor finder jeg 'sendkeys.pas', jeg er ikk sikker på den ligger i BDS 2006 :-/
og så håbede jeg måske på lidt mere forklaring :)

Her SendKey.pas :

library SendKey;

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, KeyDefs;

type
  { Error codes }
  TSendKeyError = (sk_None, sk_FailSetHook, sk_InvalidToken, sk_UnknownError);

  { exceptions }
  ESendKeyError = class(Exception);
  ESetHookError = class(ESendKeyError);
  EInvalidToken = class(ESendKeyError);

  { a TList descendant that know how to dispose of its contents }
  TMessageList = class(TList)
  public
    destructor Destroy; override;
  end;

destructor TMessageList.Destroy;
var
  i: longint;
begin
  { deallocate all the message records before discarding the list }
  for i := 0 to Count - 1 do
    Dispose(PEventMsg(Items[i]));
  inherited Destroy;
end;

var
  { variables global to the DLL }
  MsgCount: word;
  MessageBuffer: TEventMsg;
  HookHandle: hHook;
  Playing: Boolean;
  MessageList: TMessageList;
  AltPressed, ControlPressed, ShiftPressed: Boolean;
  NextSpecialKey: TKeyString;

function MakeWord(L, H: Byte): Word;
{ macro creates a word from low and high bytes }
inline(
  $5A/            { pop dx }
  $58/            { pop ax }
  $8A/$E2);      { mov ah, dl }

procedure StopPlayback;
{ Unhook the hook, and clean up }
begin
  { if Hook is currently active, then unplug it }
  if Playing then
    UnhookWindowsHookEx(HookHandle);
  MessageList.Free;
  Playing := False;
end;

function Play(Code: integer; wParam: word; lParam: Longint): Longint; export;
{ This is the JournalPlayback callback function.  It is called by Windows }
{ when Windows polls for hardware events.  The code parameter indicates what }
{ to do. }
begin
  case Code of

    hc_Skip: begin
    { hc_Skip means to pull the next message out of our list. If we }
    { are at the end of the list, it's okay to unhook the JournalPlayback }
    { hook from here. }
      { increment message counter }
      inc(MsgCount);
      { check to see if all messages have been played }
      if MsgCount >= MessageList.Count then
        StopPlayback
      else
      { copy next message from list into buffer }
      MessageBuffer := TEventMsg(MessageList.Items[MsgCount]^);
      Result := 0;
    end;

    hc_GetNext: begin
    { hc_GetNext means to fill the wParam and lParam with the proper }
    { values so that the message can be played back.  DO NOT unhook }
    { hook from within here.  Return value indicates how much time until }
    { Windows should playback message.  We'll return 0 so that it's }
    { processed right away. }
      { move message in buffer to message queue }
      PEventMsg(lParam)^ := MessageBuffer;
      Result := 0  { process immediately }
    end

    else
      { if Code isn't hc_Skip or hc_GetNext, then call next hook in chain }
      Result := CallNextHookEx(HookHandle, Code, wParam, lParam);
  end;
end;

procedure StartPlayback;
{ Initializes globals and sets the hook }
begin
  { grab first message from list and place in buffer in case we }
  { get a hc_GetNext before and hc_Skip }
  MessageBuffer := TEventMsg(MessageList.Items[0]^);
  { initialize message count and play indicator }
  MsgCount := 0;
  { initialize Alt, Control, and Shift key flags }
  AltPressed := False;
  ControlPressed := False;
  ShiftPressed := False;
  { set the hook! }
  HookHandle := SetWindowsHookEx(wh_JournalPlayback, Play, hInstance, 0);
  if HookHandle = 0 then
    raise ESetHookError.Create('Couldn''t set hook')
  else
    Playing := True;
end;

procedure MakeMessage(vKey: byte; M: word);
{ procedure builds a TEventMsg record that emulates a keystroke and }
{ adds it to message list }
var
  E: PEventMsg;
begin
  New(E);                                { allocate a message record }
  with E^ do begin
    Message := M;                        { set message field }
    { high byte of ParamL is the vk code, low byte is the scan code }
    ParamL := MakeWord(vKey, MapVirtualKey(vKey, 0));
    ParamH := 1;                          { repeat count is 1 }
    Time := GetTickCount;                { set time }
  end;
  MessageList.Add(E);
end;

procedure KeyDown(vKey: byte);
{ Generates KeyDownMessage }
begin
  { don't generate a "sys" key if the control key is pressed (Windows quirk) }
  if (AltPressed and (not ControlPressed) and (vKey in [Ord('A')..Ord('Z')])) or
    (vKey = vk_Menu) then
    MakeMessage(vKey, wm_SysKeyDown)
  else
    MakeMessage(vKey, wm_KeyDown);
end;

procedure KeyUp(vKey: byte);
{ Generates KeyUp message }
begin
  { don't generate a "sys" key if the control key is pressed (Windows quirk) }
  if AltPressed and (not ControlPressed) and (vKey in [Ord('A')..Ord('Z')]) then
    MakeMessage(vKey, wm_SysKeyUp)
  else
    MakeMessage(vKey, wm_KeyUp);
end;

procedure SimKeyPresses(VKeyCode: Word);
{ This function simulates keypresses for the given key, taking into }
{ account the current state of Alt, Control, and Shift keys }
begin
  { press Alt key if flag has been set }
  if AltPressed then
    KeyDown(vk_Menu);
  { press Control key if flag has been set }
  if ControlPressed then
    KeyDown(vk_Control);
  { if shift is pressed, or shifted key and control is not pressed... }
  if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or ShiftPressed then
    KeyDown(vk_Shift);    { ...press shift }
  KeyDown(Lo(VKeyCode));  { press key down }
  KeyUp(Lo(VKeyCode));    { release key }
  { if shift is pressed, or shifted key and control is not pressed... }
  if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or ShiftPressed then
    KeyUp(vk_Shift);      { ...release shift }
  { if shift flag is set, reset flag }
  if ShiftPressed then begin
    ShiftPressed := False;
  end;
  { Release Control key if flag has been set, reset flag }
  if ControlPressed then begin
    KeyUp(vk_Control);
    ControlPressed := False;
  end;
  { Release Alt key if flag has been set, reset flag }
  if AltPressed then begin
    KeyUp(vk_Menu);
    AltPressed := False;
  end;
end;

procedure ProcessKey(S: String);
{ This function parses each character in the string to create the message list }
var
  KeyCode: word;
  Key: byte;
  index: integer;
  Token: TKeyString;
begin
  index := 1;
  repeat
    case S[index] of

      KeyGroupOpen : begin
      { It's the beginning of a special token! }
        Token := '';
        inc(index);
        while S[index] <> KeyGroupClose do begin
          { add to Token until the end token symbol is encountered }
          Token := Token + S[index];
          inc(index);
          { check to make sure the token's not too long }
          if (Length(Token) = 7) and (S[index] <> KeyGroupClose) then
            raise EInvalidToken.Create('No closing brace');
        end;
        { look for token in array, Key parameter will }
        { contain vk code if successful }
        if not FindKeyInArray(Token, Key) then
          raise EInvalidToken.Create('Invalid token');
        { simulate keypress sequence }
        SimKeyPresses(MakeWord(Key, 0));
      end;

      AltKey : begin
        { set Alt flag }
        AltPressed := True;
      end;

      ControlKey : begin
        { set Control flag }
        ControlPressed := True;
      end;

      ShiftKey : begin
        { set Shift flag }
        ShiftPressed := True;
      end;

      else begin
      { A normal character was pressed }
        { convert character into a word where the high byte contains }
        { the shift state and the low byte contains the vk code }
        KeyCode := vkKeyScan(MakeWord(Byte(S[index]), 0));
        { simulate keypress sequence }
        SimKeyPresses(KeyCode);
      end;
    end;
    inc(index);
  until index > Length(S);
end;

function SendKeys(S: String): TSendKeyError; export;
{ This is the one entry point.  Based on the string passed in the S  }
{ parameter, this function creates a list of keyup/keydown messages, }
{ sets a JournalPlayback hook, and replays the keystroke messages.  }
var
  i: byte;
begin
  try
    Result := sk_None;                  { assume success }
    MessageList := TMessageList.Create;  { create list of messages }
    ProcessKey(S);                      { create messages from string }
    StartPlayback;                      { set hook and play back messages }
  except
    { if an exception occurs, return an error code, and clean up }
    on E:ESendKeyError do begin
      MessageList.Free;
      if E is ESetHookError then
        Result := sk_FailSetHook
      else if E is EInvalidToken then
        Result := sk_InvalidToken;
    end
    else
      { Catch-all exception handler ensures than an exception }
      { doesn't walk up into application stack }
      Result := sk_UnknownError;
  end;
end;

exports
  SendKeys index 2;

begin
end.

Takker. men har du noget forslag til hvor den skal ligge :-/

Hvad mener du ?

Du gemmer bare det tekst der i sendkey.pas. Den fil kan du smide i den mappe hvor du har dit projekt eller delphiXX/Lib/ mappen.

Og så tilføjer du sendkey til uses.

DelphiXX/Lib/ det var det jeg var i tvivl om ;)
men hvordan skal jeg så bruge den?

hov, havde ikke set at hans sendkeys var beregnet til en dll.
Men det syntes jeg nu ikke du skal ud i nu.
Hent
http://home.conceptsfa.nl/%7Egvdvenis/downloads/sndkey32.pas

tilføj sndkey32 til uses

procedure TForm1.Button1Click(Sender: TObject);
var
fhandle : thandle;
begin
fhandle := findwindow(nil, 'Unavngivet - Notesblok');

if fhandle <> 0 then
begin
Setforegroundwindow(fhandle);
//- sndkey32 indeholder også funktion til at sætte aktive vindue..
SendKeys('Dette er en test!'+#13#10+'lala', true);

end else
showmessage('notepad was not found!');
end;

nu sender den jo kun teksten til vinduet "Unavngivet - Notesblok". den skal bare sende det til det aktive vindue.
er et eksempel på det der "Systemwide hotkeys" for meget at spørge om :)
kan ikke rigtig hitte ud af det.

Det var for du kunne se hvordan det virkede...

Hvis den skal sende til det vindue som er i front, så skal du jo bare nøjes med at kalde
SendKeys();

Fra delphi3000:

In USES: Windows, Dialogs

First, put this small code in OnCreate from your form:

procedure TForm1.FormCreate(Sender: TObject);
begin
    if not REGISTERHOTKEY(Handle, 1, MOD_CONTROL or MOD_ALT, VK_F11) then
    ShowMessage('Error registering Ctrl+Alt+F11');

    if not REGISTERHOTKEY(Handle, 2, MOD_CONTROL or MOD_ALT, VK_F12) then
    ShowMessage('Error registering Ctrl+Alt+F12');
end;

and in OnDestroy event put:

procedure TForm1.FormDestroy(Sender: TObject);
begin
    UnREGISTERHOTKEY(Handle, 1);
    UnREGISTERHOTKEY(Handle, 2);
end;

Declare the procedure below in private section from Form:

  private
    procedure WMHotkey(var Msg: TWMHotkey); message WM_HOTKEY;

Below Implementation clause, put:

procedure TForm1.WMHotkey(var Msg: TWMHotkey);
begin
  case Msg.HotKey of
    1: WinExec('write.exe', SW_SHOW);
    2: ShowMessage('Ctrl+Alt+F12 pressed!');
  end;
end;

kan godt få det til at virke hver for sig, men når jeg prøver at sætte de to ting sammen, så bliver den tekst den skulle sende til noget i den her stil "€µ€€€€€@" :-/

Nu får i lige hvad jeg har skrevet, så er det måske nemmere at finde fejlen :)

<START>
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, sndkey32;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Luk1: TMenuItem;
    TrayIcon1: TTrayIcon;
    procedure Luk1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure WMHotkey(var Msg: TWMHotkey); message WM_HOTKEY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    if not REGISTERHOTKEY(Handle, 1, MOD_CONTROL or MOD_ALT, VK_F10) then
    ShowMessage('Error registering Ctrl+Alt+F10');

    if not REGISTERHOTKEY(Handle, 2, MOD_CONTROL or MOD_ALT, VK_F11) then
    ShowMessage('Error registering Ctrl+Alt+F11');

    if not REGISTERHOTKEY(Handle, 3, MOD_CONTROL or MOD_ALT, VK_F12) then
    ShowMessage('Error registering Ctrl+Alt+F12');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    UnREGISTERHOTKEY(Handle, 1);
    UnREGISTERHOTKEY(Handle, 2);
    UnREGISTERHOTKEY(Handle, 3);
end;

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

procedure TForm1.WMHotkey(var Msg: TWMHotkey);
begin
  case Msg.HotKey of
    1: SendKeys('et smilie: :-D :-) :-( ;-)', True);
    2: SendKeys('Du trykkede på Ctrl+Alt+F11', true);
    3: SendKeys('Du trykkede på Ctrl+Alt+F12', true);
  end;
end;

end.
<SLUT>

Okay dit problem er at hotkeyen stadig bliver holdt nede mens teksten bliver sendt.

Dette er nemt nok at løse ved at se hvad for nogle taster af control alt og shift som er nede inden man kalder sendkeys og sende en keyup besked.



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, sndkey32;

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMHotkey(var Msg: TWMHotkey); message WM_HOTKEY;
    procedure Releasekeysdown;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function IsKeyDown(vk: integer): Boolean;
begin
  Result := (GetAsyncKeyState(vk) < 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if not REGISTERHOTKEY(Handle, 1, MOD_CONTROL or MOD_ALT, VK_F10) then
  ShowMessage('Error registering Ctrl+Alt+F10');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnREGISTERHOTKEY(Handle, 1);
end;

procedure TForm1.Releasekeysdown;
begin
  if IsKeyDown(vk_CONTROL) then
  Keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0);
  if IsKeyDown(vk_SHIFT) then
  Keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0);
  if IsKeyDown(vk_Menu) then
  Keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
end;

procedure TForm1.WMHotkey(var Msg: TWMHotkey);
begin
  case Msg.HotKey of
    1:
    begin
      //- Sætter hhv. control, shift & alt til at være "oppe"
      Releasekeysdown;

      SendKeys('et smilie: :-D :-) :-( ;-)', true);
      //- Måske sætte de keys igen da det er rart en hotkey er klar til at virke
      //- igen
    end;
  end;
end;

end.

okay to ting igen ;P (og han bliver ved, og ved, og ved ;))

<START>
procedure TForm1.Releasekeysdown;
begin
  if IsKeyDown(vk_CONTROL) then
    Keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0)
  else
    Keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYDOWN, 0);

  if IsKeyDown(vk_SHIFT) then
    Keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0)
  else
    Keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYDOWN, 0);

  if IsKeyDown(vk_Menu) then
    Keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0)
  else
    Keybd_event(VK_MENU, 0, KEYEVENTF_KEYDOWN, 0);
end;
<SLUT>

hvordan 'klikker' man så på knappen igen?
"Keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYDOWN, 0);"

----------------------------------------
og den anden ting, hvorfor vil den ikke skrive '(' og ')'...?
det er jo sådan set en stort problem, da programmet skulle bruges til at sende smilies :-/


Håber ikke jeg er alt for krævende :) men er ikke helt på 'talefod' med delphi endnu ;)

Jamen du skal da bare spørge til det funker : )

Fordi at sendkeys ikke medtager fx ( & ) er pga. den understøtter en lille form for scripting.

Fx kan den også simulere taster ved at man skriver "%" for at den skal holde "Alt" nede mens den simulere næste tast. Hvis der er parentes efter en modifier fx "+(hej)" så vil den skrive "hej" mens den holder shift nede, resultatatet bliver self "HEJ".

Du kan læse lidt om det her
http://www.winguides.com/scripting/reference.php?id=149

Dvs. for at sende en parentes kan man omgå det ved at sige den skal holde shift nede mens den sender næste tast og jeg sætter jo så bare næste tast til "8" eller "9" for hhv ( & ).
Det vil så se sådan ud:
SendKeys('et smilie: :-D :-+9 :-+8 ;-+0', true);

Jeg har lavet så de modkeys som blev holdt nede bliver sat igen efter teksten er sendt.

Det kan jo nok godt svare sig at lave en ny procedure som hedder fx SendText(msg:string) og i den kan du så smide de ting som jeg eller bruger her, det vil gøre det lidt smartere til de næste hotkeys som du nok skal have tilføjet.

procedure TForm1.WMHotkey(var Msg: TWMHotkey);
var
  ctrldown, shiftdown, altdown: boolean;
  procedure GetModKeys;
  begin
    ctrldown := IsKeyDown(vk_CONTROL);
    shiftdown := IsKeyDown(VK_SHIFT);
    altdown := IsKeyDown(VK_MENU);
  end;
  procedure ReleaseModKeys;
  begin
    if ctrldown then
      Keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0);
    if shiftdown then
      Keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0);
    if altdown then
      Keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
  end;
  procedure RestoreModKeys;
  begin
    if ctrldown then
      Keybd_event(VK_CONTROL, 0, 0, 0);
    if shiftdown then
      Keybd_event(VK_SHIFT, 0, 0, 0);
    if altdown then
      Keybd_event(VK_MENU, 0, 0, 0);
  end;
begin
  case Msg.HotKey of
    1:
      begin
        GetModKeys;
        ReleaseModKeys;
        SendKeys('et smilie: :-D :-+9 :-+8 ;-+0', true);
        RestoreModKeys;
      end;
  end;
end;


Jeg håber det giver lidt mening. Spørg hvis der er mere som er træls : )

ja, det virker så på min computer :) men nogen af mine venner var det kun nogen af kenvejene der virkede :\
men hvis nogen vil have point så kom med et svar :) og mange mange mange tak for hjælpen :)

Ja det lyder jo mærkeligt, især hvis den siger success til registerhotkey. Men de kan jo blive overtaget igen af noget andet.

Håber da det endte med at virke som du håbede på : )