klavuz çizgisi - Baskı Önizleme

klavuz çizgisi - Baskı Önizleme

+- Delphi Can (https://www.delphican.com)
+-- Forum: Delphi (https://www.delphican.com/forumdisplay.php?fid=3)
+--- Forum: Genel Programlama (https://www.delphican.com/forumdisplay.php?fid=6)
+--- Konu Başlığı: klavuz çizgisi (/showthread.php?tid=2388)

Sayfalar: 1 2 3 4

klavuz çizgisi - murtishow76 - 01-07-2018

[attachment=268]
fotoğraftaki gibi klavuz çizgileri nasıl yapabilirim panelin en üstte olacak şekilde

klavuz çizgisi - canbir - 01-07-2018

renklendirme önemli değilse bevel bileşeni ile yapılabilir.

Cvp: klavuz çizgisi - narkotik - 01-07-2018

(01-07-2018, Saat: 08:46)murtishow76 Adlı Kullanıcıdan Alıntı: fotoğraftaki gibi klavuz çizgileri nasıl yapabilirim panelin en üstte olacak şekilde

Senin İçin Dikey Olarak Yaptım. Yatayları Sen Yap. Sürükleme Şeklinde değişiyor konum.
Exe Kod Link

unit Unit1;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Panel1: TPanel;
   procedure Button1Click(Sender: TObject);
 private
   procedure LMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   procedure LMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   procedure LMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
implementation
 uses Line;
{$R *.dfm}


procedure TForm1.LMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 if TLine(Sender).LDragging then
 begin
   TLine(Sender).Left := TLine(Sender).LStartingLocation.X + (Mouse.CursorPos.X - TLine(Sender).LMouseDownLocation.X);
//    ShowMessage(TLine(Sender).Left.ToString);
   TLine(Sender).Invalidate;
 end;
end;

procedure TForm1.LMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 TLine(Sender).LDragging := true;
 TLine(Sender).LMouseDownLocation := Mouse.CursorPos;
 TLine(Sender).LStartingLocation := TPoint.Create(TLine(Sender).Left, TLine(Sender).Top);
end;

procedure TForm1.LMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 TLine(Sender).LDragging := false;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
 L   : TLine;
 L2  : TLine;
 Pn : TPen;
begin
 Pn         := TPen.Create;
 Pn.Color   := clGreen;
 Pn.Width   := 3;
 L          := TLine.Create(Panel1);
 L.Parent   := Panel1;
 L.Angle    := 90;
 L.Height   := Panel1.Height;
 L.Pen      := Pn;
 L.OnMouseDown := LMouseDown;
 L.OnMouseMove := LMouseMove;
 L.OnMouseUp := LMouseUp;
 L2          := TLine.Create(Panel1);
 L2.Parent   := Panel1;
 L2.Angle    := 90;
 L2.Height   := Panel1.Height;
 L2.Pen      := Pn;
 L2.OnMouseDown := LMouseDown;
 L2.OnMouseMove := LMouseMove;
 L2.OnMouseUp := LMouseUp;
 L2.Left     := 20;
//  L.le
end;

end.

unit Line;

interface

uses
 Windows, Classes, Controls, Graphics, StdCtrls, Math;

type
 TLine = class(TGraphicControl)
 private
   FAlignment: TAlignment;
   FAngle: Integer;
   FAutoAngle: Boolean;
   FLayout: TTextLayout;
   FPen: TPen;
   FLMouseDownLocation: TPoint;
   FLStartingLocation: TPoint;
   FLDragging: boolean;
   function DiagonalAngle: Integer;
   function GetBackwards: Boolean;
   function GetExtends(LimitWidth, LimitHeight: Integer): TRect;
   procedure PenChanged(Sender: TObject);
   procedure SetAlignment(Value: TAlignment);
   procedure SetAngle(Value: Integer);
   procedure SetAutoAngle(Value: Boolean);
   procedure SetBackwards(Value: Boolean);
   procedure SetLayout(Value: TTextLayout);
   procedure SetPen(Value: TPen);
   procedure SetLDragging(const Value: boolean);
   procedure SetLMouseDownLocation(const Value: TPoint);
   procedure SetLStartingLocation(const Value: TPoint);
 protected
   procedure AdjustSize; override;
   function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
   procedure Paint; override;
   procedure Resize; override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property LDragging : boolean read FLDragging write SetLDragging;
   property LMouseDownLocation : TPoint read FLMouseDownLocation write SetLMouseDownLocation;
   property LStartingLocation : TPoint read FLStartingLocation write SetLStartingLocation;
   property Align;
   property Alignment: TAlignment read FAlignment write SetAlignment
     default taCenter;
   property Anchors;
   property Angle: Integer read FAngle write SetAngle;
   property AutoAngle: Boolean read FAutoAngle write SetAutoAngle
     default True;
   property AutoSize;
   property Backwards: Boolean read GetBackwards write SetBackwards
     stored False;
   property Constraints;
   property DragCursor;
   property DragKind;
   property DragMode;
   property Enabled;
   property Layout: TTextLayout read FLayout write SetLayout default tlCenter;
   property OnContextPopup;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDock;
   property OnStartDrag;
   property ParentShowHint;
   property Pen: TPen read FPen write SetPen;
   property ShowHint;
   property Visible;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Samples', [TLine]);
end;

{ TLine }

procedure TLine.AdjustSize;
begin
 if AutoSize then
   FAutoAngle := False;
 inherited AdjustSize;
end;

function TLine.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
 with GetExtends(NewWidth, NewHeight) do
 begin
   NewWidth := Right;
   NewHeight := Bottom;
 end;
 Result := True;
end;

constructor TLine.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 ControlStyle := ControlStyle + [csReplicatable];
 Width := 65;
 Height := 65;
 FPen := TPen.Create;
 FPen.OnChange := PenChanged;
 FAlignment := taCenter;
 FLayout := tlCenter;
 FAutoAngle := True;
end;

destructor TLine.Destroy;
begin
 FPen.Free;
 inherited Destroy;
end;

function TLine.DiagonalAngle: Integer;
begin
 if Width = FPen.Width then
   Result := 90
 else if Height = FPen.Width then
   Result := 0
 else
   if Backwards then
     Result := 180 - Round(RadToDeg(ArcTan(Height / Width)))
   else
     Result := Round(RadToDeg(ArcTan(Height / Width)));
end;

function TLine.GetBackwards: Boolean;
begin
 Result := FAngle > 90;
end;

function TLine.GetExtends(LimitWidth, LimitHeight: Integer): TRect;
begin
 Result.Left := 0;
 Result.Top := 0;
 if FAngle = 0 then
 begin
   Result.Right := LimitWidth;
   Result.Bottom := FPen.Width;
 end
 else if FAngle = 90 then
 begin
   Result.Right := FPen.Width;
   Result.Bottom := LimitHeight;
 end
 else
 begin
   Result.Right := Min(LimitWidth,
     Round(LimitHeight / Abs(Tan(DegToRad(FAngle)))));
   Result.Bottom := Min(LimitHeight,
     Round(LimitWidth * Abs(Tan(DegToRad(FAngle)))));
 end;
end;

procedure TLine.Paint;
var
 R: TRect;
begin
 Canvas.Pen.Assign(FPen);
 Canvas.Brush.Style := bsClear;
 R := GetExtends(Width, Height);
 case FAlignment of
   taCenter:
     OffsetRect(R, (Width - R.Right) div 2, 0);
   taRightJustify:
     OffsetRect(R, Width - R.Right, 0);
 end;
 case FLayout of
   tlCenter:
     OffsetRect(R, 0, (Height - R.Bottom) div 2);
   tlBottom:
     OffsetRect(R, 0, Height - R.Bottom);
 end;
 if FAngle = 0 then
 begin
   Canvas.MoveTo(R.Left, R.Top + FPen.Width div 2);
   Canvas.LineTo(R.Right, R.Top + FPen.Width div 2);
 end
 else if FAngle = 90 then
 begin
   Canvas.MoveTo(R.Left + FPen.Width div 2, R.Top);
   Canvas.LineTo(R.Left + FPen.Width div 2, R.Bottom);
 end
 else if FAngle < 90 then
 begin
   Canvas.MoveTo(R.Left, R.Bottom);
   Canvas.LineTo(R.Right, R.Top);
 end
 else
 begin
   Canvas.MoveTo(R.Left, R.Top);
   Canvas.LineTo(R.Right, R.Bottom);
 end;
end;

procedure TLine.PenChanged(Sender: TObject);
begin
 AdjustSize;
 Invalidate;
end;

procedure TLine.Resize;
begin
 if FAutoAngle then
   Angle := DiagonalAngle;
 inherited Resize;
end;

procedure TLine.SetAlignment(Value: TAlignment);
begin
 if FAlignment <> Value then
 begin
   FAlignment := Value;
   Invalidate;
 end;
end;

procedure TLine.SetAngle(Value: Integer);
begin
 while Value < 0 do
   Inc(Value, 180);
 while Value >= 180 do
   Dec(Value, 180);
 if FAngle <> Value then
 begin
   FAngle := Value;
   if FAngle <> DiagonalAngle then
     FAutoAngle := False;
   if AutoSize then
     AdjustSize;
   Invalidate;
 end;
end;

procedure TLine.SetAutoAngle(Value: Boolean);
begin
 if FAutoAngle <> Value then
 begin
   FAutoAngle := Value;
   if FAutoAngle then
   begin
     AutoSize := False;
     Angle := DiagonalAngle;
   end;
 end;
end;

procedure TLine.SetBackwards(Value: Boolean);
begin
 if Backwards <> Value then
   Angle := 180 - FAngle;
end;

procedure TLine.SetLayout(Value: TTextLayout);
begin
 if FLayout <> Value then
 begin
   FLayout := Value;
   Invalidate;
 end;
end;

procedure TLine.SetLDragging(const Value: boolean);
begin
 FLDragging := Value;
end;

procedure TLine.SetLMouseDownLocation(const Value: TPoint);
begin
 FLMouseDownLocation := Value;
end;

procedure TLine.SetLStartingLocation(const Value: TPoint);
begin
 FLStartingLocation := Value;
end;

procedure TLine.SetPen(Value: TPen);
begin
 FPen.Assign(Value);
end;

end.

Cvp: klavuz çizgisi - murtishow76 - 01-07-2018

(01-07-2018, Saat: 13:11)narkotik Adlı Kullanıcıdan Alıntı:

(01-07-2018, Saat: 08:46)murtishow76 Adlı Kullanıcıdan Alıntı: fotoğraftaki gibi klavuz çizgileri nasıl yapabilirim panelin en üstte olacak şekilde

Senin İçin Dikey Olarak Yaptım. Yatayları Sen Yap. Sürükleme Şeklinde değişiyor konum.
Exe Kod Link

unit Unit1;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Panel1: TPanel;
   procedure Button1Click(Sender: TObject);
 private
   procedure LMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   procedure LMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   procedure LMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
implementation
 uses Line;
{$R *.dfm}


procedure TForm1.LMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 if TLine(Sender).LDragging then
 begin
   TLine(Sender).Left := TLine(Sender).LStartingLocation.X + (Mouse.CursorPos.X - TLine(Sender).LMouseDownLocation.X);
//    ShowMessage(TLine(Sender).Left.ToString);
   TLine(Sender).Invalidate;
 end;
end;

procedure TForm1.LMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 TLine(Sender).LDragging := true;
 TLine(Sender).LMouseDownLocation := Mouse.CursorPos;
 TLine(Sender).LStartingLocation := TPoint.Create(TLine(Sender).Left, TLine(Sender).Top);
end;

procedure TForm1.LMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 TLine(Sender).LDragging := false;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
 L   : TLine;
 L2  : TLine;
 Pn : TPen;
begin
 Pn         := TPen.Create;
 Pn.Color   := clGreen;
 Pn.Width   := 3;
 L          := TLine.Create(Panel1);
 L.Parent   := Panel1;
 L.Angle    := 90;
 L.Height   := Panel1.Height;
 L.Pen      := Pn;
 L.OnMouseDown := LMouseDown;
 L.OnMouseMove := LMouseMove;
 L.OnMouseUp := LMouseUp;
 L2          := TLine.Create(Panel1);
 L2.Parent   := Panel1;
 L2.Angle    := 90;
 L2.Height   := Panel1.Height;
 L2.Pen      := Pn;
 L2.OnMouseDown := LMouseDown;
 L2.OnMouseMove := LMouseMove;
 L2.OnMouseUp := LMouseUp;
 L2.Left     := 20;
//  L.le
end;

end.

unit Line;

interface

uses
 Windows, Classes, Controls, Graphics, StdCtrls, Math;

type
 TLine = class(TGraphicControl)
 private
   FAlignment: TAlignment;
   FAngle: Integer;
   FAutoAngle: Boolean;
   FLayout: TTextLayout;
   FPen: TPen;
   FLMouseDownLocation: TPoint;
   FLStartingLocation: TPoint;
   FLDragging: boolean;
   function DiagonalAngle: Integer;
   function GetBackwards: Boolean;
   function GetExtends(LimitWidth, LimitHeight: Integer): TRect;
   procedure PenChanged(Sender: TObject);
   procedure SetAlignment(Value: TAlignment);
   procedure SetAngle(Value: Integer);
   procedure SetAutoAngle(Value: Boolean);
   procedure SetBackwards(Value: Boolean);
   procedure SetLayout(Value: TTextLayout);
   procedure SetPen(Value: TPen);
   procedure SetLDragging(const Value: boolean);
   procedure SetLMouseDownLocation(const Value: TPoint);
   procedure SetLStartingLocation(const Value: TPoint);
 protected
   procedure AdjustSize; override;
   function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
   procedure Paint; override;
   procedure Resize; override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property LDragging : boolean read FLDragging write SetLDragging;
   property LMouseDownLocation : TPoint read FLMouseDownLocation write SetLMouseDownLocation;
   property LStartingLocation : TPoint read FLStartingLocation write SetLStartingLocation;
   property Align;
   property Alignment: TAlignment read FAlignment write SetAlignment
     default taCenter;
   property Anchors;
   property Angle: Integer read FAngle write SetAngle;
   property AutoAngle: Boolean read FAutoAngle write SetAutoAngle
     default True;
   property AutoSize;
   property Backwards: Boolean read GetBackwards write SetBackwards
     stored False;
   property Constraints;
   property DragCursor;
   property DragKind;
   property DragMode;
   property Enabled;
   property Layout: TTextLayout read FLayout write SetLayout default tlCenter;
   property OnContextPopup;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDock;
   property OnStartDrag;
   property ParentShowHint;
   property Pen: TPen read FPen write SetPen;
   property ShowHint;
   property Visible;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Samples', [TLine]);
end;

{ TLine }

procedure TLine.AdjustSize;
begin
 if AutoSize then
   FAutoAngle := False;
 inherited AdjustSize;
end;

function TLine.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
 with GetExtends(NewWidth, NewHeight) do
 begin
   NewWidth := Right;
   NewHeight := Bottom;
 end;
 Result := True;
end;

constructor TLine.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 ControlStyle := ControlStyle + [csReplicatable];
 Width := 65;
 Height := 65;
 FPen := TPen.Create;
 FPen.OnChange := PenChanged;
 FAlignment := taCenter;
 FLayout := tlCenter;
 FAutoAngle := True;
end;

destructor TLine.Destroy;
begin
 FPen.Free;
 inherited Destroy;
end;

function TLine.DiagonalAngle: Integer;
begin
 if Width = FPen.Width then
   Result := 90
 else if Height = FPen.Width then
   Result := 0
 else
   if Backwards then
     Result := 180 - Round(RadToDeg(ArcTan(Height / Width)))
   else
     Result := Round(RadToDeg(ArcTan(Height / Width)));
end;

function TLine.GetBackwards: Boolean;
begin
 Result := FAngle > 90;
end;

function TLine.GetExtends(LimitWidth, LimitHeight: Integer): TRect;
begin
 Result.Left := 0;
 Result.Top := 0;
 if FAngle = 0 then
 begin
   Result.Right := LimitWidth;
   Result.Bottom := FPen.Width;
 end
 else if FAngle = 90 then
 begin
   Result.Right := FPen.Width;
   Result.Bottom := LimitHeight;
 end
 else
 begin
   Result.Right := Min(LimitWidth,
     Round(LimitHeight / Abs(Tan(DegToRad(FAngle)))));
   Result.Bottom := Min(LimitHeight,
     Round(LimitWidth * Abs(Tan(DegToRad(FAngle)))));
 end;
end;

procedure TLine.Paint;
var
 R: TRect;
begin
 Canvas.Pen.Assign(FPen);
 Canvas.Brush.Style := bsClear;
 R := GetExtends(Width, Height);
 case FAlignment of
   taCenter:
     OffsetRect(R, (Width - R.Right) div 2, 0);
   taRightJustify:
     OffsetRect(R, Width - R.Right, 0);
 end;
 case FLayout of
   tlCenter:
     OffsetRect(R, 0, (Height - R.Bottom) div 2);
   tlBottom:
     OffsetRect(R, 0, Height - R.Bottom);
 end;
 if FAngle = 0 then
 begin
   Canvas.MoveTo(R.Left, R.Top + FPen.Width div 2);
   Canvas.LineTo(R.Right, R.Top + FPen.Width div 2);
 end
 else if FAngle = 90 then
 begin
   Canvas.MoveTo(R.Left + FPen.Width div 2, R.Top);
   Canvas.LineTo(R.Left + FPen.Width div 2, R.Bottom);
 end
 else if FAngle < 90 then
 begin
   Canvas.MoveTo(R.Left, R.Bottom);
   Canvas.LineTo(R.Right, R.Top);
 end
 else
 begin
   Canvas.MoveTo(R.Left, R.Top);
   Canvas.LineTo(R.Right, R.Bottom);
 end;
end;

procedure TLine.PenChanged(Sender: TObject);
begin
 AdjustSize;
 Invalidate;
end;

procedure TLine.Resize;
begin
 if FAutoAngle then
   Angle := DiagonalAngle;
 inherited Resize;
end;

procedure TLine.SetAlignment(Value: TAlignment);
begin
 if FAlignment <> Value then
 begin
   FAlignment := Value;
   Invalidate;
 end;
end;

procedure TLine.SetAngle(Value: Integer);
begin
 while Value < 0 do
   Inc(Value, 180);
 while Value >= 180 do
   Dec(Value, 180);
 if FAngle <> Value then
 begin
   FAngle := Value;
   if FAngle <> DiagonalAngle then
     FAutoAngle := False;
   if AutoSize then
     AdjustSize;
   Invalidate;
 end;
end;

procedure TLine.SetAutoAngle(Value: Boolean);
begin
 if FAutoAngle <> Value then
 begin
   FAutoAngle := Value;
   if FAutoAngle then
   begin
     AutoSize := False;
     Angle := DiagonalAngle;
   end;
 end;
end;

procedure TLine.SetBackwards(Value: Boolean);
begin
 if Backwards <> Value then
   Angle := 180 - FAngle;
end;

procedure TLine.SetLayout(Value: TTextLayout);
begin
 if FLayout <> Value then
 begin
   FLayout := Value;
   Invalidate;
 end;
end;

procedure TLine.SetLDragging(const Value: boolean);
begin
 FLDragging := Value;
end;

procedure TLine.SetLMouseDownLocation(const Value: TPoint);
begin
 FLMouseDownLocation := Value;
end;

procedure TLine.SetLStartingLocation(const Value: TPoint);
begin
 FLStartingLocation := Value;
end;

procedure TLine.SetPen(Value: TPen);
begin
 FPen.Assign(Value);
end;

end.

emek vermişsiniz çok teşekkür ederim ancak t panele bir şey eklendiğinde çizgiler allta kalıyor yani çizgi her daim üstte olması lazım

klavuz çizgisi - narkotik - 01-07-2018

BringtoFront yaparsanız çözülür

Cvp: klavuz çizgisi - murtishow76 - 01-07-2018

(01-07-2018, Saat: 18:51)narkotik Adlı Kullanıcıdan Alıntı: BringtoFront yaparsanız çözülür

çözülmedi

klavuz çizgisi - narkotik - 01-07-2018

Şuan deneme şansım yok fakat tahminimce TGraphicControlden türediği için aynı panel içerisinde nesnelerde bringtofront çalışmaz. BringttoFront ve SendtoBack için nesneler farklı paneller içerisinde kullanılmalı diye hatırlıyorum. Panelin bringtofront oynanmalı.

Cvp: klavuz çizgisi - murtishow76 - 02-07-2018

(01-07-2018, Saat: 20:06)narkotik Adlı Kullanıcıdan Alıntı: Şuan deneme şansım yok fakat tahminimce TGraphicControlden türediği için aynı panel içerisinde nesnelerde bringtofront çalışmaz. BringttoFront ve SendtoBack için nesneler farklı paneller içerisinde kullanılmalı diye hatırlıyorum. Panelin bringtofront oynanmalı.

KONUYLA İLGİLİ guideline diye hiç bir bilgi bulamadım nette

klavuz çizgisi - boreas - 02-07-2018

ben eskiden tshape kullanarak yapmıştım.

klavuz çizgisi - murtishow76 - 02-07-2018

herhangi bir controle çizgi çizmek basit lakin çizdiğimiz kontrol diğer kontrolllerin en üstünde seffaf olacak ve altındaki kontroller kullanılabilir olacak

kafayı yememe az kaldı hemen hemen grafikle ilgili her programda bu klavuz çizgileri mevcut ama delphi ile kaynak yok nerede yanlış yapıyorum (arıyorum) bilemedim üstadlardan bu konuda yardım istiyorum....