Ich werde noch verrückt mit ImageList und OnCreate .

[Cosamia]

Hallo zusammen,

ich habe ein kleines Problem, evtl. kann man mir ja noch helfen.
Ich habe ein Programm geschrieben, welches den Status eines Dienstes abfrägt. Das funktioniert auch soweit. Jetzt soll beim FormCreate dieser Staus abgefragt werden und mit Hilfe eines Images angezeigt werden. Der Boolean Wert wird korrekt angezeigt, lediglich das Image will nicht so wie es soll. Ich nutze hierzu eine ImageList mit PaintBox.
Wenn ich den Staus manuell mit einem Button abfrage funktioniert alles wie gewünscht. Nur beim Create hängt das Teil.

Delphi-Quellcode:

unit servicetest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, shellapi, WinSvc, XPMan, Buttons, colorbtn, ExtCtrls;
  
type
  TForm1 = class(TForm)
    btstatus: TButton;
    Label1: TLabel;
    XPManifest1: TXPManifest;
    btstop: TColorBtn;
    btstart: TColorBtn;
    ImageList1: TImageList;
    Button1: TButton;
    PaintBox1: TPaintBox;
    Label2: TLabel;
    procedure btstatusClick(Sender: TObject);
    procedure stopClick(Sender: TObject);
    procedure startClick(Sender: TObject);
    procedure btstopClick(Sender: TObject);
    procedure btstartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);


  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  cname : string;
  status:boolean;

implementation

{$R *.dfm}

const
  bit29 = 1 SHL 28;

  NERR_Success = 0;
  NERR_BASE = 2100;
  NERR_NameNotFound = NERR_BASE + 173;
  NERR_NetworkError = NERR_BASE + 36;
  ERROR_FAILED_STARTING_SERVICE = 1 or bit29;
  ERROR_FAILED_STOPPING_SERVICE = 2 or bit29;

  function ServiceGetStatus(sMachine, sService: PChar): DWORD;
  {******************************************}
  {*** Parameters: ***}
  {*** sService: specifies the name of the service to open
  {*** sMachine: specifies the name of the target computer
  {*** ***}
  {*** Return Values: ***}
  {*** -1 = Error opening service ***}
  {*** 1 = SERVICE_STOPPED ***}
  {*** 2 = SERVICE_START_PENDING ***}
  {*** 3 = SERVICE_STOP_PENDING ***}
  {*** 4 = SERVICE_RUNNING ***}
  {*** 5 = SERVICE_CONTINUE_PENDING ***}
  {*** 6 = SERVICE_PAUSE_PENDING ***}
  {*** 7 = SERVICE_PAUSED ***}
  {******************************************}
var
  SCManHandle, SvcHandle: SC_Handle;
  SS: TServiceStatus;
  dwStat: DWORD;
begin
  dwStat := 0;
  // Open service manager handle.
  SCManHandle := OpenSCManager(sMachine, nil, SC_MANAGER_CONNECT);
  if (SCManHandle > 0) then
  begin
    SvcHandle := OpenService(SCManHandle, sService, SERVICE_QUERY_STATUS);
    // if Service installed
    if (SvcHandle > 0) then
    begin
      // SS structure holds the service status (TServiceStatus);
      if (QueryServiceStatus(SvcHandle, SS)) then
        dwStat := ss.dwCurrentState;
      CloseServiceHandle(SvcHandle);
    end;
    CloseServiceHandle(SCManHandle);
  end;
  Result := dwStat;
end;

function ServiceRunning(sMachine, sService: PChar): Boolean;
begin
  Result := SERVICE_RUNNING = ServiceGetStatus(sMachine, sService);
end;

function ServiceStart(Machine, ServiceName: string): Boolean; 
// Machine is UNC path or local machine if empty 
var 
  h_manager, h_svc: SC_Handle; 
  ServiceStatus: TServiceStatus; 
  dwCheckPoint: DWORD; 
  ServiceArgVectors: PChar; 
begin 
  h_manager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_CONNECT); 
  if h_manager > 0 then 
  begin 
    h_svc := OpenService(h_manager, PChar(ServiceName), 
      SERVICE_START or SERVICE_QUERY_STATUS or SC_MANAGER_ALL_ACCESS); 
    if h_svc > 0 then 
    begin 
      if (StartService(h_svc, 0, ServiceArgVectors)) then { succeeded } 
      begin 
        if (QueryServiceStatus(h_svc, ServiceStatus)) then 
        begin 
          while (SERVICE_RUNNING <> ServiceStatus.dwCurrentState) do 
          begin 
            dwCheckPoint := ServiceStatus.dwCheckPoint; 
            Sleep(ServiceStatus.dwWaitHint); 
            if (not QueryServiceStatus(h_svc, ServiceStatus)) then 
              // couldn't check status 
              break; 
            if (ServiceStatus.dwCheckPoint < dwCheckPoint) then 
              break;
          end;
        end;
      end;
      CloseServiceHandle(h_svc);
    end;
    CloseServiceHandle(h_manager);
  end;

  Result := (SERVICE_RUNNING = ServiceStatus.dwCurrentState);
end;

function ServiceStop(Machine, ServiceName: string): Boolean;
// Machine is UNC path or local machine if empty
var
  h_manager, h_svc: SC_Handle;
  ServiceStatus: TServiceStatus;
  dwCheckPoint: DWORD;
begin
  h_manager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_CONNECT);
  if h_manager > 0 then
  begin
    h_svc := OpenService(h_manager, PChar(ServiceName),
      SERVICE_STOP or SERVICE_QUERY_STATUS);
    if h_svc > 0 then
    begin
      if (ControlService(h_svc, SERVICE_CONTROL_STOP, ServiceStatus)) then
      begin
        if (QueryServiceStatus(h_svc, ServiceStatus)) then
        begin
          while (SERVICE_STOPPED <> ServiceStatus.dwCurrentState) do
          begin
            dwCheckPoint := ServiceStatus.dwCheckPoint;
            Sleep(ServiceStatus.dwWaitHint);
            if (not QueryServiceStatus(h_svc, ServiceStatus)) then
              // couldn't check status
              break;
            if (ServiceStatus.dwCheckPoint < dwCheckPoint) then
              break;
          end;
        end;
      end;
      CloseServiceHandle(h_svc);
    end;
    CloseServiceHandle(h_manager);
  end;

  Result := (SERVICE_STOPPED = ServiceStatus.dwCurrentState);
