![]() |
|
|
#1 (permalink) |
|
*BUNALIMLARIN ADMİNİ*
![]() |
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 theprinter 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 anddon’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 thenif 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 thenbegin 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) thenDirectoryOutline.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) thenInitializeOLEObject(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; |
|
|
|