?? dwinctl.pas
字號:
end;
Result := y;
end;
procedure TDControl.AddChild (dcon: TDControl);
begin
DControls.Add (Pointer (dcon));
end;
//把指定的控件移動到控件列表的最后面
procedure TDControl.ChangeChildOrder (dcon: TDControl);
var
i: integer;
begin
if not (dcon is TDWindow) then exit;
if TDWindow(dcon).Floating then begin
for i:=0 to DControls.Count-1 do begin
if dcon = DControls[i] then begin
DControls.Delete (i);
break;
end;
end;
DControls.Add (dcon);
end;
end;
//判斷一點是否在當前控件范圍內
function TDControl.InRange (x, y: integer): Boolean;
var
inrange: Boolean;
d: TDirectDrawSurface;
begin
if (x >= Left) and (x < Left+Width) and (y >= Top) and (y < Top+Height) then begin
inrange := TRUE;
if Assigned (FOnInRealArea) then
FOnInRealArea(self, x-Left, y-Top, inrange)
else
if WLib <> nil then begin
d := WLib.Images[FaceIndex];
if d <> nil then
if d.Pixels[x-Left, y-Top] <= 0 then
inrange := FALSE;
end;
Result := inrange;
end else
Result := FALSE;
end;
function TDControl.KeyPress (var Key: Char): Boolean;
var
i: integer;
begin
Result := FALSE;
if Background then exit;
for i:=DControls.Count-1 downto 0 do
if TDControl(DControls[i]).Visible then
if TDControl(DControls[i]).KeyPress(Key) then begin
Result := TRUE;
exit;
end;
if (FocusedControl=self) then begin
if Assigned (FOnKeyPress) then FOnKeyPress (self, Key);
Result := TRUE;
end;
end;
function TDControl.KeyDown (var Key: Word; Shift: TShiftState): Boolean;
var
i: integer;
begin
Result := FALSE;
if Background then exit;
for i:=DControls.Count-1 downto 0 do
if TDControl(DControls[i]).Visible then
if TDControl(DControls[i]).KeyDown(Key, Shift) then begin
Result := TRUE;
exit;
end;
if (FocusedControl=self) then begin
if Assigned (FOnKeyDown) then FOnKeyDown (self, Key, Shift);
Result := TRUE;
end;
end;
function TDControl.CanFocusMsg: Boolean;
begin
Result :=(MouseCaptureControl = nil) or
((MouseCaptureControl <> nil) and
((MouseCaptureControl=self) or
(MouseCaptureControl=DParent)));
end;
function TDControl.MouseMove (Shift: TShiftState; X, Y: Integer): Boolean;
var
i: integer;
begin
Result := FALSE;
for i:=DControls.Count-1 downto 0 do
if TDControl(DControls[i]).Visible then
if TDControl(DControls[i]).MouseMove(Shift, X-Left, Y-Top) then begin
Result := TRUE;
exit;
end;
if (MouseCaptureControl <> nil) then begin //MouseCapture 撈擱 磊腳撈 快急
if (MouseCaptureControl = self) then begin
if Assigned (FOnMouseMove) then
FOnMouseMove (self, Shift, X, Y);
Result := TRUE;
end;
exit;
end;
if Background then exit;
if InRange (X, Y) then begin
if Assigned (FOnMouseMove) then
FOnMouseMove (self, Shift, X, Y);
Result := TRUE;
end;
end;
function TDControl.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
var
i: integer;
begin
Result := FALSE;
for i:=DControls.Count-1 downto 0 do
if TDControl(DControls[i]).Visible then
if TDControl(DControls[i]).MouseDown(Button, Shift, X-Left, Y-Top) then begin
Result := TRUE;
exit;
end;
if Background then begin
if Assigned (FOnBackgroundClick) then begin
WantReturn := FALSE;
FOnBackgroundClick (self);
if WantReturn then Result := TRUE;
end;
ReleaseDFocus;
exit;
end;
if CanFocusMsg then begin
if InRange (X, Y) or (MouseCaptureControl = self) then begin
if Assigned (FOnMouseDown) then
FOnMouseDown (self, Button, Shift, X, Y);
if EnableFocus then SetDFocus (self);
Result := TRUE;
end;
end;
end;
function TDControl.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
var
i: integer;
begin
Result := FALSE;
for i:=DControls.Count-1 downto 0 do
if TDControl(DControls[i]).Visible then
if TDControl(DControls[i]).MouseUp(Button, Shift, X-Left, Y-Top) then begin
Result := TRUE;
exit;
end;
if (MouseCaptureControl <> nil) then begin //MouseCapture 撈擱 磊腳撈 快急
if (MouseCaptureControl = self) then begin
if Assigned (FOnMouseUp) then
FOnMouseUp (self, Button, Shift, X, Y);
Result := TRUE;
end;
exit;
end;
if Background then exit;
if InRange (X, Y) then begin
if Assigned (FOnMouseUp) then
FOnMouseUp (self, Button, Shift, X, Y);
Result := TRUE;
end;
end;
function TDControl.DblClick (X, Y: integer): Boolean;
var
i: integer;
begin
Result := FALSE;
if (MouseCaptureControl <> nil) then begin //MouseCapture 撈擱 磊腳撈 快急
if (MouseCaptureControl = self) then begin
if Assigned (FOnDblClick) then
FOnDblClick (self);
Result := TRUE;
end;
exit;
end;
for i:=DControls.Count-1 downto 0 do
if TDControl(DControls[i]).Visible then
if TDControl(DControls[i]).DblClick(X-Left, Y-Top) then begin
Result := TRUE;
exit;
end;
if Background then exit;
if InRange (X, Y) then begin
if Assigned (FOnDblClick) then
FOnDblClick (self);
Result := TRUE;
end;
end;
function TDControl.Click (X, Y: integer): Boolean;
var
i: integer;
begin
Result := FALSE;
if (MouseCaptureControl <> nil) then begin //MouseCapture 撈擱 磊腳撈 快急
if (MouseCaptureControl = self) then begin
if Assigned (FOnClick) then
FOnClick (self, X, Y);
Result := TRUE;
end;
exit;
end;
for i:=DControls.Count-1 downto 0 do
if TDControl(DControls[i]).Visible then
if TDControl(DControls[i]).Click(X-Left, Y-Top) then begin
Result := TRUE;
exit;
end;
if Background then exit;
if InRange (X, Y) then begin
if Assigned (FOnClick) then
FOnClick (self, X, Y);
Result := TRUE;
end;
end;
procedure TDControl.SetImgIndex (Lib: TWMImages; index: integer);
var
d: TDirectDrawSurface;
begin
if Lib <> nil then begin
d := Lib.Images[index];
WLib := Lib;
FaceIndex := index;
if d <> nil then begin
Width := d.Width;
Height := d.Height;
end;
end;
end;
procedure TDControl.DirectPaint (dsurface: TDirectDrawSurface);
var
i: integer;
d: TDirectDrawSurface;
begin
if Assigned (FOnDirectPaint) then
FOnDirectPaint (self, dsurface)
else
if WLib <> nil then begin
d := WLib.Images[FaceIndex];
if d <> nil then
dsurface.Draw (SurfaceX(Left), SurfaceY(Top), d.ClientRect, d, TRUE);
end;
for i:=0 to DControls.Count-1 do
if TDControl(DControls[i]).Visible then
TDControl(DControls[i]).DirectPaint (dsurface);
end;
{--------------------- TDButton --------------------------}
constructor TDButton.Create (AOwner: TComponent);
begin
inherited Create (AOwner);
Downed := FALSE;
FOnClick := nil;
FEnableFocus := TRUE;
FClickSound := csNone;
end;
function TDButton.MouseMove (Shift: TShiftState; X, Y: Integer): Boolean;
begin
Result := inherited MouseMove (Shift, X, Y);
if (not Background) and (not Result) then begin
Result := inherited MouseMove (Shift, X, Y);
if MouseCaptureControl = self then
if InRange (X, Y) then Downed := TRUE
else Downed := FALSE;
end;
end;
function TDButton.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
begin
Result := FALSE;
if inherited MouseDown (Button, Shift, X, Y) then begin
if (not Background) and (MouseCaptureControl=nil) then begin
Downed := TRUE;
SetDCapture (self);
end;
Result := TRUE;
end;
end;
function TDButton.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
begin
Result := FALSE;
if inherited MouseUp (Button, Shift, X, Y) then begin
ReleaseDCapture;
if not Background then begin
if InRange (X, Y) then begin
if Assigned (FOnClickSound) then FOnClickSound(self, FClickSound);
if Assigned (FOnClick) then FOnClick(self, X, Y);
end;
end;
Downed := FALSE;
Result := TRUE;
exit;
end else begin
ReleaseDCapture;
Downed := FALSE;
end;
end;
{------------------------- TDGrid --------------------------}
constructor TDGrid.Create (AOwner: TComponent);
begin
inherited Create (AOwner);
FColCount := 8;
FRowCount := 5;
FColWidth := 36;
FRowHeight:= 32;
FOnGridSelect := nil;
FOnGridMouseMove := nil;
FOnGridPaint := nil;
end;
//根據指定的坐標獲得表格的行/列
function TDGrid.GetColRow (x, y: integer; var acol, arow: integer): Boolean;
begin
Result := FALSE;
if InRange (x, y) then begin
acol := (x-Left) div FColWidth;
arow := (y-Top) div FRowHeight;
Result := TRUE;
end;
end;
function TDGrid.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
var
acol, arow: integer;
begin
Result := FALSE;
if mbLeft = Button then begin
if GetColRow (X, Y, acol, arow) then begin
SelectCell.X := acol;
SelectCell.Y := arow;
DownPos.X := X;
DownPos.Y := Y;
SetDCapture (self);
Result := TRUE;
end;
end;
end;
function TDGrid.MouseMove (Shift: TShiftState; X, Y: Integer): Boolean;
var
acol, arow: integer;
begin
Result := FALSE;
if InRange (X, Y) then begin
if GetColRow (X, Y, acol, arow) then begin
if Assigned (FOnGridMouseMove) then
FOnGridMouseMove (self, acol, arow, Shift);
end;
Result := TRUE;
end;
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -