unit export1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, Clipbrd;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ApplicationActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);


  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// -------------------- Programm schließen
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
   close;
end;

// -------------------- Quelltext lesen
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
   memo1.lines.loadfromfile('export1.pas');
end;

//  -------------------- Box löschen
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
   memo1.lines.clear;
end;

// -------------------- MIDOSThesaurus holen
function exec(fname:string):boolean;
var pex:pchar;
    exresult:integer;
begin
   pEx := StrAlloc(Length(fname) + 1);
   StrPCopy(pEx, fname);
   exresult := WinExec(pEx, SW_ShowNormal);
   StrDispose(pEx);
   Result := ExResult > 31;
end;

function SetTOPWindow(sw:string):boolean;
var hW: hWnd;
    i:integer;

function Searchwindow(hWindow: hWnd):boolean; //stdcall;
var lpBuffer: PChar;
    z:string;
begin
   Searchwindow:=false;
   GetMem(lpBuffer, 255);
try
   if GetWindowText(hWindow, lpBuffer,255)>0 then
   begin
      z:=StrPas(lpBuffer);
      if pos(sw,uppercase(z))>0 then
      begin
         SearchWindow:=true;
         if IsIconic(hWindow) then ShowWindow(hWindow, SW_SHOWNORMAL)
  	 else BringWindowToTop(hWindow);
      end;
   end;

finally
   FreeMem(lpBuffer, sizeof(lpBuffer^));
end;
end;

begin
   SetTOPWindow:=false;
   sw:=uppercase(sw);
   hW:=GetTopWindow(0);
   i:=0;
   while hw<>0 do
   begin
      if SearchWindow(hw) then
      begin
         SetTOPWindow:=true;
         exit;
      end;
      inc(i);
      if i>1000 then break;
      hW:=GetNextWindow(hw,GW_HWNDNEXT);
   end;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
   if not SetTOPWindow('m2tshow') then exec('m2tshow.exe')
end;

// -------------------- Terme vom MIDOSThesaurus übernehmen
procedure TForm1.FormCreate(Sender: TObject);
begin
   //Methode einrichten, die beim Aktivieren des Programmes aufgerufen wird
   Application.OnActivate := ApplicationActivate;
end;

// Terme von der Ablage übernehmen, beim Aktivieren des Programmes
procedure TForm1.ApplicationActivate(Sender: TObject);
const maxpuffer=500000;
var puffer:array[0..maxpuffer] of char;
begin
   //clipbord kopieren
   If not Clipboard.HasFormat(CF_TEXT) then exit;
   fillchar(puffer,maxpuffer,#0);
   clipboard.gettextbuf(puffer,maxpuffer);

   //MIDOSThesaurus-Kennung prüfen (&&&)
   if (puffer[0]='&') and (puffer[1]='&') and (puffer[2]='&') then
   begin
      //Ablage löschen
      clipboard.clear;

      //Kennung löschen
      move(puffer[3],puffer[0],maxpuffer);

      //zum Anzeigefeld kopieren
      memo1.settextbuf(puffer);
   end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   //beim Programmstart Ablage prüfen
   ApplicationActivate(Self);
end;

end.
