childwin.~pas

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

  lBuff: ByteP0;
  lPGwid, lPGHt, lBits: integer;
  procedure ScaleStretch(lSrcHt, lSrcWid: integer; lInXYRatio: single);
  var
    lKScale: byte;
    lrRA, lbRA, lgRA: array[0..255] of byte;
    //lBuff: ByteP0;
    lPos, xP, yP, yP2, xP2, t, z, z2, iz2, w1, w2, w3, w4, lTopPos, lBotPos,
      lINSz, lDstWidM, {lDstWid,lDstHt,} x, y, lLT, lLB, lRT, lRB: integer;
    lXRatio, lYRatio: single;
  begin
    yP := 0;
    lXRatio := lInXYRatio;
    lYRatio := lInXYRatio;
    lInSz := lSrcWid * lSrcHt;
    lPGwid := {round} round(lSrcWid * lXRatio); //*lZoom;
    lPGHt := {round} round(lSrcHt * lYRatio); //*lZoom;
    lkScale := 1;
    xP2 := ((lSrcWid - 1) shl 15) div (lPGWid - 1);
    yP2 := ((lSrcHt - 1) shl 15) div (lPGHt - 1);
    lPos := 0;
    lDstWidM := lPGWid - 1;
    if lBIts = 24 then
    begin
      getmem(lBuff, lPGHt * lPGWid * 3);
      lInSz := lInSz * 3; //24bytesperpixel
      for y := 0 to lPGHt - 1 do
      begin
        xP := 0;
        lTopPos := lSrcWid * (yP shr 15) * 3; //top row
        if yP shr 16 < lSrcHt - 1 then
          lBotPos := lSrcWid * (yP shr 15 + 1) * 3 //bottom column
        else
          lBotPos := lTopPos;
        z2 := yP and $7FFF;
        iz2 := $8000 - z2;
        x := 0;
        while x < lPGWid do
        begin
          t := (xP shr 15) * 3;
          if ((lBotPos + t + 6) > lInSz) or ((lTopPos + t) < 0) then
          begin
            lBuff[lPos] := 0;
            inc(lPos); //reds
            lBuff[lPos] := 0;
            inc(lPos); //greens
            lBuff[lPos] := 0;
            inc(lPos); //blues
          end
          else
          begin
            z := xP and $7FFF;
            w2 := (z * iz2) shr 15;
            w1 := iz2 - w2;
            w4 := (z * z2) shr 15;
            w3 := z2 - w4;
            lBuff[lPos] := (lInBuff[lTopPos + t] * w1 + lInBuff[lTopPos + t + 3] * w2
              + lInBuff[lBotPos + t] * w3 + lInBuff[lBotPos + t + 3] * w4) shr 15;
            inc(lPos); //reds
            lBuff[lPos] := (lInBuff[lTopPos + t + 1] * w1 + lInBuff[lTopPos + t + 4] * w2
              + lInBuff[lBotPos + t + 1] * w3 + lInBuff[lBotPos + t + 4] * w4) shr 15;
            inc(lPos); //greens
            lBuff[lPos] := (lInBuff[lTopPos + t + 2] * w1 + lInBuff[lTopPos + t + 5] * w2
              + lInBuff[lBotPos + t + 2] * w3 + lInBuff[lBotPos + t + 5] * w4) shr 15;
            inc(lPos); //blues
          end;
          Inc(xP, xP2);
          inc(x);
        end; //inner loop
        Inc(yP, yP2);
      end;
    end
    else if gCustomPalette > 0 then
    begin //<>24bits,custompal
      lBits := 24;
      for y := 0 to 255 do
      begin
        lrRA[y] := grRA[y];
        lgra[y] := ggRA[y];
        lbra[y] := gbRA[y];
      end;
      getmem(lBuff, lPGHt * lPGWid * 3);
      for y := 0 to lPGHt - 1 do
      begin
        xP := 0;
        lTopPos := lSrcWid * (yP shr 15); //Line1
        if yP shr 16 < lSrcHt - 1 then
          lBotPos := lSrcWid * (yP shr 15 + 1) //Line2
        else
          lBotPos := lTopPos; //lSrcWid *(yP shr 15);
        z2 := yP and $7FFF;
        iz2 := $8000 - z2;
        x := 0;
        while x < lPGWid do
        begin
          t := xP shr 15;
          if ((lBotPos + t + 2) > lInSz) or ((lTopPos + t {-1}) < 0) then
          begin
            lLT := 0;
            lRT := 0;
            lLB := 0;
            lRB := 0;
          end
          else
          begin
            lLT := lInBuff[lTopPos + t];
            lRT := lInBuff[lTopPos + t + 1];
            lLB := lInBuff[lBotPos + t];
            lRB := lInBuff[lBotPos + t + 1];
          end;
          z := xP and $7FFF;
          w2 := (z * iz2) shr 15;
          w1 := iz2 - w2;
          w4 := (z * z2) shr 15;
          w3 := z2 - w4;
          lBuff[lPos] := (lrRA[lLT] * w1 + lrRA[lRT] * w2
            + lrRA[lLB] * w3 + lrRA[lRB] * w4) shr 15;
          inc(lPos);
          lBuff[lPos] := (lgRA[lLT] * w1 + lgRA[lRT] * w2
            + lgRA[lLB] * w3 + lgRA[lRB] * w4) shr 15;
          inc(lPos);
          lBuff[lPos] := (lbRA[lLT] * w1 + lbRA[lRT] * w2
            + lbRA[lLB] * w3 + lbRA[lRB] * w4) shr 15;
          inc(lPos);
          Inc(xP, xP2);
          inc(x);
        end; //inner loop
        Inc(yP, yP2);
      end;
    end
    else
    begin //<>24bits,custompal
      getmem(lBuff, lPGHt * lPGWid {*3});
      for y := 0 to lPGHt - 1 do
      begin
        xP := 0;
        lTopPos := lSrcWid * (yP shr 15); //Line1
        if yP shr 16 < lSrcHt - 1 then
          lBotPos := lSrcWid * (yP shr 15 + 1) //Line2
        else
          lBotPos := lTopPos; //lSrcWid *(yP shr 15);
        z2 := yP and $7FFF;
        iz2 := $8000 - z2;
        //      for x:=0 to lDstWid-1 do begin
        x := 0;
        while x < lPGWid do
        begin
          t := xP shr 15;
          if ((lBotPos + t + 2) > lInSz) or ((lTopPos + t {-1}) < 0) then
          begin
            lLT := 0;
            lRT := 0;
            lLB := 0;
            lRB := 0;
          end
          else
          begin
            lLT := lInBuff[lTopPos + t {+1}];
            lRT := lInBuff[lTopPos + t {+2} + 1];
            lLB := lInBuff[lBotPos + t {+1}];
            lRB := lInBuff[lBotPos + t {+2} + 1];
          end;
          z := xP and $7FFF;
          w2 := (z * iz2) shr 15;
          w1 := iz2 - w2;
          w4 := (z * z2) shr 15;
          w3 := z2 - w4;
          lBuff[lPos] := (lLT * w1 + lRT * w2
            + lLB * w3 + lRB * w4) shr 15;
          inc(lPos);
          Inc(xP, xP2);
          inc(x);
        end; //inner loop
        Inc(yP, yP2);
      end;
    end; //<>24bits,custompal
  end;
var
  //lStartTime, lEndTime: DWord;
  lBufferUsed: boolean;
  PixMap: pointer;
  Bmp: TBitmap;
  hBmp: HBITMAP;
  BI: PBitmapInfo;
  BIH: TBitmapInfoHeader;
  lSlope, lScale: single;
  lPixmapInt, lBuffInt: integer;
  ImagoDC: hDC;
  lByteRA: array[0..255] of byte;
  lRow: pRGBTripleArray;
  lWinScaleShl16,
    lWinC, lWinW, lMinPal, lMaxPal, lL, lTemp, lHt, lWid, I, J, lScanLineSz, lScanLineSz8: integer;
begin
  gLine.Left := -666;
  gLineLenMM := 0;
  FreeBackupBitmap;
  lScale := gZoomPct / 100;
  lBits := lInBits;
  {rotate}

  if (lScale = 1) or (not gSmooth) then
  begin
    lPGWid := lInPGWid;
    lPGHt := lInPGHt;
    lBuff := @lInBuff^;
    lBufferUsed := false;
  end
  else
  begin
    lBufferUsed := true;
    ScaleStretch(lInPGHt, lInPGWid, lScale);
  end;
  if (lBits = 24) {or (lBits = 25)} then
  begin
    if (TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.RLERedSz <> 0) or
      (TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.SamplesPerPixel > 1) or
      (TMDIChild(MainForm.ActiveMDIChild).gCustomPalette > 0) then
    begin
      lWinC := gWinCen;
      lWinW := gWinWid;
      //lStartTime := GetTickCount;
      if ((lWinC = 127) and (lWinW = 255)) or (lWinW = 0) then
        //scaling not required
      else
      begin
        if not lBufferUsed then
        begin
          getmem(lBuff, lPGHt * lPGWid * 3);
          CopyMemory(Pointer(lBuff), Pointer(lInBuff), lPGHt * lPGWid * 3);
          lBufferUsed := true;
        end;
        lWinScaleShl16 := 1 shl 16;
        lWinScaleShl16 := round(lWinScaleShl16 * (256 / lWinW));
        for lL := 0 to 255 do
        begin //lookup buffer for scaling
          lTemp := lL - lWinC;
          lTemp := (lTemp * lWinScaleShl16);
          lTemp := lTemp div 65536;
          lTemp := 128 + lTemp;
          if lTemp < 0 then
            lTemp := 0
          else if lTemp > 255 then
            lTemp := 255;
          lByteRA[lL] := lTemp;
        end;
        J := (lPGWid * lPGHt * 3) - 1;
        for lL := 0 to J do
        begin
          lBuff[lL] := lByteRA[lBuff[lL]];

        end;
      end; //scaling required
      //self.caption :=('update(ms): '+inttostr(GetTickCount-lStartTime)); //70 ms
    end;
    BMP := TBitmap.Create;
    lL := 0;
    try
      BMP.PixelFormat := pf24bit;
      BMP.Width := lPGwid;
      BMP.Height := lPGHt;
      if lBuff <> nil then
      begin
        //if VertFlipItem.checked then
        //   J := BMP.Height-1
        //else
        J := 0;
        repeat
          lRow := BMP.Scanline[j];
          {if HorFlipItem.checked then begin
            FOR i := BMP.Width-1 downto 0 DO BEGIN
                WITH lRow[i] DO BEGIN
                  rgbtRed    := lBuff[lL];
                  inc(lL);
                  rgbtGreen := lBuff[lL];
                  inc(lL);
                  rgbtBlue  := lBuff[lL];
                  inc(lL);
               END //with row
            END;  //for width
          end else begin //horflip {}
          for i := 0 to BMP.Width - 1 do
          begin
            with lRow[i] do
            begin
              rgbtRed := lBuff[lL];
              inc(lL);
              rgbtGreen := lBuff[lL];
              inc(lL);
              rgbtBlue := lBuff[lL];
              inc(lL);
            end //with row
          end; //for width
          //end; //horflip
            //if VertFlipItem.checked then
            //   Dec(J)
            //else
          Inc(J)
        until (J < 0) or (J >= BMP.Height); //for J
      end;
      Image.Picture.Graphic := BMP;
    finally
      BMP.Free;
    end;
    if (lBufferUsed) then //alpha1415ABBA: required
      freemem(lBuff);
    exit;
  end; //24bit
  BIH.biSize := Sizeof(BIH);
  BIH.biWidth := lPGwid;
  BIH.biHeight := lPGHt;
  BIH.biPlanes := 1;
  BIH.biBitCount := 8; //lBits
  BIH.biCompression := BI_RGB;
  BIH.biSizeImage := 0;
  BIH.biXPelsPerMeter := 0;
  BIH.biYPelsPerMeter := 0;
  BIH.biClrUsed := 0;
  BIH.biClrImportant := 0;
{$P+,S-,W-,R-}
  BI := AllocMem(SizeOf(TBitmapInfoHeader) + 256 * Sizeof(TRGBQuad));
  BI^.bmiHeader := BIH;




  if (TMDIChild(MainForm.ActiveMDIChild).gCustomPalette > 0) and (gWinWid > 0) then
  begin
    lWinC := gWinCen;
    lWinW := gWinWid;
    lWinScaleShl16 := 1 shl 16;
    lWinScaleShl16 := round(lWinScaleShl16 * (256 / lWinW));
    for lL := 0 to 255 do
    begin
      lTemp := gRra[lL] - lWinC;
      lTemp := (lTemp * lWinScaleShl16);
      lTemp := lTemp div 65536;
      lTemp := 128 + lTemp;
      if lTemp < 0 then
        lTemp := 0
      else if lTemp > 255 then
        lTemp := 255;
      BI^.bmiColors[lL].rgbRed := lTemp;
      lTemp := gGra[lL] - lWinC;
      lTemp := (lTemp * lWinScaleShl16);
      lTemp := lTemp div 65536;
      lTemp := 128 + lTemp;
      if lTemp < 0 then
        lTemp := 0
      else if lTemp > 255 then
        lTemp := 255;
      BI^.bmiColors[lL].rgbGreen := lTemp;
      lTemp := gBra[lL] - lWinC;
      lTemp := (lTemp * lWinScaleShl16);
      lTemp := lTemp div 65536;
      lTemp := 128 + lTemp;
      if lTemp < 0 then
        lTemp := 0
      else if lTemp > 255 then
        lTemp := 255;
      BI^.bmiColors[lL].rgbBlue := lTemp;
      BI^.bmiColors[lL].rgbReserved := 0;
    end;
  end
  else if (lUseWinCenWid) and (gWinWid > 0) then
  begin
    lMinPal := gWinCen - (gWinWid shr 1);
    lMaxPal := lMinPal + gWinWid;
    lSlope := 255 / gWinWid;
    if (lMinPal < 0) or (lMinPal > 255) then
      lMinPal := 0;
    if (lMaxPal < 0) or (lMaxPal > 255) then
      lMaxPal := 255;
    for I := 0 to lMinPal do
    begin
      BI^.bmiColors[I].rgbRed := gRra[0];
      BI^.bmiColors[I].rgbGreen := gGra[0];
      BI^.bmiColors[I].rgbBlue := gBra[0];
      BI^.bmiColors[I].rgbReserved := 0;
    end;
    for I := lMaxPal to 255 do
    begin
      BI^.bmiColors[I].rgbRed := gRra[255];
      BI^.bmiColors[I].rgbGreen := gGra[255];
      BI^.bmiColors[I].rgbBlue := gBra[255];
      BI^.bmiColors[I].rgbReserved := 0;
    end;
    if (lMinPal + 1) < (lMaxPal) then
    begin
      for I := (lMinPal + 1) to (lMaxPal - 1) do
      begin
        J := 128 + round(lSLope * (I - gWinCen));
        if J < 0 then
          J := 0
        else if J > 255 then
          J := 255;
        BI^.bmiColors[I].rgbRed := gRra[J];
        BI^.bmiColors[I].rgbGreen := gGra[J];
        BI^.bmiColors[I].rgbBlue := gBra[J];
        BI^.bmiColors[I].rgbReserved := 0;
      end;
    end;
  end
  else
  begin //use wincen/wid
    for I := 0 to 255 do
    begin
      BI^.bmiColors[I].rgbRed := gRra[i];
      BI^.bmiColors[I].rgbGreen := gGra[i];
      BI^.bmiColors[I].rgbBlue := gBra[i];
      BI^.bmiColors[I].rgbReserved := 0;