Joachim Mohr Mathematik Musik Delphi
≡

Häufig gestellte Fragen und
Antworten zu Delphi

Hinweis: Lektion 15 bis 19 werden für Lektion 20ff nicht vorausgesetzt.

Elementares
Das n-te Zeichen des Strings u.ä. (s[k] tolerant)
Enthält ein String nur Leerzeichen?
Strings ab einer gewissen Stelle lesen.
Wie schneide ich von einem String alles nach dem letzten Backslash ab?
Wie kann ich das zweite, dritte oder vierte Vorkommen u.s.w. eines Teilstrings in einem String ermitteln
Wie kann ich das letzte Vorkommen eines Teilstrings in einem String ermitteln
Wie kann ich das erste, zweite oder dritte Wort u.s.w. in einem String ermitteln?
Drucken
Wie kann ich einen beliebigen Text drucken?
Die Umlaute werden nicht richtig gedruckt.
Texte abspeichern
Wie kann ich den Inhalt eines Memos auf Festplatte speichern?
Wie kann ich den Inhalt eines Strings auf Festplatte speichern?
Wie kann ich den Inhalt von Editfeldern auf Festplatte speichern?
Sound
Wie erzeuge ich eine Wav-Datei?
Graphik
Wie zeige ich eine JPEG-Datei?
Wie helle ich ein Bild auf? (Oder: Wie verwende ich "scanline"?)
Grundlagen
Warum meldet der Compiler "Auf a zugewiesener Wert wird niemals benutzt"?
Was bedeutet overload?
Oder: Wie entferne ich die hinteren Zeichen eines Strings?
Oder: Wie vertausche ich Zahlen oder Strings?
Was bedeutet try?
Ist es möglich, dass ich als Rückgabewert einer Funktion ein Array übergeben kann?
Meine Schleife zählt von 8 bis 0 statt von 1 bis 9. Wie kommt das?
Verzeichnisse
Ordner
Verzeichnisstruktur einlesen
Ein eigenen Explorer
Die ganze Festplatte nach eine bestimmten Text durchsuchen
Andere Dateien und Programme
Mit Notepad Datei öffnen
Mit externem Programm Datei öffnen
Wie starte ich von einem Delphiprogramm ein weiteres (externes) Programm?
Formulare
Wie kann ich im Programm meinen Programmnamen mit Pfad ermitteln?
Mein Memo soll die Scrollbalken erst zeigen, wenn es notwenig ist. Wie mache ich das?
Wie kann ich beim Start meines Programms Parameter entgegenzunehmen?
Wie kann ich einen Menüpunkt (de-)aktivieren?
Wie kann ich edi1, edit2, ... edit20 elegant alle löschen?
Wie kann ich Zeile und Spalte des Cursors in einer Statusbar anzeigen?
Wie kann ich eine Stringgrid-Zelle farbig darstellen?
Wie kann ich das Fenster des Opendialogs größer machen? (Und gleichzeitig "Details" zeigen)
Wie kann ich in mein Programm ein Symbol einbinden?
Wie kann ich bei langwierigen Berechnungen einen Abbrechenknopf einblenden?
Bildschirmschoner (und: Verhindern, dass Programm zweimal aufgerufen wird).
Wie kann ich ein Objekt durch Ziehen bewegen?
Wie kann ich ein Timage um 90° drehen?
Wie kann ich eine Verknüpfung auf dem Desktop zu meinem Programm erzeugen?
Bei meiner Webbrowserkomponente funktioniert Kopieren und Einfügen nicht.
Mein Programm ist mit dem xyz-File verbunden. Es soll nach Doppelklick auf ein xyz-File sich aber nicht mehrfach öffnen.
Mathematisches
Wie drehe ich ein Objekt um ein Zentrum?
Wie haben Sie die Lissajou-Animation programmiert?
Ini-Daten und Registry
Beim savedialog den Dateinamen merken
Programmeinstellungen merken
Wie erhalte ich alle Benutzereinstellungen beim Programmstart?
In die Registry schreiben und aus der Registry lesen (Tu's nicht!)
Wie übertrage ich die Registry-Einstellungen von Delpi auf weitere Benutzer?
Ressourcen ohne großen Aufwand einbinden
Notenschlüssel Wie zeichne ich mit Delphi eine einfache Zeichnung ohne aufwendige Ressourcen-Edition?
Wie kann man einen formatierten Text als String schreiben und in einem Richeditfeld darstellen?
Wie kann man einen formatierten Text als String schreiben und in einem Webbrowser darstellen?
Wie binde ich ohne aufwendige Ressourcen-Edition eine Binärdatei in Delphi ein?
Wie binde ich ohne aufwendige Ressourcen-Edition eine Bilddatei in Delphi ein?
Wie binde aufwendigere Ressourcen in Delphi ein?
Tricks
Wie kann ich Texte aus Nichttextdateien lesen?
Empfehlenswerte Delphi-Links
www.delphi-fundgrube.de" Simon Reinhards Fundgrube (Nur noch im Archiv aufrufbar:Archiv)
Der Delphikurs von M.Papst
Swiss Delphi Center
Oft ist die Suche in Google in der Abteilung "News" unter "Delphi MeinStichwort" erfolgreich.

Spitze Klammern in Delphi

Da spitze Klammern in der Webpräsenz eine besondere Bedeutung haben, werden sie hier ersetzt:
〈 = kleiner als
〉 = größer als.

Wenn Sie ein Delphi-Programm von hier kopieren und in Ihr Delphi einfügen, so ergeben diese Zeichen eine Fehlermeldung. Ersetzten Sie dann bitte.

"〈" durch das Zeichen "kleiner als" und
"〉" durch das Zeichen "größer als".

Genauer ...

Warum meldet der Compiler: "Auf a zugewiesener Wert wird niemals benutzt"?

In meiner Prozedur, die zwei Werte vertauscht, ist doch alles richtig!
Kann ich die Compilermeldung deshalb ignorieren? 
procedure tausche(a,b: string);
  var x: string;
begin
  x := a;
  a := b;
  b := x;
end;
Niemals! Wie leicht man doch etwas vergisst, sieht man hier.
Füge mal folgendes Testprogramm ein! 
procedure TForm1.Button1Click(Sender: TObject);
  var u, v: string;
begin
  u := 'A';
  v := 'B';
  showmessage('1.' + u + ' 2.' + v);
  tausche(u,v);
  showmessage('1.' + u + ' 2.' + v + ' Nun vertauscht?');
end;
Die Prozedur tut nicht, was Du erwartet hast.
Jetzt fällt Dir ein: Es muss natürlich heißen: 
procedure tausche(var a,b: string);
(a, und b sind Variablenparameter!).
Außerdem hast Du folgende Regel nicht beachtet:

Jede Prozedur, die man schreibt, sollte man sofort daraufhin testen, ob sie in allen möglichen Fällen das tut, was man von ihr erwartet.

Man erspart sich dadurch stundenlanges "debuggen".

Diese Regel hast Du hier anscheinend nicht befolgt. Sonst hättest Du selbst Deinen Kardinalfehler bemerkt.

Was bedeutet overload ?

Oder: Wie entferne ich die hinteren Zeichen eines Strings?
Oder: Wie vertausche ich Zahlen oder Strings?

In Delphi ist es möglich, Funktionen und Prozeduren mit gleichem Namen, aber unterschiedlichen Parametern zu definieren.
Bei folgenden Prozeduren kannst du zum Beispiel mit kup(s) das letzte Zeichen, mit kup(s,3) die letzten drei Zeichen von s entfernen.1 
procedure kup(var s: string); overload;
begin s := copy(s, 1, length(s) - 1) end;

procedure kup(var s: string; Anzahl: integer); overload;
begin
  kup(s);
  if Anzahl 〉 1 then kup(s, Anzahl - 1); //rekursiv
end;
Oft will man Zahlen oder Strings tauschen. Durch folgende Prozeduren wird das Programmieren vereinfacht: 
procedure tausche(var a, b: string); overload;
  var c: string;
begin
  c := a;
  a := b;
  b := c;
end;

procedure tausche(var a, b: integer); overload;
  var c: integer;
begin
  c := a;
  a := b;
  b := c;
end;

procedure tausche(var a, b: Extended); overload;
  var c: extended;
begin
  c := a;
  a := b;
  b := c;
end;

Das n-te Zeichen des Strings.

Folgende Funktion erspart dir die Bereichsüberprüfung bei "s[k]".
Das k-te Zeichen in s: 
function char_(const s: string; const k: integer): char;
begin
  if (k 〈= 0) or (k〉length(s)) then result := #0 //oder ' '
    else result := s[k]
end;
Das letzte Zeichen eines Strings ermittelt folgende Funktion: (s='' erlaubt) 
function char_last(const s: string): char;
  begin result := char_(s, length(s)) end;
Mit folgender toleranten Funktion kannst du das k-te Zeichen eines Strings überschreiben.1 
procedure char_in(var s: string; k: integer; c: char); //s[k]:=c
begin
  while length(s) 〈k do s := s + ' ';
  s[k] := c
end;

Enthält ein String nur Leerzeichen (oder ist leer)? 

function OnlySpaces(s: string): boolean;
begin
  result := (s = StringOfChar(' ',length(s)));
end;

Strings ab einer gewissen Stelle lesen

function copyab(const s: string; const i: integer): string;
begin result := copy(s, i, length(s) - i + 1) end;

Wie schneide ich von einem String alles nach dem letzten Backslash ab?

Ich habe eine Anwendung, in der ich durch das lokale Dateiensystem navigiere. Ich möchte nun eine Ebene nach oben gehen. Wie komme ich zum Beispiel von "c:\Programme\Borland\Delphi" nach "c:\Programme\Borland"?

Anwort: Rückwärts im String nach einem Backslash suchen, Rest abschneiden: 
k := length(pfad); //z.B. pfad='c:\Programme\Borland\Delphi'
while (k>0) and (pfad[k]〈〉'\') do dec(k);
pfad := copy(pfad,1,k-1) //Jetzt pfad='c:\Programme\Borland';

Wie kann ich das zweite, dritte oder vierte Vorkommen u.s.w. eines Teilstrings in einem String ermitteln?

pos('abc',s) ermittelt die Position in s, bei der 'abc' zum ersten Mal auftaucht. Ich möchte aber zum Beispiel die Position ermitteln, wo 'abc' zum dritten Mal auftaucht.1 
function pos_n(const a: string; b: string; n: integer): integer;
var k: integer;
begin
  if n 〈1 then Begin result := 0; exit End;
      //Sollte nicht vorkommen
  if n = 1 then result := pos(a, b) else Begin
    k := pos(a, b);
    if k = 0 then result := 0 else BEgin
      b := copyab(b, k + 1);
      result := pos_n(a, b, n - 1); //rekursiv
      if result > 0 then result := k + result;
    ENd;
  End;
end;

Wie kann ich das letzte Vorkommen eines Teilstrings in einem String ermitteln?

Antwort: Mit der Funktion lastpos: 
function copyab(const s:string; const i:integer):string;
  //Rest von s ab i-tem Zeichen
  begin result:=copy(s,i,length(s)-i+1) end;

function lastpos(const klein, gross: string): integer;
  //die letzte Position von a in b wird gesuch
   var k: integer;
begin
  for k := length(gross) - length(klein) + 1 downto 1 do
    if pos(klein,copyab(gross,k)) = 1 then Begin
      result := k;
      exit;
    End;
  result := 0; //nicht vorhanden
end;

Wie kann ich das erste, zweite oder dritte Wort u.s.w. in einem String ermitteln?

Die Wörter im String seinen durch Leerstellen oder Zeilenumbrüche getrennt. Zum Beispiel: s :='abc def hij pqr uvw'. Dann ist wort(s,4)='pqr'.1 
function wort_(s: string; k: integer): string;
var n: integer;
begin
  s := trim(s);
    //entfernt Leerzeichen, #13 oder andere Steuerzeichen
  n := pos(' ', s);
  if n = 0 then n := pos(#13,s); //Zeilenumbruch
  if n = 0 then Begin
    if k 〉 1 then result := '' else result := s
  End else Begin //z.B. s='abc def;
    if k 〉 1 then
      result := wort_(copyab(s, n + 1), k - 1)
        //rekursiv
    else result := copy(s, 1, n - 1);
  End;
end;

Wie kann ich einen Text drucken?

Folgende Prozedur funktioniert auf jedem Drucker (vor allem: sehr schnell auf alten Nadeldruckern).
Wichtig: In die Uses-Klausel Winspool mit einbinden. Im Beispiel wird der Inhalt eines Memos ausgedruckt. 

procedure DruckeRoh_String(DiesenText:string); //uses WinSpool;

var Printer : array [0..255] of char;
    p       : Integer;

  function RawDataToPrinter(const szPrinterName : string;
                            const data:string;
                            dwCount : DWORD) : boolean;
  var
    hPrinter       : THandle;
    DocInfo        : TDocInfo1;
    dwJOB          : DWORD;
    dwBytesWritten : DWORD;
  begin
    Result := False;
    if OpenPrinter (pchar (szPrinterName), hPrinter, Nil) then
      try
        // Fill in the structure with info about this "document"
        DocInfo.pDocName := 'My Document';
        DocInfo.pOutputFile := Nil;
        DocInfo.pDatatype := 'RAW';
        // Inform the spooler the document is beginning
        dwJob := StartDocPrinter (hPrinter, 1, @docInfo);
        if dwJob  〈〉 0 then
          try
            if StartPagePrinter (hPrinter) then
              try
                if WritePrinter (hPrinter, Pchar(data),
                  dwCount, dwBytesWritten) then
                  Result := dwBytesWritten = dwCount;
              finally
                EndPagePrinter (hPrinter)
              end
          finally
            EndDocPrinter (hPrinter);
          end
      finally
        ClosePrinter (hPrinter)
      end
  end; {RawDataToPrinter}

begin
  GetProfileString ('windows',
                    'device',
                    ',,,',
                    Printer,
                    sizeof(Printer));
  p := Pos (',', Printer);
  if p > 0 then
    Printer [p - 1] := #0;
  RawDataToPrinter (Printer, DiesenText, length(DiesenText));
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  DruckeRoh_String(memo1.text+#12);
end;

Bemerkung: Steuerzeichen müssen mit den alten Escape-Sequenzen zum Drucker geschickt werden. Bei meinen alten IBM-Nadeldrucker zum Beispiel: 

Neue Seite:            #12
Zeilenwechsel:         #13#10
Schnellschrift:        #27#73#0
Schönschrift:          #27#73#2
Unterstreichen Anfang: #27#45#1
Unterstreichen Ende:   #27#45#0

Die Umlaute werden nicht richtig gedruckt.

Wenn ich nach der vorhergehenden Methode direkt auf den (Nadel-)Drucker schreibe, werden die Umlaute nicht richtig dargestellt?

Antwort: Der Direktdruck stammt noch aus den alten DOS-Zeiten (Ein Betriebssystem vor Linux oder Windows). Dort hatten die Umlaute einen anderen Ascii-Code. Für die Umwandlung gibt es aber in der unit Windows Proceduren, die für Delphi allerdings wegen der Verwendung von nullterminierten Strings folgendermaßen verwendet werden müssen:1 
procedure AsciiZuAnsi(var s: string);
begin
  if s 〉 '' then OemToChar(Pchar(s), PChar(s));
end;

procedure AnsiZuAscii(var s: string);
begin
 if s 〉 '' then CharToOem(Pchar(s), Pchar(s));
end;
Wandle also jeden String entsprechend um, bevor Du ihn zum Drucker schickst!

Wie kann ich den Inhalt eines Memos auf Festplatte speichern?

Einfachste Version: 

procedure TForm1.Button1Click(Sender: TObject); //Speichern
begin
  memo1.Lines.SaveToFile('c:\test.txt');
end;

procedure TForm1.Button2Click(Sender: TObject); //Einlesen
begin
  memo1.Lines.LoadFromFile('c:\test.txt');
end;
Damit hast Du eine weitere überflüssige Datei auf dem Wurzelverzeichnis erzeugt. (Machen übrigens viele Programme ... getarnt als LOG-Datei.). Du solltest die Datei in einem Ordner ablegen, für den Du Dir noch einen passenden Namen ausdenken solltest.

Zweite Version:

Wir verstecken also unsere Datei ein wenig, in dem wir einen neuen Unterordner der "Programme"-Ordners anlegen und dort unsere Datei abspeichern. 
uses FileCtrl;

procedure TForm1.Button1Click(Sender: TObject); //Speichern
begin
  ForceDirectories('C:\programme\versteckterOrdner');
    //Benötigt " uses FileCtrl"
  memo1.Lines.SaveToFile('C:\programme\versteckterOrdner\test.txt');
end;

procedure TForm1.Button2Click(Sender: TObject); //Einlesen
begin
  memo1.Lines.LoadFromFile('C:\programme\versteckterOrdner\test.txt');
end;

Dritte Version:

Am besten ist es natürlich, der Anwender bestimmt selbst den Ort, wo seine Datei abgespeichert werden soll: 
{Benötigt werden neben den beiden Buttons
 und dem Memo noch
 vom Komponentenreiter "Dialoge" ein
 Opendialog und ein Savedialog}

procedure TForm1.Button1Click(Sender: TObject); //Speichern
  var pfad: string;
begin
 with savedialog1 do if execute then
   pfad := filename else exit;
 memo1.Lines.SaveToFile(pfad);
end;

procedure TForm1.Button2Click(Sender: TObject); //Einlesen
  var pfad: string;
begin
  with opendialog1 do if execute then
    pfad := filename else exit;
  memo1.Lines.LoadFromFile(pfad);
end;

Fast schon professionelle Version

Auf der Downloadseite findest Du in der Abteilung Alle Delphi-Quellcode-Dateien als Zip-Downloads alphabetisch die Datei "editorpas.zip".

Der Quellcode sei hier zum Studium wiedergegeben: 
(* Ein einfacher Editor mit Öffnen und Speichern von Dateien.
   Dabei soll demonstriert werden, wie benutzerspezifische Angaben
   in einer Ini-Datei gespeichert werden.
   ——————————————————————————————————————————————————————————————
   Stichworte:  OpenDialog
                ClosDialog
                IniFiles
*)
unit Unieditor;  // DFM-Datei binär gespeichert.

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, IniFiles;

type
  TFEditor1 = class(TForm)
    Panel1: TPanel;
    BOeffnen: TButton;
    BSichern: TButton;
    BLoeschen: TButton;
    BClose: TButton;
    StatusBar1: TStatusBar;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure BOeffnenClick(Sender: TObject);
    procedure BSichernClick(Sender: TObject);
    procedure BLoeschenClick(Sender: TObject);
    procedure BCloseClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  FEditor1: TFEditor1;

implementation

{$R *.DFM}

function IniPfad:string;
begin
 result:=extractFilepath(paramstr(0))//der exe-pfad des Programms
         +'MyIni.ini';
end;

function HoleDateiPfad:string;
    //Dass man noch weiss, wo Datei gespeichert wurde.
  var MyIniFile:TIniFile;
    //benötigt uses IniFiles.
    //Ini-Dateien sind besser als in Registry schreiben!
begin
  MyIniFile:=Tinifile.create(Inipfad);
  try
    result:=MyIniFile.ReadString('Section1','Schluessel1', 'File1');
  finally MyIniFile.Free End;
end;

procedure SchreibeDateiPfad(pfad:string); /
  /Dass man noch weiss, wo Datei gespeichert wurde
  var MyIniFile:TIniFile;
    //benötigt uses IniFiles. So besser als in der Registry
begin
  MyIniFile:=Tinifile.create(Inipfad);
  try
    MyIniFile.WriteString('Section1','Schluessel1', pfad);
  finally MyIniFile.Free End;
end;



procedure TFEditor1.BOeffnenClick(Sender: TObject);
begin
 {Es funktioniert bereits mit den folgenden zwei Zeilen
  if OpenDialog1.Execute then
    memo1.Lines.LoadFromFile(Opendialog1.Filename);
 komfortabler ist:}
  with  opendialog1 do Begin
  //bewirkt, dass nicht stets "Opendialog1." geschriebeb werden muss
    title:='Hallo Festplatte! Jetzt bleibt mir nichts verborgen!';
    Initialdir:=extractFilepath(holedateipfad);
    filename:=extractFilename(holedateipfad);
    options:=[ofFileMustExist,ofAllowMultiselect,ofHideReadOnly,
                ofShareAware,
                ofEnableSizing,{ofShowHelp,}
                {ofOldStyleDialog,}ofNoTestFileCreate,ofNoValidate];
    Filter :='Pascal-Dateien (*.PAS)|*.PAS|Textdateien (*.txt)|*.TXT|'
              +'Alle Dateien (*.*)|*.*';
    DefaultExt:='';
    if Execute then Begin
      memo1.Lines.LoadFromFile(Opendialog1.Filename);
      SchreibeDateiPfad(Opendialog1.Filename);
    End else showmessage('Abbruch!');
 End;
end;

procedure TFEditor1.BSichernClick(Sender: TObject);

begin
 {Es funktioniert bereits mit den folgenden zwei Zeilen
    if SaveDialog1.Execute then
      memo1.Lines.SaveToFile(Savedialog1.Filename);
    komfortabler ist:}
   with SaveDialog1 do Begin /
     /bewirkt, dass nicht stets "Savedialog1." geschriebeb werden muss
     Options:=[ofCreatePrompt,ofEnableSizing,ofHideReadOnly,
       ofShareAware,ofEnableSizing]; //Ohne Kästchen
     //Options:=[ofHideReadOnly,ofOverwritePrompt];
     //Rückfrage entfällt
     Initialdir:=extractFilepath(HoleDateipfad);
     filename:=extractFilename(holedateipfad);
     Filter :='Pascal-Dateien (*.PAS)|*.PAS|Textdateien (*.txt)|*.TXT|'
               +'Alle Dateien (*.*)|*.*';
     DefaultExt:='';
     if execute then Begin
       memo1.Lines.SaveToFile(Savedialog1.Filename);
       schreibeDateiPfad(Savedialog1.Filename);
     End else showmessage('Nicht gespeichert');
   End;
end;

procedure TFEditor1.BLoeschenClick(Sender: TObject);
begin
  Memo1.lines.clear;
end;

procedure TFEditor1.BCloseClick(Sender: TObject);
begin
  close
end;

end.

Wie kann ich den Inhalt eines Strings auf Festplatte speichern?

Mit folgender Prozedur: 
procedure SpeichereString(const s, pfad:string);
  var sl: Tstringlist;
begin
  sl := Tstringlist.create;
  try
    sl.text := adjustlinebreaks(s);
    sl.SaveToFile(pfad);
  finally sl.free end;
end;
Ein TStringlist hat die Methode SaveToFile und damit kannst Du den String s abspeichern.

adjustlinebreaks macht aus dem String 
s := 'erste Zeile'#13+
     'zweite Zeile'#13+
     'dritte Zeile'
den folgenden String mit für Windows richtigen Zeilenumbrüchen. 
s := 'erste Zeile'#13#10+
     'zweite Zeile'#13#10+
     'dritte Zeile'
Wie Du den Pfad bestimmen kannst, siehst Du hier in verschiedenen Versionen.

Wie kann ich den Inhalt von Editfeldern auf Festplatte speichern?

Hier ein Beispiel, wie der Quellcode für das Speichern und einlesen aussehen könnte: 
{Benötigt werden neben den beiden Buttons
 und den drei Bditfeldern wird noch
 vom Komponentenreiter "Dialoge" ein
 Opendialog und ein Savedialog}

procedure TForm1.Button1Click(Sender: TObject); //Speichern
  var zeile1, zeile2, zeile3: string;
      pu: Tstringlist;
begin
  zeile1 := edit1.text;
  zeile2 := edit2.text;
  zeile3 := edit3.text;
  pu := Tstringlist.Create; //Jedes "Create" benötigt ein "free"
  try
    pu.Add(Zeile1);
    pu.Add(Zeile2);
    pu.Add(Zeile3);
    // statt pu.savetofile('c:\test.txt');
    with savedialog1 do if execute then
      pu.SaveToFile(filename);
  finally pu.free End;
end;

procedure TForm1.Button2Click(Sender: TObject);
  //Am nächsten Tag wieder einlesen
procedure TForm1.FormCreate(Sender: TObject);
  var zeile1, zeile2, zeile3: string;
      pu: Tstringlist;
begin
  pu := Tstringlist.Create; //Jedes "Create" benötigt ein "free"
  // statt pu.LoadFromFile('c:\test.txt');
  with opendialog1 do if execute then
      pu.LoadfromFile(filename);
  try
    if pu.count 〉 0 then Zeile1 := pu[0] else zeile1 := 'Fehlanzeige';
    if pu.count 〉 1 then Zeile2 := pu[1] else zeile2 := 'Fehlanzeige';
    if pu.count 〉 2 then zeile3 := pu[2] else zeile3 := 'Fehlanzeige';
    //Beachte!
    edit1.text := zeile1;
    edit2.text := zeile2;
    edit3.text := zeile3;
  finally pu.free End;
end;
Bemerkung: Das einlesen könnte auch in "procedure TForm1.FormCreate(Sender: TObject)" erfolgen. Dann mit festem Speicherpfad, also etwa "pu.LoadFromFile('c:\test.txt')"

Wie erzeuge ich eine Wav-Datei?

Antwort: Binde folgende unit ein!

Um zum Beispiel den Kammerton mit 440 Hz als Sinuston eine Sekunde lang erklingen zu lassen, mußt Du aufrufen: 
 spieleSinus(440,100,8); //uses unit wavton
——— Beginn der unit ——— 
unit wavton;
{Ausgerichtete Recordfelder aus!!!}
{$A-}

interface

uses forms,    //für application
     Classes,  // für TMemoryStream
     mmsystem; // für sndPlaySound

const sampl441 = 441; //für eine 1/100-Sekunde
  Anzahl_stereokanaele = 8;
  sampl22050 = 50*sampl441; //22050
type
  Tlautstaerke = 0..8;
  TRiffHeader = record
    riff: Array[0..3] OF Char;
    filesize: LongInt;
    typeStr: Array[0..3] OF Char;
  end;
  TChunkRec = record
    id: Array[0..3] OF Char;
    size: LongInt;
  end;
  TWaveFormatRec = record
    tag: Word;
    channels: Word;
    samplesPerSec: LongInt;
    bytesPerSec: LongInt;
    blockAlign: Word;
  end;
  TPCMWaveFormatRec = record
    wf: TWaveFormatRec;
    bitsPerSample: Word;
  end;
  TWAVHeader = record { WAV Format }
    riffHdr: TRiffHeader;
    fmtChunk: TChunkRec;
    fmt: TPCMWaveFormatRec;
    dataChunk: TChunkRec;
    { data follows here }
  end;

procedure spieleSinus(frequenz: double;
  cs: Cardinal; lautstaerke: Tlautstaerke);
//cs=CentiSekuns
implementation

procedure HeadInit(var Header: TWAVHeader);
begin
  with Header do
  begin
    with riffHdr do
    begin
        //Schreibe 'RIFF' in die ersten 4 bytes
      riff[0] := char($52); riff[1] := char($49);
        riff[2] := char($46); riff[3] := char($46);
        // wird spaeter gesetzt;
      filesize := 0;
        //Schreibe 'WAVE' in die naechsten 4 bytes
      typeStr[0] := char($57); typeStr[1] := char($41);
      typeStr[2] := char($56); typeStr[3] := char($45);
    end;
    with fmtChunk do
    begin
        //Schreibe 'fmt' + char($20) in die naechsten 4 bytes
      id[0] := char($66);
      id[1] := char($6D);
      id[2] := char($74);
      id[3] := char($20);
      size := $10;
    end;
    with fmt.wf do
    begin
        //its 16 bit, 44kHz Stereo
      tag := 1; channels := 2;
      samplesPerSec := $AC44;
      bytesPerSec := 176400;
      blockAlign := 4;
      fmt.bitsPerSample := $10;
    end;
    with dataChunk do
    begin
        //Schreibe 'data' in die naechsten 4 bytes
      id[0] := char($64);
      id[1] := char($61);
      id[2] := char($74);
      id[3] := char($61);
      size := 0;
    end;
  end;
end;

function f0(const k: double): SmallInt; //k=i*Frequ i:=0 to ...
begin
  result := Round(sin(k*Pi/sampl22050)*32000/Anzahl_stereokanaele)
    //               Frequenz        Amplitude
  {Üblicherweise werden hier für den Sinus Tafeln verwendet und
   Schleifen durchlaufen. Das spart Rechenzeit.
   Die Werte müssen allerdings dann
   gerundet werden, um den Schleifenübergang zu glätten.
   Bei gleichstufiger Stimmung ist das in Ordnung.
   Hier soll die Frequenz aber exakt ausgegeben werden.
   Weitere Frequenzen und Obertöne könner hier aufaddiert werden.}
end;

function AbtastwertSinus(const k:double): SmallInt;
begin
  //z.B. k=i*frw1 (für i=441*500(5Sek) frw1=100)=max=sampl220500000
                                           //Longword=0..4294967295
  result := f0(k);
end;

procedure spieleSinus(frequenz: double; cs: Cardinal;
  lautstaerke: Tlautstaerke);
  //cs=CentiSekunde
     const Ausgabekanal_wird_bereits_verwendet =
     'Ausgabekanal wird bereits verwendet!';
var ms: TMemoryStream;
  Header: TWavHeader;
  i: integer; //z.B. i=0 to 441*500=441500 (5 Sekunden)
  s: SmallInt;
begin
  HeadInit(Header);
  Header.Datachunk.size := sampl441 * cs * 2 * 2;
    //441*cs Samples pro sekunde,
    //2 Channels, 2Bytes (16bit)
  //FileSize = DataSize + HeaderSize
  Header.riffHdr.FileSize := Header.Datachunk.size + 24;
  ms := TMemoryStream.Create;
  try
    ms.Seek(0, 0);
    //Write Header to Stream
    ms.Write(Header, sizeof(header));
    //form here: just data chunks. in this case (16bit stereo):
    // 16bit LeftValue, 16bit Right Value,
    //16bit LeftValue, 16bit Right Value ...
    // in the range of a SmallInt
    if cs 〈= 0 then exit; //1
    for i := 0 to sampl441 * cs - 2 do BEgin
        //Writing left channel
        s := AbtastwertSinus(i * frequenz)*Lautstaerke;
        ms.Write(s, 2);
        //Writing to right channel
        ms.Write(s, 2);
    ENd;
  Finally
      sndPlaySound(ms.Memory, SND_MEMORY or SND_SYNC);
      //Speichern? Bitte schön: ms.SaveToFile('c:\windows\meinton.wav');
      application.ProcessMessages;
    ms.Free;
  End;
end;

end.
- - - - /Ende der Unit - - - -
In TTMusik können 8-stimmige Tonsätze gespielt werden, wobei noch die Klangfarbe (also die Beimischung von Obertönen) berücksichtigt wird. Die zugehörige unit ist Folgende:

- - - - - /Beginn unit tttmusik Klangerzeugung - - - - - - 
 unit Unit2;
{Ausgerichtete Recordfelder aus!}
{$A-}

interface

uses forms, //für application
     sysutils, //fileexists
     Classes, mmsystem, WinProcs;
const sampl441 = 441; //für eine 1/100-Sekunde
  sampl22050 = 50*sampl441; //22050

type
  TRiffHeader = record
    riff: Array[0..3] OF Char;
    filesize: LongInt;
    typeStr: Array[0..3] OF Char;
  end;
  TChunkRec = record
    id: Array[0..3] OF Char;
    size: LongInt;
  end;
  TWaveFormatRec = record
    tag: Word;
    channels: Word;
    samplesPerSec: LongInt;
    bytesPerSec: LongInt;
    blockAlign: Word;
  end;
  TPCMWaveFormatRec = record
    wf: TWaveFormatRec;
    bitsPerSample: Word;
  end;
  TWAVHeader = record { WAV Format }
    riffHdr: TRiffHeader;
    fmtChunk: TChunkRec;
    fmt: TPCMWaveFormatRec;
    dataChunk: TChunkRec;
    { data follows here }
  end;

var lautstaerke: integer = 3200;

procedure spiele(fr1, fr2, fr3, fr4, fr5, fr6, fr7,
  fr8: double; tondauer: integer);
procedure spieleton(fr: double; tondauer: integer);



implementation

uses FileCtrl;


procedure HeadInit(var Header: TWAVHeader);
begin
  with Header do
  begin
    with riffHdr do
    begin
        //Schreibe 'RIFF' in die ersten 4 bytes
      riff[0] := char($52);
      riff[1] := char($49);
      riff[2] := char($46);
      riff[3] := char($46);
        // wird spaeter gesetzt;
      filesize := 0;
        //Schreibe 'WAVE' in die naechsten 4 bytes
      typeStr[0] := char($57);
      typeStr[1] := char($41);
      typeStr[2] := char($56);
      typeStr[3] := char($45);
    end;
    with fmtChunk do
    begin
        //Schreibe 'fmt' + char($20) in die naechsten 4 bytes
      id[0] := char($66);
      id[1] := char($6D);
      id[2] := char($74);
      id[3] := char($20);
      size := $10;
    end;
    with fmt.wf do
    begin
        //its 16 bit, 44kHz Stereo
      tag := 1; channels := 2;
      samplesPerSec := $AC44;
      bytesPerSec := MakeLong($B110, $2);
      blockAlign := 4;
      fmt.bitsPerSample := $10;
    end;
    with dataChunk do
    begin
        //Schreibe 'data' in die naechsten 4 bytes
      id[0] := char($64);
      id[1] := char($61);
      id[2] := char($74);
      id[3] := char($61);
      size := 0;
    end;
  end;
end;

function f0(const k: double): SmallInt;
begin
  //result := Round(sin(k*Pi/sampl22050)*lautstaerke);
  //reiner sinus
  result := Round(sin((k * Pi) / sampl22050) * lautstaerke) div 2 +
      Round(sin((2 * k * Pi) / sampl22050) * lautstaerke) div 4 +
      //1.Oberton
      Round(sin((3 * k * Pi) / sampl22050) * lautstaerke) div 6;
      //2.Oberton}
end;


function Abtastwert(const k1,k2,k3,k4,k5,k6,k7,k8: double): SmallInt;
  var f:Smallint;
begin //z.B. k=i*frw1 (für i=441*500(5Sek)
      //frw1=100)=max=sampl220500000
      //Longword=0..4294967295
  if k1=0 then Begin result:=0; exit End else f:=f0(k1);
  result:=f;
  if k2=0 then exit;
  if k2 〈〉k1 then f:=f0(k2); //else f=f0(k1)
  result:=result+f;
  if k3=0 then exit;
  if k3 〈〉k2 then f:=f0(k3); //else f=f0(k2)
  result:=result+f;
  if k4=0 then exit;
  if k4 〈〉k3 then f:=f0(k4); //else f=f0(k3)
  result:=result+f;
  if k5=0 then exit;
  if k5 〈〉k4 then f:=f0(k5); //else f=f0(k4)
  result:=result+f;
  if k6=0 then exit;
  if k6 〈〉k5 then f:=f0(k6); //else f=f0(k5)
  result:=result+f;
  if k7=0 then exit;
  if k7 〈〉k6 then f:=f0(k7); //else f=f0(k6)
  result:=result+f;
  if k8=0 then exit;
  if k8 〈〉k7 then result:=result+f0(k8) else result:=result+f;
end;

procedure spiele(fr1, fr2, fr3, fr4, fr5, fr6, fr7,
  fr8: double; tondauer: integer);

var ms: TMemoryStream;
  Header: TWavHeader;
  i: integer; //z.B. i=0 to 441*500=441500 (5 Sekunden)
  s: SmallInt;
begin
  HeadInit(Header);
  Header.Datachunk.size := sampl441 * tondauer * 2 * 2;
  //441*cs Samples pro sekunde,
  //2 Channels, 2Bytes (16bit)
  //FileSize = DataSize + HeaderSize
  Header.riffHdr.FileSize := Header.Datachunk.size + 24;
  ms := TMemoryStream.Create;
  try
    ms.Seek(0, 0);
    //Write Header to Stream
    ms.Write(Header, sizeof(header));
    //form here: just data chunks. in this case (16bit stereo):
    // 16bit LeftValue, 16bit Right Value,
    //16bit LeftValue, 16bit Right Value ...
    // in the range of a SmallInt
    if tondauer 〈= 0 then exit; //kein Ton. Sollte nicht vorkommen
    for i := 0 to sampl441 * tondauer - 2 do BEgin
        //Writing left channel
        s := Abtastwert(i * fr1, i * fr2, i * fr3, i * fr4,
                        i * fr5, i * fr6, i * fr7, i * fr8);
        ms.Write(s, 2);
        //Writing to right channel
        ms.Write(s, 2);
    ENd;
  Finally
    if not sndPlaySound(ms.Memory, SND_MEMORY or SND_SYNC) then;
    ms.Free;
  End;
    { sndPlaySound(ms.Memory, SND_MEMORY or SND_ASYNC or SND_LOOP)
       führt bei WinNT zu Fehler. Deshalb dort nur snd_sync
       sndPlaySound(ms.Memory, SND_MEMORY or SND_SYNC or SND_LOOP) }
end;

procedure spieleton(fr: double; tondauer: integer);
begin
  spiele(fr, fr, fr, fr, fr, fr, fr, fr, tondauer);
end;


end.
 - - - - - Im Hauptprogramm könnte dann folgendes stehen ————
procedure TForm1.Button1Click(Sender: TObject);
begin
  spiele(440, 550, 660, 880, 440, 550, 660, 880,100);
  spieleton(440,100);
  //Dauer 100 Centisek. = 1 Sek.
end;

Zwei Fragen auf einmal beantwortet: 1. Wie zeige ich eine JPEG-Datei?
2. Wie helle ich ein Bild auf? (Oder: Wie verwende ich "scanline"?)

Antort zu 1.

Verwende die unit jpeg. Die folgenden Zeilen zeigen das Bild auf einem Canvas: 
  jpg.LoadFromFile(opendialog1.filename);
  image1.picture.bitmap.Assign(jpg);
Das ist alles! (Siehe unten "procedure TForm1.Button1_LadenClick(..."
hell

Antort zu 2.

Man kann die pixel[x,y] der Bitmap einzeln abändern!
Das ist jedoch sehr zeitaufwendig! Trickreich arbeitet man hier mit scanline!

Wie "scanline" verwendet wird, kannst Du folgendem Code entnehmen.

Es macht keine Schwierigkeit den Code so abzuwandeln, dass nur eine Farbe heller oder dunkler wird. (In TTT ist alles integriert.)

Nebenbei bemerkt: Mir ist aufgefallen, dass bei kommerziellen Bildbearbeitungsprogrammen der "Helligkeitsfaktor" additiv hinzukommt, w as mit einem unschönen "Grauschleier" belohnt wird. Hier wird der Helligkeitsfaktor proportional verändert.
hell 
type TRGBValue = packed record
  Blue: Byte;
  Green: Byte;
  Red: Byte;
End;

var
  Form1: TForm1;

implementation
uses jpeg;

{$R *.DFM}

procedure TForm1.Button1_LadenClick(Sender: TObject);
  var jpg :TJPEGImage; //uses jpeg;
begin
  jpg:=TJPEGImage.Create;
  try
    jpg.Performance :=jpBestQuality;
    jpg.ProgressiveDisplay := false;
    jpg.Performance := jpBestQuality;
      try
        with OpenDialog1 do Begin
          if not execute then exit;
          jpg.LoadFromFile(opendialog1.filename);
          image1.picture.bitmap.PixelFormat := pf24bit;
          image1.picture.bitmap.Assign(jpg);
          image1.width := image1.picture.bitmap.width;
          image1.height := image1.picture.bitmap.height;
        End;
      except Showmessage('Datei existiert nicht') End;
  finally jpg.Free; end;
end;

procedure TForm1.Button_HellerClick(Sender: TObject);
  const h = 255;
        hh = 9*h div 10; //229
var  x,y: integer;
     pixel: ^TRGBValue;
  function groesser(x: word): word; //Faktor: 110 %
  begin
      {proportional} if x >= hh then result := h
        else result := 10*x div 9;
      //{additiv} if x > 250 then
        //result := 255 else result := x + 5;
  end;
begin
  if image1.picture.Bitmap.PixelFormat  〈〉 pf24bit then Begin
    showmessage('Nicht möglich');
    exit;
  End;
  for y := 0 to image1.Picture.Bitmap.Height - 1 do Begin
    Pixel := image1.Picture.Bitmap.ScanLine[y];
    for x := 0 to image1.Picture.Bitmap.Width -1 do BEgin
      pixel.red := groesser(pixel.Red);
      pixel.green := groesser(pixel.green);
      pixel.blue := groesser(Pixel.Blue);
      inc(Pixel);
    ENd;
  End;
  image1.refresh;
end;

Frage:Was bedeutet try ?

... fragen vor allem Pascal-Umsteiger

Es gibt zwei Konstruktionen:

I. try ... Except ... End weiter II. try ... finally ... End

Zu I: Am besten verdeutliche ich es an einem Beispiel: 
Ein Programm zur Ausgabe der Wertetafel von

                  1
          y = ———————————
              (x+2)·(x-2)

procedure TForm1.Button1Click(Sender: TObject);
  var x: integer;
      y: real;
begin
   for x := -4 to 4 do Begin
     y := 1/((x+2)*(x-2)); //Doppelte Klammer nicht vergessen!
     memo1.lines.add(IntToStr(x)+'  '+FloatToStr(y));
   End;
end;
Das Programm endet mit einem Laufzeitfehler bei x =- 2 ("Division durch Null"). Die Prozedur kann nicht weiter aufgeführt. Im Memo steht gerade: 
-4  0,0833333333333333
-3  0,2
Ein Pascal-Programmierer würde nun die Nullstellen des Nenners berechnen (hier natürlich einfach, im Allgemeinen jedoch nicht) und formulieren: 
 if (x  〈〉 -2) and (x  〈〉 2) then...
. In Delphi geht es eleganter: Man kann die Fehlermeldung, die "Exception", folgendermaßen "umleiten": 
procedure TForm1.Button1Click(Sender: TObject);
  var x: integer;
      y: real;
begin
   for x := -4 to 4 do Begin
     try
       y := 1/((x+2)*(x-2));
       memo1.lines.add(IntToStr(x)+ '  ' + FloatToStr(y));
     EXcept
       memo1.lines.add(IntToStr(x)+ '  ' + 'nicht definiert');
     ENd;
   End;
end;
Im Memo steht dann wie gewünscht: 
-4  0,0833333333333333
-3  0,2
-2  nicht definiert
-1  -0,333333333333333
 0  -0,25
 1  -0,333333333333333
 2  nicht definiert
 3  0,2
 4  0,0833333333333333
Wenn du jetzt deine Funktion änderst (oder ein Programm hast, bei dem der Benutzer die Funktion eingibt weiter mathematischer Parser), gibt es keinen unerwartetet Laufzeitfehler mehr.

Hinweis: Am besten, du testest dieses Programm als Exe-Datei und in der Delphi-Entwicklungsumgebung.

Als Exe-Datei wird die Wertetafel problemlos geschrieben.

In der Delphi-Entwicklungsumgebung zeigt dir der Debugger, dass die "Exception" ordnungsemäß ausgelöst wird. Mit "Start|Start(F9)" gehts dann weiter. (Die Exception-Anzeige kannst du abschalten über "Tools|Debbugger-Optionen|Sprachexception|Bei Delphi-Exception stoppen". Ich würde dir aber raten, den Schalter nach Möglichkeiten nicht umzustellen.)

Noch ein weiteres beliebtes Beispiel: Der Benutzer darf nur Ziffern, aber keine Buchstaben, eingeben: 
procedure TForm1.Button1Click(Sender: TObject);
  var a: integer;
begin
  try
    a := StrToInt(edit1.text);
  Except showmessage('Sie müssen eine ganze Zahl eingeben') End;
end;
Für Fortgeschrittene (Näheres dazu in der Onlinehilfe):

Du kannst auch die Nachricht (message), die das Betriebssystem in einem Ausnahmefall (exception) mitteilt, verwenden. (Windows bietet Dir ja im Normalfall eine sinnvolle Erklärung.) Dazu folgendes Beispiel einer Wertetafel, die nicht berechenbare Quadratwurzeln und Division durch Null abfängt. 
function f(x: real): real;
begin
  result := sqrt(x+3) + sqrt(3 - x) + 1/x;
  // Nur definiert für -3 〈= x 〈= 3 und x  〈〉 0
end;


procedure TForm1.Button1Click(Sender: TObject);
  var x, y: real;
      xs,ys : string;
begin
  x := - 4;
  while x〈5 do Begin
    xs := floatToStr(x);
    try
      y := f(x);
      ys := floatToStr(y);
    EXcept on e:Exception do ys := e.Message ENd;
    memo1.Lines.Add(xs + '   ' + ys);
    x := x + 1;
  End;
end;

II try ... finally ... End

 Diese Konstruktion spielt eine große Rolle, wenn Instanzen zur Laufzeit erzeugt werden. Man will damit sicher gehen, dass sie auch wieder freigegeben werden. Das sieht dann meisten so aus: 
    var irgendetwas :Tirgendetwas;//global oder lokal
    //...
    irgendetwas := Tirgendetwas.create;
    //Für die Instanz wird Speicherplatz reserviert
    //manchmal auch: if irgendetwas = nil then
    //irgendetwas := Tirgendetwas.create;
       //Alles mögliche wird gemacht. Zum Beispiel: Lies eine Datei.
       //Bei Abbruch (beispielsweise falls Diskette nicht eingelgt),
       //wird Prozedur verlassen.
       //Aber folgendes wird auf jeden Fall noch erledigt:
    Finally
      irgendetwas.free;
      irgendetwas := nil; //zu empfehlen!
    End; //Speicherplatz wird wieder freigegeben.
Hier ein Beispiel ohne den Aspekt der objektorientierter Programmierung: Der Teiler einer Zahl wird gesucht. Sobald der Teiler gefunden wurde, wird die (zeitaufwendige) Schleife verlassen: 
procedure TForm1.Button1Click(Sender: TObject);
  var a, x, t: integer;
begin
  a := 1430503603; //Primzahl?
  t := 1;
  try
    for x := 2 to to round(sqrt(a))
      if a mod x = 0 {"x ist Teiler von a"} then Begin
        t := x;
        exit; //Zeit sparen!
      End;
  Finally
    if t = 1 then showmessage('Primzahl') else
      showmessage('Der Teiler ' + inttostr(t) + ' wurde gefunden.');
  End;
end;
Bemerkung: Besser wäre hier natürlich die Konstruktion ohne try ... finally mit break statt exit. Wenn es aber mehrere Schleifen sind, ist try ... finally eleganter als das verpönte goto.
Klassisches Programm für Teiler und Primzahlen: weiter Lektion 7

Frage: Ist es möglich, dass ich als Rückgabewert einer Funktion ein Array übergeben kann?

Fachleute überlassen es Dir, ob Du das Array oder der Array sagst.

Antwort: Der Rückgabewert der Funktion muss als Typ deklarierte sein:
Dies wird folgendermaßen bewerkstelligt: 
type Tmyarray= array of TImage; //dynamisches Array: Erster Index 0
Hier die Funktion mit einem Array als Rückgabewert: 
function gibmirarray: Tmyarray;
  var i:integer;
begin
  setlength(result,Anzahl);
  for i:= 0 to Anzahl-1 do Begin
     result[i]:= Timage.create(Form1);
     //Damit Freigabe bei Form1.destroy
     result[i].parent := form1;
     result[i].picture.loadfromfile(...);
   End;
End;
Das ganze ist in Wettrennen ausgeführt.

Meine Schleife zählt von 8 bis 0 statt von 1 bis 9. Wie kommt das?

Frage: 
  for i:=1 to 9 do begin
    beep;
  end;
Diese Procedure rufe ich durch ein Buttonklick auf und setze einen Haltepunkt auf das Beep, um den Wert von i abzufangen. Wenn ich mir das dann anschaue dann zählt die Schleife komischerweise von 9 nach 1 runter.

Gibt es dafür eine einleuchtende Erklärung?

Antwort: Ja. Die Schleife sieht im erzeugten Code so ähnlich aus wie 
  i:=1;
  label:
  if i〈=9 then
    begin
      Call beep;
      inc(i);
      goto label;
    end;
Den Vergleich mit der Konstanten 9 wiederum kann eine Intel-CPU nicht direkt ausführen, sondern sie macht etwas wie 
  tmp:=i-9;
  if tmp〈0 then...

(Das "tmp〈0" ist ein Test auf ein CPU-Flag, ist also elektronenschnell.)
Es liegt daher auf der Hand, daß es effizienter ist, wenn die Schleife so formuliert wird, daß sie bei 0 endet, denn dann entfällt die Subtraktion.

Also optimiert der Compiler Deine Schleife so, daß sie von 8 bis 0 herunterzählt. Das Flag wird dabei bereits beim Erniedrigen um 1 implizit gesetzt.

So bald Du aber Code schreibst, dessen semantische Bedeutung (also das, was er tun soll, sein Ergebnis) von der Reihenfolge abhängt, kann diese Optimierung natürlich nicht gemacht werden und alles sieht vertraut aus. (Nach Marian Aldenhoevel)

Frage: Wie kann ich die Dateien eines bestimmten Verzeichnisses einlesen?

Bemerkung: Die Hauptideen zum Thema "Verzeichnisse" entnahm ich Simons Reinhards FAQ

Antwort: Benütze findfirst, findnext

Im Folgenden Beispiel benötigst du button1 und memo1.
Das Verzeichnis kannst du zu Testzwecken mit der SelectDirectory-Prozedur auswählen. Dazu ist noch nötig: uses FileCtrl, d,h. ganz am Kopf deiner Unit mußt du nach uses FileCtrl einfügen. 

function formatiere(name:string; size:integer; time:TDateTime):string;
  var s:string; // Untereinander Name Größe Datum
begin
  result := name;
  while length(result)〈20 do result :=result + ' ';
  if size〉0 then s := s + formatFloat('# # #  # # #  # # #',size) else s :='';
                                    //entferne die Lehrstellenin # # #!
  while length(s)〈12 do s :=' ' + s; //rechtsbündig
  result := result + s + '   ' + DateToStr(time);
end;


procedure VerzeichnisEinlesen(dir:string);
    var SR: TSearchRec;
begin
  if dir[length(dir)] 〈〉'\' then
    dir:=dir+'\';
  with Form1 do begin
    memo1.lines.Clear;
    memo1.WordWrap := false;
    memo1.Font.name := 'Courier New';
    if FindFirst(dir+'*.*',faAnyFile,SR)=0 then Begin
      repeat
        if SR.Name[1] 〈〉'.' then begin
          memo1.lines.add(formatiere(sr.name,sr.size,sr.Time));
        end;
      until FindNext(SR) 〈〉0;
      FindClose(SR); //Nach jedem findfirst nötig,
                     //um sr freizugeben!
    End;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  //benötigt uses FileCtrl
var dir: string;
begin //mit uses FileCtrl;
  if SelectDirectory('Ordner wählen, dann OK klicken','',dir) then
    VerzeichnisEinlesen(dir);
end;
Ein Beispiel mit allen Finessen findest du in Simon FAQ unter Dateien, Ordner, Laufwerke: "Wie kann man alle Dateien eines Ordners mitsamt der Unterverzeichnisse ermitteln?"

Frage: Wie kann ich die Verzeichnisstruktur einlesen?

Antwort: Platziere auf deinem Formular button1 und treeview1 aus der Komponentenpalette von Delphi win32.

Folgende Pozeduren zeigen dann den Verzeichnisbaum und die Datei, welche ausgewählt wurde:

Neben der Methode procedure TForm1.Button1Click(Sender: TObject) benötigst du noch die Methode procedure TForm1.TreeView1Click(Sender: TObject)

Diese Methoden mußt du im Objektinspektor anklicken. Dann wird der Kopf und begin ..end geschrieben. Lösche diese Zeilen und kopiere die passenden von hier mit Inhalt.1 

procedure Verzeichnisstruktur_Einlesen(Tree : TTreeView;
                                 Verzeichnis : String;
                                 Eintrag : TTreeNode);
Var SR          : TSearchRec;
    EintragTemp : TTreeNode;
    pu          : Tstringlist;
    k           : integer;
begin
  if Verzeichnis[length(Verzeichnis)] 〈〉'\' then
    Verzeichnis:=Verzeichnis+'\';
  //Zuerst kommmen die Einträge _sortiert_ in den Pu_ffer
  pu := Tstringlist.Create;
  pu.Sorted := true;
  try
    if FindFirst(Verzeichnis+ '*.*', faDirectory, SR)=0 then begin
      repeat
        if (SR.Attr and faDirectory = faDirectory)
          and (SR.Name[1]  〈〉 '.') then Begin
            //Eintrag ist ein Verzeichnis
            if (SR.Attr and faDirectory > 0) then pu.Add(sr.name);
        End;
      until FindNext(SR) 〈〉0;
      FindClose(SR); //Nach jedem findfirst
    end;
   //Jetzt werden die Einträge vom Pu_ffer in treeview1 geschaufelt.
   Tree.Items.BeginUpdate;
    for k := 0 to pu.Count -1  do Begin
     EintragTemp := Tree.Items.AddChild(Eintrag, pu[k]);
     Verzeichnisse_Einlesen(Tree,Verzeichnis + pu[k], EintragTemp);
     //rekursiv}
    End;
    Tree.Items.EndUpdate;
  Finally pu.Free End;
end; //{Nach Michael Geisler in
     //Simon Reinhards FAQ}



procedure TForm1.Button1Click(Sender: TObject);
  var   Eintrag : TTreeNode;
        verz    : String;
begin
  verz := 'c:';
  TreeView1.Items.Clear;
  Eintrag := TreeView1.Items.Add(nil,verz);
  Verzeichnisse_Einlesen(TreeView1,verz,eintrag);
  Eintrag.Expand(false); //verz. wird geöffnet
end;

function SelectedPath(tr: TTreeNode):string;
begin
  result := tr.text;
  if tr.Parent  〈〉 nil then
    result := SelectedPath(tr.parent)+'\'+result;
end;


procedure TForm1.TreeView1Click(Sender: TObject);
begin
  showmessage(SelectedPath(treeview1.selected));
end;

Ein Programm, das beide vorhergehenden Fragen beinhaltet:
Verzeichnisbaum darstellen und Verzeichnisse auflisten

Hier siehst du auch, wie man die Icons der Programme in der Komponente Listview darstellen kann.
du benötigst für dieses Programm button1, treeview1 und listview1. Im Programm ist angegeben, was noch hinter uses einzufügen ist: 
function SelectedPath(tr: TTreeNode):string;
begin
  result := tr.text;
  if tr.Parent  〈〉 nil then
    result := SelectedPath(tr.parent)+'\'+result;
      //Rekursiv
end;

function attr_(at: integer): string;
begin if at 〈0 then exit;
  result := '';
  if at and 1 = 1 then result := result + 'R';
  if at and 2 = 2 then result := result + 'H';
  if at and 4 = 4 then result := result + 'S';
  if at and 8 = 8 then result := result + '(LW)';
  if at and 64 = 64 then result := result + '(64)';
  if at and 128 = 128 then result := result + '(128)';
end;



procedure Listview1itemsadd(const name, groesse, alt, attr: string);
var Newitem: TListItem;
  Info: TSHFileInfo; //uses  shellapi;
Begin
  NewItem := Form1.ListView1.Items.Add;
  NewItem.Caption := name;
  newItem.subitems.add(groesse);
  newItem.subitems.add(alt);
  Newitem.subitems.Add(attr);
  //if pos('\', name) = 0 then NewItem.ImageIndex := -1 else
    Begin
      SHGetFileInfo(PChar(name), 0, Info, SizeOf(TSHFileInfo),
      SHGFI_SYSIconIndex or SHGFI_TYPENAME);
      NewItem.ImageIndex := Info.IIcon;
    End;
end;

procedure VerzeichnisEinlesen(dir:string);
    var SR   : TSearchRec;
        pfad : String;
begin
  if dir[length(dir)] 〈〉'\' then
    dir:=dir+'\';
  with Form1 do begin
    if FindFirst(dir+'*.*',faAnyFile,SR)=0 then Begin
      repeat
        if SR.Name[1] 〈〉'.' then Begin
          pfad := LowerCase(dir + sr.Name);
          Listview1itemsadd(pfad,formatFloat('# # #  # # #  # # #',sr.size),
                                         //entferne die Lehrstellenin # # #!
                            DateToStr(sr.time),attr_(sr.attr));
        End;
      until FindNext(SR) 〈〉0;
      FindClose(SR); //Nach jedem findfirst nötig, um sr freizugeben!
    End;
  end;
end;


procedure Verzeichnisstruktur_Einlesen(Tree : TTreeView;
                                 Verzeichnis : String;
                                 Eintrag : TTreeNode);
Var SR          : TSearchRec;
    EintragTemp : TTreeNode;
begin
  if Verzeichnis[length(Verzeichnis)]  〈〉= '\' then
    Verzeichnis:=Verzeichnis+'\';
  Tree.Items.BeginUpdate;
  if FindFirst(Verzeichnis+ '*.*', faDirectory, SR)=0 then begin
    repeat
      if (SR.Attr and faDirectory = faDirectory)
        and (SR.Name[1]  〈〉 '.') then Begin
          //Eintrag ist ein Verzeichnis
          if (SR.Attr and faDirectory > 0) then BEgin
            EintragTemp := Tree.Items.AddChild(Eintrag, sr.name);
            Verzeichnisstruktur_Einlesen(Tree,Verzeichnis
              + sr.name, EintragTemp);
              //rekursiv}
        ENd;
      End;
    until FindNext(SR)  〈〉 0;
    sysutils.findclose(SR); //Nach jedem findfirst
  end;
  Tree.Items.EndUpdate;
end; {Nach Michael Geisler in Simon Reinhards FAQ}

procedure InitialisiereIcons;
  var SysIL         : uint;
        SFI         : TSHFileInfo;
        SmallImages : TImageList;
begin
  SmallImages := TImageList.Create(Form1);
  SysIL := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
            SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  if SysIL  〈〉 0 then Begin
    SmallImages.Handle := SysIL;
    SmallImages.ShareImages := TRUE;
  End;
  Form1.ListView1.SmallImages := SmallImages;
end;

procedure TForm1.FormCreate(Sender: TObject);
  var  NewColumn: TListColumn;
begin
   button1.Top := 0;
   form1.setbounds(0,0,screen.Width,screen.height);
   treeview1.setbounds(0,button1.height,screen.width div 5 - 15,
                       screen.height - button1.height - 30);
   listview1.setbounds(treeview1.width,button1.height,
                       4*screen.Width div 5 - 15,
                       treeview1.height);
   listview1.ViewStyle := vsReport;
   listview1.GridLines := true;
   with listview1 do Begin
     NewColumn := Columns.Add;
     NewColumn.Caption := 'Pfad';
     newColumn.Width := listview1.Width div 3;
     NewColumn := Columns.Add;
     NewColumn.Caption := 'Größe';
     newColumn.Width := listview1.Width div 6;
     NewColumn := Columns.Add;
     NewColumn.Caption := 'Datum';
     newColumn.Width :=  listview1.Width div 6;
     NewColumn := Columns.Add;
     NewColumn.Caption := 'Attr';
     newColumn.Width :=  listview1.Width div 12;
   End;
   InitialisiereIcons;
end;

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  listview1.Items.Clear;
  VerzeichnisEinlesen(SelectedPath(treeview1.selected));
end;

procedure TForm1.Button1Click(Sender: TObject);
  var   Eintrag : TTreeNode;
        verz    : String;
begin
  verz := 'c:';
  TreeView1.Items.Clear;
  Eintrag := TreeView1.Items.Add(nil,verz);
  Verzeichnisstruktur_Einlesen(TreeView1,verz,eintrag);
  treeview1.alphasort;
  Eintrag.Expand(false); //verz. wird geöffnet
end;
Der gesamte Quellcode zum Download: Ein Dateineexplorer.

Die ganze Festplatte nach eine bestimmten Text durchsuchen

Am folgedem Programmkannst Du studieren, wie man das macht: 
//Hilfsfunktionen:
function Str1IstInStr2(const a,b: string): boolean;
begin
  result := pos(AnsiLowercase(a),AnsiLowercase(b)) > 0;
end;

function istInderDatei(const s: string; const pfad: string): boolean;
   var pu: Tstringlist;
begin
  result := false;
  try
    pu := Tstringlist.Create;
    try
      pu.LoadFromFile(pfad);
      if Str1IstInStr2(s,pu.text) then result := true;
    finally pu.free End;
  except showmessage(pfad + ' | konnte nicht durchsucht werden') End;
end;


procedure ZuMemoFallsKiterienerfuellt(const pfad, BestimmteDatei,
                                      SuchTextInDerDatei: string);
begin
  if Str1IstInStr2(BestimmteDatei,pfad)
    and istInderDatei(SuchTextInDerDatei,pfad) then
      form1.memo1.lines.add('"'+pfad + '" enthält den Text "' +
                             SuchTextInDerDatei);
end;
// - - - - - - - - - - - Die Hauptprozedur1 
//- - - - - - - - - - - - - -
procedure VerzeichnisDurchsuchen(dir: string; const BestimmteDatei,
  SuchTextInDerDatei: string);
//zum Beispiel: Ist dir 'c:\' bestimmte Datei = 'html' und
//              SuchTextInDerDatei = 'Hallo Welt'
//werden auf der C-Platte alle html-Dateien durchsucht,
//ob "Hallo Welt" vorkommt
//Die Namen der Dateien werden in memo1 geschrieben
  var SR: TSearchRec;
          dirtemp : string;
Begin
    //application.ProcessMessages;
    //form1.label1.caption := dir; //Zeigt, wo gesucht wird
    // if Stop then exit;
          //falls bei Klick auf Button2 die globale Variable
          //Stop := true gesetzt wird
    dir := IncludeTrailingBackslash(dir);
    if FindFirst(dir+'*.*',faAnyFile,SR)=0 then Begin
    repeat
      //Eintrag ist eine Datei
      If ((sr.attr And faDirectory) = 0) and (SR.Name[1] 〈〉'.') then
        ZuMemoFallsKiterienerfuellt(dir + sr.name, BestimmteDatei,
                                    SuchTextInDerDatei);
      //Eintrag ist ein Verzeichnis
      if (SR.Attr and faDirectory = faDirectory)
        and (SR.Name[1]  〈〉 '.') then Begin
            dirTemp := dir + sr.name;
            VerzeichnisDurchsuchen(dirtemp,BestimmteDatei,
                                   SuchTextInDerDatei);
           //Rekursiv
        End;
    until FindNext(SR) 〈〉0;
    FindClose(SR);
  End;
End;

procedure TForm1.Button1Click(Sender: TObject);
  var dir, datei, suchtext: string;
begin
   dir := 'c:\'; //oder dir := edit1.text
   datei := '.php'; //oder datei := edit2.text
   suchtext := 'Hallo Welt'; // oder suchtext := edit3.text
   //Stop := false; //falls Stop (globale Variable) bei Klick
   //auf button2 auf true gesetzt werden kann
   VerzeichnisDurchsuchen(dir, datei, suchtext);
end;

Frage: Mit Notepad Datei öffnen

Die Datei "c:\MeiOrdner\Meintext.txt" kann mit Notepad folgendermaßen gezeigt werden: 
uses Shellapi;
...
if ShellExecute(application.handle,
    Pchar('open'),
    Pchar('notepad'),
    Pchar('c:\MeiOrdner\Meintext.txt'),
    Pchar(''),
    sw_ShowNormal) >= 32
then showmessage('Datei ist geöffnet') else
     showmessage('Notepad konnte nicht geöffnet werden.');

Frage: Ich würde gerne eine Datei mit dem zu ihm passenden Programm öffnen.

Siehe auch die vorhergehende Frage.
Antwort:
In folgendem Programm wird zuerst eine Datei ausgewählt und dann das Programm ausgeführt.
Zu Testzwecken wird als Pfadsuchdialog die Komponente OpenDialog verwendet.
Wird die Datei in einer filelistbox angeklickt, musst du in deinem Programm statt pfad := waehleDatei(pfad) schreiben: pfad := filelistbox1.FileName 

uses Shellapi; //für Shellexecute
// d.h. Füge deinen uses-Anweisungen noch uses Shellapi hinzu:

function waehleDatei(alterpfad:string):string; //zum Testen
begin
   with form1.OpenDialog1 do Begin //Komponente von "Dialoge"
      title := 'Wähle deinen Song aus';
      filename := extractFilename(alterpfad);
      initialdir := extractFilepath(alterpfad);
      options := [ofFileMustExist, ofAllowMultiselect,
                  ofHideReadOnly, ofShareAware,
                  {ofOldStyleDialog,} ofNoTestFileCreate, ofNoValidate];
      if Execute then result := filename
        else Begin result :='';  showmessage('Abbruch') End;
    End;
end;


procedure Anwendung(pfad:string);
begin
 //uses Shellapi wird für ShellExecute benötigt
 if ShellExecute(application.handle,
      Pchar('open'), //vorgang
      Pchar(extractfilename(pfad)),
      Pchar(''),    //Parameter),
      Pchar( extractFilepath(pfad)),
      sw_ShowNormal) 〈= 32
 then showmessage('Fehlgeschlagen');
end;

procedure TForm1.Button1Click(Sender: TObject);
  var pfad:string;
begin
  pfad := ExtractFilePath(ParamStr(0));
  //paramstr(0)  = Pfad der application.
  //falls dort der Song oder ähnliches abgelegt wurde
  repeat
    pfad := waehleDatei(pfad);
    //oder pfad := filelistbox1.FileName;
    if pfad  〈〉 '' then Begin
      showmessage('"' + pfad + '"' +'wird geöffnet.');
      Anwendung(pfad);
    End;
  until pfad = '';
end;

Wie kann ich im Programm meinen Programmnamen mit Pfad ermitteln?

und:

Wie kann ich beim Start meines Programms Parameter entgegenzunehmen? Zum Beispiel "meinprogramm.exe -parameter1 -parameter2 " usw.

Verwende paramcount und paramstr(k). Das folgende Programm erklärt sich selbst. 
procedure TForm1.Button1Click(Sender: TObject);
  var k: integer;
begin
  showmessage(paramstr(0));
  //liefert den Programmpfad z.B. "c:\programme\meinprogramm.exe"
  for k := 1 to paramcount do
    showmessage(paramstr(k)); //liefert parameter1 parameter2 ...
end;

Mein Memo soll die Scrollbalken erst zeigen, wenn es notwenig ist. Wie mache ich das?

Wenn man in einem memo Scrollbars auf ssBoth setzt, sieht man die Scrollbalken selbst dann, wenn kein Text im Memo steht. Dies stört.

Lösung:

Verwende statt eines Memos ein Riched, setzte (im Objektinspektor) Scrollbars auf ssBoth und plaintext auf true.

Eine Richeditkomponente zeigt die entsprechenden Scrollbalken erst dann, wenn sie benötigt werden, wenn also der Text zu lang oder zu breit ist.

Wie kann ich einen Menüpunkt (de-)aktivieren?

Deklariere eine globale Variable "var menuabc: boolean=false" und führe in die Menüprocedur folgendes ein: 
procedure TForm1.MeinMenupunkabct1Click(Sender: TObject);
begin
  (sender as Tmenuitem).checked  :=  not (sender as Tmenuitem).checked;
   menuabc :=  (sender as Tmenuitem).checked;
end;
Dann kanst Du einen Programmpunkt folgendermaßen in Abhängigkeit des aktivierten oder deaktivierten Menüpunktes ausführen lassen: 
  if menuabc then {mach was} else {mach was anderes};

edi1, edit2, ... edit20 elegant löschen?

Frage: Ich haben 20 Editfelder und lösche sie folgendermaßen: 
  //edit1.text := ''; //Das soll nicht gelöscht werden!
  edit2.text := '';
  ...
  edit20.text := '';
Wie kann ich das eleganter machen?

Antwort: Das folgende Programm sagt alles: 
procedure TForm1.Button1Click(Sender: TObject); //Editfelder löschen
var k: integer;
    a: Tcomponent;
begin
  for k := 0 to ComponentCount - 1 do Begin
    a := components[k];
    showmessage(a.name); //Zum Testen
    if a.ClassType = TEdit then if a  〈〉 edit1 then
      (a as Tedit).text := '';
  End;
end;

Frage: Wie kann ich Zeile und Spalte des Curors in einer Statusbar anzeigen?

Antwort: Das ist im reinen Delphi nicht möglich. Allerdings kann man über die Api Nachrichten senden und empfangen. Betrachte dazu folgendes trickreiche Programm (Quelle: Borland FAQ): 
procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.Align := alclient;
  statusbar1.Panels.Add;
  statusbar1.Panels.Add;
  statusbar1.Panels[0].Width := 100;
  //Rest statusbar1.Panels[1].Width
  showmessage('Panel hat nun '
    + IntToStr(statusbar1.Panels.Count)
    + ' Felder'); //Panel hat 2 Felder
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Zeile: longint;
  Spalte: longint;
begin
  Zeile := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart,0);
  Spalte := SendMessage(Memo1.Handle, EM_LINEINDEX, Zeile, 0);
  statusbar1.panels[0].text := 'Zeile ' + IntToStr(Zeile +1);
  statusbar1.panels[1].text := 'Spalte '
    + IntToStr((Memo1.SelStart - Spalte) + 1);
end;

Frage:Wie kann ich eine Stringgrid-Zelle farbig darstellen?

Antwort: Füge in das Ereignis StringGrid1DrawCell folgendes ein: 
procedure TForm1.Button1Click(Sender: TObject);
  var i,j: integer;
begin
  for i := 0 to stringgrid1.ColCount - 1 do
    for j := 0 to stringgrid1.RowCount - 1 do
      stringgrid1.cells[i,j] := IntTostr(i) + ' ' + inttostr(j);
      application.ProcessMessages;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; 
  ACol, ARow: Integer;Rect: TRect; State: TGridDrawState);
begin
 with sender as Tstringgrid do
   if (Acol=2) or (pos('0',cells[Acol,ARow]) > 0) then Begin
     Canvas.brush.Color := clred;
     Canvas.Font.Color := clwhite;
     canvas.Font.Name := 'Arial';
     canvas.Font.Size := 18;
     canvas.fillRect(Rect);
     canvas.TextOut(Rect.Left,Rect.Top,Cells[ACol,ARow]);
 End;
end; //Nach: FAQ von Simon Reinhard
Wichtig: Klicke auf Dein Stringgrid, dann im Objektinspector auf Ereignisse und ordne "DrawCell" Deine eingefügte Procedur zu (Delphi findes sie sofort)!.

Frage:Wie kann ich das Fenster des Opendialogs größer machen? (Und gleichzeitig "Details" zeigen)

Antwort 1: Baue Dir ein eigenes Formular. Delphi bietet dazu alle Komponenten. Dann kannst Du Dir Deinen "Explorer" völlig frei nach Deinen Wünschen gestalten.

Antwort 2: Kopiere Dir folgende Proceduren in Deine unit1 ... und kümmere Dich nicht darum wie sie funktioniert (Das überlassen wir den Experten, die wissen wie Windows seine Botschaften behandelt. Wo Du die Höhe und die Breiet einstellen kannst ist offensichtlich.) 
// OldProcfuerOpendialog1: Dword globale Variable
//Idee von Pascal Enz
function DialogProc(Handle: HWND; Msg: DWORD; wParam,
    lParam: Integer):Integer; stdcall;
   var breite, hoehe: integer;
begin
  if MSG = WM_SHOWWINDOW then Begin
  //Fenstergröße ändern und zentrieren
    breite := 500;
    hoehe := screen.height -150;
    SetWindowPos(Handle, 0,
    (screen.Width - breite) div 2,
    (screen.height - hoehe) div 2,
     breite,hoehe,0);
  //Gleich Befehl ans Fenster senden: Menü "Ansicht|Detail"
    SendMessage(Handle, WM_COMMAND, $A004, 0); //
  End;
  Result := CallWindowProc(Pointer(OldProcfuerOpendialog1),
    Handle, Msg, wParam, lParam);
end;

procedure TForm1.OpenDialogShow(Sender: TObject);
//Prozedurkopf von Delphi schreiben lassen
//(im Formular "opendialog1" anklicken und
//im Objectinspektor beim "Ereignis" "onshow" doppelklicken!
var
  Handle: HWND;
begin
  Handle := GetParent((Sender as TOpenDialog).Handle);
  OldProcfuerOpendialog1 := GetWindowLong(Handle, DWL_DLGPROC);
  SetWindowLong(Handle, DWL_DLGPROC, Integer(@DialogProc));
end;

procedure TForm1.OpenDialogClose(Sender: TObject);
//Prozedurkopf von Delphi schreiben lassen
//(im Formular "opendialog1" anklicken und
//im Objectinspektor beim "Ereignis" "onclose" doppelklicken!
var
  Handle: HWND;
begin
  Handle := GetParent((Sender as TOpenDialog).Handle);
  SetWindowLong(Handle, DWL_DLGPROC, Integer(OldProcfuerOpendialog1));
  OldProcfuerOpendialog1 := 0;
end;

Frage:Wie kann ich in mein Programm ein Symbol einbinden?

Antwort: In der Dephi-Entwickungsumgebung mit "Tools|Bildeditor|Neu|Symbol|Datei|32·32" Bild malen, unter "meinbild.ico" abspeichern und mit "Projekt|Optionen|Anwendung|Symbol laden" das Icon "meinbild.ico" in Die Ressourcendatei einbinden.

Wie kann ich bei langwierigen Berechnungen einen Abbrechenknopf einblenden?

Die einfachste Methode ist folgende:
Füge zu Deiner Form1 noch eine zweite Form Form2 hinzu (Delphi-Menü "Daten|Neues Formular"). Ziehe auf Form2 einen button1 und nenne ihn ButtonStop (Objectinspector "Eigenschaften|Namen"). Form2 erhält eine Eigenschaft stop:boolean unter public (siehe unten unit2!). Diese wird beim Aktivieren auf false gesetzt und beim Klick auf ButtonStop auf true. Dies ist eine Botschaft für Form1.
Schreibe in Form1 für Button1 folgende Prozedur: 
implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
  var i:integer;
begin
  form2.Show;
  i:= 0;
  repeat //wiederhole, bis Klick auf ButtonStop
    inc(i);
    //tu was vernünftiges !
    if i mod 10000 = 0 then Begin
      button1.caption := inttoStr(i);
        //um zu sehen, dass sich was tut
      application.ProcessMessages;
    End;
    if form2.stop then exit;
      //Sobald auf den ButtonStop geklickt wird
  until false; //Schleife wird nur durch exit verlassen!
end;

end.
Hier ist die ganze passende unit2 wiedergegeben: 
unit Unit2; //Was nicht Delphi schreibt ist mit "//!" markiert.

interface

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

type
  TForm2 = class(TForm)
    Buttonstop: TButton;
    procedure FormActivate(Sender: TObject);
    //Im Objektinspector Ereignisse doppelklicken!
    procedure ButtonstopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    stop: boolean;  //! Das mußt Du einfügen !
  end;

var
  Form2: TForm2;

implementation

uses unit1; //!um form1.enabled zu ändern

{$R *.DFM}

procedure TForm2.FormActivate(Sender: TObject);
begin
  stop := false;             //!
  form1.Enabled := false;    !!!
end;

procedure TForm2.ButtonstopClick(Sender: TObject);
begin
 close; //!
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   form1.enabled := true; //!
   stop := true;          //!
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  FormStyle := fsstayontop; //Im Objektinspektor möglich
  Form2.BorderStyle := bsnone;               //"
  button1.Top := 20;                         //"
  button1.Left := 20;                        //"
  button1.Caption := 'Bitte hier klicken';   //"
  width := button1.Width + 40;               //"
  height := button1.Height + 40;             //"
end;

end.

Siehe auch Aufgabe24.1

Frage:Wie programmiert man einen Bildschirmschoner und verhindert, dass er zweimal aufgerufen wird?

Siehe auch Lektion 24 Beispiel 24.2

Antwort: Schreibe ein Delphiprogramm und benenne es mit Hilfe des Windowsexplorers von MeinProgramm.exe in MeinProgramm.scr um. Dann in das Verzeichnis windows/system kopieren. (Oder das Verzeichnis, bei dem du die .scr-Dateien findest.) Anschließend von Windows aus: Start|Einstellungen|Anzeige deinen Bildschirmschoner auswählen.

Noch einige Hinweise:
Bei Erzeugen deiner Form (FormCreate) können die Eigenschaften festgelegt werden (oder mit dem Objektinspector). Dort kann man auch die Taskleiste verstecken: 
procedure TForm1.FormCreate(Sender: TObject);
 var hTaskBar: THandle;
begin
  //Taskleiste weg!
  hTaskbar    := FindWindow('Shell_TrayWnd', Nil);
  ShowWindow(hTaskBar, SW_HIDE);
  //Form1-Eigenschaften
  Formstyle   := fsStayOnTop;
  Bordericons := []; //  (Alles false)
  Borderstyle := bsnone;
  WindowState := wsnormal;
    //wegen Taskleiste nicht wsmaximized
  align       := alnone;
  form1.Top   :=0;
  form1.left  :=0;
  form1.Width := screen.Width;
  form1.height:= screen.height + 50; //einschließlich
                                     //Taskleiste
  Color       := clBlack;
  Ctl3D       := false; //sonst weißer Streifen
  cursor      := -1;    //Kein Cursor!
  KeyPreview  := True;
    //Damit das Fenster auf Tastendruck schliessen kann
End;
Vergiss nicht, den alten Zustand beim Schliessen wieder herzustellen: 
procedure TForm1.FormClose(Sender: TObject;
   var Action: TCloseAction);
  var hTaskBar: THandle;  //uses Window;
begin
  hTaskbar := FindWindow('Shell_TrayWnd', Nil);
  ShowWindow(hTaskBar, SW_SHOWNORMAL);
end;
Bei Tastendruck oder Mausbewegung soll dein Bildschirmschoner verschwinden: 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  close;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  inc(zaehl);
  (*Zahl mußt du als private-Variable deklarieren:
   Ergänze in Deimem Programm, dort wo privat steht:
                      private
                        zaehl: integer;
                      { Private-Deklarationen } *)
 if zaehl > 5 then close;
end;
Wichtig: Der Bildschirmschoner soll nur einmal aufgerufen werden. Deshalb Klicke in Delohi "Ansicht|Units" an und wähle "Project1". In dieses mußt Du die Prozedur "Zweimalverhindern" (Siehe unten) einfügen und vor "Application.Initialize" aufrufen. Der Quelltext könnte dann folgendermaßen aussehen: 
program Project1;

uses
  dialogs,
  windows,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

procedure ZweimalVerhindern;
var h: HWND; //uses windows
begin
  h:=FindWindow('TApplication','Bildschirmschoner (c) Joschka F.');
  if h 〈〉0 then Begin SetForegroundWindow(h); halt End;
end;

begin
  ZweimalVerhindern;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Title := 'Bildschirmschoner (c) Joschka F.';
  Application.Run;
end.
Download: bildschirmschonerpas.zip Das Grundgerüst des Bidschirmschoners.

Was du jetzt mit deinem Bildschirmschoner machst, bleibt dir überlassen. (siehe baelle )

Über den Parameter paramstr(1) kannst du feststellen, wie dein Bildschirmschoner verwendet wird.

pos('/s',paramstr(1))>0: Normaler Aufruf
pos('/p',paramstr(1))>0: Aufruf für Einstellungen.

(Die müssen dann in einer Ini-Datei oder in der Registrierung abgelegt werden und bei jedem Aufruf des Bildschirmschoners eingelesen werden.)

Bei meiner Webbrowserkomponente funktioniert Kopieren und Einfügen nicht.

Frage: Ich habe ein Kleines Problem mit der TWebBrowser Komponente, die bei D5, Professional dabei ist:

Wenn ich z.B. aus dem Demoverzeichnis die Demo CoolStuf starte, und dann z.B irgend eine Textzeile mit der Maus markiere, rechte Maustaste drücke und dann Kopieren wähle, danach im in Word oder sonst irgend einer Anwendung einfügen will, wird nicht eingefügt. Es sei denn ich hatte noch irgend etwas in der Zwischenablage von einem andren Programm.

Antwort:

Füge am Schlüß Deiner unit vor "end." ein: 
initialization
  OleInitialize(nil);

finalization
  OleUninitialize;
//vor
end.
Aus der Onlinehilfe:
You must initialize the Ole library before you can call OLE functions.

Frage: Mein Programm ist mit dem xyz-File (".txt", ".jpg", ".wav", "mp3" etc.) verbunden. Es soll nach Doppelklick auf ein xyz-File sich aber nicht mehrfach öffnen sonder die Datei in der ersten Instanz zeigen (spielen etc.).

Antwort: Binde folgende unit mit ein. Dann ist das Problem schon fast gelöst. 
unit InstanceManager; //nach Evan Simpson
{ Diese unit Einbinden:
  in .dpr  und unit1.pas als erstes: "uses  InstanceManager"
  und in Form1 folgendes Einfügen
" private
    procedure Nachrichauswerten;
procedure TForm1.Nachrichauswerten;
begin
  Application.Restore;
  Application.BringToFront;
  //edit1.Text := WoherKommtDieNachricht; zum Beispiel
  //edit2.text := DieNachrichtselbst;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  InstanceManager.triggerProc:=Nachrichauswerten;
end;"
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

interface

const MutexIdentifizierung = 'Mein eigenes Programm';
      AppNotifyValue: integer = 0;

var WoherKommtDieNachricht,DieNachrichtselbst: string;
    rcvValue: integer;
    ForbidOtherInstance: boolean = True;
    triggerProc: procedure of object;

implementation

uses Windows, SysUtils, Messages, Dialogs, Controls;

var mutex, thisWnd: HWND;
    IMWndClass: TWndClassA;
    mustHalt: boolean;
    copydata: TCOPYDATASTRUCT;

function copyab(const s:string; const i:integer):string;
   //Rest von s ab i. em Zeichen
  begin result:=copy(s,i,length(s)-i+1) end;

function frage(const s: string): boolean;
begin
  result := MessageDlg(s, mtConfirmation, [mbYes, mbNo],0) = mrYes;
end;

procedure teiledenStringInzweiTeile(var a,b: string);
  var k: integer;
begin
  k := 1;
  while (k〈〉length(a)) and (a[k]  〈〉 ' ') do inc(k);
  b := copyab(a,k+1);
  a := copy(a,1,k-1);
end;

function IMWndProc(HWindow: HWnd; Message,
  WParam: Longint; LParam: Longint): Longint; stdcall;
begin
  if Message=WM_COPYDATA then
    begin
      WoherKommtDieNachricht
        := StrPas(PCOPYDATASTRUCT(lParam).lpData);
      teiledenStringInzweiTeile(WoherKommtDieNachricht,
        DieNachrichtSelbst);
      rcvValue := PCOPYDATASTRUCT(lParam).dwData;
      if Assigned(triggerProc) then triggerProc;
      Result := Ord(ForbidOtherInstance);
    end
  else
    Result := DefWindowProc(hWindow, Message, WParam, LParam);
end;

initialization
  FillChar(IMWndClass, SizeOf(IMWndClass), 0);
  IMWndClass.lpfnWndProc := @IMWndProc;
  IMWndClass.hInstance := HINSTANCE;
  IMwndClass.lpszClassName := 'TInstanceManager';
  if Windows.RegisterClass(IMWndClass) = 0 then RaiseLastWin32Error;
  mutex := CreateMutex(nil, True, MutexIdentifizierung);
  if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      if paramcount = 0 then
        if frage('Programm läuft schon. Wiklich eine '
          +' zweite Instanz des Programms aufrufen?')
            then exit;
      mustHalt := True;
      if WaitForSingleObject(mutex, 5000)=WAIT_OBJECT_0 then
        begin
          thisWnd := FindWindow(IMwndClass.lpszClassName,
            MutexIdentifizierung);
          if thisWnd = 0 then RaiseLastWin32Error;
          CopyData.dwData := AppNotifyValue;
          CopyData.lpData := CmdLine;
          CopyData.cbData := StrLen(CmdLine);
          mustHalt := (SendMessage(thisWnd,WM_COPYDATA,0,
            Integer(@CopyData))>0);
        end;
      thisWnd := 0;
      ReleaseMutex(mutex);
      if mustHalt then Halt;
    end
  else
    begin
      thisWnd := CreateWindow(IMwndClass.lpszClassName,
        MutexIdentifizierung,0,0,0,0,0,0,0,hInstance, nil);
      if thisWnd = 0 then RaiseLastWin32Error;
      ReleaseMutex(mutex);
    end;
finalization
  if thisWnd > 0 then DestroyWindow(thisWnd);
end.
Dein Hauptprgramm könnte dann folgendarmaßen aussehen: 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
     procedure Nachrichauswerten; //Das schreibst Du!
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses InstanceManager;

procedure TForm1.Nachrichauswerten; //Das schreibst Du ebenfalls.
begin
  Application.Restore;
  Application.BringToFront;
  memo1.lines.add('Woher:' + WoherKommtDieNachricht
    + ' | Nachricht = ' + DieNachrichtselbst);
end;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  InstanceManager.triggerProc:=Nachrichauswerten;  //Wichtig!
end;

end.

Frage:Wie drehe ich ein Objekt um ein Zentrum?

Antwort: Dreht man den Vektor e1' = (1;0) mit dem Winkel phi um den Ursprung, erhält man den Vektor e1' = (cos(phi); sin(phi)).
Dreht man den Vektor e2 = (0;1) mit dem Winkel phi um den Ursprung, erhält man den Vektor e2' = (-sin(phi); cos(phi)).
Dreht man den Vektor (x,y) = x·e1 + y·e2 mit dem Winkel phi um den Ursprung, erhält man den Vektor (x', y') = x·e1' + y·e2'. Somit ist: 
    x' = x·cos(phi) - y·sin(phi)
    y' = x·sin(phi) + y·cos(phi)
Eine Drehung um das Zentrum Z(a|b) kann man als Hintereinanderausführung von Verschiebung, Drehung und Verschiebung auffassen. Die Abbildungsgleichungen sind dann: 
    x' = (x - a)·cos(phi) - (y - b)·sin(phi) + a
    y' = (x - a)·sin(phi) + (y- b)·cos(phi) + b
Mit folgender Prozedur ist dies in Delphi realisiert.

Beachte: Willst du auf dem Bildschirm eine mathematisch positive Drehung, so musst du Phi durch -Phi ersetzten, da die y-Achse des Bildschirms nach unten zeigt. 
procedure DrehungUm(a, b, x, y, phi: real; var xs, ys:real);
  //Zentrum Z(a|b) Punkt P(x|y) wird gedreht um Winkel phi zu Ps(xs|ys)
begin
  phi := phi/180*Pi; //Gradmass in Bogenmass
  xs := cos(phi)*(x - a)  + sin(phi)*(y - b) + a;
  ys := -sin(phi)*(x - a) + cos(phi)*(y - b) + b;
end;
Bei folgendem Programm fungiert das Shape Sz als Zentrum. Um Sz rotiert das Shape Sp als Punkt um Sz. Du brauchst dazu noch einen Timer aus der Komponentenpalette System.
Shapes findest du auf der Komponentenpalette Zusätzlich. 
{Nach einer Idee von Timo Holzherr}
var
  Form1: TForm1;
  d    : real;
  szposx, szposy, spposx, spposy,
     a, b, x0, y0,  phi: integer;
  spmoving, szmoving: boolean;

implementation
{$R *.DFM}

procedure DrehungUm(a, b, x, y, phi: real; var xs, ys:real);
  //Zentrum Z(a|b) Punkt P(x|y) wird gedreht um Winkel phi zu Ps(xs|ys)
begin
  phi := phi/180*Pi; //Gradmass in Bogenmass
  xs := cos(phi)*(x - a)  + sin(phi)*(y - b) + a;
  ys := -sin(phi)*(x - a) + cos(phi)*(y - b) + b;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin //Anfangswerte setzten
  timer1.Interval := 1;
  phi := 0;
  a := sz.Left;
  b := sz.Top;
  x0 := sp.left;
  y0 := sp.top;
  d := sqrt((sz.left - sp.left)*(sz.left - sp.left)
       +(sz.top - sp.top)*(sz.top - sp.top));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
  var x,y: real;
begin
  inc(phi);
  if phi 〉= 360 then phi := phi - 360;
  DrehungUm(a, b, x0, y0, phi, x, y);
  sp.Left := round(x);
  sp.top := round(y);
end;


(*Durch folgende Prozeduren kannst du das Shape Sz ("Shape Zentrum")
 ziehen.*)

procedure TForm1.SzMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then Begin
     SzMoving := True;
     SzPosX := X;
     SzPosY := Y;
  End;

end;

procedure TForm1.SzMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if SzMoving then
  begin
    sz.Left := sz.Left + X - szPosX;
    sz.Top := sz.Top + Y - szPosY;
  end;
end;

procedure TForm1.SzMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then Begin
     Szmoving := False;
     Button1Click(nil);
   End;
end;

Ich möchte mein Fenster mit Hilfe eines Panels "ziehen". Wie geht das?

Ein kleines Fenster, das über das blaue Feld gezogen werden kann Das Panel ist das blaue Feld.
Mit Klick auf das Blaue Feld soll die Form "gezogen" werden können.

Antwort: Setzte private Variablen . . . 
  ...
  private
    { Private-Deklarationen }
    PanelMoving: boolean;
    PanelPosX, panelPosY: integer;
  public
  ...
. . . und rufe im Objektinspektor bei panel1 folgende Ereignisse auf .... 
procedure TForm1.Panel1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then Begin
     PanelMoving := True;
     PanelPosX := X;
     PanelPosY := Y;
  End;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then Begin
     Panelmoving := False;
   End;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if PanelMoving then
  Begin
    Form1.Left := Form1.Left + X - PanelPosX;
    Form1.Top := form1.Top + Y - PanelPosY;
  End;
end;
Beachte dabei, dass Delphi bei Klick im Objektinspektor auf das Ereignis den Rahmen für die Prozeduren selbst schreibt.

Nun kannst Du "Form1.borderstyle := bsNone" setzten (Am besten im Objektinspektor) und das Panel1 blau färben als Hinweis: Hier kann "gezogen" werden.

Wie kann ich ein Timage um 90° drehen?

Antwort: Mathematisch ist eine Drehung um 90° (im Uhrzeigersinn) die Hintereinanderausführung der Spiegelung an der ersten Winkelhalbierenden und der Spiegelung an der horizontalen Mittelsenkrechten. Die Abbildungsgleichungen lauten: 

                                       |x|    |y|
Spiegelung an der Winkelhalbierenden:  | | -> | |
                                       |y|    |x|

Spiegelung an der horizontalen Mittelsenkrechten:


   |x|    |breite - x|
   | | -> |          |,
   |y|    |    y     |


wobei breite (width) die Breite meines Bildes ist.


                                            |x|    |    y     |
Die Hintereinanderazsführung ist dann also: | | -> |          |
                                            |y|    |breite - x|
Das Programm ist dann schnell erstellt. Es besticht durch seine Einfachheit. Dafür dauern die Berechnungen für ein bildschirmfüllendes Bild etwa drei Sekunten. 
procedure TForm1.Button1Click(Sender: TObject);
var
  a, b : TBitmap;
  x,y, breite: integer;
begin
  a :=Tbitmap.Create;
  b := TBitmap.Create;
  try
   image1.Picture.Bitmap.LoadFromFile(
         'c:\fotos\FranzistkaHochformat.bmp');
     //ersetze passend!
   application.ProcessMessages;
   a.Assign(Image1.Picture.Bitmap);
   b.Width := Image1.Picture.height;
   b.Height := Image1.Picture.Width;
   breite := b.Width - 1;
   for x := 0 to b.Width -1 do for y := 0 to b.Height - 1 do
     b.Canvas.pixels[x,y]  := a.Canvas.Pixels[y,breite - x];
  Image1.Picture.Assign(b);
  finally a.free; b.Free  end;
end;

Frage:Wie haben Sie die Lissajou-Animation programmiert?

Antwort: Das geht ganz einfach:

Eine Kurve in der Ebene (im Raum) kann man durch zwei (drei) Funktionen der Zeit t beschreiben:

t -> x(t)
t -> y(t)
t -> z(t) (im dreidimmenionalen).

Einen Kreis zum Beispiel folgendermaßen:

x(t) = r*sin(t)
y(t) = r*sin(t)

Eine Ellipse:

x(t) = a*sin(t)
y(t) = b*sin(t)

Und allgemein Lissajoufiguren:

x(t) = sin(a*t + b)
y(t) = sin(c*t + d)

Das Frequenzverhältnis entspricht dabei a:c, die Phasenverschiebung den Parametern b und d.

Im Programm werden die Animationen folgendermaßen realisiert. 
Global:

  var lissj_t, lissj_a, lissj_c: integer;

Anfangswerte setzten:

  lissj_a := 3;
    //zum Beispiel
    //(Werte werden bei jedem neuen Aufruf erhöht)
  lissj_c := 2;  //zum Beispiel
  timer1.Enabled := true;
  timer1.Interval := 100;

Im Timeraufruf zeichnen lassen:

   procedure zeichneKreisAufPanel(x,y:integer);
   begin
     with form1.Canvas do Begin
       Pen.Color := clyellow;
       Pen.Width := 2;
       Brush.Style := bssolid;
       Brush.Color := clred;
      Ellipse(x-4,y-4,x+4,y+4)
     End
   end;

   procedure TForm1.Timer1Timer(Sender: TObject);
      var h,b: integer;
   begin
     inc(lissj_t);
     h := form1.height div 4;
     b := form1.Width div 4;
     zeichneKreisAufPanel(2*b
       + round(b*sin(lissj_a/50*lissj_t + lissj_b)),
       2*h + round(h*sin(lissj_c/50*lissj_t + lissj_d)));
   end;

Frage:Wenn ich etwas mit savedialog abspeichere, möchte ich die Datei beim nächsten Programmaufruf beim opendialog ... als Vorgabe. Wie geht das?

Antwort: Das geht am besten über eine "Ini-Datei".
Die Benutzereingaben werden in der Datei "abc.ini" gespeichert, wenn das Programm "abc.exe" heißt.
Hat der Anwender keine Schreibrechte in dem Ordner, in dem das Programm liegt, musst du den Ordner für die Ini-Datei entsprechend ändern und eventuell in der Registry speichern. 
Beispiel: Ein Memo abspeichern und einlesen.

Download: editor

function IniPfad:string;
  var exepfad, exefile: string;
begin exepfad := extractFilepath(paramstr(0));
  exefile := extractFilename(paramstr(0));
  result:=exepfad //der exe-pfad des Programms
          + copy(exefile,1,length(exefile) - 3)
            //der Name ohne "exe"
          + 'ini'; //die Ini-Datei
end;


1. Variante: Unter Verwendung der unit TiniFile

function HoleDateiPfad:string;
   //Dass man noch weiss, wo Datei gespeichert wurde.
  var MyIniFile:TIniFile;      //benötigt uses IniFiles.
  //Ini-Dateien sind besser als in Registry schreiben!
begin
  MyIniFile:=Tinifile.create(Inipfad);
  try
    result:=MyIniFile.ReadString('Section1','Schluessel1', 'File1');
      //File1 ist Vorgabe
  finally MyIniFile.Free End;
end;

procedure SchreibeDateiPfad(pfad:string);
  //Dass man noch weiss, wo Datei gespeichert wurde
  var MyIniFile:TIniFile;
  //benötigt uses IniFiles. So besser als in der Registry
begin
  MyIniFile:=Tinifile.create(Inipfad);
  try
    MyIniFile.WriteString('Section1','Schluessel1', pfad);
  finally MyIniFile.Free End;
end;

2. Variante: Wenn man sonst keine weiteren Ini-Daten hat.

function HoleDateiPfad:string;
  var sl: Tstringlist;
begin
  sl := Tstringlist.Create;
  try
    try
      sl.LoadFromFile(IniPfad);
      if sl.Count > 0 then result := sl[0];
    Except {Das erste Mal gibt es keine Datei} End;
  finally sl.Free End;
end;

procedure SchreibeDateiPfad(pfad:string);
 var sl: Tstringlist;
begin
  sl := Tstringlist.Create;
  try
    sl.Text := pfad;
    try
      sl.SaveToFile(IniPfad);
    Except {z.B. keine Schreibrechte} End;
  finally sl.Free End;
end;

 Weiter  Für beide Varianten.


procedure TForm1.Button1Click(Sender: TObject);
begin
  with  opendialog1 do Begin
    Initialdir:=extractFilepath(holedateipfad);
    filename:=extractFilename(holedateipfad);
    options:=[ofFileMustExist,ofAllowMultiselect,
                ofHideReadOnly,ofShareAware,
                ofEnableSizing, ofNoTestFileCreate,ofNoValidate];
    Filter :='Pascal-Dateien (*.PAS)|*.PAS|Textdateien (*.txt)|*.TXT|'
              +'Alle Dateien (*.*)|*.*';
    DefaultExt:='';
    if Execute then Begin
      memo1.Lines.LoadFromFile(Opendialog1.Filename);
      SchreibeDateiPfad(Opendialog1.Filename);
    End else showmessage('Abbruch!');
 End;
end;

procedure TForm1.Button2Click(Sender: TObject);

begin
   with SaveDialog1 do Begin
     Options:=[ofCreatePrompt,ofEnableSizing,
       ofHideReadOnly,ofShareAware,ofEnableSizing];
     Initialdir:=extractFilepath(HoleDateipfad);
     filename:=extractFilename(holedateipfad);
     Filter :='Pascal-Dateien (*.PAS)|*.PAS|Textdateien (*.txt)|*.TXT|'
               +'Alle Dateien (*.*)|*.*';
     DefaultExt:='';
     if execute then Begin
       memo1.Lines.SaveToFile(Savedialog1.Filename);
       schreibeDateiPfad(Savedialog1.Filename);
     End else showmessage('Nicht gespeichert');
   End;
end;

Frage: Wie kann ich Programmeinstellungen merken

Bei kleineren Vorhaben ist die unit "TiniFile", die bei Delphi dabei ist, zu umständlich. Eine einfache Unit ist die folgende (Eine Erweiterung zum vorhergehenden Thema). Hier wird zu jeder Einstellung ein Schlüsselname verlang. Gut ist es, wenn man die Schlüssel als Konstanten abspeichert. Zum Beispiel: 
const schluesselpfad = 'Pfad';
      schluesselOben  = 'Oben';
      schluesselLinks = 'Links';
      schluesselUnten = 'Unten';
      schluesselRechts = 'Rechts';
- - - - - Beispiel für den Inhalt der Ini-Datei hier - - -
|°Pfad°|
c:\Programme\meinProject\abc12
|°Oben°|
141
|°Links°|
424
|°Unten°|
652
|°Rechts°|
461

   - - - - -
   Diese Unit_init einfach kopieren und in Dein Programm einbinden!1
   - - - - - - -

unit Unit_init;
 //möglich wäre auch die Stringlist sl im initialization-Abschnitt
 //zu erzeugen und beim Finalization-Abschnitt wieder freizugeben

interface

function LiesIni(const schluessel: string):string;
function LiesIniInteger(const schluessel: string): integer;
procedure SchreibeIni(const schluessel, inhalt:string);


implementation
  uses Sysutils, classes;

function IniPfad:string;
  var exepfad, exefile: string;
begin exepfad := extractFilepath(paramstr(0));
  exefile := extractFilename(paramstr(0));
  result:=exepfad //der exe-pfad des Programms
          + copy(exefile,1,length(exefile) - 3)
            //der Name ohne "exe"
          + 'ini'; //die Ini-Datei
end;

function SchluesselNummer(const schluessel: string;
   sl: Tstringlist): integer;
  var k: integer; //Ermittelt Zeilennummer des Schlüssels
begin
  for k := 0 to sl.Count - 1 do if '|°' + schluessel + '°|' = sl[k]
    then Begin
    result := k;
    exit;
  End;
  result := -1; //Nicht gefunden
end;

function LiesIni(const schluessel: string):string;
  var sl: Tstringlist;
      nr: integer;
begin
  result := ''; //falls nicht vorhanden
  sl := Tstringlist.Create;
  try
    try sl.LoadFromFile(IniPfad) Except  {Das erste Mal} exit End;
    nr := SchluesselNummer(schluessel,sl); //z.B. nr := 3 =>
      result := sl[4] (sl.count >=5)
    if nr 〈0 then exit;
    if sl.Count > nr + 1 then result := sl[nr + 1];
  finally sl.Free End;
end;

function LiesIniInteger(const schluessel: string): integer;
begin
  try result := strToInt(LiesIni(schluessel));
  except result := -1 End;
end;

procedure SchreibeIni(const schluessel, inhalt:string);
 var sl: Tstringlist;
     nr: integer;
begin
  sl := Tstringlist.Create;
  try
    try sl.LoadFromFile(IniPfad) Except {Das erste Mal} End;
    nr := SchluesselNummer(schluessel,sl);
      //falls Schlüssel vorhanden, nr >= 0
    if nr 〈0 then nr := sl.count;  //Schlüssel noch nicht vorhanden
    while sl.Count 〈= nr + 1  do sl.Add(''); //=> sl.count > nr + 1
    //z.B. nr=4 sl[4] ='|°links°|' sl[5] ='125'; notwendig sl.count > 5
    sl[nr] := '|°' + schluessel + '°|';
    sl[nr+1] := inhalt;
    try sl.SaveToFile(IniPfad)  Except {keine Schreibrechte} End;
  finally sl.Free End;
end;

end.
- - - - - Ende Unit_init - - - - -

Frage:Wie erhalte ich alle Benutzereinstellungen beim Programmstart?

Antwort: Hier ein Beispiel, bei dem alle Beschriftungen von Editfelder und alle angeklickten Checkboxen - und als Zugabe der Inhalt aller Memofelder als Beispiel für Listen - von Form1 wiederhergestellt werden.

Die Benutzereingaben werden in der Datei "abc.ini" gespeichert, wenn das Programm "abc.exe" heißt.

Verwendet wird nicht die Unit inifiles von Delphi, sondern das Einlesen und Sichern der Daten wird selbst programmiert. (Ich halte auch nichts davon, dass du die Windowsregistry mit deinen Daten voll stopfst, sonst wird dein System mit der Zeit immer träger.)

Im folgenden siehst du, wo die globale Variable IniInhalt deklariert wird, welche Pascal-Funktionen und -Prozeduren du in dein Programm kopieren mußt und wie der Inhalt der Methoden TForm1.FormCreate und TForm1.FormDestroy aussieht. 
var
  Form1: TForm1;
  IniInhalt: TStringlist;

implementation

{$R *.DFM}

function IniPfad:string;
  var exepfad, exefile: string;
begin
 exepfad := extractFilepath(paramstr(0));
 exefile := extractFilename(paramstr(0));
 result:=exepfad
   //der exe-pfad des Programms
         + copy(exefile,1,length(exefile) - 3)
           //der Name ohne "exe"
         + 'ini';
           //die Ini-Datei
end;

function copyab(const s: string; const i: integer): string;
begin result := copy(s, i, length(s) - i + 1) end;

function AnfangDerZeile(section,schluessel: string) :string;
begin
  result := section + '|' + schluessel + ' = ';
end;

procedure schreibeIni(section,schluessel,was:string);
  var k:integer;
begin
  for k := 0 to IniInhalt.Count - 1 do
    if pos(AnfangDerZeile(section,schluessel), IniInhalt[k]) = 1
      then Begin //Eintrag löschen bzw. überschreiben
        if was = '' then iniInhalt.Delete(k) else
          iniInhalt[k] := AnfangDerZeile(section,schluessel) + was;
        exit;
      End;
  //Neueintrag
  if was > '' then
    iniInhalt.Add(AnfangDerZeile(section,schluessel) + was);
end;

function intToStr4(k:integer): string; //von 0000 bis 9999 alphabetisch
begin
  result := inttostr(k);
  while length(result)〈4 do result := '0' + result;
end;

procedure loescheStringlistInIni(s:string);
  var k:integer;
begin
  k := 0;
  while〈IniInhalt.Count do Begin
    if pos(s,IniInhalt[k]) = 1 then iniInhalt.Delete(k) else inc(k);
  End;

end;

procedure schreibeIniStringlist(section,
              schluessel,stringlisttext:string);
  var sl: Tstringlist;
       k: integer;
begin
  loescheStringlistInIni(section + '|' + schluessel + '|');
  sl := Tstringlist.Create;
  sl.Text := stringlisttext;
  try
    for k := 0 to sl.Count - 1 do
      schreibeIni(section,schluessel + '|' + inttostr4(k) + '|', sl[k]);
  finally sl.free End;
end;


function LeseIni(section,schluessel: string): string;
  var k:integer;
begin
  for k := 0 to IniInhalt.Count - 1 do
    if pos(AnfangDerZeile(section,schluessel), IniInhalt[k]) = 1
      then Begin
        result := copyab(IniInhalt[k],
           length(AnfangDerZeile(section,schluessel)) + 1);
        exit;
      End;
  result :='';
end;

function LeseINIStringlist(section,schluessel: string): string;
  var sl: Tstringlist;
       k: integer;
begin
  sl := Tstringlist.Create;
  try
    for k := 0 to IniInhalt.count - 1  do
      if pos(section + '|' + schluessel + '|', IniInhalt[k]) = 1
      then Begin
        sl.add(copyab(IniInhalt[k],length(section
          + '|' + schluessel + '|') + 9));
      End;
    result := sl.text;
  finally sl.free End;
end;


function boolToStr(b: boolean): string; //Boolean -> String
begin
  if b then result := 'T' else result := 'F';
end;

procedure SchreibeAlleEditfenster(wo: TComponent);
var k: integer;
  a: Tcomponent;
begin
  for k := 0 to wo.ComponentCount - 1 do Begin
    a := wo.components[k];
    if a.ClassType = TEdit then with a as Tedit do
        schreibeIni(wo.name,a.name, text);
  End;
end;

procedure SchreibeAllecomboboxfenster(wo: TComponent);
var k: integer;
  a: Tcomponent;
begin
  for k := 0 to wo.ComponentCount - 1 do Begin
    a := wo.components[k];
    if a.classType = Tcheckbox then with a as Tcheckbox do
        schreibeIni(wo.name, a.name, boolToStr(checked));
  End;
end;

procedure SchreibeAllememofelder(wo: TComponent);
var k: integer;
  a: Tcomponent;
begin
  for k := 0 to wo.ComponentCount - 1 do Begin
    a := wo.components[k];
    if a.ClassType = TMemo then with a as TMemo do
      schreibeIniStringlist(wo.name,a.name, text);
  End;
end;

procedure LeseAlleEditfenster(wo: TComponent);
var k: integer;
    a: Tcomponent;
begin
  for k := 0 to wo.ComponentCount - 1 do Begin
    a := wo.components[k];
    if a.ClassType = TEdit then with a as Tedit do
        text := LeseINI(wo.name,a.name);
  End;
end;

procedure LeseAlleComboboxfenster(wo: TComponent);
var k: integer;
    a: Tcomponent;
begin
  for k := 0 to wo.ComponentCount - 1 do Begin
    a := wo.components[k];
    if a.classType = Tcheckbox then with a as Tcheckbox do
        checked := LeseINI(wo.name, a.name) = boolToStr(true);
  End;
end;

procedure LeseAllememofelder(wo: TComponent);
var k: integer;
    a: Tcomponent;
begin
  for k := 0 to wo.ComponentCount - 1 do Begin
    a := wo.components[k];
    if a.ClassType = TMemo then with a as TMemo do
       text := LeseINIStringlist(wo.name,a.name);
  End;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IniInhalt := Tstringlist.create;
  try
    iniInhalt.LoadFromFile(IniPfad);
    LeseAlleEditfenster(Form1);
    LeseAllecomboboxfenster(Form1);
    LeseAllememofelder(Form1);
  except {Das erste Mal} End;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  try
    SchreibeAlleEditfenster(form1);
    SchreibeAllecomboboxfenster(form1);
    SchreibeAlleMemofelder(form1);
    iniInhalt.SaveToFile(IniPfad);
  except {Keine Schreibrechte}  End;
  IniInhalt.Free;
end;

Frage:Wie starte ich von einem Delphiprogramm ein weiteres Programm?

Antwort: Verwende ShellExecute. Verwendung siehe unten die Prozedur programmstarten.
Beispielsweise wird durch den Aufruf programmstarten(C:\WINDOWS\SCANDSKW.EXE,','a:') die Diskette auf Fehler untersucht.
Eine Anwendung dazu ist das Programm "Programmmanager" 

function ShellexecuteFehler(i: integer): string;
begin
  Case i of 0: result :=
     'The operating system is out of memory or resources.';
    ERROR_FILE_NOT_FOUND: result :=
      'The specified file was not found.';
    ERROR_PATH_NOT_FOUND: result :=
      'The specified path was not found.';
    ERROR_BAD_FORMAT: result :=
      'The .EXE file is invalid (non-Win32 .EXE 
                      or error in .EXE image).';
    SE_ERR_ACCESSDENIED: result :=
      'The operating system denied access to the specified file.';
    SE_ERR_ASSOCINCOMPLETE: result :=
      'The filename association is incomplete or invalid.';
    SE_ERR_DDEBUSY: result :=
      'The DDE transaction could not be completed because '
      +'other DDE transactions were being processed.';
    SE_ERR_DDEFAIL: result :=
      'The DDE transaction failed.';
    SE_ERR_DDETIMEOUT: result :=
      'The DDE transaction could not be completed '
      +'because the request timed out.';
    SE_ERR_DLLNOTFOUND: result :=
      'The specified dynamic-link library was not found.';
       //SE_ERR_FNF : result:='The specified file was not found.';
    SE_ERR_NOASSOC  : result:='Unbekannter Extender.';
    SE_ERR_OOM: result :=
      'There was not enough memory to complete the operation.';
       //SE_ERR_PNF          : result:='The specified path was not found.';
    SE_ERR_SHARE: result := 'A sharing violation occurred.';
  End;
end;

procedure programmstarten(pfad, parameter: string);
  var name: String;
      code: integer;
begin
  name := extractFilename(Pfad);
  pfad := extractFilepath(pfad); //Jetzt nur Pfad
  code := ShellExecute(application.handle,
          Pchar('open'),
          Pchar(name),
          Pchar(Parameter),
          Pchar(Pfad),
          sw_ShowNormal);
  if code〈32 then ShellexecuteFehler(code);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with opendialog1 do Begin
     options:=[ofFileMustExist,ofAllowMultiselect,
                ofHideReadOnly,ofShareAware,
                ofEnableSizing, ofNoTestFileCreate,ofNoValidate];
     Filter :='EXE-Dateien (*.exe)|*.exe|Batchdateien (*.bat)|*.bat|'
              +'Alle Dateien (*.*)|*.*';
     DefaultExt:='exe';
  End;
  if opendialog1.Execute then Begin
    programmstarten(opendialog1.filename,''); 
    //evtl. Parameter abfragen
  End;
end;

In die Registry schreiben und aus der Registry lesen

Dazu musst du die Unit registry einbinden.
Wenn du den vielen Leichen in der Registry noch weitere hinzufügen willst, dann verwende die beiden nachfolgenden Prozeduren!
Im Ernst: Selbst gute Deinstallationsprogramme "vergessen" Einträge in der Registry und das System wird immer langsamer.
Das ist vor allem ärgerlich bei Programmen, die man nur vorübergehend mal ausprobiert.
Verwende lieber Ini-Files und schreibe diese in denselben Ordner, in dem sich Dein Programm befindet. 
procedure schreibeRegistry(a,b:string);
     var registrierung:TRegistry; //uses registry nicht vergessen
  begin
      Registrierung:=Tregistry.Create;
      Registrierung.Rootkey:=HKEY_LOCAL_MACHINE;
      try
  Registrierung.OPENKEY('\SOFTWARE\MyName\MyProgramm\Hallo',true);
      except
  Registrierung.CreateKey('\SOFTWARE\MyName\MyProgramm\Hallo');
      end;
      Registrierung.WriteString(a,b);
      Registrierung.free;
  end;


function leseRegistry(a:string):string;
    var registrierung:TRegistry;
  begin
      Registrierung:=Tregistry.Create;
      Registrierung.Rootkey:=HKEY_LOCAL_MACHINE;
      try
        Registrierung.OPENKEY('\MyName\MyProgramm\Hallo',true);
        result:=Registrierung.ReadString(a);
      except
        result:='';
      end;
  end;

Frage:Wie übertrage ich die Installation von Delpi auf weitere Benutzer?

Zwar kann ich Delphi aufrufen, aber alle Komponenten sind weg.
Folgende zwei Antworten aus Diskussionsforen könnten hilfreich sein:

Antwort 1: Als User, der Delphi mit Administratorenrechte installiert hat, den Delphi Key in der Registry [HKEY_CURRENT_USER\Software\Borlan\Delphi\〈Version〉] exportieren und als neuer User diese Reg-Datei importieren. (Dieser User braucht meistens dann vorübergehend auch Administratorenrechte.)
(Stand: November 2012/Windows XP: funktioniert!)

Antwort 2: Delphi braucht umfangreiche Einträge in der Registry. Wenn für Euch der Zugriff auf die Registry für Normaluser gesperrt ist, dann kann man Delphi nur installieren, wenn Du mit Deinem Namen angemeldet bist und kurzfristig Admin-Rechte hast.

Frage: Wie zeichne ich mit Delphi eine einfache Zeichnung ohne aufwendige Ressourcen-Edition?

Hinweis: Beliebige Bilder (z.B. kleine GIF-Dateien) können wie bei der nächsten Frage eingebunden werden.
Notenschlüssel Die Anwort gibt folgender Quellcode: Die Procedur wird zum Beispiel folgendermaßen aufgerufen:
ZeichneViolinschluessel(200,100, Form1.Canvas)
Benötigst Du Farbe in der Figur? Dann füge für rot 'r' statt '+' ein und "clred" statt "clblack" u.s.w. 
procedure zeichneViolinschluessel(a,b: integer; canv: Tcanvas);
 const
   schluessel =
     //gezeichnet mit Programm
     //Bildbearbeitung
      '         ++'#13#10+
      '        ++++'#13#10+
      '        ++++'#13#10+
      '       +++ +'#13#10+
      '       ++   +'#13#10+
      '       ++   +'#13#10+
      '      ++    +'#13#10+
      '      ++    +'#13#10+
      '      +    ++'#13#10+
      '      ++   ++'#13#10+
      '      ++  +++'#13#10+
      '      ++  +++'#13#10+
      '       + +++'#13#10+
      '       +++++'#13#10+
      '       ++++'#13#10+
      '      ++++'#13#10+
      '     ++++'#13#10+
      '    +++++'#13#10+
      '   ++++++'#13#10+
      '  +++++ +'#13#10+
      '  +++   +'#13#10+
      ' ++++    +'#13#10+
      ' ++      +++'#13#10+
      ' ++    +++++'#13#10+
      '+++   +++++++++'#13#10+
      '++    ++++ +++++'#13#10+
      '++   +++  +  +++'#13#10+
      '++    +   +   ++'#13#10+
      '++    +   +    +'#13#10+
      ' +    +   +    +'#13#10+
      ' +    +   +    +'#13#10+
      ' ++   ++   +   +'#13#10+
      '  ++    +  +  ++'#13#10+
      '   ++      + ++'#13#10+
      '     ++    ++'#13#10+
      '       +++++'#13#10+
      '           +'#13#10+
      '           ++'#13#10+
      '            +'#13#10+
      '      +     +'#13#10+
      '    +++++   +'#13#10+
      '    +++++   +'#13#10+
      '    +++++   +'#13#10+
      '    +++++   +'#13#10+
      '    +++    ++'#13#10+
      '     +++ +++';
  var i,j: integer;
      puffer: Tstringlist;
begin
  puffer := Tstringlist.Create;
  try
    puffer.Text := schluessel;
    with canv do
      for i := 0 to puffer.Count - 1 do
        for j := 1 to length(puffer[i]) do
          if puffer[i][j]  〈〉 ' ' then Pixels[j+a,i+b] := clblack;
  finally puffer.Free End;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   zeichneViolinschluessel(0,0, Canvas);
end;

Frage:Wie kann man einen formatierten Text als String schreiben und in einem Richeditfeld darstellen?

Zum Beispiel den Text:
Beispiel für formatierten Text
Antwort: Formatiere denen Text mit Word oder besser mit TTT, Menü:"Bearbeiten|RTF|Ausgewähltes formatieren", (schlanker Code) und speichere ihn ab. Lies die Datei mit einem Texteditor - zum Beispiel TTT - ein und schreibe jede Zeile in einfache Anführungszeichen und füge noch ein Zerilenvorschub (#13#10) an. (Das macht übrigens das Programm TTT mit Menü "Extras|Export für Delphi") automatisch. Den Rest siehst Du am folgendem Quelltext: 
procedure TForm1.Button1Click(Sender: TObject);
  const rtf_ressource =
      '{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl'+
      '{\f0\fswiss\fprq2\fcharset0 Arial;}'+
      '{\f1\froman\fprq2\fcharset0 Times New Roman;}}'#13#10+
      '{\colortbl ;\red255\green0\blue0;\red0\green0\blue255;'+
      '\red0\green128\blue0;}'#13#10+
      '{\stylesheet{ Normal;}{\s1 heading 1;}{\s2 heading 2;}}'#13#10+
      '\viewkind4\uc1\pard\qc\cf1\b\f0\fs48 TTTon'#13#10+
      '\par \cf2\fs32 Version Januar 2007'#13#10+
      '\par \''a9 Joachim Mohr'#13#10+
      '\par \b0\fs24'#13#10+
      '\par Dieses Programm ist - wie alle meine Programme -'#13#10+
      '\par  f\''fcr den privaten Gebrauch,  '
      +'f\''fcr (Hoch-)Schulen  und f\''fcr'#13#10+
      '\par gemeinn\''fctzige Organisationen frei.'#13#10+
      '\par \cf0'#13#10+
      '\par \cf3\b\fs20 Wenn Ihnen das Programm '+
      'gef\''e4llt, dann schicken Sie eine Email '+
      'an\cf0\b0 :'#13#10+
      '\par \pard\keepn\s1\qc\cf1\b wegen.spamcrawler.'+
      'geaendert@t-online.de'#13#10+
      '\par \pard\qc\cf3 Es sollte keine offene '
      +'Emailadresse ins Internet '+
      'dieselbe Adresse.\cf0\b0'#13#10+
      '\par'#13#10+
      '\par \cf1\b Viel Spa\''df mit den TT-Programmen'#13#10+
      '\par \pard\keepn\s2\qc Joachim Mohr'#13#10+
      '\par \pard\qc T\''fcbingen am Neckar'#13#10+
      '\par \cf2\f1\fs32 www.joachimmohr.de}';
 var ms: TMemoryStream;
      sl: Tstringlist;
begin
  ms := TMemoryStream.Create;
  sl := TStringlist.Create;
  try
    sl.Text := rtf_ressource;
    sl.SaveToStream(ms);
    ms.Position := 0;
    Richedit1.PlainText := false;
    richedit1.Lines.loadfromstream(ms);
  finally sl.free; ms.free end;
end;

Wie kann man einen formatierten Text als String schreiben und in einem Webbrowser darstellen?

Platziere auf deiner Form1 außer memo1,button1 und button2 noch von der Palette Internet die Komponentewebbrowser1.

Kopiere dann aus der folgenden unit den fehlenden Text:

Oder downloade das Projekt TextInWebrowser.zip 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, 
       Graphics, Controls, Forms, Dialogs,
  OleCtrls, SHDocVw, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    WebBrowser1: TWebBrowser;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

const beispiel =
    '〈html〉'#13#10+
'〈head〉'#13#10+
'  〈title〉 Die ist die Titelzeile eines Testes 〈/title〉'#13#10+
'〈/head〉'#13#10+
'〈body text="#000000" bgcolor="#FFFFFF"〉'#13#10+
'〈h1〉Die ist ein Test〈/h1〉#13#10+
'〈/body〉'#13#10+
'〈/html〉';

var
  Form1: TForm1;

implementation
  uses activeX;
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
   memo1.text := beispiel;
end;

procedure LoadStream(WebBrowser: TWebBrowser; Stream: TStream);
var
  PersistStreamInit: IPersistStreamInit; // uses activeX;
  StreamAdapter: IStream;
  MemoryStream: TMemoryStream;
begin
  WebBrowser.Navigate('about:blank');
  repeat
    Application.ProcessMessages;
    Sleep(0);
  until WebBrowser.ReadyState = READYSTATE_COMPLETE;
  if WebBrowser.Document.QueryInterface(IPersistStreamInit,
    PersistStreamInit) = S_OK then
  begin
    if PersistStreamInit.InitNew = S_OK then
    begin
      MemoryStream:= TMemoryStream.Create;
      try
        MemoryStream.CopyFrom(Stream, 0);
        MemoryStream.Position:= 0;
      except
        MemoryStream.Free;
        raise;
      end;
      StreamAdapter:= TStreamAdapter.Create(MemoryStream, soOwned);
      PersistStreamInit.Load(StreamAdapter);
    end;
  end;
end;

procedure UeberStreamzeigen(const s:string);
  var Str: TStringStream;
begin
  Str:= TStringStream.Create(s);
  try
    LoadStream(form1.webbrowser1, Str);
  finally
    Str.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ueberstreamzeigen(memo1.text);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  close
end;

end.

Frage: Wie binde ich ohne aufwendige Ressourcen-Edition eine Binärdatei in Delphi ein?

(Nur für kleine Binärdatei geeignet! Sonst siehe große Dateien)
Hier wird exemplarisch gezeigt, wie z.B. ein Sound als wav-datei in zwei Strings so umgewandelt werden, dass sie in "lesbare" Delphikonstanten ... 
const strtext = 'Binärfile als Textfile gespeichert, '
  + 'alle Bytes > #39 (wegen Hochkomma)'
          s01 = 'dieser String merkt sich, bei welchen '
          +'Bytes in strtext ein "Hub" notwendig war'
... gespeichert werden können.

Hier die Funktion, die einen "binären" String in zwei "lesbare" Strings überführt.
("Maschinennaher" könnte statt dem String b einen Array of Bytes verwenden") 
{Ein Binärstring wird in zwei Strings übergeführt,
  die als Dephistring akzeptabel sind}
Procedure BinaerStrToTextStr(const b:string; var strtext,
  str01:string; kurz:boolean);
    const Hub = 40; //Oberhalb #39 (Hochkomma)
    var k:integer;
  function NullEinsStrgZuTextstr(const s01:string): string;
     //Jeweils 7 Bytes - zum Beispiel - "0011000" wird
     //in ein "lesbares" Byte übergeführt
    var k,j: integer;
        a: string;
    function NullEinsZuChar(const s:string): char;
      //zum Beispiel s='0011000';
      var j,n: byte;
    begin //geht auch kürzer mit "shr" und "and"
      //("Maschinennaher Code").
      n := 0;
      for j := 1 to 7 do
        if (j 〈=length(s)) and (s[j] = '1') then
          Case j of 7: n := n + 1;
                    6: n := n + 2;
                    5: n := n + 4;
                    4: n := n + 8;
                    3: n := n + 16;
                    2: n := n + 32;
                    1: n := n + 64;
          End; //n maximal 127
      if n〈Hub then n := n + 128;
        //So wird ein "unlesbares" Char "lesbar"
      result := char(n)
    end;
  begin
    setlength(a,7);
    setlength(result,length(s01) div 7+1);
    k := 0;
    while k 〈= length(s01) do Begin
      for j := 1 to 7 do
        if (k + j 〈=length(s01)) and (s01[k+j] = '1')
          then a[j] := '1' else a[j] := '0';
      inc(k,7);
      result[k div 7] := NullEinsZuChar(a);
    End;
  end;
begin
  setlength(strtext,length(b));
// strtext := stringtest + 〈irgend ein Zeichen〉 kostet zu viel Zeit
  setlength(str01,length(b));
// Deswegen wird gleich zu Anfang Speicherplatz reserviert
  for k := 1 to length(b) do
     if ord(b[k]) >= Hub then Begin
        strtext[k] := b[k];
        str01[k] := '0';
     End else Begin
        strtext[k] := char(ord(b[k]) + Hub);
          //Nicht "lesbares" Char wird "lesbar".
        str01[k] := '1';
        //Das muss man sich merken "0" oder "1"
     End;
  if kurz then str01 := NullEinsStrgZuTextstr(str01);
end;
Im Programm könnte man zum Beispiel folgendermaßen eine (natürlich nur kurze) wav-Datei einlesen und in zwei "lesbare" Strings in eine Datei so schreiben, dass die Konstanten sofort in die Richedit1-Komponente kopiert werden können. 
function pfad: string;
begin
  with form1.opendialog1 do
    if execute then pfad := filename else pfad := '';
end;

function FileToBinaerStr(const pfad: string): string;
  //String als Puffer für die Bytes
var
  F: TStream;
begin
  F := TFileStream.Create(pfad, fmOpenRead or fmShareDenyWrite);
  try
    SetLength(result, F.Size);
    F.ReadBuffer(PChar(result)^, F.Size);
  finally
    F.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  const HK = '''';  //Hochkomma
  var binaerstr,strtext,str01: string;
      k: integer;
begin
  binaerstr := FileToBinaerStr(pfad);
  binaerstrToTextStr(binaerstr,strtext,str01,true);
  richedit1.text :='const strtext = ';
  k := 1;
  while k〈length(strtext) do Begin
    richedit1.lines.Add(HK + copy(strtext,k,80) + HK + '+');
    k := k +80;
  End;
  richedit1.Text := copy(richedit1.Text,1,length(richedit1.text) - 1)
    + ';'#13#10+#13#10 + 's01 = ';
  k := 1;
  while k〈length(str01) do Begin
    richedit1.lines.Add(HK + copy(str01,k,80) + HK + '+');
    k := k +80;
  End;
  richedit1.Text := copy(richedit1.Text,1,length(richedit1.text) - 1)
    + ';';
end;
Die Umkehrfunktion wird in das Delphiprogramm, die die Ressource verwenden soll, eingebunden.

{Die Umkehrfunktion: Zwei Delphistrings werden in einen Binärstring umgewandelt} 
function TextStrToBinaerst(const t,s01:string; kurz: boolean): string;
  const Hub = 40; //Oberhalb Hochkomma
  var k:integer;
      s01echtausNullEins: string;
  function TextStrZuNullEinsStr(const t:string): string;
      var k: integer;
    function CharZuNullEins(const c:char): string;
      //geht auch "maschinennäher"
      var k,n: integer;
    begin
      setlength(result,7);
      n := ord(c);
      if n >=128 then n := n - 128;
        //Das war ursprünglich ein "unlesbares" Char.
      for k := 1 to 7 do
        Case k of
 7: if n and 1 = 1 then result[k] := '1' else result[k] := '0';
 6: if n and 2 = 2 then result[k] := '1' else result[k] := '0';
 5: if n and 4 = 4 then result[k] := '1' else result[k] := '0';
 4: if n and 8 = 8 then result[k] := '1' else result[k] := '0';
 3: if n and 16 = 16 then result[k] := '1' else result[k] := '0';
 2: if n and 32 = 32 then result[k] := '1' else result[k] := '0';
 1: if n and 64 = 64 then result[k] := '1' else result[k] := '0';
        End;
    end;
  begin
    result := '';
    for k := 1 to length(t) do result := result + CharZuNullEins(t[k]);
  end;
begin
  if kurz then s01echtausNullEins := TextStrZuNullEinsstr(s01) else
    s01echtausNullEins := s01;
  setlength(result,length(t));
  for k := 1 to length(t) do
     if s01echtausNullEins[k] = '0' then result[k] := t[k] else
       result[k] := char(ord(t[k]) - Hub);
end;
Der folgende Sound (hier kürzer) kann dann folgendermaßen ins Delphiprogramm eingebunden und abgespielt werden. 
//Nicht vergessen uses MMSystem

procedure spieleBinaerstring(const b: string);
  var ms: TMemoryStream;
begin
  ms :=tmemorystream.Create;
  try
    ms.Seek(0, 0);
    ms.Write(Pchar(b)^, length(b));
    ms.Seek(0, 0);
    sndPlaySound(ms.Memory, SND_MEMORY or SND_SYNC);
                                     //uses MMSystem
  Finally ms.Free; End;
end;

procedure TForm1.Button2click(Sender: TObject);

const strtext = //Eine Wav-Datei als "lesbaren" String
  //Dazu gehört s01: Zusätzlich pro Byte ein Bit (wegen des "Hubes")
'RIFF ...';

s01 = 'â@?s...';

begin
  spieleBinaerstring(TextStrToBinaerst(strtext,s01,true));
end;

Frage: Wie binde ich ohne aufwendige Ressourcen-Edition eine Bilddatei in Delphi ein?

Antwort: Wie bei der vorangegangenen Frage als Binärdatei.
Dies habe ich in einem Programm "bildalsstrinspeichern.dpr" schon durchgeführt.
Siehe dazu unit1 und unit2.
Das gesamte Delphiprogramm kann in Download Quellcode unter dem Namen "bildalsstrinspeichern.zip" heruntergeladen werden.

Hinweis: In der Unit Umwandlungsprozeduren.pas wird ein Binärfile in einen Textstring umgewandelt.

Frage: Wie binde aufwendigere Ressourcen in Delphi ein?

Ich beschreibe zunächst wie man ein JPG-Bild einbindet, dann wie man eine WAV-Datei eibindet.

Mein Programm soll mit einem schönen Bild beginnen

  1. Erzeuge folgendermaßen aus "meinbild.jpg" (Beispiel) eine Resourcendatei "meinbild.res"
    1. Schreibe eine Datei mit der einen Zeile
      105 RCDATA "MEINBILD.JPG" und Speichere sie ab als Datei meinbild.rc
    2. Rufe das Programm BRC32.EXE mit dem Parameter -R MEINBILD.RC auf.
      Die Datei findest Du im Delphiverzeichnis "BIN". Am besten kopierst Du die Dateien
      brc32.exe
      brcc32.exe
      rw32core.dll
      mit in dasselbe Verzeichnis wie MEINBILD.JPG
    3. Jetzt verfügst Du über die von BRC32.EXE erzeugte Datei MEINBILD.RES
  2. In Deinem Delphiprogramm musst Du nun die Zeile
    {$R meinbild.res}
    einfügen und etwa folgende Procedur schreiben: 
    procedure TForm1.Button1Click(Sender: TObject);
  var ms: TResourceStream;
     jpg :TJPEGImage; //benötigt "uses jpeg"
begin
  jpg:=TJPEGImage.Create;
  ms :=TResourceStream.CreateFromID(Hinstance,105,RT_RCDATA);
  try
    jpg.LoadFromStream(ms);
    image1.Picture.bitmap.Assign(jpg);
    form1.Width := image1.picture.Width;
    form1.Height := image1.picture.Height+panel1.Height;
      //anpassen!
  Finally ms.Free; jpg.free End;
end;

Mein Programm soll eine schöne Akkordfolge spielen.

Akkordfolgen kannst Du zum Beispiel mit Programm TTMusik als WAV-Datei abspeichern.
  1. Erzeuge folgendermaßen aus "mysound.wav" (Beispiel) eine Resourcendatei "mysound.res"
    1. Schreibe eine Datei mit der einen Zeile
      105 RCDATA "MYSOUND.WAV"
      und Speichere sie ab als Datei MYSOUND.RC
    2. Rufe das Programm BRC32.EXE mit dem Parameter -R MYSOUND.RC auf.
      (Die Datei findest Du im Delphiverzeichnis "BIN").
    3. Jetzt verfügst Du über die von BRC32.EXE erzeugte Datei MYSOUND.RES
  2. In Deinem Delphiprogramm musst Du nun die Zeile
    {$R mysound.res} einfügen und etwa folgende Procedur schreiben: 
    procedure TForm1.Button1Click(Sender: TObject);
  var ms: TResourceStream;
begin
  ms :=TResourceStream.CreateFromID(Hinstance,105,RT_RCDATA);
  try
    sndPlaySound(ms.Memory, SND_MEMORY or SND_SYNC);//uses MMSystem
  Finally ms.Free; End;
end;

Mehrere Dateien einbinden geht zum Beispiel folgendermaßen:

Enthält die Datei MYSOUND.RC die zwei Zeilen 
105 RCDATA "MYSOUND.WAV"
106 RCDATA "MYNEXTSOUND.WAV"
so kannst Du mit 
 ms :=TResourceStream.CreateFromID(Hinstance,106,RT_RCDATA);
über die zweite Datei verfügen.

Wie kann ich Texte aus Nichttextdateien lesen?

Mit Klick auf einen Button wählst du zunächst mit Opendialog1 eine Datei aus und liest ihre ASCII-Zeichen in Richedit1 ein. 
function FileToString(const FileName: String): String;
var
  F: TStream;
  k: Integer;
begin
  F := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    SetLength(Result, F.Size);
    F.ReadBuffer(PChar(Result)^, F.Size);
  finally
    F.Free;
  end;
  for k :=1 to length(Result) do if
    not (result[k] in [#9, #10, #13, #32..#255]) then result[k] := ' ';
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(
    'Die Ascii-Zeichen der zu öffnenden Datei werden angezeigt.');
  with opendialog1 do Begin
    Filter :='Alle Dateien (*.*)|*.*';
    DefaultExt:='';
    if Execute then Begin
      richedit1.text := FileToString(Opendialog1.Filename);
    End else showmessage('Abbruch!');
 End;
end;

Frage:Wie kann ich eine Verknüpfung auf dem Desktop zu meinem Programm erzeugen?

Statt einer Installationsroutine genügt für kleinere Programme diese Routine. Der Anwender muss dann nur das Programm kopieren und diesen Programmpunkt einmal aufrufen (Wiederholung schadet nichts).
Zum Entfernen des Programms muss nur das Programm und die Verknüpfung auf dem Desktop gelöscht werden. 
uses
 //...
 shlobj, //IShellLink
 activex, //IPersistFile
 Registry, //Registry
 comobj; //CreateComObject

procedure AufDesktop(Datei,name:string);
var Shortcut: IUnknown;
  SLink: IShellLink;
  PFile: IPersistFile;
  Wdatei: WideString;
  Reg: TRegIniFile;
  dir: string;
begin
  shortCut := CreateComObject(CLSID_ShellLink);
  SLink := ShortCut as IShellLink;
  PFile := ShortCut as IPersistFile;
  SLink.SetArguments('');
  SLink.SetPath(Pchar(Datei));
  SLink.SetWorkingDirectory('c:\');
  Reg := TReginiFile.Create(
    'Software\Microsoft\Windows\CurrentVersion\Explorer');
  try
    Dir := Reg.ReadString('Shell Folders', 'Desktop', '');
    WDatei := Dir + '\'+ name + '.LNK';
    PFile.Save(PWChar(Wdatei), False);
  finally Reg.free End;
  showmessage('Sie sehen nun -wenn alle Fenster minimiert sind- '
    + Datei + ' auf dem Desktop.'#13 +
    'Gelöscht wird diese Verknüpfung nach Anklicken '
      +'mit der rechten Maustaste.');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  aufdesktop('c:\ttw\ttmathe.exe','ttmathe'); //zum Beispiel
end;

W3C

↑