Probleme mit XPMenu

Amiga-Fan · Beiträge: 534

XPMenu erzeugt Exceptions, sobald der Bildschirmschoner kommt oder auch wenn der PC in den Ruhezustand ging und wieder aufgeweckt wurde:

EOSError: Ein Aufruf einer Betriebssystemfunktion ist fehlgeschlagen

(Delphi 7).

Eine Stelle, an der das Problem auftritt, ist z. b. die Prozedur DrawItem. Da ist ein try..exception-Block drumherum, aber ohne Exceptionbehandlung. Trotzdem kommt die Fehlermeldung immer wieder mal bis zum Anwender durch. Das ist nicht sauber programmmiert... wie kann ich das abfangen, so das auch, wenn das Programm aus der IDE heraus läuft, niemals eine Exception auftritt?

_________________
- Leg dich nie mit einem Berufsprogrammierer an
- Wahre Profis akzeptieren keine einfachen Lösungen

jaenicke · Verfasst: Mo 28.04.08 00:08

Amiga-Fan hat folgendes geschrieben:

Da ist ein try..exception-Block drumherum, aber ohne Exceptionbehandlung. Trotzdem kommt die Fehlermeldung immer wieder mal bis zum Anwender durch. Das ist nicht sauber programmmiert... wie kann ich das abfangen, so das auch, wenn das Programm aus der IDE heraus läuft, niemals eine Exception auftritt?

Ich frage mich gerade, ob dir klar ist, dass wenn du ein Programm aus der IDE heraus startest, eine Exception in Delphi angezeigt wird, diese aber nie dem User angezeigt wird, wenn diese in einem try..except-Block auftritt.

Heißt: Innerhalb von try..except wird keine normale Meldung der Exception angezeigt, Delphi selbst informiert dich aber über die Exception und deren Typ, wenn du das Programm aus der IDE gestartet hast.

Amiga-Fan · Beiträge: 534

das weiß ich, normalerweise ist das auch so.

Im Moment habe ich es so, das diese Fehlermeldung nicht zum Anwender durchgereicht wird, wenn ich es aus der IDE starte (wegen try-except-block), aber wenn ich die EXE direkt starte und es bis zum Bildschirmschoner kommen lasse, trotzdem die Fehlermeldung kommt.

Generell gefragt: wie kann man diesen Fehler sauber abfangen? Dafür gehört für mich nicht nur ein try-except-block außenrum... also so eine Abfrage wie "if assigned() then"... z.b. will ich einfügen....

das ist der code... ich bin mir nicht sicher, ob diese Stelle das einzige Problem ist, aber das ist die einzige Stelle, wo er im Debugger hinspringt wenn ichs aus der IDE starte

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:

procedure TXPMenu.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
begin
  try  //"Steve Rice" <srice@pclink.com>
    if FActive then
      MenueDrawItem(Sender, ACanvas, ARect, Selected);
  except
  end;
end;

procedure TXPMenu.MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
var
  txt: string;
  B: TBitmap;
  IconRect, TextRect, CheckedRect: TRect;
  FillRect: TRect; // +jt
  i, X1, X2: integer;
  TextFormat: integer;
  HasImgLstBitmap: boolean;
  HasBitmap: boolean;
  FMenuItem: TMenuItem;
  FMenu: TMenu;
  FTopMenu: boolean;
  IsLine: boolean;
  ImgListHandle: HImageList;  {Commctrl.pas}
  ImgIndex: integer;
  hWndM: HWND;
  hDcM: HDC;
  DrawTopMenuBorder: boolean;
  msg: TMSG; // +jt
  buff: TBitmap; // +jt
 OrigRect: TRect; // +jt
 OrigCanvas: TCanvas; // +jt
begin
try

  OrigCanvas:= nil;

  FTopMenu := false;
  FMenuItem := TMenuItem(Sender);

// +jt
  B := TBitmap.Create;
  buff := TBitmap.Create;
  try
   origrect:= ARect;
   Dec(origrect.Left,4);
   origcanvas:=ACanvas;
   ARect.Right:=(ARect.Right-ARect.Left)+4;
   ARect.Bottom:=ARect.Bottom-ARect.Top;
   ARect.Left:=4;
   ARect.Top:=0;
   buff.Width := ARect.Right;
   buff.Height := ARect.Bottom;
   ACanvas:=buff.Canvas;
  // +jt
  //SetGlobalColor(ACanvas);

  if FMenuItem.Caption = '-' then IsLine := true else IsLine := false;

  FMenu := FMenuItem.Parent.GetParentMenu;

  if FMenu is TMainMenu then
    for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
      if FMenuItem.GetParentMenu.Items[i] = FMenuItem then
      begin
        FTopMenu := True;
  // +jt
        ARect.Left:=0;
       Inc(origrect.Left,4);
       Dec(ARect.Right,4);
       buff.Width:=ARect.Right;
       Dec(ARect.Bottom,1);
  // +jt
        break;
      end;
  if(FColorsChanged) then SetGlobalColor(ACanvas); // +jt

  ACanvas.Font.Assign(FFont);

  Inc(ARect.Bottom, 1);
  TextRect := ARect;
  txt := ' ' + FMenuItem.Caption;

//  B := TBitmap.Create;     //Leslie Cutting lesnes@absamail.co.za  Jul 8 2003
  HasBitmap := false;
  HasImgLstBitmap := false;


  if (FMenuItem.Parent.GetParentMenu.Images <> nil)
  {$IFDEF VER5U}
  or (FMenuItem.Parent.SubMenuImages <> nil)
  {$ENDIF}
  then
  begin
    if FMenuItem.ImageIndex <> -1 then
      HasImgLstBitmap := true
    else
      HasImgLstBitmap := false;
  end;

  if FMenuItem.Bitmap.Width  > 0 then
    HasBitmap := true;

  //-------
  if HasBitmap then
    begin
      B.Width := FMenuItem.Bitmap.Width;
      B.Height := FMenuItem.Bitmap.Height;
  // +jt
     //B.Canvas.Brush.Color := FTransparentColor; // ACanvas.Brush.Color;
     B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" <ashert@yadasystems.com>
     B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
     FMenuItem.Bitmap.Transparent := true;
     FMenuItem.Bitmap.TransparentMode := tmAuto;
      B.Canvas.Draw(0,0,FMenuItem.Bitmap);
  // +jt
    end;


  if HasImgLstBitmap then
  begin
  {$IFDEF VER5U}
    if FMenuItem.Parent.SubMenuImages <> nil then
    begin
      ImgListHandle := FMenuItem.Parent.SubMenuImages.Handle;
      ImgIndex := FMenuItem.ImageIndex;

      B.Width := FMenuItem.Parent.SubMenuImages.Width;
      B.Height := FMenuItem.Parent.SubMenuImages.Height;
     // B.Canvas.Brush.Color := FTransparentColor; // ACanvas.Brush.Color; // +jt
      B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" <ashert@yadasystems.com>
      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
      ImageList_DrawEx(ImgListHandle, ImgIndex,
        B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);

    end
    else
  {$ENDIF}
    if FMenuItem.Parent.GetParentMenu.Images <> nil then
    begin
      ImgListHandle := FMenuItem.Parent.GetParentMenu.Images.Handle;
      ImgIndex := FMenuItem.ImageIndex;

      B.Width := FMenuItem.Parent.GetParentMenu.Images.Width;
      B.Height := FMenuItem.Parent.GetParentMenu.Images.Height;
      //B.Canvas.Brush.Color := FTransparentColor; //ACanvas.Pixels[2,2]; // +jt
      B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" <ashert@yadasystems.com>
      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
      ImageList_DrawEx(ImgListHandle, ImgIndex,
        B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);

    end;

  end;

  //-----

  if FMenu.IsRightToLeft then
  begin
    X1 := ARect.Right - FIconWidth;
    X2 := ARect.Right;
  end
  else
  begin
    X1 := ARect.Left;
    X2 := ARect.Left + FIconWidth;
  end;
  IconRect := Rect(X1, ARect.Top, X2, ARect.Bottom);


  if HasImgLstBitmap or HasBitmap then
  begin
    CheckedRect := IconRect;
    Inc(CheckedRect.Left, 1);
    Inc(CheckedRect.Top, 2);
    Dec(CheckedRect.Right, 3);
    Dec(CheckedRect.Bottom, 2);
  end
  else
  begin
    CheckedRect.Left := IconRect.Left +
      (IConRect.Right - IconRect.Left - 10) div 2;
    CheckedRect.Top := IconRect.Top +
      (IConRect.Bottom - IconRect.Top - 10) div 2;
    CheckedRect.Right := CheckedRect.Left + 10;
    CheckedRect.Bottom := CheckedRect.Top + 10;
  end;

  if B.Width > FIconWidth then
    if FMenu.IsRightToLeft then
      CheckedRect.Left := CheckedRect.Right - B.Width
    else
      CheckedRect.Right := CheckedRect.Left + B.Width;

  if FTopMenu then Dec(CheckedRect.Top, 1);


  if FMenu.IsRightToLeft then
  begin
    X1 := ARect.Left;
    if not FTopMenu then
      Dec(X2, FIconWidth)
    else
      Dec(X2, 4);
    if (ARect.Right - B.Width) < X2 then
      X2 := ARect.Right - B.Width - 8;
  end
  else
  begin
    X1 := ARect.Left ;
    if not FTopMenu then
      Inc(X1, FIconWidth)
    else
      Inc(X1, 4);

    if (ARect.Left + B.Width) > X1 then
      X1 := ARect.Left + B.Width + 4;
    X2 := ARect.Right;
  end;

  TextRect := Rect(X1, ARect.Top, X2, ARect.Bottom);
  // +jt
  FillRect := ARect;
  Dec(FillRect.Left,4);
  // +jt

  if FTopMenu then
  begin
    if not (HasImgLstBitmap or HasBitmap) then
    begin
      TextRect := ARect;
    end
    else
    begin
      if FMenu.IsRightToLeft then
        TextRect.Right := TextRect.Right + 5
      else
        TextRect.Left := TextRect.Left - 5;
    end

  end;

  if FTopMenu then
  begin
    if FDrawMenuBar then
      FFMenuBarColor := FMenuBarColor;
    ACanvas.brush.color := FFMenuBarColor;
    ACanvas.Pen.Color := FFMenuBarColor;
  //    Inc(ARect.Bottom, 2);
    ACanvas.FillRect(ARect);

  //--
    if FDrawMenuBar then
    begin
      if FMenuItem.GetParentMenu.Items[FMenuItem.GetParentMenu.Items.Count-1] =
         FMenuItem then
      begin
        if FMenu.IsRightToLeft then
          ACanvas.Rectangle(3, ARect.Top, ARect.Right, ARect.Bottom)
        else
          ACanvas.Rectangle(ARect.Left, ARect.Top, TScrollingWinControl(FMenu.Owner).ClientWidth+5{FForm.ClientWidth+5},
           ARect.Bottom);
      end
      else
        if FMenu.IsRightToLeft then
          ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right+7, ARect.Bottom);
    end;
  //--
  end
  else
  begin
    if (Is16Bit and FGradient) then
    begin
      inc(ARect.Right,2);  //needed for RightToLeft
      DrawGradient(ACanvas, ARect, FMenu.IsRightToLeft);
      Dec(ARect.Right,2);

    end
    else
    begin
      ACanvas.brush.color := FFColor;
      ACanvas.FillRect(FillRect); // +jt
      ACanvas.brush.color := FFIconBackColor;
      ACanvas.FillRect(IconRect);
    end;


  //------------
  end;


  if FMenuItem.Enabled then
    ACanvas.Font.Color := FFont.Color
  else
    ACanvas.Font.Color := FDisabledColor;

  DrawTopMenuBorder := false;
  if Selected and FDrawSelect then
  begin
    ACanvas.brush.Style := bsSolid;
    if FTopMenu then
    begin
      DrawTopMenuItem(FMenuItem, ACanvas, ARect, FMenuBarColor, FMenu.IsRightToLeft);
    end
    else
    if FMenuItem.Enabled then
    begin
      Inc(ARect.Top, 1);
      Dec(ARect.Bottom, 1);
      if FFlatMenu then
        Dec(ARect.Right, 1);
      ACanvas.brush.color := FFSelectColor;
      ACanvas.FillRect(ARect);
      ACanvas.Pen.color := FFSelectBorderColor;
      ACanvas.Brush.Style := bsClear;
      ACanvas.RoundRect(Arect.Left, Arect.top, Arect.Right, Arect.Bottom, 0, 0);
      Dec(ARect.Top, 1);
      Inc(ARect.Bottom, 1);
      if FFlatMenu then
        Inc(ARect.Right, 1);
    end;
    DrawTopMenuBorder := true;
  end

  // Draw the menubar in XP Style when hovering over an main menu item
  else
  begin
    //if FMenuItem.Enabled and FTopMenu and IsMouseInRect( TScrollingWinControl(FMenu.Owner), ARect) then
    if FMenuItem.Enabled and FTopMenu and IsWNT and
       IsMouseInRect( TScrollingWinControl(FMenu.Owner), origrect) then // +jt
    begin
      ACanvas.brush.Style := bsSolid;
      ACanvas.brush.color := FFSelectColor;
      DrawTopMenuBorder := true;
      ACanvas.Pen.color := FFSelectBorderColor;
      ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right - 7, ARect.Bottom);
    end;
  end;


  if (FMenuItem.Checked) or (FMenuItem.RadioItem ) then  //x
    DrawCheckedItem(FMenuItem, Selected, FMenuItem.Enabled, HasImgLstBitmap or HasBitmap,
                    ACanvas, CheckedRect);

  if (B <> nil) and (B.Width > 0) then  // X
    DrawIcon(FMenuItem, ACanvas, B, IconRect,
      Selected or DrawTopMenuBorder, False, FMenuItem.Enabled, FMenuItem.Checked,
      FTopMenu, FMenu.IsRightToLeft);



  if not IsLine then
  begin

    if FMenu.IsRightToLeft then
    begin
      TextFormat := DT_RIGHT + DT_RTLREADING;
      Dec(TextRect.Right, 3);
    end
    else
    begin
      TextFormat := 0;
      Inc(TextRect.Left, 3);
    end;
    TextRect.Top := TextRect.Top +
        ((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2;
    DrawTheText(FMenuItem, txt, ShortCutToText(FMenuItem.ShortCut),
      ACanvas, TextRect,
      Selected, FMenuItem.Enabled, FMenuItem.Default,
      FTopMenu, FMenu.IsRightToLeft, FFont, TextFormat);

  end
  else
  begin
    if FMenu.IsRightToLeft then
    begin
      X1 := TextRect.Left;
      X2 := TextRect.Right - 7;
    end
    else
    begin
      X1 := TextRect.Left + 7;
      X2 := TextRect.Right;
    end;

    ACanvas.Pen.Color := FFSeparatorColor;
    try
    ACanvas.MoveTo(X1,
      TextRect.Top +
      Round((TextRect.Bottom - TextRect.Top) / 2));
    ACanvas.LineTo(X2,
      TextRect.Top +
      Round((TextRect.Bottom - TextRect.Top) / 2))
      except
      end;
  end;

  // +jt
    BitBlt(origcanvas.Handle,origrect.Left,origrect.Top,buff.Width,buff.Height,ACanvas.Handle,0,0,SRCCOPY);
  finally
   B.free;
   buff.free;
   ACanvas := OrigCanvas;
   ARect:=origrect;
  end;
// +jt

  if not (csDesigning in ComponentState) then
  begin
    if (FFlatMenu) and (not FTopMenu) then
    begin
      hDcM := ACanvas.Handle;
      hWndM := WindowFromDC(hDcM);
// +jt
      if (hWndM=0) and (Application.Handle<>0) then
     begin
       if not PeekMessage(msg,Application.Handle,WM_DRAWMENUBORDER,WM_DRAWMENUBORDER2,PM_NOREMOVE) then
         PostMessage(Application.Handle,WM_DRAWMENUBORDER,0,Integer(FMenuItem));
     end
     else
     if hWndM <> FForm.Handle then
     begin
       if not PeekMessage(msg,Application.Handle,WM_DRAWMENUBORDER,WM_DRAWMENUBORDER2,PM_NOREMOVE) then
         PostMessage(Application.Handle,WM_DRAWMENUBORDER2,integer(FMenu.IsRightToLeft),Integer(hWndM));
     end;
   end;
  end;

//-----
except
end;

end;

_________________
- Leg dich nie mit einem Berufsprogrammierer an
- Wahre Profis akzeptieren keine einfachen Lösungen

wp_xxyyzz · Beiträge: 40

Ich weiß nicht, ob das mit deinem Problem zusammenhängt: XPMenu bringt anscheinend die Kommunikation mit Windows durcheinander, so dass sich Delphi beim Laden eines anderen Projekts oder beim Beenden aufhängt und mit dem Taskmanager abgeschossen werden muss. Die Lösung ist, XPMenu nicht zur Designzeit auf das Formular zu setzen, sondern erst zur Laufzeit im FormCreate-Event:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

procedure TForm1.FormCreate(Sender:TObject);
begin
  XPMenu := TXPMenu.Create(self);
  XPMenu.Active := true;
end;

Seitdem ich das mache, habe ich keine Probleme mehr mit dieser Komponente.

Moderiert von Klabautermann: Delphi-Tags hinzugefügt.

Amiga-Fan · Beiträge: 534

Danke, aber das ist es nicht. Das Problem tritt an der Stelle innerhalb von MenuDrawItem auf:

ACanvas.MoveTo(X1,
TextRect.Top +
Round....

anscheinend funzen die VCL-Zeichenbefehle nicht, sobald der PC einmal in den Ruhezustand/Standby-Modus gefahren ist oder der Bildschirmschoner aufgekommen ist und währenddessen gezeichnet werden soll, und liefern gleich eine Exception (oder anders formuliert, entsprechende VCL-Funktionen fangen das nicht sauber ab -> schlecht geschriebene VCL-Funktionen).

Aber, an dieser Stelle wird das ja durch try...except.. abgefangen, es gab tatsächlich noch eine andere Stelle, wo ich die Mausposition in einem Timer abfragte, die dieselbe Exception erzeugte und nicht durch try...except geschützt war. Jetzt habe ich das Problem also weitgehend gelöst, nur das ein try...except-Block drumrum nicht unbedingt sauber ist...

_________________
- Leg dich nie mit einem Berufsprogrammierer an
- Wahre Profis akzeptieren keine einfachen Lösungen

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme