Bu unit program yeniden boyutlandırma işleminde kullanılır.
Kod: Tümünü seç
unit ads_DlgResize;
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Description: ads_DlgResize.pas.pas
This unit contains
*)
interface
{!~DlgResize_ads
}
Function DlgResize_ads(var inWidth, inHeight: Integer;Units: String;IsHeight: Boolean;Var IsProportional, IsPercent: Boolean): Boolean;
implementation
Uses
ads_Exception,
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
Buttons,
ExtCtrls,
Spin,
ComCtrls
;
Var
UnitName : String;
ProcName : String;
type
TfrmResize = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
pnlBase : TPanel;
pnlButtons : TPanel;
pnltop : TPanel;
rgWhich : TRadioGroup;
rgUnits : TRadioGroup;
rgProportional : TRadioGroup;
pnlBtnCancel : TPanel;
btnCancel : TBitBtn;
pnlBtnOk : TPanel;
btnOK : TBitBtn;
pnlSpinners : TPanel;
seDimension : TSpinEdit;
upd10 : TUpDown;
upd100 : TUpDown;
edtTen : TEdit;
edtHun : TEdit;
procedure FormActivate(Sender: TObject);
procedure upd10MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure seDimensionMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure seDimensionChange(Sender: TObject);
procedure upd100MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure upd100Changing(Sender: TObject; var AllowChange: Boolean);
procedure upd10Changing(Sender: TObject; var AllowChange: Boolean);
procedure pnlButtonsResize(Sender: TObject);
procedure rgUnitsClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure rgWhichClick(Sender: TObject);
procedure rgProportionalClick(Sender: TObject);
private
FIsPropertional : Boolean;
FUnitsArePercent : Boolean;
FHeightNew : Integer;
FWidthOld : Integer;
FWidthNew : Integer;
FHeightOld : Integer;
FDimensionIsHeight: Boolean;
procedure SetHeightNew (const Value: Integer);
procedure SetHeightOld (const Value: Integer);
procedure SetIsPropertional (const Value: Boolean);
procedure SetUnitsArePercent (const Value: Boolean);
procedure SetWidthNew (const Value: Integer);
procedure SetWidthOld (const Value: Integer);
procedure SetDimensionIsHeight(const Value: Boolean);
{ Private declarations }
public
{ Public declarations }
procedure Coordinate;
published
{ published declarations }
property HeightOld : Integer read FHeightOld write SetHeightOld;
property WidthOld : Integer read FWidthOld write SetWidthOld;
property HeightNew : Integer read FHeightNew write SetHeightNew;
property WidthNew : Integer read FWidthNew write SetWidthNew;
property IsPropertional : Boolean read FIsPropertional write SetIsPropertional;
property UnitsArePercent : Boolean read FUnitsArePercent write SetUnitsArePercent;
property DimensionIsHeight : Boolean read FDimensionIsHeight write SetDimensionIsHeight;
end;
procedure TfrmResize.FormActivate(Sender: TObject);
begin
edtTen.Text := IntToStr(seDimension.Value);
edtHun.Text := IntToStr(seDimension.Value);
pnlButtonsResize(Sender);
end;
procedure TfrmResize.upd10MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
seDimension.Text := edtTen.Text;
edtHun.Text := seDimension.Text;
end;
procedure TfrmResize.seDimensionMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
edtTen.Text := seDimension.Text;
edtHun.Text := seDimension.Text;
end;
procedure TfrmResize.seDimensionChange(Sender: TObject);
begin
edtTen.Text := seDimension.Text;
edtHun.Text := seDimension.Text;
end;
procedure TfrmResize.upd100MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
edtHun.Text := IntToStr(upd100.Position);
seDimension.Text := IntToStr(upd100.Position);
edtTen.Text := IntToStr(upd100.Position);
end;
procedure TfrmResize.upd100Changing(Sender: TObject;
var AllowChange: Boolean);
begin
edtHun.Text := IntToStr(upd100.Position);
seDimension.Text := IntToStr(upd100.Position);
edtTen.Text := IntToStr(upd100.Position);
end;
procedure TfrmResize.upd10Changing(Sender: TObject;
var AllowChange: Boolean);
begin
seDimension.Text := edtTen.Text;
edtHun.Text := seDimension.Text;
end;
procedure TfrmResize.pnlButtonsResize(Sender: TObject);
begin
If pnlBtnCancel.Width = 80 Then
pnlBtnCancel.Width := 81
Else
pnlBtnCancel.Width := 80;
pnlBtnOK.Width := 80;
end;
procedure TfrmResize.rgUnitsClick(Sender: TObject);
Var
inMax : Integer;
inMin : Integer;
inPos : Integer;
begin
UnitsArePercent := (rgUnits.ItemIndex = 1);
Coordinate;
end;
procedure TfrmResize.SetHeightNew(const Value: Integer);
begin
If FHeightNew <> Value Then
Begin
FHeightNew := Value;
If rgWhich.ItemIndex = 0 Then
Begin
If seDimension.Text <> IntToStr(Value) Then
Begin
seDimension.Text := IntToStr(Value);
End;
End;
End;
end;
procedure TfrmResize.SetHeightOld(const Value: Integer);
begin
If FHeightOld <> Value Then
Begin
FHeightOld := Value;
End;
end;
procedure TfrmResize.SetIsPropertional(const Value: Boolean);
begin
If FIsPropertional <> Value Then
Begin
FIsPropertional := Value;
If FIsPropertional Then
Begin
If rgProportional.ItemIndex <> 0 Then
Begin
rgProportional.ItemIndex := 0;
End;
End
Else
Begin
If rgProportional.ItemIndex <> 1 Then
Begin
rgProportional.ItemIndex := 1;
End;
End;
End;
end;
procedure TfrmResize.SetUnitsArePercent(const Value: Boolean);
begin
If FUnitsArePercent <> Value Then
Begin
FUnitsArePercent := Value;
If FUnitsArePercent Then
Begin
If rgUnits.ItemIndex <> 1 Then
Begin
rgUnits.ItemIndex := 1;
rgUnitsClick(nil);
End;
End
Else
Begin
If rgUnits.ItemIndex <> 0 Then
Begin
rgUnits.ItemIndex := 0;
rgUnitsClick(nil);
End;
End;
End;
end;
procedure TfrmResize.SetWidthNew(const Value: Integer);
begin
If FWidthNew <> Value Then
Begin
FWidthNew := Value;
If rgWhich.ItemIndex = 1 Then
Begin
If seDimension.Text <> IntToStr(Value) Then
Begin
seDimension.Text := IntToStr(Value);
End;
End;
End;
end;
procedure TfrmResize.SetWidthOld(const Value: Integer);
begin
If FWidthOld <> Value Then
Begin
FWidthOld := Value;
End;
end;
procedure TfrmResize.FormCreate(Sender: TObject);
begin
HeightOld := 200;
WidthOld := 200;
HeightNew := 200;
WidthNew := 200;
IsPropertional := True;
UnitsArePercent := False;
DimensionIsHeight := True;
end;
procedure TfrmResize.btnOKClick(Sender: TObject);
begin
If IsPropertional Then
Begin
If Not UnitsArePercent Then
Begin
If rgWhich.ItemIndex = 0 Then
Begin
HeightNew := StrToInt(seDimension.Text);
WidthNew := (HeightNew * WidthOld) div HeightOld;
End
Else
Begin
WidthNew := StrToInt(seDimension.Text);
HeightNew := (WidthNew * HeightOld) div WidthOld;
End;
End
Else
Begin
If rgWhich.ItemIndex = 0 Then
Begin
HeightNew := StrToInt(seDimension.Text);
HeightNew := (HeightNew * HeightOld) div 100;
WidthNew := (HeightNew * WidthOld) div HeightOld;
End
Else
Begin
WidthNew := StrToInt(seDimension.Text);
WidthNew := (WidthNew * WidthOld) div 100;
HeightNew := (WidthNew * HeightOld) div WidthOld;
End;
End;
End
Else
Begin
If Not UnitsArePercent Then
Begin
If rgWhich.ItemIndex = 0 Then
Begin
HeightNew := StrToInt(seDimension.Text);
WidthNew := WidthOld;
End
Else
Begin
WidthNew := StrToInt(seDimension.Text);
HeightNew := HeightOld;
End;
End
Else
Begin
If rgWhich.ItemIndex = 0 Then
Begin
HeightNew := StrToInt(seDimension.Text);
HeightNew := (HeightNew * HeightOld) div 100;
WidthNew := WidthOld;
End
Else
Begin
WidthNew := StrToInt(seDimension.Text);
WidthNew := (WidthNew * WidthOld) div 100;
HeightNew := HeightOld;
End;
End;
End;
end;
procedure TfrmResize.SetDimensionIsHeight(const Value: Boolean);
begin
If FDimensionIsHeight <> Value Then
Begin
FDimensionIsHeight := Value;
If FDimensionIsHeight Then
Begin
If rgWhich.ItemIndex <> 0 Then
Begin
rgWhich.ItemIndex := 0;
rgUnitsClick(nil);
End;
End
Else
Begin
If rgWhich.ItemIndex <> 1 Then
Begin
rgWhich.ItemIndex := 1;
rgUnitsClick(nil);
End;
End;
End;
end;
procedure TfrmResize.rgWhichClick(Sender: TObject);
begin
DimensionIsHeight := (rgWhich.ItemIndex = 0);
Coordinate;
end;
procedure TfrmResize.rgProportionalClick(Sender: TObject);
begin
IsPropertional := (rgProportional.ItemIndex = 0);
Coordinate;
end;
procedure TfrmResize.Coordinate;
Var
inMax : Integer;
inMin : Integer;
inPos : Integer;
begin
If UnitsArePercent Then
Begin
inMax := 500;
inMin := 5;
If IsPropertional Then
Begin
If DimensionIsHeight Then
Begin
inPos := 100;
End
Else
Begin
inPos := 100;
End;
End
Else
Begin
If DimensionIsHeight Then
Begin
inPos := 100;
End
Else
Begin
inPos := 100;
End;
End;
End
Else
Begin
inMax := 4000;
inMin := 1;
If IsPropertional Then
Begin
If DimensionIsHeight Then
Begin
inPos := HeightOld;
End
Else
Begin
inPos := WidthOld;
End;
End
Else
Begin
If DimensionIsHeight Then
Begin
inPos := HeightOld;
End
Else
Begin
inPos := WidthOld;
End;
End;
End;
If Not (seDimension = nil) Then
Begin
Try seDimension.Text := IntToStr(inPos); Except End;
Try edtHun .Text := IntToStr(inPos); Except End;
Try edtTen .Text := IntToStr(inPos); Except End;
Try seDimension.MaxValue := inMax; Except End;
Try upd10 .Max := inMax; Except End;
Try upd100 .Max := inMax; Except End;
Try seDimension.MinValue := inMin; Except End;
Try upd10 .Min := inMin; Except End;
Try upd100 .Min := inMin; Except End;
Try upd10 .Position := inPos; Except End;
Try upd100 .Position := inPos; Except End;
End;
end;
Constructor TfrmResize.Create(AOwner: TComponent);
Begin
ProcName := 'TfrmResize.Create'; Try
inherited;
Self.Parent := TWincontrol(AOwner);
pnlBase := TPanel.Create(AOwner);
With pnlBase Do
Begin
Parent := Self;
Left := 0;
Top := 0;
Width := 216;
Height := 215;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
TabOrder := 0;
End;
pnlButtons := TPanel.Create(AOwner);
With pnlButtons Do
Begin
Parent := pnlBase;
Left := 10;
Top := 173;
Width := 196;
Height := 32;
Align := alBottom;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 0;
OnResize := pnlButtonsResize;
End;
pnlBtnCancel := TPanel.Create(AOwner);
With pnlBtnCancel Do
Begin
Parent := pnlButtons;
Left := 116;
Top := 0;
Width := 80;
Height := 32;
Align := alRight;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 0;
End;
btnCancel := TBitBtn.Create(AOwner);
With btnCancel Do
Begin
Parent := pnlBtnCancel;
Left := 5;
Top := 0;
Width := 75;
Height := 25;
Hint := 'Cancel any changes and close this dialog.';
TabOrder := 0;
Kind := bkCancel;
End;
pnlBtnOk := TPanel.Create(AOwner);
With pnlBtnOk Do
Begin
Parent := pnlButtons;
Left := 36;
Top := 0;
Width := 80;
Height := 32;
Align := alRight;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 1;
End;
btnOK := TBitBtn.Create(AOwner);
With btnOK Do
Begin
Parent := pnlBtnOk;
Left := 5;
Top := 0;
Width := 75;
Height := 25;
Hint := 'Implement any changes and close this dialog.';
TabOrder := 0;
OnClick := btnOKClick;
Kind := bkOK;
End;
pnltop := TPanel.Create(AOwner);
With pnltop Do
Begin
Parent := pnlBase;
Left := 10;
Top := 10;
Width := 196;
Height := 163;
Align := alClient;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 1;
End;
rgWhich := TRadioGroup.Create(AOwner);
With rgWhich Do
Begin
Parent := pnltop;
Left := 0;
Top := 33;
Width := 196;
Height := 41;
Hint := 'Select which dimension will be changed.';
Align := alTop;
Caption := 'Dimension is';
Columns := 2;
TabOrder := 0;
OnClick := rgWhichClick;
Items.Clear;
With Items Do
Begin
Try Add('Height'); Except End;
Try Add('Width'); Except End;
End;
ItemIndex := 0;
End;
rgUnits := TRadioGroup.Create(AOwner);
With rgUnits Do
Begin
Parent := pnltop;
Left := 0;
Top := 74;
Width := 196;
Height := 41;
Hint := 'Select what units the new value represents.';
Align := alTop;
Caption := 'Units';
Columns := 2;
TabOrder := 1;
OnClick := rgUnitsClick;
Items.Clear;
With Items Do
Begin
Try Add('pixels'); Except End;
Try Add('percent'); Except End;
End;
ItemIndex := 0;
End;
rgProportional := TRadioGroup.Create(AOwner);
With rgProportional Do
Begin
Parent := pnltop;
Left := 0;
Top := 115;
Width := 196;
Height := 41;
Hint := 'Select yes to perform proportional resizing, no otherwise.';
Align := alTop;
Caption := 'Proportional Resizing';
Columns := 2;
TabOrder := 2;
OnClick := rgProportionalClick;
Items.Clear;
With Items Do
Begin
Try Add('Yes'); Except End;
Try Add('No'); Except End;
End;
ItemIndex := 0;
End;
pnlSpinners := TPanel.Create(AOwner);
With pnlSpinners Do
Begin
Parent := pnltop;
Left := 0;
Top := 0;
Width := 196;
Height := 33;
Align := alTop;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 3;
End;
upd100 := TUpDown.Create(AOwner);
With upd100 Do
Begin
Parent := pnlSpinners;
Left := 71;
Top := 5;
Width := 15;
Height := 21;
Hint := 'Increment the value by 100.';
Associate := edtHun;
Min := 1;
Max := 4000;
Increment := 100;
Position := 1;
TabOrder := 2;
Wrap := False;
OnChanging := upd100Changing;
OnMouseUp := upd100MouseUp;
End;
edtTen := TEdit.Create(AOwner);
With edtTen Do
Begin
Parent := pnlSpinners;
Left := 5;
Top := 5;
Width := 50;
Height := 21;
TabOrder := 3;
Text := '1';
End;
edtHun := TEdit.Create(AOwner);
With edtHun Do
Begin
Parent := pnlSpinners;
Left := 5;
Top := 5;
Width := 66;
Height := 21;
TabOrder := 4;
Text := '1';
End;
seDimension := TSpinEdit.Create(AOwner);
With seDimension Do
Begin
Parent := pnlSpinners;
Left := 5;
Top := 5;
Width := 50;
Height := 22;
Hint := 'Increment the value by one.';
MaxValue := 4000;
MinValue := 1;
TabOrder := 0;
Value := 1;
OnChange := seDimensionChange;
OnMouseUp := seDimensionMouseUp;
End;
upd10 := TUpDown.Create(AOwner);
With upd10 Do
Begin
Parent := pnlSpinners;
Left := 55;
Top := 5;
Width := 15;
Height := 21;
Hint := 'Increment the value by 10.';
Associate := edtTen;
Min := 1;
Max := 4000;
Increment := 10;
Position := 1;
TabOrder := 1;
Wrap := False;
OnChanging := upd10Changing;
OnMouseUp := upd10MouseUp;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Destructor TfrmResize.Destroy;
Begin
ProcName := 'TfrmResize.Destroy'; Try
upd10 .Free;
seDimension .Free;
edtHun .Free;
edtTen .Free;
upd100 .Free;
pnlSpinners .Free;
rgProportional.Free;
rgUnits .Free;
rgWhich .Free;
pnltop .Free;
btnOK .Free;
pnlBtnOk .Free;
btnCancel .Free;
pnlBtnCancel .Free;
pnlButtons .Free;
pnlBase .Free;
inherited Destroy;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~DlgResize_ads
}
Function DlgResize_ads(var inWidth, inHeight: Integer;Units: String;IsHeight: Boolean;Var IsProportional, IsPercent: Boolean): Boolean;
Var
Dialog : TForm;
Form : TfrmResize;
Begin
Result := False;
Dialog := nil;
ProcName := 'DlgResize_ads'; Try
Try
Dialog := TForm.Create(nil);
Form := TfrmResize.Create(Dialog);
Form.Parent:= Dialog;
Form.Align := alClient;
With Dialog Do
Begin
Left := 523;
Top := 356;
Width := 224;
Height := 242;
Caption := 'Resizing Dialog';
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
OldCreateOrder:= False;
Position := poScreenCenter;
ShowHint := True;
OnActivate := Form.FormActivate;
OnCreate := Form.FormCreate;
PixelsPerInch := 96;
End;
Form.FormCreate(Dialog);
Form.WidthOld := inWidth;
Form.HeightOld := inHeight;
Form.WidthNew := inWidth;
Form.HeightNew := inHeight;
If Units <> '' Then
Form.rgUnits.Items[0] := Units;
Form.IsPropertional := IsProportional;
Form.DimensionIsHeight := IsHeight;
Form.UnitsArePercent := IsPercent;
Dialog.ShowModal;
If Dialog.ModalResult = mrOK Then
Begin
//Do Something here
Result := True;
inWidth := Form.WidthNew;
inHeight := Form.HeightNew;
IsProportional := Form.IsPropertional;
IsPercent := Form.UnitsArePercent;
End;
Finally
Dialog.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Initialization
UnitName := 'ads_DlgResize';
ProcName := 'Unknown';
End.