Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

 
 
Herramientas Buscar en Tema Desplegado
  #6  
Antiguo 03-04-2008
Avatar de Caral
[Caral] Caral is offline
Miembro Premium
 
Registrado: ago 2006
Posts: 7.659
Poder: 27
Caral Va por buen camino
Hola
Dibujando encima de un TImage lineas rectas, tambien se pueden hacer otras figuras.
Código Delphi [-]
unit Unit1;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus;

type
  TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    BrushStyle: TBrushStyle;
    PenStyle: TPenStyle;
    PenWide: Integer;
    Drawing: Boolean;
    Origin, MovePt: TPoint;
    DrawingTool: TDrawingTool;
    CurrentFile: string;
    procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  AnteriorBkMode: integer;
begin
  Drawing := True;
  Image1.Canvas.MoveTo(X, Y);
  Origin := Point(X, Y);
  MovePt := Origin;
 with Image1.Canvas do begin
  Brush.Color := clBlack;
  AnteriorBkMode := SetBkMode(Handle, TRANSPARENT);
  SetBkMode(Handle, AnteriorBkMode);
end;

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if Drawing then
  begin
    DrawShape(Origin, MovePt, pmNotXor);
    MovePt := Point(X, Y);
    DrawShape(Origin, MovePt, pmNotXor);
  end;
end;


procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
  with Image1.Canvas do
  begin
    Pen.Mode := AMode;
    case DrawingTool of
      dtLine:
        begin
          Image1.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
          Image1.Canvas.LineTo(BottomRight.X, BottomRight.Y);
        end;
      dtRectangle: Image1.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
        BottomRight.Y);
      dtEllipse: Image1.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,
        BottomRight.Y);
      dtRoundRect: Image1.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,
        BottomRight.Y, (TopLeft.X - BottomRight.X) div 2,
        (TopLeft.Y - BottomRight.Y) div 2);
    end;
  end;
end;


procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if Drawing then
  begin
    DrawShape(Origin, Point(X, Y), pmCopy);
    Drawing := False;
  end;
end;

end.
Saludos
Responder Con Cita
 


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Ver un html dentro de un formulario c++. LordSarevok C++ Builder 4 23-04-2007 16:59:47
Tomar lineas dentro de un Memo ?? Coco_jac Varios 9 09-02-2006 07:14:24
Modo diseño y modo ejecución buildero_d OOP 3 11-09-2005 06:45:00
Asignar en tiempo de diseño un datafield dentro de un informe melanthea C++ Builder 7 25-06-2004 18:35:35


La franja horaria es GMT +2. Ahora son las 19:17:20.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi