проблемы с графикой

[joker]

блин заколебался я со скринсейвером
Я просто хотел, чтобы создавалась иллюзия, что рисование идёт прямо по рабочему столу, юзал copyRect у Canvasа битмаповского, потом BitBlt,
но всё время возникала ошибка Canvas does not allow drawning
Теперь же прога в половине случаев работает в половине нет
Меня это просто добивает. Впрочём вот код, поставивший меня на порог мыслей об изучении теории вероятности:

unit jeansform;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, settings, registry;

{$D SCRNSAVE Jeansed.dpr}

type

  TForm1 = class(TForm)
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
   FParameter:TScreenJoke;
  public
  end;

var Form1: TForm1;

implementation

const
colors:Array [0..21] of TColor=
(clBlack,clMaroon,clGreen,clOlive,clNavy,clPurple,clTeal,clGray,
clSilver,clRed,clLime,clYellow,clBlue,clFuchsia,clAqua,clLTGray,
clDKGray,clWhite,clMoneyGreen,clSkyBlue,clCream,clMedGray);
Var DC,DC1:hdc; SX,SY,ID:cardinal;
   h:integer; bit:TBitmap; d:Tcanvas;

Procedure InitializeKey(p:pointer);
Var reg:TRegIniFile;
Begin
reg:=TRegIniFile.Create('Software');
If reg.KeyExists('Jeans') then
 with TScreenJoke(p^) do
  begin
   AllColors:=reg.ReadBool('Jeans','Colors',true);
   OneSize:=reg.ReadBool('Jeans','OneSize',false);
   invers:=reg.ReadBool('Jeans','Inversion',false);
   If not AllColors then ParticularColor:=reg.ReadInteger('Jeans','PartColor',clRed)
   else ParticularColor:=clNone;
   LimitOfSize:=reg.ReadInteger('Jeans','Size',140);
   Wait:=reg.ReadInteger('Jeans','WaitTime',50);
  end
else begin
 reg.WriteBool('Jeans','Colors',true);
 reg.WriteBool('Jeans','OneSize',false);
 reg.WriteBool('Jeans','Inversion',false);
 reg.WriteInteger('Jeans','PartColor',clNone);
 reg.WriteInteger('Jeans','Size',140);
 reg.WriteInteger('Jeans','WaitTime',50);
 with TScreenJoke(p^) do
  begin
   AllColors:=true;
   OneSize:=false;
   ParticularColor:=clNone;
   LimitOfSize:=140;
   Wait:=50;
  end;
end;
reg.Free;
end;

procedure SetSettings(p:pointer);
var reg:TRegIniFile;
begin
reg:=TRegIniFile.Create('Software');
with TScreenJoke(p^) do begin
   reg.WriteBool('Jeans','Colors',AllColors);
   reg.WriteBool('Jeans','OneSize',OneSize);
   reg.WriteBool('Jeans','Inversion',invers);
   reg.WriteInteger('Jeans','PartColor',ParticularColor);
   reg.WriteInteger('Jeans','Size',LimitOfSize);
   reg.WriteInteger('Jeans','WaitTime',Wait);
  end;
reg.Free;
end;

Function Compare(x,y:PScreenJoke):boolean;
Begin
result:=(x^.AllColors=y^.AllColors) and (x^.oneSize=y^.oneSize)
and (x^.ParticularColor=y^.ParticularColor) and (x^.invers=y^.invers)
and (x^.LimitOfSize=y^.LimitOfSize) and (x^.Wait=y^.Wait);
End;

{$R *.dfm}


procedure Jeans(struct:pointer);
Var Ifcol,inv:boolean; r:TRect; cons:cardinal;
X, Y: Integer; size,sizelimit,time:cardinal; col:TColor;
begin
randomize;
with PScreenJoke(struct)^ do
begin
 Ifcol:=AllColors;
 sizelimit:=LimitOfSize+1;
 if OneSize then size:=sizelimit;
 inv:=invers;
 if not ifcol then col:=ParticularColor;
 time:=Wait;
end;
Form1.Left:=0; 
Form1.Top:=0;
bit:=TBitmap.Create;
SX:=GetSystemMetrics(0); 
SY:=GetSystemMetrics(1);
bit.Width:=SX;
bit.Height:=SY;
DC:=GetDC(GetDesktopWindow);
d:=TCanvas.Create;
if inv then cons:=SRCInvert
else cons:=SRCCopy;
DC1:=GetDc(0);
if not BitBlt(bit.Canvas.Handle,0,0,SX,SY,DC,0,0,cons) then
begin
MessageBox(0,'Drawning in this way is not allowed','Error',MB_ICONERROR);
terminateprocess(GetCurrentProcess,0);
end;
d.Handle:=DC1;
if not ifcol then bit.Canvas.Brush.Color:=col;
repeat
 X := Random (SX);
 Y := Random (SY);
 if size<>sizelimit then size:=Random(sizelimit);
 if ifcol then bit.Canvas.Brush.Color:=colors[random(22)];
 bit.Canvas.Ellipse(X - size, Y - size,
 X + size, Y + size);
 d.Draw(0,0,bit);
 sleep(time);
