~ubuntu-branches/ubuntu/utopic/mricron/utopic

unit MultiSlice;

interface

uses

{$IFNDEF Unix} Windows,wgraphics,

{$ELSE}

//not used by Darwin... RGBGraphics,rgbroutines,

{$ENDIF}

 LResources,LCLType,SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  ExtCtrls,nifti_img,define_types,nifti_img_view,

  StdCtrls,GraphicsMathLibrary, Menus,ClipBrd,IniFiles,userdir;

const

	kMaxMultiSlice  = 24;

type

 TMultiSlice =  record

   Orient,nSlices,OverslicePct: integer;

   OrthoView,SliceLabel: boolean;

   SliceList: array [1..kMaxMultiSlice] of integer;

 end;//TMultiSlice

  { TMultiSliceForm }

  TMultiSliceForm = class(TForm)

	MainMenu1: TMainMenu;

	File1: TMenuItem;

	Closewindow1: TMenuItem;

	Saveasbitmap1: TMenuItem;

	Edit1: TMenuItem;

	Copy1: TMenuItem;

	MultiPanel: TScrollBox;

	MultiImage: TImage;

	View1: TMenuItem;

    OrientMenu: TMenuItem;

	Axial1: TMenuItem;

	Sagittal1: TMenuItem;

	Coronal1: TMenuItem;

    Orthoview: TMenuItem;

	Slices1: TMenuItem;

	Savesettings1: TMenuItem;

	Settings1: TMenuItem;

    MultiSaveDialog: TSaveDialog;

	SliceLabelCheck: TMenuItem;

    OversliceMenu: TMenuItem;

    N501: TMenuItem;

    N331: TMenuItem;

    N201: TMenuItem;

    N01: TMenuItem;

    N202: TMenuItem;

    N351: TMenuItem;

    N502: TMenuItem;

	procedure Copy1Click(Sender: TObject);

procedure MenuItem1Click(Sender: TObject);

	procedure Saveasbitmap1Click(Sender: TObject);

	procedure OrientClick(Sender: TObject);

	procedure FormShow(Sender: TObject);

	procedure CreateMultiAx;

	procedure CreateMultiCor;

	procedure CreateMultiSag;

	procedure CreateMultiSlice;

	procedure OrthoviewClick(Sender: TObject);

procedure Settings1Click(Sender: TObject);

	procedure Slices1Click(Sender: TObject);

	procedure Closewindow1Click(Sender: TObject);

	procedure FormCreate(Sender: TObject);

	procedure UpdateMultiSliceDisplay;

	procedure OpenMultiMRU(Sender:TObject);

	procedure UpdateMultiSliceMRU;

 {$IFNDEF FPC}

	procedure FormClose(Sender: TObject; var Action: TCloseAction);

 {$ELSE}

	procedure FormClose(Sender: TObject);

 {$ENDIF}

	procedure Savesettings1Click(Sender: TObject);

    procedure SliceLabelCheckClick(Sender: TObject);

    procedure OverlsiceClick(Sender: TObject);

  private

	{ Private declarations }

  public

	{ Public declarations }

  end;

var

  MultiSliceForm: TMultiSliceForm;

  gMulti:TMultiSlice;

  gMultiSliceDir,gMultiSliceStartupFilename,gMultiSliceDefaultsFilename:string;

{$IFDEF FPC}

  gMultiBuff: RGBQuadp;

  gMultiWid,gMultiHt: Integer;

  gMultiXCenterRA: array [1..kMaxMultiSlice] of integer;

{$ENDIF}

implementation

 {$IFNDEF FPC}

{$R *.DFM}

 {$ENDIF}

function MultiSliceNum2String: string;

var

	lSlice: integer;

begin

 if gMulti.nSlices = 0 then begin

     gMulti.nSlices := 1;

     gMulti.SliceList[1] := 1;

 end;

 result := '';

	for lSlice := 1 to gMulti.nSlices do  begin

		result := result+inttostr(gMulti.SliceList[lSlice]);

		if lSlice < gMulti.nSlices then

			result := result+',';

	end; //for each slice

end;

procedure MultiSliceString2Num (var lStr: string);

var

	lSliceStr: string;

	lStrPos,lStrLen,lSlice: integer;

