⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frxexportimage.pas

📁 这个是功能强大的报表软件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
    FBitmap.Free;
  end;
end;

function TfrxCustomImageExport.SizeOverflow(const Val: Extended): Boolean;
begin
  Result :=  Val > MAX_TBITMAP_HEIGHT;
end;

{ TfrxIMGExportDialog }

procedure TfrxIMGExportDialog.FormCreate(Sender: TObject);
begin
  Caption := frxGet(8600);
  OK.Caption := frxGet(1);
  Cancel.Caption := frxGet(2);
  GroupPageRange.Caption := frxGet(7);
  AllRB.Caption := frxGet(3);
  CurPageRB.Caption := frxGet(4);
  PageNumbersRB.Caption := frxGet(5);
  DescrL.Caption := frxGet(9);
  GroupBox1.Caption := frxGet(8601);
  Label2.Caption := frxGet(8602);
  Label1.Caption := frxGet(8603);
  SeparateCB.Caption := frxGet(8604);
  CropPage.Caption := frxGet(8605);
  Mono.Caption := frxGet(8606);

  if UseRightToLeftAlignment then
    FlipChildren(True);
end;

procedure TfrxIMGExportDialog.SetFilter(const Value: TfrxCustomImageExport);
begin
  FFilter := Value;
  SaveDialog1.Filter := FFilter.FilterDesc;
  SaveDialog1.DefaultExt := FFilter.DefaultExt;
end;


{ TfrxBMPExport }

constructor TfrxBMPExport.Create(AOwner: TComponent);
begin
  inherited;
  FilterDesc := frxResources.Get('BMPexportFilter');
  DefaultExt := '.bmp';
end;

class function TfrxBMPExport.GetDescription: String;
begin
  Result := frxResources.Get('BMPexport');
end;

procedure TfrxBMPExport.Save;
begin
  inherited;
  if Stream <> nil then
    FBitmap.SaveToStream(Stream)
  else
    FBitmap.SaveToFile(ChangeFileExt(FileName, FFileSuffix + '.bmp'));
end;


{ TfrxTIFFExport }

constructor TfrxTIFFExport.Create(AOwner: TComponent);
begin
  inherited;
  FilterDesc := frxResources.Get('TIFFexportFilter');
  DefaultExt := '.tif';
end;

class function TfrxTIFFExport.GetDescription: String;
begin
  Result := frxResources.Get('TIFFexport');
end;

procedure TfrxTIFFExport.Save;
var
  TFStream: TFileStream;
begin
  inherited;
  try
    if Stream <> nil then
      SaveTiffToStream(Stream, FBitmap)
    else
    begin
      TFStream := TFileStream.Create(ChangeFileExt(FileName, FFileSuffix + '.tif'), fmCreate);
      try
        SaveTiffToStream(TFStream, FBitmap);
      finally
        TFStream.Free;
      end;
    end;
  except
    on e: Exception do
      case Report.EngineOptions.NewSilentMode of
        simSilent:        Report.Errors.Add(e.Message);
        simMessageBoxes:  frxErrorMsg(e.Message);
        simReThrow:       raise;
      end;
  end;
end;

procedure TfrxTIFFExport.SaveTIFFToStream(const Stream: TStream; const Bitmap: TBitmap);
var
  i, k: Integer;
  dib_f: Boolean;
  Header, Bits, BitsPtr, TmpBitsPtr, NewBits: PAnsiChar;
  HeaderSize, BitsSize: DWORD;
  Width, Height, DataWidth, BitCount: Integer;
  MapRed, MapGreen, MapBlue: array[0..255, 0..1] of Byte;
  ColTabSize, BmpWidth: Integer;
  Red, Blue, Green: AnsiChar;
  O_XRes, O_YRes, O_Soft, O_Strip, O_Dir, O_BPS: LongInt;
  RGB: Word;
  Res: Word;
  NoOfDirs: array[0..1] of Byte;
  D_BW: array[0..13] of TDirEntry;
  D_COL: array[0..14] of TDirEntry;
  D_RGB: array[0..14] of TDirEntry;
  Res_Value: array[0..7] of Byte;
begin
  if Bitmap.Handle = 0 then Exit;
  NoOfDirs[1] := 0;
  Res := FResolution * 10;
  Res_Value[0] := Res and $00ff;
  Res_Value[1] := (Res and $ff00) shr 8;
  Res_Value[2] := 0;
  Res_Value[3] := 0;
  Res_Value[4] := $0A;
  Res_Value[5] := 0;
  Res_Value[6] := 0;
  Res_Value[7] := 0;
  GetDIBSizes(Bitmap.Handle, HeaderSize, BitsSize);
  Header := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE, HeaderSize + BitsSize);
  try
    Bits := Header + HeaderSize;
    dib_f := GetDIB(Bitmap.Handle, Bitmap.Palette, Header^, Bits^);
    if dib_f then
    begin
      Width := PBITMAPINFO(Header)^.bmiHeader.biWidth;
      Height := PBITMAPINFO(Header)^.bmiHeader.biHeight;
      BitCount := PBITMAPINFO(Header)^.bmiHeader.biBitCount;
      NoOfDirs[0] := $0F;
      ColTabSize := (1 shl BitCount);
      BmpWidth := Trunc(BitsSize / Height);
      Stream.Write(TifHeader, sizeof(TifHeader));
      if BitCount = 1 then
      begin
        CopyMemory(@D_BW, @D_BW_C, SizeOf(D_BW));
        NoOfDirs[0] := $0E;
        O_XRes := Stream.Position;
        Stream.Write(Res_Value, sizeof(Res_Value));
        O_YRes := Stream.Position;
        Stream.Write(Res_Value, sizeof(Res_Value));
        O_Soft := Stream.Position;
        Stream.Write(Software, sizeof(Software));
        DataWidth := ((Width + 7) div 8);
        O_Strip := Stream.Position;
        if Height < 0 then
          for i := 0 to Height - 1 do
          begin
            BitsPtr := Bits + i * BmpWidth;
            Stream.Write(BitsPtr^, DataWidth);
          end
        else
          for i := 1 to Height do
          begin
            BitsPtr := Bits + (Height - i) * BmpWidth;
            Stream.Write(BitsPtr^, DataWidth);
          end;
        Stream.Write(NullString, sizeof(NullString));
        D_BW[1]._Value := LongInt(Width);
        D_BW[2]._Value := LongInt(abs(Height));
        D_BW[8]._Value := LongInt(abs(Height));
        D_BW[9]._Value := LongInt(DataWidth * abs(Height));
        D_BW[6]._Value := O_Strip;
        D_BW[10]._Value := O_XRes;
        D_BW[11]._Value := O_YRes;
        D_BW[13]._Value := O_Soft;
        O_Dir := Stream.Position;
        Stream.Write(NoOfDirs, sizeof(NoOfDirs));
        Stream.Write(D_BW, sizeof(D_BW));
        Stream.Write(NullString, sizeof(NullString));
        Stream.Seek(4, soFromBeginning);
        Stream.Write(O_Dir, sizeof(O_Dir));
      end;
      if BitCount in [4, 8] then
      begin
        CopyMemory(@D_COL, @D_COL_C, SizeOf(D_COL));
        DataWidth := Width;
        if BitCount = 4 then
        begin
          Width := (Width div BitCount) * BitCount;
          if BitCount = 4 then
            DataWidth := Width div 2;
        end;
        D_COL[1]._Value := LongInt(Width);
        D_COL[2]._Value := LongInt(abs(Height));
        D_COL[3]._Value := LongInt(BitCount);
        D_COL[8]._Value := LongInt(Height);
        D_COL[9]._Value := LongInt(DataWidth * abs(Height));
        for i := 0 to ColTabSize - 1 do
        begin
          MapRed[i][1] := PBITMAPINFO(Header)^.bmiColors[i].rgbRed;
          MapRed[i][0] := 0;
          MapGreen[i][1] := PBITMAPINFO(Header)^.bmiColors[i].rgbGreen;
          MapGreen[i][0] := 0;
          MapBlue[i][1] := PBITMAPINFO(Header)^.bmiColors[i].rgbBlue;
          MapBlue[i][0] := 0;
        end;
        D_COL[14]._Count := LongInt(ColTabSize * 3);
        Stream.Write(MapRed, ColTabSize * 2);
        Stream.Write(MapGreen, ColTabSize * 2);
        Stream.Write(MapBlue, ColTabSize * 2);
        O_XRes := Stream.Position;
        Stream.Write(Res_Value, sizeof(Res_Value));
        O_YRes := Stream.Position;
        Stream.Write(Res_Value, sizeof(Res_Value));
        O_Soft := Stream.Position;
        Stream.Write(Software, sizeof(Software));
        O_Strip := Stream.Position;
        if Height < 0 then
          for i := 0 to Height - 1 do
          begin
            BitsPtr := Bits + i * BmpWidth;
            Stream.Write(BitsPtr^, DataWidth);
          end
        else
          for i := 1 to Height do
          begin
            BitsPtr := Bits + (Height - i) * BmpWidth;
            Stream.Write(BitsPtr^, DataWidth);
          end;
        D_COL[6]._Value := O_Strip;
        D_COL[10]._Value := O_XRes;
        D_COL[11]._Value := O_YRes;
        D_COL[13]._Value := O_Soft;
        O_Dir := Stream.Position;
        Stream.Write(NoOfDirs, sizeof(NoOfDirs));
        Stream.Write(D_COL, sizeof(D_COL));
        Stream.Write(NullString, sizeof(NullString));
        Stream.Seek(4, soFromBeginning);
        Stream.Write(O_Dir, sizeof(O_Dir));
      end;
      if BitCount = 16 then
      begin
        CopyMemory(@D_RGB, @D_RGB_C, SizeOf(D_RGB));
        D_RGB[1]._Value := LongInt(Width);
        D_RGB[2]._Value := LongInt(Height);
        D_RGB[8]._Value := LongInt(Height);
        D_RGB[9]._Value := LongInt(3 * Width * Height);
        O_XRes := Stream.Position;
        Stream.Write(Res_Value, sizeof(Res_Value));
        O_YRes := Stream.Position;
        Stream.Write(Res_Value, sizeof(Res_Value));
        O_BPS := Stream.Position;
        Stream.Write(BitsPerSample, sizeof(BitsPerSample));
        O_Soft := Stream.Position;
        Stream.Write(Software, sizeof(Software));
        O_Strip := Stream.Position;
        GetMem(NewBits, Width * Height * 3);
        for i := 0 to Height - 1 do
        begin
          BitsPtr := Bits + i * BmpWidth;
          TmpBitsPtr := NewBits + i * Width * 3;
          for k := 0 to Width - 1 do
          begin
            RGB := PWord(BitsPtr)^;
            Blue := AnsiChar((RGB and $1F) shl 3 or $7);
            Green := AnsiChar((RGB shr 5 and $1F) shl 3 or $7);
            Red := AnsiChar((RGB shr 10 and $1F) shl 3 or $7);
            PByte(TmpBitsPtr)^ := Byte(Red);
            PByte(TmpBitsPtr + 1)^ := Byte(Green);
            PByte(TmpBitsPtr + 2)^ := Byte(Blue);
            BitsPtr := BitsPtr + 2;
            TmpBitsPtr := TmpBitsPtr + 3;
          end;
        end;
        for i := 1 to Height do
        begin
          TmpBitsPtr := NewBits + (Height - i) * Width * 3;
          Stream.Write(TmpBitsPtr^, Width * 3);
        end;
        FreeMem(NewBits);
        D_RGB[3]._Value := O_BPS;
        D_RGB[6]._Value := O_Strip;
        D_RGB[10]._Value := O_XRes;
        D_RGB[11]._Value := O_YRes;
        D_RGB[14]._Value := O_Soft;
        O_Dir := Stream.Position;
        Stream.Write(NoOfDirs, sizeof(NoOfDirs));
        Stream.Write(D_RGB, sizeof(D_RGB));
        Stream.Write(NullString, sizeof(NullString));
        Stream.Seek(4, soFromBeginning);
        Stream.Write(O_Dir, sizeof(O_Dir));
      end;
      if BitCount in [24, 32] then
      begin
        CopyMemory(@D_RGB, @D_RGB_C, SizeOf(D_RGB));
        D_RGB[1]._Value := LongInt(Width);
        D_RGB[2]._Value := LongInt(Height);
        D_RGB[8]._Value := LongInt(Height);
        D_RGB[9]._Value := LongInt(3 * Width * Height);
        O_XRes := Stream.Position;
        Stream.Write(Res_Value, sizeof(Res_Value));
        O_YRes := Stream.Position;
        Stream.Write(Res_Value, sizeof(Res_Value));
        O_BPS := Stream.Position;
        Stream.Write(BitsPerSample, sizeof(BitsPerSample));
        O_Soft := Stream.Position;
        Stream.Write(Software, sizeof(Software));
        O_Strip := Stream.Position;
        for i := 0 to Height - 1 do
        begin
          BitsPtr := Bits + i * BmpWidth;
          for k := 0 to Width - 1 do
          begin
            Blue := (BitsPtr)^;
            Red := (BitsPtr + 2)^;
            (BitsPtr)^ := Red;
            (BitsPtr + 2)^ := Blue;
            BitsPtr := BitsPtr + BitCount div 8;
          end;
        end;
        if BitCount = 32 then
          for i := 0 to Height - 1 do
          begin
            BitsPtr := Bits + i * BmpWidth;
            TmpBitsPtr := BitsPtr;
            for k := 0 to Width - 1 do
            begin
              (TmpBitsPtr)^ := (BitsPtr)^;
              (TmpBitsPtr + 1)^ := (BitsPtr + 1)^;
              (TmpBitsPtr + 2)^ := (BitsPtr + 2)^;
              TmpBitsPtr := TmpBitsPtr + 3;
              BitsPtr := BitsPtr + 4;
            end;
          end;
        BmpWidth := Trunc(BitsSize / Height);
        if Height < 0 then
          for i := 0 to Height - 1 do
          begin
            BitsPtr := Bits + i * BmpWidth;
            Stream.Write(BitsPtr^, Width * 3);
          end
        else
          for i := 1 to Height do
          begin
            BitsPtr := Bits + (Height - i) * BmpWidth;
            Stream.Write(BitsPtr^, Width * 3);
          end;
        D_RGB[3]._Value := O_BPS;
        D_RGB[6]._Value := O_Strip;
        D_RGB[10]._Value := O_XRes;
        D_RGB[11]._Value := O_YRes;
        D_RGB[14]._Value := O_Soft;
        O_Dir := Stream.Position;
        Stream.Write(NoOfDirs, sizeof(NoOfDirs));
        Stream.Write(D_RGB, sizeof(D_RGB));
        Stream.Write(NullString, sizeof(NullString));
        Stream.Seek(4, soFromBeginning);
        Stream.Write(O_Dir, sizeof(O_Dir));
      end;
    end;
  finally
    GlobalFreePtr(Header);
  end;
end;


{ TfrxJPEGExport }

constructor TfrxJPEGExport.Create(AOwner: TComponent);
begin
  inherited;
  FilterDesc := frxResources.Get('JPEGexportFilter');
  DefaultExt := '.jpg';
end;

class function TfrxJPEGExport.GetDescription: String;
begin
  Result := frxResources.Get('JPEGexport');
end;

procedure TfrxJPEGExport.Save;
var
  Image: TJPEGImage;
  TFStream: TFileStream;
begin
  inherited;
  try
    if Stream <> nil then
    begin
      Image := TJPEGImage.Create;
      try
        Image.CompressionQuality := FJPEGQuality;
        Image.Assign(FBitmap);
        Image.SaveToStream(Stream);
      finally
        Image.Free;
      end;
    end
    else
    begin
      TFStream := TFileStream.Create(ChangeFileExt(FileName, FFileSuffix + '.jpg'), fmCreate);
      try
        Image := TJPEGImage.Create;
        try
          Image.CompressionQuality := FJPEGQuality;
          Image.Assign(FBitmap);
          Image.SaveToStream(TFStream);
        finally
          Image.Free;
        end;
      finally
        TFStream.Free;
      end;
    end;
  except
    on e: Exception do
      case Report.EngineOptions.NewSilentMode of
        simSilent:        Report.Errors.Add(e.Message);
        simMessageBoxes:  frxErrorMsg(e.Message);
        simReThrow:       raise;
      end;
  end;
end;

{ TfrxGIFExport }

procedure GIFSaveToFile(const FileName: String; const Bitmap: TBitmap);
var
  f: TFileStream;
begin
  f := TFileStream.Create(FileName, fmCreate);
  try
    GIFSaveToStream(f, Bitmap);
  finally
    f.Free;
  end;
end;
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -