Ver Mensaje Individual
  #2  
Antiguo 11-05-2007
Avatar de MaMu
MaMu MaMu is offline
Miembro
 
Registrado: abr 2006
Ubicación: Argentina
Posts: 863
Reputación: 21
MaMu Va por buen camino
Cita:
Empezado por seoane
Vamos por partes. Si el bmp no se crea te tiene que salir un mensaje de error ,¿cual es?
No me sale absolutamente nada.

Este es el código completo, perdon por la desproligidad

Código Delphi [-]
unit Unit2;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dxCore, dxWinXPBar, StdCtrls, ExtCtrls, dxButtons, dxCheckCtrls,
  JvExControls, JvComCtrls, ExtDlgs,  abfControls, Jpeg, Registry, INIFiles,
  FileCtrl;
type
    TLocal = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox3: TGroupBox;
    dxWinXPBar2: TdxWinXPBar;
    Bevel1: TBevel;
    dxButton1: TdxButton;
    dxCheckbox5: TdxCheckbox;
    dxCheckbox6: TdxCheckbox;
    dxCheckbox7: TdxCheckbox;
    dxCheckbox8: TdxCheckbox;
    dxCheckbox9: TdxCheckbox;
    dxCheckbox10: TdxCheckbox;
    dxCheckbox11: TdxCheckbox;
    dxCheckbox12: TdxCheckbox;
    dxWinXPBar4: TdxWinXPBar;
    GroupBox5: TGroupBox;
    dxWinXPBar9: TdxWinXPBar;
    Label5: TLabel;
    Label6: TLabel;
    Edit5: TEdit;
    dxButton2: TdxButton;
    Label1: TLabel;
    Edit8: TEdit;
    dxButton3: TdxButton;
    dxCheckbox13: TdxCheckbox;
    Label2: TLabel;
    Edit9: TEdit;
    dxButton4: TdxButton;
    dxCheckbox14: TdxCheckbox;
    dxButton6: TdxButton;
    dxButton7: TdxButton;
    dxButton8: TdxButton;
    JvIPAddress1: TJvIPAddress;
    dxButton5: TdxButton;
    GroupBox2: TGroupBox;
    dxWinXPBar1: TdxWinXPBar;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    ComboBox1: TComboBox;
    Label7: TLabel;
    Edit2: TEdit;
    dxButton9: TdxButton;
    dxButton10: TdxButton;
    dxButton11: TdxButton;
    OpenPictureDialog1: TOpenPictureDialog;
    FileListBox1: TFileListBox;
    Image1: TImage;
    abfImage1: TabfImage;
    procedure dxButton1Click(Sender: TObject);
    procedure dxCheckbox11Click(Sender: TObject);
    procedure dxCheckbox8Click(Sender: TObject);
    procedure dxButton6Click(Sender: TObject);
    procedure dxButton9Click(Sender: TObject);
    procedure dxButton10Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure dxButton11Click(Sender: TObject);

  private
     { Private declarations }
     procedure NiTeMenees(var m: TWMWINDOWPOSCHANGED); message    
    WM_WINDOWPOSCHANGING ;
  
  public
    { Public declarations }
  end;
var
  Local: TLocal;
implementation
uses Unit1;

procedure TLocal.NiTeMenees(var m : TWMWINDOWPOSCHANGED);
   begin
  //       m.windowpos.x := Main.dxContainer3.Left+15;  {Left/Posicion X}
  //       m.windowpos.y := Main.dxContainer3.Top+40;  {Left/Posicion X}
   end;
function GetWallpaperBitmap(): string;
const
  SPI_GETDESKWALLPAPER = $0073;
var
  wpFName: array [0..MAX_PATH] of char;
begin
  SystemParametersInfo(SPI_GETDESKWALLPAPER,MAX_PATH,@wpFName,0);
  result := wpFName;
end;
procedure SetWallpaper(Original, Copia: string);
var
  Imagen: TPicture;
  Bitmap: TBitmap;
begin
  // Convertimos la imagen a bmp, y ajustamos su tamaño
  Imagen:= TPicture.Create;
  Bitmap:= TBitmap.Create;
  try
    Imagen.LoadFromFile(Original);
    Bitmap.Width:= GetSystemMetrics(SM_CXSCREEN);
    Bitmap.Height:= GetSystemMetrics(SM_CYSCREEN);
    Bitmap.Canvas.StretchDraw(Bitmap.Canvas.ClipRect,Imagen.Graphic);
    Bitmap.SaveToFile(Copia);
  finally
    Bitmap.Free;
    Imagen.Free;
  end;
  // Y ahora hacemos el cambio
  if FileExists(Copia) then
  begin
    with TRegistry.Create do
    begin
      RootKey:= HKEY_CURRENT_USER;
      if OpenKey('Control Panel\Desktop', FALSE) then
      begin
        WriteString('Wallpaper', Copia);
        WriteString('ConvertedWallpaper', Copia);
        WriteString('OriginalWallpaper', Copia);
        WriteString('TileWallpaper', '0');
        WriteString('WallpaperStyle', '2');
        CloseKey;
      end;
    end;
    SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar(Copia),SPIF_SENDCHANGE);
  end;
end;
{$R *.dfm}
procedure TLocal.dxButton1Click(Sender: TObject);
begin
Close;
end;
procedure TLocal.dxCheckbox11Click(Sender: TObject);
begin
if dxCheckBox11.Checked=True
 then begin
        dxCheckBox8.Enabled:=False;
        dxCheckBox6.Enabled:=False;
      end
 else begin
        dxCheckBox8.Enabled:=True;
        dxCheckBox8.Checked:=False;
        dxCheckBox6.Enabled:=True;
        dxCheckBox6.Checked:=False;
      end;
end;
procedure TLocal.dxCheckbox8Click(Sender: TObject);
begin
if dxCheckBox8.Checked=True
 then begin
        dxCheckBox11.Enabled:=False;
        dxCheckBox6.Enabled:=False;
      end
 else begin
        dxCheckBox11.Enabled:=True;
        dxCheckBox11.Checked:=False;
         dxCheckBox6.Enabled:=True;
        dxCheckBox6.Checked:=False;
      end;
end;
procedure TLocal.dxButton6Click(Sender: TObject);
begin
//ip servidor
JvIPAddress1.Text:='192.168.1.1';
//permisos servidor
dxCheckBox14.Checked:=True;
//extensiones

//licencia
 
end;
procedure TLocal.dxButton9Click(Sender: TObject);
begin
OpenPictureDialog1.Execute;
if OpenPictureDialog1.FileName<>''
then begin
  Edit2.Text:=OpenPictureDialog1.FileName;
  abfImage1.Picture.LoadFromFile(Edit2.Text);
end;
end;
procedure TLocal.dxButton10Click(Sender: TObject);
var tema:string;
begin
tema:=Trim(Edit2.Text);
if (tema<>'') then begin
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,Pchar(tema),SPIF_UPDATEINIFILE +
    SPIF_SENDWININICHANGE);
end;
Local.OnShow(self);
end;
procedure TLocal.FormShow(Sender: TObject);
var i:integer;
begin
ComboBox1.Clear;
  for i:=0 to FileListBox1.Items.Count-1 do
    begin
      ComboBox1.Items.Add(FileListBox1.Items.Strings[i]);
    end;
ComboBox1.ItemIndex:=0;
Edit1.Text:=GetWallpaperBitmap();
abfImage1.Picture.LoadFromFile(Edit1.Text);
end;
procedure TLocal.ComboBox1Change(Sender: TObject);
begin
abfImage1.Picture.LoadFromFile('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
end;
procedure TLocal.dxButton11Click(Sender: TObject);
var exten,root,tema : string;
begin
root:=ExtractFilePath(Application.ExeName);
abfImage1.Picture.LoadFromFile('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
tema:=Trim('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
exten:=ExtractFileExt(ComboBox1.Text);
if (exten='JPG')
    then SetWallpaper('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text,root+'temp\nuevo.bmp')
    else  SystemParametersInfo(SPI_SETDESKWALLPAPER,0,Pchar(tema),SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE);
showmessage('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
showmessage(root+'temp\nuevo.bmp');
Local.OnShow(self);
end;
end.
__________________
Código Delphi [-]
 
try 
ProgramarMicro(80C52,'Intel',MnHex,True);
except
On Exception do
MicroChip.IsPresent(True);
end;
Responder Con Cita