begin

 //showmessage(lStr);

 lStrLen := length(lStr);

	if lStrLen < 1 then exit;

	lSlice := 0;

	lSliceStr := '';

	for lStrPos := 1 to lStrLen do begin

		if lStr[lStrPos] in  ['0'..'9'] then

			lSliceStr := lSliceStr+lStr[lStrPos];

		if ((not (lStr[lStrPos] in  ['0'..'9'])) or (lStrPos=lStrLen)) and (lSliceStr<>'') then begin

			inc(lSlice);

			if lSlice <= kMaxMultiSlice then

				gMulti.SliceList[lSlice] := strtoint(lSliceStr);

			lSliceStr := '';

		end; //if white space or eoln

	end; //for lStrPos

	gMulti.nSlices := lSlice;

	if lSlice > kMaxMultiSlice then begin

		showmessage('Warning: maximum number of slices is '+inttostr(kMaxMultiSlice));

		gMulti.nSlices := kMaxMultiSlice;

	end;

end;

procedure WriteMultiSliceIniFile (lFilename: string);

var

  lIniFile: TIniFile;

begin

  if DiskFreeEx(lFilename) < 1 then

	exit;

  if not DirectoryExists(extractfiledir(lFilename)) then begin

		mkDir(extractfiledir(lFilename));

  end;

  lIniFile := TIniFile.Create(lFilename);

  //Slice Index

  lIniFile.WriteString('STR', 'Slices', MultiSliceNum2String);

  //Booleans

  lIniFile.WriteString('BOOL', 'OrthoView',Bool2Char( gMulti.OrthoView));

  lIniFile.WriteString('BOOL', 'SliceLabel',Bool2Char( gMulti.SliceLabel));

  //Integers        LicenseID

  lIniFile.WriteString('INT', 'Orient',IntToStr(gMulti.Orient));

  lIniFile.WriteString('INT', 'OverslicePct',IntToStr(gMulti.OverslicePct));

  lIniFile.Free;

end;

procedure ReadMultiSliceIniFile (lFilename: string);

var

  lStr: string;

  lIniFile: TIniFile;

begin

	if not FileexistsEx(lFilename) then begin

		exit;

	end;

  lIniFile := TIniFile.Create(lFilename);

  lStr := lIniFile.ReadString('STR', 'Slices', '10,20,30');//file0 - last file viewed

  MultiSliceString2Num(lStr);

  gMulti.OrthoView := IniBool(lIniFile,'OrthoView',gMulti.OrthoView);

  gMulti.SliceLabel := IniBool(lIniFile,'SliceLabel',gMulti.SliceLabel);

  gMulti.Orient:= IniInt(lIniFile,'Orient',gMulti.Orient);

  gMulti.OverslicePct:= IniInt(lIniFile,'OverslicePct',gMulti.OverslicePct);

	lIniFile.Free;

end;

procedure TMultiSliceForm.OpenMultiMRU(Sender:TObject);

var

	lFilename: string;

begin

   lFilename := gMultiSliceDir +(Sender as TMenuItem).caption+'.ini' ;

   ReadMultiSliceIniFile(lFilename);

   UpdateMultiSliceDisplay;

   CreateMultiSlice;

end;

procedure TMultiSliceForm.UpdateMultiSliceMRU;

var

	NewItem: TMenuItem;

	lSearchRec: TSearchRec;

begin

  While Settings1.Count > 0 do Settings1.Items[0].Free;

  if FindFirst(gMultiSliceDir +'*.ini', faAnyFile, lSearchRec) = 0 then

	 repeat

		   NewItem := TMenuItem.Create(Self);

		   NewItem.Caption := ParseFileName(ExtractFileName(lSearchRec.Name));

                   {$IFDEF FPC}

                    NewItem.Onclick := @OpenMultiMRU; //Lazarus

                    {$ELSE}

                     NewItem.Onclick := OpenMultiMRU;

                     {$ENDIF}

		   Settings1.Add(NewItem);

		until (FindNext(lSearchRec) <> 0);

  FindClose(lSearchRec);

end;

procedure TMultiSliceForm.Copy1Click(Sender: TObject);

{$IFNDEF FPC}

var

  MyFormat : Word;

  AData: THandle;

  APalette : HPalette;

  {$ENDIF}

begin

           {$IFDEF Darwin}

        Showmessage('Copy not yet supported with OSX: use File/Save');

        {$ENDIF}

	 if (MultiImage.Picture.Graphic = nil) then begin //1420z

		Showmessage('You need to load an image before you can copy it to the clipboard.');

		exit;

	 end;

 {$IFNDEF FPC}

	 MultiImage.Picture.Bitmap.SaveToClipBoardFormat(MyFormat,AData,APalette);

	 ClipBoard.SetAsHandle(MyFormat,AData);

 {$ELSE}

        MultiSliceForm.MultiImage.Picture.Bitmap.SaveToClipboardFormat(2);

 {$ENDIF}

end;

procedure TMultiSliceForm.MenuItem1Click(Sender: TObject);

begin

end;

procedure TMultiSliceForm.Saveasbitmap1Click(Sender: TObject);

begin

	 SaveImgAsPNGBMP (MultiImage);

end;

 {$IFNDEF FPC} //if delphi...

procedure CreateBlankBitmap (lPGHt,lPGWid:integer;var lImage: TImage);

var

 sbBits : PByteArray;

 l32BitP: DWordp;

 lBGInvisibleColor: DWord;

   lBMP: TBitmap;

   lInc : integer;

begin

	 lBMP := TBitmap.Create;

	 TRY

			 lBMP.PixelFormat := pf32bit;

			 lBMP.Width := lPGwid;

			 lBMP.Height := lPGHt;

			 sbBits := lBmp.ScanLine[lPGHt-1];

			 //FillChar(sbBits^,(lPGHt*lPGwid*4), 0);

			 //FillChar fills with black, the next bit will fill current background color

			 lBGInvisibleColor := gMRIcroOverlay[kBGOverlayNum].LUTinvisible;

			 l32BitP := DWordp(sbBits);

			 for lInc := 1 to (lPGwid*lPGHt) do

				l32BitP[lInc] := lBGInvisibleColor;

			 lImage.Width := (lBmp.Width);//xx

			 lImage.Height := (lBmp.Height);//xx

			 lImage.Picture.Graphic := lBMP;

	 FINALLY

			   lBMP.Free;

	 END; //try..finally

end; //proc CreateBlankBitmap

 {$ELSE} //else freepascal

procedure CreateBlankBitmap (lPGHt,lPGWid:integer;var lImage: TImage);

var

   lPos: integer;

   lBGInvisibleColor: TRGBQuad;

begin

{$IFDEF ENDIAN_BIG}

lBGInvisibleColor :=TColor2TRGBQuad(clBlack);

 {$ELSE}

  //lBGInvisibleColor := gMRIcroOverlay[kBGOverlayNum].LUTinvisible;

  lBGInvisibleColor := gMRIcroOverlay[kBGOverlayNum].LUT[0];

 {$ENDIF}

   gMultiWid := lPGWid;

  gMultiHt := lPGHt;

  if (gMultiWid < 1) or (gMultiHt < 1) then

     exit;

  getmem (gMultiBuff, gMultiHt*gMultiWid*sizeof(TRGBQuad) );

  //fillchar(gMultiBuff^,gMultiHt*gMultiWid*sizeof(TRGBQuad),0);

  for lPos := 1 to (gMultiHt*gMultiWid) do

      gMultiBuff^[lPos] :=  lBGInvisibleColor;

end;

{$ENDIF}

procedure MultiHLine (lX1,lX2,lY1,lThick: integer; lClr: TRGBQuad);

var

   lLine,lY,lYPos,lX,lXlo,lXhi: integer;

begin

  if (lThick < 1) or (gMultiWid < 1) or (gMultiHt < 1) or (lY1 < 1) or (lY1 >gMultiHt) or (gMultiBuff = nil) then

     exit;

  lXlo := lX1;

  lXHi := lX2;

  SortInteger(lXlo,lXhi);

  if lXlo < 1 then

     lXlo := 1;

  if lXlo > gMultiWid then

     lXlo := gMultiWid;

  if lXhi < 1 then

     lXhi := 1;

  if lXhi > gMultiWid then

     lXhi := gMultiWid;

  lY := lY1-((lThick{+1}) div 2);

  for lLine := 1 to lThick do begin

      lYPos := (lY)*gMultiWid;

      if lY < gMultiHt then

          for lX := lXlo to lXhi do

          gMultiBuff^[lYPos+lX] := lClr;

      inc(lY);

  end;

end;

procedure MultiVLine (lX1,lY1,lY2,lThick: integer; lClr: TRGBQuad);

var

   lXs, lX,lY,lYlo,lYhi: integer;

begin

  if (lThick < 1) or (gMultiWid < 1) or (gMultiHt < 1) or (lX1 < 1) or (lX1 >gMultiWid) or (gMultiBuff = nil) then

     exit;

  lYlo := lY1;

  lYHi := lY2;

  SortInteger(lYlo,lYhi);

  if lYlo < 1 then

     lYlo := 1;

  if lYlo > gMultiHt then

     lYlo := gMultiHt;

  if lYhi < 1 then

     lYhi := 1;

  if lYhi > gMultiHt then

     lYhi := gMultiHt;

  lXs := lX1-((lThick{+1}) div 2)-2;//-2 as indexed from 0 and line is at least 1 pixel thick

  for lX := lXs to (lXs+lThick-1) do

      if (lX >= 0) and (lX < gMultiWid) then

         for lY := lYlo to lYHi do

             gMultiBuff^[((lY-1)*gMultiWid)+lX] := lClr;

end;

procedure DefineBackGround(var lBMP: DWordp; lBGInvisibleColor: DWord; lMaskHt,lMaskWid: integer);

//lMaskP should have all invis voxels as 128, non as 255

//sets all invis boundary voxels to 0

var

	lMaskP: ByteP;

	lBGvisibleColor: DWord;

	lPos,lMaskSz,

	lQSz,lQHead,lQTail: integer;

	lQRA: LongIntp;

Procedure IncQra(var lVal, lQSz: integer);

begin

	inc(lVal);

	if lVal >= lQSz then

	 lVal := 1;

end;

PROCEDURE RetirePixel; //FIFO cleanup

VAR

   lVal,lPos: integer;

BEGIN

   lVal := lQra^[lQTail];

   lPos := lVal-1;

   if (lPos > 0) and (lMaskP^[lPos]=128) then begin//add item to left

		incQra(lQHead,lQSz);

		lMaskP^[lPos] := 0;

		lQra^[lQHead] := lPos;

   end;

   if (lPos > 0) then lMaskP^[lPos] := 0;

   lPos := lVal+1;

   if (lPos < lMaskSz) and (lMaskP^[lPos]=128) then begin//add item to right

		incQra(lQHead,lQSz);

		lMaskP^[lPos] := 0;

		lQra^[lQHead] := lPos;

   end;

   if (lPos < lMaskSz) then lMaskP^[lPos] := 0;

   lPos := lVal-lMaskWid;

   if (lPos > 0) and (lMaskP^[lPos]=128) then begin//add item above

		incQra(lQHead,lQSz);

		lMaskP^[lPos] := 0;

		lQra^[lQHead] := lPos;

   end;

   if (lPos > 0) then lMaskP^[lPos] := 0;

   lPos := lVal+lMaskWid;

   if (lPos < lMaskSz) and(lMaskP^[lPos]=128) then begin//add item below

		incQra(lQHead,lQSz);

		lMaskP^[lPos] := 0;

		lQra^[lQHead] := lPos;

   end;

   if (lPos < lMaskSz) then lMaskP^[lPos] := 0;

   incQra(lQTail,lQSz); //done with this pixel

END;

procedure FillStart (lPt: integer); {FIFO algorithm: keep memory VERY low}

begin

  if (lPt < 1) or (lPt > lMaskSz) or (lMaskP^[lPt] <> 128) then exit;

  //lQSz := 8000;//size of FIFO Queue Array

  lQHead := 1;

  lQTail := 1;

  lQra^[lQTail] := (lPt); //NOTE: both X and Y start from 0 not 1

  lMaskP^[lPt] := 0;

  RetirePixel;

  if lQHead >= lQTail then begin

	while lQHead <> lQTail do

		RetirePixel;

  end;

end;

begin //proc DefineBG

  lMaskSz := lMaskWid * lMaskHt;

  Getmem(lMaskP,lMaskSz);

  for lPos := 1 to lMaskSz do

	if lBMP^[lPos] = lBGInvisibleColor then

		lMaskP^[lPos] := 128

	else

		lMaskP^[lPos] := 255;

  lQSz := lMaskSz div 4;

  GetMem(lQra,lQSz*sizeof(LongInt));

  //erase all rows

  for lPos := 1 to lMaskHt do begin

	  FillStart( (lPos-1)*lMaskWid + 1);

	  FillStart( (lPos)*lMaskWid);

  end;

  //erase all cols

  for lPos := 1 to lMaskWid do begin

	  FillStart( lPos + 1);

	  FillStart( ((lMaskHt-1) *lMaskWid) + lPos);

  end;

  Freemem(lQRa);

  //make sure bright blue 0000FF becauses neighbor 0000FE instead of 000100

  if (lBGInvisibleColor and 255) = 255 then

	lBGVisibleColor:= lBGInvisibleColor-1

  else

	lBGVisibleColor:= lBGInvisibleColor+1;

  //now, fill in islands so they are not transparent

  for lPos := 1 to lMaskSz do

	if lMaskP^[lPos] = 128 then

		lBMP^[lPos] := lBGVisibleColor;

  Freemem(lMaskP);

end;

{$IFDEF FPC} //Delphi draws bitmaps directly, Lazarus can use two indirect methods...

procedure SetDim (lInPGHt,lInPGWid,lWriteColumn: integer; var l32OutBitP : DWordp);

var

   lLen,lSrc,lDest,lY: integer;

   lTBuff:    RGBQuadp;

begin

        getmem(lTBuff,lInPGHt*lWriteColumn*4);

        lLen := lWriteColumn*4;

        lSrc := 1;

        lDest := 1;

        for lY := 1 to lInPGHt do begin

           //svn Move(Pointer(l32OutBitP^[lSrc]),Pointer(lTBuff^[lDest]),lLen);

           Move(l32OutBitP^[lSrc],lTBuff^[lDest],lLen);

           lSrc := lSrc + lInPGWid;

           lDest := lDest + lWriteColumn;

        end;

        DrawBMP( lWriteColumn, lInPGHt, lTBuff, MultiSliceForm.MultiImage);

        freemem(lTBuff);

end;

{$ENDIF} //ifdef FPC

procedure RemoveHorizGaps (lMaxOverlapWid,lColWid: integer); //will overlap gaps from 1..lMaxOverlapWid, leave right non-overlapped);

var

 l32BitP,l32OutBitP : DWordp;

 lBGInvisibleColor,lBGInvisibleColorShr8: DWord;

 lIsGap,lPrevIsGap: boolean;

 lInc,lPrevSliceStart,lPrevSliceEnd,lPrevWriteColumn,lWid,lHt,lReadRow,

 lMaxWriteColumn,lReadColumn,lWriteColumn,lReadOffset,lWriteOffset,lPos,x,y: integer;

 lTextPos,lTextReadColumn: integer;

begin

      (*freemem (gMultiBuff );

 gMultiBuff := nil;

 exit;*)

     for lTextPos := 1 to kMaxMultiSlice do

         gMultiXCenterRA[lTextPos] := 0;

       lTextPos := 0;

       lTextReadColumn := lColWid div 2;

       if (gMultiWid < 1) or (gMultiHt < 1) or (gMultiBuff = nil) then

          exit;

     lBGInvisibleColor := TRGBQuad2DWord(gMRIcroOverlay[kBGOverlayNum].LUTinvisible);

     //fx(lBGInvisibleColor);

     //lBGInvisibleColorShr8 := lBGInvisibleColor Shr 8;

	lHt := gMultiHt;//MultiSliceForm.MultiImage.Picture.Bitmap.Height;

	lWid := gMultiWid; //MultiSliceForm.MultiImage.Picture.Bitmap.Width;

	if (lHt < 2) or (lWid < 2) then exit;

	//next: prepare input

        l32BitP := DWordP(gMultiBuff);

        (*GetMem(l32BitP,lHt*lWid*sizeof(DWord));

        lPos := 0;

        for y:=  0 to (lHt-1) do begin

            for x:=0 to lWid-1 do begin

                inc(lPos);

                l32BitP^[lPos] := MultiSliceForm.MultiImage.Picture.Bitmap.Canvas.Pixels[x,y];

            end;

        end;*)

        lBGInvisibleColor := l32BitP^[1];

	DefineBackGround(l32BitP,lBGInvisibleColor, lHt,lWid);

	//next prepare output

         GetMem(l32OutBitP,lHt*lWid*sizeof(DWord));

	 for lInc := 1 to (lwid*lHt) do

		l32OutBitP^[lInc] := lBGInvisibleColor;

	//next: compress by deleting empty columns

	lWriteColumn := 0;

	lPrevIsGap := true;

	lPrevSliceStart := maxint -10;

	lPrevSliceEnd := 0;

	lPrevWriteColumn := maxint-10;//do not degap 1st line

if gMulti.OverSlicePct = 0 then begin //simply remove gaps between slice

	for lReadColumn := 1 to lWid do begin

		lReadOffset := lReadColumn;

		lIsGap := true;

		lReadRow := 1;

                if lReadColumn >= lTextReadColumn then begin

                   inc(lTextPos);

                   lTextReadColumn := lTextReadColumn+lColWid;

                   if lTextPos <= kMaxMultiSlice then

                      gMultiXCenterRA[lTextPos] := lWriteColumn;

                end;

		while (lReadRow < lHt) and (lIsGap) do begin

			if l32BitP^[lReadOffset] <> lBGInvisibleColor then

				lIsGap := false;

			inc(lReadOffset,lWid);

			inc(lReadRow);

		end; //while each readrow

		if not lIsGap then begin//data in this column

			if lReadColumn > (lPrevWriteColumn+1) then begin //leave one pixel gap between noncontiguous columns

				inc(lWriteColumn);

				lReadOffset := lReadColumn-1;

				lWriteOffset := lWriteColumn;

				//showmessage(inttostr(lWriteColumn)+'  '+inttostr(lReadOffset));

				for lReadRow := 1 to lHt do begin

					l32OutBitP[lWriteOffset] := l32BitP[lReadOffset];

					inc(lReadOffset,lWid);

					inc(lWriteOffset,lWid);

				end;

			end; //leave 1 pixel gap

			inc(lWriteColumn);

			lReadOffset := lReadColumn;

			lWriteOffset := lWriteColumn;

			for lReadRow := 1 to lHt do begin

				l32OutBitP[lWriteOffset] := l32BitP[lReadOffset];

				inc(lReadOffset,lWid);

				inc(lWriteOffset,lWid);

			end;

			lPrevWriteColumn := lReadColumn;

		end; //not Gap - write this column

	end; //for each column

end else begin //overslice <> 0: show subsequent slices above/below each other

         lMaxWriteColumn := -maxint;

         for lReadColumn := 1 to lMaxOverlapWid do begin

		lReadOffset := lReadColumn;

		lIsGap := true;

		lReadRow := 1;

		while (lReadRow < lHt) and (lIsGap) do begin

			//ovx

			if l32BitP^[lReadOffset] <> lBGInvisibleColor then

				lIsGap := false;

			inc(lReadOffset,lWid);

			inc(lReadRow);

		end; //while each readrow

		if (lPrevIsGap <> lIsGap) then begin//change from prev column

			if not (lIsGap) then begin

                              //fx(lPrevSliceStart,lPrevSliceEnd,lReadColumn,abs(((lPrevSliceEnd-lPrevSliceStart) * gMulti.OverSlicePct)div 100));

			   if lPrevSliceEnd > lPrevSliceStart then

				lWriteColumn := lPrevSliceEnd-abs(((lPrevSliceEnd-lPrevSliceStart) * gMulti.OverSlicePct)div 100);

			   lPrevSliceStart := lWriteColumn;

			end;

			if (lIsGap) then

			   lPrevSliceEnd := lWriteColumn;

		end;

		lPrevIsGap := lIsGap;

		if gMulti.OverSlicePct > 0 then begin

		  if not lIsGap then begin//data in this column

			inc(lWriteColumn);

			lReadOffset := lReadColumn;

			lWriteOffset := lWriteColumn;

			for lReadRow := 1 to lHt do begin

				if l32BitP^[lReadOffset] <> lBGInvisibleColor then

					l32OutBitP^[lWriteOffset] := l32BitP^[lReadOffset];

				inc(lReadOffset,lWid);

				inc(lWriteOffset,lWid);

			end;

		  end; //not Gap - write this column

		end else begin //if overwrite, else underwrite

		  if not lIsGap then begin//data in this column

			inc(lWriteColumn);

			lReadOffset := lReadColumn;

			lWriteOffset := lWriteColumn;

		        for lReadRow := 1 to lHt do begin

				if l32OutBitP^[lWriteOffset] = lBGInvisibleColor then

					l32OutBitP^[lWriteOffset] := l32BitP^[lReadOffset];

				inc(lReadOffset,lWid);

				inc(lWriteOffset,lWid);

			end;

		  end; //not Gap - write this column

		end;

                if lReadColumn >= lTextReadColumn then begin //text

                   inc(lTextPos);

                   lTextReadColumn := lTextReadColumn+lColWid;

                   if lTextPos <= kMaxMultiSlice then

                      gMultiXCenterRA[lTextPos] := lWriteColumn;

                end;  //text

       		if lWriteColumn > lMaxWriteColumn then

			lMaxWriteColumn := lWriteColumn;

	end; //for each column

	if lWriteColumn < lMaxWriteColumn then

		lWriteColumn := lMaxWriteColumn;

       if lMaxOverlapWid < lWid then begin

		lReadColumn := lMaxOverlapWid;

		if (lWriteColumn) < lReadColumn then //add gap if some compression

			inc(lWriteColumn);

		for lReadColumn := (lMaxOverlapWid+1) to lWid do begin

		  lReadOffset := lReadColumn;

		  lIsGap := true;

		  lReadRow := 1;

		  while (lReadRow < lHt) and (lIsGap) do begin

			if l32BitP^[lReadOffset] <> lBGInvisibleColor then

				lIsGap := false;

			inc(lReadOffset,lWid);

			inc(lReadRow);

		  end; //while each readrow

		  if not lIsGap then begin

			inc(lWriteColumn);

			lReadOffset := lReadColumn;

			lWriteOffset := lWriteColumn;

			for lReadRow := 1 to lHt do begin

				l32OutBitP[lWriteOffset] := l32BitP[lReadOffset];

				inc(lReadOffset,lWid);

				inc(lWriteOffset,lWid);

			end; //for each row

		  end; //not gap

		end; //for each column

		if (lWriteColumn+1) < lWid then

			inc(lWriteColumn);

	end; //if maxwid < wid - unoverlapped

end;

 SetDim (lHt,lWid,lWriteColumn,l32OutBitP);

 FreeMem(l32OutBitP);

   freemem (gMultiBuff );

 gMultiBuff := nil;

end;

procedure TMultiSliceForm.CreateMultiSag;

var

	lSlice,lHt,lWid,lSlicePos,lSliceWid: integer;

begin

  lHt:= gBGIMg.ScrnDim[3];

  lSliceWid :=gBGIMg.ScrnDim[2]+2;//+1 for 1-voxel gap between slices - ensures we can detect slice boundary

  lWid := (lSliceWid*gMulti.nSlices);

  if lWid < 2 then exit;

  if gMulti.OrthoView then //coro crossview

	lWid := lWid + gBGIMg.ScrnDim[1]+2;

  if lWid < 2 then exit;

  CreateBlankBitmap (lHt,lWid, MultiImage);

  for lSlice := 1 to gMulti.nSlices do begin

	DrawSag (gMulti.SliceList[lSlice],1+((lSlice-1)*lSliceWid));//+lSlice because we want 1-voxel gap between slices

	//if gMulti.SliceLabel then DrawLabel(MultiImage,DimToMM(gMulti.SliceList[lSlice],1),((lSlice-1)*lSliceWid)+(lSliceWid div 2),lWid);

  end;

  if gMulti.OrthoView then begin //coro crossview

	DrawCor (gBGImg.ScrnDim[2] div 2,(lSliceWid*gMulti.nSlices)-1);

        //MultiImage.Canvas.Pen.Color := clWhite;

	//MultiImage.Canvas.Pen.Color := gBGIMg.XBarClr;

        //MultiImage.Canvas.Pen.Width := gBGImg.XBarThick;

        for lSlice := 1 to gMulti.nSlices do begin //draw lines

		lSlicePos := (gMulti.nSlices*lSliceWid)+(gMulti.SliceList[lSlice]);

                MultiVLine (lSlicePos,0,lHt,gBGImg.XBarThick,TColor2TRGBQuad(gBGImg.XBarClr));

		{MultiImage.Canvas.MoveTo(lSlicePos,0);

		MultiImage.Canvas.LineTo(lSlicePos,lHt);}

	end;//line for each slice

  end;//if cross view

  RemoveHorizGaps(lSliceWid*gMulti.nSlices,lSliceWid);

end; //CreateMultiSag

procedure TMultiSliceForm.CreateMultiCor;

var

	lSlice,lHt,lWid,lLeft,lSliceWid: integer;