Recent

Author Topic: Converter o seguinte código  (Read 5343 times)

andrejsilva

  • New Member
  • *
  • Posts: 14
Converter o seguinte código
« on: February 24, 2009, 01:20:55 pm »
Olá pessoal será que alguem poderia me ajudar a converter o código abaixo, se possível multiplataforma, é para um componente q estou tentando converter para o lazarus,
inclusive já tenho vários componentes lazarus funcionando, se alguém tiver interesse é só contatar.

MSN: gasperfantasminha@hotmail.com



procedure TfrmFreeBoletoImg.BltTBitmapAsDib(DestDc: hdc; x, y, Width, Height: integer; bm: TBitmap);
type
  PPalEntriesArray = ^TPalEntriesArray; {for palette re-construction}
  TPalEntriesArray = array[0..0] of TPaletteEntry;
var
  OriginalWidth: LongInt; {width of BM}
  dc: hdc; {screen dc}
  IsPaletteDevice: bool; {if the device uses palettes}
  IsDestPaletteDevice: bool; {if the device uses palettes}
  BitmapInfoSize: integer; {sizeof the bitmapinfoheader}
  lpBitmapInfo: PBitmapInfo; {the bitmap info header}
  hBm: hBitmap; {handle to the bitmap}
  hPal: hPalette; {handle to the palette}
  OldPal: hPalette; {temp palette}
  hBits: THandle; {handle to the DIB bits}
  pBits: pointer; {pointer to the DIB bits}
  lPPalEntriesArray: PPalEntriesArray; {palette entry array}
  NumPalEntries: integer; {number of palette entries}
  i: integer; {looping variable}
begin
{If range checking is on - lets turn it off for now}
{we will remember if range checking was on by defining}
{a define called CKRANGE if range checking is on.}
{We do this to access array members past the arrays}
{defined index range without causing a range check}
{error at runtime. To satisfy the compiler, we must}
{also access the indexes with a variable. ie: if we}
{have an array defined as a: array[0..0] of byte,}
{and an integer i, we can now access a[3] by setting}
{i := 3; and then accessing a without error}
//{$IFOPT R+}
// {$DEFINE CKRANGE}
// {$R-}
//{$ENDIF}

 {Save the original width of the bitmap}
  OriginalWidth := bm.Width;

 {Get the screen's dc to use since memory dc's are not reliable}
  dc := GetDc(0);

 {Are we a palette device?}
  IsPaletteDevice := GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;

 {Give back the screen dc}
 {dc := } ReleaseDc(0, dc);

 {Allocate the BitmapInfo structure}
  if IsPaletteDevice then
    BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255)
  else
    BitmapInfoSize := sizeof(TBitmapInfo);

  GetMem(lpBitmapInfo, BitmapInfoSize);

 {Zero out the BitmapInfo structure}
  FillChar(lpBitmapInfo^, BitmapInfoSize, #0);

 {Fill in the BitmapInfo structure}
  lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);
  lpBitmapInfo^.bmiHeader.biWidth := OriginalWidth;
  lpBitmapInfo^.bmiHeader.biHeight := bm.Height;
  lpBitmapInfo^.bmiHeader.biPlanes := 1;

  if IsPaletteDevice then
    lpBitmapInfo^.bmiHeader.biBitCount := 8
  else
    lpBitmapInfo^.bmiHeader.biBitCount := 24;
  lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;
  lpBitmapInfo^.bmiHeader.biSizeImage := ((lpBitmapInfo^.bmiHeader.biWidth *
    longint(lpBitmapInfo^.bmiHeader.biBitCount)) div 8) *
    lpBitmapInfo^.bmiHeader.biHeight;
  lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;
  lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;

  if IsPaletteDevice then
  begin
    lpBitmapInfo^.bmiHeader.biClrUsed := 256;
    lpBitmapInfo^.bmiHeader.biClrImportant := 256;
  end
  else
  begin
    lpBitmapInfo^.bmiHeader.biClrUsed := 0;
    lpBitmapInfo^.bmiHeader.biClrImportant := 0;
  end;

 {Take ownership of the bitmap handle and palette}
  hBm := bm.ReleaseHandle;
  hPal := bm.ReleasePalette;

 {Get the screen's dc to use since memory dc's are not reliable}
  dc := GetDc(0);

  if IsPaletteDevice then
  begin
   {If we are using a palette, it must be}
   {selected into the dc during the conversion}
    //OldPal := SelectPalette(dc, hPal, TRUE);
   {Realize the palette}
    RealizePalette(dc);
  end;

 {Tell GetDiBits to fill in the rest of the bitmap info structure}
  GetDiBits(dc, hBm, 0, lpBitmapInfo^.bmiHeader.biHeight, nil, TBitmapInfo(lpBitmapInfo^), DIB_RGB_COLORS);

 {Allocate memory for the Bits}
  hBits := GlobalAlloc(GMEM_MOVEABLE, lpBitmapInfo^.bmiHeader.biSizeImage);
  pBits := GlobalLock(hBits);

 {Get the bits}

  GetDiBits(dc, hBm, 0, lpBitmapInfo^.bmiHeader.biHeight, pBits, TBitmapInfo(lpBitmapInfo^), DIB_RGB_COLORS);

  if IsPaletteDevice then
  begin
   {Lets fix up the color table for buggy video drivers}
    GetMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);
{$IFDEF VER100}
    NumPalEntries := GetPaletteEntries(hPal, 0, 256, lPPalEntriesArray^);
{$ELSE}
    NumPalEntries := GetSystemPaletteEntries(dc, 0, 256, lPPalEntriesArray^);
{$ENDIF}
    for i := 0 to (NumPalEntries - 1) do
    begin
      lpBitmapInfo^.bmiColors.rgbRed :=
        lPPalEntriesArray^.peRed;
      lpBitmapInfo^.bmiColors.rgbGreen :=
        lPPalEntriesArray^.peGreen;
      lpBitmapInfo^.bmiColors.rgbBlue :=
        lPPalEntriesArray^.peBlue;
    end;
    FreeMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);
  end;

  oldPal := hPal;
  if IsPaletteDevice then
  begin
   {Select the old palette back in}
    SelectPalette(dc, OldPal, TRUE);
   {Realize the old palette}
    RealizePalette(dc);
  end;

 {Give back the screen dc}
  {dc := } ReleaseDc(0, dc);
 {Is the Dest dc a palette device?}
  IsDestPaletteDevice := GetDeviceCaps(DestDc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
  if IsPaletteDevice then
  begin
   {If we are using a palette, it must be}
   {selected into the dc during the conversion}
    OldPal := SelectPalette(DestDc, hPal, TRUE);
   {Realize the palette}
    RealizePalette(DestDc);
  end;

 {Do the blt}
  StretchDiBits(DestDc, x, y, Width, Height, 0, 0, OriginalWidth, lpBitmapInfo^.bmiHeader.biHeight, pBits, lpBitmapInfo^, DIB_RGB_COLORS, SrcCopy);

  if IsDestPaletteDevice then
  begin
   {Select the old palette back in}
    SelectPalette(DestDc, OldPal, TRUE);
   {Realize the old palette}
    RealizePalette(DestDc);
  end;

 {De-Allocate the Dib Bits}
  GlobalUnLock(hBits);
  GlobalFree(hBits);
 {De-Allocate the BitmapInfo}
  FreeMem(lpBitmapInfo, BitmapInfoSize);
 {Set the ownership of the bimap handles back to the bitmap}
  bm.Handle := hBm;
  bm.Palette := hPal;

  {Turn range checking back on if it was on when we started}
//{$IFDEF CKRANGE}
// {$UNDEF CKRANGE}
// {$R+}
//{$ENDIF}
end; 

LazaruX

  • Hero Member
  • *****
  • Posts: 597
  • Lazarus original cheetah.The cheetah doesn't cheat
Re: Converter o seguinte código
« Reply #1 on: February 24, 2009, 03:11:33 pm »
The translation should sound something like:

Hi, is there anybody that could help me to convert the code below, if possible multiplatform, its for a comopnent that I am trying to convert to Lazaris.
I have various components in Lazarus working, if anybody is interested, contact me please

Marc

  • Administrator
  • Hero Member
  • *
  • Posts: 2496
Re: Converter o seguinte código
« Reply #2 on: February 25, 2009, 12:17:54 am »
Skip all palette stuff (or comment out) and use GetMem for GlobalAlloc/GlobalLock
Then the code should work in lazarus.
//--
{$I stdsig.inc}
//-I still can't read someones mind
//-Bugs reported here will be forgotten. Use the bug tracker