Bezeichnungen von Shortcuts ändern, aber wie?

[Marco Steinebach]

Hi Leuts,
ich meine, sowas schonmal in der DP gelesen zu haben, ich kann's aber nicht finden.
Ich habe ein Prog, daß es auch auf englisch geben soll. Allerdings läßt sich mein Delphi nicht überreden aus dem Shortcut strg + pfeil nach oben in einem Menüeintrag, ctrl+up arrow, oder soetwas zu machen.
Erstellen tu ich ihn mittels
Titel_nachOben.Shortcut := ShortCut (VK_up, [ssCtrl]); Das funktioniert auch prima, sieht aber blöd aus, wenn im englishcen
move up strg+nach oben
steht.
Gibt's da 'ne lösung, wie ich das ändern kann?
Meinetwegen weise ich die Shortcuttexte auch alle per Hand zu - hauptsache, es geht irgendwie!
Ich bitte um euere Hilfe!
Marco

[DeddyH]

Wäre ShortcutToText evtl. die gesuchte Funktion?

[Marco Steinebach]

Zitat von DeddyH:

Wäre ShortcutToText evtl. die gesuchte Funktion?

nein, leider nicht. ShortcutToText gibt lediglich den, von wem auch immer, vorgegebenen Text zurück, also in meinem Beispiel strg+nach oben. Beim TMenuItem wird der Shortcut als Eigenschaft von Typ TShortCut eingetragen, und Delpühi wandelt ihn dann, bei der Anzeige in Text um. Genau hier liegt das Problem, daß Delphi hier "Mist" umwandelt!
Viele Grüße
Marco

[toms]

Zitat von DeddyH:

Wäre ShortcutToText evtl. die gesuchte Funktion?

ShortCutToText müsste mit einer eingenen ShortCutToText Funktion überschrieben werden, welche dann je nach Sprache
einen anderen Text zurückgibt.

[Marco Steinebach]

Zitat von toms:

Zitat von DeddyH:

Wäre ShortcutToText evtl. die gesuchte Funktion?

ShortCutToText müsste mit einer eingenen ShortCutToText Funktion überschrieben werden, welche dann je nach Sprache
einen anderen Text zurückgibt.

Prima Idee! ähm, geht das bei TMenuItem? Und wenn ja, kann mir irgendwer sagen wie?
Etwas überraschte Grüße
Marco

[toms]

Zitat von Marco Steinebach:

Prima Idee! ähm, geht das bei TMenuItem? Und wenn ja, kann mir irgendwer sagen wie?

Es geht bei TMenuItem da immer auf ShortCutToText zurück gegriffen wird.
D.h es funktioniert für TMainMenu, TPopupMenu etc, etc.

Das Prinzip funktioniert so wie es im SiComponents Forums gezeigt wird.

Anmerkung: Die verwendetet OverwriteProcedure() Funktion funktioniert unter D2009 nicht.

[Marco Steinebach]

Hi Toms,
erstmal vielen herzlichen Dank für die Antwort. Das sieht doch klasse aus! So komme ich ganz sicher weiter. Wenn ich das ganze zusammengebaut habe, stell ich das Ergebnis natürlich hier rein, damit's ein beispiel gibt.
Könnte mir vielleicht mal jemand aus der Unit Menus die procedure ShortcutToText posten, oder meinetwegen gleich die ganze Unit, damit ich eine vorlage habe?
Vielen Dank nochmal und viele Grüße
Marco

[toms]

Hallo Marco

Aus persönlichem Interesse habe ich mich auch mal hingesetzt und versuche eine Komponente zu erstellen,
bei welcher man die verschiedenen Shortcuts definieren kann.

Die Unit uReplaceShortCutToText ist schon mal soweit fertig. (getestet unter D6, D2007, D2009)
Der Rest kommt noch.

Delphi-Quellcode:

unit uReplaceShortCutToText;

interface

uses
  Classes, Windows, Messages, Menus, SysUtils;
  
procedure EnableReplaceShortCutToText(Value: Boolean);

type
  TMyShortCutToTextEvent = procedure(ShortCut: TShortCut; var Result: string) of object;

var
  OnShortCutToText : TMyShortCutToTextEvent;

implementation

type
  POverwrittenData = ^TOverwrittenData;
  TOverwrittenData = record
    Location: Pointer;
    OldCode: array[0..6] of Byte;
  end;

var
  OldShortCutToText: TOverwrittenData;

procedure RestoreProcedure(OriginalProc: Pointer; Data: TOverwrittenData);
var
  ov, ov2: Cardinal;
