Вверх ↑
Ответов: 5227
Рейтинг: 585
#1: 2022-02-08 21:45:37 ЛС | профиль | цитата
Gunta, о, теперь работает
Отлично, держи в замен другую (в компонент лень оборачивать)

Add(MainForm,11788041,329,49)
{
Width=479
Height=417
Position=1
Point(SizeHeader)
Point(Handle)
Point(doSendToBack)
Point(doBringToFront)
}
Add(Button,7184611,140,98)
{
Width=463
Align=2
Caption="Вырезать"
link(onClick,1712484:doEvent1,[])
}
Add(Image,3179763,329,105)
{
Top=20
Width=463
Height=358
Align=5
Color=16777215
}
Add(Hub,1712484,196,98)
{
link(onEvent1,11788041:doSendToBack,[(221,104)(221,83)])
link(onEvent2,16364808:doCapture,[])
}
Add(Hub,2186279,287,105)
{
link(onEvent1,3179763:doLoad,[])
link(onEvent2,11788041:doBringToFront,[(312,118)(312,90)])
}
Add(InlineCode,16364808,238,105)
{
WorkPoints=#9:doCapture|
EventPoints=#5:onScr|
Code=#25:// autor andrestudio 2021|15:unit HiAsmUnit;|0:|9:interface|0:|29:uses kol,windows,Share,Debug;|0:|5:const|12: PSIZE = 2;|0:|4:type|28: THiAsmClass = class(TDebug)|10: private|27: f1,f2,f3,f4: PControl;|16: t1: PTimer;|9: public|22: onScr: THI_Event;|51: procedure doCapture(var dt: TData; idx: word);|73: procedure onMouseDown(Sender: PControl; var Mouse: TMouseEventData);|71: procedure onMouseUp(Sender: PControl; var Mouse: TMouseEventData);|31: procedure Timer(Obj:PObj);|22: procedure GetBMP;|5: end;|0:|14:implementation|0:|29:procedure THiAsmClass.GetBMP;|3:var|10: dc: HDC;|19: Bmp: Kol.PBitmap;|19: w,h,x,y: integer;|14: pos: TPoint;|5:begin|18: dc := GetDC(0);|21: GetCursorPos(pos);|59: w := Max(f2.Left,f4.Left) - Min(f2.Left,f4.Left) -PSIZE;|55: h := Max(f1.Top,f3.Top) - Min(f1.Top,f3.Top) -PSIZE;|35: x := Min(f2.Left,f4.Left)+PSIZE;|33: y := Min(f1.Top,f3.Top)+PSIZE;|3: |25: Bmp := NewBitmap(w,h);|69: BitBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,DC,x,y,SRCCOPY);|26: _hi_OnEvent(onScr,bmp);|23: bmp.CopyToClipboard;|12: bmp.Free;|54: // пришлось отказатся от пересоздания из за FPC |40: //f1.Free; f2.Free; f3.Free; f4.Free;|13: //t1.Free;|4:end;|0:|34:procedure THiAsmClass.onMouseDown;|5:begin|38: if Mouse.Button <> mbLeft then Exit;|14: t1.Tag := 2;|20: f3.Show; f4.Show; |4:end;|0:|32:procedure THiAsmClass.onMouseUp;|5:begin|38: if Mouse.Button <> mbLeft then Exit;|33: if f2.Left = f4.Left then Exit;|31: if f1.Top = f3.Top then Exit;|22: t1.Enabled := False;|37: f1.Hide; f2.Hide; f3.Hide; f4.Hide;|9: GetBMP;|4:end;|0:|38:procedure THiAsmClass.Timer(Obj:PObj);|3:var|14: pos: TPoint;|5:begin|20: GetCursorPos(pos);|21: if Obj.Tag = 1 then|7: begin|20: f1.Top := Pos.y;|21: f2.Left := Pos.x;|6: end;|21: if Obj.Tag = 2 then|7: begin|20: f3.Top := Pos.y;|21: f4.Left := Pos.x;|8: end; |4:end;|0:|32:procedure THiAsmClass.doCapture;|6:begin |34: if not Assigned(f1) then begin |28: f1 := NewForm(Applet,'');|22: f1.GetWindowHandle;|25: f1.Style := 101187584;|23: f1.ExStyle := 65536;|27: f1.Width := ScreenWidth;|22: f1.Height := PSIZE;|19: f1.Color := 255;|16: f1.Left := 0;|13: //f1.Show;|38: f1.onMouseDown := onMouseDown; end;|0:|34: if not Assigned(f2) then begin |28: f2 := NewForm(Applet,'');|22: f2.GetWindowHandle;|25: f2.Style := 101187584;|23: f2.ExStyle := 65536;|29: f2.Height := ScreenHeight;|21: f2.Width := PSIZE;|19: f2.Color := 255;|15: f2.Top := 0;|13: //f2.Show;|38: f2.onMouseDown := onMouseDown; end;|3: |35: if not Assigned(f3) then begin |28: f3 := NewForm(Applet,'');|22: f3.GetWindowHandle;|25: f3.Style := 101187584;|23: f3.ExStyle := 65536;|27: f3.Width := ScreenWidth;|22: f3.Height := PSIZE;|19: f3.Color := 255;|16: f3.Left := 0;|11: f3.Hide;|34: f3.onMouseUp := onMouseUp; end;|0:|34: if not Assigned(f4) then begin |28: f4 := NewForm(Applet,'');|22: f4.GetWindowHandle;|25: f4.Style := 101187584;|23: f4.ExStyle := 65536;|29: f4.Height := ScreenHeight;|21: f4.Width := PSIZE;|19: f4.Color := 255;|15: f4.Top := 0;|11: f4.Hide;|42: f4.onMouseUp := onMouseUp; end; |3: |34: if not Assigned(t1) then begin |22: t1 := NewTimer(25);|28: t1.OnTimer := Timer; end;|15: t1.Tag := 1;|23: t1.Enabled := True; |11: f1.Show;|16: f2.Show; |4:end;|0:|4:end.|
link(onScr,2186279:doEvent1,[])
}

карма: 4
Мой форум - http://hiasm.bbtalk.me/ схемы, компоненты...
1
Голосовали:prostov