Here is some code that does work...
It draws on the little demo window one of 3 things depending on the setup of
the screen saver...
I was going to cut some of the bits out... but hey, this might be more
helpful.
This function gets called if the first parameter passed in is a p, the 2nd
parameter, is, as has been mentioned before, a handle to the demo or preview
window.
Regards
C Fraser
procedure TfrmScnSaver.Preview;
var
HDemoWnd : HWnd;
aRect : TRect;
aCanvas : TCanvas;
InMemBitmap : TBitmap;
x, y, dx, dy, ScrWidth, ScrHeight : integer;
begin
HDemoWnd := StrToInt(ParamStr(2));
while not IsWindowVisible(HDemoWnd) do
Application.ProcessMessages;
GetWindowRect(HDemoWnd, aRect);
ScrWidth := aRect.Right - aRect.Left + 1;
ScrHeight := aRect.Bottom - aRect.Top + 1;
aRect := Rect(0, 0, ScrWidth - 1, ScrHeight - 1);
aCanvas := TCanvas.Create;
aCanvas.Handle := GetDC(HDemoWnd);
x := (ScrWidth div 2) - 16;
y := (ScrHeight div 2) - 16;
dx := 1;
dy := 1;
InMemBitmap := TBitmap.Create;
InMemBitmap.Width := ScrWidth;
InMemBitmap.Height := ScrHeight;
while IsWindowVisible(HDemoWnd) do begin
InMemBitmap.Canvas.Brush.Color := clBlack;
InMemBitmap.Canvas.FillRect(aRect);
if frmSetup.opnSpot.Checked then begin
InMemBitmap.Canvas.Brush.Color := clWindow;
InMemBitmap.Canvas.Ellipse(x, y, x + 32, y + 32);
end else if frmSetup.opnTime.Checked then begin
InMemBitmap.Canvas.Font := frmSetup.pnlExampleFont.Font;
InMemBitmap.Canvas.Font.Size := 10;
InMemBitmap.Canvas.TextOut(x, y, FormatDateTime('h:mmampm', Now));
end else if frmSetup.opnLogo.Checked then begin
InMemBitmap.Canvas.Draw(x, y, Application.Icon);
end;
aCanvas.CopyRect(aRect, InMemBitmap.Canvas, aRect);
Sleep(25);
Application.ProcessMessages;
if (x = 0) or (x = (ScrWidth - 33)) then dx := -dx;
if (y = 0) or (y = (ScrHeight - 33)) then dy := -dy;
Inc(x, dx);
Inc(y, dy);
end;
InMemBitmap.Free;
aCanvas.Free;
end;
-----Original Message-----
From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED]]On
Behalf Of Tony Goodrich
Sent: Friday, 10 September 1999 12:19 pm
To: Multiple recipients of list delphi
Subject: RE: [DUG]: Screen Savers
Thanks for the contributions
I have been to these sites and after the usual tangental browseing that
happens when anybody with a sense of curiosity browsers the net, I
fopund several interesting articles.
1) A screen saver called spheres which is great but is targeted at
16 bit and therefore has no preview
2) An artickle about writing a previewer by Robert Vivrette (basically
pass the handle odf a panel on the command line)
3) Microsoft MSDN documentation (the usual frustration)
4) An article on how to/from write to the desk top which was
brilliant.
Now I tried to apply rthe desktop analogy (which works by the way to the
desktop) to writing to the little preview window. But something is
not working. Any comments. Here is the snippet for any enlighteded
comments.
regards & thanks Tony Goodrich
procedure Splash(thehandle: string);
var
MyImage: TBitMap;
MyCanvas: TCanvas;
begin
MyImage := TBitMap.Create;
MyImage.LoadFromFile('c:\earth.bmp');
MyCanvas := tcanvas.create;
try
with MyCanvas do
begin
handle := getdc(strtoint(thehandle)); // no go
// handle := getwindowdc(strtoint(thehandle)); // no go
// handle := strtoint(thehandle); // blows up
// handle := getwindowdc(Getdesktopwindow); // writes to
desktop OK
end;
copyrect(rect(0, 0, 200, 200),
MyImage.canvas,
rect(0, 0, 200, 200));
finally
MyCanvas.free;
end;
MyImage.Free;
end;
---------------------------------------------------------------------------
New Zealand Delphi Users group - Delphi List - [EMAIL PROTECTED]
Website: http://www.delphi.org.nz
---------------------------------------------------------------------------
New Zealand Delphi Users group - Delphi List - [EMAIL PROTECTED]
Website: http://www.delphi.org.nz
