PaintBox wird an falscher Position neu gezeichnet

ConcAPPtLab · Beitrag von **ConcAPPtLab** » So 6. Sep 2015, 14:32

Hallo zusammen,

Ich bin gerade dabei eine kleine Software für einen Freund zu schreiben. Dabei möchte ich jedoch statt der Button-Komponente PaintBoxen mit eigenem Design verwenden.

Dabei trat dann jedoch folgendes Problem auf:

Die Knöpfe befinden sich auf einem Panel, werden zur Laufzeit mit

Code: Alles auswählen

BtnCancelTask:=TDesignButton2.Create(PanConsole, 'Abbrechen', 104, 80, 78, 25); //Parent, Caption, Left, Top, Width, Height
  BtnRunTask:=TDesignButton2.Create(PanConsole, 'Start', 264, 80, 78, 25);
  BtnAddTask:=TDesignButton2.Create(PanConsole, 'Hinzufügen', 349, 80, 78, 25);

mit diesem Constructor

Code: Alles auswählen

constructor TDesignButton.Create(Sender: TComponent; newBtnCaption: String;
  newLeft, newTop, newWidth, newHeight: integer);
begin
  inherited Create(Sender);
  FBtnCaption:=newBtnCaption;
  Width:=newWidth;
  Height:=newHeight;
  Left:=newLeft;
  Top:=newTop;
  Parent:=TWinControl(Sender);
 
  self.OnPaint:=@Paint;
  self.OnMouseEnter:=@MouseEnter;
  self.OnMouseLeave:=@MouseLeave;
  self.OnMouseDown:=@MouseDown;
  self.OnMouseUp:=@MouseUp;
end;

erzeut. Wärend der Laufzeit verändert sich das Aussehen des Panels. Und auch das der Buttons (siehe Anhang). Jedoch, immer wenn das Aussehen gewechselt hat, und ich über einen Button fahre, wird dieser Button an einer falschen Position neu gezeichnet (siehe Anhang, der überlappende Button ist der Falsche). Es passiert immer nur bei einem der 3 Button, am häufigsten bei dem Button rechts außen. weiß nicht wieso. Hier ist der Code:

Code: Alles auswählen

 
{Setzt Aussehen der Console}
 
