📄 picshow.pas
字号:
R1.Top := H - Y;
R2.Right := X;
R2.Top := H - Y;
end;
45: begin
R1.Left := W - X;
R1.Top := H - Y;
R2.Left := W - X;
R2.Top := H - Y;
end;
46: begin
R1.Left := W - X;
R1.Bottom := Y;
R2.Left := W - X;
R2.Bottom := Y;
end;
47: begin
R1.Right := (2 * W) - X;
R1.Bottom := (2 * H) - Y;
R2.Right := X;
R2.Bottom := Y;
end;
48: begin
R1.Right := (2 * W) - X;
R1.Top := Y - H;
R2.Right := X;
R2.Top := H - Y;
end;
49: begin
R1.Left := X - W;
R1.Top := Y - H;
R2.Left := W - X;
R2.Top := H - Y;
end;
50: begin
R1.Left := X - W;
R1.Bottom := (2 * H) - Y;
R2.Left := W - X;
R2.Bottom := Y;
end;
51: begin
R1.Left := X - W;
R1.Top := Y - H;
R1.Right := (2 * W) - X;
R1.Bottom := (2 * H) - Y;
R2.Left := (W - X) div 2;
R2.Top := (H - Y) div 2;
R2.Right := (W + X) div 2;
R2.Bottom := (H + Y) div 2;
end;
52: begin
R1.Left := (W - X) div 2;
R1.Top := (H - Y) div 2;
R1.Right := (W + X) div 2;
R1.Bottom := (H + Y) div 2;
end;
53: begin
R1.Left := (W - X) div 2;
R1.Top := (H - Y) div 2;
R1.Right := (W + X) div 2;
R1.Bottom := (H + Y) div 2;
R2.Left := (W - X) div 2;
R2.Top := (H - Y) div 2;
R2.Right := (W + X) div 2;
R2.Bottom := (H + Y) div 2;
end;
54: begin
R1.Left := 0;
R1.Right := W;
R1.Top := 0;
R1.Bottom := Y div 2;
R2.Left := 0;
R2.Right := W;
R2.Top := 0;
R2.Bottom := Y div 2;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Right := W;
R1.Top := H - (Y div 2);
R1.Bottom := H;
R2.Left := 0;
R2.Right := W;
R2.Top := H - (Y div 2);
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Right := X div 2;
R1.Top := 0;
R1.Bottom := H;
R2.Left := 0;
R2.Right := X div 2;
R2.Top := 0;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2);
R1.Right := W;
R1.Top := 0;
R1.Bottom := H;
R2.Left := W - (X div 2);
R2.Right := W;
R2.Top := 0;
R2.Bottom := H;
end;
55: begin
R1.Left := 0;
R1.Top := 0;
R1.Right := (X div 2) + 1;
R1.Bottom := (Y div 2) + 1;
R2.Left := 0;
R2.Top := 0;
R2.Right := (X div 2) + 1;
R2.Bottom := (Y div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Top := H - (Y div 2) - 1;
R1.Right := (X div 2) + 1;
R1.Bottom := H;
R2.Left := 0;
R2.Top := H - (Y div 2) - 1;
R2.Right := (X div 2) + 1;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2) - 1;
R1.Top := H - (Y div 2) - 1;
R1.Right := W;
R1.Bottom := H;
R2.Left := W - (X div 2) - 1;
R2.Top := H - (Y div 2) - 1;
R2.Right := W;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2) - 1;
R1.Top := 0;
R1.Right := W;
R1.Bottom := (Y div 2) + 1;
R2.Left := W - (X div 2) - 1;
R2.Top := 0;
R2.Right := W;
R2.Bottom := (Y div 2) + 1;
end;
56: begin
R1.Left := 0;
R1.Top := 0;
R1.Right := (X div 2) + 1;
R1.Bottom := (Y div 2) + 1;
R2.Left := 0;
R2.Top := 0;
R2.Right := (W div 2) + 1;
R2.Bottom := (H div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Top := H - (Y div 2);
R1.Right := (X div 2) + 1;
R1.Bottom := H;
R2.Left := 0;
R2.Top := (H div 2) + 1;
R2.Right := (W div 2) + 1;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2);
R1.Top := H - (Y div 2);
R1.Right := W;
R1.Bottom := H;
R2.Left := (W div 2) + 1;
R2.Top := (H div 2) + 1;
R2.Right := W;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2);
R1.Top := 0;
R1.Right := W;
R1.Bottom := (Y div 2) + 1;
R2.Left := (W div 2) + 1;
R2.Top := 0;
R2.Right := W;
R2.Bottom := (H div 2) + 1;
end;
57: begin
R1.Left := (X - W) div 2;
R1.Right := (X div 2) + 1;
R1.Top := 0;
R1.Bottom := (H div 2) + 1;
R2.Left := 0;
R2.Right := (W div 2) + 1;
R2.Top := 0;
R2.Bottom := (H div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := (W div 2) - 1;
R1.Right := W;
R1.Top := (Y - H) div 2;
R1.Bottom := (Y div 2) + 1;
R2.Left := (W div 2) - 1;
R2.Right := W;
R2.Top := 0;
R2.Bottom := (H div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - X div 2;
R1.Right := W + (W - X) div 2;
R1.Top := (H div 2) - 1;
R1.Bottom := H;
R2.Left := (W div 2) + 1;
R2.Right := W;
R2.Top := (H div 2) - 1;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Right := (W div 2) + 1;
R1.Top := H - Y div 2;
R1.Bottom := H + (H - Y) div 2;
R2.Left := 0;
R2.Right := (W div 2) + 1;
R2.Top := (H div 2) + 1;
R2.Bottom := H;
end;
58: Rgn := CreateRoundRectRgn(-(2 * W), -5, 2 * X, H + 5, 2 * W, 2 * W);
59: Rgn := CreateRoundRectRgn(W - 2 * X, -5, W + (2 * W), H + 5, 2 * W, 2 * W);
60: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 1, 0);
61: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 2, 0);
62: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 4, 0);
63: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 5, 0);
64: Rgn := CreateBarRgn(X, 0, W, H, 0, 3, 0);
65: Rgn := CreateSplashRgn(X, 0, W, H, 1, 0);
66: Rgn := CreateSplashRgn(X, 0, W, H, 2, 0);
67: Rgn := CreateSplashRgn(X, 0, W, H, 3, 0);
68: Rgn := CreateSplashRgn(X, 0, W, H, 4, 0);
69: Rgn := CreateRoundRectRgn(-5, -(2 * H), W + 5, 2 * Y, 2 * H, 2 * H);
70: Rgn := CreateRoundRectRgn(-5, H - 2 * Y, W + 5, H + (2 * H), 2 * H, 2 * H);
71: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 1);
72: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 2);
73: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 4);
74: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 5);
75: Rgn := CreateBarRgn(0, Y, W, H, 0, 0, 3);
76: Rgn := CreateSplashRgn(0, Y, W, H, 0, 1);
77: Rgn := CreateSplashRgn(0, Y, W, H, 0, 2);
78: Rgn := CreateSplashRgn(0, Y, W, H, 0, 3);
79: Rgn := CreateSplashRgn(0, Y, W, H, 0, 4);
80: Rgn := CreateRoundRectRgn(-(2 * W), -(2 * H), 2 * X, 2 * Y, 2 * W, 2 * H);
81: Rgn := CreateRoundRectRgn(W - 2 * X, -(2 * H), W + (2 * W), 2 * Y, 2 * W, 2 * H);
82: Rgn := CreateRoundRectRgn(-(2 * W), H - 2 * Y, 2 * X, H + (2 * H), 2 * W, 2 * H);
83: Rgn := CreateRoundRectRgn(W - 2 * X, H - 2 * Y, W + (2 * W), H + (2 * H), 2 * H, 2 * H);
84: Rgn := CreateRoundRectRgn(W div 2 - X, H div 2 - Y, W div 2 + X, H div 2 + Y, 9 * X div 5, 9 * Y div 5);
85: begin
R := CreateRectRgn(0, 0, W, H);
Rgn := CreateRoundRectRgn(X - W div 2, Y - H div 2, 3 * W div 2 - X,
3 * H div 2 - Y, 9 * (W - X) div 5, 9 * (H - Y) div 5);
CombineRgn(Rgn, Rgn, R, RGN_XOR);
DeleteObject(R);
end;
86: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 1);
87: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 2);
88: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 1);
89: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 2);
90: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 4, 4);
91: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 4, 5);
92: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 5, 4);
93: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 5, 5);
94: Rgn := CreateBarRgn(X, Y, W, H, S, 1, 3);
95: Rgn := CreateBarRgn(X, Y, W, H, S, 2, 3);
96: Rgn := CreateBarRgn(X, Y, W, H, S, 3, 1);
97: Rgn := CreateBarRgn(X, Y, W, H, S, 3, 2);
98: Rgn := CreateBarRgn(X, Y, W, H, 0, 3, 3);
99: begin
R := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 1);
Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 2);
CombineRgn(Rgn, Rgn, R, RGN_AND);
DeleteObject(R);
end;
100: Rgn := CreateSplashRgn(X, Y, W, H, 1, 1);
101: Rgn := CreateSplashRgn(X, Y, W, H, 1, 2);
102: Rgn := CreateSplashRgn(X, Y, W, H, 2, 1);
103: Rgn := CreateSplashRgn(X, Y, W, H, 2, 2);
104: Rgn := CreateSplashRgn(X, Y, W, H, 1, 3);
105: Rgn := CreateSplashRgn(X, Y, W, H, 2, 3);
106: Rgn := CreateSplashRgn(X, Y, W, H, 3, 1);
107: Rgn := CreateSplashRgn(X, Y, W, H, 3, 2);
108: Rgn := CreateSplashRgn(X, Y, W, H, 3, 3);
109: Rgn := CreateSplashRgn(X, Y, W, H, 4, 4);
// Thanks to M. R. Zamani for these effects
110: Rgn := CreateTriangleRgn(0, 0, 2 * X, 0, 0, 2 * Y);
111: Rgn := CreateTriangleRgn(W, 0, W - 2 * X, 0, W, 2 * Y);
112: Rgn := CreateTriangleRgn(0, H, 2 * X, H, 0, H - 2 * Y);
113: Rgn := CreateTriangleRgn(W, H, W - 2 * X, H, W, H - 2 * Y);
114: begin
R := CreateTriangleRgn(0, H, 0, 0, X, H);
Rgn := CreateTriangleRgn(W, H, W, 0, W - X, 0);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
end;
115: begin
R := CreateTriangleRgn(W, 0, 0, 0, W, Y);
Rgn := CreateTriangleRgn(W, H, 0, H, 0, H - Y);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
end;
116: begin
Rgn := CreateTriangleRgn(W div 2, H div 2, 0, H, 0, H - Y);
R := CreateTriangleRgn(0, 0, X, 0, W div 2, H div 2);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
R := CreateTriangleRgn(W - X, H, W div 2, H div 2, W, H);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
R := CreateTriangleRgn(W div 2, H div 2, W, 0, W, Y);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
end;
117: begin
X := X div 5;
Y := MulDiv(X, H, W);
for J := 0 to 9 do
begin
for I := 0 to 9 do
begin
R := CreateTriangleRgn(I * W div 10, J * H div 10,
I * W div 10 + X, J * H div 10, I * W div 10, J * H div 10 + Y);
if Rgn <> NULLREGION then
begin
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
end
else
Rgn := R;
end;
end;
end;
118: MergeTransparent(Media, Pic, Progress);
119: MergeRotate(Media, Pic, -1, -1, (100-Progress) * PI / 200);
120: MergeRotate(Media, Pic, -1, H, (100-Progress) * PI / 200);
121: MergeRotate(Media, Pic, W, -1, (100-Progress) * PI / 200);
122: MergeRotate(Media, Pic, W, H, (100-Progress) * PI / 200);
else
Exit;
end; // end of case
if fProgress = High(TPercent) then
Media.Canvas.Draw(0, 0, Pic)
else if fProgress <> Low(TPercent) then
if fStyle in RegionStyles then
begin
ExtSelectClipRgn(Media.Canvas.Handle, Rgn, RGN_AND);
Media.Canvas.Draw(0, 0, Pic);
SelectClipRgn(Media.Canvas.Handle, 0);
end
else if fStyle in [1..57] then
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
if Rgn <> NULLREGION then DeleteObject(Rgn);
InvalidateArea(R1);
if Assigned(fOnAfterNewFrame) then
fOnAfterNewFrame(Self, Pic, Media);
if not Drawing then Update;
end;
{ TDBPicShow }
constructor TDBPicShow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fAutoDisplay := True;
fDataLink := TFieldDataLink.Create;
fDataLink.Control := Self;
fDataLink.OnDataChange := DataChange;
fDataLink.OnUpdateData := UpdateData;
end;
destructor TDBPicShow.Destroy;
begin
fDataLink.Free;
fDataLink := nil;
inherited Destroy;
end;
function TDBPicShow.GetDataSource: TDataSource;
begin
Result := fDataLink.DataSource;
end;
procedure TDBPicShow.SetDataSource(Value: TDataSource);
begin
if not (fDataLink.DataSourceFixed and (csLoading in ComponentState)) then
fDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
function TDBPicShow.GetDataField: string;
begin
Result := fDataLink.FieldName;
end;
procedure TDBPicShow.SetDataField(const Value: string);
begin
fDataLink.FieldName := Value;
end;
function TDBPicShow.GetReadOnly: Boolean;
begin
Result := fDataLink.ReadOnly;
end;
procedure TDBPicShow.SetReadOnly(Value: Boolean);
begin
fDataLink.ReadOnly := Value;
end;
function TDBPicShow.GetField: TField;
begin
Result := fDataLink.Field;
end;
procedure TDBPicShow.SetAutoDisplay(Value: Boolean);
begin
if fAutoDisplay <> Value then
begin
fAutoDisplay := Value;
if fAutoDisplay then LoadPicture;
end;
end;
procedure TDBPicShow.PictureChange(Sender: TObject);
begin
if fPictureLoaded then FDataLink.Modified;
fPictureLoaded := True;
inherited PictureChange(Self);
end;
procedure TDBPicShow.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (fDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TDBPicShow.LoadPicture;
begin
if not fPictureLoaded and (not Assigned(fDataLink.Field) or
fDataLink.Field.IsBlob) then
begin
Picture.Assign(fDataLink.Field);
if Busy then Stop;
Execute;
end;
end;
procedure TDBPicShow.DataChange(Sender: TObject);
begin
Picture.Graphic := nil;
fPictureLoaded := False;
if fAutoDisplay then LoadPicture;
end;
procedure TDBPicShow.UpdateData(Sender: TObject);
begin
if Picture.Graphic is TBitmap then
fDataLink.Field.Assign(Picture.Graphic)
else
fDataLink.Field.Clear;
end;
procedure TDBPicShow.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(fDataLink);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -