Muhtelif Kodlar

~~*MeLeK*~~ · 28-01-2008, 12:25

procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.ShowModal;
end;

procedure TForm2.CancelButtonClick(Sender: TObject);
begin
Form2.Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Color := clAqua;
end;

procedure TForm1.AddBtnClick(Sender: TObject);
begin
Listbox1.Items.Add(Edit1.Text); {add this line of code}
end;

procedure TForm1.ClearBtnClick(Sender: TObject);
begin
ListBox1.Items.Clear; {add this line of code}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
AboutBox.Caption := 'About '+ Application.Title; { use the application’s name }
AboutBox.ShowModal; { then open the dialog box }
end

procedure TMain1.Button1Click(Sender: TObject);
begin
if Sender = Button1 then {this is the first line you add}
AboutBox.Caption := 'About ' + Application.Title {remove the existing semicolon}
else AboutBox.Caption := ''; {this is the second line you add}
AboutBox.ShowModal;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
MessageDlg('Save changes?', mtConfirmation, mbYesNoCancel , 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := InputBox('Password Entry Form', 'Enter Password', '')
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
PasswordDlg.ShowModal;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
AboutBox.Show; {This is the line you need to write}
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
AboutBox.ShowModal;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Button2.Enabled := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add(Edit1.Text);
Edit1.Clear;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Color := clRed;
end;

procedure TForm1.ColorGrid1Click(Sender: TObject);
begin
Edit1.Color := ColorGrid1.ForegroundColor;
end;

procedure TForm1.AddButtonClick(Sender: TObject);
var
X, Y, Sum: Integer;
begin
X := 100;
Y := 10;
Sum := X + Y;
Edit1.Text := IntToStr(Sum);
end;

procedure TForm1.AddButtonClick(Sender: TObject);
var
X, Y: Integer;
begin
X := 100;
Y := 10;
Edit1.Text := IntToStr(X + Y);
end;

procedure TForm1.CutClick(Sender: TObject);
begin
Memo1.CutToClipboard;
end;
procedure TForm1.CopyClick(Sender: TObject);
begin
Memo1.CopyToClipboard;
end;
procedure TForm1.PasteClick(Sender: TObject);
begin
Memo1.PasteFromClipboard;
end;
procedure TForm1.ClearAllClick(Sender: TObject);
begin
Memo1.Clear;
end;

procedure TForm1.AddButtonClick(Sender: TObject);
var
X, Y, Sum: Integer;
begin
X := 100;
Y := 10;
Sum := X + Y;
Edit1.Text := IntToStr(Sum);
end;

procedure TForm1.ChangeColorClick(Sender: TObject);
begin
if ColorDialog1.Execute then { if user clicks OK button }
Form1.Color := ColorDialog1.Color
else
Form1.Color := clRed;
end;

procedure TForm1.OKClick(Sender: TObject);
begin
if Edit1.Text = 'Saturday' then
Label2.Caption := 'Why are you working today?';
end;

procedure TForm1.OKClick(Sender: TObject);
begin
if Edit1.Text = 'Saturday' then
Label2.Caption := 'Why are you working today?'
else
Label2.Caption := '';
end;

procedure TForm1.OKClick(Sender: TObject);
begin
if Edit1.Text = 'Saturday' then
begin
Label2.Caption := 'Why are you working today?';
Form1.Color := clYellow;
end
else
Label2.Caption := '';
end;

procedure TForm1.OKClick(Sender: TObject);
begin
if Edit1.Text = 'Saturday' then
Label2.Caption := 'Why are you working today?'
else
if Edit1.Text = 'Sunday' then
Label2.Caption := 'You should be resting'
else
if Edit1.Text = 'Monday' then
Label2.Caption := 'Welcome to a new work week!'
else
Label2.Caption := '';
end;

procedure TForm1.OKClick(Sender: TObject);
var
Number: Integer;
begin
Number := StrToInt(Edit1.Text);
case Number of
1, 3, 5, 7, 9: Label2.Caption := 'Odd digit';
0, 2, 4, 6, 8: Label2.Caption := 'Even digit';
10..100: Label2.Caption := 'Between 10 and 100';
else
Label2.Caption := 'Greater than 100 or negative';
end;
end;

procedure TForm1.RepeatButtonClick(Sender: TObject);
var
I: Integer;
begin
I := 0;
repeat
I := I + 1;
Writeln(I);
until I = 10;
end;

procedure TForm1.WhileButtonClick(Sender: TObject);
var
J: Integer;
begin
J := 0;
while J < 10 do
begin
J := J + 1;
Writeln(J:50);
end;
end;

procedure TForm1.CountButtonClick(Sender: TObject);
var
Col: Integer;
begin
for Col := 1 to 5 do
StringGrid1.Cells[Col, 1] := IntToStr(Col);
end;

procedure TForm1.CountButtonClick(Sender: TObject);
var
Col: Integer;
begin
for Col := 5 downto 1 do
StringGrid1.Cells[Col, 1] := IntToStr(Col);
end;

procedure TForm1.ShowCoordinatesButtonClick(Sender: TObject);
var
Col, Row: Integer;
begin
for Col := 1 to 5 do
StringGrid1.Cells[Col, 0] := 'Col ' + IntToStr(Col);
for Row := 1 to 5 do
StringGrid1.Cells[0, Row] := 'Row ' + IntToStr(Row);
for Col := 1 to 5 do
for Row := 1 to 5 do
StringGrid1.Cells[Col, Row] :=
'Col ' + IntToStr(Col) + ', ' + 'Row ' + IntToStr(Row);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin { The block starts here with the statement part }
Edit1.Text := 'Welcome to Delphi';
end;

var { The block begins here with the start of the declaration part }
Name: string;
begin { The statement part of the block begins }
Name := Edit1.Text;
Edit2.Text := 'Welcome to Delphi, ' + Name;
end;

procedure TForm1.MultiplyClick(Sender: TObject); { Multiplies two numbers together }
var
FirstNumber, SecondNumber: Integer;
begin
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber * SecondNumber); { Displays answer in Edit3 }
end;

procedure TForm1.DivideClick(Sender: TObject);
begin
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber div SecondNumber);
end;

procedure TForm1.DivideClick(Sender: TObject);
var
FirstNumber, SecondNumber: Integer;
begin
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber div SecondNumber);
end;

implementation
{$R *.DFM}
var
FirstNumber, SecondNumber: Integer; { Variables global to the event handlers }
procedure TForm1.MultiplyClick(Sender: TObject); { Multiplies two numbers together }
begin
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber * SecondNumber); { Displays result in Edit3 }
end;
procedure TForm1.DivideClick(Sender: TObject); { Divides first number by the second }
begin
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber div SecondNumber); { Displays result in Edit3 }
end;

procedure TForm1.DivideClick(Sender: TObject);
var
FirstNumber, SecondNumber, Count: Integer;
begin
Count := 0;
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber div SecondNumber);
Count := Count + 1;
Counter.Text := IntToStr(Counter);
end;

implementation
{$R *.DFM}
var
Count: Integer;
procedure TForm1.MultiplyClick(Sender: TObject);
var
FirstNumber, SecondNumber: Integer;
begin
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber * SecondNumber);
Count := Count + 1;
Counter.Text := IntToStr(Count);
end;
procedure TForm1.DivideClick(Sender: TObject);
var
FirstNumber, SecondNumber: Integer;
begin
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber div SecondNumber);
Count := Count + 1;
Counter.Text := IntToStr(Count);
end;
initialization
Count := 0;
end

function NoValue(AnEditBox: TEdit): Boolean;
begin
if AnEditBox.Text = '' then
begin
AnEditBox.Color := clRed;
AnEditBox.Text := 'Enter a value';
Result := True;
end
else
begin
AnEditBox.Color := clWindow;
Result := False;
end;
end;

procedure TForm1.MultiplyClick(Sender: TObject);
var
FirstNumber, SecondNumber: Integer;
begin
if NoValue(Edit1) or NoValue(Edit2) then { This line calls NoValue twice }
Exit; { If an edit box is empty, quit this event handler }
FirstNumber := StrToInt(Edit1.Text);
SecondNumber := StrToInt(Edit2.Text);
Edit3.Text := IntToStr(FirstNumber * SecondNumber);
Count := Count + 1;
Counter.Text := IntToStr(Count);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Number: Integer;
begin
Number := StrToInt(Edit1.Text);
Calculate(Number);
Edit2.Text := IntToStr(Number);
end;

implementation
{$R *.DFM}
type
TCourse = (Nothing, History, Literature, Biology, Psychology);
var
SelectedCourse: TCourse;
procedure TForm1.HistoryButtonClick(Sender: TObject);
begin
SelectedCourse := History;
end;
procedure TForm1.LiteratureButtonClick(Sender: TObject);
begin
SelectedCourse := Literature;
end;
procedure TForm1.BiologyButtonClick(Sender: TObject);
begin
SelectedCourse := Biology;
end;
procedure TForm1.PsychologyButtonClick(Sender: TObject);
begin
SelectedCourse := Psychology;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
case SelectedCourse of
History: Label1.Caption := 'You are taking history';
Literature: Label1.Caption := 'You are taking literature';
Biology: Label1.Caption := 'You are taking biology';
Psychology: Label1.Caption := 'You are taking psychology';
else
Label1.Caption := 'You are taking nothing';
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
{$R+}
type
TValidEntry = 1..100;
var
Entry: TValidEntry;
begin
Entry := StrToInt(Edit1.Text);
Label2.Caption := 'Excellent!';
end;

procedure TForm1.FindLengthClick(Sender: TObject);
type
TEditString = string;
var
UserString: TEditString;
begin
UserString := Edit1.Text;
Label2.Caption := 'This string is ' + IntToStr(Length(UserString)) +
' characters in length';
end;

procedure TForm1.FindLengthClick(Sender: TObject);
begin
Label2.Caption := 'This string is ' + IntToStr(Length(Edit1.Text)) +
' characters in length';
end;

procedure TForm1.Button1Click(Sender: TObject);
type
TVowels = set of Char;
var
Vowels: TVowels;
begin
Vowels := ['A','E','I','O','U'];
if Edit1.Text[1] in Vowels then
Label2.Caption := 'You are clever'
else
Label2.Caption := 'Please try again';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Color := clGreen;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Color := clFuchsia;
Edit1.Color := clLime;
end;

begin
ListBox1.Clear;
ListBox1.MultiSelect := True;
ListBox1.Items.Add('One');
ListBox1.Items.Add('Two');
ListBox1.Items.Add('Three');
ListBox1.Sorted := True;
ListBox1.Font.Style := [fsBold];
ListBox1.Font.Color := clPurple;
ListBox1.Font.Name := 'Times New Roman';
ListBox1.ScaleBy(125, 100);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
with ListBox1 do
begin
Clear;
MultiSelect := True;
Items.Add('One');
Items.Add('Two');
Items.Add('Three');
Sorted := True;
Font.Style := [fsBold];
Font.Color := clPurple;
Font.Name := 'Times New Roman';
ScaleBy(125, 100);
end;
end;