procedure TForm1.setConsoleType(cType: String);
begin
  if lowercase(cType)='run' then
    begin
      with Image2 do
        begin
          Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'data\icons\run_blue_big.png');
          Visible:=true;
        end;
      with PanProgress do
        begin
          Visible:=true;
          Left:=104;
          Top:=16;
        end;
 
      PanConsole.Color:=$00FFEFD5;
 
      ImgPrev.Visible:=false;
 
      with Label4 do
        begin
          Left:=104;
          Top:=56;
          Font.Color:=$00B97400;
          Caption:='Kopiervorgang läuft...';
          Visible:=true;
        end;
 
      with BtnCancelTask do
        begin
          Visible:=true;
          BtnCaption:='Abbrechen';
          State:='cancel';
          Width:=78;
          Left:=104;
          Top:=80;
        end;
 
      with BtnRunTask do
        begin
          Visible:=false;
          BtnCaption:='';
          State:='UNSET';
          Width:=78;
          Left:=264;
          Top:=80;
        end;
 
      with BtnAddTask do
        begin
          Visible:=true;
          BtnCaption:='Pausieren';
          State:='pause';
          Width:=78;
          Left:=349;
          Top:=80;
        end;
    end
 
  else if lowercase(cType)='abort' then
    begin
      with Image2 do
        begin
          Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'data\icons\stop_red.png');
          Visible:=true;
        end;
      with PanProgress do
        begin
          Visible:=true;
          Left:=104;
          Top:=16;
        end;
 
      PanConsole.Color:=$00CDCCFF;
 
      ImgPrev.Visible:=false;
 
      with Label4 do
        begin
          Left:=104;
          Top:=56;
          Font.Color:=$000000CC;
          Caption:='Vorgang durch Benutzer abgebrochen.';
          Visible:=true;
        end;
 
      with BtnCancelTask do
        begin
          Visible:=true;
          BtnCaption:='Neu';
          State:='new';
          Width:=78;
          Left:=104;
          Top:=80;
        end;
 
      with BtnRunTask do
        begin
          Visible:=false;
          BtnCaption:='Fortsetzen';
          State:='UnSET';
          Width:=78;
          Left:=264;
          Top:=80;
        end;
 
      with BtnAddTask do
        begin
          Visible:=true;
          BtnCaption:='Fortsetzen';
          State:='UNSET';
          Width:=78;
          Left:=349;
          Top:=80;
        end;
    end
 
  else if lowercase(cType)='pause' then
    begin
      with Image2 do
        begin
          Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'data\icons\pause_darkorange.png');
          Visible:=true;
        end;
      with PanProgress do
        begin
          Visible:=true;
          Left:=104;
          Top:=16;
        end;
 
      PanConsole.Color:=$00D9F0FF;
 
      ImgPrev.Visible:=false;
 
      with Label4 do
        begin
          Left:=104;
          Top:=56;
          Font.Color:=$000099FF;
          Caption:='Vorgang angehalten.';
          Visible:=true;
        end;
 
      with BtnCancelTask do
        begin
          Visible:=true;
          BtnCaption:='Neu';
          State:='new';
          Width:=78;
          Left:=104;
          Top:=80;
        end;
 
      with BtnRunTask do
        begin
          Visible:=false;
          BtnCaption:='';
          State:='UNSET';
          Width:=78;
          Left:=264;
          Top:=80;
        end;
 
      with BtnAddTask do
        begin
          Visible:=true;
          BtnCaption:='Fortsetzen';
          State:='continue';
          Width:=75;
          Left:=349;
          Top:=80;
        end;
    end
 
  else if lowercase(cType)='failure' then
    begin
      with Image2 do
        begin
          Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'data\icons\stop_red.png');
          Visible:=true;
        end;
      with PanProgress do
        begin
          Visible:=true;
          Left:=104;
          Top:=16;
        end;
 
      PanConsole.Color:=$00CDCCFF;
 
      ImgPrev.Visible:=false;
 
      with Label4 do
        begin
          Left:=104;
          Top:=56;
          Font.Color:=$000000CC;
          Caption:='Es ist ein Fehler aufgetreten. Vorgang abgebrochen!';
          Visible:=true;
        end;
 
      with BtnCancelTask do
        begin
          Visible:=false;
          BtnCaption:='';
          State:='UNSET';
          Width:=78;
          Left:=104;
          Top:=80;
        end;
 
      with BtnRunTask do
        begin
          Visible:=true;
          BtnCaption:='Start';
          State:='start';
          Width:=78;
          Left:=264;
          Top:=80;
        end;
 
      with BtnAddTask do
        begin
          Visible:=false;
          BtnCaption:='Hinzufügen';
          State:='UNSET';
          Width:=78;
          Left:=349;
          Top:=80;
        end;
    end
 
  else if lowercase(cType)='done' then
    begin
      with Image2 do
        begin
          Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'data\icons\tick_darkgreen.png');
          Visible:=true;
        end;
      with PanProgress do
        begin
          Visible:=false;
          Left:=104;
          Top:=16;
        end;
 
      PanConsole.Color:=$00DAFFD7;
 
      ImgPrev.Visible:=false;
 
      with Label4 do
        begin
          Left:=104;
          Top:=16;
          Font.Color:=$000C9F00;
          Caption:='Es wurden '+IntToStr(lastCopy+1)+' Bilder erfolgreich kopiert.';
          Visible:=true;
        end;
 
      with BtnCancelTask do
        begin
          Visible:=true;
          BtnCaption:='Neu';
          State:='new';
          Width:=78;
          Left:=104;
          Top:=80;
        end;
 
      with BtnRunTask do
        begin
          Visible:=false;
          BtnCaption:='';
          State:='UNSET';
          Width:=78;
          Left:=264;
          Top:=80;
        end;
 
      with BtnAddTask do
        begin
          Visible:=true;
          BtnCaption:='Zielordner öffnen';
          State:='openTargetDir';
          Width:=118;
          Left:=309;
          Top:=80;
        end;
    end
 
  else if lowercase(cType)='default' then
    begin
      with Image2 do
        begin
          Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'data\icons\stop_gray.png');
          Visible:=true;
        end;
      with PanProgress do
        begin
          Visible:=false;
          Left:=104;
          Top:=16;
        end;
 
      PanConsole.Color:=$00E6E6E6;
 
      ImgPrev.Visible:=true;
      editCoverLinkChange(Form1);
 
      with Label4 do
        begin
          Left:=104;
          Top:=16;
          Font.Color:=$008C8C8C;
          Caption:='Bereit zum Kopieren';
          Visible:=true;
        end;
 
      with BtnCancelTask do
        begin
          Visible:=true;
          BtnCaption:='Zurücksetzen';
          State:='UNSET';
          Width:=85;
          Left:=104;
          Top:=80;
        end;
 
      with BtnRunTask do
        begin
          Visible:=true;
          BtnCaption:='Start';
          State:='start';
          Width:=78;
          Left:=264;
          Top:=80;
        end;
 
      with BtnAddTask do
        begin
          Visible:=true;
          BtnCaption:='Hinzufügen';
          State:='UNSET';
          Width:=78;
          Left:=349;
          Top:=80;
        end;
    end;