until false;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
terminatethread(h,0);
UpdateWindow(GetDesktopWindow);
d.Free;
bit.Free;
Close;
ReleaseDC(Form1.Handle,DC1);
ReleaseDc(Form1.Handle,DC);
UpdateWindow(GetDesktopWindow);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeKey(@FParameter);
Data:=FParameter;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
if ParamCount>0 then
  case paramStr(1)[2] of
  'p':close;
  'c':
    begin
     case Config.ShowModal of //это окно настроек, что в Settings лежит
     mrOk:if not compare(@FParameter,@Data) then
      begin
       Fparameter:=Data;
       SetSettings(@Fparameter);
      end;
     mrCancel:
     end;
     Close;
    end;
  end
else
 begin
  Width:=SX;
  Height:=SY; 
  h:=beginthread(nil,1024,@Jeans,@FParameter,0,ID); ///CreateScreenSaverThread
 end;
end;
end.

Какие идеи?

[Stilet]

но всё время возникала ошибка
Canvas does not allow drawning

На каком операторе?

[joker]

в процедуре Jeans

на рисовании битмепа канвасом -
d.Draw(0,0,bit);
реже на BitBlt

а в большинстве случаев ничего не вылазит висит просто бежевый фон (графического режима) вместо скопированного рисунка экрана, и никаких шаров

[joker]

вот процедура jeans (для тех кому лень искать)
почему код то работает, то нет

procedure Jeans(struct:pointer);   
Var Ifcol,inv:boolean; {r:TRect;} cons:cardinal;   
X, Y: Integer; size,sizelimit,time:cardinal; col:TColor;   
begin  
randomize;   
with PScreenJoke(struct)^ do  
begin  
 Ifcol:=AllColors;   
 sizelimit:=LimitOfSize+1;   
 if OneSize then size:=sizelimit;   
 inv:=invers;   
 if not ifcol then col:=ParticularColor;   
 time:=Wait;   
end;   
Form1.Left:=0;    
Form1.Top:=0;   
bit:=TBitmap.Create;   
SX:=GetSystemMetrics(0);    
SY:=GetSystemMetrics(1);   
bit.Width:=SX;   
bit.Height:=SY;   
DC:=GetDC(GetDesktopWindow);   
d:=TCanvas.Create;   
if inv then cons:=SRCInvert   
else cons:=SRCCopy;   
DC1:=GetDc(0);   
if not BitBlt(bit.Canvas.Handle,0,0,SX,SY,DC,0,0,cons) then  
begin  
MessageBox(0,'Drawning in this way is not allowed','Error',MB_ICONERROR);   
terminateprocess(GetCurrentProcess,0);   
end;   
d.Handle:=DC1;   
if not ifcol then bit.Canvas.Brush.Color:=col;   
repeat  
 X := Random (SX);   
 Y := Random (SY);   
 if size<>sizelimit then size:=Random(sizelimit);   
 if ifcol then bit.Canvas.Brush.Color:=colors[random(22)];   
 bit.Canvas.Ellipse(X - size, Y - size,   
 X + size, Y + size);   
 d.Draw(0,0,bit);   
 sleep(time);   
until false;   
end;

помогите плиз такая красивая заставка пропадает

[Stilet]

А почему ты обязательно рисуешь через канву?
Почему нельзя сразу на рабстол рисовать?

[joker]

Я поначалу так и делал, это куда проще

Блин я хочу чтоб это был нормальный скринсейвер с окном настроек (модуль Settings - Config.ShowModal), чтобы пользователь потом экран не чистил вручную, а убирал все последствия простым нажатием клавиши, тем более так можно ещё и инвертировать изображение, так красивее

Вопрос по теме В чем разница между GetDC и GetWindowDC

[rpy3uH]

GetDC возвращает контекст только клиентской части окна, а GetWindowDC возвращает контекст с помощью которго можно рисовать на всей поверхности окна, как бы поверх всего на окне включая заголовок, главное меню, и полосу прокрутки.

[mutabor]

joker помоему ты с канвой перемудрил, я не знаю почему у тебя код то работает то нет, (не стал вникать, я обычно не так делаю) но рисование на канве будь то раб. стол или окно это довольно простая процедура, я обычно таймер использую и код вывода немного не такой

чтобы пользователь потом экран не чистил вручную, а убирал все последствия простым нажатием клавиши

что мешает после отрисовки очистить рабочий стол?

посмотри этот исходник http://www.programmersforum.ru/attac...2&d=1195742924, может полезное что-то найдешь, это один из первых моих экспериментов с рабочим столом, как очищать я тогда еще не знал

[joker]

это один из первых моих экспериментов с рабочим столом

Для одного из первых экспериментов неплохо, что же было дальше?

что мешает после отрисовки очистить рабочий стол?

Подскажи как?

[mutabor]

Для одного из первых экспериментов неплохо, что же было дальше?

ничего не было, дальше стало неинтересно

Несколько разных способов очистки канвы. Один из них чистит рабочий стол, не помню какой.

 InvalidateRect(0, nil, true);
 //
 InValidateRect(Canvas.Handle,nil,true);
 // Если вы используете холст формы, то попробуйте следующее:
 InValidateRect(Form1.Handle,nil,true);
 // (или взамен передать дескриптор компонента)
 // Это очистит хост:
 Canvas.FillRect(Canvas.ClipRect);
 // или
 // Canvas.Brush.Color:=ClWhite;
 // Canvas.FillRect(Canvas.ClipRect);
 // Самый быстрый способ очистить Canvas
 PatBlt(Form1.Canvas.Handle, 0, 0,
   Form1.ClientWidth, Form1.ClientHeight, WHITENESS);