USLANMAM
USLANMAM öğesini iGoogle sayfanıza ekleyin.
UslanmaM En Kaliteli Bilgi Adresiniz
Geri git   USLANMAM > PROGRAM > PROGRAMLAMA DİLLERİ > Programlama > Delphi
Google
 
UslanmaM Resim AlbümleriSosyal Gruplar
Kayıt ol Sosyal Gruplar Ajanda Konuları Okundu Kabul Et

Yeni Konu aç  Cevapla
 
LinkBack Seçenekler Stil
Alt 11-26-2007, 09:54 AM   #1 (permalink)
*BUNALIMLARIN ADMİNİ*
 
BoDyGuArD - ait Kullanıcı Resmi (Avatar)
Post 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)].aaaaPath);
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;

BoDyGuArD isimli Üye şimdilik offline konumundadır  
Digg this Post!Add Post to del.icio.usBookmark Post in TechnoratiFurl this Post!
Alıntı ile Cevapla

Cevapla


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 
Seçenekler
Stil

Yetkileriniz
You may not post new threads
You may not post replies
Eklenti Ekleyemezsiniz
You may not edit your posts

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-KodlarıKapalı
Trackbacks are Açık
Pingbacks are Açık
Refbacks are Açık
Gitmek istediğiniz klasörü seçiniz