AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein GUI-Design mit VCL / FireMonkey / Common Controls Delphi Drawgrids & Shapes, oder Canvas mit onClick-Ereignis??
Thema durchsuchen
Ansicht
Themen-Optionen

Drawgrids & Shapes, oder Canvas mit onClick-Ereignis??

Ein Thema von venomsoup · begonnen am 6. Okt 2004 · letzter Beitrag vom 13. Okt 2004
 
omata

Registriert seit: 26. Aug 2004
Ort: Nebel auf Amrum
3.154 Beiträge
 
Delphi 7 Enterprise
 
#2

Re: Drawgrids & Shapes, oder Canvas mit onClick-Ereignis

  Alt 7. Okt 2004, 01:48
Moin,

das ist etwas aufwendiger. Besonders weil ich nicht weiss wie du die Aufträge speicherst. Wenn diese in einer Datenbank liegen, wird es noch etwas einfacher. Ich habe jetzt erstmal eine Klasse für die Speicherung der Aufträge angelegt. Aber schau selbst...

zuerst die Typen:
Delphi-Quellcode:
type
  TAuftrag = class
  private
    _Start:integer;
    _Laenge:integer;
    _Zeile:integer;
    _Farbe:TColor;
    _Selected:boolean;
    _Bezeichnung:string;
  public
    constructor create(Start, Laenge, Zeile:integer; Bezeichnung:string; Farbe:TColor); reintroduce;
    property Zeile:integer read _Zeile;
    property Start:integer read _Start;
    property Laenge:integer read _Laenge;
    property Farbe:TColor read _Farbe;
    property Selected:boolean read _Selected write _Selected;
    property Bezeichnung:string read _Bezeichnung;
  end;

  TAuftraegeArray = array of TAuftrag;

  TAuftraege = class
  private
    _Auftraege:TAuftraegeArray;
  public
    constructor create; reintroduce;
    destructor destroy; override;
    procedure addAuftrag(Auftrag:TAuftrag);
    function GetAuftrag(Col, Row:integer):TAuftraegeArray; overload;
    function SelectAuftrag(X, Y:integer; Rect:TRect; Col, Row:integer):TAuftrag;
  end;
Dann die einzelnen Rümpfe...
Delphi-Quellcode:
{ TAuftraege }

procedure TAuftraege.addAuftrag(Auftrag: TAuftrag);
begin
  setlength(_Auftraege, length(_Auftraege)+1);
  _Auftraege[length(_Auftraege)-1]:=Auftrag;
end;

constructor TAuftraege.create;
begin
  setlength(_Auftraege, 0);
end;

destructor TAuftraege.destroy;
var i:integer;
begin
  for i:=1 to length(_Auftraege) do
    _Auftraege[i-1].Free;
  setlength(_Auftraege, 0);
  inherited;
end;

function TAuftraege.GetAuftrag(Col, Row: integer): TAuftraegeArray;
var i:integer;
begin
  setlength(Result, 0);
  i:=0;
  while (i < length(_Auftraege)) do begin
    if (Row = _Auftraege[i].Zeile)
       and (_Auftraege[i]._Start <= Col)
       and (Col <= _Auftraege[i]._Start + _Auftraege[i]._Laenge) then begin
      setlength(Result, length(Result)+1);
      Result[length(Result)-1]:=_Auftraege[i];
    end;
    inc(i);
  end;
end;

function TAuftraege.SelectAuftrag(X, Y:integer; Rect:TRect; Col, Row:integer):TAuftrag;
var i:integer;
    AuftraegeArray:TAuftraegeArray;
    abbruch:boolean;
begin
  Result:=nil;
  i:=0;
  setlength(AuftraegeArray, 0);
  while (i < length(_Auftraege)) do begin
    _Auftraege[i].Selected:=false;
    if (Row = _Auftraege[i].Zeile)
       and (_Auftraege[i]._Start <= Col)
       and (Col <= _Auftraege[i]._Start + _Auftraege[i]._Laenge) then begin
      setlength(AuftraegeArray, length(AuftraegeArray)+1);
      AuftraegeArray[length(AuftraegeArray)-1]:=_Auftraege[i];
    end;
    inc(i);
  end;

  if length(AuftraegeArray) > 0 then begin
    i:=0;
    abbruch:=false;
    while (i < length(AuftraegeArray)) and not abbruch do begin
      abbruch:= ( (Y > Rect.Top + 3)
                     and (Y < Rect.Bottom - 3))
                and ( ( (X >= Rect.Left + ((Rect.Right - Rect.Left) div 2))
                          and (AuftraegeArray[i].Start = Col))
                      or ( (X < Rect.Left + ((Rect.Right - Rect.Left) div 2))
                          and (AuftraegeArray[i].Start + AuftraegeArray[i].Laenge = Col)
                      or ( (AuftraegeArray[i].Start < Col)
                          and (AuftraegeArray[i].Start + AuftraegeArray[i].Laenge > Col))));
      if not abbruch then
        inc(i);
    end;
    if abbruch then begin
      AuftraegeArray[i].Selected:=true;
      Result:=AuftraegeArray[i];
    end;
  end;
end;

{ TAuftrag }

constructor TAuftrag.create(Start, Laenge, Zeile: integer; Bezeichnung:string; Farbe: TColor);
begin
  _Start:=Start;
  _Laenge:=Laenge;
  _Zeile:=Zeile;
  _Farbe:=Farbe;
  _Selected:=false;
  _Bezeichnung:=Bezeichnung;
end;
Auf dem Formular benötigst du nur ein DrawGrid.
Die Ereignis-Methoden sehen dann folgendermaßen aus...
Delphi-Quellcode:
procedure TFMain.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var AuftraegeArray:TAuftraegeArray;
    i:integer;
    MyRect:TRect;
begin
  with Sender as TDrawGrid do begin
    if gdFixed in State then begin
      canvas.Brush.Color:=clSilver;
      canvas.FillRect(Rect);
    end
    else begin
      canvas.Brush.Color:=clWhite;
      canvas.FillRect(Rect);
      AuftraegeArray:=FAuftraege.GetAuftrag(ACol, ARow);
      for i:=1 to length(AuftraegeArray) do begin
        MyRect.Left:=Rect.Left;
        MyRect.Right:=Rect.Right;
        MyRect.Top:=Rect.Top + 3;
        MyRect.Bottom:=Rect.Bottom - 3;
        if AuftraegeArray[i-1].Start = ACol then
          MyRect.Left:=MyRect.Left + ((Rect.Right - Rect.Left) div 2);
        if ACol = AuftraegeArray[i-1].Start + AuftraegeArray[i-1].Laenge then
          MyRect.Right:=MyRect.Right - ((Rect.Right - Rect.Left) div 2);
        canvas.Brush.Color:=AuftraegeArray[i-1].Farbe;
        canvas.FillRect(MyRect);
        if AuftraegeArray[i-1].Selected then begin
          canvas.Pen.Color:=clBlack;
          canvas.Pen.Width:=2;
          canvas.MoveTo(MyRect.Left, MyRect.Top);
          canvas.LineTo(MyRect.Right, MyRect.Top);
          canvas.MoveTo(MyRect.Left, MyRect.Bottom);
          canvas.LineTo(MyRect.Right, MyRect.Bottom);
          if AuftraegeArray[i-1].Start = ACol then begin
            canvas.MoveTo(MyRect.Left, MyRect.Top);
            canvas.LineTo(MyRect.Left, MyRect.Bottom);
          end;
          if ACol = AuftraegeArray[i-1].Start + AuftraegeArray[i-1].Laenge then begin
            canvas.MoveTo(MyRect.Right, MyRect.Top);
            canvas.LineTo(MyRect.Right, MyRect.Bottom);
          end;
        end;
      end;
      setlength(AuftraegeArray, 0);
    end;
  end;
end;

procedure TFMain.DrawGridMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Col, Row:integer;
    Rect:TRect;
    Auftrag:TAuftrag;
begin
  if Button = mbLeft then begin
    TDrawGrid(Sender).MouseToCell(X, Y, Col, Row);
    Rect:=TDrawGrid(Sender).CellRect(Col, Row);
    Auftrag:=FAuftraege.SelectAuftrag(X, Y, Rect, Col, Row);
    TDrawGrid(Sender).Repaint;
    if assigned(Auftrag) then
      OnAuftragClick(Auftrag);
  end;
end;
Dann wird noch folgendes in der Formularklasse benötigt...
Delphi-Quellcode:
  :
  private
    FAuftraege:TAuftraege;
    procedure OnAuftragClick(Auftrag:TAuftrag);
  :
  :
  :
procedure TFMain.FormCreate(Sender: TObject);
begin
  FAuftraege:=TAuftraege.create;
  FAuftraege.addAuftrag(TAuftrag.create(1, 2, 1, '1. Auftrag', clRed));
  FAuftraege.addAuftrag(TAuftrag.create(3, 1, 1, '2. Auftrag', clGreen));
  FAuftraege.addAuftrag(TAuftrag.create(0, 1, 3, '3. Auftrag', clBlue));
end;

procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FAuftraege.Free;
end;
und Der Rumpf sieht als Beispiel zu aus...
Delphi-Quellcode:
procedure TFMain.OnAuftragClick(Auftrag: TAuftrag);
begin
  showmessage(Auftrag.Bezeichnung);
end;

So, hoffe es hilft dir...

MfG
Thorsten
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:30 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz