Дело все в палитре принтера. Предлагаю модуль с функцией печати битмапа.
Битмап тут вмещается и перемасштабируется, чтоб влезть на страницу бОльшим
размером и разместиться по центру листа. Это ты сам можешь изменить по
своему желанию.

unit UPrint;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Printers;

procedure PrintBitmap(ABitmap: TBitmap);

implementation

procedure PrintBitmap(ABitmap: TBitmap);
var
    B: TBitmap;
    isPrnPal: Boolean;
    Pal, OldPal: hPalette;
    PageWidth, PageHeight: Integer;
    PageMargin: TPoint;
    TestInt: Integer;
    ImagePageWidth: Integer;
    ImagePageHeight: Integer;
    ScaleX, ScaleY, OffsetX, OffsetY: Integer;
    ImageSize, InfoSize: DWord;
    PImage, PInfo: Pointer;
begin
    Pal := 0;
    OldPal := 0;
    Printer.BeginDoc;
    B := TBitmap.Create;
    B.Assign(ABitmap);
    B.PixelFormat := pf24bit;
    isPrnPal := False;
    if (GetDeviceCaps(Printer.Canvas.Handle, RasterCaps) and RC_Palette) =
        RC_Palette then
    begin
        B.PixelFormat := pf8bit;
        Pal := CopyPalette(B.Palette);
        OldPal := SelectPalette(Printer.Canvas.Handle, Pal, False);
        isPrnPal := True;
    end;
    PageWidth := Integer(GetDeviceCaps(Printer.Canvas.Handle, HORZRES));
    PageHeight := Integer(GetDeviceCaps(Printer.Canvas.Handle, VERTRES));
    PageMargin.X := 0; PageMargin.Y := 0;
    TestInt := Integer(GetPrintingOffset);
    if Escape(Printer.Canvas.Handle, QUERYESCSUPPORT, SizeOf(TestInt),
        @TestInt, nil) <> 0 then
    begin
        if Escape(Printer.Canvas.Handle, GETPRINTINGOFFSET, 0, nil, @PageMargin) <= 0 then
        begin
            PageMargin.X := 0;
            PageMargin.Y := 0;
        end;
    end;
    ImagePageWidth := PageWidth-2*PageMargin.X;
    ImagePageHeight := PageHeight-2*PageMargin.Y;
    if ((ImagePageWidth <= ImagePageHeight) and (B.Width >= B.Height)) or
            ((ImagePageWidth > ImagePageHeight) and (B.Width > B.Height)) then
    begin
        ScaleX := ImagePageWidth;
        ScaleY := Trunc(B.Height*ImagePageWidth/B.Width);
        OffsetX := PageMargin.X;
        OffsetY := (PageHeight div 2) - (ScaleY div 2);
    end else
    begin
        ScaleY := ImagePageHeight;
        ScaleX := Trunc(B.Width*ImagePageHeight/B.Height);
        OffsetY := PageMargin.Y;
        OffsetX := (PageWidth div 2) - (ScaleX div 2);
    end;
    GetDIBSizes(B.Handle, InfoSize, ImageSize);
    GetMem(PImage, ImageSize);
    GetMem(PInfo, InfoSize);
    GetDIB(B.Handle, B.Palette, PInfo^, PImage^);
    StretchDIBits(Printer.Canvas.Handle, OffsetX, OffsetY, ScaleX, ScaleY,
            0, 0, B.Width, B.Height, PImage, PBitmapInfo(PInfo)^,
            DIB_RGB_COLORS, SRCCOPY);
    FreeMem(PImage); FreeMem(PInfo);
    if isPrnPal then
    begin
        SelectPalette(Printer.Canvas.Handle, OldPal, False);
        DeleteObject(Pal);
    end;
    Printer.EndDoc;
end;
end.

Удаление собственного exe сразу же после его отработки
//*********************************************************
procedure DeleteSelf;
//*********************************************************
var
    F: TextFile;
    batName: string;
    pi: TProcessInformation;
    si: TStartupInfo;
begin
    batName := ExtractFilePath(ParamStr(0)) + '\$$$$$$$$.bat';
    AssignFile(F,batName);
    Rewrite(F);
    Writeln(F,':try');
    Writeln(F,'del "'+ParamStr(0)+'"');
    Writeln(F,'if exist "'+ ParamStr(0)+'"'+' goto try');
    Writeln(F,'del "' + batName + '"' );
    CloseFile(F);
    FillChar(si, SizeOf(si), $00);
    si.dwFlags := STARTF_USESHOWWINDOW;
    si.wShowWindow := SW_HIDE;
    if CreateProcess( nil, PChar(batName), nil, nil, False, IDLE_PRIORITY_CLASS,
        nil, nil, si, pi ) then
    begin
        CloseHandle(pi.hThread);
        CloseHandle(pi.hProcess);
    end;
end;

  Как сделать TWinControl прозрачным без регионов?

Это совершенно разные вещи. TLabel порожден от ветки TGraphicControl, т.е.
не является окном в терминах windows, а TEdit - является. Прорисовкой
TGraphicControl по большому счету занимается его Parent - он сначала
отрисовывает самого себя, а потом уже вызывает прорисовку TGraphicControl.
Отсюда возможность делать "нормальную" прозрачность, но отсюда же и мигание
текста на TLabel при частой перерисовке. Любой же потомок TWinControl
занимается
своей перерисовкой сам целиком. Поэтому, в принципе он не может быть прозрачным
без извратов. Извраты же заключаются в том, что перекрываются методы:
procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CreateParams(var Params: TCreateParams); override;

procedure TsohoTransButton.CreateParams(var Params: TCreateParams);
begin
    inherited CreateParams(Params);
    if not (csDesigning in ComponentState) then
        Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;

procedure TsohoTransButton.WMEraseBkgnd(var message: TWMEraseBkgnd);
var Rect : TRect;
begin
    if (csDesigning in ComponentState) then inherited
    else begin
        Message.Result := 1;
        Rect := GetClientRect;
        FBack.Free;
        FBack := TBitmap.Create;
        FBack.Height := Rect.Bottom - Rect.Top;
        FBack.Width := Rect.Right - Rect.Left;
        CopyParentImage(Self, FBack.Canvas);
    end;
end;
В последнем методе контрол запоминает картинку со своего Parent и потом,
при собственной прорисовке просто выводит ее на свой задний фон.
with Canvas do begin
    BitBlt(Canvas.Handle, 0, 0, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top,
    FBack.Canvas.Handle, 0, 0, SRCCOPY);
end;

Как сделать генерацию звука заданной частоты?
    В NT есть API: Sound(Herz,MkSec); Но в Win9x - такого нет. Тогда можно сделать так:
library Sound;
// Фyнкция котоpая генеpиpyет звyк на PC Speaker под NT и WIN95.
// procedure SpeakerBeep(Hz, MkSec : Dword); stdcall; export;

uses Windows;

procedure NoSound;
begin
  asm
    in al,61h
    and al,0fch
    out 61h,al
  end;
end;

procedure _Sound(Hz : Word);
begin
  if (Hz > 18) then
    asm
      movzx ecx,Hz
      mov eax,1193180
      sub edx,edx
      div ecx
      mov ecx,eax
//set timer #3
      mov al,182
      out 43h,al
      mov al,cl
      out 42h,al
      mov al,ch
      out 42h,al
//enable speaker
      in al,61h
      or al,3
      out 61h,al
     end;
end;

procedure SpeakerBeep(Hz, MkSec : Dword); stdcall; export;
Var
    OSVERSIONINFO : TOSVERSIONINFO;
Begin
    OSVERSIONINFO.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
    GetVersionEx(OSVERSIONINFO);
    If OSVERSIONINFO.dwPlatformId =VER_PLATFORM_WIN32_NT then
        Beep(Hz,MkSec)
    else
    Begin
        _Sound(Hz);
        Sleep(MkSec);
        Nosound;
    End;
End;

exports SpeakerBeep;
begin
end.

Как сделать, чтобы форма при минимизации анимировалась?

Суть в том, что
1) Настоящая главная форма фиктивная, и пустая.
2)
  procedure TRealForm.CreateParams(var Params :TCreateParams); {override;}
  begin
    inherited CreateParams(Params); {CreateWindowEx}
    Params.ExStyle := Params.ExStyle or WS_Ex_AppWindow;
  end;
3)
  application.showmainform:=false;

4) Форма которая действительно появляется, создается так:
  realform:=TRealForm.Create(FakeMainForm);

5) Самое интересное. Показать realform, и при этом
  не показать application.   (realform.show - некатит).

procedure showwnd(frm:TForm);
var
  i:integer;
begin
  for i:=0 to frm.ComponentCount-1 do
  begin
    if frm.components[i] is TWinControl then
      showwindow((frm.Components[i] as TWinControl).handle,SW_SHOW);
  end;
  showwindow(frm.handle,SW_SHOW);
end;

Как бы ускорить работу с TImage?

   Если скоpость не удовлетвоpяет, то можно воспользоваться паpой Win API функций : SetDIBits и GetDIBits.Изобpажение Win32 удобно хpанить в памяти следующим обpазом : Каждый пиксел занимает 4 байта : 0BGR (т.е пеpвый байт - альфа-канал (мы не будем использовать его, и обычно он 0 ), втоpой байт - синяя составляющая, тpетий - зеленая, четвеpтый - красная).Пpи этом массив заполняется постpочно, начиная с _последней_ стpоки. Работа будет осуществляться следующим обpазом :    Пеpеместим изобpажение с TImage в память, выделенную чеpез соответствующий указатель    Пpоделаем необходим действие над изобpажением в памяти(это и даст большую скоpость обpаботки каpтинки)    Пеpеместим сфоpмиpованное изобpажение обpатно: из памяти в TImage
    Собственно функции для pаботы с изобpажением :
    Считывание инфоpмации из TImage в память. Hеобходимо создать указатель и отвести под него необходимое кол-во памяти. h - хэндл окна, на котоpом лежит каpтинка. BitsInfo - паpаметpы каpтинки(заголовок, котоpый пpидется сфоpмиpовать самому)

      // Запись изобpажения в память(DIBits)
      procedure InternalGetDIBits(h : hdc;Image: TImage; var BitsInfo; var pt: pointer);
        function WidthBytes(I: Longint): Longint;
        begin
          Result := ((I + 31) div 32) * 4;
        end;
      var i : integer;
      begin
        with TBitmapInfo(BitsInfo).bmiHeader do begin
          biWidth  := Image.Picture.Bitmap.Width;
          biHeight := Image.Picture.Bitmap.Height;
          biSize :=   SizeOf(TBITMAPINFOHEADER);
          biCompression := BI_RGB;
          biBitCount  := 32;
          biPlanes := 1;
          biSizeImage := WidthBytes(biWidth * biBitCount) * biHeight;
          i := GetMemoSize(pt);
          if i=0 then pt := AllocMemo(biSizeImage) else
            if i<biSizeImage
                  then begin FreeMemo(pt);pt := AllocMemo(biSizeImage) end;
        end;
         with Image do begin
           GetDIBits(h, Picture.Bitmap.Handle, 0,
             Picture.Bitmap.Height, pt , TBitMapInfo(BitsInfo),DIB_RGB_COLORS);
         end;
      end;

  Пеpемещение изобpажения из памяти на TImage.

      Image -Куда кинуть
      Bits - откуда
      BitsInfo - заголовок

      // Загpузить изобpажения из памяти (DIBits)
      function InternalSetDIBits(Image: TImage; Bits: Pointer;
        var BitsInfo): integer;
      begin
        with Image do begin
          picture.Bitmap.Height := TBitMapInfo(BitsInfo).bmiHeader.biHeight;
          picture.Bitmap.Width := TBitMapInfo(BitsInfo).bmiHeader.biWidth;
          Height := TBitMapInfo(BitsInfo).bmiHeader.biHeight;
          Width := TBitMapInfo(BitsInfo).bmiHeader.biWidth;
          Result := SetDIBits(Canvas.Handle, Picture.Bitmap.Handle,
            0, Picture.Bitmap.Height, Bits, TBitMapInfo(BitsInfo), DIB_RGB_COLORS);
        end;
      end;

  Запись пиксела в память . Для скоpости сделано на ассемблеpе.

      pix - цвет пиксела (длиное беззнаковое целое(4байта, используются
      младшие тpи байта)
      x,y - кооpдинаты пиксела
      xmax - число пикселей в стpоке
      p -указывает на массив в памяти , где лежит изобpажение
      // Запись цвета пикселя.(DIBits)
      procedure SetArrPixel(pix : cardinal; xmax, x, y : integer; p : pointer);assembler;
      begin
        asm
           mov  ecx,XMax
           lea  ecx,[ecx*4]// ecx = XMax * 4

      @@1: mov  edx,x
           lea  edx,[edx*4]// edx = x * 4
           push edx

           mov  eax,y
           mul  ecx      // ecx = z * y
           pop  edx

           add  eax,edx // eax = z*y + x*4;
           mov  edx,eax

           push esi
           mov  eax,pix
           mov  esi,p
           add  esi,edx
           mov  dl,[esi+3]
           mov  [esi],eax
           mov  [esi+3],dl
           pop  esi
        end;
      end;

  Считывание пиксела из памяти. Для скоpости сделано на ассемблеpе.

      pix - цвет пиксела (длиное беззнаковое целое(4байта, используются младшие тpи байта)
      x,y - кооpдинаты пиксела
      xmax - число пикселей в стpоке
      p -указывает на массив в памяти , где лежит изобpажение
      function GetArrPixel(XMax, x, y : integer; p : pointer) : integer; assembler;
      begin
        asm
           mov  ecx,XMax
           lea  ecx,[ecx*4]// ecx = XMax * 4

      @@1: mov  edx,x
           lea  edx,[edx*4]// edx = x * 4
           push edx

           mov  eax,y
           mul  ecx      // ecx = z * y
           pop  edx
           add  eax,edx // eax = z*y + x*4;

           push esi
           mov  esi,p
           add  esi,eax
           mov  eax,[esi]
           and  eax,$00FFFFFF
           mov  Result,eax
           pop  esi
        end;
      end;

  Пpимеpы эффектов:(в данном случае PictArrs - указатель (глобальная пеpеменная) на массив, хpанящий изобpажение).

      // Hегатив изобpажения
      function Negative(Num,Xs,Ys : integer) : boolean;
      var x, y : integer;
          t, e : cardinal;
      begin
        dec(Xs);
        dec(Ys);
        for y := 0 to Ys do
          for x := 0 to Xs do
            SetArrPixel( not GetArrPixel(Xs + 1 , x, Ys-y, PictArrs), Xs + 1, x, Ys-y, PictArrs);
        Result := True;
      end;

      // Миксование белого шума к изобpажению.
      function Noise(Num,Level,Xs,Ys : integer) : boolean;
      var x, y  : integer;
          t, e  : cardinal;
          nr    : integer;
          r,g,b : integer;
      begin
        dec(Xs);
        dec(Ys);
        for y := 0 to Ys do
          for x := 0 to Xs do begin
            t := GetArrPixel(Xs + 1 , x, Ys-y, PictArrs);
            r := (t and $FF0000) shr 16;
            g := (t and $FF00) shr 8;
            b :=  t and $FF;
            nr := Level - random (Level*2);
            r := r + nr;
            g := g + nr;
            b := b + nr;
            if r < 0 then r := 0 else if r > 255 then r := 255;
            if g < 0 then g := 0 else if g > 255 then g := 255;
            if b < 0 then b := 0 else if b > 255 then b := 255;
            e := b or (g shl 8) or (r shl 16);
            SetArrPixel( e, Xs + 1, x, Ys-y, PictArrs);
          end;
        Result := True;
      end;

Работа с библиотекой unrar.dll.

    Там хитpости с типами функций, котоpые объявлены PASCAL, надо писать stdcall, а callback функции cdecl.
{$A-,H-}
{$ALIGN OFF}
{$MINENUMSIZE 4}
unit unrar;
(* ported to Delphi by Eugene Kotlyarov           *)
(* fido: 2:5058/26.9 email: eugenek@mail.esoo.ru *)
interface
uses Windows;
const
  ERAR_END_ARCHIVE    = 10;
  ERAR_NO_MEMORY      = 11;
  ERAR_BAD_DATA       = 12;
  ERAR_BAD_ARCHIVE    = 13;
  ERAR_UNKNOWN_FORMAT = 14;
  ERAR_EOPEN          = 15;
  ERAR_ECREATE        = 16;
  ERAR_ECLOSE         = 17;
  ERAR_EREAD          = 18;
  ERAR_EWRITE         = 19;
  ERAR_SMALL_BUF      = 20;
  RAR_OM_LIST         =  0;
  RAR_OM_EXTRACT      =  1;
  RAR_SKIP            =   0;
  RAR_TEST            =   1;
  RAR_EXTRACT         =  2;
  RAR_VOL_ASK         =  0;
  RAR_VOL_NOTIFY      =  1;

type
  RARHeaderData=record
    ArcName  :array [0..259] of char;
    FileName :array [0..259] of char;
    Flags,
    PackSize,
    UnpSize,
    HostOS,
    FileCRC,
    FileTime,
    UnpVer,
    Method,
    FileAttr: UINT;
    CmtBuf:PChar;
    CmtBufSize,
    CmtSize,
    CmtState: UINT;
  end;

  RAROpenArchiveData=record
    ArcName   :PChar;
    OpenMode  :UINT;
    OpenResult:UINT ;
    CmtBuf    :PChar;
    CmtBufSize:UINT;
    CmtSize   :UINT;
    CmtState  :UINT;
  end;

  TChangeVolProc  =function(ArcName:PChar;Mode:integer):integer cdecl export;
  TProcessDataProc=function(Addr:PUCHAR;Size:integer):integer cdecl export;

function RAROpenArchive(var ArchiveDate:RAROpenArchiveData):THandle;
         stdcall; external 'unrar.dll';

function RARCloseArchive(hArcData : THandle):integer;
         stdcall; external 'unrar.dll';

function RARReadHeader(hArcData:THandle;var HeaderData:RARHeaderData):integer;
         stdcall; external 'unrar.dll';

function RARProcessFile(hArcData:THandle;Operation:integer;DestPath,DestName:PC
har):integer;
         stdcall; external 'unrar.dll';

procedure RARSetChangeVolProc(hArcData:THandle;ChangeVolProc:TChangeVolProc);
          stdcall; external 'unrar.dll';

procedure RARSetProcessDataProc(hArcData:THandle;ProcessDataProc:TProcessDataPr
oc);
          stdcall; external 'unrar.dll';

procedure RARSetPassword(hArcData:THandle;Password:PChar);
          stdcall; external 'unrar.dll';

implementation

end.

А это пpимеpчик:

{$APPTYPE CONSOLE}
{$H-}
program UnRdll;
(* ported to Delphi by Eugene Kotlyarov           *)
(* fido: 2:5058/26.9 email: eugenek@mail.esoo.ru *)
uses Windows,Unrar,Crt,SysUtils;

// enum { EXTRACT, TEST, PRINT };
const
  EXTRACT = 0;
  TEST    = 1;
  PRINT   = 2;

  CRLF = #13#10;

procedure ShowComment(CmtBuf : PChar);
begin
  writeln(CRLF,'Comment:',CRLF,CmtBuf,CRLF);
end;

procedure OutHelp;
begin
  write(#13#10,'UNRDLL.   This is a simple example of UNRAR.DLL usage'#13#10);
  write(#13#10'Syntax:'#13#10);
  write(#13#10'UNRDLL X <Archive>     extract archive contents');
  write(#13#10'UNRDLL T <Archive>     test archive contents');
  write(#13#10'UNRDLL P <Archive>     print archive contents to stdout');
  write(#13#10'UNRDLL L <Archive>     view archive contents'#13#10);
end;

function ChangeVolProc(ArcName:PChar;Mode:integer):integer; cdecl export;
var Ch:char;
begin
  Writeln('Start change');
  if (Mode = RAR_VOL_ASK) then
  begin
    write(#13#10'Insert disk with ',ArcName,' and press ''Enter'' or enter
''Q'' to exit ');
    Ch:=ReadKey;
    result:=integer((UpCase(Ch)<>'Q'));
    Exit;
  end;
  result:=1;
end;

function ProcessDataProc(Addr:PUCHAR;Size:integer):integer; cdecl export;
begin
  Flush(Output);
  FileWrite(TTextRec(Output).Handle,Addr^,Size);
  Flush(Output);
  result:=1;
end;

procedure OutOpenArchiveError(Error:integer; ArcName:PChar);
begin
  case Error of
    ERAR_NO_MEMORY:  write(#13#10'Not enough memory');
    ERAR_EOPEN:      write(#13#10'Cannot open ',ArcName);
    ERAR_BAD_ARCHIVE:write(#13#10,ArcName,' is not RAR archive');
    ERAR_BAD_DATA:   write(#13#10,ArcName,': archive header broken');
  end;
end;

procedure OutProcessFileError(Error:integer);
begin
  case (Error) of
    ERAR_UNKNOWN_FORMAT:write('Unknown archive format');
    ERAR_BAD_ARCHIVE:   write('Bad volume');
    ERAR_ECREATE:       write('File create error');
    ERAR_EOPEN:          write('Volume open error');
    ERAR_ECLOSE:        write('File close error');
    ERAR_EREAD:         write('Read error');
    ERAR_EWRITE:        write('Write error');
    ERAR_BAD_DATA:      write('CRC error');
  end;
end;


procedure ListArchive(ArcName : PChar);
var
  hArcData:THandle;
  RHCode,PFCode:integer;
  CmtBuf:array [0..16383] of char;
  HeaderData: RARHeaderData;
  OpenArchiveData:RAROpenArchiveData;

begin
  OpenArchiveData.ArcName:=ArcName;
  OpenArchiveData.CmtBuf:=CmtBuf;
  OpenArchiveData.CmtBufSize:=sizeof(CmtBuf);
  OpenArchiveData.OpenMode:=RAR_OM_LIST;
  hArcData:=RAROpenArchive(OpenArchiveData);

  if (OpenArchiveData.OpenResult <> 0) then
  begin
    OutOpenArchiveError(OpenArchiveData.OpenResult,ArcName);
    Exit;
  end;

  if (OpenArchiveData.CmtState = 1) then ShowComment(CmtBuf);

  RARSetChangeVolProc(hArcData,ChangeVolProc);

  HeaderData.CmtBuf:=CmtBuf;
  HeaderData.CmtBufSize:=sizeof(CmtBuf);

  write(#13#10'File                        Size');
  write(#13#10'-------------------------------');
  RHCode:=RARReadHeader(hArcData,  HeaderData);
  while (RHCode = 0) do
  begin
//    printf("\n%-20s %10d ",HeaderData.FileName,HeaderData.UnpSize);
    write(#13#10,HeaderData.FileName,' ',HeaderData.UnpSize,' ');

    if (HeaderData.CmtState = 1) then
      ShowComment(CmtBuf);

    PFCode:=RARProcessFile(hArcData,RAR_SKIP,nil,nil);
    if (PFCode<>0) then
    begin
      OutProcessFileError(PFCode);
      break;
    end;
    RHCode:=RARReadHeader(hArcData,  HeaderData)
  end;

  if (RHCode = ERAR_BAD_DATA) then
    write(#13#10'File header broken');

  RARCloseArchive(hArcData);
end;

procedure ExtractArchive(ArcName:PChar;Mode:integer);
var
  hArcData:THandle;
  RHCode,PFCode :integer;
  CmtBuf:array [0..16384] of char;
  HeaderData: RARHeaderData;
  OpenArchiveData: RAROpenArchiveData;
begin
  OpenArchiveData.ArcName:=ArcName;
  OpenArchiveData.CmtBuf:=CmtBuf;
  OpenArchiveData.CmtBufSize:=sizeof(CmtBuf);
  OpenArchiveData.OpenMode:=RAR_OM_EXTRACT;
  hArcData:=RAROpenArchive(OpenArchiveData);

  if (OpenArchiveData.OpenResult<>0) then
  begin
    OutOpenArchiveError(OpenArchiveData.OpenResult,ArcName);
    exit;
  end;

  if (OpenArchiveData.CmtState = 1) then
    ShowComment(CmtBuf);

  RARSetChangeVolProc(hArcData,ChangeVolProc);

  if (Mode = PRINT) then
    RARSetProcessDataProc(hArcData,ProcessDataProc);

  HeaderData.CmtBuf:=nil;

  RHCode:=RARReadHeader(hArcData,HeaderData);
  while (RHCode = 0) do
  begin
    case (Mode) of
      EXTRACT: write(#13#10'Extracting ',HeaderData.FileName:45);
      TEST:    write(#13#10'Testing ',HeaderData.FileName:45);
      PRINT:   writeln(#13#10'Printing ',HeaderData.FileName:45);
    end;

    if (Mode = EXTRACT) then
      PFCode:=RARProcessFile(hArcData,RAR_EXTRACT,nil,nil)
    else
      PFCode:=RARProcessFile(hArcData,RAR_TEST,nil,nil);

    if (PFCode = 0) then
      write(' Ok')
    else
    begin
      OutProcessFileError(PFCode);
      break;
    end;
    RHCode:=RARReadHeader(hArcData,HeaderData);
  end; // while

  if (RHCode = ERAR_BAD_DATA) then write(#13#10'File header broken');

  RARCloseArchive(hArcData);

end;

begin
  Assign (input,'');
  Reset (input);
  Assign (output,'');
  Rewrite (output);

  if (ParamCount<2) then
  begin
    OutHelp;
    Halt(0);
  end;

  case UpCase(ParamStr(1)[1]) of
    'X':ExtractArchive(PChar(ParamStr(2)),EXTRACT);
    'T':ExtractArchive(PChar(ParamStr(2)),TEST);
    'P':ExtractArchive(PChar(ParamStr(2)),PRINT);
    'L':ListArchive(PChar(ParamStr(2)));
  else begin
      OutHelp;
      Halt(0);
    end;
  end;
  Halt(0);
end.

AP> Имеется тpабл. Если pедактиpование сабжа заканчивается Cancel, то не
AP> генеpится событие OnEdited. А тpабл во в чем. У меня pеализоввано
AP> добавление элемента в деpево так же, как в виндовском эксплоpеpе. т.е. Add
AP> и затем EditText. Пpи этом если пользователь нажмет esc, нет никакой
AP> возможности об этом (т.е. о том, что он нажал) узнать :) Таком обpазом
AP> можно наплодить кучу одинаковых элементом с пустым или дефолтным именем,
AP> что не есть хоpошо. Есть какие-нибудь сообpажения?

Вот решение, котоpое пpидумал Т. Сван:
----------------------------[ Begin BetterTreeView.pas ]----------------------------
unit BetterTreeView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, CommCtrl;

type
  TTVNewEditCancelEvent = procedure( Sender: TObject; Node: TTreeNode; var Delete: Boolean) of object;
  TBetterTreeView = class(TTreeView)
  protected
    FIsEditingNew: Boolean;
    FOnEditCancel: TTVChangedEvent;
    FOnNewEditCancel: TTVNewEditCancelEvent;
    procedure Edit(const Item: TTVItem); override;
  public
    function NewChildAndEdit(Node: TTreeNode; const S: String)
      : TTreeNode;
  published
    property IsEditingNew: Boolean read FIsEditingNew;
    property OnEditCancel: TTVChangedEvent
      read FOnEditCancel write FOnEditCancel;
    property OnNewEditCancel: TTVNewEditCancelEvent
      read FOnNewEditCancel write FOnNewEditCancel;
  end;

implementation

procedure TBetterTreeView.Edit(const Item: TTVItem);
var
  Node: TTreeNode;
  Action: Boolean;
begin
  with Item do begin
    { Get the node }
    if (state and TVIF_PARAM) <> 0 then
      Node := Pointer(lParam)
    else
      Node := Items.GetNode(hItem);

    if pszText = nil then begin
      if FIsEditingNew then begin
        Action := True;
        if Assigned(FOnNewEditCancel) then
          FOnNewEditCancel(Self, Node, Action);
        if Action then
          Node.Destroy
      end
      else
        if Assigned(FOnEditCancel) then
          FOnEditCancel(Self, Node);
    end
    else
      inherited;
  end;
  FIsEditingNew := False;
end;

function TBetterTreeView.NewChildAndEdit
  (Node: TTreeNode; const S: String): TTreeNode;
begin
  SetFocus;
  Result := Items.AddChild(Node, S);
  FIsEditingNew := True;
  Node.Expand(False);
  Result.EditText;
  SetFocus;
end;

end.
----------------------------[   End BetterTreeView.pas ]----------------------------

Получение расширенных данных при возникновении Exception.

>         Hе подскажетли всезнающийй All как полyчить дамп стека на момент
> возникновения Exception. А еще лyчше список пpоцедyp, коpоpые пpивели к
> возникновению исключения.

Напрямую никак. Я для себя и коллег по компании разработал следующую "технологию":

1. implementation (что важно) у SysUtils правится
   таким образом, чтобы каждый конструктор Exception
   записывал дамп стека (вызвать UnwindEBP). Естественно,
   в uses implementation следует добавить ExDebug.
   При перекомпиляции не забудьте SYSUTILS.INC и
   FFMT.OBJ (получаемый из FFMT.ASM). Я все эти
   (стандартные) файлы распространять не могу.
   Лицензия, однако.
2. В любой момент (как правило в каком-нибудь except'е
   или обработчике Application.OnException) можно
   получить состояние стека для последнего исключения
   в виде списка, где каждый элемент (Pointer) - адрес
   возврата из (почти) каждой процедуры. Эти адреса
   потом можно отобразить на имена при помощи MAP файла.

unit ExDebug;

interface

uses
  Classes;

procedure UnwindEBP;
function LastEBPList: TList;

implementation

var
  L: TList;

function LastEBPList: TList;
begin
  Result := L;
end;

{$STACKFRAMES ON}
procedure UnwindEBP;
type
  PPointer = ^Pointer;
var
  P: PPointer;
begin
  L.Clear;
  asm
    mov  P, ebp
  end;
  while P <> nil do
  begin
    L.Add(PPointer(PChar(P) + 4)^);
    P := P^;
  end;
end;
{$STACKFRAMES OFF}

initialization
  L := TList.Create;
finalization
  L.Free;
end.

P.S. Если кто разовьет данный модуль, например перепишет
все на ASM'е (мне это делать некогда), автоматизирует
процесс отображения в имена из MAP'а, просьба известить
меня (можно эху), а лучше поделиться.
P.P.S. Все тестировалось только в D3, думаю в D2,D4
проблем не будет.
--
Alexander Horoshilov   Baikonur-CORBA R&D team
Epsylon Technologies   http://www.demo.ru/