childwin.pas

在delphi7 下开发医学图象浏览器,对医学图象进行编辑,分析的

    end;
  end; //use wincen/wid



  
  Bmp := TBitmap.Create;
  Bmp.Height := lPGHt {width};
  Bmp.Width := lPGwid;
  ImagoDC := GetDC(Self.Handle);
  hBmp := CreateDIBSection(imagodc, bi^, DIB_RGB_COLORS, pixmap, 0, 0);
  lScanLineSz := lPGwid;
  if (lPGwid mod 4) <> 0 then
    lScanLineSz8 := 4 * ((lPGWid + 3) div 4)
  else
    lScanLineSz8 := lPGwid;
  lHt := Bmp.Height - 1;
  //lWid := lPGwid -1;
  {if (hBmp = 0) or (pixmap = nil) then
          if GetLastError = 0 then ShowMessage('Error!') else RaiseLastWin32Error;}
  if lBuff <> nil then
  begin
    {if HorFlipItem.checked then begin
       For i:= (lHt)  downto 0 do begin
           lPixMapInt := i * lScanLineSz;
           for j := (lWid shr 1) downto 0 do begin
               lTemp :=lBuff[lPixMapInt+j];
               lBuff[lPixMapInt+j] := lBuff[lPixMapInt+(lWid-j)];
               lBuff[lPixMapInt+(lWid-j)] := lTemp;
           end;
       end; //i 0..lHt
    end; //horflip{}
    lPixmapInt := Integer(pixmap);
    lBuffInt := Integer(lBuff);
    {if VertFlipItem.checked then begin
       For i:= (lHt)  downto 0 do
           CopyMemory(Pointer(lPixmapInt+lScanLineSz8*(i)),
                 Pointer(lBuffInt+((i))*lScanLineSz),lScanLineSz);
    end else begin}
    for i := (lHt) downto 0 do
      CopyMemory(Pointer(lPixmapInt + lScanLineSz8 * (i)),
        Pointer(lBuffInt + ((lHt - i)) * lScanLineSz), lScanLineSz);
    {end; {}
  end; //lBuff full
  ReleaseDC(0, ImagoDC);
  Bmp.Handle := hBmp;
  Bmp.ReleasePalette;

  Image.Picture.Assign(Bmp);
  Bmp.Free;
  FreeMem(BI);
  if (lBufferUsed) then
  begin
    freemem(lBuff);
  end;
{$P-,S+,W+,R-}
end;

procedure TMDIChild.ShowMagnifier(const X, Y: INTEGER);
//Shows a magnifier over one region of the image, saves old region a BackupBitmap
var
  AreaRadius: INTEGER;
  Magnification: INTEGER;
  xActual, yActual {,lMagArea}: INTEGER;
begin
  if BackupBitmap = nil then
    exit;
  xActual := round((X * image.Picture.Height) / image.Height);
  yActual := round((Y * image.Picture.Width) / image.Width);

  if (xActual < 0) or (yActual < 0) or (xActual > Image.Picture.width)
    or (yActual > Image.Picture.height) then
    exit;
  if (not gSmooth) and (gZoomPct <> 0) then
    AreaRadius := (50 * 100) div gZoomPct
  else
    AreaRadius := 50;
  Magnification := {round((30*2) / (100))} AreaRadius * 2;
    //round(( (( gZoomPct div 50)+1) * 100)  /gZoomPct * AreaRadius);
  if (gMagRect.Left <> gMagRect.Right) then
  begin
    Image.Picture.Bitmap.Canvas.CopyRect(gMagRect,
      BackupBitmap.Canvas, // [anme]
      gMagRect);
  end;
  gMagRect := Rect(xActual - Magnification,
    yActual - Magnification,
    xActual + Magnification,
    yActual + Magnification);
  Image.Picture.Bitmap.Canvas.CopyRect(gMagRect,
    BackupBitmap.Canvas, // [anme]
    Rect(xActual - AreaRadius,
    yActual - AreaRadius,
    xActual + AreaRadius,
    yActual + AreaRadius));
  Image.refresh;
end; {ShowMagnifier}

procedure FireLUT(lIntensity, lTotal: integer; var lR, lG, lB: integer);
//Generates a 'hot metal' style color lookup table
var
  l255scale: integer;
begin
  l255Scale := round(lIntensity / lTotal * 255);
  lR := (l255Scale - 52) * 3;
  if lR < 0 then
    lR := 0
  else if lR > 255 then
    lR := 255;
  lG := (l255Scale - 108) * 2;
  if lG < 0 then
    lG := 0
  else if lG > 255 then
    lG := 255;
  case l255Scale of
    0..55: lB := (l255Scale * 4);
    56..118: lB := 220 - ((l255Scale - 55) * 3);
    119..235: lB := 0;
  else
    lB := ((l255Scale - 235) * 10);
  end; {case}
  if lB < 0 then
    lB := 0
  else if lB > 255 then
    lB := 255;
end;

procedure TMDIChild.LoadColorScheme(lStr: string; lScheme: integer);
//Loads a color lookup tabel from disk.
//Lookup tables can either be in Osiris format (TEXT) or ImageJ format (BINARY: 768 bytes)
const
  UNIXeoln = chr(10);
var
  lF: textfile;
  lBuff: bytep0;
  lFdata: file;
  lCh: char;
  lNumStr: string;
  lRi, lGi, lBi, lZ: integer;
  lByte, lIndex, lRed, lBlue, lGreen: byte;
  lType, lIndx, lLong, lR, lG, lB: boolean;
  procedure ResetBools;
  begin
    lType := false;
    lIndx := false;
    lR := false;
    lG := false;
    lB := false;
    lNumStr := '';
  end;
begin
  gScheme := lScheme;
  if lScheme < 3 then
  begin //AUTOGENERATE LUT 0/1/2 are internally generated: do not read from disk
    case lScheme of
      0: for lZ := 0 to 255 do
        begin //1: low intensity=white, high intensity = black
          gRra[lZ] := 255 - lZ;
          gGra[lZ] := 255 - lZ;
          gBra[lZ] := 255 - lZ;
        end;
      2: for lZ := 0 to 255 do
        begin //Hot metal LUT
          FireLUT(lZ, 255, lRi, lGi, lBi);
          gRra[lZ] := lRi;
          gGra[lZ] := lGi;
          gBra[lZ] := lBi;
        end;
    else
      for lZ := 0 to 255 do
      begin //1: low intensity=black, high intensity = white
        gRra[lZ] := lZ;
        gGra[lZ] := lZ;
        gBra[lZ] := lZ;

      end;
    end; //case
    gMaxRGB := (gRra[255] + (gGra[255] shl 8) + (gBra[255] shl 16));
    gMinRGB := (gRra[0] + (gGra[0] shl 8) + (gBra[0] shl 16));
    exit;
  end; //AUTOGENERATE LUT
  lIndex := 0;
  lRed := 0;
  lGreen := 0;
  if gCustomPalette > 0 then
    exit;
  if not fileexists(lStr) then
    exit;
  assignfile(lFdata, lStr);
  filemode := 0;
  reset(lFdata, 1);
  lZ := FileSize(lFData);
  if (lZ = 768) or (lZ = 800) or (lZ = 970) then
  begin
    GetMem(lBuff, 768);
    Seek(lFData, lZ - 768);
    BlockRead(lFdata, lBuff^, 768);
    closeFile(lFdata);
    for lZ := 0 to 255 do
    begin
      //lZ := (lIndex);
      gRra[lZ] := lBuff[lZ];
      gGra[lZ] := lBuff[lZ + 256];
      gBra[lZ] := lBuff[lZ + 512];
    end;

    {write output ->
 filemode := 1;
 lZ := 256;
 AssignFile(lFData, 'C:\Documents and Settings\Chris\My Documents\imagen\smash.lut');
 Rewrite(lFData,1);
 BlockWrite(lFdata, lBuff[0], lZ);   //red
 BlockWrite(lFdata, lBuff[2*lZ], lZ); //blue
 BlockWrite(lFdata, lBuff[lZ], lZ); //green
 //BlockWrite(lFdata, lBuff^, lZ);
 CloseFile(lFData);

    {end write output}

    freemem(lBuff);
    gMaxRGB := (gRra[255] + (gGra[255] shl 8) + (gBra[255] shl 16));
    gMinRGB := (gRra[0] + (gGra[0] shl 8) + (gBra[0] shl 16));

    exit;

  end;
  closefile(lFdata);
  lLong := false;
  assignfile(lF, lStr);
  filemode := 0;
  reset(lF);
  ResetBools;
  for lByte := 0 to 255 do
  begin
    gRra[lByte] := 0;
    gGra[lByte] := 0;
    gBra[lByte] := 0;
  end;

  (*Start PaintShopProConverter
          lNumStr := '';
          lCh := ' ';
              while (not EOF(lF)) and (lCh <> kCR) and (lCh <> UNIXeoln) do begin
                    read(lF,lCh); //header signatur JASC-PAL
                    lNumStr := lNumStr + lCh;
              end;
          lCh := ' ';
              while (not EOF(lF)) and (lCh <> kCR) and (lCh <> UNIXeoln) do begin
                    read(lF,lCh); //jasc header version 0100
                    lNumStr := lNumStr + lCh;
              end;
          lCh := ' ';
              while (not EOF(lF)) and (lCh <> kCR) and (lCh <> UNIXeoln) do begin
                    read(lF,lCh); //jasc header index items, e.g. 256
                    lNumStr := lNumStr + lCh;
              end;
  //            showmessage(lNumStr);
              for lIndex := 0 to 255 do begin
                for lZ := 1 to 3 do begin
                  lNumStr := '';
                  repeat
                        read(lF,lCh);
                        if lCh in ['0'..'9'] then
                           lNumStr := lNumStr + lCh;
                  until (lNumStr <> '') and (not (lCh in ['0'..'9']));
                  case lZ of
                     1: gGra[lIndex] := strtoint(lNumStr);
                     2: grra[lIndex] := strtoint(lNumStr);
                     else gBra[lIndex] := strtoint(lNumStr);

                  end; //case lZ
                end; //for lZ r,g,b loops

              end; //for lIndex 0..255 loops
              lIndex := 0;
       filemode := 1;
       lZ := 256;
       AssignFile(lFData, 'C:\Documents and Settings\Chris\My Documents\imagen\newlut.lut');
       Rewrite(lFData,1);
       BlockWrite(lFdata, gRra[1], lZ);   //red
       BlockWrite(lFdata, gGra[1], lZ); //blue
       BlockWrite(lFdata, gBra[1], lZ); //green
       //BlockWrite(lFdata, lBuff^, lZ);
       CloseFile(lFData);
       exit;
   (*end - PaintShopPro format*)

  (* begin Osiris format reader *)

       //if EOF(lF) then
         //do not start reading
       //else repeat
  while not EOF(lF) do
  begin
    read(lF, lCh);
    if lCh = '*' then //comment character
      while (not EOF(lF)) and (lCh <> kCR) and (lCh <> UNIXeoln) do
        read(lF, lCh);
    if (lCh = 'L') or (lCh = 'l') then
    begin
      lType := true;
      lLong := true;
    end; //'l'
    if (lCh = 's') or (lCh = 'S') then
    begin
      lType := true;
      lLong := false;
    end; //'s'
    if lCh in ['0'..'9'] then
      lNumStr := lNumStr + lCh;
    //note on next line: revised 9/9/2003: will read final line of text even if EOF instead of EOLN for final index
    if ((not (lCh in ['0'..'9'])) or (EOF(lF))) and (length(lNumStr) > 0) then
    begin //not a number = space??? try to read number string
      if not lIndx then
      begin
        lIndex := strtoint(lNumStr);
        lIndx := true;
      end
      else
      begin //not index
        if lLong then
          lByte := trunc(strtoint(lNumStr) / 256)
        else
          lByte := strtoint(lNumStr);
        if not lR then
        begin
          lRed := lByte;
          lR := true;
        end
        else if not lG then
        begin
          lGreen := lByte;
          lG := true;
        end
        else if not lB then
        begin
          lBlue := lByte;
          //if (lIndex > 253) then showmessage(inttostr(lIndex));
          lB := true;
          gRra[lIndex] := lRed;
          gGra[lIndex] := lGreen;
          gBra[lIndex] := lBlue;
          //if lIndex = 236 then showmessage(inttostr(lBlue));
          ResetBools;
        end;
      end;
      lNumStr := '';
    end;
  end;
  //until EOF(lF); //not eof
(*end osiris reader  *)
{write as ImageJ format
  filemode := 1;
  lZ := 256;
  AssignFile(lFData, 'C:\Documents and Settings\Chris\My Documents\imagen\cortex.lut');
  Rewrite(lFData,1);
  BlockWrite(lFdata, gRra[1], lZ);   //red
  BlockWrite(lFdata, gGra[1], lZ); //blue
  BlockWrite(lFdata, gBra[1], lZ); //green
  CloseFile(lFData);
{end write}
  gMaxRGB := (gRra[255] + (gGra[255] shl 8) + (gBra[255] shl 16));
  gMinRGB := (gRra[0] + (gGra[0] shl 8) + (gBra[0] shl 16));
  closefile(lF);
  filemode := 2;
end;

procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
//release dynamic memory
begin
  gDynStr := '';
  gSelectRect := rect(0, 0, 0, 0);
  gSelectOrigin.X := -1;
  Action := caFree;
  MainForm.ColUpdate;
  gStringList.Free; //rev20
  ReleaseDICOMmemory;
  MainForm.UpdateMenuItems(nil);
end;

procedure TMDIChild.FormCreate(Sender: TObject);
//Initialize form
begin
  gSmooth := false;
  Smooth1.Checked := gSmooth;
  gMultiRow := 1;
  gMultiCol := 1;
  BackupBitmap := nil;
  gScheme := 1;
  gWinCen := 0;
  gWinWid := 0;
  gStringList := TStringList.Create;
  gFileListSz := 0;
  gCurrentPosInFileList := -1;
  gBuff16sz := 0;
  gVideoSpeed := 0;
  gBuff8sz := 0;
  FFileName := '';
  gContrastStr := '';
  gDICOMdata.Allocbits_per_pixel := 0;
  gCustomPalette := 0;
  gMinHt := 10;
  gMinWid := 10;
  gDICOMData.XYZdim[1] := 0;
  gDICOMData.XYZdim[2] := 0;
  g100PctImageWid := 0;
  g100PctImageHt := 0;
  gZoomPct := 100;
  //for lInc := 0 to 255 do
  //    gRGBquadRA[lInc].rgbReserved := 0;