DarkAxi0m

[Delphi] On Draw Canvas Arrow

2010-12-08T00:50:30-08:00

i have not done much to the way its drawn other than how i would Re-factor it.

moving the DrawArrow and DrawArrowPoint code into there own procedures so different arrow heads can be easily tried

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    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);
  public
    BeginPoint: Tpoint;
    EndPoint: Tpoint;
    procedure ReDraw;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



uses Math;

procedure DrawArrowPoint(canvas: Tcanvas; PtTop, PtA, PtB: Tpoint);
var
  HalfPt : TPoint;
  points : array of TPoint;
begin
  HalfPt := point((pta.x+ptb.x) div 2, (pta.y+ptb.y) div 2);
  //UnCommnet the next line for a differnt Shape
  //HalfPt := point((HalfPt.x+PtTop.x) div 2, (HalfPt.y+PtTop.y) div 2);
  setlength(points,5);

  points[0] := ptTop;
  points[1] := PtA;
  points[2] := HalfPt;
  points[3] := PtB;
  points[4] := ptTop;

  canvas.Polygon(points);
end;

procedure DrawArrow(canvas: Tcanvas; startPt: Tpoint; endPt: Tpoint;
  headLength: integer = 15; headAngle: integer = 30);
var
  C: extended;
  B1,B2 : extended;
  PtA: Tpoint;
  PtB: Tpoint;
begin
  if startPt.X <> endPt.X then // checks for division by zero
    c := ArcTan((startPt.Y - endPt.Y) / (startPt.X - endPt.X))
  else
    c := -ArcTan((startPt.Y - endPt.Y));

  if (startPt.X > endPt.X) then
   begin
     B1 := DegToRad(180-headAngle) - c ;
     B2 := -DegToRad(90+headAngle) + c ;
   end
  else
   begin
     B1 := DegToRad(headAngle) - c;
     B2 := DegToRad(90+headAngle) + c;
   end;

  PtA := point(endPt.X - Trunc(headLength * Cos(B1)), endPt.Y + Trunc(headLength * Sin(B1)));
  PtB := point(endPt.X - Trunc(headLength * Sin(B2)), endPt.Y + Trunc(headLength * Cos(B2)));

  canvas.PenPos := startPt;
  canvas.LineTo(endPt.x,endPt.y);
  DrawArrowPoint(canvas, endPt, PtA, PtB);
end;


procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  BeginPoint := point(X, y);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if ssLeft in shift then
    endPoint := point(x, y);
  redraw;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  endPoint := point(x, y);
  redraw;
end;

procedure TForm1.ReDraw;
begin
  Image1.canvas.Brush.color := clwhite;
  Image1.canvas.fillrect(Image1.ClientRect);
  Image1.canvas.Brush.color := clred;
  Image1.canvas.Pen.color := clblue;
  DrawArrow(Image1.canvas, BeginPoint, endPoint);
end;

end.

[Delphi] On TStrings IndexOfValue

2009-09-25T03:50:32-07:00

Sorry i should have made it more clear about the function, i will update the first post.

[Delphi] TStrings IndexOfValue

2009-09-23T03:46:09-07:00

this function finds the first match in stringlist
where the value part of a "name=value" pair is equal value passed.

Any thoughts on speeding this up?

function indexOfValue(list : TStrings; value : string): integer;
 begin
  Result := 0;
  while (Result < list.Count) and (not SameText(list.ValueFromIndex[Result], value)) do
    Inc(Result);
  if Result >= list.Count then
    Result := -1;
 end;

[Delphi] custom index for class(TList)

2009-02-12T05:17:56-08:00

I often find myself copying the following code and making changes to it when i want to search for something in a TList

can anyone see if it can be improved/speed up?

TMylist = class(TList);

Thankyou.

(delphi 7 code would be nice)

## Delphi 7 [pascal]
function TMylist.GetNameIndex(aName: Sting): integer;
var
  I:     integer;
begin
  i := 0;
  result := -1;

  while (i < Count - 1) and (not sametext(Items[i].name = aName)) do
      Inc(i);

  if sametext(Items[i].name = aName) then
    Result := i
end;


function TMylist.GetItems(Index: integer): TMylist;
begin
  Result := TMylist(inherited Items[index]);
end;

[Delphi] On Array Helper Functions

2009-02-03T23:14:02-08:00

Using Delphi 7;

Move seems to be fast,

CopyIntoArray, after a quick test looks like it returns the same results.

AppendToArray, I couldn't get to compile either versions.
Can not seem to do setlength on 'var Dest: Array of Byte;'

## Delphi 7 [pascal]
procedure CopyIntoArray(var DestArray: Array of Byte; SourceArray: Array of Byte; StartIndex: integer);
begin
 Move(SourceArray,DestArray[StartIndex],SizeOf(SourceArray));
end;

procedure AppendToArray(var Dest: Array of Byte; Source: Array of Byte);
begin
  SetLength(Dest,SizeOf(dest)+SizeOf(Source));
  Move(Source,Dest[SizeOf(dest)],SizeOf(Source));
end;