Fælles cursor for alle komponenter på formen

Hvis du henter data ind i en loop kan du gøre følgende

while not MyDataSet.Eof do
begin
  //Hente data
  Application.ProcessMessages; <----Denne linie får programmet til at reagere på dine tastetryk
end

Når data skal hentes, gør jeg følgende :

ADODataSet.Parameters.ParamByName('myParam').AsInteger:=myInteger;
ADODataSet.Open;

det er rigtigt det som morten siger, men der er lige en ting man skal tænke på. Hvis du har et loop som kører igennem 80000 eller flere gange, så bliver Application.ProcessMessages jo udført mere end 80.000 gange hvilket vil sløve hentningen af dataene meget drastisk.

I stedet bør du sætte en variabel som tæller op i loopet (hvis der ikke allerede er det i MyDataSet) og så kun køre Application.ProcessMessages hver 1000'e gang i løkken eller lignende. Prøv dig frem.

counter := 0;
while not MyDataSet.Eof do
begin
  //Hente data
  Inc(Counter);
  if Counter mod 1000 = 0 then
    Application.ProcessMessages;
end;

/SpEeDy

>> speedy : som nævnt tidligere, har jeg ikke nogen faste holdepunkter, fra jeg fyrer en "ADODataSet.Open;" til programmet er klart med data'erne.

Men jeg kan da se fidusen i at opdatere med jævne mellemrum ... så kan man måske også indføre en progress bar ...

hmmm...jeg har aldrig rodet med andet end MySQL databaser i Delphi ved hjælp af nogle smarte units, så jeg kender ikke til hvordan det fungerer med de indbyggede komponenter i Delphi.

Jeg så bare mortens kommentar og ville bare lige optimere den lidt.

Men den henter altså alt indholdet efter du har kaldt ADODataSet.Open; ? Er ADODataSet en komponent ? Har den så ikke nogle events man kan bruge til noget i denne sammenhæng ?

/SpEeDy

ADODataSet er en komponent i Delphi 6 og den har en OnFetchProgress event. Jeg skrev en eventhandler til den og satte et breakpoint deri, men programmet udførte aldrig den kode ...

okay øv. Så ved jeg desværre ikke hvad du kan gøre :(

/SpEeDy

Jeg fandt ud af, at man kan sætte eoAsyncFetch i ExecuteOptions property for et ADODataSet. Så kommer der nemlig OnFetchProgress events.

Jeg har nu en Gauge komponent til vise fremskridtet. Desværre er det kun Gauge komponenten, der bliver opdateret, når jeg kalder Application.ProcessMessages ...

Når du kalder Application.ProcessMessages, udfører Windows de jobs som ligger og venter i messageskøen, og så vidt jeg ved repainter den også din applikation hvis der er behov for det

Det vil i praktis sige at hvis du laver nye museklik, eller andet som giver events vil de blive udført

Hverken Application.ProcessMessages eller Repaint hjælper - det er stadig kun Gauge komponenten, der bliver opdateret.

Er der virkeligt ingen forslag til mit cursor problem ?

Eller skal der flere point på bordet ?

flere points er altid godt ;)
men her har du svaret.


var
  Save_Cursor:TCursor;
Begin
  Save_Cursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;    { Show hourglass cursor }
  try
    { Do some lengthy operation }
  finally
    Screen.Cursor := Save_Cursor;  { Always restore to normal }
  end;
end;


håber du kunne bruge det.

btw:
Application.ProcessMessages; er nok en af de hurtigste rutiner at lave hvis der ikke sker noget, så jeg ville fortrække at kalde den hele tiden, så programmet ikke virker som om det er gået i stå, eller hakker.

koden herunder tog 70 ms. at udfører på en P4 1800
var
  Tid1:Cardinal;
  i:integer;
Begin
    Tid1:=GetTickCount;
    for i := 0 to 1000000 do
    begin
          Application.ProcessMessages;
    end;
    showmessage(inttostr(Gettickcount-tid1));
end;

siz23>Klart nok der var vel ingen job der skulle behandles i messages køen ;-)

det har du ret i, men du er nødtil at håndtere dine beskeder på et eller andet tidspunkt alligvel, så det du mister ved at kører den hele tiden er uden betydning for de fleste applicationer. Hvis der kommer meget data i ens message cue (som tager langtid at håndtere), vil ens program jo bare lagge totalt når du endlig går igang med at proccesse den. ;)

men du har da ret i, at din rutine vil kunne spare tid go vil værer mere hensigtmæssigt i nogle sammenhæng.

//If debugging is the process of removing bugs, then programming must be the process of putting them in.

>>slowaterz
Jeg har to ideer til dit loop problem! :)

1. Tråde!
2. Sæt en progressbar på så man kan se at programmet laver noget, men at det bare tager tid... En ide var måske at lave progressbaren i sin egen form... Jeg fandt selv en gang en komponent ved navn TFloatProg som egentlig bare var en form med en ProgressBar på som så havde nogle properties (meget let at lave selv)... Så er det ellers bare at opdatere den en gang i mellem... Jeg bruger den selv til et program der henter en hulens masse filer ind i et TListView, ud fra en fil-type jeg selv har oprettet, og der virker den aldeles udemærket! :)

Hvis du er for doven til selv at lave den bette form + progressbar der skal til, så er koden her:

unit FloatProg;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
    Forms, Graphics, ComCtrls;

type
  TFloatProg = class(TComponent)
    private
      FCaption : String;
      FMax : Integer;
      FMin : Integer;
      FPosition : Integer;
      FWidth : Integer;
      procedure AutoInitialize;
      procedure AutoDestroy;
      procedure SetPosition(Value: Integer);
      procedure SetCaption(Value: String);
      procedure SetMin(Value: Integer);
      procedure SetMax(Value: Integer);
      procedure SetWidth(Value: Integer);
    protected
      procedure Loaded; override;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
    published
      procedure Show;
      procedure Hide;
      property Caption : String read FCaption write SetCaption;
      property Max : Integer read FMax write SetMax;
      property Min : Integer read FMin write SetMin;
      property Position : Integer read FPosition write SetPosition;
      property Width : Integer read FWidth write SetWidth;
  end;

procedure Register;

implementation

var
  frmProg: TForm;
  prgProg: TProgressBar;

procedure Register;
begin
  RegisterComponents('JCM', [TFloatProg]);
end;

procedure TFloatProg.AutoInitialize;
begin
  frmProg:=TForm.Create(Self);
  frmProg.FormStyle:=fsStayOnTop;
  frmProg.BorderStyle:=bsToolWindow;
  frmProg.Caption:='';
  frmProg.BorderIcons:=[];
  prgProg:=TProgressBar.Create(frmProg);
  prgProg.Parent:=frmProg;
  prgProg.Left:=4;
  prgProg.Top:=4;
  prgProg.Width:=200;
  FWidth:=200;
  frmProg.ClientWidth:=prgProg.Width+8;
  frmProg.ClientHeight:=prgProg.Height+8;
  frmProg.Position:=poScreenCenter;
  prgProg.Min:=0;
end;

procedure TFloatProg.AutoDestroy;
begin
  prgProg.Free;
  frmProg.Free;
end;

constructor TFloatProg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoInitialize;
end;

destructor TFloatProg.Destroy;
begin
  AutoDestroy;
  inherited Destroy;
end;

procedure TFloatProg.SetPosition(Value: Integer);
begin
  prgProg.Position:=Value;
  FPosition:=Value;
end;

procedure TFloatProg.SetCaption(Value: String);
begin
  frmProg.Caption:=Value;
  FCaption:=Value;
end;

procedure TFloatProg.SetMin(Value: Integer);
begin
  prgProg.Min:=Value;
  FMin:=Value;
end;

procedure TFloatProg.SetMax(Value: Integer);
begin
  prgProg.Max:=Value;
  FMax:=Value;
end;

procedure TFloatProg.SetWidth(Value: Integer);
begin
  prgProg.Width:=Value;
  frmProg.ClientWidth:=prgProg.Width+8;
  frmProg.Position:=poScreenCenter;
  FWidth:=Value;
end;

procedure TFloatProg.Loaded;
begin
  inherited Loaded;
end;

procedure TFloatProg.Show;
begin
  frmProg.Show;
end;

procedure TFloatProg.Hide;
begin
  frmProg.Hide;
end;

end.

siz23 >> det er det, jeg har prøvet indtil nu ...

Cursoren crSQLWait kommer aldrig frem - kun et almindeligt timeglas.

Så vidt jeg husker får Application.ProcessMessages cursoren til at blive sat tilbage til default. Prøv at sætte Screen.Cursor := crSQLWait efter hvert eneste kald til Application.ProcessMessages.

slowaterz: så erstat med crSQLWait istedet for crHourGlass......

så den kommer til at se sådanne ud.
var
  Save_Cursor:TCursor;
Begin
  Save_Cursor := Screen.Cursor;
  Screen.Cursor := crSQLWait;    { Show hourglass cursor }
  try
    { Do some lengthy operation }
  finally
    Screen.Cursor := Save_Cursor;  { Always restore to normal }
  end;
end;

hvis timeglasset kommer frem, så virker det. Jeg havde bare ikke set du brugte crSQLWait.

ohhh well nu gider jeg ikke skrive mere.

siz23 >> det var stort set det samme, jeg har prøvet - bare uden "try .. finally". Jeg satte cursoren til crSQLWait, men det var altid timeglasset, der kom frem.

Det kan være, zimp har ret og det er Application.ProcessMessages, der gør det ... Problemet er i så fald, at selvom jeg sætter cursoren for hver gang, hvadenten det er før eller efter, så bliver cursoren "nulstillet" inden, ma når at se den.

ok ok, nu sad jeg lige og kiggede lidt på hvilket component du brugte... ;)

først lidt fra delphi hjælpen.
*************************************************************
Applies to
TDBChart component

Declaration
property ShowGlassCursor : Boolean;

Description
Default Value: True
The ShowGlassCursor property determines if TDBChart will change the current cursor shape to a glass cursor whenever records are retrieved from Tables or Queries.
This notifies the user of record retrieval activity.
For fast and small queries or tables you might want to set it to False, thus not disturbing the user.

*************************************************************

så før du sætter din cursor sætter du lige dbchart1.ShowGlassCursor:=False;

håber du kunne bruge det.

Lukketid?

Jep, ærgeligt nok ...

errr... prøvede du dbchart1.ShowGlassCursor:=False;
også sætte din cursor til crSQLWait???
for det virkede hos mig.

Ja, men jeg kunne ikke få programmet til at opdatere cursoren ...

Så jeg endte med at gå tilbage til et af hermandsens forslag - jeg lagde operationen, der henter data ud i en tråd, som kun opdaterer min progress bar. Der var jeg vist for hurtig til at afvise hans svar ...

Projektet er siden afsluttet og afleveret. Hvis jeg kommer til at arbejde med det igen, vil jeg nok vælge en anden løsning ...