unit Procs;

interface

uses

 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

 Forms, StdCtrls, Buttons, ExtCtrls, ShellAPI;

procedure LlenaBoton(boton: TSpeedButton; Programa: string);

procedure LimpiaBoton(boton: TSpeedButton);

var

 {Botones de programas}

 Pic: TPicture;

 Fname: string;

 TempFile: array[0..255] of Char;

 Icon: TIcon;

implementation

uses ttotro;

procedure LlenaBoton(boton: TSpeedButton; Programa: string);

var

 NumFiles, NameLength: integer;

 nIconsInFile: word;

 rBoton: TRect;

 oBitmap: TBitmap;

 oBitmap2: TBitmap;

 NombreBitmap: string;

begin

 try

  screen.cursor := crHourglass;

  {Extrae el Icono}

  Icon := TIcon.Create;

  StrPCopy(TempFile, Programa);

  Icon.Handle := ExtractIcon(HInstance, TempFile, 0);

  {Crea una instancia de TPicture}

  Pic := TPicture.Create;

  {Asigna el icon.handle a la propiedad Pic.icon}

  Pic.Icon := Icon;

  {Configura el tamano del bitmap como el del icono y el del segundo

  bitmap con el tamano del boton}

  oBitmap := TBitMap.create;

  oBitmap2 := TBitMap.create;

  oBitmap2.Width := Icon.Width;

  oBitmap2.Height := Icon.Height;

  oBitmap.Width := boton.Width - 4;

  oBitmap.Height := boton.Height - 4;

  { Dibuja el icono en el bitmap }

  oBitmap2.Canvas.Draw(0, 0, Pic.Graphic);

  rBoton.left := 1;

  rBoton. := 1;

  rBoton.right := boton.Width - 6;

  rBoton.Bottom := boton.Height - 6;

  oBitmap.Canvas.StretchDraw(rBoton, oBitmap2);

  Boton.Hint := Programa;

  NombreBitmap := Copy(programa, 1, Length(programa) - 3) + 'BMP';

  {Salva el bitmap en un fichero}

  if not FileExists(NombreBitmap) then

  begin

  oBitmap.SaveToFile(ExtractFilePath(Application.ExeName) +

  ExtractFileName(NombreBitmap));

  Boton.Glyph := oBitmap;

  end

  else

  {Carga el BMP en el boton}

  Boton.Glyph.LoadFromFile(ExtractFilePath(Application.ExeName) +

  ExtractFileName(NombreBitmap));

 finally

  Icon.Free;

  oBitmap.Free;

  oBitmap2.Free;

  screen.cursor := crDefault;

 end; {main begin}

end; {llenaboton}

procedure LimpiaBoton(boton: TSpeedButton);

var

 oBitmap: TBitmap;

 rBoton: TRect;

begin

 try

  {Configuara el tamano del bitmap como el del icono y el del segundo

  bitmap con el tamano del boton}

  oBitmap := TBitMap.create;

  oBitmap.Width := boton.Width - 4;

  oBitmap.Height := boton.Height - 4;

  Boton.Glyph := oBitmap;

 finally

  oBitmap.Free;

 end; {main begin}

end; {limpiaboton}

end.