end;
 
{wird beim Loslassen der Maustaste ausgeführt}
 
procedure TDesignButton2.MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if btnAction() then
    begin
      RunTask();
    end;
end;
 
function TDesignButton.btnAction(): boolean;
var P: TPoint;
begin
  GetCursorPos(P);
  P:=self.ScreenToClient(P);
 
  with self.Canvas do
    begin
      Brush.Color:=$00E4E4E4;
      Brush.Style:=bsSolid;
      Pen.Color:=$007D7D7D;
      Pen.Style:=psSolid;
      Pen.Width:=1;
      Font.Style:=[fsBold];
      Font.Color:=$004E4E4E;
      Rectangle(0, 0, self.Width, self.Height);
      TextOut((self.Width-
               self.Canvas.TextWidth(self.FBtnCaption)) div 2,
              (self.Height-
               self.Canvas.TextHeight(self.FBtnCaption)) div 2,
               self.BtnCaption);
    end;
 
  if  ((P.X>=0) and (P.X<=self.Width))
  and ((P.Y>=0) and (P.Y<=self.Height))then
    begin
      self.Parent.Refresh;
      Sleep(50);
      result:=true;
      exit;
    end;
 
  result:=false;
 
end;
 
procedure TDesignButton.RunTask();
begin
  if lowercase(self.State)='opentargetdir' then
    OpenDocument(Unit1.lastTargetDir)
  else if lowercase(self.State)='new' then
    Form1.setConsoleType('default')
  else if lowercase(self.State)='cancel' then
    Unit1.abort:=true
  else if lowercase(self.State)='pause' then
    begin
      Unit1.abort:=true;
      Unit1.pause:=true;
    end
  else if lowercase(self.State)='start' then
    begin
      Unit1.lastCopy:=-1;
      Form1.setConsoleType('run');
      Form1.copyImage(Form1.editCoverLink.Text, Form1.editTargetDir.Text,
        StrToInt(Form1.editCopyNum.Text), StrToInt(Form1.editStartNum.Text));
    end
  else if lowercase(self.State)='continue' then
    begin
      Form1.setConsoleType('run');
      Form1.copyImage(Unit1.lastSourcePath, Unit1.lastTargetDir,
        Unit1.lastCopyNum, Unit1.lastStartNum);
    end;

Noch eine kleine Anmerkung: Der Fehler tritt entweder beim Hovern oder beim Leave eines Buttons auf. Sollte noch Code fehlen, bitte Bescheid sagen.

Ich hoffe ihr könnt mein Problem lösen, ich kann es nich

LG
ConcAPPtLab

P.S.: Dieser Fehler trat auch schon einmal bei einem früheren Projekt auf...auch da konnte ich ihn nicht beheben....

Michl · Beitrag von **Michl** » So 6. Sep 2015, 15:00

Du machst dir mMn das Leben unnötig schwer. Schau dir mal die Eigenschaft Anchors an. Damit könntest du einfach den linken unteren Button (Paintbox) am Formular verankern (mit etwas Abstand) und alle anderen Buttons an diesem ebenfalls mit Anchors (mit etwas Abstand) ausrichten.

ConcAPPtLab · Beitrag von **ConcAPPtLab** » So 6. Sep 2015, 15:15

Hallo Michl,

das ist natürlich eine gute Idee, ich kannte die Anchors bisher nur aus Java. Ich werde da mal reinschauen. Vielleicht verschwndet ja auch dann der ungewollte Effekt. Danke jedenfalls

Grüße
ConcAPPtLab

TBug · Beitrag von **TBug** » So 6. Sep 2015, 22:45

ConcAPPtLab hat geschrieben:

Code: Alles auswählen

constructor TDesignButton.Create(Sender: TComponent; newBtnCaption: String;
  newLeft, newTop, newWidth, newHeight: integer);
begin
  inherited Create(Sender);
  FBtnCaption:=newBtnCaption;
  Width:=newWidth;
  Height:=newHeight;
  Left:=newLeft;
  Top:=newTop;
  Parent:=TWinControl(Sender);
 
  self.OnPaint:=@Paint;
  self.OnMouseEnter:=@MouseEnter;
  self.OnMouseLeave:=@MouseLeave;
  self.OnMouseDown:=@MouseDown;
  self.OnMouseUp:=@MouseUp;
end;

...

Noch eine kleine Anmerkung: Der Fehler tritt entweder beim Hovern oder beim Leave eines Buttons auf. Sollte noch Code fehlen, bitte Bescheid sagen.

Da der Fehler bei OnMouseEnter oder OnMouseLeave auftritt, fehlen die entsprechenden Codezeilen der Funktionen MouseEnter und MouseLeave um einen Fehler erkennen zu können.

Die Paint-Procedure wäre natürlich auch noch zu untersuchen.

ConcAPPtLab · Beitrag von **ConcAPPtLab** » Mo 7. Sep 2015, 18:56

Hallo TBug,

natürlich, hier sind die fehlenden Methoden:

Code: Alles auswählen

procedure TDesignButton.Paint(Sender: TObject);
begin
  with TDesignButton(Sender).Canvas do
    begin
      Brush.Color:=$00E4E4E4;
      Brush.Style:=bsSolid;
      Pen.Color:=$007D7D7D;
      Pen.Style:=psSolid;
      Pen.Width:=1;
      Font.Style:=[fsBold];
      Font.Color:=$004E4E4E;
      Rectangle(0, 0, self.Width, self.Height);
      TextOut((self.Width-
               self.Canvas.TextWidth(self.FBtnCaption)) div 2,
              (self.Height-
               self.Canvas.TextHeight(self.FBtnCaption)) div 2,
               self.btnCaption);
    end;
end;
 
procedure TDesignButton.MouseEnter(Sender: TObject);
begin
  with self.Canvas do
    begin
      Brush.Color:=$00E9E9E9;
      Brush.Style:=bsSolid;
      Pen.Color:=$00868686;
      Pen.Style:=psSolid;
      Pen.Width:=1;
      Font.Style:=[fsBold];
      Font.Color:=$005B5B5B;
      Rectangle(0, 0, self.Width, self.Height);
      TextOut((self.Width-
               self.Canvas.TextWidth(self.FBtnCaption)) div 2,
              (self.Height-
               self.Canvas.TextHeight(self.FBtnCaption)) div 2,
               self.btnCaption);
    end;
end;
 
procedure TDesignButton.MouseLeave(Sender: TObject);
begin
  if self.Visible then
    with self.Canvas do
      begin
        Brush.Color:=$00E4E4E4;
        Brush.Style:=bsSolid;
        Pen.Color:=$007D7D7D;
        Pen.Style:=psSolid;
        Pen.Width:=1;
        Font.Style:=[fsBold];
        Font.Color:=$004E4E4E;
        Rectangle(0, 0, self.Width, self.Height);
        TextOut((self.Width-
                 self.Canvas.TextWidth(self.FBtnCaption)) div 2,
                (self.Height-
                 self.Canvas.TextHeight(self.FBtnCaption)) div 2,
                 self.btnCaption);
      end;
end;

Vorher mitgesandt habe ich diese nur, weil hier keine Bewegungen vorgenommen worden, sondern nur auf der Canvas gezeichnet wird. Aber der Vollständigkeit halber gerne

Deutsches Lazarusforum

PaintBox wird an falscher Position neu gezeichnet

PaintBox wird an falscher Position neu gezeichnet

Re: PaintBox wird an falscher Position neu gezeichnet

Re: PaintBox wird an falscher Position neu gezeichnet

Re: PaintBox wird an falscher Position neu gezeichnet

Re: PaintBox wird an falscher Position neu gezeichnet