end;



procedure TForm1.btstatusClick(Sender: TObject);
begin
status := ServiceRunning(pchar('pc265'),'UmRdpService');
//if (status = True) then label1.Caption := 'läuft';
if (status = True) then ImageList1.Draw(Paintbox1.Canvas,0,0,0);
if (status = False) then ImageList1.Draw(Paintbox1.Canvas,0,0,1);
if (status = False) then btstop.Enabled := false;
end;

procedure TForm1.stopClick(Sender: TObject);
begin
ServiceStop(pchar('pc265'),'UmRdpService');
end;

procedure TForm1.startClick(Sender: TObject);
begin
ServiceStart(pchar('pc265'),'UmRdpService');
btstop.Enabled := true;
end;

procedure TForm1.btstopClick(Sender: TObject);
begin
ServiceStop(pchar('pc265'),'UmRdpService');
btstop.Enabled := false;
end;

procedure TForm1.btstartClick(Sender: TObject);
begin
ServiceStart(pchar('pc265'),'UmRdpService');
btstop.Enabled := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ImageList1.Draw(Paintbox1.Canvas,0,0,0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var ststatus:boolean;
begin
ststatus := ServiceRunning(pchar('pc265'),'UmRdpService');
if (ststatus = True) then label1.Caption := 'läuft';
if (ststatus = True) then ImageList1.Draw(Paintbox1.Canvas,0,0,0);
if (ststatus = False) then ImageList1.Draw(Paintbox1.Canvas,0,0,1);
if (ststatus = False) then btstop.Enabled := false;
label2.Caption := BoolToStr (ststatus);

end;

end.

Danke für die Hilfe.

[SirThornberry]

Könntest du bitte deinem Beitrag einen aussagekräftigen Titel geben?!

Zu deinem Problem:
eine Fehlerquelle kann das sein: if (ststatus = True)

Zum anderne scheinst du das Prinzip der Ausgabe unter Windows nicht zu kennen:
Wenn du etwas auf eine Canvas malst ist es nur solange sichtbar bis etwas drüber gemalt wird.
Wenn dein Formular also noch nicht sichtbar ist und du malst auf das Canvas ist das gemalte auch nicht sichtbar.
Angenommen deine Paintbox ist sichtbar, du malst etwas drauf und legst dann etwas kurzzeitig über die Paintbox ist das gemalte wieder weg.

Stell dir am besten vor der Bildschirm ist ein Blatt papier. Wenn du auf Paintbox.Canvas was malst wird das auf das Papier des Bildschirms überträgen (an der Stelle wo die Paintbox liegt). Da deine Paintbox nicht sichtbar ist kannst du auch nichts an die Stelle auf dem Papier/Bildschirm malen.
Ist deine Paintbox sichtbar so ist dein gemaltes nur solange sichtbar bis etwas anderes an der Stelle auf dem Papier/Bildschirm war (denn das andere übermalt dein Bild). Sobald also das andere weg ist musst du wieder malen. Nutze daher OnPaint der Paintbox damit du immer malst wenn es notwendig ist.

[mkinzler]

.FormCreate() ist wohl die falsche Stelle, nimm .Loaded();

[Phoenix]

1.) Bitte ändere den Titel Deiner Frage.
2.) Erst nach dem Create des Forms werden die Komponenten auf dem Form erzeugt. Man kann schliesslich keine Komponenten auf einem nicht existierenden Form erzeugen. Benutze zum einmaligen initialisieren das OnShow event des Forms. Da das aber öfter aufgerufen wird setze Dir noch einen Boolean-Merker (z.B. FirstShow) im Konstruktor auf True und frage diesen im Show-Event ab. Nach dem initialisieren setzt du den dann auf False und gut ist,

[Cosamia]

funktioniert leider auch nicht, oder habe ich etwas falsch verstanden?

Delphi-Quellcode:

procedure TForm1.FormShow(Sender: TObject);
begin
status := ServiceRunning(pchar('pc265'),'UmRdpService');
if (status = True) then label1.Caption := 'läuft';
if (status = True) then ImageList1.Draw(Paintbox1.Canvas,0,0,0);
if (status = False) then ImageList1.Draw(Paintbox1.Canvas,0,0,1);
if (status = False) then btstop.Enabled := false;
label2.Caption := BoolToStr (status);
end;

[Hawkeye219]

Hallo,

wenn das Ereignis OnCreate des Formulars ausgelöst wird, sind alle Komponenten auf dem Formular bereits vorhanden. Der Aufruf von Loaded erfolgt vor dem Auslösen des Ereignisses OnCreate.

Gruß Hawkeye

[SirThornberry]

OnShow ist eben nicht OnAfterShow und ein OnAfterShow gibt es nicht. Packe das bemalen der Paintbox in das OnPaint der Paintbox. Und ersetze
if (BooleanVariable = True) then durch
if (BooleanVariable) then Denn wahr ist nicht das gleiche wie True (alles ungleich 0 ist wahr - True hingegen ist 1)

[Cosamia]

Wo liegt dann der "Hund" begraben?
Bei OnClick funzt ja alles.

Delphi-Quellcode:

if (status = True) then label1.Caption := 'läuft';
if (status = False) then btstop.Enabled := false;
label2.Caption := BoolToStr (status);

funktionieren ja ohne Probleme, lediglich

Delphi-Quellcode:

if (status = True) then ImageList1.Draw(Paintbox1.Canvas,0,0,0);
if (status = False) then ImageList1.Draw(Paintbox1.Canvas,0,0,1);

werden ignoriert.

[Cosamia]

macht leider auch kein Unterschied:

Delphi-Quellcode:

procedure TForm1.FormShow(Sender: TObject);
begin
status := ServiceRunning(pchar('pc265'),'UmRdpService');
if (status) then label1.Caption := 'läuft';
if (status) then ImageList1.Draw(Paintbox1.Canvas,0,0,0);
if (status = False) then ImageList1.Draw(Paintbox1.Canvas,0,0,1);
if (status = False) then btstop.Enabled := false;
label2.Caption := BoolToStr (status);
end;

[Cosamia]

mit OnPaint funktioniert es. Danke.