procedure TForm1.Button1Click(Sender: TComponent);
var
APointer: Pointer;
AnInteger, ADividend: Integer;
begin
ADividend := 0;
GetMem(APointer, 1024); { allocate 1K of memory }
AnInteger := 10 div ADividend; { this generates an error }
FreeMem(APointer, 1024); { it never gets here }
end;

procedure TForm1.Button1Click(Sender: TComponent);
var
APointer: Pointer;
AnInteger, ADividend: Integer;
begin
ADividend := 0;
GetMem(APointer, 1024); { allocate 1K of memory }
try
AnInteger := 10 div ADividend; { this generates an error }
finally
FreeMem(APointer, 1024); { execution resumes here, despite the error }
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add('a string'); { add a string to list box }
ListBox1.Items.Add('another string'); { add another string... }
ListBox1.Items.Add('still another string'); { ...and a third string }
try
Caption := ListBox1.Items[3]; { set form caption to fourth string in list box }
except
on EListError do
MessageDlg('List box contains fewer than four strings', mtWarning, [mbOK], 0);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
for I := 1 to 10 do { loop ten times }
begin
ListBox1.Items.Add(IntToStr(I)); { add a numeral to the list }
if I = 7 then Abort; { abort after the seventh one }
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Index: Integer;
begin
for Index := 0 to ListBox1.Items.Count - 1 do
ListBox1.Items[Index] := UpperCase(ListBox1.Items[Index]);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
FileName: string; { storage for file name }
begin
FileName := 'C:\AUTOEXEC.BAT'; { set the file name }
with Memo1 do
begin
LoadFromFile(FileName); { load from file }
SaveToFile(ChangeFileExt(FileName, 'BAK')); { save into backup file }
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
TempList: TStrings; { declare the list }
begin
TempList := TStringList.Create; { construct the list object }
try
{ use the string list }
finally
TempList.Free; { destroy the list object }
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClickList := TStringList.Create; { construct the list }
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ClickList.SaveToFile(ChangeFileExt(Application.Exe Name, '.LOG')); { save the list }
ClickList.Free; { destroy the list object }
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ClickList.Add(Format('Click at (%d, %d)', [X, Y])); { add a string to the list }
end;

procedure TFrameForm.NewChild(Sender: TObject);
var
EditForm: TEditForm; {declare the child form as a variable}
begin
EditForm := TEditForm.Create(Self); {create the new child window}
end;

procedure TEditForm.New1Click(Sender: TObject);
begin
FrameForm.NewChild(Sender);
end;

procedure TFrameForm.Tile1Click(Sender: TObject);
begin
Tile; {this is the only code you write}
end;
procedure TFrameForm.Cascade1Click(Sender: TObject);
begin
Cascade; {this is the only code you write}
end;
procedure TFrameForm.ArrangeIcons1Click(Sender: TObject);
begin
ArrangeIcons; {this is the only code you write}
end;

procedure TEditForm.AlignClick(Sender: TObject);
begin
Left1.Checked := False;
Right1.Checked := False;
Center1.Checked := False;
with Sender as TMenuItem do Checked := True;
with Memo1 do
if Left1.Checked then
Alignment := taLeftJustify
else if Right1.Checked then
Alignment := taRightJustify
else if Center1.Checked then
Alignment := taCenter;
end;

procedure TEditForm.SetWordWrap(Sender: TObject);
begin
with Memo1 do
begin
WordWrap := not WordWrap;
if WordWrap then
ScrollBars := ssVertical else
ScrollBars := ssBoth;
WordWrap1.Checked := WordWrap;
end;
end;

procedure TEditForm.SelectAll(Sender: TObject);
begin
Memo1.SelectAll;
end;

procedure TEditForm.CutToClipboard(Sender: TObject);
begin
Memo1.CutToClipboard;
end;
procedure TEditForm.CopyToClipboard(Sender: TObject);
begin
Memo1.CopyToClipboard;
end;
procedure TEditForm.PasteFromClipboard(Sender: TObject);
begin
Memo1.PasteFromClipboard;
end;

procedure TEditForm.Delete(Sender: TObject);
begin
Memo1.ClearSelection;
end;

procedure TEditForm.UpdateMenus;
var
HasSelection: Boolean; {declare a variable that stores the results of the Boolean}
begin
Paste1.Enabled := Clipboard.HasFormat(CF_TEXT); {enable or disable the Paste menu item}
HasSelection := Memo1.SelLength <> 0; {assign the value of the Boolean variable based on
whether any text is selected in the Memo}
Cut1.Enabled := HasSelection; {enable the menu items if HasSelection evaluates to True}
Copy1.Enabled := HasSelection;
Delete1.Enabled := HasSelection;
end;

procedure TEditForm.SetEditItems(Sender: TObject);
begin
UpdateMenus;
end;

procedure TEditForm.UpdateMenus;
var
HasSelection: Boolean;
begin
Paste1.Enabled := Clipboard.HasFormat(CF_TEXT);
Paste2.Enabled := Clipboard.HasFormat(CF_TEXT); {Add this line}
HasSelection := Memo1.SelLength <> 0;
Cut1.Enabled := HasSelection;
Cut2.Enabled := HasSelection; {Add this line}
Copy1.Enabled := HasSelection;
Copy2.Enabled := HasSelection; {Add this line}
Delete1.Enabled := HasSelection;
end;

procedure TEditForm.SetPopUpItems(Sender: TObject);
begin
UpdateMenus;
end;

procedure TEditForm.Open1Click(Sender: TObject);
begin
FrameForm.OpenChild(Sender);
end;
procedure TFrameForm.OpenChild(Sender: TObject);
var
EditForm: TEditForm;
begin
if OpenFileDialog.Execute then
begin
EditForm := TEditForm.Create(Self);
EditForm.Open(OpenFileDialog.Filename); {Calls the Open method of EditForm}
EditForm.Visible := True;
end;
end;

procedure TEditForm.Open(const AFilename: string);
begin
Filename := AFilename; {assigns the parameter passed from FrameForm.OpenChild to the
form variable}
Memo1.Lines.LoadFromFile(FileName); {loads the file specified in the form variable}
Memo1.SelStart := 0;
Caption := ExtractFileName(FileName); {displays the filename in the form caption}
Memo1.Modified := False;
end;

procedure TEditForm.SaveAs1Click(Sender: TObject);
begin
SaveFileDialog.Filename := Filename; {display current value of Filename, if any}
if SaveFileDialog.Execute then
begin
Filename := SaveFileDialog.Filename;
Caption := ExtractFileName(Filename);
Save1Click(Sender);
end;
end;

procedure TEditForm.Save1Click(Sender: TObject);
procedure CreateBackup(const Filename: string);
var
BackupFilename: string;
begin
BackupFilename := ChangeFileExt(Filename, BackupExt);
DeleteFile(BackupFilename);
RenameFile(Filename, BackupFilename);
end;
begin
if Filename = '' then
SaveAs1Click(Sender)
else
begin
CreateBackup(Filename);
Memo1.Lines.SaveToFile(Filename);
Memo1.Modified := False;
end;
end;

procedure TEditForm.SetFont(Sender: TObject);
begin
FontDialog1.Font := Memo1.Font;
if FontDialog1.Execute then
Memo1.Font := FontDialog1.Font;
end;

procedure TEditForm.PrintSetUp1Click(Sender: TObject);
begin
PrinterSetupDialog1.Execute;
end;

procedure TEditForm.Print1Click(Sender: TObject);
var
Line: Integer;{declare an integer variable for the number of lines of text}
PrintText: System.Text; {declare PrintText as text file defined in System unit}
begin
if PrintDialog1.Execute then
begin
AssignPrn(PrintText); {assign the global variable PrintText to the printer}
Rewrite(PrintText); {create and open the output file}
Printer.Canvas.Font := Memo1.Font;{assign the current Font setting for Memo1 to the
Printer object's canvas}
for Line := 0 to Memo1.Lines.Count - 1 do
Writeln(PrintText, Memo1.Lines[Line]); {write the :-):-):-):-):-):-):-)s of the Memo to the
printer object}
CloseFile(PrintText);
end;
end;

procedure TEditForm.Close1Click(Sender: TObject);
begin
Close;
end;

procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;

procedure TEditForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
DialogValue: Integer; {declare an integer variable to store the user's response
to the message dialog}
FName: string; {declare a string variable to store the value of
the file name when saving}
begin
if Memo1.Modified then
begin
FName := Caption; {save the value of the Caption property to the FName variable}
if Length(FName) = 0 then
FName := 'Untitled'; {if there is no filename, use 'Untitled'}
DialogValue := MessageDlg(Format(SWarningText, [FName]), mtConfirmation,
[mbYes, mbNo, mbCancel], 0); {produce the message dialog box}
case DialogValue of
id_Yes: Save1Click(Self); {Self parameter saves the instance of EditForm open at
the time the user chooses Yes in the dialog}}
id_Cancel: CanClose := False; {if the user chooses Cancel, exit the dialog and
don’t close the form}
end;
end;
end;

procedure TEditForm.Exit1Click(Sender: TObject);
begin
FrameForm.Exit1Click(Sender);
end;

procedure TFrameForm.Exit1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
CheckBox1.Font.Color := Canvas.Pixels[10, 10];
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Canvas.Pixels[Random(ClientWidth), Random(ClientHeight)] := clRed;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
with Canvas do
begin
MoveTo(0, 0);
LineTo(ClientWidth, ClientHeight);
MoveTo(0, ClientHeight);
LineTo(ClientWidth, 0);
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
with Canvas do
PolyLine([Point(0, 0), Point(50, 0), Point(75, 50), Point(25, 50), Point(0, 0)]);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Rectangle(0, 0, ClientWidth div 2, ClientHeight div 2);
Canvas.Ellipse(0, 0, ClientWidth div 2, ClientHeight div 2);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.RoundRect(0, 0, ClientWidth div 2, ClientHeight div 2, 10, 10);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Polygon([Point(0, 0), Point(0, ClientHeight),
Point(ClientWidth, ClientHeight)]);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Canvas.TextOut(X, Y, 'Here!'); { write text at (X, Y) }
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Canvas.MoveTo(X, Y); { set pen position }
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Canvas.LineTo(X, Y); { draw line from PenPos to (X, Y) }
end;

procedure TForm1.FormMouseMove(Sender: TObject;Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Canvas.LineTo(X, Y); { draw line to current position }
end;

type
TForm1 = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
Drawing: Boolean;
Origin, MovePt: TPoint; { fields to store points }
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := True; { set the Drawing flag }
Canvas.MoveTo(X, Y);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Canvas.LineTo(X, Y);
Drawing := False; { clear the Drawing flag }
end;

procedure TForm1.FormMouseMove(Sender: TObject;Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Drawing then { only draw if Drawing flag is set }
Canvas.LineTo(X, Y);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := True;
Canvas.MoveTo(X, Y);
Origin := Point(X, Y); { record where the line starts }
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Canvas.MoveTo(Origin.X, Origin.Y); { move pen to starting point }
Canvas.LineTo(X, Y);
Drawing := False;
end;

procedure TForm1.FormMouseMove(Sender: TObject;Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Drawing then
begin
Canvas.MoveTo(Origin.X, Origin.Y); { move pen to starting point }
Canvas.LineTo(X, Y);
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := True;
Canvas.MoveTo(X, Y);
Origin := Point(X, Y);
MovePt := Point(X, Y); { keep track of where this move was }
end;
procedure TForm1.FormMouseMove(Sender: TObject;Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Drawing then
begin
Canvas.Pen.Mode := pmNotXor; { use XOR mode to draw/erase }
Canvas.MoveTo(Origin.X, Origin.Y); { move pen back to origin }
Canvas.LineTo(MovePt.X, MovePt.Y); { erase the old line }
Canvas.MoveTo(Origin.X, Origin.Y); { start at origin again }
Canvas.LineTo(X, Y); { draw the new line }
end;
MovePt := Point(X, Y); { record point for next move }
Canvas.Pen.Mode := pmCopy;
end;

procedure TForm1.LineButtonClick(Sender: TObject); { LineButton }
begin
DrawingTool := dtLine;
end;
procedure TForm1.RectangleButtonClick(Sender: TObject); { RectangleButton }
begin
DrawingTool := dtRectangle;
end;
procedure TForm1.EllipseButtonClick(Sender: TObject); { EllipseButton }
begin
DrawingTool := dtEllipse;
end;
procedure TForm1.RoundedRectButtonClick(Sender: TObject); { RoundRectButton }
begin
DrawingTool := dtRoundRect;
end;

procedure TForm1.FormMouseUp(Sender: TObject);
begin
if DrawingTool = dtLine then { draw a line }
else if DrawingTool = dtRectangle then { draw a rectangle }
{ ... and so on ... }
end;

procedure TForm1.FormMouseUp(Sender: TObject);
begin
case DrawingTool of
dtLine: { draw a line }
dtRectangle: { draw a rectangle }
{ ... and so on ... }
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject);
begin
case DrawingTool of
dtLine:
begin
Canvas.MoveTo(Origin.X, Origin.Y);
Canvas.LineTo(X, Y)
end;
dtRectangle: Canvas.Rectangle(Origin.X, Origin.Y, X, Y);
dtEllipse: Canvas.Ellipse(Origin.X, Origin.Y, X, Y);
dtRoundRect: Canvas.RoundRect(Origin.X, Origin.Y, X, Y,
(Origin.X - X) div 2, (Origin.Y - Y) div 2);
end;
Drawing := False;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if Drawing then
begin
Canvas.Pen.Mode := pmNotXor;
case DrawingTool of
dtLine: begin
Canvas.MoveTo(Origin.X, Origin.Y);
Canvas.LineTo(MovePt.X, MovePt.Y);
Canvas.MoveTo(Origin.X, Origin.Y);
Canvas.LineTo(X, Y);
end;
dtRectangle: begin
Canvas.Rectangle(Origin.X, Origin.Y, MovePt.X, MovePt.Y);
Canvas.Rectangle(Origin.X, Origin.Y, X, Y);
end;
dtEllipse: begin
Canvas.Ellipse(Origin.X, Origin.Y, X, Y);
Canvas.Ellipse(Origin.X, Origin.Y, X, Y);
end;
dtRoundRect: begin
Canvas.RoundRect(Origin.X, Origin.Y, X, Y,
(Origin.X - X) div 2, (Origin.Y - Y) div 2);
Canvas.RoundRect(Origin.X, Origin.Y, X, Y,
(Origin.X - X) div 2, (Origin.Y - Y) div 2);
end;
end;
MovePt := Point(X, Y);
end;
Canvas.Pen.Mode := pmCopy;
end;

procedure TForm1.PenButtonClick(Sender: TObject);
begin
PenBar.Visible := PenButton.Down;
end;
procedure TForm1.BrushButtonClick(Sender: TObject);
begin
BrushBar.Visible := BrushButton.Down;
end;

procedure TForm1.SetPenStyle(Sender: TObject);
begin
with Canvas.Pen do
begin
if Sender = SolidPen then Style := psSolid
else if Sender = DashPen then Style := psDash
else if Sender = DotPen then Style := psDot
else if Sender = DashDotPen then Style := psDashDot
else if Sender = DashDotDotPen then Style := psDashDotDot
else if Sender = ClearPen then Style := psClear;
end;
end;

procedure TForm1.PenColorClick(Sender: TObject);
begin
Canvas.Pen.Color := PenColor.ForegroundColor;
end;

procedure TForm1.PenWidthChange(Sender: TObject);
begin
Canvas.Pen.Width := PenWidth.Position; { set the pen width directly }
PenSize.Caption := IntToStr(PenWidth.Position); { convert to string for caption }
end;

procedure TForm1.SetBrushStyle(Sender: TObject);
begin
with Canvas.Brush do
begin
if Sender = SolidBrush then Style := bsSolid
else if Sender = ClearBrush then Style := bsClear
else if Sender = HorizontalBrush then Style := bsHorizontal
else if Sender = VerticalBrush then Style := bsVertical
else if Sender = FDiagonalBrush then Style := bsFDiagonal
else if Sender = BDiagonalBrush then Style := bsBDiagonal
else if Sender = CrossBrush then Style := bsCross
else if Sender = DiagCrossBrush then Style := bsDiagCross;
end;
end;

procedure TForm1.BrushColorClick(Sender: TObject);
begin
Canvas.Brush.Color := BrushColor.ForegroundColor;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := True;
Canvas.MoveTo(X, Y);
Origin := Point(X, Y);
MovePt := Origin;
OriginPanel.Caption := Format('Origin: (%d, %d)', [X, Y]); { update status bar }
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, Point(X, Y), pmNotXor);
end;
CurrentPanel.Caption := Format('Current: (%d, %d)', [X, Y]); { update status bar }
end;

procedure TForm1.FormCreate(Sender: TObject);
var
Bitmap: TBitmap; { temporary variable to hold the bitmap }
begin
Bitmap := TBitmap.Create; { construct the bitmap object }
Bitmap.Width := 200; { assign the initial width... }
Bitmap.Height := 200; { ...and the initial height }
Image.Picture.Graphic := Bitmap; { assign the bitmap to the image control }
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.Print1Click(Sender: TObject);
begin
with Printer do
begin
BeginDoc; { start printing }
Canvas.Draw(0, 0, Image.Picture.Graphic); { draw Image at upper left of page }
EndDoc; { finish printing }
end;
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
CurrentFile := OpenDialog1.FileName;
Image.Picture.LoadFromFile(CurrentFile);
end;
end;

procedure TForm1.Save1Click(Sender: TObject);
begin
if CurrentFile <> '' then
Image.Picture.SaveToFile(CurrentFile) { save if already named }
else SaveAs1Click(Sender); { otherwise get a name }
end;
procedure TForm1.Saveas1Click(Sender: TObject);
begin
if SaveDialog1.Execute then { get a file name }
begin
CurrentFile := SaveDialog1.FileName; { save the user-specified name }
Save1Click(Sender); { then save normally }
end;
end;

procedure TForm1.New1Click(Sender: TObject);
var
Bitmap: TBitmap; { temporary variable for the new bitmap }
begin
with NewBMPForm do
begin
ActiveControl := WidthEdit; { make sure focus is on width field }
WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width); { use current dimensions... }
HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height); { ...as default }
if ShowModal <> idCancel then { continue if user doesn't cancel dialog box }
begin
Bitmap := TBitmap.Create; { create fresh bitmap object }
Bitmap.Width := StrToInt(WidthEdit.Text); { use specified width }
Bitmap.Height := StrToInt(HeightEdit.Text); { use specified height }
Image.Picture.Graphic := Bitmap; { replace graphic with new bitmap }
CurrentFile := ''; { indicate unnamed file }
end;
end;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
Clipboard.Assign(Image.Picture);
end;

var
ARect: TRect;
begin
Copy1Click(Sender); { copy picture to Clipboard }
with Image.Canvas do
begin
CopyMode := cmWhiteness; { copy everything as white }
ARect := Rect(0, 0, Image.Width, Image.Height); { get bitmap rectangle }
CopyRect(ARect, Image.Canvas, ARect); { copy bitmap over itself }
CopyMode := cmSrcCopy; { restore normal mode }
end;
end;

procedure TForm1.PasteButtonClick(Sender: TObject);
var
Bitmap: TBitmap;
begin
if Clipboard.HasFormat(CF_BITMAP) then
{ check to see if there’s a bitmap on the clipboard )
begin
{create a bitmap to hold the :-):-):-):-):-):-):-)s on the clipboard }
Bitmap := TBitmap.Create;
try
{ Get the bitmap off the clipboard using Assign }
Bitmap.Assign(Clipboard);
{ Copy the bitmap to the Image }
Image.Canvas.Draw(0, 0, Bitmap);
finally
Bitmap.Free;
end;
end;
end;

procedure TFMForm.FormCreate(Sender: TObject);
var
Drive, AddedIndex: Integer;
begin
for Drive := 0 to 25 do { iterate through all possible drives }
if GetDriveType(Drive) > 0 then { positive values mean valid drives }
begin
AddedIndex := DriveTabSet.Tabs.Add(Chr(Drive + ord('a'))); { add a tab }
if Chr(Drive + ord('A')) = FileList.Drive then { if it's current drive... }
DriveTabSet.TabIndex := AddedIndex; { ...make that current tab }
end;
end;

procedure TFMForm.DirectoryOutlineChange(Sender: TObject);
begin
FileList.Directory := DirectoryOutline.Directory;
DirectoryPanel.Caption := DirectoryOutline.Directory;
end;

procedure TFMForm.FileListChange(Sender: TObject);
var
TheFileName: string;
begin
with FileList do
begin
if ItemIndex >= 0 then { is there a selected item? }
begin
TheFileName := Items[ItemIndex]; { get the file name }
FilePanel.Caption := Format('%s, %d bytes', [TheFileName,
GetFileSize(TheFileName)]); { set caption to file name/size }
end
else FilePanel.Caption := ''; { blank panel if none selected }
end;
end;

procedure TFMForm.FormCreate(Sender: TObject);
var
Drive, AddedIndex: Integer;
DriveLetter: Char;
begin
for Drive := 0 to 25 do { iterate through all possible drives }
begin
DriveLetter := Chr(Drive + ord('a'));
case GetDriveType(Drive) of { positive values mean valid drives }
DRIVE_REMOVABLE: { add a tab }
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Floppy.Picture.Graphic);
DRIVE_FIXED: { add a tab }
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Fixed.Picture.Graphic);
DRIVE_REMOTE: { add a tab }
AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Network.Picture.Graphic);
end;
if UpCase(DriveLetter) = UpCase(DirectoryOutline.Drive) then { current drive? }
DriveTabSet.TabIndex := AddedIndex; { then make that current tab }
end;
end;

procedure TFMForm.DriveTabSetMeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer); { note that TabWidth is a var parameter}
var
BitmapWidth: Integer;
begin
BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;
{ increase tab width by the width of the associated bitmap plus two }
Inc(TabWidth, 2 + BitmapWidth);
end;

procedure TFMForm.DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
R: TRect; Index: Integer; Selected: Boolean);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap(DriveTabSet.Tabs.Objects[Index]);
with TabCanvas do
begin
Draw(R.Left, R.Top + 4, Bitmap); { draw bitmap }
TextOut(R.Left + 2 + Bitmap.Width, { position text }
R.Top + 2, DriveTabSet.Tabs[Index]); { and draw it to the right of the bitmap }
end;
end;

procedure TFMForm.File1Click(Sender: TObject);
var
FileSelected: Boolean;
begin
FileSelected := FileList.ItemIndex >= 0; { True if there is a file selected }
Open1.Enabled := FileSelected;
Delete1.Enabled := FileSelected;
Copy1.Enabled := FileSelected;
Move1.Enabled := FileSelected;
Rename1.Enabled := FileSelected;
Properties1.Enabled := FileSelected;
end;

procedure TFMForm.Delete1Click(Sender: TObject);
begin
with FileList do
if DeleteFile(FileName) then Update;
end;

procedure TFMForm.Delete1Click(Sender: TObject);
begin
with FileList do
if MessageDlg('Delete ' + FileName + '?', mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
if DeleteFile(FileName) then Update;
end;

procedure TFMForm.Properties1Click(Sender: TObject);
var
Attributes, NewAttributes: Word;
begin
with FileAttrForm do
begin
FileDirName.Caption := FileList.Items[FileList.ItemIndex]; { set box caption }
PathName.Caption := FileList.Directory; { show directory name }
ChangeDate.Caption := DateTimeToStr(FileDateTime(FileList.FileName));
Attributes := FileGetAttr(FileDirName.Caption); { read file attributes }
ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly;
Archive.Checked := (Attributes and faArchive) = faArchive;
System.Checked := (Attributes and faSysFile) = faSysFile;
Hidden.Checked := (Attributes and faHidden) = faHidden;
if ShowModal <> mrCancel then { execute dialog box }
begin
NewAttributes := Attributes; { start with original attributes }
if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly
else NewAttributes := NewAttributes and not faReadOnly;
if Archive.Checked then NewAttributes := NewAttributes or faArchive
else NewAttributes := NewAttributes and not faArchive;
if System.Checked then NewAttributes := NewAttributes or faSysFile
else NewAttributes := NewAttributes and not faSysFile;
if Hidden.Checked then NewAttributes := NewAttributes or faHidden
else NewAttributes := NewAttributes and not faHidden;
if NewAttributes <> Attributes then { if anything changed... }
FileSetAttr(FileDirName.Caption, NewAttributes); { ...write the new values }
end;
end;
end;

procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: string);
begin
if MessageDlg(Format('%s %s to %s?', [ACaption, FromFile, ToFile]),
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if ACaption = 'Move' then
MoveFile(FromFile, ToFile)
else if ACaption = 'Copy' then
CopyFile(FromFile, ToFile)
else if ACaption = 'Rename' then
RenameFile(FromFile, ToFile);
FileList.Update;
end;
end;

procedure TFMForm.FileChange(Sender: TObject);
begin
with ChangeDlg do
begin
if Sender = Move1 then Caption := 'Move'
else if Sender = Copy1 then Caption := 'Copy'
else if Sender = Rename1 then Caption := 'Rename'
else Exit;
CurrentDir.Caption := DirectoryOutline.Directory;
FromFileName.Text := FileList.FileName;
ToFileName.Text := '';
if (ShowModal <> mrCancel) and (ToFileName.Text <> '') then
ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);
end;
end;

procedure TFMForm.Open1Click(Sender: TObject);
begin
with FileList do
ExecuteFile(FileName, '', Directory, SW_SHOW);
end;

procedure TFMForm.Open1Click(Sender: TObject);
begin
with FileList do
begin
if HasAttr(FileName, faDirectory) then
DirectoryOutline.Directory := FileName
else ExecuteFile(FileName, '', Directory, SW_SHOW);
end;
end;

procedure TFMForm.FileListBox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then { drag only if left button pressed }
with Sender as TFileListBox do { treat Sender as TFileListBox }
begin
if ItemAtPos(Point(X, Y), True) >= 0 then { is there an item here? }
BeginDrag(False); { if so, drag it }
end;
end;

procedure TFMForm.DirectoryOutline1DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
if Source is TFileListBox then
Accept := True;
end;

procedure TFMForm.DirectoryOutline1DragDrop(Sender, Source: TObject; X,
Y: Integer);
begin
if Source is TFileListBox then
with DirectoryOutline do
ConfirmChange('Move', FileList.FileName, Items[GetItem(X, Y)].FullPath);
end;

procedure TFMForm.FileListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
if Target <> nil then FileList.Update;
end;

procedure TOLEFrameForm.New1Click(Sender: TObject);
begin
CreateChild {Call the CreateChild method}
end;

procedure TOLEFrameForm.Exit1Click(Sender: TObject);
begin
Close {close the main form, which terminates the application}
end;

procedure TOLEObjectForm.New1Click(Sender: TObject);
begin
OLEFrameForm.New1Click(Sender) {Call OLEFrameForm's File|New handler}
end;

procedure TOLEObjectForm.Exit1Click(Sender: TObject);
begin
OLEFrameForm.Exit1Click(Sender) {Call OLEFrameForm's File|Exit handler}
end;

procedure TOLEObjectForm.Cascade1Click(Sender: TObject);
begin
OLEFrameForm.Cascade {Cascade the MDI children of OLEFrameForm}
end;

procedure TOLEObjectForm.Tile1Click(Sender: TObject);
begin
OLEFrameForm.Tile {Tile the MDI children of OLEFrameForm}
end;

procedure TOLEObjectForm.ArrangeIcons1Click(Sender: TObject);
begin
OLEFrameForm.ArrangeIcons {Arrange the icons of the MDI chilren of OLEFrameForm}
end;

procedure TOLEObjectForm.OleContainerStatusLineEvent(Sender: TObject; Msg: String);
begin
OLEFrameForm.StatusBarPanel.Caption := Msg {Display Msg in status bar}
end;

procedure TOLEObjectForm.InitializeOLEObject(Info: Pointer);
begin
OLEContainer.PInitInfo := Info; {Initialize the container by pointing to Info}
ReleaseOLEInitInfo(Info)
end;

procedure TOLEObjectForm.InsertObject1Click(Sender: TObject);
var
Info: Pointer; {Declare the pointer to the OLE initialization info}
begin
if InsertOLEObjectDlg(OLEFrameForm, 0, Info) then {Insert Object dialog box}
InitializeOLEObject(Info); {Initialize the OLE object}
end;

procedure TOLEObjectForm.Deactivate1Click(Sender: TObject);
begin
OLEContainer.Active := False {Deactivate the OLE object}
end;

procedure TOLEFrameForm.FormCreate(Sender: TObject);
begin
FEmbedClipFmt := RegisterClipboardFormat('Embedded Object');
FLinkClipFmt := RegisterClipboardFormat('Link Source');
end;

procedure TOLEFrameForm.FormCreate(Sender: TObject);
begin
FEmbedClipFmt := RegisterClipboardFormat('Embedded Object');
FLinkClipFmt := RegisterClipboardFormat('Link Source');
Fmts[0].fmtId := FEmbedClipFmt; {Embedded OLE object Clipboard format}
Fmts[0].fmtMedium := BOLEMediumCalc(FEmbedClipFmt); {Medium for embedded objects}
Fmts[0].fmtIsLinkable := False; {No linking to OLE server}
StrPCopy (Fmts[0].fmtName, '%s'); {Name from OLE server}
StrPCopy (Fmts[0].fmtResultName, '%s'); {Result name from OLE server}
Fmts[1].fmtId := FLinkClipFmt; {Linked OLE object Clipboard format}
Fmts[1].fmtMedium := BOLEMediumCalc(FLinkClipFmt); {Medium for linked objects}
Fmts[1].fmtIsLinkable := True; {Allows linking to OLE server}
StrPCopy (Fmts[1].fmtName, '%s'); {Name from OLE server}
StrPCopy (Fmts[1].fmtResultName, '%s'); {Result name from OLE server}
end;

procedure TOLEObjectForm.PasteSpecial1Click(Sender: TObject);
var
ClipFmt: Word; {Declare the Windows Clipboard format variable}
DataHand: THandle; {Declare the Windows Clipboard data handle variable}
Info: Pointer; {Declare the pointer to the OLE initialization info}
begin
if PasteSpecialEnabled(Self, OLEFrameForm.Fmts) then {If there is something to paste}
if PasteSpecialDlg(OLEObjectForm, OLEFrameForm.Fmts, 0, {Paste Special dialog box}
ClipFmt, DataHand, Info) then
InitializeOLEObject(Info) {Initialize the OLE object}
end;

procedure TOLEObjectForm.Edit1Click(Sender: TObject);
begin
PasteSpecial1.Enabled := PasteSpecialEnabled(Self, OLEFrameForm.Fmts)
end;

procedure TOLEFrameForm.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
var
NewChild: TOLEObjectForm;
begin
if Source is TOLEDropNotify then
begin
NewChild := CreateChild;
with Source as TOLEDropNotify do
NewChild.OLEContainer.PInitInfo := PInitInfo;
end
end;

procedure TOLEObjectForm.Saveas1Click(Sender: TObject);
begin
if SaveAsDialog.Execute then
OLEContainer.SaveToFile(SaveAsDialog.FileName) {Save the object to FileName}
end;

procedure TOLEFrameForm.Open1Click(Sender: TObject);
var
NewChild: TOLEObjectForm;
begin
if OpenDialog.Execute then
begin
NewChild := CreateChild;
NewChild.OLEContainer.LoadFromFile(OpenDialog.File Name)
end
end;

procedure TOLEObjectForm.Open1Click(Sender: TObject);
begin
OLEFrameForm.Open1Click(Sender)
end;

**JudasPriest** · 09-03-2008, 19:44

vay be bunları bilsem delphi dersinden kesin geçerdim

28-01-2008, 12:25	#1 (permalink)
~~MeLeK~~ Banlandı Üyelik tarihi: 22-11-2007 Nerden: napıcan ziyaretemi geLcen!! Mesajlar: 4.542 Konular: 2724 Üye No: 11416 Ruh halim: Rep Gücü : 0 Rep Puanı : 4991 Rep Seviyesi :	Muhtelif Kodlar procedure TForm1.Button1Click(Sender: TObject); begin Form2.ShowModal; end; procedure TForm2.CancelButtonClick(Sender: TObject); begin Form2.Close; end; procedure TForm1.Button1Click(Sender: TObject); begin Form1.Color := clAqua; end; procedure TForm1.AddBtnClick(Sender: TObject); begin Listbox1.Items.Add(Edit1.Text); {add this line of code} end; procedure TForm1.ClearBtnClick(Sender: TObject); begin ListBox1.Items.Clear; {add this line of code} end; procedure TForm1.Button1Click(Sender: TObject); begin AboutBox.Caption := 'About '+ Application.Title; { use the application’s name } AboutBox.ShowModal; { then open the dialog box } end procedure TMain1.Button1Click(Sender: TObject); begin if Sender = Button1 then {this is the first line you add} AboutBox.Caption := 'About ' + Application.Title {remove the existing semicolon} else AboutBox.Caption := ''; {this is the second line you add} AboutBox.ShowModal; end; procedure TForm1.Button1Click(Sender: TObject); begin MessageDlg('Save changes?', mtConfirmation, mbYesNoCancel , 0); end; procedure TForm1.Button1Click(Sender: TObject); begin Label1.Caption := InputBox('Password Entry Form', 'Enter Password', '') end; procedure TForm1.Button1Click(Sender: TObject); begin PasswordDlg.ShowModal; end; procedure TMainForm.Button1Click(Sender: TObject); begin AboutBox.Show; {This is the line you need to write} end; procedure TMainForm.Button1Click(Sender: TObject); begin AboutBox.ShowModal; end; procedure TForm1.Button1Click(Sender: TObject); begin Button2.Enabled := False; end; procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Lines.Add(Edit1.Text); Edit1.Clear; end; procedure TForm1.SpeedButton1Click(Sender: TObject); begin Form2.Show; end; procedure TForm1.Button1Click(Sender: TObject); begin Edit1.Color := clRed; end; procedure TForm1.ColorGrid1Click(Sender: TObject); begin Edit1.Color := ColorGrid1.ForegroundColor; end; procedure TForm1.AddButtonClick(Sender: TObject); var X, Y, Sum: Integer; begin X := 100; Y := 10; Sum := X + Y; Edit1.Text := IntToStr(Sum); end; procedure TForm1.AddButtonClick(Sender: TObject); var X, Y: Integer; begin X := 100; Y := 10; Edit1.Text := IntToStr(X + Y); end; procedure TForm1.CutClick(Sender: TObject); begin Memo1.CutToClipboard; end; procedure TForm1.CopyClick(Sender: TObject); begin Memo1.CopyToClipboard; end; procedure TForm1.PasteClick(Sender: TObject); begin Memo1.PasteFromClipboard; end; procedure TForm1.ClearAllClick(Sender: TObject); begin Memo1.Clear; end; procedure TForm1.AddButtonClick(Sender: TObject); var X, Y, Sum: Integer; begin X := 100; Y := 10; Sum := X + Y; Edit1.Text := IntToStr(Sum); end; procedure TForm1.ChangeColorClick(Sender: TObject); begin if ColorDialog1.Execute then { if user clicks OK button } Form1.Color := ColorDialog1.Color else Form1.Color := clRed; end; procedure TForm1.OKClick(Sender: TObject); begin if Edit1.Text = 'Saturday' then Label2.Caption := 'Why are you working today?'; end; procedure TForm1.OKClick(Sender: TObject); begin if Edit1.Text = 'Saturday' then Label2.Caption := 'Why are you working today?' else Label2.Caption := ''; end; procedure TForm1.OKClick(Sender: TObject); begin if Edit1.Text = 'Saturday' then begin Label2.Caption := 'Why are you working today?'; Form1.Color := clYellow; end else Label2.Caption := ''; end; procedure TForm1.OKClick(Sender: TObject); begin if Edit1.Text = 'Saturday' then Label2.Caption := 'Why are you working today?' else if Edit1.Text = 'Sunday' then Label2.Caption := 'You should be resting' else if Edit1.Text = 'Monday' then Label2.Caption := 'Welcome to a new work week!' else Label2.Caption := ''; end; procedure TForm1.OKClick(Sender: TObject); var Number: Integer; begin Number := StrToInt(Edit1.Text); case Number of 1, 3, 5, 7, 9: Label2.Caption := 'Odd digit'; 0, 2, 4, 6, 8: Label2.Caption := 'Even digit'; 10..100: Label2.Caption := 'Between 10 and 100'; else Label2.Caption := 'Greater than 100 or negative'; end; end; procedure TForm1.RepeatButtonClick(Sender: TObject); var I: Integer; begin I := 0; repeat I := I + 1; Writeln(I); until I = 10; end; procedure TForm1.WhileButtonClick(Sender: TObject); var J: Integer; begin J := 0; while J < 10 do begin J := J + 1; Writeln(J:50); end; end; procedure TForm1.CountButtonClick(Sender: TObject); var Col: Integer; begin for Col := 1 to 5 do StringGrid1.Cells[Col, 1] := IntToStr(Col); end; procedure TForm1.CountButtonClick(Sender: TObject); var Col: Integer; begin for Col := 5 downto 1 do StringGrid1.Cells[Col, 1] := IntToStr(Col); end; procedure TForm1.ShowCoordinatesButtonClick(Sender: TObject); var Col, Row: Integer; begin for Col := 1 to 5 do StringGrid1.Cells[Col, 0] := 'Col ' + IntToStr(Col); for Row := 1 to 5 do StringGrid1.Cells[0, Row] := 'Row ' + IntToStr(Row); for Col := 1 to 5 do for Row := 1 to 5 do StringGrid1.Cells[Col, Row] := 'Col ' + IntToStr(Col) + ', ' + 'Row ' + IntToStr(Row); end; procedure TForm1.Button1Click(Sender: TObject); begin { The block starts here with the statement part } Edit1.Text := 'Welcome to Delphi'; end; var { The block begins here with the start of the declaration part } Name: string; begin { The statement part of the block begins } Name := Edit1.Text; Edit2.Text := 'Welcome to Delphi, ' + Name; end; procedure TForm1.MultiplyClick(Sender: TObject); { Multiplies two numbers together } var FirstNumber, SecondNumber: Integer; begin FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber * SecondNumber); { Displays answer in Edit3 } end; procedure TForm1.DivideClick(Sender: TObject); begin FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber div SecondNumber); end; procedure TForm1.DivideClick(Sender: TObject); var FirstNumber, SecondNumber: Integer; begin FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber div SecondNumber); end; implementation {$R .DFM} var FirstNumber, SecondNumber: Integer; { Variables global to the event handlers } procedure TForm1.MultiplyClick(Sender: TObject); { Multiplies two numbers together } begin FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber SecondNumber); { Displays result in Edit3 } end; procedure TForm1.DivideClick(Sender: TObject); { Divides first number by the second } begin FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber div SecondNumber); { Displays result in Edit3 } end; procedure TForm1.DivideClick(Sender: TObject); var FirstNumber, SecondNumber, Count: Integer; begin Count := 0; FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber div SecondNumber); Count := Count + 1; Counter.Text := IntToStr(Counter); end; implementation {$R .DFM} var Count: Integer; procedure TForm1.MultiplyClick(Sender: TObject); var FirstNumber, SecondNumber: Integer; begin FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber SecondNumber); Count := Count + 1; Counter.Text := IntToStr(Count); end; procedure TForm1.DivideClick(Sender: TObject); var FirstNumber, SecondNumber: Integer; begin FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber div SecondNumber); Count := Count + 1; Counter.Text := IntToStr(Count); end; initialization Count := 0; end function NoValue(AnEditBox: TEdit): Boolean; begin if AnEditBox.Text = '' then begin AnEditBox.Color := clRed; AnEditBox.Text := 'Enter a value'; Result := True; end else begin AnEditBox.Color := clWindow; Result := False; end; end; procedure TForm1.MultiplyClick(Sender: TObject); var FirstNumber, SecondNumber: Integer; begin if NoValue(Edit1) or NoValue(Edit2) then { This line calls NoValue twice } Exit; { If an edit box is empty, quit this event handler } FirstNumber := StrToInt(Edit1.Text); SecondNumber := StrToInt(Edit2.Text); Edit3.Text := IntToStr(FirstNumber * SecondNumber); Count := Count + 1; Counter.Text := IntToStr(Count); end; procedure TForm1.Button1Click(Sender: TObject); var Number: Integer; begin Number := StrToInt(Edit1.Text); Calculate(Number); Edit2.Text := IntToStr(Number); end; implementation {$R *.DFM} type TCourse = (Nothing, History, Literature, Biology, Psychology); var SelectedCourse: TCourse; procedure TForm1.HistoryButtonClick(Sender: TObject); begin SelectedCourse := History; end; procedure TForm1.LiteratureButtonClick(Sender: TObject); begin SelectedCourse := Literature; end; procedure TForm1.BiologyButtonClick(Sender: TObject); begin SelectedCourse := Biology; end; procedure TForm1.PsychologyButtonClick(Sender: TObject); begin SelectedCourse := Psychology; end; procedure TForm1.Button1Click(Sender: TObject); begin case SelectedCourse of History: Label1.Caption := 'You are taking history'; Literature: Label1.Caption := 'You are taking literature'; Biology: Label1.Caption := 'You are taking biology'; Psychology: Label1.Caption := 'You are taking psychology'; else Label1.Caption := 'You are taking nothing'; end; end; procedure TForm1.Button1Click(Sender: TObject); {$R+} type TValidEntry = 1..100; var Entry: TValidEntry; begin Entry := StrToInt(Edit1.Text); Label2.Caption := 'Excellent!'; end; procedure TForm1.FindLengthClick(Sender: TObject); type TEditString = string; var UserString: TEditString; begin UserString := Edit1.Text; Label2.Caption := 'This string is ' + IntToStr(Length(UserString)) + ' characters in length'; end; procedure TForm1.FindLengthClick(Sender: TObject); begin Label2.Caption := 'This string is ' + IntToStr(Length(Edit1.Text)) + ' characters in length'; end; procedure TForm1.Button1Click(Sender: TObject); type TVowels = set of Char; var Vowels: TVowels; begin Vowels := ['A','E','I','O','U']; if Edit1.Text[1] in Vowels then Label2.Caption := 'You are clever' else Label2.Caption := 'Please try again'; end; procedure TForm1.Button1Click(Sender: TObject); begin Form1.Color := clGreen; end; procedure TForm1.Button1Click(Sender: TObject); begin Color := clFuchsia; Edit1.Color := clLime; end; begin ListBox1.Clear; ListBox1.MultiSelect := True; ListBox1.Items.Add('One'); ListBox1.Items.Add('Two'); ListBox1.Items.Add('Three'); ListBox1.Sorted := True; ListBox1.Font.Style := [fsBold]; ListBox1.Font.Color := clPurple; ListBox1.Font.Name := 'Times New Roman'; ListBox1.ScaleBy(125, 100); end; procedure TForm1.Button1Click(Sender: TObject); begin with ListBox1 do begin Clear; MultiSelect := True; Items.Add('One'); Items.Add('Two'); Items.Add('Three'); Sorted := True; Font.Style := [fsBold]; Font.Color := clPurple; Font.Name := 'Times New Roman'; ScaleBy(125, 100); end; end; procedure TForm1.Button1Click(Sender: TComponent); var APointer: Pointer; AnInteger, ADividend: Integer; begin ADividend := 0; GetMem(APointer, 1024); { allocate 1K of memory } AnInteger := 10 div ADividend; { this generates an error } FreeMem(APointer, 1024); { it never gets here } end; procedure TForm1.Button1Click(Sender: TComponent); var APointer: Pointer; AnInteger, ADividend: Integer; begin ADividend := 0; GetMem(APointer, 1024); { allocate 1K of memory } try AnInteger := 10 div ADividend; { this generates an error } finally FreeMem(APointer, 1024); { execution resumes here, despite the error } end; end; procedure TForm1.Button1Click(Sender: TObject); begin ListBox1.Items.Add('a string'); { add a string to list box } ListBox1.Items.Add('another string'); { add another string... } ListBox1.Items.Add('still another string'); { ...and a third string } try Caption := ListBox1.Items[3]; { set form caption to fourth string in list box } except on EListError do MessageDlg('List box contains fewer than four strings', mtWarning, [mbOK], 0); end; end; procedure TForm1.Button1Click(Sender: TObject); var I: Integer; begin for I := 1 to 10 do { loop ten times } begin ListBox1.Items.Add(IntToStr(I)); { add a numeral to the list } if I = 7 then Abort; { abort after the seventh one } end; end; procedure TForm1.Button1Click(Sender: TObject); var Index: Integer; begin for Index := 0 to ListBox1.Items.Count - 1 do ListBox1.Items[Index] := UpperCase(ListBox1.Items[Index]); end; procedure TForm1.FormCreate(Sender: TObject); var FileName: string; { storage for file name } begin FileName := 'C:\AUTOEXEC.BAT'; { set the file name } with Memo1 do begin LoadFromFile(FileName); { load from file } SaveToFile(ChangeFileExt(FileName, 'BAK')); { save into backup file } end; end; procedure TForm1.Button1Click(Sender: TObject); var TempList: TStrings; { declare the list } begin TempList := TStringList.Create; { construct the list object } try { use the string list } finally TempList.Free; { destroy the list object } end; end; procedure TForm1.FormCreate(Sender: TObject); begin ClickList := TStringList.Create; { construct the list } end; procedure TForm1.FormDestroy(Sender: TObject); begin ClickList.SaveToFile(ChangeFileExt(Application.Exe Name, '.LOG')); { save the list } ClickList.Free; { destroy the list object } end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ClickList.Add(Format('Click at (%d, %d)', [X, Y])); { add a string to the list } end; procedure TFrameForm.NewChild(Sender: TObject); var EditForm: TEditForm; {declare the child form as a variable} begin EditForm := TEditForm.Create(Self); {create the new child window} end; procedure TEditForm.New1Click(Sender: TObject); begin FrameForm.NewChild(Sender); end; procedure TFrameForm.Tile1Click(Sender: TObject); begin Tile; {this is the only code you write} end; procedure TFrameForm.Cascade1Click(Sender: TObject); begin Cascade; {this is the only code you write} end; procedure TFrameForm.ArrangeIcons1Click(Sender: TObject); begin ArrangeIcons; {this is the only code you write} end; procedure TEditForm.AlignClick(Sender: TObject); begin Left1.Checked := False; Right1.Checked := False; Center1.Checked := False; with Sender as TMenuItem do Checked := True; with Memo1 do if Left1.Checked then Alignment := taLeftJustify else if Right1.Checked then Alignment := taRightJustify else if Center1.Checked then Alignment := taCenter; end; procedure TEditForm.SetWordWrap(Sender: TObject); begin with Memo1 do begin WordWrap := not WordWrap; if WordWrap then ScrollBars := ssVertical else ScrollBars := ssBoth; WordWrap1.Checked := WordWrap; end; end; procedure TEditForm.SelectAll(Sender: TObject); begin Memo1.SelectAll; end; procedure TEditForm.CutToClipboard(Sender: TObject); begin Memo1.CutToClipboard; end; procedure TEditForm.CopyToClipboard(Sender: TObject); begin Memo1.CopyToClipboard; end; procedure TEditForm.PasteFromClipboard(Sender: TObject); begin Memo1.PasteFromClipboard; end; procedure TEditForm.Delete(Sender: TObject); begin Memo1.ClearSelection; end; procedure TEditForm.UpdateMenus; var HasSelection: Boolean; {declare a variable that stores the results of the Boolean} begin Paste1.Enabled := Clipboard.HasFormat(CF_TEXT); {enable or disable the Paste menu item} HasSelection := Memo1.SelLength <> 0; {assign the value of the Boolean variable based on whether any text is selected in the Memo} Cut1.Enabled := HasSelection; {enable the menu items if HasSelection evaluates to True} Copy1.Enabled := HasSelection; Delete1.Enabled := HasSelection; end; procedure TEditForm.SetEditItems(Sender: TObject); begin UpdateMenus; end; procedure TEditForm.UpdateMenus; var HasSelection: Boolean; begin Paste1.Enabled := Clipboard.HasFormat(CF_TEXT); Paste2.Enabled := Clipboard.HasFormat(CF_TEXT); {Add this line} HasSelection := Memo1.SelLength <> 0; Cut1.Enabled := HasSelection; Cut2.Enabled := HasSelection; {Add this line} Copy1.Enabled := HasSelection; Copy2.Enabled := HasSelection; {Add this line} Delete1.Enabled := HasSelection; end; procedure TEditForm.SetPopUpItems(Sender: TObject); begin UpdateMenus; end; procedure TEditForm.Open1Click(Sender: TObject); begin FrameForm.OpenChild(Sender); end; procedure TFrameForm.OpenChild(Sender: TObject); var EditForm: TEditForm; begin if OpenFileDialog.Execute then begin EditForm := TEditForm.Create(Self); EditForm.Open(OpenFileDialog.Filename); {Calls the Open method of EditForm} EditForm.Visible := True; end; end; procedure TEditForm.Open(const AFilename: string); begin Filename := AFilename; {assigns the parameter passed from FrameForm.OpenChild to the form variable} Memo1.Lines.LoadFromFile(FileName); {loads the file specified in the form variable} Memo1.SelStart := 0; Caption := ExtractFileName(FileName); {displays the filename in the form caption} Memo1.Modified := False; end; procedure TEditForm.SaveAs1Click(Sender: TObject); begin SaveFileDialog.Filename := Filename; {display current value of Filename, if any} if SaveFileDialog.Execute then begin Filename := SaveFileDialog.Filename; Caption := ExtractFileName(Filename); Save1Click(Sender); end; end; procedure TEditForm.Save1Click(Sender: TObject); procedure CreateBackup(const Filename: string); var BackupFilename: string; begin BackupFilename := ChangeFileExt(Filename, BackupExt); DeleteFile(BackupFilename); RenameFile(Filename, BackupFilename); end; begin if Filename = '' then SaveAs1Click(Sender) else begin CreateBackup(Filename); Memo1.Lines.SaveToFile(Filename); Memo1.Modified := False; end; end; procedure TEditForm.SetFont(Sender: TObject); begin FontDialog1.Font := Memo1.Font; if FontDialog1.Execute then Memo1.Font := FontDialog1.Font; end; procedure TEditForm.PrintSetUp1Click(Sender: TObject); begin PrinterSetupDialog1.Execute; end; procedure TEditForm.Print1Click(Sender: TObject); var Line: Integer;{declare an integer variable for the number of lines of text} PrintText: System.Text; {declare PrintText as text file defined in System unit} begin if PrintDialog1.Execute then begin AssignPrn(PrintText); {assign the global variable PrintText to the printer} Rewrite(PrintText); {create and open the output file} Printer.Canvas.Font := Memo1.Font;{assign the current Font setting for Memo1 to the Printer object's canvas} for Line := 0 to Memo1.Lines.Count - 1 do Writeln(PrintText, Memo1.Lines[Line]); {write the :-):-):-):-):-):-):-)s of the Memo to the printer object} CloseFile(PrintText); end; end; procedure TEditForm.Close1Click(Sender: TObject); begin Close; end; procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; procedure TEditForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var DialogValue: Integer; {declare an integer variable to store the user's response to the message dialog} FName: string; {declare a string variable to store the value of the file name when saving} begin if Memo1.Modified then begin FName := Caption; {save the value of the Caption property to the FName variable} if Length(FName) = 0 then FName := 'Untitled'; {if there is no filename, use 'Untitled'} DialogValue := MessageDlg(Format(SWarningText, [FName]), mtConfirmation, [mbYes, mbNo, mbCancel], 0); {produce the message dialog box} case DialogValue of id_Yes: Save1Click(Self); {Self parameter saves the instance of EditForm open at the time the user chooses Yes in the dialog}} id_Cancel: CanClose := False; {if the user chooses Cancel, exit the dialog and don’t close the form} end; end; end; procedure TEditForm.Exit1Click(Sender: TObject); begin FrameForm.Exit1Click(Sender); end; procedure TFrameForm.Exit1Click(Sender: TObject); begin Close; end; procedure TForm1.CheckBox1Click(Sender: TObject); begin CheckBox1.Font.Color := Canvas.Pixels[10, 10]; end; procedure TForm1.Button1Click(Sender: TObject); begin Canvas.Pixels[Random(ClientWidth), Random(ClientHeight)] := clRed; end; procedure TForm1.FormPaint(Sender: TObject); begin with Canvas do begin MoveTo(0, 0); LineTo(ClientWidth, ClientHeight); MoveTo(0, ClientHeight); LineTo(ClientWidth, 0); end; end; procedure TForm1.FormPaint(Sender: TObject); begin with Canvas do PolyLine([Point(0, 0), Point(50, 0), Point(75, 50), Point(25, 50), Point(0, 0)]); end; procedure TForm1.FormPaint(Sender: TObject); begin Canvas.Rectangle(0, 0, ClientWidth div 2, ClientHeight div 2); Canvas.Ellipse(0, 0, ClientWidth div 2, ClientHeight div 2); end; procedure TForm1.FormPaint(Sender: TObject); begin Canvas.RoundRect(0, 0, ClientWidth div 2, ClientHeight div 2, 10, 10); end; procedure TForm1.FormPaint(Sender: TObject); begin Canvas.Polygon([Point(0, 0), Point(0, ClientHeight), Point(ClientWidth, ClientHeight)]); end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Canvas.TextOut(X, Y, 'Here!'); { write text at (X, Y) } end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Canvas.MoveTo(X, Y); { set pen position } end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Canvas.LineTo(X, Y); { draw line from PenPos to (X, Y) } end; procedure TForm1.FormMouseMove(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Canvas.LineTo(X, Y); { draw line to current position } end; type TForm1 = class(TForm) procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); public Drawing: Boolean; Origin, MovePt: TPoint; { fields to store points } end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Drawing := True; { set the Drawing flag } Canvas.MoveTo(X, Y); end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Canvas.LineTo(X, Y); Drawing := False; { clear the Drawing flag } end; procedure TForm1.FormMouseMove(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Drawing then { only draw if Drawing flag is set } Canvas.LineTo(X, Y); end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Drawing := True; Canvas.MoveTo(X, Y); Origin := Point(X, Y); { record where the line starts } end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Canvas.MoveTo(Origin.X, Origin.Y); { move pen to starting point } Canvas.LineTo(X, Y); Drawing := False; end; procedure TForm1.FormMouseMove(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Drawing then begin Canvas.MoveTo(Origin.X, Origin.Y); { move pen to starting point } Canvas.LineTo(X, Y); end; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Drawing := True; Canvas.MoveTo(X, Y); Origin := Point(X, Y); MovePt := Point(X, Y); { keep track of where this move was } end; procedure TForm1.FormMouseMove(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Drawing then begin Canvas.Pen.Mode := pmNotXor; { use XOR mode to draw/erase } Canvas.MoveTo(Origin.X, Origin.Y); { move pen back to origin } Canvas.LineTo(MovePt.X, MovePt.Y); { erase the old line } Canvas.MoveTo(Origin.X, Origin.Y); { start at origin again } Canvas.LineTo(X, Y); { draw the new line } end; MovePt := Point(X, Y); { record point for next move } Canvas.Pen.Mode := pmCopy; end; procedure TForm1.LineButtonClick(Sender: TObject); { LineButton } begin DrawingTool := dtLine; end; procedure TForm1.RectangleButtonClick(Sender: TObject); { RectangleButton } begin DrawingTool := dtRectangle; end; procedure TForm1.EllipseButtonClick(Sender: TObject); { EllipseButton } begin DrawingTool := dtEllipse; end; procedure TForm1.RoundedRectButtonClick(Sender: TObject); { RoundRectButton } begin DrawingTool := dtRoundRect; end; procedure TForm1.FormMouseUp(Sender: TObject); begin if DrawingTool = dtLine then { draw a line } else if DrawingTool = dtRectangle then { draw a rectangle } { ... and so on ... } end; procedure TForm1.FormMouseUp(Sender: TObject); begin case DrawingTool of dtLine: { draw a line } dtRectangle: { draw a rectangle } { ... and so on ... } end; end; procedure TForm1.FormMouseUp(Sender: TObject); begin case DrawingTool of dtLine: begin Canvas.MoveTo(Origin.X, Origin.Y); Canvas.LineTo(X, Y) end; dtRectangle: Canvas.Rectangle(Origin.X, Origin.Y, X, Y); dtEllipse: Canvas.Ellipse(Origin.X, Origin.Y, X, Y); dtRoundRect: Canvas.RoundRect(Origin.X, Origin.Y, X, Y, (Origin.X - X) div 2, (Origin.Y - Y) div 2); end; Drawing := False; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if Drawing then begin Canvas.Pen.Mode := pmNotXor; case DrawingTool of dtLine: begin Canvas.MoveTo(Origin.X, Origin.Y); Canvas.LineTo(MovePt.X, MovePt.Y); Canvas.MoveTo(Origin.X, Origin.Y); Canvas.LineTo(X, Y); end; dtRectangle: begin Canvas.Rectangle(Origin.X, Origin.Y, MovePt.X, MovePt.Y); Canvas.Rectangle(Origin.X, Origin.Y, X, Y); end; dtEllipse: begin Canvas.Ellipse(Origin.X, Origin.Y, X, Y); Canvas.Ellipse(Origin.X, Origin.Y, X, Y); end; dtRoundRect: begin Canvas.RoundRect(Origin.X, Origin.Y, X, Y, (Origin.X - X) div 2, (Origin.Y - Y) div 2); Canvas.RoundRect(Origin.X, Origin.Y, X, Y, (Origin.X - X) div 2, (Origin.Y - Y) div 2); end; end; MovePt := Point(X, Y); end; Canvas.Pen.Mode := pmCopy; end; procedure TForm1.PenButtonClick(Sender: TObject); begin PenBar.Visible := PenButton.Down; end; procedure TForm1.BrushButtonClick(Sender: TObject); begin BrushBar.Visible := BrushButton.Down; end; procedure TForm1.SetPenStyle(Sender: TObject); begin with Canvas.Pen do begin if Sender = SolidPen then Style := psSolid else if Sender = DashPen then Style := psDash else if Sender = DotPen then Style := psDot else if Sender = DashDotPen then Style := psDashDot else if Sender = DashDotDotPen then Style := psDashDotDot else if Sender = ClearPen then Style := psClear; end; end; procedure TForm1.PenColorClick(Sender: TObject); begin Canvas.Pen.Color := PenColor.ForegroundColor; end; procedure TForm1.PenWidthChange(Sender: TObject); begin Canvas.Pen.Width := PenWidth.Position; { set the pen width directly } PenSize.Caption := IntToStr(PenWidth.Position); { convert to string for caption } end; procedure TForm1.SetBrushStyle(Sender: TObject); begin with Canvas.Brush do begin if Sender = SolidBrush then Style := bsSolid else if Sender = ClearBrush then Style := bsClear else if Sender = HorizontalBrush then Style := bsHorizontal else if Sender = VerticalBrush then Style := bsVertical else if Sender = FDiagonalBrush then Style := bsFDiagonal else if Sender = BDiagonalBrush then Style := bsBDiagonal else if Sender = CrossBrush then Style := bsCross else if Sender = DiagCrossBrush then Style := bsDiagCross; end; end; procedure TForm1.BrushColorClick(Sender: TObject); begin Canvas.Brush.Color := BrushColor.ForegroundColor; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Drawing := True; Canvas.MoveTo(X, Y); Origin := Point(X, Y); MovePt := Origin; OriginPanel.Caption := Format('Origin: (%d, %d)', [X, Y]); { update status bar } 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, Point(X, Y), pmNotXor); end; CurrentPanel.Caption := Format('Current: (%d, %d)', [X, Y]); { update status bar } end; procedure TForm1.FormCreate(Sender: TObject); var Bitmap: TBitmap; { temporary variable to hold the bitmap } begin Bitmap := TBitmap.Create; { construct the bitmap object } Bitmap.Width := 200; { assign the initial width... } Bitmap.Height := 200; { ...and the initial height } Image.Picture.Graphic := Bitmap; { assign the bitmap to the image control } 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.Print1Click(Sender: TObject); begin with Printer do begin BeginDoc; { start printing } Canvas.Draw(0, 0, Image.Picture.Graphic); { draw Image at upper left of page } EndDoc; { finish printing } end; end; procedure TForm1.Open1Click(Sender: TObject); begin if OpenDialog1.Execute then begin CurrentFile := OpenDialog1.FileName; Image.Picture.LoadFromFile(CurrentFile); end; end; procedure TForm1.Save1Click(Sender: TObject); begin if CurrentFile <> '' then Image.Picture.SaveToFile(CurrentFile) { save if already named } else SaveAs1Click(Sender); { otherwise get a name } end; procedure TForm1.Saveas1Click(Sender: TObject); begin if SaveDialog1.Execute then { get a file name } begin CurrentFile := SaveDialog1.FileName; { save the user-specified name } Save1Click(Sender); { then save normally } end; end; procedure TForm1.New1Click(Sender: TObject); var Bitmap: TBitmap; { temporary variable for the new bitmap } begin with NewBMPForm do begin ActiveControl := WidthEdit; { make sure focus is on width field } WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width); { use current dimensions... } HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height); { ...as default } if ShowModal <> idCancel then { continue if user doesn't cancel dialog box } begin Bitmap := TBitmap.Create; { create fresh bitmap object } Bitmap.Width := StrToInt(WidthEdit.Text); { use specified width } Bitmap.Height := StrToInt(HeightEdit.Text); { use specified height } Image.Picture.Graphic := Bitmap; { replace graphic with new bitmap } CurrentFile := ''; { indicate unnamed file } end; end; end; procedure TForm1.Copy1Click(Sender: TObject); begin Clipboard.Assign(Image.Picture); end; var ARect: TRect; begin Copy1Click(Sender); { copy picture to Clipboard } with Image.Canvas do begin CopyMode := cmWhiteness; { copy everything as white } ARect := Rect(0, 0, Image.Width, Image.Height); { get bitmap rectangle } CopyRect(ARect, Image.Canvas, ARect); { copy bitmap over itself } CopyMode := cmSrcCopy; { restore normal mode } end; end; procedure TForm1.PasteButtonClick(Sender: TObject); var Bitmap: TBitmap; begin if Clipboard.HasFormat(CF_BITMAP) then { check to see if there’s a bitmap on the clipboard ) begin {create a bitmap to hold the :-):-):-):-):-):-):-)s on the clipboard } Bitmap := TBitmap.Create; try { Get the bitmap off the clipboard using Assign } Bitmap.Assign(Clipboard); { Copy the bitmap to the Image } Image.Canvas.Draw(0, 0, Bitmap); finally Bitmap.Free; end; end; end; procedure TFMForm.FormCreate(Sender: TObject); var Drive, AddedIndex: Integer; begin for Drive := 0 to 25 do { iterate through all possible drives } if GetDriveType(Drive) > 0 then { positive values mean valid drives } begin AddedIndex := DriveTabSet.Tabs.Add(Chr(Drive + ord('a'))); { add a tab } if Chr(Drive + ord('A')) = FileList.Drive then { if it's current drive... } DriveTabSet.TabIndex := AddedIndex; { ...make that current tab } end; end; procedure TFMForm.DirectoryOutlineChange(Sender: TObject); begin FileList.Directory := DirectoryOutline.Directory; DirectoryPanel.Caption := DirectoryOutline.Directory; end; procedure TFMForm.FileListChange(Sender: TObject); var TheFileName: string; begin with FileList do begin if ItemIndex >= 0 then { is there a selected item? } begin TheFileName := Items[ItemIndex]; { get the file name } FilePanel.Caption := Format('%s, %d bytes', [TheFileName, GetFileSize(TheFileName)]); { set caption to file name/size } end else FilePanel.Caption := ''; { blank panel if none selected } end; end; procedure TFMForm.FormCreate(Sender: TObject); var Drive, AddedIndex: Integer; DriveLetter: Char; begin for Drive := 0 to 25 do { iterate through all possible drives } begin DriveLetter := Chr(Drive + ord('a')); case GetDriveType(Drive) of { positive values mean valid drives } DRIVE_REMOVABLE: { add a tab } AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Floppy.Picture.Graphic); DRIVE_FIXED: { add a tab } AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Fixed.Picture.Graphic); DRIVE_REMOTE: { add a tab } AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Network.Picture.Graphic); end; if UpCase(DriveLetter) = UpCase(DirectoryOutline.Drive) then { current drive? } DriveTabSet.TabIndex := AddedIndex; { then make that current tab } end; end; procedure TFMForm.DriveTabSetMeasureTab(Sender: TObject; Index: Integer; var TabWidth: Integer); { note that TabWidth is a var parameter} var BitmapWidth: Integer; begin BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width; { increase tab width by the width of the associated bitmap plus two } Inc(TabWidth, 2 + BitmapWidth); end; procedure TFMForm.DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas; R: TRect; Index: Integer; Selected: Boolean); var Bitmap: TBitmap; begin Bitmap := TBitmap(DriveTabSet.Tabs.Objects[Index]); with TabCanvas do begin Draw(R.Left, R.Top + 4, Bitmap); { draw bitmap } TextOut(R.Left + 2 + Bitmap.Width, { position text } R.Top + 2, DriveTabSet.Tabs[Index]); { and draw it to the right of the bitmap } end; end; procedure TFMForm.File1Click(Sender: TObject); var FileSelected: Boolean; begin FileSelected := FileList.ItemIndex >= 0; { True if there is a file selected } Open1.Enabled := FileSelected; Delete1.Enabled := FileSelected; Copy1.Enabled := FileSelected; Move1.Enabled := FileSelected; Rename1.Enabled := FileSelected; Properties1.Enabled := FileSelected; end; procedure TFMForm.Delete1Click(Sender: TObject); begin with FileList do if DeleteFile(FileName) then Update; end; procedure TFMForm.Delete1Click(Sender: TObject); begin with FileList do if MessageDlg('Delete ' + FileName + '?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then if DeleteFile(FileName) then Update; end; procedure TFMForm.Properties1Click(Sender: TObject); var Attributes, NewAttributes: Word; begin with FileAttrForm do begin FileDirName.Caption := FileList.Items[FileList.ItemIndex]; { set box caption } PathName.Caption := FileList.Directory; { show directory name } ChangeDate.Caption := DateTimeToStr(FileDateTime(FileList.FileName)); Attributes := FileGetAttr(FileDirName.Caption); { read file attributes } ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly; Archive.Checked := (Attributes and faArchive) = faArchive; System.Checked := (Attributes and faSysFile) = faSysFile; Hidden.Checked := (Attributes and faHidden) = faHidden; if ShowModal <> mrCancel then { execute dialog box } begin NewAttributes := Attributes; { start with original attributes } if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly else NewAttributes := NewAttributes and not faReadOnly; if Archive.Checked then NewAttributes := NewAttributes or faArchive else NewAttributes := NewAttributes and not faArchive; if System.Checked then NewAttributes := NewAttributes or faSysFile else NewAttributes := NewAttributes and not faSysFile; if Hidden.Checked then NewAttributes := NewAttributes or faHidden else NewAttributes := NewAttributes and not faHidden; if NewAttributes <> Attributes then { if anything changed... } FileSetAttr(FileDirName.Caption, NewAttributes); { ...write the new values } end; end; end; procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: string); begin if MessageDlg(Format('%s %s to %s?', [ACaption, FromFile, ToFile]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin if ACaption = 'Move' then MoveFile(FromFile, ToFile) else if ACaption = 'Copy' then CopyFile(FromFile, ToFile) else if ACaption = 'Rename' then RenameFile(FromFile, ToFile); FileList.Update; end; end; procedure TFMForm.FileChange(Sender: TObject); begin with ChangeDlg do begin if Sender = Move1 then Caption := 'Move' else if Sender = Copy1 then Caption := 'Copy' else if Sender = Rename1 then Caption := 'Rename' else Exit; CurrentDir.Caption := DirectoryOutline.Directory; FromFileName.Text := FileList.FileName; ToFileName.Text := ''; if (ShowModal <> mrCancel) and (ToFileName.Text <> '') then ConfirmChange(Caption, FromFileName.Text, ToFileName.Text); end; end; procedure TFMForm.Open1Click(Sender: TObject); begin with FileList do ExecuteFile(FileName, '', Directory, SW_SHOW); end; procedure TFMForm.Open1Click(Sender: TObject); begin with FileList do begin if HasAttr(FileName, faDirectory) then DirectoryOutline.Directory := FileName else ExecuteFile(FileName, '', Directory, SW_SHOW); end; end; procedure TFMForm.FileListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then { drag only if left button pressed } with Sender as TFileListBox do { treat Sender as TFileListBox } begin if ItemAtPos(Point(X, Y), True) >= 0 then { is there an item here? } BeginDrag(False); { if so, drag it } end; end; procedure TFMForm.DirectoryOutline1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin if Source is TFileListBox then Accept := True; end; procedure TFMForm.DirectoryOutline1DragDrop(Sender, Source: TObject; X, Y: Integer); begin if Source is TFileListBox then with DirectoryOutline do ConfirmChange('Move', FileList.FileName, Items[GetItem(X, Y)].FullPath); end; procedure TFMForm.FileListBox1EndDrag(Sender, Target: TObject; X, Y: Integer); begin if Target <> nil then FileList.Update; end; procedure TOLEFrameForm.New1Click(Sender: TObject); begin CreateChild {Call the CreateChild method} end; procedure TOLEFrameForm.Exit1Click(Sender: TObject); begin Close {close the main form, which terminates the application} end; procedure TOLEObjectForm.New1Click(Sender: TObject); begin OLEFrameForm.New1Click(Sender) {Call OLEFrameForm's File\|New handler} end; procedure TOLEObjectForm.Exit1Click(Sender: TObject); begin OLEFrameForm.Exit1Click(Sender) {Call OLEFrameForm's File\|Exit handler} end; procedure TOLEObjectForm.Cascade1Click(Sender: TObject); begin OLEFrameForm.Cascade {Cascade the MDI children of OLEFrameForm} end; procedure TOLEObjectForm.Tile1Click(Sender: TObject); begin OLEFrameForm.Tile {Tile the MDI children of OLEFrameForm} end; procedure TOLEObjectForm.ArrangeIcons1Click(Sender: TObject); begin OLEFrameForm.ArrangeIcons {Arrange the icons of the MDI chilren of OLEFrameForm} end; procedure TOLEObjectForm.OleContainerStatusLineEvent(Sender: TObject; Msg: String); begin OLEFrameForm.StatusBarPanel.Caption := Msg {Display Msg in status bar} end; procedure TOLEObjectForm.InitializeOLEObject(Info: Pointer); begin OLEContainer.PInitInfo := Info; {Initialize the container by pointing to Info} ReleaseOLEInitInfo(Info) end; procedure TOLEObjectForm.InsertObject1Click(Sender: TObject); var Info: Pointer; {Declare the pointer to the OLE initialization info} begin if InsertOLEObjectDlg(OLEFrameForm, 0, Info) then {Insert Object dialog box} InitializeOLEObject(Info); {Initialize the OLE object} end; procedure TOLEObjectForm.Deactivate1Click(Sender: TObject); begin OLEContainer.Active := False {Deactivate the OLE object} end; procedure TOLEFrameForm.FormCreate(Sender: TObject); begin FEmbedClipFmt := RegisterClipboardFormat('Embedded Object'); FLinkClipFmt := RegisterClipboardFormat('Link Source'); end; procedure TOLEFrameForm.FormCreate(Sender: TObject); begin FEmbedClipFmt := RegisterClipboardFormat('Embedded Object'); FLinkClipFmt := RegisterClipboardFormat('Link Source'); Fmts[0].fmtId := FEmbedClipFmt; {Embedded OLE object Clipboard format} Fmts[0].fmtMedium := BOLEMediumCalc(FEmbedClipFmt); {Medium for embedded objects} Fmts[0].fmtIsLinkable := False; {No linking to OLE server} StrPCopy (Fmts[0].fmtName, '%s'); {Name from OLE server} StrPCopy (Fmts[0].fmtResultName, '%s'); {Result name from OLE server} Fmts[1].fmtId := FLinkClipFmt; {Linked OLE object Clipboard format} Fmts[1].fmtMedium := BOLEMediumCalc(FLinkClipFmt); {Medium for linked objects} Fmts[1].fmtIsLinkable := True; {Allows linking to OLE server} StrPCopy (Fmts[1].fmtName, '%s'); {Name from OLE server} StrPCopy (Fmts[1].fmtResultName, '%s'); {Result name from OLE server} end; procedure TOLEObjectForm.PasteSpecial1Click(Sender: TObject); var ClipFmt: Word; {Declare the Windows Clipboard format variable} DataHand: THandle; {Declare the Windows Clipboard data handle variable} Info: Pointer; {Declare the pointer to the OLE initialization info} begin if PasteSpecialEnabled(Self, OLEFrameForm.Fmts) then {If there is something to paste} if PasteSpecialDlg(OLEObjectForm, OLEFrameForm.Fmts, 0, {Paste Special dialog box} ClipFmt, DataHand, Info) then InitializeOLEObject(Info) {Initialize the OLE object} end; procedure TOLEObjectForm.Edit1Click(Sender: TObject); begin PasteSpecial1.Enabled := PasteSpecialEnabled(Self, OLEFrameForm.Fmts) end; procedure TOLEFrameForm.FormDragDrop(Sender, Source: TObject; X, Y: Integer); var NewChild: TOLEObjectForm; begin if Source is TOLEDropNotify then begin NewChild := CreateChild; with Source as TOLEDropNotify do NewChild.OLEContainer.PInitInfo := PInitInfo; end end; procedure TOLEObjectForm.Saveas1Click(Sender: TObject); begin if SaveAsDialog.Execute then OLEContainer.SaveToFile(SaveAsDialog.FileName) {Save the object to FileName} end; procedure TOLEFrameForm.Open1Click(Sender: TObject); var NewChild: TOLEObjectForm; begin if OpenDialog.Execute then begin NewChild := CreateChild; NewChild.OLEContainer.LoadFromFile(OpenDialog.File Name) end end; procedure TOLEObjectForm.Open1Click(Sender: TObject); begin OLEFrameForm.Open1Click(Sender) end;

Konu Araçları
Yazdırılabilir şekli göster Sayfayı E-Mail olarak gönder
Stil
Normal Hybrid-şeklinde gösterime geç Ağaç şeklinde gösterime geç