Zwei Datensätze mit for-Schleife auf eine Seite drucken

[jaenicke]

Die Frage ist ja wie das Zeichnen der Datensätze selbst geht. Ich habe dafür selbst was gebastelt, da wusste ich noch nicht, dass es da vieles auch schon auf API-Ebene gibt. Der Quelltext ist ururalt, da habe ich noch nicht lange programmiert, aber funktioniert hat er.

Delphi-Quellcode:

function TPrinterObject.GetMultilineTextRect(Width: Integer;
   Text: String): TStringList;
var TextToAdd: String;
begin
   Result:=TStringList.Create;
   if Printer.Canvas.TextWidth(Text)<=Width then
      Result.Add(Text)
   else
      while Length(Text)>0 do
      begin
         TextToAdd:='';
         while ((Pos(' ',Text)>0)
            and (Printer.Canvas.TextWidth(TextToAdd
               + Copy(Text,1,Pos(' ',Text)-1)) < Width)
            or ((Pos(' ',Text)=0) and (Pos('/',Text)>0)
               and (Printer.Canvas.TextWidth(TextToAdd
                  + Copy(Text,1,Pos('/',Text)-1)) < Width))
            or ((Pos(' ',Text)=0)
               and (Printer.Canvas.TextWidth(TextToAdd + Text) < Width)))
            and (Length(Text)>0) do
         begin
            if Pos(' ',Text)=0 then
            begin
               if Pos('/',Text)=0 then
               begin
                  TextToAdd:=TextToAdd + Text;
                  Text:='';
               end
               else
               begin
                  TextToAdd:=TextToAdd+Copy(Text,1,Pos('/',Text)-1)+' / ';
                  Delete(Text,1,Pos('/',Text));
                  Text:=Trim(Text);
               end;
            end
            else
            begin
               TextToAdd:=TextToAdd + Copy(Text,1,Pos(' ',Text)-1) + ' ';
               Delete(Text,1,Pos(' ',Text));
               Text:=Trim(Text);
            end;
         end;
         if Trim(TextToAdd)<>'' then
            Result.Add(Trim(TextToAdd))
         else
         begin
            while Printer.Canvas.TextWidth(
               TextToAdd+'a')<Width do
            begin
               TextToAdd:=TextToAdd+Text[1];
               Delete(Text,1,1);
            end;
            Result.Add(Trim(TextToAdd))
         end;
      end;
end;

procedure TPrinterObject.PrintMultilineText(uText: TStringList;
   uLeft, uTop: Integer);
var
   i: Integer;
begin
   for i:=0 to uText.Count-1 do
      Printer.Canvas.TextOut(uLeft,
         uTop + i*Printer.Canvas.TextHeight('A'), uText[i]);
end;

function TPrinterObject.GetLineCount(uText: String;
   uWidth: Integer): Integer;
begin
   Result := Self.GetMultilineTextRect(uWidth,uText).Count;
end;

function TPrinterObject.GetItemHeight(uItem: Integer; uCols: array of Integer;
   ShortenLibrary: Boolean): Integer;
var
   i, tmpLineCount: Integer;
   tmpString: String;
begin
   Result :=
      GetLineCount(frmMain.lvwList.Items[uItem].Caption,Round(0.9*uCols[0]));
   for i:=1 to High(uCols) do
   begin
      tmpString := frmMain.lvwList.Items[uItem].SubItems[i-1];
      if (frmMain.fAppMetrics.GetBookListColType(frmMain.fDisplayMode,i)
         = colLibrary) and ShortenLibrary then
      begin
         if Pos('/',tmpString) > 0 then
            tmpString := Trim(Copy(tmpString,1,Pos('/',tmpString)-1))
         else if Pos('(',tmpString) > 0 then
            tmpString := Trim(Copy(tmpString,1,Pos('(',tmpString)-1));
      end;
      tmpLineCount := GetLineCount(tmpString, Round(0.9*uCols[i]));
      if Result < tmpLineCount then
         Result := tmpLineCount;
   end;
   Result := Result * Printer.Canvas.TextHeight('Aj');
end;

GetMultilineTextRect bricht den Text um und gibt die Zeilen zurück. GetItemHeight berechnet die Höhe des gesamten Eintrags, es geht hier um mehrere Spalten einer ListView (frmMain.lvwList).

Die neue Version dieses Quelltextes kann ich nicht posten, da es sich um ein kommerzielles Produkt handelt, aber von der Funktionsweise her ist der ähnlich, nur deutlich optimiert und sauberer geschrieben. Aber eben auch viel umfangreicher und produktspezifischer, deshalb würde der wohl auch nicht viel bringen.