Linux Print Server

// These lines are part of the routine handling server status messages
// s gets status message line


    i := Pos('Print file: ', s);
    if i>0 then
    begin
      t := copy(s, i+12, 250);
      tmp := Lastfile + '.BMP';


      try
        ServerTask('', 'convert_to_bmp:'+t+',9600,'+tmp);
        i := 0;
      except
        i := 999;
      end;


      if i=0 then
      begin
        Image1.Picture.LoadFromFile(tmp);
        Image1.Update;
        Application.ProcessMessages;
        DeleteFile(tmp);
        DeleteFile(t);
        Image1.Canvas.Font.Height := round(Image1.Picture.Height/16);
        Image1.Canvas.Font.Color  := clRed;
        Image1.Canvas.Brush.Style := bsClear;
        Image1.Canvas.TextOut(round(Image1.Picture.Width /6),
                       round(Image1.Picture.Height/40),
                       'Printed by ' + LastCallingAE);
        Image1.Canvas.Font.Color  := clBlack;
        Image1.Canvas.Brush.Style := bsSolid;
      end;
    end;
  end;


  i := Pos('Printing Basic Film Box', s);
  if i>0 then
  begin
    GetMem(mem, 256);
    StrPCopy(mem, 'Printing Basic Film Box');
    PrinterQueue.Add(mem);
  end;


  i := Pos('Printing Basic Film Session', s);
  if i>0 then
  begin
    GetMem(mem, 256);
    StrPCopy(mem, 'Printing Basic Film Session');
    PrinterQueue.Add(mem);
  end;


  i := Pos('Creating Basic Film Box', s);
  if i>0 then
  begin
    GetMem(mem, 256);
    j := Pos('Film#', s);
    if j>0 then j := StrToInt(copy(s, j + 6, 5));


    i := Pos('PORTRAIT', s);
    if i>0 then
      StrPCopy(mem, 'Creating Basic Portrait Film Box - Film# ' + IntToStr(j))
    else
      StrPCopy(mem, 'Creating Basic Landscape Film Box - Film# ' + IntToStr(j));
    PrinterQueue.Add(mem);
  end;


  i := Pos('Print file: ', s);
  if i>0 then
  begin
    t := copy(s, i+12, 250);
    GetMem(mem, 256);
    StrPCopy(mem, t);
    PrinterQueue.Add(mem);
  end;
end;


// This timer Serves the Printer Queue


var InTimer: boolean;


procedure TForm1.PrinterTimerTimer(Sender: TObject);
var LastFile, tmp: string;
    l: Tlist;
    j, film, rows, cols, num, num2, h, w, dx, dy: integer;
    Bmp: TBitmap;
    rc: TRect;
    scale: single;
begin
  if not assigned(PrinterQueue) then exit;
  if InTimer then exit;
  InTimer := true;


  rows := 0;
  cols := 0;
  num  := 0;
  num2 := 0;
  film := 0;


  l := PrinterQueue.LockList;
  if l.count<>0 then
  begin
    ProgressBar1.Hint := 'Print server queue contains ' + IntToStr(l.Count) + ' images';
    LastFile := Pchar(l.items[0]);
    Freemem(l.items[0]);
    l.Delete(0);
    ProgressBar1.Position := l.Count;
  end
  else
    ProgressBar1.Hint := 'Print server queue is empty';
  PrinterQueue.UnlockList;


  if LastFile<>'' then
  begin
    if LastFile = 'Printing Basic Film Box' then
    begin
      if Printer.Printing then Printer.EndDoc;
      InTimer := false;
      exit;
    end;


    if LastFile = 'Printing Basic Film Session' then
    begin
      if Printer.Printing then Printer.EndDoc;
      InTimer := false;
      exit;
    end;


    // get film number when creating film box (later for multi-user printing)
    j := Pos('Film#', LastFile);
    if j>0 then film := StrToInt(copy(LastFile, j + 6, 5));


    if Pos('Creating Basic Portrait Film Box', LastFile)>0 then
    begin
      if not Printer.Printing then Printer.Orientation := poPortrait;
      if Printer.Printing then Printer.NewPage;
      InTimer := false;
      exit;
    end;


    if Pos('Creating Basic Landscape Film Box', LastFile)>0 then
    begin
      if not Printer.Printing then Printer.Orientation := poLandscape;
      if Printer.Printing then Printer.NewPage;
      InTimer := false;
      exit;
    end;


    tmp := Lastfile + '.BMP';


    try
      ServerTask('', 'convert_to_bmp:'+LastFile+',9600,'+tmp);
    except
    end;


    if FileExists(tmp) then
    begin
      for j:=1 to Length(LastFile) do
        if LastFile[j]='.' then num2 := j;
      for j:=1 to num2-1 do
        if LastFile[j]='.' then num  := j;
      for j:=1 to num-1 do
        if LastFile[j]='.' then rows := j;
      for j:=1 to rows-1 do
        if LastFile[j]='.' then cols := j;
      for j:=1 to cols-1 do
        if LastFile[j]='.' then film := j;


      film := StrToInt(copy(LastFile, film+1, cols-film-1)); // for multi-user printing
      cols := StrToInt(copy(LastFile, cols+1, rows-cols-1));
      rows := StrToInt(copy(LastFile, rows+1, num -rows-1));
      num  := StrToInt(copy(LastFile, num +1, num2-num -1));


      if cols=0 then cols:=1;


      Bmp := TBitmap.Create;
      try
        Bmp.LoadFromFile(tmp);


        if not Printer.Printing then
        begin
          Printer.Title := 'Conquest DICOM printer - film# ' + IntToStr(film);
          Printer.BeginDoc;
        end;


        scale := Printer.PageWidth / (Bmp.Width * cols);
        if scale > Printer.PageHeight / (Bmp.Height * rows) then
          scale := Printer.PageHeight / (Bmp.Height * rows);


        h := round(Bmp.Height * scale);
        w := round(Bmp.Width  * scale);


        dx := (Printer.PageWidth  - w * cols) div 2;
        dy := (Printer.PageHeight - h * rows) div 2;


        rc.Top    := dy + (num div cols) * h;
        rc.Bottom := dy + (num div cols) * h + h;
        rc.Left   := dx + (num mod cols) * w;
        rc.Right  := dx + (num mod cols) * w + w;


        Printer.Canvas.MoveTo(0,0);             // required otherwise StretchDraw
        Printer.Canvas.LineTo(0,0);             // ... sometimes failes
        Printer.Canvas.StretchDraw(rc, Bmp);
      finally
        Bmp.Free;
        DeleteFile(tmp);
        DeleteFile(LastFile);
      end;
    end;
  end;
  InTimer := false;
end;