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
procedure NiTeMenees(var m: TWMWINDOWPOSCHANGED); message
WM_WINDOWPOSCHANGING ;
public
end;
var
Local: TLocal;
implementation
uses Unit1;
procedure TLocal.NiTeMenees(var m : TWMWINDOWPOSCHANGED);
begin
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
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;
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
JvIPAddress1.Text:='192.168.1.1';
dxCheckBox14.Checked:=True;
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.