如何在stringGrid 中显示 选择虚线框?(200分)

  • 主题发起人 主题发起人 let_it_be
  • 开始时间 开始时间
L

let_it_be

Unregistered / Unconfirmed
GUEST, unregistred user!
在stringGrid 上面,按住鼠标左键,移动鼠标,在鼠标移动过的区域显示虚线框,就像在explorer 在选择文件一样,
这个功能怎么实现?
 
本身STRINGGRID选择的时候就好多块,不好么,不也是一样。
 
你可以参考DELPHI的绘图例子啊。
GraphEx
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := True;
Image.Canvas.MoveTo(X, Y);
Origin := Point(X, Y);
MovePt := Origin;
StatusBar1.Panels[0].Text := Format('Origin: (%d, %d)', [X, Y]);
end;

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

procedure TForm1.FormMouseMove(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;
StatusBar1.Panels[1].Text := Format('Current: (%d, %d)', [X, Y]);
end;
 
StringGrid1.Canvas.DrawFocusRect(Rect);
 
那就在listView 上面 画 选择虚线框 怎么画?
 
//蚂蚁线
unit ScreenMarchingAnts;

interface

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

type
TFormMarchingAnts = class(TForm)
Timer1: TTimer;
Image1: TImage;
Image3: TImage;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);

procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
X1, Y1, X2, Y2: Integer;

procedure RemoveTheRect;
procedure DrawTheRect;
public
{ Public declarations }
end;

var
FormMarchingAnts: TFormMarchingAnts;
Counter: Byte;
CounterStart: Byte;
Looper: LongInt;

implementation
{$R *.DFM}


procedure RestrictCursorToDrawingArea(const Image: TImage);
var
CursorClipArea: TRect;
begin
CursorClipArea := Bounds(Image.ClientOrigin.X, Image.ClientOrigin.Y,
Image.Width, Image.Height);
Windows.ClipCursor(@CursorClipArea)
end {RestrictCursorToDrawingArea};


procedure RemoveCursorRestrictions;
begin
Windows.ClipCursor(nil)
end {RemoveCursorRestrictions};


procedure MovingDots(X, Y: Integer; TheCanvas: TCanvas); stdcall;
begin
Inc(Looper);
{$R-}
Counter := Counter shl 1; // Shift the bit left one
{$R+}
if Counter = 0
then Counter := 1; // If it shifts off left, reset it
if (Counter and 224) > 0 // Are any of the left 3 bits set?
then TheCanvas.Pixels[X, Y] := clWhite // Erase the pixel
else TheCanvas.Pixels[X, Y] := clBlack; // Draw the pixel
end;


function NormalizeRect(R: TRect): TRect;
begin
// This routine normalizes a rectangle. It makes sure that the Left,Top
// coords are always above and to the left of the Bottom,Right coords.
with R do
begin
if Left > Right
then
if Top > Bottom
then Result := Rect(Right, Bottom, Left, Top)
else Result := Rect(Right, Top, Left, Bottom)
else
if Top > Bottom
then Result := Rect(Left, Bottom, Right, Top)
else Result := Rect(Left, Top, Right, Bottom);
end
end;


procedure TFormMarchingAnts.FormCreate(Sender: TObject);
begin
X1 := 0;
Y1 := 0;
X2 := 0;
Y2 := 0;
Canvas.Pen.Color := Color;
Canvas.Brush.Color := Color;
CounterStart := 128;
Timer1.Interval := 100;
Timer1.Enabled := True;
Looper := 0;
self.DoubleBuffered := true;
FormMarchingAnts.ControlStyle := FormMarchingAnts.ControlStyle + [csOpaque];
end;


procedure TFormMarchingAnts.RemoveTheRect;
var
R: TRect;
begin
R := NormalizeRect(Rect(X1, Y1, X2, Y2)); // Rectangle might be flipped
InflateRect(R, 1, 1); // Make the rectangle 1 pixel larger , 其实是left-1,right+1,故而widht加2 ,top和bottom相似
InvalidateRect(Handle, @R, True); // Mark the area as invalid
InflateRect(R, -2, -2); // Now shrink the rectangle 2 pixels
ValidateRect(Handle, @R); // And validate this new rectangle.
// This leaves a 2 pixel band all the way around
// the rectangle that will be erased & redrawn
UpdateWindow(Handle);
end;

procedure TFormMarchingAnts.DrawTheRect;
begin
// Determines starting pixel color of Rect
Counter := CounterStart;
// Use LineDDA to draw each of the 4 edges of the rectangle
LineDDA(X1, Y1, X2, Y1, @MovingDots, LongInt(Canvas));
LineDDA(X2, Y1, X2, Y2, @MovingDots, LongInt(Canvas));
LineDDA(X2, Y2, X1, Y2, @MovingDots, LongInt(Canvas));
LineDDA(X1, Y2, X1, Y1, @MovingDots, LongInt(Canvas));
end;


procedure TFormMarchingAnts.Timer1Timer(Sender: TObject);
begin
CounterStart := CounterStart shr 2; // Shl 1 will move rect slower
if CounterStart = 0 // If bit is lost, reset it
then CounterStart := 128;
DrawTheRect // Draw the rectangle
end;


// ===================================================================
// Use "quick and dirty" fix to get ants to march on top of an image

procedure TFormMarchingAnts.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
X := X + (Sender as TImage).Left;
Y := Y + (Sender as TImage).Top;

RemoveTheRect; // Erase any existing rectangle
X1 := X;
Y1 := Y;

X2 := X;
Y2 := Y;

// Force mouse movement to stay within TImage
RestrictCursorToDrawingArea((Sender as TImage))
end;



procedure TFormMarchingAnts.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift
then begin
X := X + (Sender as TImage).Left;
Y := Y + (Sender as TImage).top;

RemoveTheRect; // Erase any existing rectangle
X2 := X; Y2 := Y; // Save the new corner where the mouse is
DrawTheRect; // Draw the Rect now... don't wait for the timer!
end;
end;


procedure TFormMarchingAnts.ImageMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
RemoveCursorRestrictions
end;

end.
 
参考 Tsplitter 的 代码,特别是移动时候大代码
 
多人接受答案了。
 

Similar threads

D
回复
0
查看
825
DelphiTeacher的专栏
D
D
回复
0
查看
831
DelphiTeacher的专栏
D
D
回复
0
查看
664
DelphiTeacher的专栏
D
D
回复
0
查看
824
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部