Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > API de Windows
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #16  
Antiguo 11-05-2007
Avatar de MaMu
MaMu MaMu is offline
Miembro
 
Registrado: abr 2006
Ubicación: Argentina
Posts: 863
Poder: 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
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
obtener ip JAV Redes 2 13-03-2007 14:50:12
Cambiar wallpaper en windows xp diegohdv Varios 0 10-05-2005 17:29:12
obtener el dia,mes y año noe Firebird e Interbase 3 17-02-2005 07:49:22
Cambiar mi Wallpaper en RUntime bustio Varios 4 01-10-2004 18:47:13
Cambiar el wallpaper soul6301 Varios 1 30-05-2004 16:40:23


La franja horaria es GMT +2. Ahora son las 17:23:37.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi