Autor |
Beitrag |
Jack Falworth
Beiträge: 222
Win XP Pro, Slackware 10.0
D5 Enterprise, C++, ABAP
|
Verfasst: So 12.09.04 01:48
Kurzbeschreibung:
GraVis ist eine 2D Grafikunit zum einfachen erstellen und verwalten diverser
geometrischer Figuren, (Rechtecke, Kreise, Dreiecke,..). Durch Verwendung von Klassen können die Eigenschaften (Farbe, Text,..) jedes Objektes mit einfachen Befehlen verändert und beispielsweise in Arrays verwaltet werden.
Hier zwei Screenshots, die zeigen was man damit z.b. machen kann:
Die Unit zum Download gibts hier.
Ein OpenSource Demo Programm hier.
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: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456: 457: 458: 459: 460: 461: 462: 463: 464: 465: 466: 467: 468: 469: 470: 471: 472: 473: 474: 475: 476: 477: 478: 479: 480: 481: 482: 483: 484: 485: 486: 487: 488: 489: 490: 491: 492: 493: 494: 495: 496: 497: 498: 499: 500: 501: 502: 503: 504: 505: 506: 507: 508: 509: 510: 511: 512: 513: 514: 515: 516: 517: 518: 519: 520: 521: 522: 523: 524: 525: 526: 527: 528: 529: 530: 531: 532: 533: 534: 535: 536: 537: 538: 539: 540: 541: 542: 543: 544: 545: 546: 547: 548: 549: 550: 551: 552: 553: 554: 555: 556: 557: 558: 559: 560: 561: 562: 563: 564: 565: 566: 567: 568: 569: 570: 571: 572: 573: 574: 575: 576: 577: 578: 579: 580: 581: 582: 583: 584: 585: 586: 587: 588: 589: 590: 591: 592: 593: 594: 595: 596: 597: 598: 599: 600: 601: 602: 603: 604: 605: 606: 607: 608: 609: 610: 611: 612: 613: 614: 615: 616: 617:
|
unit GraVis;
interface
uses Classes, Graphics, Controls, ExtCtrls;
type TTriangle_Dir = (links, rechts);
TCircle = class private fx: Integer; fy: Integer; fWidth: Integer; fFarbe: TColor; fText: String; fImage: TImage; function get_int (index: integer): integer; procedure set_int (index: integer; value: integer); procedure set_col (value: tcolor); procedure set_str (value: string); procedure set_img (value: Timage); procedure paint; overload; virtual; procedure p_Circle; public constructor create; procedure paint (pImage: TImage); overload; virtual; procedure paint (px,py,pWidth: Integer; pImage: TImage); overload; published property x: integer index 0 read get_int write set_int; property y: integer index 1 read get_int write set_int; property width: integer index 2 read get_int write set_int; property farbe: tcolor read fFarbe write set_col; property text: string read fText write set_str; property image: TImage read fImage write set_img; end;
TRectangle = class (TCircle) private fHeight: Integer; procedure paint; overload; override; procedure set_HInt (value: integer); procedure p_Rectangle; public constructor create; procedure paint (pImage: TImage); overload; override; procedure paint (px,py,pWidth,pHeight: Integer; pImage: TImage); overload; published property height: integer read fHeight write set_HInt; end;
TRRectangle = class (TRectangle) private fRundung: cardinal; procedure set_card (value: cardinal); procedure paint; overload; override; procedure p_RRectangle; public constructor create; procedure paint (pImage: TImage); overload; override; procedure paint (px,py,pWidth,pHeight: Integer; pImage: TImage); overload; published property rundung: cardinal read fRundung write set_card; end;
TLine = class private fx: Integer; fy: Integer; fWidth: Integer; fHeight: Integer; fFarbe: TColor; fImage: TImage; function get_int (index: integer): integer; procedure set_int (index: integer; value: integer); procedure set_col (value: tcolor); procedure set_img (value: Timage); procedure paint; overload; procedure p_Line; public constructor create; procedure paint (pImage: TImage); overload; procedure paint (px,py,pWidth,pHeight: Integer; pImage: TImage); overload; published property x: integer index 0 read get_int write set_int; property y: integer index 1 read get_int write set_int; property width: integer index 2 read get_int write set_int; property height: integer index 3 read get_int write set_int; property farbe: tcolor read fFarbe write set_col; property image: TImage read fImage write set_img; end;
TTriangle = class private fx: integer; fy: integer; fheight: integer; fwidth: integer; fcolor: TColor; frichtung: TTriangle_Dir; fImage: TImage; function get_int (index: integer): integer; procedure set_int (index: integer; value: integer); procedure set_col (value: tcolor); procedure set_img (value: Timage); procedure set_dir (value: TTriangle_Dir); procedure paint; overload; procedure p_Triangle; public constructor create; procedure paint (pImage: TImage); overload; procedure paint (px,py: Integer); overload; procedure paint (px,py: Integer; pImage: TImage); overload; published property x: integer index 0 read get_int write set_int; property y: integer index 1 read get_int write set_int; property height: integer index 2 read get_int write set_int; property width: integer index 3 read get_int write set_int; property color: TColor read fcolor write set_col; property richtung: TTriangle_dir read frichtung write set_dir; property image: TImage read fimage write set_img; end;
procedure Refresh_Img (image: Timage);
implementation
constructor TCircle.create; begin fx:= 50; fy:= 50; fwidth:= 70; ffarbe:= clWhite; ftext:= ''; end;
function TCircle.get_int (index: integer): integer; begin case index of 0: result:= fx; 1: result:= fy; 2: result:= fWidth; else result:= 0; end; end;
procedure TCircle.set_int (index: integer; value: integer); begin case index of 0: fx:= value; 1: fy:= value; 2: fWidth:= value; else ; end; paint; end;
procedure TCircle.set_col (value: tcolor); begin fFarbe:= value; paint; end;
procedure TCircle.set_str (value: string); begin fText:= value; paint; end;
procedure TCircle.set_img (value: Timage); begin fImage:= value; paint; end;
procedure TCircle.p_Circle; var zen_x, zen_y: integer; begin with fImage.Canvas do begin Pen.Width:= 1; Brush.Color:= fFarbe; Ellipse (fx,fy-(fWidth div 2),fx+fWidth,fy+(fWidth div 2)); end;
if fText <> '' then begin zen_x:= ((fWidth div 2) + fx) - (fImage.Canvas.Textwidth (fText) div 2); zen_y:= fy - (fImage.Canvas.Textheight (fText) div 2); fImage.Canvas.Textout (zen_x, zen_y, fText); end; end;
procedure TCircle.paint; begin Refresh_img (fImage); p_Circle; end;
procedure TCircle.paint (pImage: TImage); begin if image <> pImage then fImage:= pImage; p_Circle; end;
procedure TCircle.paint (px,py,pWidth: Integer; pImage: TImage); begin if x <> px then fx:= px; if y <> py then fy:= py; if width <> pWidth then fWidth:= pWidth; if image <> pImage then fImage:= pImage; p_Circle; end;
constructor TRectangle.create; begin fx:= 50; fy:= 50; fHeight:= 40; fWidth:= 50; fFarbe:= clWhite; fText:= ''; end;
procedure TRectangle.set_HInt (value: Integer); begin fHeight:= value; paint; end;
procedure TRectangle.p_Rectangle; var zen_x, zen_y: integer; begin with fImage.Canvas do begin Pen.Width:= 1; Brush.Color:= ffarbe; Rectangle (fx,fy -(fHeight div 2),fx+fWidth,fy + (fHeight div 2)); end;
if fText <> '' then begin zen_x:= ((fWidth div 2) + fx) - (fImage.Canvas.Textwidth (fText) div 2); zen_y:= fy - (fImage.Canvas.Textheight (fText) div 2); fImage.Canvas.Textout (zen_x, zen_y, fText); end; end;
procedure TRectangle.paint (px,py,pWidth,pHeight: integer; pImage: TImage); begin if x <> px then fx:= px; if y <> py then fy:= py; if width <> pWidth then fWidth:= pWidth; if height <> pHeight then fHeight:= pHeight; if image <> pImage then fImage:= pImage; p_Rectangle; end;
procedure TRectangle.paint (pImage: TImage); begin if image <> pImage then fImage:= pImage; p_Rectangle; end;
procedure TRectangle.paint; begin Refresh_img (fImage); p_Rectangle; end;
constructor TRRectangle.create; begin fx:= 50; fy:= 50; fHeight:= 35; fWidth:= 70; fFarbe:= clWhite; fText:= ''; fRundung:= 35; end;
procedure TRRectangle.set_card (value: cardinal); begin fRundung:= value; paint; end;
procedure TRRectangle.p_RRectangle; var zen_x, zen_y: integer; begin with fImage.Canvas do begin Pen.Width:= 1; Brush.Color:= fFarbe; RoundRect (fx,fy-(fHeight div 2),fx+fWidth,fy + (fHeight div 2),fRundung,fRundung); end;
if fText <> '' then begin zen_x:= ((fWidth div 2) + fx) - (fImage.Canvas.Textwidth (fText) div 2); zen_y:= fy - (fImage.Canvas.Textheight (ftext) div 2); fImage.Canvas.Textout (zen_x, zen_y, fText); end; end;
procedure TRRectangle.paint; begin Refresh_img (fImage); p_RRectangle; end;
procedure TRRectangle.paint (pImage: TImage); begin if image <> pImage then fImage:= pImage; p_RRectangle; end;
procedure TRRectangle.paint (px,py,pWidth,pHeight: Integer; pImage: TImage); begin if x <> px then fx:= px; if y <> py then fy:= py; if width <> pWidth then fWidth:= pWidth; if height <> pHeight then fHeight:= pHeight; if image <> pImage then fImage:= pImage; p_RRectangle; end;
constructor TLine.create; begin fx:= 10; fy:= 10; fWidth:= 20; fHeight:= 0; fFarbe:= clBlack; end;
function TLine.get_int (index: integer): integer; begin case index of 0: result:= fx; 1: result:= fy; 2: result:= fWidth; 3: result:= fHeight; else result:= 0; end; end;
procedure TLine.set_int (index: integer; value: integer); begin case index of 0: fx:= value; 1: fy:= value; 2: fWidth:= value; 3: fHeight:= value; else ; end; paint; end;
procedure TLine.set_col (value: TColor); begin fFarbe:= value; paint; end;
procedure TLine.set_img (value: TImage); begin fImage:= value; paint; end;
procedure TLine.p_Line; begin with fImage.Canvas do begin Pen.Color:= fFarbe; MoveTo (fx,fy); LineTo (fx+fWidth,fy+fHeight); Pen.Color:= clblack; end; end;
procedure TLine.paint; begin Refresh_Img (fImage); p_Line; end;
procedure TLine.paint (pImage: TImage); begin if Image <> pImage then fImage:= pImage; p_Line; end;
procedure TLine.paint (px,py,pWidth,pHeight: Integer; pImage: TImage); begin if x <> px then fx:= px; if y <> py then fy:= py; if width <> pWidth then fWidth:= pWidth; if height <> pHeight then fHeight:= pHeight; if image <> pImage then fImage:= pImage; p_Line; end;
constructor TTriangle.create; begin fx:= 50; fy:= 50; fheight:= 40; fwidth:= 24; fcolor:= clred; frichtung:= rechts; fImage:= nil; end;
function TTriangle.get_int (index: integer): integer; begin case index of 0: result:= fx; 1: result:= fy; 2: result:= fHeight; 3: result:= fWidth; else result:= 0; end; end;
procedure TTriangle.set_int (index: integer; value: integer); begin case index of 0: fx:= value; 1: fy:= value; 2: fHeight:= value; 3: fWidth:= value; else ; end; paint; end;
procedure TTriangle.set_col (value: tcolor); begin fcolor:= value; paint; end;
procedure TTriangle.set_img (value: Timage); begin fImage:= value; paint; end;
procedure TTriangle.set_dir (value: TTriangle_Dir); begin frichtung:= value; paint; end;
procedure TTriangle.paint; begin Refresh_img (fImage); p_Triangle; end;
procedure TTriangle.paint (pImage: TImage); begin if image <> pImage then fImage:= pImage; p_Triangle; end;
procedure TTriangle.paint (px,py: Integer); begin if x <> px then fx:= px; if y <> py then fy:= py; p_Triangle; end;
procedure TTriangle.paint (px,py: Integer; pImage: TImage); begin if x <> px then fx:= px; if y <> py then fy:= py; if image <> pImage then fImage:= pImage; p_Triangle; end;
procedure TTriangle.p_Triangle; begin with fImage.Canvas do begin Pen.Width:= 1; Brush.Color:= fcolor;
if (richtung = rechts) then Polygon ([Point(fx,fy+(fheight div 2)), Point(fx,fy-(fheight div 2)), Point (fx+fwidth, fy)]) else if (richtung = links) then Polygon ([Point(fx,fy+(fheight div 2)), Point(fx,fy-(fheight div 2)), Point (fx-fwidth, fy)]); end; end;
procedure Refresh_Img (image: Timage); var Bitmap : TBitmap; begin begin with Image do Bitmap := nil; try Bitmap:= TBitmap.Create; Bitmap.Width := image.width; Bitmap.Height := image.height; Image.Picture.Graphic := Bitmap; finally Bitmap.Free; end; end; end;
end. |
Die Unit hab ich ursprünglich für zwei andere Programme geschrieben. Daher ist das ein oder andere auf jene Programme angepasst.
MfG
Jack Falworth
Moderiert von Udontknow: Code- durch Delphi-Tags ersetzt.
_________________ Andere zu kritisieren ist mitunter eine Möglichkeit, sich selbst ins bessere Licht zu setzen.
Zuletzt bearbeitet von Jack Falworth am Fr 21.01.05 18:49, insgesamt 2-mal bearbeitet
|
|
PhilGo
Beiträge: 315
Win 98, Win Longhorn ;-)
|
Verfasst: Do 16.09.04 11:13
Echt net schlecht!
_________________ Sie werden dich finden und töten... Söhne der großen Bärin!
|
|
Lhid
Beiträge: 831
|
Verfasst: Do 16.09.04 14:39
Meinung und mich grundlegend geändert-> alte beiträge gelöscht
Zuletzt bearbeitet von Lhid am Sa 26.09.09 14:33, insgesamt 1-mal bearbeitet
|
|
Jack Falworth
Beiträge: 222
Win XP Pro, Slackware 10.0
D5 Enterprise, C++, ABAP
|
Verfasst: Do 16.09.04 23:32
@Lhid: Was ist das genau (omoprhia)? Normalerweise hätte ich nichts dagegen, wenn die Unit verbreitet oder weiterverwendet wird. Dafür hab ich sie ja hier reingestellt
_________________ Andere zu kritisieren ist mitunter eine Möglichkeit, sich selbst ins bessere Licht zu setzen.
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Fr 17.09.04 11:33
Omorphia ist ein Projekt zur ERstellung von Multimedia- und Spiele-Anwendungen unabhängig von der Grafik-Schnittstelle (d.h. Unabhängig von DX oder OGL), je nach Verfügbarkeit dieser.
Näheres unter
www.de-schneider.de/omorphia/
sowie
sf.net/projects/omorphia/
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
Jack Falworth
Beiträge: 222
Win XP Pro, Slackware 10.0
D5 Enterprise, C++, ABAP
|
Verfasst: Fr 17.09.04 13:02
Jo von mir aus könnt ihr die Unit benutzen.
Achja zur Page: Ich finde das Negativ der Tussi etwas gewöhnungsbedürftig und der HTML Code ist einfach nur grausam. Da fehlen wichtige Sachen und man sollte fürs Layout keine Tables mehr benutzen. Aber das nur so am Rande.
_________________ Andere zu kritisieren ist mitunter eine Möglichkeit, sich selbst ins bessere Licht zu setzen.
|
|
G'Kar
Hält's aus hier
Beiträge: 2
|
Verfasst: Fr 21.01.05 14:03
Hi !
Zwei Fragen!
Im IMPLEMENTATION-Teil (Zeile 173 --> uses unit1; & Zeile 507 --> fImage:= form1.image1;) können wohl gelöscht werden? ODER?
MFG G'Kar
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Fr 21.01.05 14:13
Jip, kann weg ...
In Zeile 507 aber durch NIL esetzen!
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
Jack Falworth
Beiträge: 222
Win XP Pro, Slackware 10.0
D5 Enterprise, C++, ABAP
|
Verfasst: Fr 21.01.05 18:48
Jo das kann weg. Muss ich wohl übersehen haben.
Habs editiert.
MfG
Jack Falworth
_________________ Andere zu kritisieren ist mitunter eine Möglichkeit, sich selbst ins bessere Licht zu setzen.
|
|
|