home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / navody / DICOMSRC.ZIP / Childwin.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-09  |  92KB  |  2,523 lines
  1. unit Childwin;
  2.  
  3. interface
  4.  
  5. uses SysUtils, Windows, Classes, Graphics, Forms,
  6.      Controls, ExtCtrls, StdCtrls, Buttons,
  7.      ComCtrls, Menus, Dialogs,DICOM,Analyze,JPEG,lsJPEG,Clipbrd, ToolWin,uMultislice;
  8. const
  9.  
  10.      kRadCon = pi/180;
  11.      kMaxECAT = 512;
  12.      PixelCountMax = 32768;
  13.      gMouseDown : boolean = false;
  14.      gInc: integer = 0;
  15. type
  16.   pRGBTripleArray = ^TRGBTripleArray;
  17.   TRGBTripleArray = ARRAY[0..PixelCountMax-1] OF TRGBTriple;
  18.  
  19.     palentries   = array[0..255] of TPaletteEntry;
  20.     palindices   = array[0..255] of word;
  21.     TMDIChild = class(TForm)
  22.     MainMenu1: TMainMenu;
  23.     OptionsSettingsMenu: TMenuItem;
  24.     OptionsImgInfoItem: TMenuItem;
  25.     N2: TMenuItem;
  26.     Lowerslice1: TMenuItem;
  27.     Higherslice1: TMenuItem;
  28.     SelectZoom1: TMenuItem;
  29.     ContrastAutobalance1: TMenuItem;
  30.     ScrollBox1: TScrollBox;
  31.     Image: TImage;
  32.     Memo1: TMemo;
  33.     CopyItem: TMenuItem;
  34.     EditMenu: TMenuItem;
  35.     Timer1: TTimer;
  36.     StudyMenu: TMenuItem;
  37.     Previous1: TMenuItem;
  38.     Next1: TMenuItem;
  39.     Mosaic1: TMenuItem;
  40.     N1x11: TMenuItem;
  41.     N2x21: TMenuItem;
  42.     N3x31: TMenuItem;
  43.     N4x41: TMenuItem;
  44.     Other1: TMenuItem;
  45.     Smooth1: TMenuItem;
  46.     Overlay1: TMenuItem;
  47.     None1: TMenuItem;
  48.     White1: TMenuItem;
  49.     Black1: TMenuItem;
  50.     procedure FreeBackupBitmap;
  51.     //procedure ReleaseDICOMmemory;
  52.     procedure UpdatePalette (lApply: boolean; lWid0ForSlope:integer);
  53.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  54.     procedure FormCreate(Sender: TObject);
  55.     procedure FileOpenItemClick(Sender: TObject);
  56.     procedure FileCloseItemClick(Sender: TObject);
  57.     procedure FileExitItemClick(Sender: TObject);
  58.     procedure OptionsImgInfoItemClick(Sender: TObject);
  59.     procedure FileExportAsBmpItemClick(Sender: TObject);
  60.     procedure FileOpenpicture1Click(Sender: TObject);
  61.     procedure Lowerslice1Click(Sender: TObject);
  62.     procedure FormActivate(Sender: TObject);
  63.     procedure LoadColorScheme(lStr: string; lScheme: integer);
  64.     procedure DetermineZoom;
  65.     procedure AutoMaximise;
  66.     procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
  67.       Shift: TShiftState; X, Y: Integer);
  68.     procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  69.       Y: Integer);
  70.     procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
  71.       Shift: TShiftState; X, Y: Integer);
  72.     procedure SelectZoom1Click(Sender: TObject);
  73.     procedure ContrastAutobalance1Click(Sender: TObject);
  74.     procedure FormResize(Sender: TObject);
  75.     procedure CopyItemClick(Sender: TObject);
  76.     procedure DICOMImageRefreshAndSize;
  77.     procedure SetDimension(lInPGHt,lInPGWid ,lInBits:integer; lInBuff: ByteP0; lUseWinCenWid: boolean);
  78.     procedure Scale16to8bit(lWinCen,lWinWid: integer);
  79.     function VxlVal(X,Y: integer):integer;
  80.     procedure Vxl(X,Y: integer);
  81.     procedure Timer1Timer(Sender: TObject);
  82.     procedure Previous1Click(Sender: TObject);
  83.     procedure N1x11Click(Sender: TObject);
  84.     procedure Smooth1Click(Sender: TObject);
  85.     procedure None1Click(Sender: TObject);
  86.   private
  87.     { Private declarations }
  88.       FLastDown,gSelectOrigin: TPoint;
  89.      // gMagRect,gSelectRect: TRect;
  90.     FFileName,gFilePath     : string;
  91.     gPalRA,gRra,gGra,gBra: array [0..255] of byte;
  92.     gECATslices: integer;
  93.     gECATposra,gECATszra: array[1..kMaxECAT] of longint;
  94.     gDynStr: string;
  95.     gAbort: boolean;
  96.   public
  97.  
  98.         BackupBitmap: TBitmap;
  99.      gSelectRect,gMagRect: TRect;
  100.    gMultiFirst,gMultiLast,gMultiRow,gMultiCol,g100pctImageWid, g100pctImageHt{,gMaxRGB,gMinRGB,gMinHt,gMinWid}: integer;
  101.     gSmooth,gImgOK,FDICOM: boolean;
  102.     gBuff16: SmallIntP0;
  103.     gBuff8,gBuff24: Bytep0;
  104.     gDicomData: DIcomData;
  105.     gStringList : TStringList;
  106.     gVideoSpeed,gBuff24sz,gBuff8sz, gBuff16sz,gCustomPalette: integer;
  107.      gFileListSz,gCurrentPosInFileList,gWinCen,gWinWid,gSlice,gnSLice,gXStart,gStartSlope,gStartCen,gYStart,gImgMin,gImgMax,gImgCen,gImgWid,gWinMin,gWinMax,gWHite,gBlack,gScheme,gZoomPct,gPro,gScale: integer;
  108.     gContrastStr: string;
  109.      gFastSlope,gFastCen : integer;
  110.     { Public declarations }
  111.     procedure OverlayData;
  112.     function  LoadData( lFileName : string; lAnalyze,lECAT,l2dImage,lRaw: boolean ) : Boolean;
  113.     procedure LoadFileList;
  114.     procedure ReleaseDICOMmemory;
  115.     procedure DisplayImage(lUpdateCon,lForceDraw: boolean; lSlice,lWinWid,lWincen: integer);
  116.     //procedure Vxl;
  117.     procedure HdrShow;
  118.     procedure RefreshZoom;
  119.     PROCEDURE ShowMagnifier (CONST X,Y:  INTEGER);//requires backup bitmap
  120.   end;
  121. var
  122.    MDIChild : TMDIChild;
  123.  
  124. //     gImgStr: string ='';
  125.  
  126.  
  127. implementation
  128.  
  129. uses Main;
  130.  
  131.  
  132.  
  133. var
  134. //gPalUpdated: boolean;
  135. gMaxRGB,gMinRGB,gMinHt,gMinWid: integer;
  136.    gRGBquadRA: array [0..255] of TRGBquad;
  137. {$R *.DFM}
  138. procedure TMDIChild.OverlayData;
  139. var lZOomPct,lMultiSlice,lRowPos,lColPos,lDiv,lFOntSpacing,lSpace,lRow,lSlice,lCol: integer;
  140. lMultiSliceInc : single;
  141. begin
  142.      if None1.checked then exit;
  143.      if gSmooth then
  144.         lZoomPct := gZoomPct
  145.      else
  146.          lZoomPct := 100;
  147.      if gMultiCol > 0 then
  148.         lDiv := gMultiCol
  149.      else
  150.          lDiv := 1;
  151.      case {gDicomData.XYZdim[1]}(image.Picture.Width div lDiv) of
  152.           0..63: lFontSpacing := 8;
  153.           64..127: lFontSpacing := 8;//9;
  154.           128..255: lFontSpacing := 9;//10;
  155.           256..511: lFontSpacing := 10;//12;
  156.           512..767: lFontSpacing := 12;//14;
  157.           else lFontSpacing := 14;//26;
  158.      end;
  159.            Image.Canvas.Font.Name := 'MS Sans Serif';
  160.            Image.Canvas.Brush.Style := bsClear;
  161.            Image.Canvas.Font.Size := lFontSpacing;
  162.            if White1.Checked then
  163.               Image.Canvas.Font.Color := gMaxRGB
  164.            else
  165.               Image.Canvas.Font.Color := gMinRGB;
  166.            if ((gMultiRow > 1) or (gMultiCol > 1)) and (gMultiROw > 0) and (gMultiCol > 0) then begin
  167.                lMultiSliceInc := (gMultiLast -gMultiFirst) / ((gMultiRow * gMultiCol)-1);
  168.                if lMultiSliceInc < 1 then
  169.                   lMultiSliceInc := 1;
  170.                lMultiSlice := 0;
  171.                for lRow := 0 to (gMultiRow-1)  do begin
  172.                    lRowPos := 6+(lROw * (((gDICOMdata.XYZdim[2] )* lZoomPct) div 100 ));
  173.                    for lCol := 0 to (gMultiCOl-1)  do begin
  174.                        lColPos :=6+ (lCol * (((gDICOMdata.XYZdim[1] )* lZoomPct) div 100 ));
  175.                        lSlice := gMultiFirst+round (lMultiSliceInc*(lMultiSlice))-1;
  176.                        //showmessage(inttostr(lColPos)+':'+inttostr(lROwPos));
  177.                        if (gDicomData.XYZdim[3] > 1) then begin
  178.                           if (lSLice < gDicomData.XYZdim[3]) then begin
  179.                             if (lRow=0) and (lCol=0) then
  180.                              Image.Canvas.TextOut(lColPos,lROwPos,inttostr(lSlice+1)+':'+extractfilename(ffilename))
  181.                             else
  182.                              Image.Canvas.TextOut(lColPos,lROwPos,inttostr(lSlice+1))
  183.  
  184.                           end
  185.                        end else if (lSlice < gFileListSz) and (lSlice >= 0) then
  186.                             Image.Canvas.TextOut(lColPos,lRowPos,inttostr(lSlice+1)+':'+(gStringList.Strings[lSlice]));
  187.  //                           Image.Canvas.TextOut(lColPos,lRowPos,inttostr(lSlice));
  188.  
  189.                        inc(lMultiSlice);
  190.                    end;//for lROw
  191.                end; //for lCol.
  192.            end else //not multislice mosaic
  193.                Image.Canvas.TextOut(6,6,extractfilename(FFilename));
  194.            lSpace := 6+2+lFontSpacing;
  195.            //Image.Canvas.TextOut(6,lSpace,'Name: '+gDicomData.PatientName);
  196.            //lSpace :=lSpace+ 2+lFontSpacing;
  197.            //if DetailedItem.checked then begin
  198.               //Image.Canvas.TextOut(6,lSpace,'ID: '+gDicomData.PatientID);
  199.               //lSpace :=lSpace+ 2+lFontSpacing;
  200.               //Image.Canvas.TextOut(6,lSpace,'Date: '+gDicomData.StudyDate);
  201.               //lSpace :=lSpace+ 2+lFontSpacing;
  202.               Image.Canvas.TextOut(6,lSpace,'C: '+inttostr(gWinCen));
  203.               lSpace :=lSpace+ 2+lFontSpacing;
  204.               Image.Canvas.TextOut(6,lSpace,'W: '+inttostr(gWinWid));
  205.            //end;
  206.   end;
  207.  
  208.  
  209.  
  210. procedure TMDIChild.RefreshZoom;
  211. begin
  212.   LockWindowUpdate(Self.Handle);
  213.   if gBuff24sz > 0 then
  214.         SetDimension(g100pctImageHt,g100pctImageWid,24,gBuff24,false)
  215.   else if gBuff16sz > 0 then
  216.          Scale16to8bit(TMDIChild(MainForm.ActiveMDIChild).gWinCen,TMDIChild(MainForm.ActiveMDIChild).gWinWid)
  217.   else if  (gBuff8sz > 0) {and (gCustomPalette = 0)} then begin
  218.        //showmessage('abba'+inttostr(gWinWid));
  219.        SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true);
  220.        //showmessage('abba'+inttostr(gWinWid)); XXX
  221.   end else begin
  222.        //if Image.Picture.Bitmap.PixelFormat = pf24bit then
  223.        //if gCustomPalette <> 0 then
  224.        //   MainForm.StatusBar.Panels[4].text := inttostr(gCustomPalette)+':'+inttostr(random(8888))+'%';
  225.        MainForm.StatusBar.Panels[1].text := inttostr(gZoomPct)+'%';
  226.        image.Height:= round((image.Picture.Height * gZoomPct) div 100);
  227.        image.Width := round((image.Picture.Width* gZoomPct) div 100) ;
  228.        IMage.refresh;
  229.        LockWindowUpdate(0);
  230.        exit;
  231.   end;
  232.   MainForm.StatusBar.Panels[1].text := inttostr(gZoomPct)+'%';
  233.   DICOMImageRefreshAndSize;
  234.   LockWindowUpdate(0);
  235.   //inc(gInc);
  236.   //MainForm.StatusBar.Panels[0].text := inttostr(gInc)+'abba';
  237. end;
  238.  
  239. procedure TMDIChild.DICOMImageRefreshAndSize;
  240. begin
  241.   if gSmooth then begin
  242.      image.Height:= image.Picture.Height;
  243.      image.Width := image.Picture.Width ;
  244.   end else begin
  245.        image.Height:= round((image.Picture.Height * gZoomPct) div 100);
  246.        image.Width := round((image.Picture.Width* gZoomPct) div 100) ;
  247.   end;
  248.   OverlayData;
  249.   IMage.refresh;
  250. end;
  251. procedure   TMDIChild.ReleaseDICOMmemory;
  252. begin
  253.   {if (BackupBitmap <> nil) and (self.active) then begin//magnifier on
  254.      MainForm.StatusBar.Panels[1].text := inttostr(gCustomPalette)+':'+inttostr(random(8888))+'release';
  255.      BackupBitmap.Free;
  256.      BackupBitmap := nil
  257.   end;}
  258.   FreeBackupBitmap;
  259.   if (gBuff24sz > 0) then begin
  260.      freemem(gBuff24);
  261.      gBuff24sz := 0;
  262.   end;
  263.   if (gBuff16sz > 0) then begin
  264.      freemem(gBuff16);
  265.      gBuff16sz := 0;
  266.   end;
  267.   if (gBuff8sz > 0) then begin
  268.      freemem(gBuff8);
  269.      gBuff8sz := 0;
  270.   end;
  271.      if red_table_size > 0 then begin
  272.         freemem(red_table);
  273.         red_table_size := 0;
  274.      end;
  275.      if green_table_size > 0 then begin
  276.         freemem(green_table);
  277.         green_table_size := 0;
  278.      end;
  279.      if blue_table_size > 0 then begin
  280.         freemem(blue_table);
  281.         blue_table_size := 0;
  282.      end;
  283.      gCustomPalette := 0;
  284.       gECATslices:= 0;
  285. end;
  286.  
  287.  
  288. procedure TMDIChild.LoadFileList;
  289. var
  290.   lSearchRec: TSearchRec;
  291.   lName,lFilenameWOPath,lExt : string;
  292.   lSz,lDICMcode: integer;
  293.   lDICM: boolean;
  294.      FP: file;
  295. begin
  296.      lFilenameWOPath := extractfilename(FFilename);
  297.      lExt := ExtractFileExt(FFileName);
  298.      if length(lExt) > 0 then
  299.         for lSz := 1 to length(lExt) do
  300.             lExt[lSz] := upcase(lExt[lSz]);
  301.  if (gDicomData.NamePos > 0) then begin //real DICOM file
  302.      if {SysUtils.}FindFirst(gFilePath+'*.*', faAnyFile, lSearchRec) = 0 then begin
  303.         repeat
  304.               lExt := AnsiUpperCase(extractfileext(lSearchRec.Name));
  305.               lName := AnsiUpperCase(lSearchRec.name);
  306.               if (lSearchRec.Size > 1024)and (lName <> 'DICOMDIR') then begin
  307.                  lDICM := false;
  308.                  if ('.DCM' = lExt) then lDICM := true;
  309.                  if ('.DCM'<>  lExt) then begin
  310.                     Filemode := 0;
  311.                     AssignFile(fp, gFilePath+lSearchRec.Name);
  312.                     Filemode := 0; //read only - might be CD
  313.                     Reset(fp, 1);
  314.                     Seek(FP,128);
  315.                     BlockRead(fp, lDICMcode, 4);
  316.                     if lDICMcode = 1296255300 then lDICM := true;
  317.                     CloseFile(fp);
  318.                     Filemode := 2; //read/write
  319.                  end; //Ext <> DCM
  320.                  if lDICM then
  321.                     gStringList.Add(lSearchRec.Name);{}
  322.               end; //FileSize > 512
  323.  
  324.         until ({SysUtils.}FindNext(lSearchRec) <> 0);
  325.         Filemode := 2;
  326.      end; //some files found
  327.      SysUtils.FindClose(lSearchRec);
  328.      gStringlist.Sort;
  329.      if gStringlist.Count > 0 then begin
  330.         for lSz := (gStringList.count-1) downto 0 do begin
  331.             //showmessage(gStringList.Strings[lSz]);
  332.             if gStringList.Strings[lSz] = lFilenameWOPath then gCurrentPosInFileList := lSz;
  333.         end;
  334.      end;
  335.      gFileListSz := gStringList.count;
  336.      //showmessage(inttostr(gCurrentPosInFileList ));
  337.      //lStringList.Free;
  338.   end; //NamePos > 0    *)
  339.   if (gStringlist.Count > 1) then begin
  340.       StudyMenu.enabled := true;
  341.       //Next1.enabled := true;
  342.       //Previous1.enabled := true;
  343.       //VideospeedMenu.enabled := true;
  344.   end;
  345. end;
  346.  
  347. procedure TMDIChild.FreeBackupBitmap;
  348. begin
  349.      if BackupBItmap <> nil then begin
  350.         Backupbitmap.free;
  351.         Backupbitmap := nil;
  352.      end;
  353.      gMagRect := Rect(0,0,0,0);
  354. end;
  355.  
  356. procedure TMDIChild.Scale16to8bit(lWinCen,lWinWid: integer);
  357. var
  358.    value,i,lScaleShl10,lSz,min16,max16  :integer;
  359.    lBuffx: ByteP0;
  360. begin
  361.   if gBuff16 = nil then exit;
  362.   gWinCen := lWinCen;
  363.   gWinWid := lWinWid;
  364.   if Self.Active then begin//qwer
  365.      gContrastStr := 'Window Center/Width: '+inttostr(lWinCen)+'/'+inttostr(lWinWid){+':'+inttostr(round(lSlopeReal))};
  366.      MainForm.StatusBar.Panels[4].text := gContrastStr;
  367.   end;
  368.   //if lWinWid{Edit.value} <> 0 then begin
  369.       min16 := lWinCen{Edit.value} - (abs(trunc(lWinWid{Edit.value}/2)));
  370.       max16 := lWinCen{Edit.value} + (abs(trunc(lWinWid{Edit.value}/2)));
  371.   //end;
  372.   gWinMin := min16;
  373.   gWinMax := max16;
  374.   lSz:= (g100pctImageWid*g100pctImageHt);
  375.   GetMem( lbuffx,lSz {width * height});
  376.   lSz := lSz -1;
  377.   value := (max16-min16);
  378.   //value = range
  379.   if (value = 0) or (trunc((1024/value) * 255) = 0) then begin
  380.       if lWinWid > 1024 then begin
  381.          for i := 0 to lSz do
  382.           lbuffx[i] := 128;
  383.  
  384.       end else begin
  385.       for i := 0 to lSz do
  386.           if gBuff16[i] < lWinCen then
  387.              lbuffx[i] := 0
  388.           else
  389.                lbuffx[i] := 255;
  390.       end;
  391.   end else begin
  392.       if value = 0 then value := 1;
  393.       lScaleShl10 := trunc((1024/value) * 255); //value = range,Scale = 255/range
  394.       for i := 0 to lSz do begin
  395.           if gBuff16[i] < min16 then
  396.              lbuffx[i] := 0
  397.           else if gBuff16[i] > max16 then
  398.                lbuffx[i] := 255
  399.           else
  400.               lbuffx[i] := (((gBuff16[i])-min16) * lScaleShl10)  shr 10;
  401.             //NOTE: integer maths increases speed x7!
  402.             //          lbuff[i] := (Trunc(255*((gBuff16[i])-min16) / (value)));
  403.       end;
  404.   end;
  405.   SetDimension(g100pctImageHt,g100pctImageWid,8,lBuffx,false);
  406.   DICOMImageRefreshAndSize;
  407.   FreeMem( lbuffx );
  408.   //if gZoomTag = 0 then
  409.   //   automaximise;
  410. end;
  411.  
  412.  
  413.  
  414. function TMDIChild.VxlVal (X,Y: integer): integer;
  415. var
  416.    lVxl: integer;
  417. begin
  418.   RESULT := 0;
  419.   lVxl := (Y* g100PctImageHt) +X;
  420.   if (gBuff16Sz > 0) and (lVxl >= 0) and (lVxl < gBuff16Sz) then
  421.      result := gbuff16[lVxl]
  422.   else if (gBuff8sz > 0) and (lVxl >= 0) and (lVxl < gBuff8Sz) then
  423.      result := gbuff8[lVxl];
  424. end;
  425. procedure TMDIChild.Vxl (X,Y: integer);
  426. begin
  427.   if (gBuff8sz > 0) or (gBuff16sz > 0) then
  428.      MainForm.StatusBar.Panels[0].text := inttostr(VxlVal(X,Y)){}
  429.   else
  430.       MainForm.StatusBar.Panels[0].text := ''
  431. end;
  432.  
  433. procedure TMDIChild.SetDimension(lInPGHt,lInPGWid ,lInBits:integer; lInBuff: ByteP0; lUseWinCenWid: boolean);
  434. var
  435.   lBuff: ByteP0;
  436.   lPGwid,lPGHt,lBits: integer;
  437. procedure ScaleStretch(lSrcHt,lSrcWid: integer; lInXYRatio: single);
  438. var
  439. lKScale: byte;
  440. lrRA,lbRA,lgRA: array [0..255] of byte;
  441.   //lBuff: ByteP0;
  442.   lPos,xP,yP,yP2,xP2,t,z, z2,iz2,w1,w2,w3,w4,lTopPos,lBotPos,
  443.   lINSz,  lDstWidM,{lDstWid,lDstHt,}x,y,lLT,lLB,lRT,lRB: integer;
  444.     lXRatio,lYRatio: single;
  445.   begin
  446.   yP:=0;
  447.   lXRatio := lInXYRatio;
  448.   lYRatio := lInXYRatio;
  449.   lInSz := lSrcWid *lSrcHt;
  450.   lPGwid := {round}round(lSrcWid*lXRatio);//*lZoom;
  451.   lPGHt := {round}round(lSrcHt*lYRatio);//*lZoom;
  452.   lkScale := 1;
  453.   xP2:=((lSrcWid-1)shl 15)div (lPGWid -1 );
  454.   yP2:=((lSrcHt-1)shl 15)div (lPGHt -1);
  455.   lPos := 0;
  456.   lDstWidM := lPGWid - 1;
  457. if lBIts = 24 then begin
  458.   getmem(lBuff, lPGHt*lPGWid*3);
  459.   lInSz := lInSz * 3; //24bytesperpixel
  460.   for y:=0 to lPGHt-1 do begin
  461.       xP:= 0;
  462.       lTopPos:=lSrcWid *(yP shr 15) *3; //top row
  463.       if yP shr 16<lSrcHt-1 then
  464.          lBotPos:=lSrcWid *(yP shr 15+1) *3 //bottom column
  465.       else
  466.           lBotPos:=lTopPos;
  467.       z2:=yP and $7FFF;
  468.       iz2:=$8000-z2;
  469.       x := 0;
  470.       while x < lPGWid do begin
  471.         t:=(xP shr 15) * 3;
  472.         if ((lBotPos+t+6) > lInSz) or ((lTopPos+t) < 0) then begin
  473.            lBuff[lPos] :=0; inc(lPos); //reds
  474.            lBuff[lPos] :=0; inc(lPos); //greens
  475.            lBuff[lPos] :=0; inc(lPos); //blues
  476.         end else begin
  477.             z:=xP and $7FFF;
  478.             w2:=(z*iz2)shr 15;
  479.             w1:=iz2-w2;
  480.             w4:=(z*z2)shr 15;
  481.             w3:=z2-w4;
  482.             lBuff[lPos] :=(lInBuff[lTopPos+t]*w1+lInBuff[lTopPos+t+3]*w2
  483.             +lInBuff[lBotPos+t]*w3+lInBuff[lBotPos+t+3]*w4)shr 15;
  484.             inc(lPos); //reds
  485.             lBuff[lPos] :=(lInBuff[lTopPos+t+1]*w1+lInBuff[lTopPos+t+4]*w2
  486.             +lInBuff[lBotPos+t+1]*w3+lInBuff[lBotPos+t+4]*w4)shr 15;
  487.             inc(lPos); //greens
  488.             lBuff[lPos] :=(lInBuff[lTopPos+t+2]*w1+lInBuff[lTopPos+t+5]*w2
  489.             +lInBuff[lBotPos+t+2]*w3+lInBuff[lBotPos+t+5]*w4)shr 15;
  490.             inc(lPos); //blues
  491.         end;
  492.         Inc(xP,xP2);
  493.         inc(x);
  494.       end;   //inner loop
  495.       Inc(yP,yP2);
  496.     end;
  497. end else if gCustomPalette > 0 then begin //<>24bits,custompal
  498.    lBits := 24;
  499.    for y := 0 to 255 do begin
  500.     lrRA[y] := grRA[y];
  501.     lgra[y] := ggRA[y]  ;
  502.     lbra[y] := gbRA[y];
  503.    end;
  504.   getmem(lBuff, lPGHt*lPGWid*3);
  505.   for y:=0 to lPGHt-1 do begin
  506.       xP:= 0;
  507.       lTopPos:=lSrcWid *(yP shr 15);  //Line1
  508.       if yP shr 16<lSrcHt-1 then
  509.          lBotPos:=lSrcWid *(yP shr 15+1)   //Line2
  510.       else
  511.           lBotPos:=lTopPos;//lSrcWid *(yP shr 15);
  512.       z2:=yP and $7FFF;
  513.       iz2:=$8000-z2;
  514.       x := 0;
  515.       while x < lPGWid do begin
  516.         t:=xP shr 15;
  517.       if ((lBotPos+t+2) > lInSz) or ((lTopPos+t{-1}) < 0) then begin
  518.         lLT := 0;
  519.         lRT := 0;
  520.         lLB := 0;
  521.         lRB := 0;
  522.       end else begin
  523.         lLT := lInBuff[lTopPos+t];
  524.         lRT := lInBuff[lTopPos+t+1];
  525.         lLB := lInBuff[lBotPos+t];
  526.         lRB := lInBuff[lBotPos+t+1];
  527.       end;
  528.         z:=xP and $7FFF;
  529.         w2:=(z*iz2)shr 15;
  530.         w1:=iz2-w2;
  531.         w4:=(z*z2)shr 15;
  532.         w3:=z2-w4;
  533.         lBuff[lPos] :=(lrRA[lLT]*w1+lrRA[lRT]*w2
  534.         +lrRA[lLB]*w3+lrRA[lRB]*w4)shr 15;
  535.         inc(lPos);
  536.         lBuff[lPos] :=(lgRA[lLT]*w1+lgRA[lRT]*w2
  537.         +lgRA[lLB]*w3+lgRA[lRB]*w4)shr 15;
  538.         inc(lPos);
  539.         lBuff[lPos] :=(lbRA[lLT]*w1+lbRA[lRT]*w2
  540.         +lbRA[lLB]*w3+lbRA[lRB]*w4)shr 15;
  541.         inc(lPos);
  542.         Inc(xP,xP2);
  543.         inc(x);
  544.       end;   //inner loop
  545.       Inc(yP,yP2);
  546.     end;
  547. end else begin //<>24bits,custompal
  548.   getmem(lBuff, lPGHt*lPGWid{*3});
  549.   for y:=0 to lPGHt-1 do begin
  550.       xP:= 0;
  551.       lTopPos:=lSrcWid *(yP shr 15);  //Line1
  552.       if yP shr 16<lSrcHt-1 then
  553.          lBotPos:=lSrcWid *(yP shr 15+1)   //Line2
  554.       else
  555.           lBotPos:=lTopPos;//lSrcWid *(yP shr 15);
  556.       //pc:=Dst.Scanlines[y];
  557.       z2:=yP and $7FFF;
  558.       iz2:=$8000-z2;
  559.       //      for x:=0 to lDstWid-1 do begin
  560.       x := 0;
  561.       while x < lPGWid do begin
  562.         t:=xP shr 15;
  563.       if ((lBotPos+t+2) > lInSz) or ((lTopPos+t{-1}) < 0) then begin
  564.         lLT := 0;
  565.         lRT := 0;
  566.         lLB := 0;
  567.         lRB := 0;
  568.       end else begin
  569.         lLT := lInBuff[lTopPos+t{+1}];
  570.         lRT := lInBuff[lTopPos+t{+2}+1];
  571.         lLB := lInBuff[lBotPos+t{+1}];
  572.         lRB := lInBuff[lBotPos+t{+2}+1];
  573.       end;
  574.         z:=xP and $7FFF;
  575.         w2:=(z*iz2)shr 15;
  576.         w1:=iz2-w2;
  577.         w4:=(z*z2)shr 15;
  578.         w3:=z2-w4;
  579.         lBuff[lPos] :=(lLT*w1+lRT*w2
  580.         +lLB*w3+lRB*w4)shr 15;
  581.         inc(lPos);
  582.         Inc(xP,xP2);
  583.         inc(x);
  584.       end;   //inner loop
  585.       Inc(yP,yP2);
  586.     end;
  587. end;  //<>24bits,custompal
  588.   end;
  589. var
  590.    PixMap: pointer;
  591.    Bmp     : TBitmap;
  592.    hBmp    : HBITMAP;
  593.    BI      : PBitmapInfo;
  594.    BIH     : TBitmapInfoHeader;
  595.    lSlope,lScale: single;
  596.    lPixmapInt,lBuffInt: integer ;
  597.    ImagoDC : hDC;
  598.    lRow:  pRGBTripleArray;
  599.    lMinPal,lMaxPal,lL,lTemp,lHt,lWid,I,J,lScanLineSz,lScanLineSz8: integer;
  600. begin
  601.  FreeBackupBitmap;
  602.  lScale := gZoomPct / 100;
  603.  lBits := lInBits;
  604.  if (lScale = 1) or (not gSmooth) then begin
  605.      lPGWid := lInPGWid;
  606.      lPGHt := lInPGHt;
  607.      lBuff := @lInBuff^;
  608.  end else begin
  609.     ScaleStretch(lInPGHt,lInPGWid, lScale);
  610.  end;
  611.  if (lBits = 24) {or (lBits = 25)} then begin
  612.         BMP := TBitmap.Create;
  613.         lL := 0;
  614.         TRY
  615.            BMP.PixelFormat := pf24bit;
  616.            BMP.Width := lPGwid;
  617.            BMP.Height := lPGHt;
  618.         if lBuff <> nil then begin
  619.            //if VertFlipItem.checked then
  620.            //   J := BMP.Height-1
  621.            //else
  622.               J := 0;
  623.            REPEAT
  624.              lRow := BMP.Scanline[j];
  625.              {if HorFlipItem.checked then begin
  626.                FOR i := BMP.Width-1 downto 0 DO BEGIN
  627.                    WITH lRow[i] DO BEGIN
  628.                      rgbtRed    := lBuff[lL];
  629.                      inc(lL);
  630.                      rgbtGreen := lBuff[lL];
  631.                      inc(lL);
  632.                      rgbtBlue  := lBuff[lL];
  633.                      inc(lL);
  634.                   END //with row
  635.                END;  //for width
  636.              end else begin //horflip {}
  637.                FOR i := 0 TO BMP.Width-1 DO BEGIN
  638.                    WITH lRow[i] DO BEGIN
  639.                      rgbtRed    := lBuff[lL];
  640.                      inc(lL);
  641.                      rgbtGreen := lBuff[lL];
  642.                      inc(lL);
  643.                      rgbtBlue  := lBuff[lL];
  644.                      inc(lL);
  645.                    END //with row
  646.                END;  //for width
  647.              //end; //horflip
  648.                //if VertFlipItem.checked then
  649.                //   Dec(J)
  650.                //else
  651.                   Inc(J)
  652.            UNTIL (J < 0) or (J >= BMP.Height); //for J
  653.         end;
  654.            Image.Picture.Graphic := BMP;
  655.            //if lBits = 25 then begin
  656.            //   image.Height:= lPGHt*(ZoomBox.ItemIndex+1);
  657.            //   image.Width := lPGWid*(ZoomBox.ItemIndex+1);
  658.            //end else begin
  659.               image.Height:= lPGHt;
  660.               image.Width := lPGWid;
  661.            //end;
  662.         FINALLY
  663.                BMP.Free;
  664.         END;
  665.         exit;
  666.      end;  //24bit
  667.      BIH.biSize:= Sizeof(BIH);
  668.      BIH.biWidth:= lPGwid;//g100pctImageWid{width};
  669.      BIH.biHeight := lPGHt{-height};
  670.      BIH.biPlanes  := 1;
  671.      BIH.biBitCount := 8;//lBits;
  672.      BIH.biCompression     := BI_RGB;
  673.      BIH.biSizeImage := 0;
  674.      BIH.biXPelsPerMeter := 0;
  675.      BIH.biYPelsPerMeter := 0;
  676.      BIH.biClrUsed       := 0;
  677.      BIH.biClrImportant  := 0;
  678.      {$P+,S-,W-,R-}
  679.      BI := AllocMem(SizeOf(TBitmapInfoHeader) + 256*Sizeof(TRGBQuad));
  680.      BI^.bmiHeader := BIH;
  681.      (*for I:=0 to 255 do begin
  682.              BI^.bmiColors[I].rgbRed     := gRra[i];
  683.              BI^.bmiColors[I].rgbGreen    := gGra[i];
  684.              BI^.bmiColors[I].rgbBlue      := gBra[i];
  685.              BI^.bmiColors[I].rgbReserved := 0;
  686.      end;*)
  687.       if (lUseWinCenWid) and (gWinWid > 0) then begin
  688.         //if lMin < 0 then lMin := 0
  689.  
  690.         //lMin > 255 then lMin := 255;
  691.         //if lMax < 0 then lMax := 0
  692.         //else if lMax > 255 then lMax := 255;
  693.         lMinPal := gWinCen - (gWinWid shr 1);
  694.         lMaxPal := lMinPal + gWinWid;
  695.         lSlope := 255 / gWinWid;
  696.         if (lMinPal < 0) or (lMinPal > 255) then
  697.            lMinPal := 0;
  698.         if (lMaxPal < 0) or (lMaxPal > 255) then
  699.            lMaxPal := 255;
  700.         for I := 0 to lMinPal do begin
  701.                 BI^.bmiColors[I].rgbRed     := gRra[0];
  702.                 BI^.bmiColors[I].rgbGreen    := gGra[0];
  703.                 BI^.bmiColors[I].rgbBlue      := gBra[0];
  704.                 BI^.bmiColors[I].rgbReserved := 0;
  705.         end;
  706.         for I := lMaxPal to 255 do begin
  707.                 BI^.bmiColors[I].rgbRed     := gRra[255];
  708.                 BI^.bmiColors[I].rgbGreen    := gGra[255];
  709.                 BI^.bmiColors[I].rgbBlue      := gBra[255];
  710.                 BI^.bmiColors[I].rgbReserved := 0;
  711.         end;
  712.         if (lMinPal+1) < (lMaxPal) then begin
  713.             for I := (lMinPal+1) to (lMaxPal-1) do begin
  714.                 J := 128+round(lSLope*(I-gWinCen));
  715.                 if J < 0 then J := 0
  716.                 else if J > 255 then J := 255;
  717.                 BI^.bmiColors[I].rgbRed     := gRra[J];
  718.                 BI^.bmiColors[I].rgbGreen    := gGra[J];
  719.                 BI^.bmiColors[I].rgbBlue      := gBra[J];
  720.                 BI^.bmiColors[I].rgbReserved := 0;
  721.             end;
  722.         end; 
  723.      end else begin //use wincen/wid
  724.        for I:=0 to 255 do begin
  725.              BI^.bmiColors[I].rgbRed     := gRra[i];
  726.              BI^.bmiColors[I].rgbGreen    := gGra[i];
  727.              BI^.bmiColors[I].rgbBlue      := gBra[i];
  728.              BI^.bmiColors[I].rgbReserved := 0;
  729.        end;
  730.      end; //use wincen/wid
  731.      Bmp        := TBitmap.Create;
  732.      Bmp.Height := lPGHt{width};
  733.      Bmp.Width  := lPGwid;
  734.      ImagoDC := GetDC(Self.Handle);
  735.      hBmp:= CreateDIBSection(imagodc,bi^,DIB_RGB_COLORS,pixmap,0,0);
  736.      lScanLineSz := lPGwid;
  737.      if(lPGwid mod 4) <> 0 then lScanLineSz8 := 4*((lPGWid + 3)div 4)
  738.      else lScanLineSz8 := lPGwid;
  739.      lHt := Bmp.Height-1;
  740.      lWid := lPGwid -1;
  741.      {if (hBmp = 0) or (pixmap = nil) then
  742.              if GetLastError = 0 then ShowMessage('Error!') else RaiseLastWin32Error;}
  743.      if lBuff <> nil then begin
  744.         {if HorFlipItem.checked then begin
  745.            For i:= (lHt)  downto 0 do begin
  746.                lPixMapInt := i * lScanLineSz;
  747.                for j := (lWid shr 1) downto 0 do begin
  748.                    lTemp :=lBuff[lPixMapInt+j];
  749.                    lBuff[lPixMapInt+j] := lBuff[lPixMapInt+(lWid-j)];
  750.                    lBuff[lPixMapInt+(lWid-j)] := lTemp;
  751.                end;
  752.            end; //i 0..lHt
  753.         end; //horflip{}
  754.         lPixmapInt  := Integer(pixmap);
  755.         lBuffInt := Integer(lBuff);
  756.         {if VertFlipItem.checked then begin
  757.            For i:= (lHt)  downto 0 do
  758.                CopyMemory(Pointer(lPixmapInt+lScanLineSz8*(i)),
  759.                      Pointer(lBuffInt+((i))*lScanLineSz),lScanLineSz);
  760.         end else begin}
  761.            For i:= (lHt)  downto 0 do
  762.                CopyMemory(Pointer(lPixmapInt+lScanLineSz8*(i)),
  763.                      Pointer(lBuffInt+((lHt-i))*lScanLineSz),lScanLineSz);
  764.         {end; {}
  765.      end; //lBuff full
  766.      ReleaseDC(0,ImagoDC);
  767.      Bmp.Handle := hBmp;
  768.      Bmp.ReleasePalette;
  769.      Image.Picture.Assign(Bmp);
  770.      Bmp.Free;
  771.      FreeMem( BI);
  772.      if (lScale <> 1) and (gSmooth) then
  773.         freemem(lBuff);
  774. //     Image.Refresh;
  775.      {$P-,S+,W+,R-}
  776. end;
  777.  
  778. PROCEDURE TMDIChild.ShowMagnifier (CONST X,Y:  INTEGER);
  779.   VAR
  780.     AreaRadius    :  INTEGER;
  781.     Magnification :  INTEGER;
  782.     //ModifiedBitmap:  TBitmap;
  783.     xActual,yActual{,lMagArea}       :  INTEGER;
  784. BEGIN
  785. if BackupBitmap = nil then exit;
  786.   xActual := round((X *image.Picture.Height)/image.Height);
  787.   yActual := round((Y *image.Picture.Width)/image.Width);
  788.  
  789.  
  790. if (xActual < 0) or (yActual < 0) or (xActual > Image.Picture.width)
  791. or (yActual > Image.Picture.height) then
  792.    exit;
  793.  
  794. {if gZoomPct <> 0 then
  795.    AreaRadius := (50 * 100) div gZoomPct//ROUND(SpinEditMagnifierRadius.Value / Magnification);
  796. else
  797.     AreaRadius := 50; }
  798. if (not gSmooth) and (gZoomPct <> 0) then
  799. AreaRadius := (50 * 100) div gZoomPct
  800. //   AreaRadius := (50 * gZoomPct) div 100//ROUND(SpinEditMagnifierRadius.Value / Magnification);
  801. else
  802.     AreaRadius := 50;
  803. Magnification := {round((30*2) / (100))}AreaRadius*2;//round(( (( gZoomPct div 50)+1) * 100)  /gZoomPct * AreaRadius);
  804. if (gMagRect.Left <> gMagRect.Right) then begin
  805.    Image.Picture.Bitmap.Canvas.CopyRect(gMagRect,
  806.                               BackupBitmap.Canvas, // [anme]
  807.                               gMagRect);
  808. end;
  809. gMagRect := Rect(xActual - Magnification,
  810.                                    yActual - Magnification,
  811.                                    xActual + Magnification,
  812.                                    yActual + Magnification);
  813. //MainForm.StatusBar.Panels[1].text := inttostr(gZoomPct);
  814. Image.Picture.Bitmap.Canvas.CopyRect(gMagRect{Rect(xActual - Magnification,
  815.                                    yActual - Magnification,
  816.                                    xActual + Magnification,
  817.                                    yActual + Magnification)},
  818.                               BackupBitmap.Canvas, // [anme]
  819.                                 Rect(xActual - AreaRadius,
  820.                                    yActual - AreaRadius,
  821.                                    xActual + AreaRadius,
  822.                                    yActual + AreaRadius) );
  823.   //Image.invalidate;
  824.  
  825.   Image.refresh;
  826. END; {ShowMagnifier}(**)
  827.  
  828. procedure FireLUT (lIntensity, lTotal: integer; var lR,lG,lB: integer);
  829. var l255scale: integer;
  830. begin
  831.      l255Scale := round ( lIntensity/lTotal * 255);
  832.      lR := (l255Scale - 52) * 3;
  833.      if lR < 0 then lR := 0
  834.      else if lR > 255 then lR := 255;
  835.      lG := (l255Scale - {96}108) * 2{2};
  836.      if lG < 0 then lG := 0
  837.      else if lG > 255 then lG := 255;
  838.      case l255Scale of
  839.           0..55: lB :=  (l255Scale * 4);
  840.           56..118: lB := 220-((l255Scale-55)*3);
  841.           119..235: lB := 0;
  842.           else lB := {255-}((l255Scale-235)*10);
  843.      end; {case}
  844.      if lB < 0 then lB := 0
  845.      else if lB > 255 then lB := 255;
  846. end;
  847.  
  848.  
  849. procedure TMDIChild.LoadColorScheme(lStr: string; lScheme: integer);
  850. const UNIXeoln = chr(10);
  851. var
  852.    lF: textfile;
  853.    lBuff: bytep0;
  854.    lFdata: file;
  855.    lCh: char;
  856.    lNumStr: String;
  857.    lRi,lGi,lBi,lZ: integer;
  858.    lByte,lIndex,lRed,lBlue,lGreen: byte;
  859.    lType,lIndx,lLong,lR,lG,lB: boolean;
  860. procedure ResetBools;
  861. begin
  862.     lType := false;
  863.     lIndx := false;
  864.     lR := false;
  865.     lG := false;
  866.     lB := false;
  867.     lNumStr := '';
  868. end;
  869. begin
  870.      gScheme := lScheme;
  871.      if lScheme < 3 then begin
  872.         case lScheme of
  873.            0: for lZ:=0 to 255 do begin
  874.               gRra[lZ] := 255-lZ;
  875.               gGra[lZ] := 255-lZ;
  876.               gBra[lZ] := 255-lZ;
  877.              end;
  878.             2:  for lZ:=0 to 255 do begin
  879.                 FireLUT (lZ,255,lRi,lGi,lBi);
  880.                 gRra[lZ] :=  lRi;
  881.                 gGra[lZ] := lGi;
  882.                 gBra[lZ]      := lBi ;
  883.              end;
  884.            else for lZ:=0 to 255 do begin
  885.                 gRra[lZ] := lZ;
  886.                 gGra[lZ] := lZ;
  887.                 gBra[lZ] := lZ;
  888.  
  889.              end;
  890.         end; //case
  891.         {for lZ := 0 to 255 do begin
  892.          gRra[lZ] := lZ;
  893.          gGra[lZ] := lZ;
  894.          gBra[lZ] := lZ;
  895.         end;}
  896.         gMaxRGB := (gRra[255] + (gGra[255] shl 8)+(gBra[255] shl 16));
  897.         gMinRGB := (gRra[0] + (gGra[0] shl 8)+(gBra[0] shl 16));
  898.  
  899.         exit;
  900.      end;
  901.      lIndex := 0;
  902.      lRed := 0;
  903.      lGreen := 0;
  904.      if gCustomPalette > 0 then exit;
  905.      if not fileexists(lStr) then exit;
  906.      assignfile(lFdata,lStr);
  907.      reset(lFdata,1);
  908.      lZ := FileSize(lFData);
  909.      if (lZ =768) or (lZ = 800) or (lZ = 970) then begin
  910.         GetMem( lBuff, 768);
  911.         Seek(lFData,lZ-768);
  912.         BlockRead(lFdata, lBuff^, 768);
  913.         closeFile(lFdata);
  914.         for lZ := 0 to 255 do begin
  915.             //lZ := (lIndex);
  916.             gRra[lZ] := lBuff[lZ];
  917.             gGra[lZ] := lBuff[lZ+256];
  918.             gBra[lZ] := lBuff[lZ+512];
  919.         end;
  920.         freemem(lBuff);
  921.         gMaxRGB := (gRra[255] + (gGra[255] shl 8)+(gBra[255] shl 16));
  922.         gMinRGB := (gRra[0] + (gGra[0] shl 8)+(gBra[0] shl 16));
  923.         exit;
  924.      end;
  925.      closefile(lFdata);
  926.      lLong := false;
  927.      assignfile(lF,lStr);
  928.      reset(lF);
  929.      ResetBools;
  930.      for lByte := 0 to 255 do begin
  931.          gRra[lByte] := 0;
  932.          gGra[lByte] := 0;
  933.          gBra[lByte] := 0;
  934.      end;
  935.      while not EOF(lF) do begin
  936.          read(lF,lCh);
  937.          if lCh = '*' then //comment character
  938.             while (not EOF(lF)) and (lCh <> kCR) and (lCh <> UNIXeoln) do
  939.                   read(lF,lCh);
  940.          if (lCh = 'L') or (lCh = 'l') then begin
  941.             lType := true;
  942.             lLong := true;
  943.          end; //'l'
  944.          if (lCh = 's') or (lCh = 'S') then begin
  945.             lType := true;
  946.             lLong := false;
  947.          end; //'s'
  948.          if lCh in ['0'..'9'] then
  949.              lNumStr := lNumStr + lCh
  950.          else if length(lNumStr) > 0 then begin //not a number = space??? try to read number string
  951.               if not lIndx then begin
  952.                  lIndex := strtoint(lNumStr);
  953.                  lIndx := true;
  954.               end else begin //not index
  955.                   if lLong then
  956.                      lByte := trunc(strtoint(lNumStr) / 256)
  957.                   else
  958.                       lByte := strtoint(lNumStr);
  959.                   if not lR then begin
  960.                      lRed := lByte;
  961.                      lR := true;
  962.                   end else if not lG then begin
  963.                       lGreen := lByte;
  964.                       lG := true;
  965.                   end else if not lB then begin
  966.                       lBlue := lByte;
  967.                       lB := true;
  968.                       gRra[lIndex] := lRed;
  969.                       gGra[lIndex] := lGreen;
  970.                       gBra[lIndex] := lBlue;
  971.                       //if lIndex = 236 then showmessage(inttostr(lBlue));
  972.                       ResetBools;
  973.                   end;
  974.               end;
  975.               lNumStr := '';
  976.          end;
  977.      end; //not eof
  978.      gMaxRGB := (gRra[255] + (gGra[255] shl 8)+(gBra[255] shl 16));
  979.      gMinRGB := (gRra[0] + (gGra[0] shl 8)+(gBra[0] shl 16));
  980.      closefile(lF);
  981. (*export as medcon .pal file->
  982.      AssignFile(lF, 'C:\'+extractfilename(lStr));
  983.      Rewrite(lF);
  984.      for lIndex := 0 to 255 do begin
  985.          Write(lF, '0x'+IntToHex(gRra[lIndex],2)+' 0x'+IntToHex(gGra[lIndex],2)+' 0x' +IntToHex(gBra[lIndex],2)+chr(10));
  986.      end;
  987.      CloseFile(lF);
  988. (*
  989. //export as imagej .lut file->
  990.      AssignFile(lFData, 'C:\'+extractfilename(lStr));
  991.      Rewrite(lFData,1);
  992.      GetMem( lBuff, 768);
  993.      for lIndex := 0 to 255 do begin
  994.          lBuff[lIndex] := gRra[lIndex];
  995.          lBuff[lIndex+256] := gGra[lIndex];
  996.          lBuff[lIndex+512] := gBra[lIndex];
  997.      end;
  998.         BlockWrite(lFdata, lBuff^, 768);
  999.      freemem(lBuff);
  1000.      CloseFile(lFData);
  1001. (**)
  1002.  
  1003. end;
  1004.  
  1005.  
  1006.  
  1007.  
  1008. procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
  1009. begin
  1010.   gDynStr:= '';
  1011.      gSelectRect := rect(0,0,0,0);
  1012.      gSelectOrigin.X := -1;
  1013.   Action := caFree;
  1014.   MainForm.ColUpdate;
  1015.   if (BackupBitmap <> nil) then //magnifier on
  1016.      BackupBitmap.Free;
  1017.   BackupBitmap := nil;
  1018.   if (gBuff16sz > 0) then begin
  1019.      freemem(gBuff16);
  1020.      gBuff16sz := 0;
  1021.   end;
  1022.   if (gBuff8sz > 0) then begin
  1023.      freemem(gBuff8);
  1024.      gBuff8sz := 0;
  1025.   end;
  1026.   MainForm.UpdateMenuItems(nil);
  1027.   //MainForm.UpdateMenus(MDIChildCount{-1});
  1028.  
  1029. end;
  1030.  
  1031. (*========================================================================*)
  1032. procedure TMDIChild.FormCreate(Sender: TObject);
  1033. var
  1034.    lInc: integer;
  1035. begin
  1036.      //gCine := false;
  1037.      gSmooth := false;
  1038.      Smooth1.Checked := gSmooth;
  1039.      gMultiRow := 1;
  1040.      gMultiCol := 1;
  1041.      BackupBitmap := nil;
  1042.      gScheme := 1;
  1043.      gWinCen := 0;
  1044.      gWinWid := 0;
  1045.      gStringList := TStringList.Create;
  1046.      gFileListSz := 0;
  1047.      gCurrentPosInFileList := -1;
  1048.  
  1049.      gBuff16sz := 0;
  1050.      gVideoSpeed := 0;
  1051.      gBuff8sz := 0;
  1052.   FFileName    := '';
  1053.   gContrastStr := '';
  1054.   gDICOMdata.Allocbits_per_pixel := 0;
  1055.   gCustomPalette := 0;
  1056.   gMinHt := 10;
  1057.   gMinWid := 10;
  1058.   gDICOMData.XYZdim[1]        := 0;
  1059.   gDICOMData.XYZdim[2]       := 0;
  1060.   g100PctImageWid := 0;
  1061.   g100PctImageHt := 0;
  1062.   gZoomPct := 100;
  1063.   for lInc := 0 to 255 do
  1064.       gRGBquadRA[lInc].rgbReserved := 0;
  1065.  
  1066.   {if (MainForm.MDIChildCount > 1) then
  1067.      if (TMDIChild(MainForm.ActiveMDIChild).WindowState = wsMaximized) then
  1068.         Self.Top := 64; }
  1069.         //Self.windowstate := wsMaximized;
  1070. end;
  1071.  
  1072. procedure TMDIChild.DetermineZoom;
  1073. var lHZoom: single;
  1074.     lZoom,lZoomPct: integer;
  1075. begin
  1076.      if (not MainForm.BestFitItem.checked) then exit;
  1077.      lHZoom := (ClientWidth)/g100pctImageWid;
  1078.      if ((ClientHeight)/g100pctImageHt) < lHZoom then
  1079.         lHZoom := ((ClientHeight)/g100pctImageHt);
  1080.      lZoomPct := trunc(100*lHZoom);
  1081.      if lZoomPct < 11 then
  1082.         lZoom := 10 //.5 zoom
  1083.      else if lZoomPct > 500 then
  1084.           lZoom := 500
  1085.      else lZoom := lZoomPct;
  1086.      gZoomPct := lZoom;
  1087. end;
  1088.  
  1089. procedure TMDIChild.AutoMaximise;
  1090. var lZoom: integer;
  1091. begin
  1092.      if (not MainForm.BestFitItem.checked) or (g100pctImageHt < 1) or (g100pctImageWid < 1) then exit;
  1093.      lZoom := gZoomPct;
  1094.      DetermineZoom;
  1095.      if lZoom <> gZoomPct then begin
  1096.         RefreshZoom;
  1097.         MainForm.ZoomSlider.Position := lZoom;
  1098.      end;
  1099.      //MainForm.ZoomSliderChange(nil);
  1100. end;
  1101.  
  1102.  
  1103. function TMDIChild.LoadData(lFileName : string; lAnalyze,lECAT,l2dImage,lRaw: boolean ) : Boolean;
  1104. var
  1105.      lHdrOK: boolean;
  1106.      lS: integer;
  1107.      lExt : string;
  1108.      JPG{,JPEGOriginal}:  TJPEGImage;
  1109.      Stream: TmemoryStream;
  1110.      BMP: TBitmap;
  1111.      //lStartTime, lEndTime: DWord;
  1112. begin
  1113.   ReleaseDICOMmemory;
  1114.  
  1115.      gFilePath := extractfilepath(lFileName);
  1116.  
  1117.      gScheme := 1;
  1118.      gSlice := 1;
  1119.      LoadColorScheme('',gScheme); //load Black and white
  1120.      Result := TRUE;
  1121.      gImgOK := false;
  1122.      FFileName := lFileName;
  1123.      gAbort:= true;
  1124.   if not fileexists(lFilename) then begin
  1125.      result := false;
  1126.      showmessage('Unable to find the file: '+lFilename);
  1127.      exit;
  1128.   end;
  1129.      Self.caption := extractfilename(lFilename);
  1130.  
  1131.      if l2DImage then begin
  1132.         FDICOM := false;
  1133.         lExt := ExtractFileExt(FFileName);
  1134.         if length(lExt) > 0 then
  1135.            for lS := 1 to length(lExt) do
  1136.                lExt[lS] := upcase(lExt[lS]);
  1137.         if ('.JPG'= lExt) then begin
  1138.            {JPEGOriginal := TJPEGImage.Create;
  1139.            TRY
  1140.               JPEGOriginal.LoadFromFile(FFilename);
  1141.               Image.Picture.Graphic := JPEGOriginal
  1142.            FINALLY
  1143.                JPEGOriginal.Free
  1144.            END;}
  1145.            //the following longer method makes sure the user can save the JPEG file...
  1146.            Stream := TMemoryStream.Create;
  1147.            try
  1148.               Stream := TMemoryStream.Create;
  1149.               Stream.LoadFromFile(FFilename);
  1150.               Stream.Seek(0, soFromBeginning);
  1151.               Jpg := TJPEGImage.Create;
  1152.               try
  1153.                  Jpg.LoadFromStream(Stream);
  1154.                  BMP := TBitmap.create;
  1155.                  try
  1156.                     BMP.Height := JPG.Height;
  1157.                     BMP.Width := JPG.Width;
  1158.                     BMP.PixelFormat := pf24bit;
  1159.                     BMP.Canvas.Draw(0,0, JPG);
  1160.                     Image.Picture.Graphic := BMP;
  1161.                  finally
  1162.                         BMP.Free;
  1163.                  end;
  1164.               finally
  1165.                      JPG.Free;
  1166.               end;
  1167.            finally
  1168.                   Stream.Free;
  1169.            end;
  1170.         end else
  1171.             Image.Picture.Bitmap.LoadFromFile(FFilename);
  1172.         gDICOMData.XYZdim[1] := Image.Picture.Width;
  1173.         gDICOMData.XYZdim[2] := Image.Picture.Height;
  1174.         g100PctImageWid := gDICOMData.XYZdim[1];
  1175.         g100PctImageHt := gDICOMData.XYZdim[2];
  1176.         //if MainForm.WindowMaximizeItem.checked then begin
  1177.            //Self.WindowState:=wsMaximized;
  1178.            //automaximise;
  1179.         //end;//else begin}
  1180.         Image.Width :=  Image.Picture.Width;
  1181.         Image.Height :=  Image.Picture.Height;
  1182.         //end;
  1183.         //MainForm.StatusBar.Panels[0].text := inttostr(gDICOMData.XYZdim[1])+'x'+inttostr(gDICOMData.XYZdim[2]);
  1184.         gDICOMData.XYZdim[3] := 1;
  1185.         {if MainForm.WindowMaximizeItem.checked then begin
  1186.            Self.WindowState:=wsMaximized;
  1187.         end else begin}
  1188.         if self.WindowState <> wsMaximized then begin
  1189.            self.ClientHeight:=gDICOMdata.XYZdim[2];
  1190.            self.ClientWidth:= (gDICOMData.XYZdim[1]);
  1191.         end;
  1192.         MainForm.ColUpdate;
  1193.         //OptionsSettingsMenu.enabled := false;
  1194.         ContrastAutobalance1.enabled := false;
  1195.         OptionsImgInfoItem.enabled := false;
  1196.         gImgOK := true;
  1197.  
  1198.         automaximise; //asdf
  1199.           Image.Refresh;
  1200.         exit;
  1201.      end;
  1202.      FDICOM := true;
  1203.      if lRaw then begin
  1204.          lHdrOK := true;
  1205.          gImgOK := true;
  1206.      end else if lAnalyze then
  1207.          OpenAnalyze (lHdrOK,gImgOK,gDynStr,FFileName, gDicomData)
  1208.      else if lECAT then
  1209.          read_ecat_data(gDICOMdata,true{verbose},true{offset tables supported},lHdrOK,gImgOK,gDynStr,FFileName)
  1210.      else
  1211.       read_dicom_data(true,true,true,true,true,true,true, gDICOMdata, lHdrOK, gImgOK, gDynStr,FFileName );
  1212.       HdrShow;
  1213.       if gECATJPEG_table_entries > 0 then begin
  1214.          if (gECATJPEG_table_entries > kMaxECAT) then begin
  1215.             gImgOK := false;
  1216.             Showmessage('This ECAT file has too many slices ('+inttostr(gECATJPEG_table_entries)+').');
  1217.          end else begin
  1218.              gECATslices:= gECATJPEG_table_entries;
  1219.              for lS := 1 to gECATslices do begin
  1220.                  gECATposra[lS]:=gECATJPEG_pos_table[lS];
  1221.                  gECATszra[lS]:=gECATJPEG_size_table[lS];
  1222.              end;
  1223.          end;
  1224.          freemem(gECATJPEG_pos_table);
  1225.          freemem(gECATJPEG_size_table);
  1226.          gECATJPEG_table_entries := 0;
  1227.       end;
  1228.   gBlack := 1;
  1229.   gScale := 1;
  1230.   gPro := 0;
  1231. //if gCurrentPosInFileList < 0 then begin
  1232.   gCustomPalette := 0;
  1233. if red_table_size > 0 then begin
  1234.    //gCustomPalette := 0;
  1235. end else begin
  1236.   if gDICOMdata.monochrome = 1 then
  1237.       gScheme := 0
  1238.   else
  1239.       gScheme := 1;
  1240.   LoadColorScheme('',gScheme); //load Black and white
  1241. end;
  1242.   gWinCen := 0;
  1243.   gWinWid := 0;
  1244. //end;
  1245. //showmessage('abba'+inttostr(red_table_size));
  1246.   if (gDICOMdata.XYZdim[2] < 1) or (gDICOMdata.XYZdim[1] < 1) or (not lHdrOK) or (not gImgOK) then begin
  1247.      showmessage('Error reading image.');
  1248.      ReleaseDICOMmemory;
  1249.      OptionsImgInfoItemClick(nil);
  1250.      exit;
  1251.   end;
  1252.   //if gDicomdata.XYZdim[3] > 1 then begin
  1253.   LowerSlice1.enabled := gDicomdata.XYZdim[3] > 1;
  1254.   HigherSlice1.enabled := gDicomdata.XYZdim[3] > 1;
  1255.   Mosaic1.enabled := gDicomdata.XYZdim[3] > 1;
  1256.   //end;
  1257.   {if MainForm.WindowMaximizeItem.checked then begin
  1258.      Self.WindowState:=wsMaximized;
  1259.      automaximise;
  1260.   end else begin}
  1261.   if self.WindowState <> wsMaximized then begin
  1262.       self.ClientHeight:=gDICOMdata.XYZdim[2];
  1263.       self.ClientWidth:= (gDICOMData.XYZdim[1]);
  1264.   end;
  1265.   //end;
  1266.   //MainForm.PGSaveDialog1.initialdir := extractfilepath(FFilename);
  1267.   gAbort := false;
  1268.   Overlay1.enabled := true;
  1269.   gSlice := 0; {force a new image to be displayed - so gSlice should be different from displayimage requested slice}
  1270.   //lStartTime := GetTickCount;
  1271. //showmessage('abba'+inttostr(red_table_size));
  1272. //       Showmessage('MRIcro can not convert run-length compressed DICOM images. You can view this image with ezDICOM.'+inttostr(gDicomData.CompressOffset));
  1273.  
  1274.   DisplayImage(True,True,1,-1,0);
  1275. //showmessage('abba'+inttostr(gDicomdata.xxx));
  1276.  
  1277.   //lEndTime := GetTickCount;
  1278.   //showmessage('display time(ms): '+inttostr(lEndTime-lStartTime));
  1279.   Screen.Cursor := crDefault;
  1280. end;
  1281.  
  1282. (*========================================================================*)
  1283. procedure TMDIChild.FileOpenItemClick(Sender: TObject);
  1284. begin
  1285.     MainForm.FileOpenItemClick(Sender);
  1286. end;
  1287.  
  1288. (*========================================================================*)
  1289. procedure TMDIChild.FileExportAsBmpItemClick(Sender: TObject);
  1290. begin
  1291. end;
  1292.  
  1293. (*========================================================================*)
  1294. procedure TMDIChild.FileCloseItemClick(Sender: TObject);
  1295. begin
  1296. end;
  1297.  
  1298. (*========================================================================*)
  1299. procedure TMDIChild.FileExitItemClick(Sender: TObject);
  1300. begin
  1301.     MainForm.FileExitItemClick(Sender);
  1302. end;
  1303. procedure TMDIChild.HdrShow;
  1304. var lLen,lI : integer;
  1305. lStr: string;
  1306. begin
  1307.   if not FDICOM then begin
  1308.      //showmessage('Unable to show DICOM header information. This is not a DICOM file.');
  1309.      EXIT;
  1310.   end;
  1311. //Memo1.visible := not Memo1.visible;
  1312. //ClipCopy.enabled := Memo1.visible;
  1313. Memo1.Lines.Clear;
  1314. //if not Memo1.visible then begin
  1315. //   exit;
  1316. //end;
  1317.  
  1318.       lLen := Length (gDynStr);
  1319.     if lLen > 0 then begin
  1320.        lStr := '';
  1321.        for lI := 1 to lLen do begin
  1322.            if gDynStr[lI] <> kCR then
  1323.               lStr := lStr + gDynStr[lI]
  1324.            else begin
  1325.                 Memo1.Lines.add(lStr);
  1326.                 lStr := '';
  1327.            end;
  1328.        end;
  1329.        Memo1.Lines.Add(lStr);
  1330.     end;
  1331. end;
  1332. procedure TMDIChild.OptionsImgInfoItemClick(Sender: TObject);
  1333. begin
  1334.      MainForm.HdrBtn.Down := not  MainForm.HdrBtn.Down;
  1335.      MainForm.HdrBtn.Click;
  1336. end;
  1337.  
  1338. procedure TMDIChild.DisplayImage(lUpdateCon,lForceDraw: boolean;lSlice,lWinWid,lWinCen: integer);
  1339. label
  1340. 123,444;
  1341. var
  1342.   Stream: TMemoryStream;
  1343.   Jpg: TJPEGImage;
  1344.   Hd: Integer;
  1345.   lLookup16,lCompressLine16: SmallIntP0;
  1346.   lMultiBuff,CptBuff,lBuff,TmpBuff   : bYTEp0;
  1347.   lPtr: Pointer;
  1348.   lRow:  pRGBTripleArray;
  1349.   lCptPos,lFullSz,lCompSz,lTmpPos,lTmpSz,lLastPixel: longint;
  1350.   //lMultiMultiFile: boolean;
  1351.   lMultiSliceInc: single;
  1352.   lMultiMaxSlice,lMultiFullRowSz,lMultiCol,lMultiRow,lMultiStart,lMultiLineSz,lMultiSliceSz,lMultiColSz,lnMultiRow,lMultiSlice,lnMultiCol,lnMultiSlice: integer;
  1353.   //lMultiBuff16:SmallIntP0;
  1354.   lSmall: word;//smallint;
  1355.   l16Signed,l16Signed2 : smallint;
  1356.   lFileName: string;
  1357.   infp: file;
  1358.   max16 : LongInt;
  1359.   min16 : LongInt;
  1360.   lShort: ShortInt;
  1361.   lCptVal,lRunVal,lByte2,lByte: byte;
  1362.   lLineLen,{lScaleShl10,}lL,j,size,lScanLineSz,lBufEntries,lLine,lImgPos,lLineStart,lLineEnd,lPos,value,
  1363.   lInc,lCol,lXdim,lStoreSliceVox,lImageStart,lAllocSLiceSz,lStoreSliceSz,I,I12       : Integer;
  1364.   lY,lCb,lCr,lR,lG,lB: integer;
  1365.   hBmp    : HBITMAP;
  1366.   BI      : PBitmapInfo;
  1367.   BIH     : TBitmapInfoHeader;
  1368.   Bmp     : TBitmap;
  1369.   ImagoDC : hDC;
  1370.   pixmap  : Pointer;
  1371.   PPal: PLogPalette;
  1372. function swap16i(lPos: longint): smallint;
  1373. var
  1374.    s : SmallInt;
  1375. begin
  1376.      seek(infp,lPos);
  1377.   BlockRead(infp, s, 2{, n});
  1378.   swap16i:=swap(s);
  1379. end;
  1380. function GetByte: byte;
  1381. begin
  1382.      if lTmpPos >= lTmpSz then begin //whoops GE "compression" has made the file BIGGER!
  1383.  {Worst case scenario filesize = 150% uncompressed, so this can only happen once}
  1384.         lTmpSz := FileSize(inFp)-lImageStart;
  1385.         if (lAllocSliceSz < lTmpSz) then
  1386.            lTmpSz := lAllocSliceSz; {idea: for multi slice images, limit compression}
  1387.         if lTmpSz < 1 then begin
  1388.             Showmessage('Error with GE Genesis compression.');
  1389.             GetByte := 0;
  1390.             exit;
  1391.         end;
  1392.         FreeMem(TmpBuff);
  1393.         GetMem( TmpBuff, lTmpSz);
  1394.         BlockRead(inFp, TmpBuff^, lTmpSz);
  1395.         lTmpPos := 0;
  1396.      end;
  1397.      if lTmpPos > 0 then GetByte := TmpBuff[lTmpPos]
  1398.      else GetByte := 0;
  1399. //     if lTmpPos > lMaxo then lMaxo := lTmpPos;
  1400.      inc(lTMpPos);
  1401. end;
  1402.  
  1403. begin
  1404. if lUpdateCon then begin
  1405.      gFastSlope := 128;
  1406.      gFastCen := 128;
  1407.      UpdatePalette(false,0);
  1408.      if gDICOMdata.Allocbits_per_pixel > 8 then begin
  1409.          gFastSlope := 512{256};  {CONTRAST change here}
  1410.          gFastCen := 512{256}; {CONTRAST change here}
  1411.      end;
  1412.  
  1413. end;
  1414. //MainForm.StatusBar.Panels[1].text := inttostr(8888)+'abba';
  1415. lFileName := FFilename;
  1416. Size := 0;
  1417. //dsa gPalUpdated := false;
  1418. //MainForm.Caption := inttostr(random(8888))+'abba';
  1419. if (not lUpdateCon) and (gSlice = lSlice) {and (gScheme = lScheme)} and (lWinCen = gWinCen) and (lWinWid = gWinWid) then
  1420.    exit; {no change: delphi sends two on change commands each time a slider changes: this wastes a lot of display time}
  1421. gImgMin :=0;
  1422. gImgMax := 0;
  1423. gImgCen := 0;
  1424. gImgWid := 0;
  1425. gWinMin := gImgMin;
  1426. gWinMax := gImgMax;
  1427. gWinCen := lWinCen;
  1428. gWinWid := lWinWid;
  1429. //dsa gPalUpdated := false;
  1430. if (not gImgOK) or (gAbort) then exit;
  1431. if lSlice < 1 then {exit}lSlice := 1;
  1432. g100pctImageWid := gDICOMdata.XYZdim[1];
  1433. g100pctImageHt :=  gDICOMdata.XYZdim[2];
  1434.  
  1435. gSlice := lSlice;
  1436. lnMultiRow := gMultiRow;
  1437. if lnMultiRow < 1 then lnMultiRow := 1;
  1438. lnMultiCol := gMultiCol;
  1439. if lnMultiCol < 1 then lnMultiCol := 1;
  1440. lnMultiSlice := lnMultiRow*lnMultiCol;
  1441. //lMultiMultiFile := false;
  1442. lMultiMaxSlice :=  gDicomData.XYZdim[3];
  1443. if lnMultiSlice > 1 then begin //compute if single multiframe file or multiple files
  1444.    if gDicomData.XYZdim[3] > 1 then  begin
  1445.       if (lnMultiSLice > gDicomData.XYZdim[3]) then begin
  1446.          lnMultiSLice := gDicomData.XYZdim[3];
  1447.          gMultiFirst := 1;
  1448.          gMultiLast := lnMultiSlice;
  1449.  
  1450.       end;
  1451.    end {else if (gOffsetListSize>1) then begin
  1452.        if lnMultiSLice > gOffsetListSize then
  1453.           lnMultiSLice := gOffsetListSize;
  1454.        if  lnMultiSlice > 1 then
  1455.            lMultiMultiFile := true;
  1456.        lMultiMaxSlice := gOffsetListSize;
  1457.  
  1458.    end} else lnMultiSlice := 1;
  1459. end;
  1460. if lnMultiSlice > 1 then begin
  1461.    Self.caption := 'Multislice';
  1462.    g100pctImageWid := g100pctImageWid * lnMultiCol;
  1463.    g100pctImageHt := g100pctImageHt * lnMultiRow;
  1464.    if gDICOMdata.SamplesPerPixel > 1 then
  1465.       lMultiColSz := gDICOMdata.XYZdim[1]* gDICOMdata.SamplesPerPixel
  1466.    else
  1467.       lMultiColSz := gDICOMdata.XYZdim[1];
  1468.   //if gDICOMdata.Allocbits_per_pixel > 8 then
  1469.   //   lMultiColSz := lMultiColSz * 2; //save as 16bit buffer
  1470.   lMultiLineSz := lMultiColSz * lnMultiCol;
  1471.   lMultiFullRowSz := lMultiLineSz * gDICOMdata.XYZdim[2];
  1472.   lMultiSliceSz := lMultiLineSz * gDICOMdata.XYZdim[2]*lnMultiRow;
  1473.   //showmessage('capture : '+inttostr(lMultiSliceSz));
  1474.   If (gDICOMdata.Allocbits_per_pixel > 8) then
  1475.     getmem(lMultiBuff{lMultiBuff16},lMultiSliceSz*2)
  1476.   else
  1477.       getmem(lMultiBuff,lMultiSliceSz);
  1478.   //fillchar(lMultiBuff,lMultiSliceSz,0);
  1479.   //lnMultiSLice := 4;
  1480.  
  1481.   if gMultiFirst > lMultiMaxSlice then
  1482.      gMultiFirst := 1;
  1483.   lSlice := gMultiFirst;
  1484.   if (gMultiLast > lMultiMaxSlice) or (gMultiLast < gMultiFirst) then
  1485.      gMultiLast := lMultiMaxSlice;
  1486.   lMultiSliceInc := (gMultiLast -gMultiFirst) / (lnMultiSlice-1);
  1487.   if lMultiSliceInc < 1 then lMultiSliceInc := 1;
  1488.   //showmessage(floattostr(lMultiSliceInc)+':'+inttostr(lMultiMaxSlice)+':'+inttostr(lSlice));
  1489. end else begin
  1490.          Self.caption := extractfilename(FFilename);
  1491. end;
  1492. lMultiSlice := 1; //1stSlice
  1493. 123: //return here for multislice view              xx
  1494. lMultiCol := lMultiSlice mod lnMultiCol;
  1495. {if (lMultiMultiFile)  then begin
  1496.     lSlice := 1;
  1497.     lFilename := gFilePath+gStringList.Strings[lMultiSlice-1];//-1: indexed from 0
  1498.     lImageStart := gOffsetList[lMultislice];
  1499. end;}
  1500. if lMultiCol = 0 then lMultiCol := lnMultiCol;
  1501. lMultiCol := lMultiCol - 1; //index from 0
  1502. lMultiRow := (lMultiSlice-1) div lnMultiCol;
  1503. //showmessage({inttostr(lMultiSLice)+':'+}inttostr(lMultiCol));
  1504. if (gDICOMdata.JPEGLossyCpt) and ((gDICOMdata.SamplesPerPixel > 1) or (gDICOMdata.Allocbits_per_pixel> 8)) then begin
  1505.       Stream := TMemoryStream.Create;
  1506.     try
  1507.       Stream.LoadFromFile(lFilename);
  1508.       Stream.Seek(gECATposra[lSlice], soFromBeginning);
  1509.         Jpg := TJPEGImage.Create;
  1510.       try
  1511.         Jpg.LoadFromStream(Stream);
  1512.         BMP := TBitmap.create;
  1513.         try
  1514.            BMP.Height := JPG.Height;
  1515.            BMP.Width := JPG.Width;
  1516.            BMP.Canvas.Draw(0,0, JPG);
  1517.            Image.Picture.Bitmap := BMP;
  1518.         finally //try..finally
  1519.                 BMP.Free;
  1520.         end;
  1521.       finally //try..finally
  1522.         Jpg.Free;
  1523.       end;
  1524.     finally
  1525.       Stream.Free;
  1526.     end; //try..finally
  1527.     if Self.Active then //qwer
  1528.         MainForm.ColUpdate;
  1529.   FileMode := 0; //Read only
  1530.    exit;
  1531. end; //JPEGcpt
  1532. (*if gDICOMdata.JPEGLossyCpt then begin
  1533.     try
  1534.       Stream := TMemoryStream.Create;
  1535.       Stream.LoadFromFile(lFilename);
  1536.       Stream.Seek(gECATposra[lSlice], soFromBeginning);
  1537.       try
  1538.         Jpg := TJPEGImage.Create;
  1539.         Jpg.LoadFromStream(Stream);
  1540.         Image.Picture.Graphic := Jpg;
  1541.       finally //try..finally
  1542.         Jpg.Free;
  1543.       end;
  1544.     finally
  1545.       Stream.Free;
  1546.     end; //try..finally
  1547.   MainForm.ColUpdate;
  1548.   FileMode := 0; //Read only
  1549.    exit;
  1550. end; //JPEGcpt
  1551. *)
  1552. if (gDICOMdata.JPEGLosslessCpt) and(gDICOMdata.SamplesPerPixel = 3) then begin
  1553.      exit;
  1554.   end;
  1555.   lAllocSLiceSz := (gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2] * gDICOMdata.Allocbits_per_pixel+7) div 8 ;
  1556.   if (lAllocSLiceSz) < 1 then exit;
  1557.   AssignFile(infp, lFilename);
  1558.   FileMode := 0; //Read only
  1559.   Reset(infp, 1);
  1560.   //if not lMultiMultiFile then
  1561.   lImageStart := gDicomData.ImageStart + ((lSlice-1) * (lAllocSliceSz*gDICOMdata.SamplesPerPixel));
  1562.  
  1563.   if  (not gDicomData.GenesisCpt) and (gDicomData.CompressSz=0) and (not gDicomData.RunLengthEncoding)and ((lImageStart + (lAllocSliceSz*gDICOMdata.SamplesPerPixel)) > (FileSize(infp))) then begin
  1564.         showmessage('This file does not have enough data for the image size:'+lFilename+kCR+'Image start: '+inttostr(lImageStart)+kCR+'Image size: '+inttostr(lAllocSliceSz*gDICOMdata.SamplesPerPixel));
  1565.         closefile(infp);
  1566.         FileMode := 2; //read/write
  1567.         exit;
  1568.   end;
  1569.   Seek(infp, lImageStart);
  1570.   if (gDICOMdata.Allocbits_per_pixel = 8) and(gDICOMdata.SamplesPerPixel = 3) then begin
  1571.      if gBuff24Sz <>(lAllocSliceSz*gDICOMdata.SamplesPerPixel) then begin
  1572.         if gBuff24Sz <> 0 then
  1573.            Freemem(gBuff24);
  1574.         gBuff24Sz := lAllocSliceSz*gDICOMdata.SamplesPerPixel;
  1575.         GetMem( gBuff24, lAllocSliceSz*gDICOMdata.SamplesPerPixel);
  1576.  
  1577.      end;
  1578.  
  1579.      if gDICOMdata.planarconfig = 0 then begin
  1580.          BlockRead(infp, gBuff24^, lAllocSliceSz*gDICOMdata.SamplesPerPixel);
  1581.      end else  begin
  1582.          if gDICOMdata.CompressSz > 0 then begin
  1583.              Seek(infp,gDICOMdata.CompressOffset+4*(lSlice-1));
  1584.              BlockRead(infp, J, 4{, n});
  1585.              J := J+(gDicomData.XYZDim[3]*4)+64+8;
  1586.              J := gDICOMdata.CompressOffset+J;
  1587.              if J < 1 then begin
  1588.                  Freemem(gBuff24);
  1589.                  exit;
  1590.              end;
  1591.              lFullSz := lAllocSliceSz*3;
  1592.              GetMem( TmpBuff, lFullSz);
  1593.              lFullSz := lFullSz -1;
  1594.             Seek(infp, J);//gDICOMdata.CompressOffset+64);
  1595.             GetMem( CptBuff, gDICOMdata.CompressSz);
  1596.              BlockRead(infp, CptBuff^, gDICOMdata.CompressSz{, n});
  1597.              lCptPos := 0;
  1598.              J := 0;
  1599.              repeat
  1600.                    lCptVal := CptBuff[lCptPos];
  1601.                    inc(lCptPos);
  1602.                    lShort := shortint(lCptVal);
  1603.                    case lShort{lCptVal} of
  1604.                         -128: ;
  1605.                         0..127 : begin
  1606.                                  for i := 0 {0->n+1 bytes} to lShort do begin
  1607.                                    if J < lFullSz then
  1608.                                    TmpBuff[J] := CptBuff[lCptPos];
  1609.                                    inc(J);
  1610.                                    inc(lCptPos);
  1611.                                  end;
  1612.                                end;
  1613.                         else begin
  1614.                              lCptVal := (-lShort);
  1615.                              lRunVal := CptBuff[lCptPos];
  1616.                              inc(lCptPos);
  1617.                              for i := 0 {0->n+1 bytes} to lCptVal do begin
  1618.                                    if J < lFullSz then
  1619.                                    TmpBuff[J] := lRunVal;
  1620.                                    inc(J);
  1621.                                  end;
  1622.                         end;
  1623.                    end;
  1624.              until (lCptPos >= gDICOMdata.CompressSz) or (J >= lFullSz);
  1625.              FreeMem(CptBuff);
  1626.          size := lAllocSliceSz-1;
  1627.          j:= 0;
  1628.          for i := 0 to size do begin
  1629.              gBuff24[j] := TmpBuff[i]; //red
  1630.              gBuff24[j+1] := TmpBuff[i+lAllocSliceSz];
  1631.              gBuff24[j+2] := TmpBuff[i+lAllocSliceSz+lAllocSliceSz];  //blue
  1632.              j := j + 3;
  1633.          end; //for loop
  1634.      end else begin //not compressed
  1635.             GetMem( TmpBuff, lAllocSliceSz);
  1636.             BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
  1637.             size := lAllocSliceSz-1;
  1638.             j := 0;
  1639.             for i := 0 to size do begin
  1640.                 gBuff24[j] := TmpBuff[i];
  1641.                 j := j + 3;
  1642.             end;
  1643.             BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
  1644.             size := lAllocSliceSz-1;
  1645.             j := 1;
  1646.             for i := 0 to size do begin
  1647.              gBuff24[j] := TmpBuff[i];
  1648.              j := j + 3;
  1649.             end;
  1650.             BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
  1651.             size := lAllocSliceSz-1;
  1652.             j := 2;
  1653.             for i := 0 to size do begin
  1654.              gBuff24[j] := TmpBuff[i];
  1655.              j := j + 3;
  1656.             end;
  1657.          end; //no compression
  1658.          FreeMem( TmpBuff);
  1659.      end; //planar config
  1660.      CloseFile(infp);
  1661.      FileMode := 2; //read/write
  1662.               if gDICOMdata.monochrome = 4 then begin  //xappa
  1663.               j:= 0;
  1664.            for i := 0 to size do begin  //convert YcbCr to RGB
  1665.              lY := gBuff24[j];
  1666.              lCb := gBuff24[j+1]-128;
  1667.              lCr := gBuff24[j+2]-128;
  1668.              lR := round(lY+1.4022*lCr);
  1669.              lG := lY+round(-0.3456*lCb -0.7145*lCr);
  1670.              lB := round(lY+1.771 *lCb );
  1671.              if lR < 0 then lR := 0;
  1672.              if lR > 255 then lR := 255;
  1673.              if lG < 0 then lG := 0;
  1674.              if lG > 255 then lG := 255;
  1675.              if lB < 0 then lB := 0;
  1676.              if lB > 255 then lB := 255;
  1677.              gBuff24[j] := lR;//TmpBuff[i+lAllocSliceSz+lAllocSliceSz];
  1678.              gBuff24[j+1] := lG;//TmpBuff[i+lAllocSliceSz];
  1679.              gBuff24[j+2] := {TmpBuff[i]}lB;  //red
  1680.              j := j + 3;
  1681.            end; //for loop
  1682.          end; //convert YcBcR to RGB
  1683.          DetermineZoom;
  1684.          SetDimension(gDIcomData.XYZdim[2],gDIcomData.XYZdim[1] ,24, gBuff24,false);
  1685.          DICOMImageRefreshAndSize;
  1686.          Image.Refresh;
  1687.          //xxfreemem(lBuff); lBuff XXXXXX
  1688.    exit;
  1689.   end; //rgb
  1690.   case gDICOMdata.Allocbits_per_pixel of
  1691.        8: begin
  1692.           if lAllocSliceSz <> gBuff8Sz then begin
  1693.              if gBuff8Sz <> 0 then freemem(gBuff8);
  1694.              GetMem( gbuff8, lAllocSliceSz);
  1695.           end;
  1696.           gBuff8Sz := lAllocSliceSz;
  1697.           if gDICOMdata.JPEGlossyCpt then begin
  1698.              Stream := TMemoryStream.Create;
  1699.              try
  1700.                 CloseFile(infp);
  1701.                 Stream.LoadFromFile(lFilename);
  1702.                 Stream.Seek(gECATposra[lSlice], soFromBeginning);
  1703.                    Jpg := TJPEGImage.Create;
  1704.                 try
  1705.                    Jpg.LoadFromStream(Stream);
  1706.                    BMP := TBitmap.create;
  1707.                    try
  1708.                       BMP.Height := JPG.Height;
  1709.                       BMP.Width := JPG.Width;
  1710.                       BMP.PixelFormat := pf24bit;
  1711.                       BMP.Canvas.Draw(0,0, JPG);
  1712.                lInc := lAllocSliceSz-1;
  1713.                       FOR j := BMP.Height-1 DOWNTO 0 DO BEGIN
  1714.                           lRow := BMP.Scanline[j];
  1715.                           FOR i := (BMP.Width - 1) downto 0 DO BEGIN
  1716.  
  1717.                               gBuff8[lInc] := lRow[i].rgbtRed;
  1718.                               dec(lInc);
  1719.                           END; //for i.. each column
  1720.                       END; //for j...each row
  1721.                       //Image.Picture.Bitmap := BMP;
  1722.                    finally //try..finally
  1723.                            BMP.Free;
  1724.                    end;
  1725.                 finally //try..finally
  1726.                         Jpg.Free;
  1727.                 end;
  1728.              finally
  1729.                     Stream.Free;
  1730.              end; //try..finally
  1731.           end else  if gDicomData.JPEGlosslessCpt then begin
  1732.              DecodeJPEG(infp,gBuff16,gBuff8, lAllocSliceSz,gECATposra[lSlice],gECATszra[lSlice],false);
  1733.           end else if gDICOMdata.CompressSz > 0 then begin
  1734.                   lFullSz := lAllocSliceSz -1;
  1735.                   Seek(infp,gDICOMdata.CompressOffset+4*(lSlice-1));
  1736.                   BlockRead(infp, J, 4{, n});
  1737.                   J := J+(gDicomData.XYZDim[3]*4)+64+8;
  1738.                   lCompSz := FileSize(infp) - (gDICOMdata.CompressOffset+{64}J);
  1739.                   if lCompSz >gDICOMdata.CompressSz then
  1740.                       lCompSz := gDICOMdata.CompressSz;
  1741.                   Seek(infp, gDICOMdata.CompressOffset+J);
  1742.                   GetMem( CptBuff, lCompSz);
  1743.                   BlockRead(infp, CptBuff^, lCompSz{, n});
  1744.                   lCptPos := 0;
  1745.                   J := 0;
  1746.                   repeat
  1747.                    lCptVal := CptBuff[lCptPos];
  1748.                    inc(lCptPos);
  1749.                    lShort := shortint(lCptVal);
  1750.                    case lShort{lCptVal} of
  1751.                         -128: ;
  1752.                         0..127 : begin
  1753.                                  for i := 0 {0->n+1 bytes} to lShort do begin
  1754.                                    if J < lFullSz then
  1755.                                    gBuff8[J] := CptBuff[lCptPos];
  1756.                                    inc(J);
  1757.                                    inc(lCptPos);
  1758.                                  end;
  1759.                                end;
  1760.                         else begin
  1761.                              lCptVal := (-lShort);
  1762.                              lRunVal := CptBuff[lCptPos];
  1763.                              inc(lCptPos);
  1764.                              for i := 0 {0->n+1 bytes} to lCptVal do begin
  1765.                                    if J < lFullSz then
  1766.                                    gBuff8[J] := lRunVal;
  1767.                                    inc(J);
  1768.                                  end;
  1769.                         end;
  1770.                    end;
  1771.                    until (lCptPos >= lCompSz) or (J >= lFullSz);
  1772.                    FreeMem( CptBuff);
  1773.                end else begin
  1774.  
  1775.                   BlockRead(infp, gBuff8^, lAllocSliceSz{, n});
  1776.                end;
  1777.                if not gDICOMdata.JPEGlossyCpt then begin
  1778.  
  1779.                   CloseFile(infp);
  1780.                end;
  1781.                FileMode := 2; //read/write
  1782.   size := gDicomData.XYZdim[1]*gDicomData.XYZdim[2] {2*width*height};
  1783.   value := gBuff8[0];
  1784.   max16 := value;
  1785.   min16 := value;
  1786.   i:=0;
  1787.   while I < (Size) do begin
  1788.     value := gBuff8[i];
  1789.     if value < min16 then min16 := value;
  1790.     if value > max16 then max16 := value;
  1791.     i := i+1;
  1792.   end;
  1793.   //size := (gDicomData.XYZdim[1]*gDicomData.XYZdim[2])-1 {width*height-1 };
  1794.   gImgMin := min16;
  1795.   gImgMax := max16;
  1796.   gWinMin := min16;
  1797.   gWinMax := max16;
  1798.   gImgWid := gImgMax-gImgMin;
  1799.   gImgCen := gImgMin + ((gImgWid)shr 1);
  1800.   if lWinWid < 0 then begin //autocontrast
  1801.     gWinMin := gImgMin;
  1802.     gWinMax := gImgMax;
  1803.     gWinWid := gImgWid;
  1804.     gWinCen := gImgCen;
  1805.   end;
  1806.  
  1807.   if (gCustomPalette>0) or ((red_table_size > 0) and (red_table_size <= 256) and (red_table_size=green_table_size) and (red_table_size=blue_table_size)) then begin
  1808.      if  gCustomPalette = 0 then begin
  1809.              gCustomPalette := red_table_size-1;
  1810.              for lInc := (gCustomPalette-1) downto 0 do begin
  1811.                  gRra[gCustomPalette-lInc] := red_table[lInc+1];//red_table[lInc+1];
  1812.                  gGra[gCustomPalette-lInc] := green_table[lInc+1];
  1813.                  gBra[gCustomPalette-lInc] := blue_table[lInc+1];//blue_table[lInc+1];
  1814.              end;
  1815.              freemem(red_table);
  1816.              red_table_size := 0;
  1817.              freemem(green_table);
  1818.              green_table_size := 0;
  1819.              freemem(blue_table);
  1820.              blue_table_size := 0;
  1821.      end; //red_size > 0
  1822.   end;
  1823.   if lnMultiSlice > 1 then begin
  1824.       lMultiStart := ((lMultiCol) * lMultiColSz)+(lMultiRow * lMultiFullRowSz);//both indexed from 0
  1825.       for j := (gDICOMdata.XYZdim[2]-1) downto 0 do begin
  1826.         i := j * lMultiColSz;
  1827.         move(gBuff8[i],lMultiBuff[lMultiStart+ (J*lMultiLineSz)],lMultiColSz);
  1828.       end;
  1829.       lSlice := gMultiFirst+round (lMultiSliceInc*lMultiSlice);
  1830.       inc(lMultiSlice);
  1831.       if (lMultiSlice <= lnMultiSlice) and (lSlice <= {lMultiMaxSlice}gMultiLast) then goto 123;
  1832.       freemem(gBuff8);
  1833.       getmem(gBuff8,lMultiSliceSz);
  1834.       move(lMultiBuff[0],gBuff8[0],lMultiSliceSz);
  1835.       freemem(lMultiBuff);
  1836.       gBuff8Sz := lMultiSliceSz;
  1837.       //gBuff8 := @lMultiBuff^;
  1838.   end;
  1839.   //       g100pctImageWid := gDIcomData.XYZdim[1];
  1840.   //       g100pctImageHt :=gDIcomData.XYZdim[2];
  1841.   DetermineZoom;
  1842.   SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true);
  1843.      UpdatePalette(true,0);
  1844.   //dsa gPalUpdated := false;
  1845.   //  image.Height:= round((image.Picture.Bitmap.Height * gZoomPct) div 100);
  1846.   // image.Width := round((image.Picture.Bitmap.Width* gZoomPct) div 100) ;
  1847.   {image.Height:= image.Picture.Height;
  1848.   image.Width := image.Picture.Width;
  1849.   Image.Refresh;}
  1850.   DICOMImageRefreshAndSize;
  1851.   if Self.Active then //qwer
  1852.      MainForm.ColUpdate;
  1853.   exit;
  1854.           end;
  1855.        16: begin
  1856.            if gECATslices >= lSlice then
  1857.               seek(infp, gECATposra[lSlice])
  1858.            else
  1859.                Seek(infp, lImageStart);
  1860.            if (gBuff16Sz <> (lAllocSliceSz shr 1)) then begin
  1861.               if gBuff16sz <> 0 then
  1862.                  Freemem(gBuff16);
  1863.               gBuff16Sz := 0;
  1864.            end;
  1865.            if gBuff16sz = 0 then
  1866.            GetMem( gbuff16, lAllocSliceSz);
  1867.            gBuff16sz := (lAllocSliceSz shr 1);
  1868.            if gDicomData.JPEGlosslessCpt then begin
  1869.               DecodeJPEG(infp,gBuff16,lBuff, lAllocSliceSz,gECATposra[lSlice],gECATszra[lSlice],false);
  1870.            end else if gDicomData.GenesisCpt then begin
  1871.                 lLastPixel := 0;
  1872.                 lBufEntries := lAllocSliceSz div 2;
  1873.                 lTmpSz := FileSize(infp)-lImageStart;
  1874.                 if (lAllocSliceSz < lTmpSz) then
  1875.                 lTmpSz := FileSize(infp)-lImageStart;
  1876.                 if (lAllocSliceSz < lTmpSz) then
  1877.                    lTmpSz := lAllocSliceSz; {idea: for multi slice images, limit compression}
  1878.                 lTmpSz := lTmpSz - 2;
  1879.                 GetMem( TmpBuff, lTmpSz);
  1880.                 BlockRead(inFp, TmpBuff^, lTmpSz);
  1881.                 {$R-}
  1882.                    lTmpPos := 0;
  1883.                    lImgPos := 0;
  1884.                    lLineStart := 1;
  1885.                    lLineEnd := gDicomData.XYZdim[1]{round(Xdim.value)};//gDicomData.XYZdim[1];
  1886.                    for lLine := 1 to gDicomData.XYZdim[2] do begin
  1887.                        if gDicomData.GenesisPackHdr <> 0 then begin
  1888.                               lLineStart :=swap16i(gDicomData.GenesisPackHdr+((lLine-1)*4));
  1889.                               lLineEnd := -1+lLineStart+ swap16i(2+gDicomData.GenesisPackHdr+((lLine-1)*4));
  1890.                               //if lLine < 10 then showmessage(inttostr(lLineStart));
  1891.                               if lLinestart >0 then
  1892.                                  for lPos := 1 to (lLineStart) do begin
  1893.                                   gBuff16[lImgPos] := 0;
  1894.                                   inc(lImgPos);
  1895.                               end;
  1896.                           end;
  1897.                           for lPos := lLineStart to lLineEnd do begin
  1898.                              lByte := GetByte;
  1899.                              if (lByte > 127) then begin
  1900.                                 if ((lByte and 64)=64) then begin {new 16 bits}
  1901.                                    I := GetByte;//lByte2;
  1902.                                    lByte := GetByte;
  1903.                                    lLastPixel := ((I shl 8)+lByte);
  1904.                                 end else begin {not lbyte and 64: 14 byte delta}
  1905.                                  lByte2 := getbyte;
  1906.                                  J := lByte2;
  1907.                                  if ((lByte and 32)=32) then {subtract delta}  //shl1=2,shl2=4,shl3=8,shl4=16,shl5=32
  1908.                                     I := (lByte or $E0)
  1909.                                  else
  1910.                                      I := lByte and $1F;
  1911.                                  lLastPixel := lLastPixel + smallint(((I)shl 8)+ (J {shl 5}))
  1912.                                 end; {14 byte delta}
  1913.                              end else begin {not lbyte and 128: 7 byte delta}
  1914.                                  if (lByte > 63) then {subtract delta}
  1915.                                     lByte := lByte or $C0;
  1916.                                  lLastPixel := lLastPixel + shortInt(lByte);
  1917.                          end; //lbyte values
  1918.                              if lImgPos <= lBufEntries then
  1919.                                 gBuff16[lImgPos] := lLastPixel
  1920.                              else //imgpos >= lAlloc
  1921.                                  goto 444;
  1922.                              inc(lImgPos);
  1923.                        end; //lPos
  1924.                        if (lLineEnd+1) < {round(Xdim.value)}gDICOMData.XYZdim[1] then begin
  1925.                               for lPos := gDICOMData.XYZdim[1] downto (lLineEnd+2) do begin
  1926.                                   //if lLine < (512) then
  1927.                                   gBuff16[lImgPos] := 0;
  1928.                                   inc(lImgPos);
  1929.                               end;
  1930.                        end;
  1931.                    end; //for lines
  1932.                    444:
  1933.                 Freemem(TmpBuff);
  1934.                 end else begin //not genesis
  1935.                    BlockRead(infp, gbuff16^, lAllocSliceSz{, n});
  1936.                 end;
  1937.                 CloseFile(infp);
  1938.                 FileMode := 2; //read/write
  1939.        end;
  1940.        12: begin
  1941.            GetMem( tmpbuff, lAllocSliceSz);
  1942.            BlockRead(infp, tmpbuff^, lAllocSliceSz{, n});
  1943.            CloseFile(infp);
  1944.            FileMode := 2; //read/write
  1945.            lStoreSliceVox := gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2];
  1946.            lStoreSLiceSz := lStoreSliceVox * 2;
  1947.            if (gBuff16Sz <> (lStoreSLiceSz shr 1)) then begin
  1948.               if gBuff16sz <> 0 then
  1949.                  Freemem(gBuff16); //asdf
  1950.               gBuff16Sz := 0;
  1951.            end;
  1952.            if gBuff16sz = 0 then
  1953.            GetMem( gbuff16, lStoreSLiceSz);
  1954.            gBuff16sz := lStoreSLiceSz shr 1;
  1955.            I12 := 0;
  1956.            I := 0;
  1957.          if gDicomData.little_endian = 1 then begin
  1958.           repeat
  1959.                  gbuff16[I] := tmpbuff[I12] + ((tmpbuff[I12+1] and 15) shl 8);
  1960.                  inc(I);
  1961.                  if I < lStoreSliceVox then
  1962.                     gbuff16[i] :=  (tmpbuff[I12+2] shl 4) +((tmpbuff[I12+1] and 240) shr 4 );
  1963.                  inc(I);
  1964.                  I12 := I12 + 3;
  1965.            until I >= lStoreSliceVox;
  1966.         end else begin
  1967.            repeat
  1968.                  gbuff16[I] := tmpbuff[I12] shl 4 + (tmpbuff[I12+1] and 15);
  1969.                  inc(I);
  1970.                  if I < lStoreSliceVox then
  1971.                     gbuff16[i] :=  (((tmpbuff[I12+2]) and 15) shl 8) +((((tmpbuff[I12+1]) shr 4 ) shl 4)+((tmpbuff[I12+2]) shr 4)  );
  1972.                  inc(I);
  1973.                  I12 := I12 + 3;
  1974.            until I >= lStoreSliceVox;
  1975.          end;
  1976.            FreeMem( tmpbuff);
  1977.            end;
  1978.        else exit;
  1979.   end;
  1980.   size := gDicomData.XYZdim[1]*gDicomData.XYZdim[2] {2*width*height};
  1981.   if (gDicomdata.little_endian <> 1) and (not gDicomData.GenesisCpt) then  //convert big-endian data to Intel friendly little endian
  1982.      for i := (Size-1) downto 0 do
  1983.          gbuff16[i] := swap(gbuff16[i]);
  1984.   value := gbuff16[0];
  1985.   max16 := value;
  1986.   min16 := value;
  1987.   i:=0;
  1988.   while I < (Size) do begin
  1989.     value := gbuff16[i];
  1990.     if value < min16 then min16 := value;
  1991.     if value > max16 then max16 := value;
  1992.     i := i+1;
  1993.   end;
  1994.   gImgMin := min16;
  1995.   gImgMax := max16;
  1996.   gImgWid := gImgMax-gImgMin;
  1997.   gImgCen := gImgMin + ((gImgWid)shr 1);
  1998.   if lWinWid < 0 then begin //autocontrast
  1999.     gWinMin := gImgMin;
  2000.     gWinMax := gImgMax;
  2001.     gWinCen := gImgCen;
  2002.     gWinWid := gImgWid;
  2003.     gFastCen := gImgCen;
  2004.     //showmessage('x');
  2005.   end;
  2006.   if lnMultiSlice > 1 then begin
  2007.       //showmessage(inttostr(lMultiSlice)+':'+inttostr(lnMultiSlice)+':'+inttostr(g100pctImageWid));
  2008.       lMultiStart := ((lMultiCol) * lMultiColSz)+(lMultiRow * lMultiFullRowSz);//both indexed from 0
  2009.       for j := (gDICOMdata.XYZdim[2]-1) downto 0 do begin
  2010.         i := j * lMultiColSz;
  2011.         move(gBuff16[i],lMultiBuff[(lMultiStart+ (J*lMultiLineSz)) shl 1],lMultiColSz shl 1);
  2012.       end;
  2013.  
  2014. //      lMultiStart := ((lMultiCol) * lMultiColSz)+(lMultiRow * lMultiFullRowSz);//both indexed from 0
  2015. //      for j := (gDICOMdata.XYZdim[2]-1) downto 0 do begin
  2016. //        i := j * lMultiColSz;
  2017. //        move(gBuff16[i],lMultiBuff16[(lMultiStart+ (J*lMultiLineSz)) shr 1],lMultiColSz {shl 1});
  2018. //      end;
  2019.       //showmessage('CXZ'+inttostr(lMultiSlice)+':'+inttostr(lnMultiSlice)+':'+inttostr(g100pctImageWid));
  2020.       //inc(lSlice);
  2021.       lSlice := gMultiFirst+round (lMultiSliceInc*lMultiSlice);
  2022.  
  2023.       inc(lMultiSlice);
  2024.       if (lMultiSlice <= lnMultiSlice) and (lSlice <= {lMultiMaxSlice}gMultiLast) then goto 123;
  2025.       freemem(gBuff16);
  2026.       getmem(gBuff16,lMultiSliceSz shl 1);
  2027.       gBuff16sz := (lMultiSliceSz);
  2028.       move(lMultiBuff[0],gBuff16[0],lMultiSliceSz shl 1);
  2029.       freemem(lMultiBuff);   {}
  2030.       //gBuff16 := @lMultiBuff^;
  2031.  
  2032.   end;
  2033.   //showmessage(inttostr(g100pctImageWid)+':123abba:'+inttostr(gMultiRow));
  2034.   DetermineZoom;
  2035.   Scale16to8bit(gWinCen,gWinWid);
  2036. DICOMImageRefreshAndSize;
  2037.   if Self.Active then //qwer
  2038.      MainForm.ColUpdate;
  2039.   exit;
  2040.  
  2041.   {$P-,S+,W+,R+}
  2042. end;
  2043.  
  2044. procedure TMDIChild.FileOpenpicture1Click(Sender: TObject);
  2045. begin
  2046.     MainForm.Opengraphic1Click(Sender);
  2047. end;
  2048.  
  2049. procedure TMDIChild.Lowerslice1Click(Sender: TObject);
  2050. var
  2051.    lSlice: integer;
  2052. begin
  2053.     gMultiCol := 1;
  2054.     gMultiRow := 1;
  2055.   if (sender as TMenuItem).tag = 1 then begin{increment}
  2056.      if gSlice >= gDICOMdata.XYZdim[3] then
  2057.         lSlice := 1
  2058.      else
  2059.          lSlice := gSlice + 1;
  2060.   end else begin
  2061.      if gSlice > 1 then
  2062.         lSlice := gSlice -1
  2063.      else
  2064.          lSlice := gDICOMdata.XYZdim[3];
  2065.   end;
  2066.   MainForm.SliceSlider.position := lSlice;
  2067.   MainForm.SliceSliderChange(nil);
  2068. end;
  2069.  
  2070. procedure TMDIChild.FormActivate(Sender: TObject);
  2071. begin
  2072.      MainForm.ColUpdate;
  2073.      automaximise;
  2074. end;
  2075.  
  2076. procedure TMDIChild.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  2077.   Shift: TShiftState; X, Y: Integer);
  2078. var lSlice,lX,lY: integer;
  2079. lSLopeReal: single;
  2080. begin
  2081.   if (button = mbLeft) and (ssCtrl{Shift} in Shift) then  begin
  2082.            Screen.Cursor := crDrag;
  2083.            //GetCursorPos( FLastDown );
  2084.            gMouseDown := true;
  2085.            lX := round((X *image.Picture.Height)/image.Height);
  2086.            lY := round((Y *image.Picture.Width)/image.Width);
  2087.            //lX := ((X * 100) div gZoomPct);
  2088.            //lY := ((Y * 100) div gZoomPct);
  2089.            gSelectOrigin.X := lX;
  2090.            gSelectOrigin.Y := lY;
  2091.   end else  if (button = mbLeft) and (ssAlt in Shift) then  begin
  2092.            Screen.Cursor := crHandPoint;
  2093.            GetCursorPos( FLastDown );
  2094.            gMouseDown := true;
  2095.    end  else if (button = mbLeft) and (ssShift in Shift) then begin
  2096.          if (BackupBitmap = nil) then begin
  2097.             {if gPalUpdated then begin
  2098.                lSlice := gSlice;
  2099.                gSlice := 0;  //force redraw
  2100.                DisplayImage(false,true,lSlice,gWinWid,gWinCen);
  2101.             end; dsa}
  2102.             BackupBitmap := TBitmap.Create;
  2103.             BackupBitmap.Assign(Image.Picture.Bitmap);
  2104.          end;
  2105.              FLastDown := Point( - 1, - 1);
  2106.          gMouseDown := true;
  2107.          ShowMagnifier (X,Y); {}
  2108.    end else if (button = mbLeft) and (FDicom) and (gCustomPalette = 0) and (gDicomdata.SamplesPerPixel = 1) then begin
  2109.              FLastDown := Point( - 1, - 1);
  2110.         if gBuff16sz > 0 then begin
  2111.             if (gImgMax-gIMgMin) > 0 then
  2112.             gFastCen := round( ((gWinCen-gImgMin)/(gImgMax-gIMgMin))* 1024{512})
  2113.             else
  2114.                 gFastCen := 512;
  2115.             if gWinWId > 0 then
  2116.                lSlopeReal := (gImgMax-gIMgMin)/ gWinWid
  2117.             else lSlopeReal := 666;
  2118.             gFastSlope := round(( arctan(lSlopeReal)/kRadCon)/0.0878);
  2119.  
  2120.         end else begin
  2121.             gFastCen := gWinCen;
  2122.             if gWinWId > 0 then
  2123.                lSlopeReal := 255 / gWinWid
  2124.             else lSlopeReal := 45;
  2125.             gFastSlope := round(( arctan(lSlopeReal)/kRadCon)/0.352059);
  2126.         end;
  2127.  
  2128.         gXstart := X;
  2129.         gYstart := Y;
  2130.         gStartSlope := gFastSlope;
  2131.         gStartCen := gFastCen;
  2132.         gMouseDown := true;
  2133.      end;
  2134. end;
  2135.  
  2136. procedure TMDIChild.UpdatePalette (lApply: boolean;lWid0ForSlope:integer);
  2137. var
  2138.    lMin,lMax,lInc{,lV,lMinPal,lMaxPal}: integer;
  2139.    //PPal: PLogPalette;
  2140.    lSlopeReal: single;
  2141. begin
  2142.    //dsa gPalUpdated := true;
  2143.    if gDICOMdata.Allocbits_per_pixel > 8 then begin
  2144.         if not lApply then exit;
  2145.         (*for lInc := 0 to 255 do begin
  2146.             gRGBquadRA[lInc].rgbRed := gRra[lInc];
  2147.             gRGBquadRA[lInc].rgbGreen :=gGra[lInc];
  2148.             gRGBquadRA[lInc].rgbBlue := gBra[lInc];
  2149.             //gRGBquadRA[lInc].rgbReserved := 0;
  2150.         end;
  2151.         Image.Picture.Bitmap.HandleType := bmDIB;
  2152.         SetDIBColorTable(Image.Picture.Bitmap.Canvas.Handle, 0, 256, gRGBQuadRA);
  2153.         IMage.Invalidate;*)
  2154.         refreshzoom;
  2155.         exit;
  2156.    end;
  2157.    if lWid0ForSlope = 0 then begin
  2158.  
  2159.       lSlopeReal := gFastSlope * 0.352059;
  2160.       lSlopeReal := sin(lSlopeReal*kRadCon)/cos(lSlopeReal*kRadCon);
  2161.       //showmessage(Floattostr(gFastSlope)+':'+ floattostr((arctan(lSlopeReal)/kRadCon)/0.352059));
  2162.       if lSlopeReal <> 0 then begin
  2163.            lMax := round(128 / lSlopeReal);
  2164.            lMin := gFastCen-lMax;
  2165.            lMax := gFastCen+lMax;
  2166.       end else begin
  2167.             lMin := 0;
  2168.             lMax := 0;
  2169.       end;
  2170.    end else begin //lWid0ForSlope
  2171.        lMin := gFastCen - (lWid0ForSlope shr 1);
  2172.        lMax := lMin + lWid0ForSlope;
  2173.        lSlopeReal := 255 / lWid0ForSlope;
  2174.        gFastSlope := round(( arctan(lSlopeReal)/kRadCon)/0.352059);
  2175.        //gFastSlope := round((ArcTan(lSlopeReal*kRadCon))/ 0.352059);
  2176.        //showmessage(inttostr(gFastSlope));
  2177.        //gFastSlope := 128;//round((cos(lSlopeReal*kRadCon)/sin(lSlopeReal*kRadCon))/0.352059);
  2178.  
  2179.    end;
  2180.         if gDicomData.Allocbits_per_pixel < 9 then begin
  2181.             gWinCen := (gFastCen);
  2182.             if ((lMax - lMin) > maxint) or ((lMin=0) and (lMax=0)) then begin
  2183.                gContrastStr := 'Window Cen/Wid: '+inttostr(gFastCen)+'/inf';
  2184.                 gWInWid := maxint;
  2185.             end else begin
  2186.                 gContrastStr := 'Window Cen/Wid: '+inttostr(gFastCen)+'/'+inttostr(lMax - lMin);
  2187.                 gWInWid := (lMax - lMin);
  2188.             end;
  2189.         end;
  2190.         if gBuff8Sz > 0 then begin
  2191.            SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true);
  2192.            DICOMImageRefreshAndSize;
  2193.         end;
  2194.         (*if lMin < 0 then lMin := 0
  2195.         else if lMin > 255 then lMin := 255;
  2196.         if lMax < 0 then lMax := 0
  2197.         else if lMax > 255 then lMax := 255;
  2198.         lMinPal := 128+round(lSlopeReal*(0-gFastCen));
  2199.         if (lMinPal < 0) or (lMinPal > 255) then
  2200.            lMinPal := 0;
  2201.         lMaxPal := 128+round(lSlopeReal*(255-gFastCen));
  2202.         if (lMaxPal < 0) or (lMaxPal > 255) then
  2203.            lMaxPal := 255;
  2204.         for lInc := 0 to lMin do
  2205.             gPalra[lInc] := lMinPal;//0;
  2206.         for lInc := lMax to 255 do
  2207.                gPalra[lInc] := lMaxPal;//255;
  2208.         if (lMin+1) < lMax then begin
  2209.             for lInc := (lMin+1) to (lMax-1) do begin
  2210.                 lV := 128+round(lSlopeReal*(lInc-gFastCen));
  2211.                 if lV < 0 then lV := 0
  2212.                 else if lV > 255 then lV := 255;
  2213.                 gPalRA[lInc] := lV;//(lInc-gFastCen);
  2214.             end;
  2215.         end;
  2216.         if not lApply then exit;
  2217.         for lInc := 0 to 255 do begin
  2218.             gRGBquadRA[lInc].rgbRed := gRra[gPalRA[lInc]];
  2219.             gRGBquadRA[lInc].rgbGreen :=gGra[gPalRA[lInc]];
  2220.             gRGBquadRA[lInc].rgbBlue := gBra[gPalRA[lInc]];
  2221.             //gRGBquadRA[lInc].rgbReserved := 0;
  2222.         end;
  2223.         Image.Picture.Bitmap.HandleType := bmDIB;
  2224.         SetDIBColorTable(Image.Picture.Bitmap.Canvas.Handle, 0, 256, gRGBQuadRA);
  2225.         IMage.Invalidate;*)
  2226. end;
  2227.  
  2228. procedure TMDIChild.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  2229.   Y: Integer);
  2230.   var
  2231.      lX,lY,lWid: integer;
  2232.      lSlopeReal: single;
  2233. var
  2234.   pt: TPoint;
  2235. begin
  2236.   if not gMouseDown then begin
  2237.    lX := {trunc}((X * 100) div gZoomPct);
  2238.    lY := {trunc}((Y * 100) div gZoomPct);
  2239.    Vxl(lX,lY);
  2240.   //MainForm.StatusBar.Panels[3].text := inttostr(lX)+':'+inttostr(lY);//abba
  2241.  
  2242.    exit;
  2243.   end;
  2244.  
  2245. if (ssCtrl in Shift) then begin
  2246.    Image.Canvas.DrawFocusRect(gSelectRect);
  2247.    lX := round((X *image.Picture.Height)/image.Height);
  2248.    lY := round((Y *image.Picture.Width)/image.Width);
  2249.    if gSelectOrigin.X < 1 then begin
  2250.         gSelectOrigin.X := lX;
  2251.         gSelectOrigin.Y := lY;
  2252.    end;
  2253.    if lX < gSelectOrigin.X then begin
  2254.         gSelectRect.Right := gSelectOrigin.X;
  2255.         gSelectRect.Left := lX;
  2256.    end else begin
  2257.          gSelectRect.Right := lX;
  2258.          gSelectRect.Left := gSelectOrigin.X;
  2259.    end;
  2260.    if lY < gSelectOrigin.Y then begin
  2261.         gSelectRect.Bottom := gSelectOrigin.Y;
  2262.         gSelectRect.Top := lY;
  2263.    end else begin
  2264.          gSelectRect.Bottom := (lY);
  2265.          gSelectRect.Top := gSelectOrigin.Y
  2266.    end;
  2267.    Image.Canvas.DrawFocusRect(gSelectRect);
  2268.   end else
  2269.   if {(ssLeft In Shift) gMouseDown and} (FLastDown.X >= 0) then begin
  2270.     GetCursorPos( pt );
  2271.     Scrollbox1.VertScrollBar.Position := Scrollbox1.VertScrollBar.Position + FLastDown.Y - pt.Y;
  2272.     Scrollbox1.HorzScrollBar.POsition := Scrollbox1.HorzScrollBar.Position + FLastDown.X - pt.X;
  2273.     FLastDown := pt;
  2274.   {end else if (BackupBitmap <> nil) then begin
  2275.          ShowMagnifier (X,Y);}
  2276.   end else if (BackupBitmap <> nil) then begin
  2277.          ShowMagnifier (X,Y);
  2278.   end else if gBuff16sz > 0 then begin
  2279. (*     lX := x-gXStart;
  2280.      if ((lX+gStartSlope) > 512) then
  2281.            gFastSlope := 512
  2282.      else if ((lX+gStartSlope) < 1) then
  2283.              gFastSlope := 1
  2284.      else
  2285.          gFastSlope := lX+gStartSlope;
  2286.      lSlopeReal := gFastSlope * 0.175781;
  2287.      lWid := trunc((gImgMax-gIMgMin)/(sin(lSlopeReal*kRadCon)/cos(lSlopeReal*kRadCon)));
  2288.      lY := y-gYStart;
  2289.      lY := round(lY*(gImgMax-gIMgMin)/ 512);
  2290.      if ((gStartCen + lY)> gImgMax) then
  2291.            gFastCen := gImgMax
  2292.      else if ((lY+gStartCen) < gImgMin) then
  2293.              gFastCen := gImgMin
  2294.      else
  2295.          gFastCen := gStartCen + lY;{}
  2296.      Scale16to8bit(gFastCen,lWid);
  2297.      DICOMImageRefreshAndSize;*)
  2298.      lX := x-gXStart;
  2299.      if ((lX+gStartSlope) > 1024) then
  2300.            gFastSlope := 1024
  2301.      else if ((lX+gStartSlope) < 1) then
  2302.              gFastSlope := 1
  2303.      else
  2304.          gFastSlope := lX+gStartSlope;
  2305.      lSlopeReal := gFastSlope * 0.0878{0.175781 {CONTRAST change here};
  2306.      lWid := trunc((gImgMax-gIMgMin)/(sin(lSlopeReal*kRadCon)/cos(lSlopeReal*kRadCon)));
  2307.      lY := y-gYStart;
  2308.      if ((gStartCen + lY)> 1024) then
  2309.            gFastCen := 1024
  2310.      else if ((lY+gStartCen) < 0) then
  2311.              gFastCen := 0
  2312.      else
  2313.          gFastCen := gStartCen + lY;{}
  2314.      lY := round(((gFastCen/ 1024)*(gImgMax-gIMgMin))+gImgMin); {CONTRAST change here: /n where n is amount of mouse movement}
  2315.      Scale16to8bit(lY,lWid);
  2316.      DICOMImageRefreshAndSize;
  2317.   end else begin
  2318.      lX := x-gXStart;
  2319.      if ((lX+gStartSlope) > 255) then
  2320.            gFastSlope := 255
  2321.      else if ((lX+gStartSlope) < 0) then
  2322.              gFastSlope := 0
  2323.      else
  2324.          gFastSlope := lX+gStartSlope;
  2325.      lY := y-gYStart;
  2326.      if ((gStartCen + lY)> 255) then
  2327.            gFastCen := 255
  2328.      else if ((lY+gStartCen) < 0) then
  2329.              gFastCen := 0
  2330.      else
  2331.          gFastCen := gStartCen + lY;
  2332.      UpdatePalette(true,0);
  2333.      MainForm.StatusBar.Panels[4].text := gContrastStr;
  2334.   end;
  2335. end;
  2336.  
  2337. procedure TMDIChild.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  2338.   Shift: TShiftState; X, Y: Integer);
  2339. procedure MinMaxRect (var lIn: integer; lMaxPlus1: integer);
  2340. begin
  2341.     if lIn < 0 then lIn := 0;
  2342.     if lIn >= lMaxPlus1 then lIn := lMaxPlus1 -1;
  2343. end;
  2344. var lSlice,lWinWid,lWinCen,lVal,lMin,lMax,lCol,lROw: integer;
  2345. begin
  2346.      FLastDown := Point( - 1, - 1);
  2347.      Screen.Cursor := crDefault;
  2348.      if (gSelectRect.left <> gSelectRect.right) and (gSelectRect.top <> gSelectRect.bottom) then begin
  2349.         Image.Canvas.DrawFocusRect(gSelectRect);
  2350.         if gSmooth then begin
  2351.            gSelectRect.Left := ((gSelectRect.Left * 100) div gZoomPct);
  2352.            gSelectRect.Top := ((gSelectRect.Top * 100) div gZoomPct);
  2353.            gSelectRect.Right := ((gSelectRect.Right * 100) div gZoomPct);
  2354.            gSelectRect.Bottom := ((gSelectRect.Bottom * 100) div gZoomPct);
  2355.         end;
  2356.         MinMaxRect(gSelectRect.Left,g100pctImageWid);
  2357.         MinMaxRect(gSelectRect.Top,g100pctImageHt);
  2358.         MinMaxRect(gSelectRect.Right,g100pctImageWid);
  2359.         MinMaxRect(gSelectRect.Bottom,g100pctImageHt);
  2360.  
  2361. //MainForm.StatusBar.Panels[1].text := inttostr(gSelectRect.Left)+':'+inttostr(gSelectRect.Top)+':'+inttostr(gSelectRect.Right)+':'+inttostr(gSelectRect.Bottom); //cxz
  2362.  
  2363.         lMin := VxlVal((gSelectRect.Left {* 100}) {div gZoomPct},(( gSelectRect.Top {* 100}) {div gZoomPct}));
  2364.         lMax := lMin;
  2365.         for lCol := gSelectRect.Left to gSelectRect.Right do begin
  2366.             //lX := ((lCol * 100) div gZoomPct);
  2367.             for lRow := gSelectRect.Top to gSelectRect.Bottom do begin
  2368.                 lVal := VxlVal(lCol,{((lRow * 100) div gZoomPct)}lRow);
  2369.                 if lVal < lMin then lMin := lVal;
  2370.                 if lVal > lMax then lMax := lVal;
  2371.             end; //row
  2372.         end; //column
  2373.         gSelectRect := Rect(0,0,0,0);
  2374.         gSelectOrigin.X := -1;
  2375.         lWinWid := lMax - lMin;  //max now = windowwid
  2376.         lWinCen := lMin + (lWinWid shr 1);
  2377.         gWinWid := lWinWid;
  2378.         gWinCen := LwinCen;
  2379.         gFastCen := lWinCen;
  2380.         if gBuff16sz > 0 then begin
  2381.            RefreshZoom;
  2382.         end else begin
  2383.             if lWinWid = 0 then lWinWid := 1;
  2384.             UpdatePalette(true,lWinWid);
  2385.         end;
  2386.      end else
  2387.      if (BackupBitmap <> nil) then begin//magnifier was on
  2388.         Image.Picture.Graphic  := BackupBitmap;  // Restore base image
  2389.         BackupBitmap.Free;
  2390.         BackupBitmap := nil;
  2391.         IMage.refresh;
  2392.      end else if (gMOuseDown) and (gBuff16sz > 0) then begin
  2393.          Mainform.WinCenEdit.value := gWinCen;
  2394.          MainForm.WinWidEdit.value := gWinWid;
  2395.  
  2396.      end;
  2397.      gMouseDown := false;
  2398. end;
  2399.  
  2400. procedure TMDIChild.SelectZoom1Click(Sender: TObject);
  2401. begin
  2402. if MainForm.ZoomSlider.enabled then
  2403.    MainForm.ZoomSlider.SetFocus
  2404. else if MainForm.SchemeDrop.enabled then
  2405.    MainForm.SchemeDrop.SetFocus;
  2406. end;
  2407.  
  2408. procedure TMDIChild.ContrastAutobalance1Click(Sender: TObject);
  2409. begin
  2410. MainForm.AutoBal.Click;
  2411. end;
  2412.  
  2413. procedure TMDIChild.FormResize(Sender: TObject);
  2414. begin
  2415.      //if (MainForm.BestFitItem.checked) {and (not gZoomSlider)} then
  2416.      automaximise;
  2417. end;
  2418.  
  2419. procedure TMDIChild.CopyItemClick(Sender: TObject);
  2420. var
  2421.   MyFormat : Word;
  2422.   AData: THandle;
  2423.   //APalette : THandle;
  2424.   APalette : HPalette;
  2425. begin
  2426.      if (Image.Picture.Bitmap = nil) or (Image.Picture.Width < 1) or (Image.Picture.Height < 1) then exit;
  2427.     Image.Picture.Bitmap.SaveToClipBoardFormat(MyFormat,AData,APalette);
  2428.     ClipBoard.SetAsHandle(MyFormat,AData);
  2429. end;
  2430.  
  2431. procedure TMDIChild.Timer1Timer(Sender: TObject);
  2432. var lSlice: integer;
  2433. begin
  2434.  if gDicomdata.XYZdim[3] > 1 then begin
  2435.      if gSlice >= gDICOMdata.XYZdim[3] then
  2436.         lSlice := 1
  2437.      else
  2438.          lSlice := gSlice + 1;
  2439.       DisplayImage(false,false,lSlice,gWinWid,gWinCen);
  2440.  end else begin
  2441.   Timer1.enabled := false;
  2442.   gVideoSpeed := 0;
  2443.   MainForm.VideoBtn.Caption := '0';
  2444.  end;
  2445. end;
  2446.  
  2447. procedure TMDIChild.Previous1Click(Sender: TObject);
  2448. begin
  2449.     gMultiCol := 1;
  2450.     gMultiRow := 1;
  2451.      if (sender as TMenuItem).tag = 1 then begin //increment
  2452.         gCurrentPosInFileList := gCurrentPosInFileList+1;
  2453.      end else
  2454.          gCurrentPosInFileList := gCurrentPosInFileList-1;
  2455.      if (gCurrentPosInFileList >= gFileListSz) then gCurrentPosInFileList := 0;
  2456.      if (gCurrentPosInFileList < 0) then gCurrentPosInFileList := gFileListSz-1;
  2457.      //showmessage(gStringList.Strings[gCurrentPosInFileList]);
  2458.      LoadData( gFilePath+gStringList.Strings[gCurrentPosInFileList] ,false,false,false,false );
  2459.      MainForm.ColUpdate;
  2460.      //if (MainForm.BestFitItem.checked) then
  2461.      automaximise;
  2462.      //if (MainForm.BestFitItem.checked) {and (not gZoomSlider)} then
  2463.      //   automaximise;
  2464. end;
  2465.  
  2466. procedure TMDIChild.N1x11Click(Sender: TObject);
  2467. var lSize : integer;
  2468. begin
  2469. // (sender as tmenuitem).checked := true;
  2470.  lSize := (sender as TMenuItem).tag;
  2471.  Timer1.enabled := false;
  2472.  gVideoSpeed := 0;
  2473.  MainForm.VideoBtn.Caption := '0';
  2474.  if lSize < 5 then begin
  2475.     gMultiCol := lSize;
  2476.     gMultiRow := lSize;
  2477.     gMultiFirst := 1;
  2478.     gMultiLast := gDICOMdata.XYZdim[3];
  2479.     lSize := gSlice;
  2480.     gSlice := 0; //force redraw
  2481.     DisplayImage(false,false,lSize,gWinWid,gWinCen);
  2482.     //if (MainForm.BestFitItem.checked) then
  2483.     automaximise;
  2484.     //gMultiCol := 1;
  2485.     //gMultiRow := 1;
  2486.  
  2487.  end else begin
  2488.      MultiSliceForm.gMaxMultiSlices := gDICOMdata.XYZdim[3];
  2489.      MultiSliceForm.ShowModal;
  2490.      gMultiCol := MultiSliceForm.ColEdit.value;
  2491.      gMultiRow := MultiSliceForm.RowEdit.value;
  2492.     gMultiFirst := MultiSliceForm.FirstEdit.value;
  2493.     gMultiLast := MultiSliceForm.LastEdit.value;
  2494.     lSize := gSlice;
  2495.     gSlice := 0; //force redraw
  2496.     DisplayImage(false,false,lSize,gWinWid,gWinCen);
  2497.     //if (MainForm.BestFitItem.checked) then
  2498.     automaximise;
  2499.     //gMultiCol := 1;
  2500.     //gMultiRow := 1;
  2501.  
  2502.  end;
  2503.  
  2504. end;
  2505.  
  2506. procedure TMDIChild.Smooth1Click(Sender: TObject);
  2507. begin
  2508.     Smooth1.checked :=  not Smooth1.checked;
  2509.      gSmooth := Smooth1.checked;
  2510.      RefreshZoom;
  2511. end;
  2512.  
  2513. procedure TMDIChild.None1Click(Sender: TObject);
  2514. begin
  2515. (sender as tmenuitem).checked := true;
  2516. RefreshZoom;
  2517. end;
  2518.  
  2519. end.
  2520.  
  2521.  
  2522.  
  2523.