Version:0.9 StartHTML:0000000105 EndHTML:0000044493 StartFragment:0000001037 EndFragment:0000044477
//Example of the memo load and save capabilities of the VCL
//Task: Make the 3rd algo too!
//Get the text and write your memo memories, locs=218
program Sorting_Form_Demo;
const LEFTBASE = 20;
TOPBASE = 25;
vARRSIZE = 200;
type
//TThreadSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
TmSortArray = array[0..ARRSIZE] of Integer;
var
mymemo: TMemo;
mpaint, mpaint2: TPaintBox;
inFrm: TForm;
mbtn3: TBitBtn;
Lstbox: TListbox;
stat: TStatusbar;
selectedFile: string;
BubbleSortArray: TSortArray;
SelectionSortArray: TSortArray;
QuickSortArray: TSortArray;
ArraysRandom: Boolean;
FA, FB, FI, FJ: Integer;
procedure PaintLine(Canvas: TCanvas; I, Len: Integer); forward;
procedure RandomizeArrays;
var
I: Integer;
begin
//I:= 0;
//if b then dialogs.showmessage('this is')
assert(high(BubbleSortArray) <= 200, 'array to big');
//Check(high(BubbleSortArray) <= 170, 'array to big');
if not ArraysRandom then begin
Randomize;
for I:= 1 to ARRSIZE - 1 do
//SelectionSortarray[i]:= random(165);
BubbleSortArray[I]:= Random(170);
SelectionSortArray:= BubbleSortArray;
QuickSortArray:= BubbleSortArray;
writeln('just random done')
end;
end;
procedure PaintRandomArray;
var I: integer;
begin
mPaint.Canvas.Pen.Color:= clblue;
for I:= Low(SelectionSortArray) to High(SelectionSortArray) do
PaintLine(mpaint.Canvas, I, SelectionSortArray[I]);
mPaint2.Canvas.Pen.Color:= clgreen;
for I:= Low(BubbleSortArray) to High(BubbleSortArray) do
PaintLine(mpaint2.Canvas, I, BubbleSortArray[I])
end;
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
begin
canvas.moveTo(0, I * 2 + 1)
canvas.LineTo(Len, I * 2 + 1)
//Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;
procedure DoVisualSwap2;
begin
with mpaint2 do begin
//invalidate;
Canvas.Pen.Color:= clBtnFace;
//Canvas.Pen.Color:= clBlue;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
Canvas.Pen.Color:= clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;
procedure DoVisualSwap;
begin
with mpaint do begin
//invalidate;
Canvas.Pen.Color:= clBtnFace;
//Canvas.Pen.Color:= clBlue;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
Canvas.Pen.Color:= clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;
procedure VisualSwap2(A, B, I, J: Integer);
begin
//symbol rename
FA:= A;
FB:= B;
FI:= I;
FJ:= J;
//if bolTHslowmotion then
// sysutils.sleep(5);
//DoVisualSwap;
DoVisualSwap2;
end;
procedure VisualSwap(A, B, I, J: Integer);
begin
//symbol rename
FA:= A;
FB:= B;
FI:= I;
FJ:= J;
//if bolTHslowmotion then
// sysutils.sleep(5);
DoVisualSwap;
//DoVisualSwap2;
end;
procedure TvSelectionSort(var A: TSortArray);
// syncedit
var
indx, J, T: Integer;
begin
for indx := Low(A) to High(A) - 1 do
for J := High(A) downto indx + 1 do
if A[indx] > A[J] then begin
VisualSwap(A[indx], A[J], indx, J);
//write('debug')
T:= A[indx];
A[indx] := A[J];
A[J] := T;
//if Terminated then Exit;
end;
end;
{ TBubbleSort }
procedure TvBubbleSort(var A: TSortArray);
var
I, J, T: Integer;
begin
for I := High(A) downto Low(A) do
for J := Low(A) to High(A) - 1 do
if A[J] > A[J + 1] then begin
VisualSwap2(A[J], A[J + 1], J, J + 1);
T := A[J];
A[J] := A[J + 1];
A[J + 1] := T;
end;
end;
procedure QuickSort(var A: TSortArray; iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
// inline variable
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid
do Inc(Lo);
while A[Hi] > Mid
do Dec(Hi);
if Lo <= Hi then begin
VisualSwap(A[Lo], A[Hi], Lo, Hi);
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSort(A, iLo, Hi);
if Lo < iHi then QuickSort(A, Lo, iHi);
//if Terminated then Exit;
end;
procedure TvQuickSort(var A: TSortArray);
begin
QuickSort(A, Low(A), High(A));
end;
Function getRandomText: string;
var i, getback: integer;
begin
for i:= 1 to 1400 do begin
getback:= random(58)+65
if (getback < 91) OR (getback > 96) then
result:= result + Chr(getback) +Chr(32)
end;
end;
//Event Handler - Closure
Procedure GetMediaData(self: TObject);
begin
if PromptForFileName(selectedFile,
'Text files (*.txt)|*.txt',
'',
'Select your mX3 test file',
ExePath+'examples\', False) // Means not a Save dialog !
then begin
// Display this full file/path value
ShowMessage('Selected file = '+selectedFile);
Stat.simpletext:= selectedFile;
mymemo.lines.LoadFromFile(selectedFile);
// Split this full file/path value into its constituent parts
//writeln('PromptForFileName_28: Res of processpath '+tmp)
end;
end;
//Event Handler - Closure
procedure BtnStartClick(self: TObject);
begin
//mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
mymemo.lines.text:= getRandomText;
mPaint.invalidate;
RandomizeArrays;
PaintRandomArray;
TvSelectionSort(selectionSortArray)
TvBubbleSort(bubbleSortArray)
//mymemo.lines.SaveToFile(selectedFile);
Stat.simpletext:= ' start has been sorted' ;
end;
procedure GetRandom(self: TObject);
begin
//mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
mymemo.lines.text:= getRandomText;
mPaint.invalidate;
mPaint2.invalidate;
RandomizeArrays;
PaintRandomArray;
end;
procedure BtnSortClick(self: TObject);
begin
//mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
//RandomizeArrays(inFrm);
//PaintRandomArray;
mPaint.invalidate;
mPaint2.invalidate;
TvSelectionSort(selectionSortArray)
TvBubbleSort(bubbleSortArray)
//mymemo.lines.SaveToFile(selectedFile);
//Stat.simpletext:= selectedFile+ ' has been saved' ;
end;
procedure SetForm;
var
mbtn, mbtn2: TBitBtn;
mi, mi1, mi2, mi3: TMenuItem;
mt: TMainMenu;
mlbl, mlbl1: TLabel;
begin
inFrm:= TForm.Create(self);
mLbl:= TLabel.create(inFrm);
mLbl1:= TLabel.create(inFrm);
mPaint:= TPaintBox.Create(inFrm);
mPaint2:= TPaintBox.Create(inFrm);
stat:= TStatusbar.Create(inFrm);
Lstbox:= TListbox.create(inFrm);
mymemo:= TMemo.create(inFrm);
with inFrm do begin
caption:= '********SortMonster3************';
height:= 610;
width:= 980;
//color:= clred;
Position:= poScreenCenter;
//onClose:= @CloseClick;
Show;
end;
with mPaint do begin
Parent:= inFrm;
SetBounds(LEFTBASE+10,TOPBASE+40,200,400)
color:= clsilver;
Show;
//onpaint:= @closeclick;
end;
with mPaint2 do begin
Parent:= inFrm;
SetBounds(LEFTBASE+210,TOPBASE+40,200,400)
color:= clsilver;
Show;
//onpaint:= @closeclick;
end;
with mymemo do begin
Parent:= inFrm;
SetBounds(LEFTBASE+520, TOPBASE+40, 400, 400)
font.size:= 14;
color:= clYellow;
wordwrap:= true;
scrollbars:= ssvertical;
end;
mBtn:= TBitBtn.Create(inFrm)
with mBtn do begin
Parent:= inFrm;
setbounds(LEFTBASE+ 590, TOPBASE+ 460,150, 40);
caption:= 'Random';
font.size:= 12;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPAUSE');
//event handler
onclick:= @GetRandom;
end;
mBtn2:= TBitBtn.Create(inFrm)
with mBtn2 do begin
Parent:= inFrm;
setbounds(LEFTBASE+ 430, TOPBASE+460,150, 40);
caption:= 'Sort';
font.size:= 12;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPEJECT');
//event handler
onclick:= @BtnSortClick;
end;
mBtn3:= TBitBtn.Create(inFrm)
with mBtn3 do begin
Parent:= inFrm;
setbounds(LEFTBASE+ 750, TOPBASE+460,150, 40);
caption:= 'Start Sort';
font.size:= 12;
//glyph.LoadFromResourceName(getHINSTANCE,'PREVIEWGLYPH');
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTEP');
//event handler
onclick:= @BtnStartClick;
end;
with mlbl do begin
parent:= inFrm;
setbounds(LEFTBASE+15,TOPBASE-15,180,20);
font.size:= 28;
font.color:= clred;
//font.style:= [fsunderline]
caption:= 'SortMemoApp Draft';
end;
with mlbl1 do begin
parent:= inFrm;
setbounds(LEFTBASE+495,TOPBASE-1,180,20);
font.size:= 20;
font.color:= clred;
caption:= 'Text File:';
end;
mt:= TMainMenu.Create(infrm)
with mt do begin
//parent:= frmMon;
end;
mi:= TMenuItem.Create(mt)
mi1:= TMenuItem.Create(mt)
mi2:= TMenuItem.Create(mt)
mi3:= TMenuItem.Create(mi)
with mi do begin
//parent:= frmMon;
Caption:='Play Media';
Name:='ITEM';
mt.Items.Add(mi);
//OnClick:= @GetMediaData;
end;
with mi1 do begin
//parent:= frmMon;
Caption:='Show Video';
Name:='ITEM2';
mt.Items.Add(mi1) ;
//OnClick:= @GetVideoData
end;
with mi2 do begin
//parent:= frmMon;
Caption:='Open CD Player';
Name:='ITEM3';
mt.Items.Add(mi2);
//OnClick:= @OPenCD;
end;
with mi3 do begin
Caption:='Open maXbook';
Name:='ITEM4';
//mi.Items[0].add(mi3);
end;
with Stat do begin
parent:= inFrm;
stat.SimplePanel:= true;
end;
end;
begin
memo2.font.size:= 14;
SetForm;
mymemo.lines.text:= getRandomText;
//SearchAndOpenDoc(ExePath+MEDIAPATH)
//mylistview:= TFormListView.Create(self);
//exit;
maxform1.color:= clsilver;
writeln(floattostr(maXcalc('3273+1731+276')))
End.
//-------------------------------------------------
source is tlistview
target is tform
procedure TfMerit.SourceLVStartDrag(Sender: TObject;
var DragObject: TDragObject);
var TargetLV:TListView;
begin
// TargetLV:=nejak urcit dle potreby
TargetLV.BeginDrag(True)
end;
procedure TfMerit.SourceLVMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=True;
end;
procedure TfMerit.SourceLVMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=False;
if (Sender as TListView).Dragging then
(Sender as TListView).EndDrag(False);
end;
procedure TfMerit.SourceLVMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if (Sender.ClassNameIs('TListView')) then
begin
if MouseIsDown and ((Sender as TListView).SelCount>0) then
(Sender as TListView).BeginDrag(True);
end;
end;
procedure TfMerit.TargetLVDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var T:TListView;
begin
T:=Sender as TListView;
Accept:=Assigned(T.GetItemAt(X,Y));
end;
procedure TfMerit.TargetLVDragDrop(Sender, Source: TObject; X,
Y: Integer);
var It:TListItem;
LV1,LV2:TListView;
begin
LV1:=Source as TListView;
LV2:=Sender as TListview;
It:=LV2.GetItemAt(X,Y);
if Assigned(It) then
begin
// zpracuj polozku ze zdrojoveho listview
end;
end;
procedure TControlParentR(Self: TControl; var T:TWinControl); begin T:= Self.Parent; end;
procedure TControlParentW(Self: TControl; T: TWinControl); begin Self.Parent:= T; end;
RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT');
RegisterProperty('Parent', 'TWinControl', iptRW);
procedure TTXPTool.LVPFFDblClick(Sender: TObject);
var
tmpList : TListItem;
fn ; string;
ft : integer;
fs : integer;
begin
tmpList := LVPFF.Selected;
if tmplist<>nil then
begin
fn := tmpList.Caption
ft := tmpList.SubItems.Strings[1];
fs := tmpList.SubItems.Strings[3];
if pos('Wave', ft)>0 then
PlayThisOne1Click(nil);
if pos('Jpg', ft)>0 then
ShowJpg1Click(nil);
if pos('Targa', ft)>0 then
ShowTga1Click(nil);
if pos('Pcx', ft)>0 then
ShowPcx1Click(nil);
if pos('Mission Sound Collection', ft)>0 then
ShowPwf1Click(nil);
end;
end;