begin
  if Data.Location <> nil then begin
    if not VirtualProtect(Data.Location, 6, PAGE_EXECUTE_READWRITE, @ov) then
      RaiseLastOSError;
    Move(Data.OldCode, Data.Location^, 6);
    if not VirtualProtect(Data.Location, 6, ov, @ov2) then
      RaiseLastOSError;
  end;
end;

procedure OverwriteProcedure(OldProcedure, NewProcedure: Pointer; Data: POverwrittenData = nil);
{ OverwriteProcedure originally from Igor Siticov }
{ Modified by Jacques Garcia Vazquez }
var
  x: PAnsiChar;
  y: integer;
  ov2, ov: cardinal;
  p: pointer;
begin
  if OldProcedure = nil then
  begin
    Data.Location := nil;
    Exit;
  end;
  if Assigned(Data) then
    if (Data.Location <> nil) then
      Exit; { procedure already overwritten }

  // need six bytes in place of 5
  x := PAnsiChar(OldProcedure);
  if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
    RaiseLastOSError;

  // if a jump is present then a redirect is found
  // $FF25 = jmp dword ptr [xxx]
  // This redirect is normally present in bpl files, but not in exe files
  p := OldProcedure;

  if Word(p^) = $25FF then
  begin
    Inc(Integer(p), 2); // skip the jump
    // get the jump address p^ and dereference it p^^
    p := Pointer(Pointer(p^)^);

    // release the memory
    if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
      RaiseLastOSError;

    // re protect the correct one
    x := PAnsiChar(p);
    if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
      RaiseLastOSError;
  end;

  if Assigned(Data) then
  begin
    Move(x^, Data.OldCode, 6);
    { Assign Location last so that Location <> nil only if OldCode is properly initialized. }
    Data.Location := x;
  end;

  x[0] := AnsiChar($E9);
  y := integer(NewProcedure) - integer(p) - 5;
  x[1] := AnsiChar(y and 255);
  x[2] := AnsiChar((y shr 8) and 255);
  x[3] := AnsiChar((y shr 16) and 255);
  x[4] := AnsiChar((y shr 24) and 255);

  if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
    RaiseLastOSError;
end;


function NewShortCutToText(ShortCut: TShortCut): string;
var
  Name: string;
begin
  if Assigned(OnShortCutToText) then
    OnShortCutToText(ShortCut, Result)
end;

procedure EnableReplaceShortCutToText(Value: Boolean);
begin
  if Value then
    OverWriteProcedure(@ShortCutToText, @NewShortCutToText, @OldShortCutToText)
  else
    RestoreProcedure(@ShortCutToText, OldShortCutToText);
end;


{initialization
   OverWriteProcedure(@ShortCutToText, @NewShortCutToText, @OldShortCutToText);

finalization
   RestoreProcedure(@ShortCutToText, OldShortCutToText); }

end.

[toms]

Delphi-Quellcode:

function ShortCutToText(ShortCut: TShortCut): string;
var
  Name: string;
  Key: Byte;
begin
  Key := LoByte(Word(ShortCut));
  case Key of
    $08, $09:
      Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcBkSp) + Key - $08)];
    $0D: Name := MenuKeyCaps[mkcEnter];
    $1B: Name := MenuKeyCaps[mkcEsc];
    $20..$28:
      Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcSpace) + Key - $20)];
    $2D..$2E:
      Name := MenuKeyCaps[TMenuKeyCap(Ord(mkcIns) + Key - $2D)];
    $30..$39: Name := Chr(Key - $30 + Ord('0'));
    $41..$5A: Name := Chr(Key - $41 + Ord('A'));
    $60..$69: Name := Chr(Key - $60 + Ord('0'));
    $70..$87: Name := 'F' + IntToStr(Key - $6F);
  else
    Name := GetSpecialName(ShortCut);
  end;
  if Name <> '' then
  begin
    Result := '';
    if ShortCut and scShift <> 0 then Result := Result + MenuKeyCaps[mkcShift];
    if ShortCut and scCtrl <> 0 then Result := Result + MenuKeyCaps[mkcCtrl];
    if ShortCut and scAlt <> 0 then Result := Result + MenuKeyCaps[mkcAlt];
    Result := Result + Name;
  end
  else Result := '';
end;

[Marco Steinebach]

Hallo Toms,
Super! Ganz große Klasse!!!!
Die Unit läuft, wenn man aus RaiseLastOSError RaiseLastWin32Error macht, auch einwandfrei unter Delphi 5.
Ich hab sie gerade eingebaut, zwei Shortcuts im Event definiert, läuft super!
Ein Riesenlob!
Viele Grüße
Marco